aboutsummaryrefslogtreecommitdiff
path: root/src/lua
diff options
context:
space:
mode:
Diffstat (limited to 'src/lua')
-rw-r--r--src/lua/lapi.c1411
-rw-r--r--src/lua/lapi.h47
-rw-r--r--src/lua/lauxlib.c1057
-rw-r--r--src/lua/lauxlib.h276
-rw-r--r--src/lua/lbaselib.c527
-rw-r--r--src/lua/lcode.c1814
-rw-r--r--src/lua/lcode.h104
-rw-r--r--src/lua/lcorolib.c206
-rw-r--r--src/lua/lctype.c64
-rw-r--r--src/lua/lctype.h95
-rw-r--r--src/lua/ldblib.c477
-rw-r--r--src/lua/ldebug.c841
-rw-r--r--src/lua/ldebug.h47
-rw-r--r--src/lua/ldo.c822
-rw-r--r--src/lua/ldo.h75
-rw-r--r--src/lua/ldump.c226
-rw-r--r--src/lua/lfunc.c299
-rw-r--r--src/lua/lfunc.h69
-rw-r--r--src/lua/lgc.c1616
-rw-r--r--src/lua/lgc.h186
-rw-r--r--src/lua/linit.c65
-rw-r--r--src/lua/liolib.c814
-rw-r--r--src/lua/ljumptab.h112
-rw-r--r--src/lua/llex.c578
-rw-r--r--src/lua/llex.h85
-rw-r--r--src/lua/llimits.h349
-rw-r--r--src/lua/lmathlib.c763
-rw-r--r--src/lua/lmem.c202
-rw-r--r--src/lua/lmem.h93
-rw-r--r--src/lua/loadlib.c759
-rw-r--r--src/lua/lobject.c583
-rw-r--r--src/lua/lobject.h787
-rw-r--r--src/lua/lopcodes.c104
-rw-r--r--src/lua/lopcodes.h392
-rw-r--r--src/lua/lopnames.h103
-rw-r--r--src/lua/loslib.c430
-rw-r--r--src/lua/lparser.c1996
-rw-r--r--src/lua/lparser.h170
-rw-r--r--src/lua/lprefix.h45
-rw-r--r--src/lua/lstate.c467
-rw-r--r--src/lua/lstate.h364
-rw-r--r--src/lua/lstring.c285
-rw-r--r--src/lua/lstring.h58
-rw-r--r--src/lua/lstrlib.c1805
-rw-r--r--src/lua/ltable.c924
-rw-r--r--src/lua/ltable.h57
-rw-r--r--src/lua/ltablib.c428
-rw-r--r--src/lua/ltm.c270
-rw-r--r--src/lua/ltm.h94
-rw-r--r--src/lua/lua.h517
-rw-r--r--src/lua/luaconf.h776
-rw-r--r--src/lua/lualib.h58
-rw-r--r--src/lua/lundump.c323
-rw-r--r--src/lua/lundump.h36
-rw-r--r--src/lua/lutf8lib.c289
-rw-r--r--src/lua/lvm.c1812
-rw-r--r--src/lua/lvm.h134
-rw-r--r--src/lua/lzio.c68
-rw-r--r--src/lua/lzio.h66
-rw-r--r--src/lua/makefile176
60 files changed, 27696 insertions, 0 deletions
diff --git a/src/lua/lapi.c b/src/lua/lapi.c
new file mode 100644
index 0000000..3e24781
--- /dev/null
+++ b/src/lua/lapi.c
@@ -0,0 +1,1411 @@
1/*
2** $Id: lapi.c $
3** Lua API
4** See Copyright Notice in lua.h
5*/
6
7#define lapi_c
8#define LUA_CORE
9
10#include "lprefix.h"
11
12
13#include <limits.h>
14#include <stdarg.h>
15#include <string.h>
16
17#include "lua.h"
18
19#include "lapi.h"
20#include "ldebug.h"
21#include "ldo.h"
22#include "lfunc.h"
23#include "lgc.h"
24#include "lmem.h"
25#include "lobject.h"
26#include "lstate.h"
27#include "lstring.h"
28#include "ltable.h"
29#include "ltm.h"
30#include "lundump.h"
31#include "lvm.h"
32
33
34
35const char lua_ident[] =
36 "$LuaVersion: " LUA_COPYRIGHT " $"
37 "$LuaAuthors: " LUA_AUTHORS " $";
38
39
40
41/*
42** Test for a valid index.
43** '!ttisnil(o)' implies 'o != &G(L)->nilvalue', so it is not needed.
44** However, it covers the most common cases in a faster way.
45*/
46#define isvalid(L, o) (!ttisnil(o) || o != &G(L)->nilvalue)
47
48
49/* test for pseudo index */
50#define ispseudo(i) ((i) <= LUA_REGISTRYINDEX)
51
52/* test for upvalue */
53#define isupvalue(i) ((i) < LUA_REGISTRYINDEX)
54
55
56static TValue *index2value (lua_State *L, int idx) {
57 CallInfo *ci = L->ci;
58 if (idx > 0) {
59 StkId o = ci->func + idx;
60 api_check(L, idx <= L->ci->top - (ci->func + 1), "unacceptable index");
61 if (o >= L->top) return &G(L)->nilvalue;
62 else return s2v(o);
63 }
64 else if (!ispseudo(idx)) { /* negative index */
65 api_check(L, idx != 0 && -idx <= L->top - (ci->func + 1), "invalid index");
66 return s2v(L->top + idx);
67 }
68 else if (idx == LUA_REGISTRYINDEX)
69 return &G(L)->l_registry;
70 else { /* upvalues */
71 idx = LUA_REGISTRYINDEX - idx;
72 api_check(L, idx <= MAXUPVAL + 1, "upvalue index too large");
73 if (ttislcf(s2v(ci->func))) /* light C function? */
74 return &G(L)->nilvalue; /* it has no upvalues */
75 else {
76 CClosure *func = clCvalue(s2v(ci->func));
77 return (idx <= func->nupvalues) ? &func->upvalue[idx-1] : &G(L)->nilvalue;
78 }
79 }
80}
81
82
83static StkId index2stack (lua_State *L, int idx) {
84 CallInfo *ci = L->ci;
85 if (idx > 0) {
86 StkId o = ci->func + idx;
87 api_check(L, o < L->top, "unacceptable index");
88 return o;
89 }
90 else { /* non-positive index */
91 api_check(L, idx != 0 && -idx <= L->top - (ci->func + 1), "invalid index");
92 api_check(L, !ispseudo(idx), "invalid index");
93 return L->top + idx;
94 }
95}
96
97
98LUA_API int lua_checkstack (lua_State *L, int n) {
99 int res;
100 CallInfo *ci = L->ci;
101 lua_lock(L);
102 api_check(L, n >= 0, "negative 'n'");
103 if (L->stack_last - L->top > n) /* stack large enough? */
104 res = 1; /* yes; check is OK */
105 else { /* no; need to grow stack */
106 int inuse = cast_int(L->top - L->stack) + EXTRA_STACK;
107 if (inuse > LUAI_MAXSTACK - n) /* can grow without overflow? */
108 res = 0; /* no */
109 else /* try to grow stack */
110 res = luaD_growstack(L, n, 0);
111 }
112 if (res && ci->top < L->top + n)
113 ci->top = L->top + n; /* adjust frame top */
114 lua_unlock(L);
115 return res;
116}
117
118
119LUA_API void lua_xmove (lua_State *from, lua_State *to, int n) {
120 int i;
121 if (from == to) return;
122 lua_lock(to);
123 api_checknelems(from, n);
124 api_check(from, G(from) == G(to), "moving among independent states");
125 api_check(from, to->ci->top - to->top >= n, "stack overflow");
126 from->top -= n;
127 for (i = 0; i < n; i++) {
128 setobjs2s(to, to->top, from->top + i);
129 to->top++; /* stack already checked by previous 'api_check' */
130 }
131 lua_unlock(to);
132}
133
134
135LUA_API lua_CFunction lua_atpanic (lua_State *L, lua_CFunction panicf) {
136 lua_CFunction old;
137 lua_lock(L);
138 old = G(L)->panic;
139 G(L)->panic = panicf;
140 lua_unlock(L);
141 return old;
142}
143
144
145LUA_API lua_Number lua_version (lua_State *L) {
146 UNUSED(L);
147 return LUA_VERSION_NUM;
148}
149
150
151
152/*
153** basic stack manipulation
154*/
155
156
157/*
158** convert an acceptable stack index into an absolute index
159*/
160LUA_API int lua_absindex (lua_State *L, int idx) {
161 return (idx > 0 || ispseudo(idx))
162 ? idx
163 : cast_int(L->top - L->ci->func) + idx;
164}
165
166
167LUA_API int lua_gettop (lua_State *L) {
168 return cast_int(L->top - (L->ci->func + 1));
169}
170
171
172LUA_API void lua_settop (lua_State *L, int idx) {
173 CallInfo *ci = L->ci;
174 StkId func = ci->func;
175 ptrdiff_t diff; /* difference for new top */
176 lua_lock(L);
177 if (idx >= 0) {
178 api_check(L, idx <= ci->top - (func + 1), "new top too large");
179 diff = ((func + 1) + idx) - L->top;
180 for (; diff > 0; diff--)
181 setnilvalue(s2v(L->top++)); /* clear new slots */
182 }
183 else {
184 api_check(L, -(idx+1) <= (L->top - (func + 1)), "invalid new top");
185 diff = idx + 1; /* will "subtract" index (as it is negative) */
186 }
187 if (diff < 0 && hastocloseCfunc(ci->nresults))
188 luaF_close(L, L->top + diff, LUA_OK);
189 L->top += diff; /* correct top only after closing any upvalue */
190 lua_unlock(L);
191}
192
193
194/*
195** Reverse the stack segment from 'from' to 'to'
196** (auxiliary to 'lua_rotate')
197** Note that we move(copy) only the value inside the stack.
198** (We do not move additional fields that may exist.)
199*/
200static void reverse (lua_State *L, StkId from, StkId to) {
201 for (; from < to; from++, to--) {
202 TValue temp;
203 setobj(L, &temp, s2v(from));
204 setobjs2s(L, from, to);
205 setobj2s(L, to, &temp);
206 }
207}
208
209
210/*
211** Let x = AB, where A is a prefix of length 'n'. Then,
212** rotate x n == BA. But BA == (A^r . B^r)^r.
213*/
214LUA_API void lua_rotate (lua_State *L, int idx, int n) {
215 StkId p, t, m;
216 lua_lock(L);
217 t = L->top - 1; /* end of stack segment being rotated */
218 p = index2stack(L, idx); /* start of segment */
219 api_check(L, (n >= 0 ? n : -n) <= (t - p + 1), "invalid 'n'");
220 m = (n >= 0 ? t - n : p - n - 1); /* end of prefix */
221 reverse(L, p, m); /* reverse the prefix with length 'n' */
222 reverse(L, m + 1, t); /* reverse the suffix */
223 reverse(L, p, t); /* reverse the entire segment */
224 lua_unlock(L);
225}
226
227
228LUA_API void lua_copy (lua_State *L, int fromidx, int toidx) {
229 TValue *fr, *to;
230 lua_lock(L);
231 fr = index2value(L, fromidx);
232 to = index2value(L, toidx);
233 api_check(L, isvalid(L, to), "invalid index");
234 setobj(L, to, fr);
235 if (isupvalue(toidx)) /* function upvalue? */
236 luaC_barrier(L, clCvalue(s2v(L->ci->func)), fr);
237 /* LUA_REGISTRYINDEX does not need gc barrier
238 (collector revisits it before finishing collection) */
239 lua_unlock(L);
240}
241
242
243LUA_API void lua_pushvalue (lua_State *L, int idx) {
244 lua_lock(L);
245 setobj2s(L, L->top, index2value(L, idx));
246 api_incr_top(L);
247 lua_unlock(L);
248}
249
250
251
252/*
253** access functions (stack -> C)
254*/
255
256
257LUA_API int lua_type (lua_State *L, int idx) {
258 const TValue *o = index2value(L, idx);
259 return (isvalid(L, o) ? ttype(o) : LUA_TNONE);
260}
261
262
263LUA_API const char *lua_typename (lua_State *L, int t) {
264 UNUSED(L);
265 api_check(L, LUA_TNONE <= t && t < LUA_NUMTYPES, "invalid type");
266 return ttypename(t);
267}
268
269
270LUA_API int lua_iscfunction (lua_State *L, int idx) {
271 const TValue *o = index2value(L, idx);
272 return (ttislcf(o) || (ttisCclosure(o)));
273}
274
275
276LUA_API int lua_isinteger (lua_State *L, int idx) {
277 const TValue *o = index2value(L, idx);
278 return ttisinteger(o);
279}
280
281
282LUA_API int lua_isnumber (lua_State *L, int idx) {
283 lua_Number n;
284 const TValue *o = index2value(L, idx);
285 return tonumber(o, &n);
286}
287
288
289LUA_API int lua_isstring (lua_State *L, int idx) {
290 const TValue *o = index2value(L, idx);
291 return (ttisstring(o) || cvt2str(o));
292}
293
294
295LUA_API int lua_isuserdata (lua_State *L, int idx) {
296 const TValue *o = index2value(L, idx);
297 return (ttisfulluserdata(o) || ttislightuserdata(o));
298}
299
300
301LUA_API int lua_rawequal (lua_State *L, int index1, int index2) {
302 const TValue *o1 = index2value(L, index1);
303 const TValue *o2 = index2value(L, index2);
304 return (isvalid(L, o1) && isvalid(L, o2)) ? luaV_rawequalobj(o1, o2) : 0;
305}
306
307
308LUA_API void lua_arith (lua_State *L, int op) {
309 lua_lock(L);
310 if (op != LUA_OPUNM && op != LUA_OPBNOT)
311 api_checknelems(L, 2); /* all other operations expect two operands */
312 else { /* for unary operations, add fake 2nd operand */
313 api_checknelems(L, 1);
314 setobjs2s(L, L->top, L->top - 1);
315 api_incr_top(L);
316 }
317 /* first operand at top - 2, second at top - 1; result go to top - 2 */
318 luaO_arith(L, op, s2v(L->top - 2), s2v(L->top - 1), L->top - 2);
319 L->top--; /* remove second operand */
320 lua_unlock(L);
321}
322
323
324LUA_API int lua_compare (lua_State *L, int index1, int index2, int op) {
325 const TValue *o1;
326 const TValue *o2;
327 int i = 0;
328 lua_lock(L); /* may call tag method */
329 o1 = index2value(L, index1);
330 o2 = index2value(L, index2);
331 if (isvalid(L, o1) && isvalid(L, o2)) {
332 switch (op) {
333 case LUA_OPEQ: i = luaV_equalobj(L, o1, o2); break;
334 case LUA_OPLT: i = luaV_lessthan(L, o1, o2); break;
335 case LUA_OPLE: i = luaV_lessequal(L, o1, o2); break;
336 default: api_check(L, 0, "invalid option");
337 }
338 }
339 lua_unlock(L);
340 return i;
341}
342
343
344LUA_API size_t lua_stringtonumber (lua_State *L, const char *s) {
345 size_t sz = luaO_str2num(s, s2v(L->top));
346 if (sz != 0)
347 api_incr_top(L);
348 return sz;
349}
350
351
352LUA_API lua_Number lua_tonumberx (lua_State *L, int idx, int *pisnum) {
353 lua_Number n = 0;
354 const TValue *o = index2value(L, idx);
355 int isnum = tonumber(o, &n);
356 if (pisnum)
357 *pisnum = isnum;
358 return n;
359}
360
361
362LUA_API lua_Integer lua_tointegerx (lua_State *L, int idx, int *pisnum) {
363 lua_Integer res = 0;
364 const TValue *o = index2value(L, idx);
365 int isnum = tointeger(o, &res);
366 if (pisnum)
367 *pisnum = isnum;
368 return res;
369}
370
371
372LUA_API int lua_toboolean (lua_State *L, int idx) {
373 const TValue *o = index2value(L, idx);
374 return !l_isfalse(o);
375}
376
377
378LUA_API const char *lua_tolstring (lua_State *L, int idx, size_t *len) {
379 TValue *o = index2value(L, idx);
380 if (!ttisstring(o)) {
381 if (!cvt2str(o)) { /* not convertible? */
382 if (len != NULL) *len = 0;
383 return NULL;
384 }
385 lua_lock(L); /* 'luaO_tostring' may create a new string */
386 luaO_tostring(L, o);
387 luaC_checkGC(L);
388 o = index2value(L, idx); /* previous call may reallocate the stack */
389 lua_unlock(L);
390 }
391 if (len != NULL)
392 *len = vslen(o);
393 return svalue(o);
394}
395
396
397LUA_API lua_Unsigned lua_rawlen (lua_State *L, int idx) {
398 const TValue *o = index2value(L, idx);
399 switch (ttypetag(o)) {
400 case LUA_VSHRSTR: return tsvalue(o)->shrlen;
401 case LUA_VLNGSTR: return tsvalue(o)->u.lnglen;
402 case LUA_VUSERDATA: return uvalue(o)->len;
403 case LUA_VTABLE: return luaH_getn(hvalue(o));
404 default: return 0;
405 }
406}
407
408
409LUA_API lua_CFunction lua_tocfunction (lua_State *L, int idx) {
410 const TValue *o = index2value(L, idx);
411 if (ttislcf(o)) return fvalue(o);
412 else if (ttisCclosure(o))
413 return clCvalue(o)->f;
414 else return NULL; /* not a C function */
415}
416
417
418static void *touserdata (const TValue *o) {
419 switch (ttype(o)) {
420 case LUA_TUSERDATA: return getudatamem(uvalue(o));
421 case LUA_TLIGHTUSERDATA: return pvalue(o);
422 default: return NULL;
423 }
424}
425
426
427LUA_API void *lua_touserdata (lua_State *L, int idx) {
428 const TValue *o = index2value(L, idx);
429 return touserdata(o);
430}
431
432
433LUA_API lua_State *lua_tothread (lua_State *L, int idx) {
434 const TValue *o = index2value(L, idx);
435 return (!ttisthread(o)) ? NULL : thvalue(o);
436}
437
438
439/*
440** Returns a pointer to the internal representation of an object.
441** Note that ANSI C does not allow the conversion of a pointer to
442** function to a 'void*', so the conversion here goes through
443** a 'size_t'. (As the returned pointer is only informative, this
444** conversion should not be a problem.)
445*/
446LUA_API const void *lua_topointer (lua_State *L, int idx) {
447 const TValue *o = index2value(L, idx);
448 switch (ttypetag(o)) {
449 case LUA_VLCF: return cast_voidp(cast_sizet(fvalue(o)));
450 case LUA_VUSERDATA: case LUA_VLIGHTUSERDATA:
451 return touserdata(o);
452 default: {
453 if (iscollectable(o))
454 return gcvalue(o);
455 else
456 return NULL;
457 }
458 }
459}
460
461
462
463/*
464** push functions (C -> stack)
465*/
466
467
468LUA_API void lua_pushnil (lua_State *L) {
469 lua_lock(L);
470 setnilvalue(s2v(L->top));
471 api_incr_top(L);
472 lua_unlock(L);
473}
474
475
476LUA_API void lua_pushnumber (lua_State *L, lua_Number n) {
477 lua_lock(L);
478 setfltvalue(s2v(L->top), n);
479 api_incr_top(L);
480 lua_unlock(L);
481}
482
483
484LUA_API void lua_pushinteger (lua_State *L, lua_Integer n) {
485 lua_lock(L);
486 setivalue(s2v(L->top), n);
487 api_incr_top(L);
488 lua_unlock(L);
489}
490
491
492/*
493** Pushes on the stack a string with given length. Avoid using 's' when
494** 'len' == 0 (as 's' can be NULL in that case), due to later use of
495** 'memcmp' and 'memcpy'.
496*/
497LUA_API const char *lua_pushlstring (lua_State *L, const char *s, size_t len) {
498 TString *ts;
499 lua_lock(L);
500 ts = (len == 0) ? luaS_new(L, "") : luaS_newlstr(L, s, len);
501 setsvalue2s(L, L->top, ts);
502 api_incr_top(L);
503 luaC_checkGC(L);
504 lua_unlock(L);
505 return getstr(ts);
506}
507
508
509LUA_API const char *lua_pushstring (lua_State *L, const char *s) {
510 lua_lock(L);
511 if (s == NULL)
512 setnilvalue(s2v(L->top));
513 else {
514 TString *ts;
515 ts = luaS_new(L, s);
516 setsvalue2s(L, L->top, ts);
517 s = getstr(ts); /* internal copy's address */
518 }
519 api_incr_top(L);
520 luaC_checkGC(L);
521 lua_unlock(L);
522 return s;
523}
524
525
526LUA_API const char *lua_pushvfstring (lua_State *L, const char *fmt,
527 va_list argp) {
528 const char *ret;
529 lua_lock(L);
530 ret = luaO_pushvfstring(L, fmt, argp);
531 luaC_checkGC(L);
532 lua_unlock(L);
533 return ret;
534}
535
536
537LUA_API const char *lua_pushfstring (lua_State *L, const char *fmt, ...) {
538 const char *ret;
539 va_list argp;
540 lua_lock(L);
541 va_start(argp, fmt);
542 ret = luaO_pushvfstring(L, fmt, argp);
543 va_end(argp);
544 luaC_checkGC(L);
545 lua_unlock(L);
546 return ret;
547}
548
549
550LUA_API void lua_pushcclosure (lua_State *L, lua_CFunction fn, int n) {
551 lua_lock(L);
552 if (n == 0) {
553 setfvalue(s2v(L->top), fn);
554 api_incr_top(L);
555 }
556 else {
557 CClosure *cl;
558 api_checknelems(L, n);
559 api_check(L, n <= MAXUPVAL, "upvalue index too large");
560 cl = luaF_newCclosure(L, n);
561 cl->f = fn;
562 L->top -= n;
563 while (n--) {
564 setobj2n(L, &cl->upvalue[n], s2v(L->top + n));
565 /* does not need barrier because closure is white */
566 }
567 setclCvalue(L, s2v(L->top), cl);
568 api_incr_top(L);
569 luaC_checkGC(L);
570 }
571 lua_unlock(L);
572}
573
574
575LUA_API void lua_pushboolean (lua_State *L, int b) {
576 lua_lock(L);
577 if (b)
578 setbtvalue(s2v(L->top));
579 else
580 setbfvalue(s2v(L->top));
581 api_incr_top(L);
582 lua_unlock(L);
583}
584
585
586LUA_API void lua_pushlightuserdata (lua_State *L, void *p) {
587 lua_lock(L);
588 setpvalue(s2v(L->top), p);
589 api_incr_top(L);
590 lua_unlock(L);
591}
592
593
594LUA_API int lua_pushthread (lua_State *L) {
595 lua_lock(L);
596 setthvalue(L, s2v(L->top), L);
597 api_incr_top(L);
598 lua_unlock(L);
599 return (G(L)->mainthread == L);
600}
601
602
603
604/*
605** get functions (Lua -> stack)
606*/
607
608
609static int auxgetstr (lua_State *L, const TValue *t, const char *k) {
610 const TValue *slot;
611 TString *str = luaS_new(L, k);
612 if (luaV_fastget(L, t, str, slot, luaH_getstr)) {
613 setobj2s(L, L->top, slot);
614 api_incr_top(L);
615 }
616 else {
617 setsvalue2s(L, L->top, str);
618 api_incr_top(L);
619 luaV_finishget(L, t, s2v(L->top - 1), L->top - 1, slot);
620 }
621 lua_unlock(L);
622 return ttype(s2v(L->top - 1));
623}
624
625
626LUA_API int lua_getglobal (lua_State *L, const char *name) {
627 Table *reg = hvalue(&G(L)->l_registry);
628 lua_lock(L);
629 return auxgetstr(L, luaH_getint(reg, LUA_RIDX_GLOBALS), name);
630}
631
632
633LUA_API int lua_gettable (lua_State *L, int idx) {
634 const TValue *slot;
635 TValue *t;
636 lua_lock(L);
637 t = index2value(L, idx);
638 if (luaV_fastget(L, t, s2v(L->top - 1), slot, luaH_get)) {
639 setobj2s(L, L->top - 1, slot);
640 }
641 else
642 luaV_finishget(L, t, s2v(L->top - 1), L->top - 1, slot);
643 lua_unlock(L);
644 return ttype(s2v(L->top - 1));
645}
646
647
648LUA_API int lua_getfield (lua_State *L, int idx, const char *k) {
649 lua_lock(L);
650 return auxgetstr(L, index2value(L, idx), k);
651}
652
653
654LUA_API int lua_geti (lua_State *L, int idx, lua_Integer n) {
655 TValue *t;
656 const TValue *slot;
657 lua_lock(L);
658 t = index2value(L, idx);
659 if (luaV_fastgeti(L, t, n, slot)) {
660 setobj2s(L, L->top, slot);
661 }
662 else {
663 TValue aux;
664 setivalue(&aux, n);
665 luaV_finishget(L, t, &aux, L->top, slot);
666 }
667 api_incr_top(L);
668 lua_unlock(L);
669 return ttype(s2v(L->top - 1));
670}
671
672
673static int finishrawget (lua_State *L, const TValue *val) {
674 if (isempty(val)) /* avoid copying empty items to the stack */
675 setnilvalue(s2v(L->top));
676 else
677 setobj2s(L, L->top, val);
678 api_incr_top(L);
679 lua_unlock(L);
680 return ttype(s2v(L->top - 1));
681}
682
683
684static Table *gettable (lua_State *L, int idx) {
685 TValue *t = index2value(L, idx);
686 api_check(L, ttistable(t), "table expected");
687 return hvalue(t);
688}
689
690
691LUA_API int lua_rawget (lua_State *L, int idx) {
692 Table *t;
693 const TValue *val;
694 lua_lock(L);
695 api_checknelems(L, 1);
696 t = gettable(L, idx);
697 val = luaH_get(t, s2v(L->top - 1));
698 L->top--; /* remove key */
699 return finishrawget(L, val);
700}
701
702
703LUA_API int lua_rawgeti (lua_State *L, int idx, lua_Integer n) {
704 Table *t;
705 lua_lock(L);
706 t = gettable(L, idx);
707 return finishrawget(L, luaH_getint(t, n));
708}
709
710
711LUA_API int lua_rawgetp (lua_State *L, int idx, const void *p) {
712 Table *t;
713 TValue k;
714 lua_lock(L);
715 t = gettable(L, idx);
716 setpvalue(&k, cast_voidp(p));
717 return finishrawget(L, luaH_get(t, &k));
718}
719
720
721LUA_API void lua_createtable (lua_State *L, int narray, int nrec) {
722 Table *t;
723 lua_lock(L);
724 t = luaH_new(L);
725 sethvalue2s(L, L->top, t);
726 api_incr_top(L);
727 if (narray > 0 || nrec > 0)
728 luaH_resize(L, t, narray, nrec);
729 luaC_checkGC(L);
730 lua_unlock(L);
731}
732
733
734LUA_API int lua_getmetatable (lua_State *L, int objindex) {
735 const TValue *obj;
736 Table *mt;
737 int res = 0;
738 lua_lock(L);
739 obj = index2value(L, objindex);
740 switch (ttype(obj)) {
741 case LUA_TTABLE:
742 mt = hvalue(obj)->metatable;
743 break;
744 case LUA_TUSERDATA:
745 mt = uvalue(obj)->metatable;
746 break;
747 default:
748 mt = G(L)->mt[ttype(obj)];
749 break;
750 }
751 if (mt != NULL) {
752 sethvalue2s(L, L->top, mt);
753 api_incr_top(L);
754 res = 1;
755 }
756 lua_unlock(L);
757 return res;
758}
759
760
761LUA_API int lua_getiuservalue (lua_State *L, int idx, int n) {
762 TValue *o;
763 int t;
764 lua_lock(L);
765 o = index2value(L, idx);
766 api_check(L, ttisfulluserdata(o), "full userdata expected");
767 if (n <= 0 || n > uvalue(o)->nuvalue) {
768 setnilvalue(s2v(L->top));
769 t = LUA_TNONE;
770 }
771 else {
772 setobj2s(L, L->top, &uvalue(o)->uv[n - 1].uv);
773 t = ttype(s2v(L->top));
774 }
775 api_incr_top(L);
776 lua_unlock(L);
777 return t;
778}
779
780
781/*
782** set functions (stack -> Lua)
783*/
784
785/*
786** t[k] = value at the top of the stack (where 'k' is a string)
787*/
788static void auxsetstr (lua_State *L, const TValue *t, const char *k) {
789 const TValue *slot;
790 TString *str = luaS_new(L, k);
791 api_checknelems(L, 1);
792 if (luaV_fastget(L, t, str, slot, luaH_getstr)) {
793 luaV_finishfastset(L, t, slot, s2v(L->top - 1));
794 L->top--; /* pop value */
795 }
796 else {
797 setsvalue2s(L, L->top, str); /* push 'str' (to make it a TValue) */
798 api_incr_top(L);
799 luaV_finishset(L, t, s2v(L->top - 1), s2v(L->top - 2), slot);
800 L->top -= 2; /* pop value and key */
801 }
802 lua_unlock(L); /* lock done by caller */
803}
804
805
806LUA_API void lua_setglobal (lua_State *L, const char *name) {
807 Table *reg = hvalue(&G(L)->l_registry);
808 lua_lock(L); /* unlock done in 'auxsetstr' */
809 auxsetstr(L, luaH_getint(reg, LUA_RIDX_GLOBALS), name);
810}
811
812
813LUA_API void lua_settable (lua_State *L, int idx) {
814 TValue *t;
815 const TValue *slot;
816 lua_lock(L);
817 api_checknelems(L, 2);
818 t = index2value(L, idx);
819 if (luaV_fastget(L, t, s2v(L->top - 2), slot, luaH_get)) {
820 luaV_finishfastset(L, t, slot, s2v(L->top - 1));
821 }
822 else
823 luaV_finishset(L, t, s2v(L->top - 2), s2v(L->top - 1), slot);
824 L->top -= 2; /* pop index and value */
825 lua_unlock(L);
826}
827
828
829LUA_API void lua_setfield (lua_State *L, int idx, const char *k) {
830 lua_lock(L); /* unlock done in 'auxsetstr' */
831 auxsetstr(L, index2value(L, idx), k);
832}
833
834
835LUA_API void lua_seti (lua_State *L, int idx, lua_Integer n) {
836 TValue *t;
837 const TValue *slot;
838 lua_lock(L);
839 api_checknelems(L, 1);
840 t = index2value(L, idx);
841 if (luaV_fastgeti(L, t, n, slot)) {
842 luaV_finishfastset(L, t, slot, s2v(L->top - 1));
843 }
844 else {
845 TValue aux;
846 setivalue(&aux, n);
847 luaV_finishset(L, t, &aux, s2v(L->top - 1), slot);
848 }
849 L->top--; /* pop value */
850 lua_unlock(L);
851}
852
853
854static void aux_rawset (lua_State *L, int idx, TValue *key, int n) {
855 Table *t;
856 TValue *slot;
857 lua_lock(L);
858 api_checknelems(L, n);
859 t = gettable(L, idx);
860 slot = luaH_set(L, t, key);
861 setobj2t(L, slot, s2v(L->top - 1));
862 invalidateTMcache(t);
863 luaC_barrierback(L, obj2gco(t), s2v(L->top - 1));
864 L->top -= n;
865 lua_unlock(L);
866}
867
868
869LUA_API void lua_rawset (lua_State *L, int idx) {
870 aux_rawset(L, idx, s2v(L->top - 2), 2);
871}
872
873
874LUA_API void lua_rawsetp (lua_State *L, int idx, const void *p) {
875 TValue k;
876 setpvalue(&k, cast_voidp(p));
877 aux_rawset(L, idx, &k, 1);
878}
879
880
881LUA_API void lua_rawseti (lua_State *L, int idx, lua_Integer n) {
882 Table *t;
883 lua_lock(L);
884 api_checknelems(L, 1);
885 t = gettable(L, idx);
886 luaH_setint(L, t, n, s2v(L->top - 1));
887 luaC_barrierback(L, obj2gco(t), s2v(L->top - 1));
888 L->top--;
889 lua_unlock(L);
890}
891
892
893LUA_API int lua_setmetatable (lua_State *L, int objindex) {
894 TValue *obj;
895 Table *mt;
896 lua_lock(L);
897 api_checknelems(L, 1);
898 obj = index2value(L, objindex);
899 if (ttisnil(s2v(L->top - 1)))
900 mt = NULL;
901 else {
902 api_check(L, ttistable(s2v(L->top - 1)), "table expected");
903 mt = hvalue(s2v(L->top - 1));
904 }
905 switch (ttype(obj)) {
906 case LUA_TTABLE: {
907 hvalue(obj)->metatable = mt;
908 if (mt) {
909 luaC_objbarrier(L, gcvalue(obj), mt);
910 luaC_checkfinalizer(L, gcvalue(obj), mt);
911 }
912 break;
913 }
914 case LUA_TUSERDATA: {
915 uvalue(obj)->metatable = mt;
916 if (mt) {
917 luaC_objbarrier(L, uvalue(obj), mt);
918 luaC_checkfinalizer(L, gcvalue(obj), mt);
919 }
920 break;
921 }
922 default: {
923 G(L)->mt[ttype(obj)] = mt;
924 break;
925 }
926 }
927 L->top--;
928 lua_unlock(L);
929 return 1;
930}
931
932
933LUA_API int lua_setiuservalue (lua_State *L, int idx, int n) {
934 TValue *o;
935 int res;
936 lua_lock(L);
937 api_checknelems(L, 1);
938 o = index2value(L, idx);
939 api_check(L, ttisfulluserdata(o), "full userdata expected");
940 if (!(cast_uint(n) - 1u < cast_uint(uvalue(o)->nuvalue)))
941 res = 0; /* 'n' not in [1, uvalue(o)->nuvalue] */
942 else {
943 setobj(L, &uvalue(o)->uv[n - 1].uv, s2v(L->top - 1));
944 luaC_barrierback(L, gcvalue(o), s2v(L->top - 1));
945 res = 1;
946 }
947 L->top--;
948 lua_unlock(L);
949 return res;
950}
951
952
953/*
954** 'load' and 'call' functions (run Lua code)
955*/
956
957
958#define checkresults(L,na,nr) \
959 api_check(L, (nr) == LUA_MULTRET || (L->ci->top - L->top >= (nr) - (na)), \
960 "results from function overflow current stack size")
961
962
963LUA_API void lua_callk (lua_State *L, int nargs, int nresults,
964 lua_KContext ctx, lua_KFunction k) {
965 StkId func;
966 lua_lock(L);
967 api_check(L, k == NULL || !isLua(L->ci),
968 "cannot use continuations inside hooks");
969 api_checknelems(L, nargs+1);
970 api_check(L, L->status == LUA_OK, "cannot do calls on non-normal thread");
971 checkresults(L, nargs, nresults);
972 func = L->top - (nargs+1);
973 if (k != NULL && yieldable(L)) { /* need to prepare continuation? */
974 L->ci->u.c.k = k; /* save continuation */
975 L->ci->u.c.ctx = ctx; /* save context */
976 luaD_call(L, func, nresults); /* do the call */
977 }
978 else /* no continuation or no yieldable */
979 luaD_callnoyield(L, func, nresults); /* just do the call */
980 adjustresults(L, nresults);
981 lua_unlock(L);
982}
983
984
985
986/*
987** Execute a protected call.
988*/
989struct CallS { /* data to 'f_call' */
990 StkId func;
991 int nresults;
992};
993
994
995static void f_call (lua_State *L, void *ud) {
996 struct CallS *c = cast(struct CallS *, ud);
997 luaD_callnoyield(L, c->func, c->nresults);
998}
999
1000
1001
1002LUA_API int lua_pcallk (lua_State *L, int nargs, int nresults, int errfunc,
1003 lua_KContext ctx, lua_KFunction k) {
1004 struct CallS c;
1005 int status;
1006 ptrdiff_t func;
1007 lua_lock(L);
1008 api_check(L, k == NULL || !isLua(L->ci),
1009 "cannot use continuations inside hooks");
1010 api_checknelems(L, nargs+1);
1011 api_check(L, L->status == LUA_OK, "cannot do calls on non-normal thread");
1012 checkresults(L, nargs, nresults);
1013 if (errfunc == 0)
1014 func = 0;
1015 else {
1016 StkId o = index2stack(L, errfunc);
1017 api_check(L, ttisfunction(s2v(o)), "error handler must be a function");
1018 func = savestack(L, o);
1019 }
1020 c.func = L->top - (nargs+1); /* function to be called */
1021 if (k == NULL || !yieldable(L)) { /* no continuation or no yieldable? */
1022 c.nresults = nresults; /* do a 'conventional' protected call */
1023 status = luaD_pcall(L, f_call, &c, savestack(L, c.func), func);
1024 }
1025 else { /* prepare continuation (call is already protected by 'resume') */
1026 CallInfo *ci = L->ci;
1027 ci->u.c.k = k; /* save continuation */
1028 ci->u.c.ctx = ctx; /* save context */
1029 /* save information for error recovery */
1030 ci->u2.funcidx = cast_int(savestack(L, c.func));
1031 ci->u.c.old_errfunc = L->errfunc;
1032 L->errfunc = func;
1033 setoah(ci->callstatus, L->allowhook); /* save value of 'allowhook' */
1034 ci->callstatus |= CIST_YPCALL; /* function can do error recovery */
1035 luaD_call(L, c.func, nresults); /* do the call */
1036 ci->callstatus &= ~CIST_YPCALL;
1037 L->errfunc = ci->u.c.old_errfunc;
1038 status = LUA_OK; /* if it is here, there were no errors */
1039 }
1040 adjustresults(L, nresults);
1041 lua_unlock(L);
1042 return status;
1043}
1044
1045
1046LUA_API int lua_load (lua_State *L, lua_Reader reader, void *data,
1047 const char *chunkname, const char *mode) {
1048 ZIO z;
1049 int status;
1050 lua_lock(L);
1051 if (!chunkname) chunkname = "?";
1052 luaZ_init(L, &z, reader, data);
1053 status = luaD_protectedparser(L, &z, chunkname, mode);
1054 if (status == LUA_OK) { /* no errors? */
1055 LClosure *f = clLvalue(s2v(L->top - 1)); /* get newly created function */
1056 if (f->nupvalues >= 1) { /* does it have an upvalue? */
1057 /* get global table from registry */
1058 Table *reg = hvalue(&G(L)->l_registry);
1059 const TValue *gt = luaH_getint(reg, LUA_RIDX_GLOBALS);
1060 /* set global table as 1st upvalue of 'f' (may be LUA_ENV) */
1061 setobj(L, f->upvals[0]->v, gt);
1062 luaC_barrier(L, f->upvals[0], gt);
1063 }
1064 }
1065 lua_unlock(L);
1066 return status;
1067}
1068
1069
1070LUA_API int lua_dump (lua_State *L, lua_Writer writer, void *data, int strip) {
1071 int status;
1072 TValue *o;
1073 lua_lock(L);
1074 api_checknelems(L, 1);
1075 o = s2v(L->top - 1);
1076 if (isLfunction(o))
1077 status = luaU_dump(L, getproto(o), writer, data, strip);
1078 else
1079 status = 1;
1080 lua_unlock(L);
1081 return status;
1082}
1083
1084
1085LUA_API int lua_status (lua_State *L) {
1086 return L->status;
1087}
1088
1089
1090/*
1091** Garbage-collection function
1092*/
1093LUA_API int lua_gc (lua_State *L, int what, ...) {
1094 va_list argp;
1095 int res = 0;
1096 global_State *g = G(L);
1097 lua_lock(L);
1098 va_start(argp, what);
1099 switch (what) {
1100 case LUA_GCSTOP: {
1101 g->gcrunning = 0;
1102 break;
1103 }
1104 case LUA_GCRESTART: {
1105 luaE_setdebt(g, 0);
1106 g->gcrunning = 1;
1107 break;
1108 }
1109 case LUA_GCCOLLECT: {
1110 luaC_fullgc(L, 0);
1111 break;
1112 }
1113 case LUA_GCCOUNT: {
1114 /* GC values are expressed in Kbytes: #bytes/2^10 */
1115 res = cast_int(gettotalbytes(g) >> 10);
1116 break;
1117 }
1118 case LUA_GCCOUNTB: {
1119 res = cast_int(gettotalbytes(g) & 0x3ff);
1120 break;
1121 }
1122 case LUA_GCSTEP: {
1123 int data = va_arg(argp, int);
1124 l_mem debt = 1; /* =1 to signal that it did an actual step */
1125 lu_byte oldrunning = g->gcrunning;
1126 g->gcrunning = 1; /* allow GC to run */
1127 if (data == 0) {
1128 luaE_setdebt(g, 0); /* do a basic step */
1129 luaC_step(L);
1130 }
1131 else { /* add 'data' to total debt */
1132 debt = cast(l_mem, data) * 1024 + g->GCdebt;
1133 luaE_setdebt(g, debt);
1134 luaC_checkGC(L);
1135 }
1136 g->gcrunning = oldrunning; /* restore previous state */
1137 if (debt > 0 && g->gcstate == GCSpause) /* end of cycle? */
1138 res = 1; /* signal it */
1139 break;
1140 }
1141 case LUA_GCSETPAUSE: {
1142 int data = va_arg(argp, int);
1143 res = getgcparam(g->gcpause);
1144 setgcparam(g->gcpause, data);
1145 break;
1146 }
1147 case LUA_GCSETSTEPMUL: {
1148 int data = va_arg(argp, int);
1149 res = getgcparam(g->gcstepmul);
1150 setgcparam(g->gcstepmul, data);
1151 break;
1152 }
1153 case LUA_GCISRUNNING: {
1154 res = g->gcrunning;
1155 break;
1156 }
1157 case LUA_GCGEN: {
1158 int minormul = va_arg(argp, int);
1159 int majormul = va_arg(argp, int);
1160 res = isdecGCmodegen(g) ? LUA_GCGEN : LUA_GCINC;
1161 if (minormul != 0)
1162 g->genminormul = minormul;
1163 if (majormul != 0)
1164 setgcparam(g->genmajormul, majormul);
1165 luaC_changemode(L, KGC_GEN);
1166 break;
1167 }
1168 case LUA_GCINC: {
1169 int pause = va_arg(argp, int);
1170 int stepmul = va_arg(argp, int);
1171 int stepsize = va_arg(argp, int);
1172 res = isdecGCmodegen(g) ? LUA_GCGEN : LUA_GCINC;
1173 if (pause != 0)
1174 setgcparam(g->gcpause, pause);
1175 if (stepmul != 0)
1176 setgcparam(g->gcstepmul, stepmul);
1177 if (stepsize != 0)
1178 g->gcstepsize = stepsize;
1179 luaC_changemode(L, KGC_INC);
1180 break;
1181 }
1182 default: res = -1; /* invalid option */
1183 }
1184 va_end(argp);
1185 lua_unlock(L);
1186 return res;
1187}
1188
1189
1190
1191/*
1192** miscellaneous functions
1193*/
1194
1195
1196LUA_API int lua_error (lua_State *L) {
1197 lua_lock(L);
1198 api_checknelems(L, 1);
1199 luaG_errormsg(L);
1200 /* code unreachable; will unlock when control actually leaves the kernel */
1201 return 0; /* to avoid warnings */
1202}
1203
1204
1205LUA_API int lua_next (lua_State *L, int idx) {
1206 Table *t;
1207 int more;
1208 lua_lock(L);
1209 api_checknelems(L, 1);
1210 t = gettable(L, idx);
1211 more = luaH_next(L, t, L->top - 1);
1212 if (more) {
1213 api_incr_top(L);
1214 }
1215 else /* no more elements */
1216 L->top -= 1; /* remove key */
1217 lua_unlock(L);
1218 return more;
1219}
1220
1221
1222LUA_API void lua_toclose (lua_State *L, int idx) {
1223 int nresults;
1224 StkId o;
1225 lua_lock(L);
1226 o = index2stack(L, idx);
1227 nresults = L->ci->nresults;
1228 api_check(L, L->openupval == NULL || uplevel(L->openupval) <= o,
1229 "marked index below or equal new one");
1230 luaF_newtbcupval(L, o); /* create new to-be-closed upvalue */
1231 if (!hastocloseCfunc(nresults)) /* function not marked yet? */
1232 L->ci->nresults = codeNresults(nresults); /* mark it */
1233 lua_assert(hastocloseCfunc(L->ci->nresults));
1234 lua_unlock(L);
1235}
1236
1237
1238LUA_API void lua_concat (lua_State *L, int n) {
1239 lua_lock(L);
1240 api_checknelems(L, n);
1241 if (n >= 2) {
1242 luaV_concat(L, n);
1243 }
1244 else if (n == 0) { /* push empty string */
1245 setsvalue2s(L, L->top, luaS_newlstr(L, "", 0));
1246 api_incr_top(L);
1247 }
1248 /* else n == 1; nothing to do */
1249 luaC_checkGC(L);
1250 lua_unlock(L);
1251}
1252
1253
1254LUA_API void lua_len (lua_State *L, int idx) {
1255 TValue *t;
1256 lua_lock(L);
1257 t = index2value(L, idx);
1258 luaV_objlen(L, L->top, t);
1259 api_incr_top(L);
1260 lua_unlock(L);
1261}
1262
1263
1264LUA_API lua_Alloc lua_getallocf (lua_State *L, void **ud) {
1265 lua_Alloc f;
1266 lua_lock(L);
1267 if (ud) *ud = G(L)->ud;
1268 f = G(L)->frealloc;
1269 lua_unlock(L);
1270 return f;
1271}
1272
1273
1274LUA_API void lua_setallocf (lua_State *L, lua_Alloc f, void *ud) {
1275 lua_lock(L);
1276 G(L)->ud = ud;
1277 G(L)->frealloc = f;
1278 lua_unlock(L);
1279}
1280
1281
1282void lua_setwarnf (lua_State *L, lua_WarnFunction f, void *ud) {
1283 lua_lock(L);
1284 G(L)->ud_warn = ud;
1285 G(L)->warnf = f;
1286 lua_unlock(L);
1287}
1288
1289
1290void lua_warning (lua_State *L, const char *msg, int tocont) {
1291 lua_lock(L);
1292 luaE_warning(L, msg, tocont);
1293 lua_unlock(L);
1294}
1295
1296
1297
1298LUA_API void *lua_newuserdatauv (lua_State *L, size_t size, int nuvalue) {
1299 Udata *u;
1300 lua_lock(L);
1301 api_check(L, 0 <= nuvalue && nuvalue < USHRT_MAX, "invalid value");
1302 u = luaS_newudata(L, size, nuvalue);
1303 setuvalue(L, s2v(L->top), u);
1304 api_incr_top(L);
1305 luaC_checkGC(L);
1306 lua_unlock(L);
1307 return getudatamem(u);
1308}
1309
1310
1311
1312static const char *aux_upvalue (TValue *fi, int n, TValue **val,
1313 GCObject **owner) {
1314 switch (ttypetag(fi)) {
1315 case LUA_VCCL: { /* C closure */
1316 CClosure *f = clCvalue(fi);
1317 if (!(cast_uint(n) - 1u < cast_uint(f->nupvalues)))
1318 return NULL; /* 'n' not in [1, f->nupvalues] */
1319 *val = &f->upvalue[n-1];
1320 if (owner) *owner = obj2gco(f);
1321 return "";
1322 }
1323 case LUA_VLCL: { /* Lua closure */
1324 LClosure *f = clLvalue(fi);
1325 TString *name;
1326 Proto *p = f->p;
1327 if (!(cast_uint(n) - 1u < cast_uint(p->sizeupvalues)))
1328 return NULL; /* 'n' not in [1, p->sizeupvalues] */
1329 *val = f->upvals[n-1]->v;
1330 if (owner) *owner = obj2gco(f->upvals[n - 1]);
1331 name = p->upvalues[n-1].name;
1332 return (name == NULL) ? "(no name)" : getstr(name);
1333 }
1334 default: return NULL; /* not a closure */
1335 }
1336}
1337
1338
1339LUA_API const char *lua_getupvalue (lua_State *L, int funcindex, int n) {
1340 const char *name;
1341 TValue *val = NULL; /* to avoid warnings */
1342 lua_lock(L);
1343 name = aux_upvalue(index2value(L, funcindex), n, &val, NULL);
1344 if (name) {
1345 setobj2s(L, L->top, val);
1346 api_incr_top(L);
1347 }
1348 lua_unlock(L);
1349 return name;
1350}
1351
1352
1353LUA_API const char *lua_setupvalue (lua_State *L, int funcindex, int n) {
1354 const char *name;
1355 TValue *val = NULL; /* to avoid warnings */
1356 GCObject *owner = NULL; /* to avoid warnings */
1357 TValue *fi;
1358 lua_lock(L);
1359 fi = index2value(L, funcindex);
1360 api_checknelems(L, 1);
1361 name = aux_upvalue(fi, n, &val, &owner);
1362 if (name) {
1363 L->top--;
1364 setobj(L, val, s2v(L->top));
1365 luaC_barrier(L, owner, val);
1366 }
1367 lua_unlock(L);
1368 return name;
1369}
1370
1371
1372static UpVal **getupvalref (lua_State *L, int fidx, int n, LClosure **pf) {
1373 LClosure *f;
1374 TValue *fi = index2value(L, fidx);
1375 api_check(L, ttisLclosure(fi), "Lua function expected");
1376 f = clLvalue(fi);
1377 api_check(L, (1 <= n && n <= f->p->sizeupvalues), "invalid upvalue index");
1378 if (pf) *pf = f;
1379 return &f->upvals[n - 1]; /* get its upvalue pointer */
1380}
1381
1382
1383LUA_API void *lua_upvalueid (lua_State *L, int fidx, int n) {
1384 TValue *fi = index2value(L, fidx);
1385 switch (ttypetag(fi)) {
1386 case LUA_VLCL: { /* lua closure */
1387 return *getupvalref(L, fidx, n, NULL);
1388 }
1389 case LUA_VCCL: { /* C closure */
1390 CClosure *f = clCvalue(fi);
1391 api_check(L, 1 <= n && n <= f->nupvalues, "invalid upvalue index");
1392 return &f->upvalue[n - 1];
1393 }
1394 default: {
1395 api_check(L, 0, "closure expected");
1396 return NULL;
1397 }
1398 }
1399}
1400
1401
1402LUA_API void lua_upvaluejoin (lua_State *L, int fidx1, int n1,
1403 int fidx2, int n2) {
1404 LClosure *f1;
1405 UpVal **up1 = getupvalref(L, fidx1, n1, &f1);
1406 UpVal **up2 = getupvalref(L, fidx2, n2, NULL);
1407 *up1 = *up2;
1408 luaC_objbarrier(L, f1, *up1);
1409}
1410
1411
diff --git a/src/lua/lapi.h b/src/lua/lapi.h
new file mode 100644
index 0000000..41216b2
--- /dev/null
+++ b/src/lua/lapi.h
@@ -0,0 +1,47 @@
1/*
2** $Id: lapi.h $
3** Auxiliary functions from Lua API
4** See Copyright Notice in lua.h
5*/
6
7#ifndef lapi_h
8#define lapi_h
9
10
11#include "llimits.h"
12#include "lstate.h"
13
14
15/* Increments 'L->top', checking for stack overflows */
16#define api_incr_top(L) {L->top++; api_check(L, L->top <= L->ci->top, \
17 "stack overflow");}
18
19
20/*
21** If a call returns too many multiple returns, the callee may not have
22** stack space to accommodate all results. In this case, this macro
23** increases its stack space ('L->ci->top').
24*/
25#define adjustresults(L,nres) \
26 { if ((nres) <= LUA_MULTRET && L->ci->top < L->top) L->ci->top = L->top; }
27
28
29/* Ensure the stack has at least 'n' elements */
30#define api_checknelems(L,n) api_check(L, (n) < (L->top - L->ci->func), \
31 "not enough elements in the stack")
32
33
34/*
35** To reduce the overhead of returning from C functions, the presence of
36** to-be-closed variables in these functions is coded in the CallInfo's
37** field 'nresults', in a way that functions with no to-be-closed variables
38** with zero, one, or "all" wanted results have no overhead. Functions
39** with other number of wanted results, as well as functions with
40** variables to be closed, have an extra check.
41*/
42
43#define hastocloseCfunc(n) ((n) < LUA_MULTRET)
44
45#define codeNresults(n) (-(n) - 3)
46
47#endif
diff --git a/src/lua/lauxlib.c b/src/lua/lauxlib.c
new file mode 100644
index 0000000..e3d9be3
--- /dev/null
+++ b/src/lua/lauxlib.c
@@ -0,0 +1,1057 @@
1/*
2** $Id: lauxlib.c $
3** Auxiliary functions for building Lua libraries
4** See Copyright Notice in lua.h
5*/
6
7#define lauxlib_c
8#define LUA_LIB
9
10#include "lprefix.h"
11
12
13#include <errno.h>
14#include <stdarg.h>
15#include <stdio.h>
16#include <stdlib.h>
17#include <string.h>
18
19
20/*
21** This file uses only the official API of Lua.
22** Any function declared here could be written as an application function.
23*/
24
25#include "lua.h"
26
27#include "lauxlib.h"
28
29
30#if !defined(MAX_SIZET)
31/* maximum value for size_t */
32#define MAX_SIZET ((size_t)(~(size_t)0))
33#endif
34
35
36/*
37** {======================================================
38** Traceback
39** =======================================================
40*/
41
42
43#define LEVELS1 10 /* size of the first part of the stack */
44#define LEVELS2 11 /* size of the second part of the stack */
45
46
47
48/*
49** Search for 'objidx' in table at index -1. ('objidx' must be an
50** absolute index.) Return 1 + string at top if it found a good name.
51*/
52static int findfield (lua_State *L, int objidx, int level) {
53 if (level == 0 || !lua_istable(L, -1))
54 return 0; /* not found */
55 lua_pushnil(L); /* start 'next' loop */
56 while (lua_next(L, -2)) { /* for each pair in table */
57 if (lua_type(L, -2) == LUA_TSTRING) { /* ignore non-string keys */
58 if (lua_rawequal(L, objidx, -1)) { /* found object? */
59 lua_pop(L, 1); /* remove value (but keep name) */
60 return 1;
61 }
62 else if (findfield(L, objidx, level - 1)) { /* try recursively */
63 /* stack: lib_name, lib_table, field_name (top) */
64 lua_pushliteral(L, "."); /* place '.' between the two names */
65 lua_replace(L, -3); /* (in the slot occupied by table) */
66 lua_concat(L, 3); /* lib_name.field_name */
67 return 1;
68 }
69 }
70 lua_pop(L, 1); /* remove value */
71 }
72 return 0; /* not found */
73}
74
75
76/*
77** Search for a name for a function in all loaded modules
78*/
79static int pushglobalfuncname (lua_State *L, lua_Debug *ar) {
80 int top = lua_gettop(L);
81 lua_getinfo(L, "f", ar); /* push function */
82 lua_getfield(L, LUA_REGISTRYINDEX, LUA_LOADED_TABLE);
83 if (findfield(L, top + 1, 2)) {
84 const char *name = lua_tostring(L, -1);
85 if (strncmp(name, LUA_GNAME ".", 3) == 0) { /* name start with '_G.'? */
86 lua_pushstring(L, name + 3); /* push name without prefix */
87 lua_remove(L, -2); /* remove original name */
88 }
89 lua_copy(L, -1, top + 1); /* copy name to proper place */
90 lua_settop(L, top + 1); /* remove table "loaded" and name copy */
91 return 1;
92 }
93 else {
94 lua_settop(L, top); /* remove function and global table */
95 return 0;
96 }
97}
98
99
100static void pushfuncname (lua_State *L, lua_Debug *ar) {
101 if (pushglobalfuncname(L, ar)) { /* try first a global name */
102 lua_pushfstring(L, "function '%s'", lua_tostring(L, -1));
103 lua_remove(L, -2); /* remove name */
104 }
105 else if (*ar->namewhat != '\0') /* is there a name from code? */
106 lua_pushfstring(L, "%s '%s'", ar->namewhat, ar->name); /* use it */
107 else if (*ar->what == 'm') /* main? */
108 lua_pushliteral(L, "main chunk");
109 else if (*ar->what != 'C') /* for Lua functions, use <file:line> */
110 lua_pushfstring(L, "function <%s:%d>", ar->short_src, ar->linedefined);
111 else /* nothing left... */
112 lua_pushliteral(L, "?");
113}
114
115
116static int lastlevel (lua_State *L) {
117 lua_Debug ar;
118 int li = 1, le = 1;
119 /* find an upper bound */
120 while (lua_getstack(L, le, &ar)) { li = le; le *= 2; }
121 /* do a binary search */
122 while (li < le) {
123 int m = (li + le)/2;
124 if (lua_getstack(L, m, &ar)) li = m + 1;
125 else le = m;
126 }
127 return le - 1;
128}
129
130
131LUALIB_API void luaL_traceback (lua_State *L, lua_State *L1,
132 const char *msg, int level) {
133 luaL_Buffer b;
134 lua_Debug ar;
135 int last = lastlevel(L1);
136 int limit2show = (last - level > LEVELS1 + LEVELS2) ? LEVELS1 : -1;
137 luaL_buffinit(L, &b);
138 if (msg) {
139 luaL_addstring(&b, msg);
140 luaL_addchar(&b, '\n');
141 }
142 luaL_addstring(&b, "stack traceback:");
143 while (lua_getstack(L1, level++, &ar)) {
144 if (limit2show-- == 0) { /* too many levels? */
145 int n = last - level - LEVELS2 + 1; /* number of levels to skip */
146 lua_pushfstring(L, "\n\t...\t(skipping %d levels)", n);
147 luaL_addvalue(&b); /* add warning about skip */
148 level += n; /* and skip to last levels */
149 }
150 else {
151 lua_getinfo(L1, "Slnt", &ar);
152 if (ar.currentline <= 0)
153 lua_pushfstring(L, "\n\t%s: in ", ar.short_src);
154 else
155 lua_pushfstring(L, "\n\t%s:%d: in ", ar.short_src, ar.currentline);
156 luaL_addvalue(&b);
157 pushfuncname(L, &ar);
158 luaL_addvalue(&b);
159 if (ar.istailcall)
160 luaL_addstring(&b, "\n\t(...tail calls...)");
161 }
162 }
163 luaL_pushresult(&b);
164}
165
166/* }====================================================== */
167
168
169/*
170** {======================================================
171** Error-report functions
172** =======================================================
173*/
174
175LUALIB_API int luaL_argerror (lua_State *L, int arg, const char *extramsg) {
176 lua_Debug ar;
177 if (!lua_getstack(L, 0, &ar)) /* no stack frame? */
178 return luaL_error(L, "bad argument #%d (%s)", arg, extramsg);
179 lua_getinfo(L, "n", &ar);
180 if (strcmp(ar.namewhat, "method") == 0) {
181 arg--; /* do not count 'self' */
182 if (arg == 0) /* error is in the self argument itself? */
183 return luaL_error(L, "calling '%s' on bad self (%s)",
184 ar.name, extramsg);
185 }
186 if (ar.name == NULL)
187 ar.name = (pushglobalfuncname(L, &ar)) ? lua_tostring(L, -1) : "?";
188 return luaL_error(L, "bad argument #%d to '%s' (%s)",
189 arg, ar.name, extramsg);
190}
191
192
193int luaL_typeerror (lua_State *L, int arg, const char *tname) {
194 const char *msg;
195 const char *typearg; /* name for the type of the actual argument */
196 if (luaL_getmetafield(L, arg, "__name") == LUA_TSTRING)
197 typearg = lua_tostring(L, -1); /* use the given type name */
198 else if (lua_type(L, arg) == LUA_TLIGHTUSERDATA)
199 typearg = "light userdata"; /* special name for messages */
200 else
201 typearg = luaL_typename(L, arg); /* standard name */
202 msg = lua_pushfstring(L, "%s expected, got %s", tname, typearg);
203 return luaL_argerror(L, arg, msg);
204}
205
206
207static void tag_error (lua_State *L, int arg, int tag) {
208 luaL_typeerror(L, arg, lua_typename(L, tag));
209}
210
211
212/*
213** The use of 'lua_pushfstring' ensures this function does not
214** need reserved stack space when called.
215*/
216LUALIB_API void luaL_where (lua_State *L, int level) {
217 lua_Debug ar;
218 if (lua_getstack(L, level, &ar)) { /* check function at level */
219 lua_getinfo(L, "Sl", &ar); /* get info about it */
220 if (ar.currentline > 0) { /* is there info? */
221 lua_pushfstring(L, "%s:%d: ", ar.short_src, ar.currentline);
222 return;
223 }
224 }
225 lua_pushfstring(L, ""); /* else, no information available... */
226}
227
228
229/*
230** Again, the use of 'lua_pushvfstring' ensures this function does
231** not need reserved stack space when called. (At worst, it generates
232** an error with "stack overflow" instead of the given message.)
233*/
234LUALIB_API int luaL_error (lua_State *L, const char *fmt, ...) {
235 va_list argp;
236 va_start(argp, fmt);
237 luaL_where(L, 1);
238 lua_pushvfstring(L, fmt, argp);
239 va_end(argp);
240 lua_concat(L, 2);
241 return lua_error(L);
242}
243
244
245LUALIB_API int luaL_fileresult (lua_State *L, int stat, const char *fname) {
246 int en = errno; /* calls to Lua API may change this value */
247 if (stat) {
248 lua_pushboolean(L, 1);
249 return 1;
250 }
251 else {
252 luaL_pushfail(L);
253 if (fname)
254 lua_pushfstring(L, "%s: %s", fname, strerror(en));
255 else
256 lua_pushstring(L, strerror(en));
257 lua_pushinteger(L, en);
258 return 3;
259 }
260}
261
262
263#if !defined(l_inspectstat) /* { */
264
265#if defined(LUA_USE_POSIX)
266
267#include <sys/wait.h>
268
269/*
270** use appropriate macros to interpret 'pclose' return status
271*/
272#define l_inspectstat(stat,what) \
273 if (WIFEXITED(stat)) { stat = WEXITSTATUS(stat); } \
274 else if (WIFSIGNALED(stat)) { stat = WTERMSIG(stat); what = "signal"; }
275
276#else
277
278#define l_inspectstat(stat,what) /* no op */
279
280#endif
281
282#endif /* } */
283
284
285LUALIB_API int luaL_execresult (lua_State *L, int stat) {
286 const char *what = "exit"; /* type of termination */
287 if (stat != 0 && errno != 0) /* error with an 'errno'? */
288 return luaL_fileresult(L, 0, NULL);
289 else {
290 l_inspectstat(stat, what); /* interpret result */
291 if (*what == 'e' && stat == 0) /* successful termination? */
292 lua_pushboolean(L, 1);
293 else
294 luaL_pushfail(L);
295 lua_pushstring(L, what);
296 lua_pushinteger(L, stat);
297 return 3; /* return true/fail,what,code */
298 }
299}
300
301/* }====================================================== */
302
303
304
305/*
306** {======================================================
307** Userdata's metatable manipulation
308** =======================================================
309*/
310
311LUALIB_API int luaL_newmetatable (lua_State *L, const char *tname) {
312 if (luaL_getmetatable(L, tname) != LUA_TNIL) /* name already in use? */
313 return 0; /* leave previous value on top, but return 0 */
314 lua_pop(L, 1);
315 lua_createtable(L, 0, 2); /* create metatable */
316 lua_pushstring(L, tname);
317 lua_setfield(L, -2, "__name"); /* metatable.__name = tname */
318 lua_pushvalue(L, -1);
319 lua_setfield(L, LUA_REGISTRYINDEX, tname); /* registry.name = metatable */
320 return 1;
321}
322
323
324LUALIB_API void luaL_setmetatable (lua_State *L, const char *tname) {
325 luaL_getmetatable(L, tname);
326 lua_setmetatable(L, -2);
327}
328
329
330LUALIB_API void *luaL_testudata (lua_State *L, int ud, const char *tname) {
331 void *p = lua_touserdata(L, ud);
332 if (p != NULL) { /* value is a userdata? */
333 if (lua_getmetatable(L, ud)) { /* does it have a metatable? */
334 luaL_getmetatable(L, tname); /* get correct metatable */
335 if (!lua_rawequal(L, -1, -2)) /* not the same? */
336 p = NULL; /* value is a userdata with wrong metatable */
337 lua_pop(L, 2); /* remove both metatables */
338 return p;
339 }
340 }
341 return NULL; /* value is not a userdata with a metatable */
342}
343
344
345LUALIB_API void *luaL_checkudata (lua_State *L, int ud, const char *tname) {
346 void *p = luaL_testudata(L, ud, tname);
347 luaL_argexpected(L, p != NULL, ud, tname);
348 return p;
349}
350
351/* }====================================================== */
352
353
354/*
355** {======================================================
356** Argument check functions
357** =======================================================
358*/
359
360LUALIB_API int luaL_checkoption (lua_State *L, int arg, const char *def,
361 const char *const lst[]) {
362 const char *name = (def) ? luaL_optstring(L, arg, def) :
363 luaL_checkstring(L, arg);
364 int i;
365 for (i=0; lst[i]; i++)
366 if (strcmp(lst[i], name) == 0)
367 return i;
368 return luaL_argerror(L, arg,
369 lua_pushfstring(L, "invalid option '%s'", name));
370}
371
372
373/*
374** Ensures the stack has at least 'space' extra slots, raising an error
375** if it cannot fulfill the request. (The error handling needs a few
376** extra slots to format the error message. In case of an error without
377** this extra space, Lua will generate the same 'stack overflow' error,
378** but without 'msg'.)
379*/
380LUALIB_API void luaL_checkstack (lua_State *L, int space, const char *msg) {
381 if (!lua_checkstack(L, space)) {
382 if (msg)
383 luaL_error(L, "stack overflow (%s)", msg);
384 else
385 luaL_error(L, "stack overflow");
386 }
387}
388
389
390LUALIB_API void luaL_checktype (lua_State *L, int arg, int t) {
391 if (lua_type(L, arg) != t)
392 tag_error(L, arg, t);
393}
394
395
396LUALIB_API void luaL_checkany (lua_State *L, int arg) {
397 if (lua_type(L, arg) == LUA_TNONE)
398 luaL_argerror(L, arg, "value expected");
399}
400
401
402LUALIB_API const char *luaL_checklstring (lua_State *L, int arg, size_t *len) {
403 const char *s = lua_tolstring(L, arg, len);
404 if (!s) tag_error(L, arg, LUA_TSTRING);
405 return s;
406}
407
408
409LUALIB_API const char *luaL_optlstring (lua_State *L, int arg,
410 const char *def, size_t *len) {
411 if (lua_isnoneornil(L, arg)) {
412 if (len)
413 *len = (def ? strlen(def) : 0);
414 return def;
415 }
416 else return luaL_checklstring(L, arg, len);
417}
418
419
420LUALIB_API lua_Number luaL_checknumber (lua_State *L, int arg) {
421 int isnum;
422 lua_Number d = lua_tonumberx(L, arg, &isnum);
423 if (!isnum)
424 tag_error(L, arg, LUA_TNUMBER);
425 return d;
426}
427
428
429LUALIB_API lua_Number luaL_optnumber (lua_State *L, int arg, lua_Number def) {
430 return luaL_opt(L, luaL_checknumber, arg, def);
431}
432
433
434static void interror (lua_State *L, int arg) {
435 if (lua_isnumber(L, arg))
436 luaL_argerror(L, arg, "number has no integer representation");
437 else
438 tag_error(L, arg, LUA_TNUMBER);
439}
440
441
442LUALIB_API lua_Integer luaL_checkinteger (lua_State *L, int arg) {
443 int isnum;
444 lua_Integer d = lua_tointegerx(L, arg, &isnum);
445 if (!isnum) {
446 interror(L, arg);
447 }
448 return d;
449}
450
451
452LUALIB_API lua_Integer luaL_optinteger (lua_State *L, int arg,
453 lua_Integer def) {
454 return luaL_opt(L, luaL_checkinteger, arg, def);
455}
456
457/* }====================================================== */
458
459
460/*
461** {======================================================
462** Generic Buffer manipulation
463** =======================================================
464*/
465
466/* userdata to box arbitrary data */
467typedef struct UBox {
468 void *box;
469 size_t bsize;
470} UBox;
471
472
473static void *resizebox (lua_State *L, int idx, size_t newsize) {
474 void *ud;
475 lua_Alloc allocf = lua_getallocf(L, &ud);
476 UBox *box = (UBox *)lua_touserdata(L, idx);
477 void *temp = allocf(ud, box->box, box->bsize, newsize);
478 if (temp == NULL && newsize > 0) /* allocation error? */
479 luaL_error(L, "not enough memory");
480 box->box = temp;
481 box->bsize = newsize;
482 return temp;
483}
484
485
486static int boxgc (lua_State *L) {
487 resizebox(L, 1, 0);
488 return 0;
489}
490
491
492static const luaL_Reg boxmt[] = { /* box metamethods */
493 {"__gc", boxgc},
494 {"__close", boxgc},
495 {NULL, NULL}
496};
497
498
499static void newbox (lua_State *L) {
500 UBox *box = (UBox *)lua_newuserdatauv(L, sizeof(UBox), 0);
501 box->box = NULL;
502 box->bsize = 0;
503 if (luaL_newmetatable(L, "_UBOX*")) /* creating metatable? */
504 luaL_setfuncs(L, boxmt, 0); /* set its metamethods */
505 lua_setmetatable(L, -2);
506}
507
508
509/*
510** check whether buffer is using a userdata on the stack as a temporary
511** buffer
512*/
513#define buffonstack(B) ((B)->b != (B)->init.b)
514
515
516/*
517** Compute new size for buffer 'B', enough to accommodate extra 'sz'
518** bytes.
519*/
520static size_t newbuffsize (luaL_Buffer *B, size_t sz) {
521 size_t newsize = B->size * 2; /* double buffer size */
522 if (MAX_SIZET - sz < B->n) /* overflow in (B->n + sz)? */
523 return luaL_error(B->L, "buffer too large");
524 if (newsize < B->n + sz) /* double is not big enough? */
525 newsize = B->n + sz;
526 return newsize;
527}
528
529
530/*
531** Returns a pointer to a free area with at least 'sz' bytes in buffer
532** 'B'. 'boxidx' is the relative position in the stack where the
533** buffer's box is or should be.
534*/
535static char *prepbuffsize (luaL_Buffer *B, size_t sz, int boxidx) {
536 if (B->size - B->n >= sz) /* enough space? */
537 return B->b + B->n;
538 else {
539 lua_State *L = B->L;
540 char *newbuff;
541 size_t newsize = newbuffsize(B, sz);
542 /* create larger buffer */
543 if (buffonstack(B)) /* buffer already has a box? */
544 newbuff = (char *)resizebox(L, boxidx, newsize); /* resize it */
545 else { /* no box yet */
546 lua_pushnil(L); /* reserve slot for final result */
547 newbox(L); /* create a new box */
548 /* move box (and slot) to its intended position */
549 lua_rotate(L, boxidx - 1, 2);
550 lua_toclose(L, boxidx);
551 newbuff = (char *)resizebox(L, boxidx, newsize);
552 memcpy(newbuff, B->b, B->n * sizeof(char)); /* copy original content */
553 }
554 B->b = newbuff;
555 B->size = newsize;
556 return newbuff + B->n;
557 }
558}
559
560/*
561** returns a pointer to a free area with at least 'sz' bytes
562*/
563LUALIB_API char *luaL_prepbuffsize (luaL_Buffer *B, size_t sz) {
564 return prepbuffsize(B, sz, -1);
565}
566
567
568LUALIB_API void luaL_addlstring (luaL_Buffer *B, const char *s, size_t l) {
569 if (l > 0) { /* avoid 'memcpy' when 's' can be NULL */
570 char *b = prepbuffsize(B, l, -1);
571 memcpy(b, s, l * sizeof(char));
572 luaL_addsize(B, l);
573 }
574}
575
576
577LUALIB_API void luaL_addstring (luaL_Buffer *B, const char *s) {
578 luaL_addlstring(B, s, strlen(s));
579}
580
581
582LUALIB_API void luaL_pushresult (luaL_Buffer *B) {
583 lua_State *L = B->L;
584 lua_pushlstring(L, B->b, B->n);
585 if (buffonstack(B)) {
586 lua_copy(L, -1, -3); /* move string to reserved slot */
587 lua_pop(L, 2); /* pop string and box (closing the box) */
588 }
589}
590
591
592LUALIB_API void luaL_pushresultsize (luaL_Buffer *B, size_t sz) {
593 luaL_addsize(B, sz);
594 luaL_pushresult(B);
595}
596
597
598/*
599** 'luaL_addvalue' is the only function in the Buffer system where the
600** box (if existent) is not on the top of the stack. So, instead of
601** calling 'luaL_addlstring', it replicates the code using -2 as the
602** last argument to 'prepbuffsize', signaling that the box is (or will
603** be) bellow the string being added to the buffer. (Box creation can
604** trigger an emergency GC, so we should not remove the string from the
605** stack before we have the space guaranteed.)
606*/
607LUALIB_API void luaL_addvalue (luaL_Buffer *B) {
608 lua_State *L = B->L;
609 size_t len;
610 const char *s = lua_tolstring(L, -1, &len);
611 char *b = prepbuffsize(B, len, -2);
612 memcpy(b, s, len * sizeof(char));
613 luaL_addsize(B, len);
614 lua_pop(L, 1); /* pop string */
615}
616
617
618LUALIB_API void luaL_buffinit (lua_State *L, luaL_Buffer *B) {
619 B->L = L;
620 B->b = B->init.b;
621 B->n = 0;
622 B->size = LUAL_BUFFERSIZE;
623}
624
625
626LUALIB_API char *luaL_buffinitsize (lua_State *L, luaL_Buffer *B, size_t sz) {
627 luaL_buffinit(L, B);
628 return prepbuffsize(B, sz, -1);
629}
630
631/* }====================================================== */
632
633
634/*
635** {======================================================
636** Reference system
637** =======================================================
638*/
639
640/* index of free-list header */
641#define freelist 0
642
643
644LUALIB_API int luaL_ref (lua_State *L, int t) {
645 int ref;
646 if (lua_isnil(L, -1)) {
647 lua_pop(L, 1); /* remove from stack */
648 return LUA_REFNIL; /* 'nil' has a unique fixed reference */
649 }
650 t = lua_absindex(L, t);
651 lua_rawgeti(L, t, freelist); /* get first free element */
652 ref = (int)lua_tointeger(L, -1); /* ref = t[freelist] */
653 lua_pop(L, 1); /* remove it from stack */
654 if (ref != 0) { /* any free element? */
655 lua_rawgeti(L, t, ref); /* remove it from list */
656 lua_rawseti(L, t, freelist); /* (t[freelist] = t[ref]) */
657 }
658 else /* no free elements */
659 ref = (int)lua_rawlen(L, t) + 1; /* get a new reference */
660 lua_rawseti(L, t, ref);
661 return ref;
662}
663
664
665LUALIB_API void luaL_unref (lua_State *L, int t, int ref) {
666 if (ref >= 0) {
667 t = lua_absindex(L, t);
668 lua_rawgeti(L, t, freelist);
669 lua_rawseti(L, t, ref); /* t[ref] = t[freelist] */
670 lua_pushinteger(L, ref);
671 lua_rawseti(L, t, freelist); /* t[freelist] = ref */
672 }
673}
674
675/* }====================================================== */
676
677
678/*
679** {======================================================
680** Load functions
681** =======================================================
682*/
683
684typedef struct LoadF {
685 int n; /* number of pre-read characters */
686 FILE *f; /* file being read */
687 char buff[BUFSIZ]; /* area for reading file */
688} LoadF;
689
690
691static const char *getF (lua_State *L, void *ud, size_t *size) {
692 LoadF *lf = (LoadF *)ud;
693 (void)L; /* not used */
694 if (lf->n > 0) { /* are there pre-read characters to be read? */
695 *size = lf->n; /* return them (chars already in buffer) */
696 lf->n = 0; /* no more pre-read characters */
697 }
698 else { /* read a block from file */
699 /* 'fread' can return > 0 *and* set the EOF flag. If next call to
700 'getF' called 'fread', it might still wait for user input.
701 The next check avoids this problem. */
702 if (feof(lf->f)) return NULL;
703 *size = fread(lf->buff, 1, sizeof(lf->buff), lf->f); /* read block */
704 }
705 return lf->buff;
706}
707
708
709static int errfile (lua_State *L, const char *what, int fnameindex) {
710 const char *serr = strerror(errno);
711 const char *filename = lua_tostring(L, fnameindex) + 1;
712 lua_pushfstring(L, "cannot %s %s: %s", what, filename, serr);
713 lua_remove(L, fnameindex);
714 return LUA_ERRFILE;
715}
716
717
718static int skipBOM (LoadF *lf) {
719 const char *p = "\xEF\xBB\xBF"; /* UTF-8 BOM mark */
720 int c;
721 lf->n = 0;
722 do {
723 c = getc(lf->f);
724 if (c == EOF || c != *(const unsigned char *)p++) return c;
725 lf->buff[lf->n++] = c; /* to be read by the parser */
726 } while (*p != '\0');
727 lf->n = 0; /* prefix matched; discard it */
728 return getc(lf->f); /* return next character */
729}
730
731
732/*
733** reads the first character of file 'f' and skips an optional BOM mark
734** in its beginning plus its first line if it starts with '#'. Returns
735** true if it skipped the first line. In any case, '*cp' has the
736** first "valid" character of the file (after the optional BOM and
737** a first-line comment).
738*/
739static int skipcomment (LoadF *lf, int *cp) {
740 int c = *cp = skipBOM(lf);
741 if (c == '#') { /* first line is a comment (Unix exec. file)? */
742 do { /* skip first line */
743 c = getc(lf->f);
744 } while (c != EOF && c != '\n');
745 *cp = getc(lf->f); /* skip end-of-line, if present */
746 return 1; /* there was a comment */
747 }
748 else return 0; /* no comment */
749}
750
751
752LUALIB_API int luaL_loadfilex (lua_State *L, const char *filename,
753 const char *mode) {
754 LoadF lf;
755 int status, readstatus;
756 int c;
757 int fnameindex = lua_gettop(L) + 1; /* index of filename on the stack */
758 if (filename == NULL) {
759 lua_pushliteral(L, "=stdin");
760 lf.f = stdin;
761 }
762 else {
763 lua_pushfstring(L, "@%s", filename);
764 lf.f = fopen(filename, "r");
765 if (lf.f == NULL) return errfile(L, "open", fnameindex);
766 }
767 if (skipcomment(&lf, &c)) /* read initial portion */
768 lf.buff[lf.n++] = '\n'; /* add line to correct line numbers */
769 if (c == LUA_SIGNATURE[0] && filename) { /* binary file? */
770 lf.f = freopen(filename, "rb", lf.f); /* reopen in binary mode */
771 if (lf.f == NULL) return errfile(L, "reopen", fnameindex);
772 skipcomment(&lf, &c); /* re-read initial portion */
773 }
774 if (c != EOF)
775 lf.buff[lf.n++] = c; /* 'c' is the first character of the stream */
776 status = lua_load(L, getF, &lf, lua_tostring(L, -1), mode);
777 readstatus = ferror(lf.f);
778 if (filename) fclose(lf.f); /* close file (even in case of errors) */
779 if (readstatus) {
780 lua_settop(L, fnameindex); /* ignore results from 'lua_load' */
781 return errfile(L, "read", fnameindex);
782 }
783 lua_remove(L, fnameindex);
784 return status;
785}
786
787
788typedef struct LoadS {
789 const char *s;
790 size_t size;
791} LoadS;
792
793
794static const char *getS (lua_State *L, void *ud, size_t *size) {
795 LoadS *ls = (LoadS *)ud;
796 (void)L; /* not used */
797 if (ls->size == 0) return NULL;
798 *size = ls->size;
799 ls->size = 0;
800 return ls->s;
801}
802
803
804LUALIB_API int luaL_loadbufferx (lua_State *L, const char *buff, size_t size,
805 const char *name, const char *mode) {
806 LoadS ls;
807 ls.s = buff;
808 ls.size = size;
809 return lua_load(L, getS, &ls, name, mode);
810}
811
812
813LUALIB_API int luaL_loadstring (lua_State *L, const char *s) {
814 return luaL_loadbuffer(L, s, strlen(s), s);
815}
816
817/* }====================================================== */
818
819
820
821LUALIB_API int luaL_getmetafield (lua_State *L, int obj, const char *event) {
822 if (!lua_getmetatable(L, obj)) /* no metatable? */
823 return LUA_TNIL;
824 else {
825 int tt;
826 lua_pushstring(L, event);
827 tt = lua_rawget(L, -2);
828 if (tt == LUA_TNIL) /* is metafield nil? */
829 lua_pop(L, 2); /* remove metatable and metafield */
830 else
831 lua_remove(L, -2); /* remove only metatable */
832 return tt; /* return metafield type */
833 }
834}
835
836
837LUALIB_API int luaL_callmeta (lua_State *L, int obj, const char *event) {
838 obj = lua_absindex(L, obj);
839 if (luaL_getmetafield(L, obj, event) == LUA_TNIL) /* no metafield? */
840 return 0;
841 lua_pushvalue(L, obj);
842 lua_call(L, 1, 1);
843 return 1;
844}
845
846
847LUALIB_API lua_Integer luaL_len (lua_State *L, int idx) {
848 lua_Integer l;
849 int isnum;
850 lua_len(L, idx);
851 l = lua_tointegerx(L, -1, &isnum);
852 if (!isnum)
853 luaL_error(L, "object length is not an integer");
854 lua_pop(L, 1); /* remove object */
855 return l;
856}
857
858
859LUALIB_API const char *luaL_tolstring (lua_State *L, int idx, size_t *len) {
860 if (luaL_callmeta(L, idx, "__tostring")) { /* metafield? */
861 if (!lua_isstring(L, -1))
862 luaL_error(L, "'__tostring' must return a string");
863 }
864 else {
865 switch (lua_type(L, idx)) {
866 case LUA_TNUMBER: {
867 if (lua_isinteger(L, idx))
868 lua_pushfstring(L, "%I", (LUAI_UACINT)lua_tointeger(L, idx));
869 else
870 lua_pushfstring(L, "%f", (LUAI_UACNUMBER)lua_tonumber(L, idx));
871 break;
872 }
873 case LUA_TSTRING:
874 lua_pushvalue(L, idx);
875 break;
876 case LUA_TBOOLEAN:
877 lua_pushstring(L, (lua_toboolean(L, idx) ? "true" : "false"));
878 break;
879 case LUA_TNIL:
880 lua_pushliteral(L, "nil");
881 break;
882 default: {
883 int tt = luaL_getmetafield(L, idx, "__name"); /* try name */
884 const char *kind = (tt == LUA_TSTRING) ? lua_tostring(L, -1) :
885 luaL_typename(L, idx);
886 lua_pushfstring(L, "%s: %p", kind, lua_topointer(L, idx));
887 if (tt != LUA_TNIL)
888 lua_remove(L, -2); /* remove '__name' */
889 break;
890 }
891 }
892 }
893 return lua_tolstring(L, -1, len);
894}
895
896
897/*
898** set functions from list 'l' into table at top - 'nup'; each
899** function gets the 'nup' elements at the top as upvalues.
900** Returns with only the table at the stack.
901*/
902LUALIB_API void luaL_setfuncs (lua_State *L, const luaL_Reg *l, int nup) {
903 luaL_checkstack(L, nup, "too many upvalues");
904 for (; l->name != NULL; l++) { /* fill the table with given functions */
905 if (l->func == NULL) /* place holder? */
906 lua_pushboolean(L, 0);
907 else {
908 int i;
909 for (i = 0; i < nup; i++) /* copy upvalues to the top */
910 lua_pushvalue(L, -nup);
911 lua_pushcclosure(L, l->func, nup); /* closure with those upvalues */
912 }
913 lua_setfield(L, -(nup + 2), l->name);
914 }
915 lua_pop(L, nup); /* remove upvalues */
916}
917
918
919/*
920** ensure that stack[idx][fname] has a table and push that table
921** into the stack
922*/
923LUALIB_API int luaL_getsubtable (lua_State *L, int idx, const char *fname) {
924 if (lua_getfield(L, idx, fname) == LUA_TTABLE)
925 return 1; /* table already there */
926 else {
927 lua_pop(L, 1); /* remove previous result */
928 idx = lua_absindex(L, idx);
929 lua_newtable(L);
930 lua_pushvalue(L, -1); /* copy to be left at top */
931 lua_setfield(L, idx, fname); /* assign new table to field */
932 return 0; /* false, because did not find table there */
933 }
934}
935
936
937/*
938** Stripped-down 'require': After checking "loaded" table, calls 'openf'
939** to open a module, registers the result in 'package.loaded' table and,
940** if 'glb' is true, also registers the result in the global table.
941** Leaves resulting module on the top.
942*/
943LUALIB_API void luaL_requiref (lua_State *L, const char *modname,
944 lua_CFunction openf, int glb) {
945 luaL_getsubtable(L, LUA_REGISTRYINDEX, LUA_LOADED_TABLE);
946 lua_getfield(L, -1, modname); /* LOADED[modname] */
947 if (!lua_toboolean(L, -1)) { /* package not already loaded? */
948 lua_pop(L, 1); /* remove field */
949 lua_pushcfunction(L, openf);
950 lua_pushstring(L, modname); /* argument to open function */
951 lua_call(L, 1, 1); /* call 'openf' to open module */
952 lua_pushvalue(L, -1); /* make copy of module (call result) */
953 lua_setfield(L, -3, modname); /* LOADED[modname] = module */
954 }
955 lua_remove(L, -2); /* remove LOADED table */
956 if (glb) {
957 lua_pushvalue(L, -1); /* copy of module */
958 lua_setglobal(L, modname); /* _G[modname] = module */
959 }
960}
961
962
963LUALIB_API void luaL_addgsub (luaL_Buffer *b, const char *s,
964 const char *p, const char *r) {
965 const char *wild;
966 size_t l = strlen(p);
967 while ((wild = strstr(s, p)) != NULL) {
968 luaL_addlstring(b, s, wild - s); /* push prefix */
969 luaL_addstring(b, r); /* push replacement in place of pattern */
970 s = wild + l; /* continue after 'p' */
971 }
972 luaL_addstring(b, s); /* push last suffix */
973}
974
975
976LUALIB_API const char *luaL_gsub (lua_State *L, const char *s,
977 const char *p, const char *r) {
978 luaL_Buffer b;
979 luaL_buffinit(L, &b);
980 luaL_addgsub(&b, s, p, r);
981 luaL_pushresult(&b);
982 return lua_tostring(L, -1);
983}
984
985
986static void *l_alloc (void *ud, void *ptr, size_t osize, size_t nsize) {
987 (void)ud; (void)osize; /* not used */
988 if (nsize == 0) {
989 free(ptr);
990 return NULL;
991 }
992 else
993 return realloc(ptr, nsize);
994}
995
996
997static int panic (lua_State *L) {
998 const char *msg = lua_tostring(L, -1);
999 if (msg == NULL) msg = "error object is not a string";
1000 lua_writestringerror("PANIC: unprotected error in call to Lua API (%s)\n",
1001 msg);
1002 return 0; /* return to Lua to abort */
1003}
1004
1005
1006/*
1007** Emit a warning. '*warnstate' means:
1008** 0 - warning system is off;
1009** 1 - ready to start a new message;
1010** 2 - previous message is to be continued.
1011*/
1012static void warnf (void *ud, const char *message, int tocont) {
1013 int *warnstate = (int *)ud;
1014 if (*warnstate != 2 && !tocont && *message == '@') { /* control message? */
1015 if (strcmp(message, "@off") == 0)
1016 *warnstate = 0;
1017 else if (strcmp(message, "@on") == 0)
1018 *warnstate = 1;
1019 return;
1020 }
1021 else if (*warnstate == 0) /* warnings off? */
1022 return;
1023 if (*warnstate == 1) /* previous message was the last? */
1024 lua_writestringerror("%s", "Lua warning: "); /* start a new warning */
1025 lua_writestringerror("%s", message); /* write message */
1026 if (tocont) /* not the last part? */
1027 *warnstate = 2; /* to be continued */
1028 else { /* last part */
1029 lua_writestringerror("%s", "\n"); /* finish message with end-of-line */
1030 *warnstate = 1; /* ready to start a new message */
1031 }
1032}
1033
1034
1035LUALIB_API lua_State *luaL_newstate (void) {
1036 lua_State *L = lua_newstate(l_alloc, NULL);
1037 if (L) {
1038 int *warnstate; /* space for warning state */
1039 lua_atpanic(L, &panic);
1040 warnstate = (int *)lua_newuserdatauv(L, sizeof(int), 0);
1041 luaL_ref(L, LUA_REGISTRYINDEX); /* make sure it won't be collected */
1042 *warnstate = 0; /* default is warnings off */
1043 lua_setwarnf(L, warnf, warnstate);
1044 }
1045 return L;
1046}
1047
1048
1049LUALIB_API void luaL_checkversion_ (lua_State *L, lua_Number ver, size_t sz) {
1050 lua_Number v = lua_version(L);
1051 if (sz != LUAL_NUMSIZES) /* check numeric types */
1052 luaL_error(L, "core and library have incompatible numeric types");
1053 else if (v != ver)
1054 luaL_error(L, "version mismatch: app. needs %f, Lua core provides %f",
1055 (LUAI_UACNUMBER)ver, (LUAI_UACNUMBER)v);
1056}
1057
diff --git a/src/lua/lauxlib.h b/src/lua/lauxlib.h
new file mode 100644
index 0000000..59fef6a
--- /dev/null
+++ b/src/lua/lauxlib.h
@@ -0,0 +1,276 @@
1/*
2** $Id: lauxlib.h $
3** Auxiliary functions for building Lua libraries
4** See Copyright Notice in lua.h
5*/
6
7
8#ifndef lauxlib_h
9#define lauxlib_h
10
11
12#include <stddef.h>
13#include <stdio.h>
14
15#include "lua.h"
16
17
18/* global table */
19#define LUA_GNAME "_G"
20
21
22typedef struct luaL_Buffer luaL_Buffer;
23
24
25/* extra error code for 'luaL_loadfilex' */
26#define LUA_ERRFILE (LUA_ERRERR+1)
27
28
29/* key, in the registry, for table of loaded modules */
30#define LUA_LOADED_TABLE "_LOADED"
31
32
33/* key, in the registry, for table of preloaded loaders */
34#define LUA_PRELOAD_TABLE "_PRELOAD"
35
36
37typedef struct luaL_Reg {
38 const char *name;
39 lua_CFunction func;
40} luaL_Reg;
41
42
43#define LUAL_NUMSIZES (sizeof(lua_Integer)*16 + sizeof(lua_Number))
44
45LUALIB_API void (luaL_checkversion_) (lua_State *L, lua_Number ver, size_t sz);
46#define luaL_checkversion(L) \
47 luaL_checkversion_(L, LUA_VERSION_NUM, LUAL_NUMSIZES)
48
49LUALIB_API int (luaL_getmetafield) (lua_State *L, int obj, const char *e);
50LUALIB_API int (luaL_callmeta) (lua_State *L, int obj, const char *e);
51LUALIB_API const char *(luaL_tolstring) (lua_State *L, int idx, size_t *len);
52LUALIB_API int (luaL_argerror) (lua_State *L, int arg, const char *extramsg);
53LUALIB_API int (luaL_typeerror) (lua_State *L, int arg, const char *tname);
54LUALIB_API const char *(luaL_checklstring) (lua_State *L, int arg,
55 size_t *l);
56LUALIB_API const char *(luaL_optlstring) (lua_State *L, int arg,
57 const char *def, size_t *l);
58LUALIB_API lua_Number (luaL_checknumber) (lua_State *L, int arg);
59LUALIB_API lua_Number (luaL_optnumber) (lua_State *L, int arg, lua_Number def);
60
61LUALIB_API lua_Integer (luaL_checkinteger) (lua_State *L, int arg);
62LUALIB_API lua_Integer (luaL_optinteger) (lua_State *L, int arg,
63 lua_Integer def);
64
65LUALIB_API void (luaL_checkstack) (lua_State *L, int sz, const char *msg);
66LUALIB_API void (luaL_checktype) (lua_State *L, int arg, int t);
67LUALIB_API void (luaL_checkany) (lua_State *L, int arg);
68
69LUALIB_API int (luaL_newmetatable) (lua_State *L, const char *tname);
70LUALIB_API void (luaL_setmetatable) (lua_State *L, const char *tname);
71LUALIB_API void *(luaL_testudata) (lua_State *L, int ud, const char *tname);
72LUALIB_API void *(luaL_checkudata) (lua_State *L, int ud, const char *tname);
73
74LUALIB_API void (luaL_where) (lua_State *L, int lvl);
75LUALIB_API int (luaL_error) (lua_State *L, const char *fmt, ...);
76
77LUALIB_API int (luaL_checkoption) (lua_State *L, int arg, const char *def,
78 const char *const lst[]);
79
80LUALIB_API int (luaL_fileresult) (lua_State *L, int stat, const char *fname);
81LUALIB_API int (luaL_execresult) (lua_State *L, int stat);
82
83
84/* predefined references */
85#define LUA_NOREF (-2)
86#define LUA_REFNIL (-1)
87
88LUALIB_API int (luaL_ref) (lua_State *L, int t);
89LUALIB_API void (luaL_unref) (lua_State *L, int t, int ref);
90
91LUALIB_API int (luaL_loadfilex) (lua_State *L, const char *filename,
92 const char *mode);
93
94#define luaL_loadfile(L,f) luaL_loadfilex(L,f,NULL)
95
96LUALIB_API int (luaL_loadbufferx) (lua_State *L, const char *buff, size_t sz,
97 const char *name, const char *mode);
98LUALIB_API int (luaL_loadstring) (lua_State *L, const char *s);
99
100LUALIB_API lua_State *(luaL_newstate) (void);
101
102LUALIB_API lua_Integer (luaL_len) (lua_State *L, int idx);
103
104LUALIB_API void luaL_addgsub (luaL_Buffer *b, const char *s,
105 const char *p, const char *r);
106LUALIB_API const char *(luaL_gsub) (lua_State *L, const char *s,
107 const char *p, const char *r);
108
109LUALIB_API void (luaL_setfuncs) (lua_State *L, const luaL_Reg *l, int nup);
110
111LUALIB_API int (luaL_getsubtable) (lua_State *L, int idx, const char *fname);
112
113LUALIB_API void (luaL_traceback) (lua_State *L, lua_State *L1,
114 const char *msg, int level);
115
116LUALIB_API void (luaL_requiref) (lua_State *L, const char *modname,
117 lua_CFunction openf, int glb);
118
119/*
120** ===============================================================
121** some useful macros
122** ===============================================================
123*/
124
125
126#define luaL_newlibtable(L,l) \
127 lua_createtable(L, 0, sizeof(l)/sizeof((l)[0]) - 1)
128
129#define luaL_newlib(L,l) \
130 (luaL_checkversion(L), luaL_newlibtable(L,l), luaL_setfuncs(L,l,0))
131
132#define luaL_argcheck(L, cond,arg,extramsg) \
133 ((void)((cond) || luaL_argerror(L, (arg), (extramsg))))
134
135#define luaL_argexpected(L,cond,arg,tname) \
136 ((void)((cond) || luaL_typeerror(L, (arg), (tname))))
137
138#define luaL_checkstring(L,n) (luaL_checklstring(L, (n), NULL))
139#define luaL_optstring(L,n,d) (luaL_optlstring(L, (n), (d), NULL))
140
141#define luaL_typename(L,i) lua_typename(L, lua_type(L,(i)))
142
143#define luaL_dofile(L, fn) \
144 (luaL_loadfile(L, fn) || lua_pcall(L, 0, LUA_MULTRET, 0))
145
146#define luaL_dostring(L, s) \
147 (luaL_loadstring(L, s) || lua_pcall(L, 0, LUA_MULTRET, 0))
148
149#define luaL_getmetatable(L,n) (lua_getfield(L, LUA_REGISTRYINDEX, (n)))
150
151#define luaL_opt(L,f,n,d) (lua_isnoneornil(L,(n)) ? (d) : f(L,(n)))
152
153#define luaL_loadbuffer(L,s,sz,n) luaL_loadbufferx(L,s,sz,n,NULL)
154
155
156/* push the value used to represent failure/error */
157#define luaL_pushfail(L) lua_pushnil(L)
158
159
160/*
161** {======================================================
162** Generic Buffer manipulation
163** =======================================================
164*/
165
166struct luaL_Buffer {
167 char *b; /* buffer address */
168 size_t size; /* buffer size */
169 size_t n; /* number of characters in buffer */
170 lua_State *L;
171 union {
172 LUAI_MAXALIGN; /* ensure maximum alignment for buffer */
173 char b[LUAL_BUFFERSIZE]; /* initial buffer */
174 } init;
175};
176
177
178#define luaL_bufflen(bf) ((bf)->n)
179#define luaL_buffaddr(bf) ((bf)->b)
180
181
182#define luaL_addchar(B,c) \
183 ((void)((B)->n < (B)->size || luaL_prepbuffsize((B), 1)), \
184 ((B)->b[(B)->n++] = (c)))
185
186#define luaL_addsize(B,s) ((B)->n += (s))
187
188#define luaL_buffsub(B,s) ((B)->n -= (s))
189
190LUALIB_API void (luaL_buffinit) (lua_State *L, luaL_Buffer *B);
191LUALIB_API char *(luaL_prepbuffsize) (luaL_Buffer *B, size_t sz);
192LUALIB_API void (luaL_addlstring) (luaL_Buffer *B, const char *s, size_t l);
193LUALIB_API void (luaL_addstring) (luaL_Buffer *B, const char *s);
194LUALIB_API void (luaL_addvalue) (luaL_Buffer *B);
195LUALIB_API void (luaL_pushresult) (luaL_Buffer *B);
196LUALIB_API void (luaL_pushresultsize) (luaL_Buffer *B, size_t sz);
197LUALIB_API char *(luaL_buffinitsize) (lua_State *L, luaL_Buffer *B, size_t sz);
198
199#define luaL_prepbuffer(B) luaL_prepbuffsize(B, LUAL_BUFFERSIZE)
200
201/* }====================================================== */
202
203
204
205/*
206** {======================================================
207** File handles for IO library
208** =======================================================
209*/
210
211/*
212** A file handle is a userdata with metatable 'LUA_FILEHANDLE' and
213** initial structure 'luaL_Stream' (it may contain other fields
214** after that initial structure).
215*/
216
217#define LUA_FILEHANDLE "FILE*"
218
219
220typedef struct luaL_Stream {
221 FILE *f; /* stream (NULL for incompletely created streams) */
222 lua_CFunction closef; /* to close stream (NULL for closed streams) */
223} luaL_Stream;
224
225/* }====================================================== */
226
227/*
228** {==================================================================
229** "Abstraction Layer" for basic report of messages and errors
230** ===================================================================
231*/
232
233/* print a string */
234#if !defined(lua_writestring)
235#define lua_writestring(s,l) fwrite((s), sizeof(char), (l), stdout)
236#endif
237
238/* print a newline and flush the output */
239#if !defined(lua_writeline)
240#define lua_writeline() (lua_writestring("\n", 1), fflush(stdout))
241#endif
242
243/* print an error message */
244#if !defined(lua_writestringerror)
245#define lua_writestringerror(s,p) \
246 (fprintf(stderr, (s), (p)), fflush(stderr))
247#endif
248
249/* }================================================================== */
250
251
252/*
253** {============================================================
254** Compatibility with deprecated conversions
255** =============================================================
256*/
257#if defined(LUA_COMPAT_APIINTCASTS)
258
259#define luaL_checkunsigned(L,a) ((lua_Unsigned)luaL_checkinteger(L,a))
260#define luaL_optunsigned(L,a,d) \
261 ((lua_Unsigned)luaL_optinteger(L,a,(lua_Integer)(d)))
262
263#define luaL_checkint(L,n) ((int)luaL_checkinteger(L, (n)))
264#define luaL_optint(L,n,d) ((int)luaL_optinteger(L, (n), (d)))
265
266#define luaL_checklong(L,n) ((long)luaL_checkinteger(L, (n)))
267#define luaL_optlong(L,n,d) ((long)luaL_optinteger(L, (n), (d)))
268
269#endif
270/* }============================================================ */
271
272
273
274#endif
275
276
diff --git a/src/lua/lbaselib.c b/src/lua/lbaselib.c
new file mode 100644
index 0000000..747fd45
--- /dev/null
+++ b/src/lua/lbaselib.c
@@ -0,0 +1,527 @@
1/*
2** $Id: lbaselib.c $
3** Basic library
4** See Copyright Notice in lua.h
5*/
6
7#define lbaselib_c
8#define LUA_LIB
9
10#include "lprefix.h"
11
12
13#include <ctype.h>
14#include <stdio.h>
15#include <stdlib.h>
16#include <string.h>
17
18#include "lua.h"
19
20#include "lauxlib.h"
21#include "lualib.h"
22
23
24static int luaB_print (lua_State *L) {
25 int n = lua_gettop(L); /* number of arguments */
26 int i;
27 for (i = 1; i <= n; i++) { /* for each argument */
28 size_t l;
29 const char *s = luaL_tolstring(L, i, &l); /* convert it to string */
30 if (i > 1) /* not the first element? */
31 lua_writestring("\t", 1); /* add a tab before it */
32 lua_writestring(s, l); /* print it */
33 lua_pop(L, 1); /* pop result */
34 }
35 lua_writeline();
36 return 0;
37}
38
39
40/*
41** Creates a warning with all given arguments.
42** Check first for errors; otherwise an error may interrupt
43** the composition of a warning, leaving it unfinished.
44*/
45static int luaB_warn (lua_State *L) {
46 int n = lua_gettop(L); /* number of arguments */
47 int i;
48 luaL_checkstring(L, 1); /* at least one argument */
49 for (i = 2; i <= n; i++)
50 luaL_checkstring(L, i); /* make sure all arguments are strings */
51 for (i = 1; i < n; i++) /* compose warning */
52 lua_warning(L, lua_tostring(L, i), 1);
53 lua_warning(L, lua_tostring(L, n), 0); /* close warning */
54 return 0;
55}
56
57
58#define SPACECHARS " \f\n\r\t\v"
59
60static const char *b_str2int (const char *s, int base, lua_Integer *pn) {
61 lua_Unsigned n = 0;
62 int neg = 0;
63 s += strspn(s, SPACECHARS); /* skip initial spaces */
64 if (*s == '-') { s++; neg = 1; } /* handle sign */
65 else if (*s == '+') s++;
66 if (!isalnum((unsigned char)*s)) /* no digit? */
67 return NULL;
68 do {
69 int digit = (isdigit((unsigned char)*s)) ? *s - '0'
70 : (toupper((unsigned char)*s) - 'A') + 10;
71 if (digit >= base) return NULL; /* invalid numeral */
72 n = n * base + digit;
73 s++;
74 } while (isalnum((unsigned char)*s));
75 s += strspn(s, SPACECHARS); /* skip trailing spaces */
76 *pn = (lua_Integer)((neg) ? (0u - n) : n);
77 return s;
78}
79
80
81static int luaB_tonumber (lua_State *L) {
82 if (lua_isnoneornil(L, 2)) { /* standard conversion? */
83 if (lua_type(L, 1) == LUA_TNUMBER) { /* already a number? */
84 lua_settop(L, 1); /* yes; return it */
85 return 1;
86 }
87 else {
88 size_t l;
89 const char *s = lua_tolstring(L, 1, &l);
90 if (s != NULL && lua_stringtonumber(L, s) == l + 1)
91 return 1; /* successful conversion to number */
92 /* else not a number */
93 luaL_checkany(L, 1); /* (but there must be some parameter) */
94 }
95 }
96 else {
97 size_t l;
98 const char *s;
99 lua_Integer n = 0; /* to avoid warnings */
100 lua_Integer base = luaL_checkinteger(L, 2);
101 luaL_checktype(L, 1, LUA_TSTRING); /* no numbers as strings */
102 s = lua_tolstring(L, 1, &l);
103 luaL_argcheck(L, 2 <= base && base <= 36, 2, "base out of range");
104 if (b_str2int(s, (int)base, &n) == s + l) {
105 lua_pushinteger(L, n);
106 return 1;
107 } /* else not a number */
108 } /* else not a number */
109 luaL_pushfail(L); /* not a number */
110 return 1;
111}
112
113
114static int luaB_error (lua_State *L) {
115 int level = (int)luaL_optinteger(L, 2, 1);
116 lua_settop(L, 1);
117 if (lua_type(L, 1) == LUA_TSTRING && level > 0) {
118 luaL_where(L, level); /* add extra information */
119 lua_pushvalue(L, 1);
120 lua_concat(L, 2);
121 }
122 return lua_error(L);
123}
124
125
126static int luaB_getmetatable (lua_State *L) {
127 luaL_checkany(L, 1);
128 if (!lua_getmetatable(L, 1)) {
129 lua_pushnil(L);
130 return 1; /* no metatable */
131 }
132 luaL_getmetafield(L, 1, "__metatable");
133 return 1; /* returns either __metatable field (if present) or metatable */
134}
135
136
137static int luaB_setmetatable (lua_State *L) {
138 int t = lua_type(L, 2);
139 luaL_checktype(L, 1, LUA_TTABLE);
140 luaL_argexpected(L, t == LUA_TNIL || t == LUA_TTABLE, 2, "nil or table");
141 if (luaL_getmetafield(L, 1, "__metatable") != LUA_TNIL)
142 return luaL_error(L, "cannot change a protected metatable");
143 lua_settop(L, 2);
144 lua_setmetatable(L, 1);
145 return 1;
146}
147
148
149static int luaB_rawequal (lua_State *L) {
150 luaL_checkany(L, 1);
151 luaL_checkany(L, 2);
152 lua_pushboolean(L, lua_rawequal(L, 1, 2));
153 return 1;
154}
155
156
157static int luaB_rawlen (lua_State *L) {
158 int t = lua_type(L, 1);
159 luaL_argexpected(L, t == LUA_TTABLE || t == LUA_TSTRING, 1,
160 "table or string");
161 lua_pushinteger(L, lua_rawlen(L, 1));
162 return 1;
163}
164
165
166static int luaB_rawget (lua_State *L) {
167 luaL_checktype(L, 1, LUA_TTABLE);
168 luaL_checkany(L, 2);
169 lua_settop(L, 2);
170 lua_rawget(L, 1);
171 return 1;
172}
173
174static int luaB_rawset (lua_State *L) {
175 luaL_checktype(L, 1, LUA_TTABLE);
176 luaL_checkany(L, 2);
177 luaL_checkany(L, 3);
178 lua_settop(L, 3);
179 lua_rawset(L, 1);
180 return 1;
181}
182
183
184static int pushmode (lua_State *L, int oldmode) {
185 lua_pushstring(L, (oldmode == LUA_GCINC) ? "incremental" : "generational");
186 return 1;
187}
188
189
190static int luaB_collectgarbage (lua_State *L) {
191 static const char *const opts[] = {"stop", "restart", "collect",
192 "count", "step", "setpause", "setstepmul",
193 "isrunning", "generational", "incremental", NULL};
194 static const int optsnum[] = {LUA_GCSTOP, LUA_GCRESTART, LUA_GCCOLLECT,
195 LUA_GCCOUNT, LUA_GCSTEP, LUA_GCSETPAUSE, LUA_GCSETSTEPMUL,
196 LUA_GCISRUNNING, LUA_GCGEN, LUA_GCINC};
197 int o = optsnum[luaL_checkoption(L, 1, "collect", opts)];
198 switch (o) {
199 case LUA_GCCOUNT: {
200 int k = lua_gc(L, o);
201 int b = lua_gc(L, LUA_GCCOUNTB);
202 lua_pushnumber(L, (lua_Number)k + ((lua_Number)b/1024));
203 return 1;
204 }
205 case LUA_GCSTEP: {
206 int step = (int)luaL_optinteger(L, 2, 0);
207 int res = lua_gc(L, o, step);
208 lua_pushboolean(L, res);
209 return 1;
210 }
211 case LUA_GCSETPAUSE:
212 case LUA_GCSETSTEPMUL: {
213 int p = (int)luaL_optinteger(L, 2, 0);
214 int previous = lua_gc(L, o, p);
215 lua_pushinteger(L, previous);
216 return 1;
217 }
218 case LUA_GCISRUNNING: {
219 int res = lua_gc(L, o);
220 lua_pushboolean(L, res);
221 return 1;
222 }
223 case LUA_GCGEN: {
224 int minormul = (int)luaL_optinteger(L, 2, 0);
225 int majormul = (int)luaL_optinteger(L, 3, 0);
226 return pushmode(L, lua_gc(L, o, minormul, majormul));
227 }
228 case LUA_GCINC: {
229 int pause = (int)luaL_optinteger(L, 2, 0);
230 int stepmul = (int)luaL_optinteger(L, 3, 0);
231 int stepsize = (int)luaL_optinteger(L, 4, 0);
232 return pushmode(L, lua_gc(L, o, pause, stepmul, stepsize));
233 }
234 default: {
235 int res = lua_gc(L, o);
236 lua_pushinteger(L, res);
237 return 1;
238 }
239 }
240}
241
242
243static int luaB_type (lua_State *L) {
244 int t = lua_type(L, 1);
245 luaL_argcheck(L, t != LUA_TNONE, 1, "value expected");
246 lua_pushstring(L, lua_typename(L, t));
247 return 1;
248}
249
250
251static int luaB_next (lua_State *L) {
252 luaL_checktype(L, 1, LUA_TTABLE);
253 lua_settop(L, 2); /* create a 2nd argument if there isn't one */
254 if (lua_next(L, 1))
255 return 2;
256 else {
257 lua_pushnil(L);
258 return 1;
259 }
260}
261
262
263static int luaB_pairs (lua_State *L) {
264 luaL_checkany(L, 1);
265 if (luaL_getmetafield(L, 1, "__pairs") == LUA_TNIL) { /* no metamethod? */
266 lua_pushcfunction(L, luaB_next); /* will return generator, */
267 lua_pushvalue(L, 1); /* state, */
268 lua_pushnil(L); /* and initial value */
269 }
270 else {
271 lua_pushvalue(L, 1); /* argument 'self' to metamethod */
272 lua_call(L, 1, 3); /* get 3 values from metamethod */
273 }
274 return 3;
275}
276
277
278/*
279** Traversal function for 'ipairs'
280*/
281static int ipairsaux (lua_State *L) {
282 lua_Integer i = luaL_checkinteger(L, 2) + 1;
283 lua_pushinteger(L, i);
284 return (lua_geti(L, 1, i) == LUA_TNIL) ? 1 : 2;
285}
286
287
288/*
289** 'ipairs' function. Returns 'ipairsaux', given "table", 0.
290** (The given "table" may not be a table.)
291*/
292static int luaB_ipairs (lua_State *L) {
293 luaL_checkany(L, 1);
294 lua_pushcfunction(L, ipairsaux); /* iteration function */
295 lua_pushvalue(L, 1); /* state */
296 lua_pushinteger(L, 0); /* initial value */
297 return 3;
298}
299
300
301static int load_aux (lua_State *L, int status, int envidx) {
302 if (status == LUA_OK) {
303 if (envidx != 0) { /* 'env' parameter? */
304 lua_pushvalue(L, envidx); /* environment for loaded function */
305 if (!lua_setupvalue(L, -2, 1)) /* set it as 1st upvalue */
306 lua_pop(L, 1); /* remove 'env' if not used by previous call */
307 }
308 return 1;
309 }
310 else { /* error (message is on top of the stack) */
311 luaL_pushfail(L);
312 lua_insert(L, -2); /* put before error message */
313 return 2; /* return fail plus error message */
314 }
315}
316
317
318static int luaB_loadfile (lua_State *L) {
319 const char *fname = luaL_optstring(L, 1, NULL);
320 const char *mode = luaL_optstring(L, 2, NULL);
321 int env = (!lua_isnone(L, 3) ? 3 : 0); /* 'env' index or 0 if no 'env' */
322 int status = luaL_loadfilex(L, fname, mode);
323 return load_aux(L, status, env);
324}
325
326
327/*
328** {======================================================
329** Generic Read function
330** =======================================================
331*/
332
333
334/*
335** reserved slot, above all arguments, to hold a copy of the returned
336** string to avoid it being collected while parsed. 'load' has four
337** optional arguments (chunk, source name, mode, and environment).
338*/
339#define RESERVEDSLOT 5
340
341
342/*
343** Reader for generic 'load' function: 'lua_load' uses the
344** stack for internal stuff, so the reader cannot change the
345** stack top. Instead, it keeps its resulting string in a
346** reserved slot inside the stack.
347*/
348static const char *generic_reader (lua_State *L, void *ud, size_t *size) {
349 (void)(ud); /* not used */
350 luaL_checkstack(L, 2, "too many nested functions");
351 lua_pushvalue(L, 1); /* get function */
352 lua_call(L, 0, 1); /* call it */
353 if (lua_isnil(L, -1)) {
354 lua_pop(L, 1); /* pop result */
355 *size = 0;
356 return NULL;
357 }
358 else if (!lua_isstring(L, -1))
359 luaL_error(L, "reader function must return a string");
360 lua_replace(L, RESERVEDSLOT); /* save string in reserved slot */
361 return lua_tolstring(L, RESERVEDSLOT, size);
362}
363
364
365static int luaB_load (lua_State *L) {
366 int status;
367 size_t l;
368 const char *s = lua_tolstring(L, 1, &l);
369 const char *mode = luaL_optstring(L, 3, "bt");
370 int env = (!lua_isnone(L, 4) ? 4 : 0); /* 'env' index or 0 if no 'env' */
371 if (s != NULL) { /* loading a string? */
372 const char *chunkname = luaL_optstring(L, 2, s);
373 status = luaL_loadbufferx(L, s, l, chunkname, mode);
374 }
375 else { /* loading from a reader function */
376 const char *chunkname = luaL_optstring(L, 2, "=(load)");
377 luaL_checktype(L, 1, LUA_TFUNCTION);
378 lua_settop(L, RESERVEDSLOT); /* create reserved slot */
379 status = lua_load(L, generic_reader, NULL, chunkname, mode);
380 }
381 return load_aux(L, status, env);
382}
383
384/* }====================================================== */
385
386
387static int dofilecont (lua_State *L, int d1, lua_KContext d2) {
388 (void)d1; (void)d2; /* only to match 'lua_Kfunction' prototype */
389 return lua_gettop(L) - 1;
390}
391
392
393static int luaB_dofile (lua_State *L) {
394 const char *fname = luaL_optstring(L, 1, NULL);
395 lua_settop(L, 1);
396 if (luaL_loadfile(L, fname) != LUA_OK)
397 return lua_error(L);
398 lua_callk(L, 0, LUA_MULTRET, 0, dofilecont);
399 return dofilecont(L, 0, 0);
400}
401
402
403static int luaB_assert (lua_State *L) {
404 if (lua_toboolean(L, 1)) /* condition is true? */
405 return lua_gettop(L); /* return all arguments */
406 else { /* error */
407 luaL_checkany(L, 1); /* there must be a condition */
408 lua_remove(L, 1); /* remove it */
409 lua_pushliteral(L, "assertion failed!"); /* default message */
410 lua_settop(L, 1); /* leave only message (default if no other one) */
411 return luaB_error(L); /* call 'error' */
412 }
413}
414
415
416static int luaB_select (lua_State *L) {
417 int n = lua_gettop(L);
418 if (lua_type(L, 1) == LUA_TSTRING && *lua_tostring(L, 1) == '#') {
419 lua_pushinteger(L, n-1);
420 return 1;
421 }
422 else {
423 lua_Integer i = luaL_checkinteger(L, 1);
424 if (i < 0) i = n + i;
425 else if (i > n) i = n;
426 luaL_argcheck(L, 1 <= i, 1, "index out of range");
427 return n - (int)i;
428 }
429}
430
431
432/*
433** Continuation function for 'pcall' and 'xpcall'. Both functions
434** already pushed a 'true' before doing the call, so in case of success
435** 'finishpcall' only has to return everything in the stack minus
436** 'extra' values (where 'extra' is exactly the number of items to be
437** ignored).
438*/
439static int finishpcall (lua_State *L, int status, lua_KContext extra) {
440 if (status != LUA_OK && status != LUA_YIELD) { /* error? */
441 lua_pushboolean(L, 0); /* first result (false) */
442 lua_pushvalue(L, -2); /* error message */
443 return 2; /* return false, msg */
444 }
445 else
446 return lua_gettop(L) - (int)extra; /* return all results */
447}
448
449
450static int luaB_pcall (lua_State *L) {
451 int status;
452 luaL_checkany(L, 1);
453 lua_pushboolean(L, 1); /* first result if no errors */
454 lua_insert(L, 1); /* put it in place */
455 status = lua_pcallk(L, lua_gettop(L) - 2, LUA_MULTRET, 0, 0, finishpcall);
456 return finishpcall(L, status, 0);
457}
458
459
460/*
461** Do a protected call with error handling. After 'lua_rotate', the
462** stack will have <f, err, true, f, [args...]>; so, the function passes
463** 2 to 'finishpcall' to skip the 2 first values when returning results.
464*/
465static int luaB_xpcall (lua_State *L) {
466 int status;
467 int n = lua_gettop(L);
468 luaL_checktype(L, 2, LUA_TFUNCTION); /* check error function */
469 lua_pushboolean(L, 1); /* first result */
470 lua_pushvalue(L, 1); /* function */
471 lua_rotate(L, 3, 2); /* move them below function's arguments */
472 status = lua_pcallk(L, n - 2, LUA_MULTRET, 2, 2, finishpcall);
473 return finishpcall(L, status, 2);
474}
475
476
477static int luaB_tostring (lua_State *L) {
478 luaL_checkany(L, 1);
479 luaL_tolstring(L, 1, NULL);
480 return 1;
481}
482
483
484static const luaL_Reg base_funcs[] = {
485 {"assert", luaB_assert},
486 {"collectgarbage", luaB_collectgarbage},
487 {"dofile", luaB_dofile},
488 {"error", luaB_error},
489 {"getmetatable", luaB_getmetatable},
490 {"ipairs", luaB_ipairs},
491 {"loadfile", luaB_loadfile},
492 {"load", luaB_load},
493 {"next", luaB_next},
494 {"pairs", luaB_pairs},
495 {"pcall", luaB_pcall},
496 {"print", luaB_print},
497 {"warn", luaB_warn},
498 {"rawequal", luaB_rawequal},
499 {"rawlen", luaB_rawlen},
500 {"rawget", luaB_rawget},
501 {"rawset", luaB_rawset},
502 {"select", luaB_select},
503 {"setmetatable", luaB_setmetatable},
504 {"tonumber", luaB_tonumber},
505 {"tostring", luaB_tostring},
506 {"type", luaB_type},
507 {"xpcall", luaB_xpcall},
508 /* placeholders */
509 {LUA_GNAME, NULL},
510 {"_VERSION", NULL},
511 {NULL, NULL}
512};
513
514
515LUAMOD_API int luaopen_base (lua_State *L) {
516 /* open lib into global table */
517 lua_pushglobaltable(L);
518 luaL_setfuncs(L, base_funcs, 0);
519 /* set global _G */
520 lua_pushvalue(L, -1);
521 lua_setfield(L, -2, LUA_GNAME);
522 /* set global _VERSION */
523 lua_pushliteral(L, LUA_VERSION);
524 lua_setfield(L, -2, "_VERSION");
525 return 1;
526}
527
diff --git a/src/lua/lcode.c b/src/lua/lcode.c
new file mode 100644
index 0000000..6f241c9
--- /dev/null
+++ b/src/lua/lcode.c
@@ -0,0 +1,1814 @@
1/*
2** $Id: lcode.c $
3** Code generator for Lua
4** See Copyright Notice in lua.h
5*/
6
7#define lcode_c
8#define LUA_CORE
9
10#include "lprefix.h"
11
12
13#include <limits.h>
14#include <math.h>
15#include <stdlib.h>
16
17#include "lua.h"
18
19#include "lcode.h"
20#include "ldebug.h"
21#include "ldo.h"
22#include "lgc.h"
23#include "llex.h"
24#include "lmem.h"
25#include "lobject.h"
26#include "lopcodes.h"
27#include "lparser.h"
28#include "lstring.h"
29#include "ltable.h"
30#include "lvm.h"
31
32
33/* Maximum number of registers in a Lua function (must fit in 8 bits) */
34#define MAXREGS 255
35
36
37#define hasjumps(e) ((e)->t != (e)->f)
38
39
40static int codesJ (FuncState *fs, OpCode o, int sj, int k);
41
42
43
44/* semantic error */
45l_noret luaK_semerror (LexState *ls, const char *msg) {
46 ls->t.token = 0; /* remove "near <token>" from final message */
47 luaX_syntaxerror(ls, msg);
48}
49
50
51/*
52** If expression is a numeric constant, fills 'v' with its value
53** and returns 1. Otherwise, returns 0.
54*/
55static int tonumeral (const expdesc *e, TValue *v) {
56 if (hasjumps(e))
57 return 0; /* not a numeral */
58 switch (e->k) {
59 case VKINT:
60 if (v) setivalue(v, e->u.ival);
61 return 1;
62 case VKFLT:
63 if (v) setfltvalue(v, e->u.nval);
64 return 1;
65 default: return 0;
66 }
67}
68
69
70/*
71** Get the constant value from a constant expression
72*/
73static TValue *const2val (FuncState *fs, const expdesc *e) {
74 lua_assert(e->k == VCONST);
75 return &fs->ls->dyd->actvar.arr[e->u.info].k;
76}
77
78
79/*
80** If expression is a constant, fills 'v' with its value
81** and returns 1. Otherwise, returns 0.
82*/
83int luaK_exp2const (FuncState *fs, const expdesc *e, TValue *v) {
84 if (hasjumps(e))
85 return 0; /* not a constant */
86 switch (e->k) {
87 case VFALSE:
88 setbfvalue(v);
89 return 1;
90 case VTRUE:
91 setbtvalue(v);
92 return 1;
93 case VNIL:
94 setnilvalue(v);
95 return 1;
96 case VKSTR: {
97 setsvalue(fs->ls->L, v, e->u.strval);
98 return 1;
99 }
100 case VCONST: {
101 setobj(fs->ls->L, v, const2val(fs, e));
102 return 1;
103 }
104 default: return tonumeral(e, v);
105 }
106}
107
108
109/*
110** Return the previous instruction of the current code. If there
111** may be a jump target between the current instruction and the
112** previous one, return an invalid instruction (to avoid wrong
113** optimizations).
114*/
115static Instruction *previousinstruction (FuncState *fs) {
116 static const Instruction invalidinstruction = ~(Instruction)0;
117 if (fs->pc > fs->lasttarget)
118 return &fs->f->code[fs->pc - 1]; /* previous instruction */
119 else
120 return cast(Instruction*, &invalidinstruction);
121}
122
123
124/*
125** Create a OP_LOADNIL instruction, but try to optimize: if the previous
126** instruction is also OP_LOADNIL and ranges are compatible, adjust
127** range of previous instruction instead of emitting a new one. (For
128** instance, 'local a; local b' will generate a single opcode.)
129*/
130void luaK_nil (FuncState *fs, int from, int n) {
131 int l = from + n - 1; /* last register to set nil */
132 Instruction *previous = previousinstruction(fs);
133 if (GET_OPCODE(*previous) == OP_LOADNIL) { /* previous is LOADNIL? */
134 int pfrom = GETARG_A(*previous); /* get previous range */
135 int pl = pfrom + GETARG_B(*previous);
136 if ((pfrom <= from && from <= pl + 1) ||
137 (from <= pfrom && pfrom <= l + 1)) { /* can connect both? */
138 if (pfrom < from) from = pfrom; /* from = min(from, pfrom) */
139 if (pl > l) l = pl; /* l = max(l, pl) */
140 SETARG_A(*previous, from);
141 SETARG_B(*previous, l - from);
142 return;
143 } /* else go through */
144 }
145 luaK_codeABC(fs, OP_LOADNIL, from, n - 1, 0); /* else no optimization */
146}
147
148
149/*
150** Gets the destination address of a jump instruction. Used to traverse
151** a list of jumps.
152*/
153static int getjump (FuncState *fs, int pc) {
154 int offset = GETARG_sJ(fs->f->code[pc]);
155 if (offset == NO_JUMP) /* point to itself represents end of list */
156 return NO_JUMP; /* end of list */
157 else
158 return (pc+1)+offset; /* turn offset into absolute position */
159}
160
161
162/*
163** Fix jump instruction at position 'pc' to jump to 'dest'.
164** (Jump addresses are relative in Lua)
165*/
166static void fixjump (FuncState *fs, int pc, int dest) {
167 Instruction *jmp = &fs->f->code[pc];
168 int offset = dest - (pc + 1);
169 lua_assert(dest != NO_JUMP);
170 if (!(-OFFSET_sJ <= offset && offset <= MAXARG_sJ - OFFSET_sJ))
171 luaX_syntaxerror(fs->ls, "control structure too long");
172 lua_assert(GET_OPCODE(*jmp) == OP_JMP);
173 SETARG_sJ(*jmp, offset);
174}
175
176
177/*
178** Concatenate jump-list 'l2' into jump-list 'l1'
179*/
180void luaK_concat (FuncState *fs, int *l1, int l2) {
181 if (l2 == NO_JUMP) return; /* nothing to concatenate? */
182 else if (*l1 == NO_JUMP) /* no original list? */
183 *l1 = l2; /* 'l1' points to 'l2' */
184 else {
185 int list = *l1;
186 int next;
187 while ((next = getjump(fs, list)) != NO_JUMP) /* find last element */
188 list = next;
189 fixjump(fs, list, l2); /* last element links to 'l2' */
190 }
191}
192
193
194/*
195** Create a jump instruction and return its position, so its destination
196** can be fixed later (with 'fixjump').
197*/
198int luaK_jump (FuncState *fs) {
199 return codesJ(fs, OP_JMP, NO_JUMP, 0);
200}
201
202
203/*
204** Code a 'return' instruction
205*/
206void luaK_ret (FuncState *fs, int first, int nret) {
207 OpCode op;
208 switch (nret) {
209 case 0: op = OP_RETURN0; break;
210 case 1: op = OP_RETURN1; break;
211 default: op = OP_RETURN; break;
212 }
213 luaK_codeABC(fs, op, first, nret + 1, 0);
214}
215
216
217/*
218** Code a "conditional jump", that is, a test or comparison opcode
219** followed by a jump. Return jump position.
220*/
221static int condjump (FuncState *fs, OpCode op, int A, int B, int C, int k) {
222 luaK_codeABCk(fs, op, A, B, C, k);
223 return luaK_jump(fs);
224}
225
226
227/*
228** returns current 'pc' and marks it as a jump target (to avoid wrong
229** optimizations with consecutive instructions not in the same basic block).
230*/
231int luaK_getlabel (FuncState *fs) {
232 fs->lasttarget = fs->pc;
233 return fs->pc;
234}
235
236
237/*
238** Returns the position of the instruction "controlling" a given
239** jump (that is, its condition), or the jump itself if it is
240** unconditional.
241*/
242static Instruction *getjumpcontrol (FuncState *fs, int pc) {
243 Instruction *pi = &fs->f->code[pc];
244 if (pc >= 1 && testTMode(GET_OPCODE(*(pi-1))))
245 return pi-1;
246 else
247 return pi;
248}
249
250
251/*
252** Patch destination register for a TESTSET instruction.
253** If instruction in position 'node' is not a TESTSET, return 0 ("fails").
254** Otherwise, if 'reg' is not 'NO_REG', set it as the destination
255** register. Otherwise, change instruction to a simple 'TEST' (produces
256** no register value)
257*/
258static int patchtestreg (FuncState *fs, int node, int reg) {
259 Instruction *i = getjumpcontrol(fs, node);
260 if (GET_OPCODE(*i) != OP_TESTSET)
261 return 0; /* cannot patch other instructions */
262 if (reg != NO_REG && reg != GETARG_B(*i))
263 SETARG_A(*i, reg);
264 else {
265 /* no register to put value or register already has the value;
266 change instruction to simple test */
267 *i = CREATE_ABCk(OP_TEST, GETARG_B(*i), 0, 0, GETARG_k(*i));
268 }
269 return 1;
270}
271
272
273/*
274** Traverse a list of tests ensuring no one produces a value
275*/
276static void removevalues (FuncState *fs, int list) {
277 for (; list != NO_JUMP; list = getjump(fs, list))
278 patchtestreg(fs, list, NO_REG);
279}
280
281
282/*
283** Traverse a list of tests, patching their destination address and
284** registers: tests producing values jump to 'vtarget' (and put their
285** values in 'reg'), other tests jump to 'dtarget'.
286*/
287static void patchlistaux (FuncState *fs, int list, int vtarget, int reg,
288 int dtarget) {
289 while (list != NO_JUMP) {
290 int next = getjump(fs, list);
291 if (patchtestreg(fs, list, reg))
292 fixjump(fs, list, vtarget);
293 else
294 fixjump(fs, list, dtarget); /* jump to default target */
295 list = next;
296 }
297}
298
299
300/*
301** Path all jumps in 'list' to jump to 'target'.
302** (The assert means that we cannot fix a jump to a forward address
303** because we only know addresses once code is generated.)
304*/
305void luaK_patchlist (FuncState *fs, int list, int target) {
306 lua_assert(target <= fs->pc);
307 patchlistaux(fs, list, target, NO_REG, target);
308}
309
310
311void luaK_patchtohere (FuncState *fs, int list) {
312 int hr = luaK_getlabel(fs); /* mark "here" as a jump target */
313 luaK_patchlist(fs, list, hr);
314}
315
316
317/*
318** MAXimum number of successive Instructions WiTHout ABSolute line
319** information.
320*/
321#if !defined(MAXIWTHABS)
322#define MAXIWTHABS 120
323#endif
324
325
326/* limit for difference between lines in relative line info. */
327#define LIMLINEDIFF 0x80
328
329
330/*
331** Save line info for a new instruction. If difference from last line
332** does not fit in a byte, of after that many instructions, save a new
333** absolute line info; (in that case, the special value 'ABSLINEINFO'
334** in 'lineinfo' signals the existence of this absolute information.)
335** Otherwise, store the difference from last line in 'lineinfo'.
336*/
337static void savelineinfo (FuncState *fs, Proto *f, int line) {
338 int linedif = line - fs->previousline;
339 int pc = fs->pc - 1; /* last instruction coded */
340 if (abs(linedif) >= LIMLINEDIFF || fs->iwthabs++ > MAXIWTHABS) {
341 luaM_growvector(fs->ls->L, f->abslineinfo, fs->nabslineinfo,
342 f->sizeabslineinfo, AbsLineInfo, MAX_INT, "lines");
343 f->abslineinfo[fs->nabslineinfo].pc = pc;
344 f->abslineinfo[fs->nabslineinfo++].line = line;
345 linedif = ABSLINEINFO; /* signal that there is absolute information */
346 fs->iwthabs = 0; /* restart counter */
347 }
348 luaM_growvector(fs->ls->L, f->lineinfo, pc, f->sizelineinfo, ls_byte,
349 MAX_INT, "opcodes");
350 f->lineinfo[pc] = linedif;
351 fs->previousline = line; /* last line saved */
352}
353
354
355/*
356** Remove line information from the last instruction.
357** If line information for that instruction is absolute, set 'iwthabs'
358** above its max to force the new (replacing) instruction to have
359** absolute line info, too.
360*/
361static void removelastlineinfo (FuncState *fs) {
362 Proto *f = fs->f;
363 int pc = fs->pc - 1; /* last instruction coded */
364 if (f->lineinfo[pc] != ABSLINEINFO) { /* relative line info? */
365 fs->previousline -= f->lineinfo[pc]; /* correct last line saved */
366 fs->iwthabs--; /* undo previous increment */
367 }
368 else { /* absolute line information */
369 lua_assert(f->abslineinfo[fs->nabslineinfo - 1].pc == pc);
370 fs->nabslineinfo--; /* remove it */
371 fs->iwthabs = MAXIWTHABS + 1; /* force next line info to be absolute */
372 }
373}
374
375
376/*
377** Remove the last instruction created, correcting line information
378** accordingly.
379*/
380static void removelastinstruction (FuncState *fs) {
381 removelastlineinfo(fs);
382 fs->pc--;
383}
384
385
386/*
387** Emit instruction 'i', checking for array sizes and saving also its
388** line information. Return 'i' position.
389*/
390int luaK_code (FuncState *fs, Instruction i) {
391 Proto *f = fs->f;
392 /* put new instruction in code array */
393 luaM_growvector(fs->ls->L, f->code, fs->pc, f->sizecode, Instruction,
394 MAX_INT, "opcodes");
395 f->code[fs->pc++] = i;
396 savelineinfo(fs, f, fs->ls->lastline);
397 return fs->pc - 1; /* index of new instruction */
398}
399
400
401/*
402** Format and emit an 'iABC' instruction. (Assertions check consistency
403** of parameters versus opcode.)
404*/
405int luaK_codeABCk (FuncState *fs, OpCode o, int a, int b, int c, int k) {
406 lua_assert(getOpMode(o) == iABC);
407 lua_assert(a <= MAXARG_A && b <= MAXARG_B &&
408 c <= MAXARG_C && (k & ~1) == 0);
409 return luaK_code(fs, CREATE_ABCk(o, a, b, c, k));
410}
411
412
413/*
414** Format and emit an 'iABx' instruction.
415*/
416int luaK_codeABx (FuncState *fs, OpCode o, int a, unsigned int bc) {
417 lua_assert(getOpMode(o) == iABx);
418 lua_assert(a <= MAXARG_A && bc <= MAXARG_Bx);
419 return luaK_code(fs, CREATE_ABx(o, a, bc));
420}
421
422
423/*
424** Format and emit an 'iAsBx' instruction.
425*/
426int luaK_codeAsBx (FuncState *fs, OpCode o, int a, int bc) {
427 unsigned int b = bc + OFFSET_sBx;
428 lua_assert(getOpMode(o) == iAsBx);
429 lua_assert(a <= MAXARG_A && b <= MAXARG_Bx);
430 return luaK_code(fs, CREATE_ABx(o, a, b));
431}
432
433
434/*
435** Format and emit an 'isJ' instruction.
436*/
437static int codesJ (FuncState *fs, OpCode o, int sj, int k) {
438 unsigned int j = sj + OFFSET_sJ;
439 lua_assert(getOpMode(o) == isJ);
440 lua_assert(j <= MAXARG_sJ && (k & ~1) == 0);
441 return luaK_code(fs, CREATE_sJ(o, j, k));
442}
443
444
445/*
446** Emit an "extra argument" instruction (format 'iAx')
447*/
448static int codeextraarg (FuncState *fs, int a) {
449 lua_assert(a <= MAXARG_Ax);
450 return luaK_code(fs, CREATE_Ax(OP_EXTRAARG, a));
451}
452
453
454/*
455** Emit a "load constant" instruction, using either 'OP_LOADK'
456** (if constant index 'k' fits in 18 bits) or an 'OP_LOADKX'
457** instruction with "extra argument".
458*/
459static int luaK_codek (FuncState *fs, int reg, int k) {
460 if (k <= MAXARG_Bx)
461 return luaK_codeABx(fs, OP_LOADK, reg, k);
462 else {
463 int p = luaK_codeABx(fs, OP_LOADKX, reg, 0);
464 codeextraarg(fs, k);
465 return p;
466 }
467}
468
469
470/*
471** Check register-stack level, keeping track of its maximum size
472** in field 'maxstacksize'
473*/
474void luaK_checkstack (FuncState *fs, int n) {
475 int newstack = fs->freereg + n;
476 if (newstack > fs->f->maxstacksize) {
477 if (newstack >= MAXREGS)
478 luaX_syntaxerror(fs->ls,
479 "function or expression needs too many registers");
480 fs->f->maxstacksize = cast_byte(newstack);
481 }
482}
483
484
485/*
486** Reserve 'n' registers in register stack
487*/
488void luaK_reserveregs (FuncState *fs, int n) {
489 luaK_checkstack(fs, n);
490 fs->freereg += n;
491}
492
493
494/*
495** Free register 'reg', if it is neither a constant index nor
496** a local variable.
497)
498*/
499static void freereg (FuncState *fs, int reg) {
500 if (reg >= luaY_nvarstack(fs)) {
501 fs->freereg--;
502 lua_assert(reg == fs->freereg);
503 }
504}
505
506
507/*
508** Free two registers in proper order
509*/
510static void freeregs (FuncState *fs, int r1, int r2) {
511 if (r1 > r2) {
512 freereg(fs, r1);
513 freereg(fs, r2);
514 }
515 else {
516 freereg(fs, r2);
517 freereg(fs, r1);
518 }
519}
520
521
522/*
523** Free register used by expression 'e' (if any)
524*/
525static void freeexp (FuncState *fs, expdesc *e) {
526 if (e->k == VNONRELOC)
527 freereg(fs, e->u.info);
528}
529
530
531/*
532** Free registers used by expressions 'e1' and 'e2' (if any) in proper
533** order.
534*/
535static void freeexps (FuncState *fs, expdesc *e1, expdesc *e2) {
536 int r1 = (e1->k == VNONRELOC) ? e1->u.info : -1;
537 int r2 = (e2->k == VNONRELOC) ? e2->u.info : -1;
538 freeregs(fs, r1, r2);
539}
540
541
542/*
543** Add constant 'v' to prototype's list of constants (field 'k').
544** Use scanner's table to cache position of constants in constant list
545** and try to reuse constants. Because some values should not be used
546** as keys (nil cannot be a key, integer keys can collapse with float
547** keys), the caller must provide a useful 'key' for indexing the cache.
548*/
549static int addk (FuncState *fs, TValue *key, TValue *v) {
550 lua_State *L = fs->ls->L;
551 Proto *f = fs->f;
552 TValue *idx = luaH_set(L, fs->ls->h, key); /* index scanner table */
553 int k, oldsize;
554 if (ttisinteger(idx)) { /* is there an index there? */
555 k = cast_int(ivalue(idx));
556 /* correct value? (warning: must distinguish floats from integers!) */
557 if (k < fs->nk && ttypetag(&f->k[k]) == ttypetag(v) &&
558 luaV_rawequalobj(&f->k[k], v))
559 return k; /* reuse index */
560 }
561 /* constant not found; create a new entry */
562 oldsize = f->sizek;
563 k = fs->nk;
564 /* numerical value does not need GC barrier;
565 table has no metatable, so it does not need to invalidate cache */
566 setivalue(idx, k);
567 luaM_growvector(L, f->k, k, f->sizek, TValue, MAXARG_Ax, "constants");
568 while (oldsize < f->sizek) setnilvalue(&f->k[oldsize++]);
569 setobj(L, &f->k[k], v);
570 fs->nk++;
571 luaC_barrier(L, f, v);
572 return k;
573}
574
575
576/*
577** Add a string to list of constants and return its index.
578*/
579static int stringK (FuncState *fs, TString *s) {
580 TValue o;
581 setsvalue(fs->ls->L, &o, s);
582 return addk(fs, &o, &o); /* use string itself as key */
583}
584
585
586/*
587** Add an integer to list of constants and return its index.
588** Integers use userdata as keys to avoid collision with floats with
589** same value; conversion to 'void*' is used only for hashing, so there
590** are no "precision" problems.
591*/
592static int luaK_intK (FuncState *fs, lua_Integer n) {
593 TValue k, o;
594 setpvalue(&k, cast_voidp(cast_sizet(n)));
595 setivalue(&o, n);
596 return addk(fs, &k, &o);
597}
598
599/*
600** Add a float to list of constants and return its index.
601*/
602static int luaK_numberK (FuncState *fs, lua_Number r) {
603 TValue o;
604 setfltvalue(&o, r);
605 return addk(fs, &o, &o); /* use number itself as key */
606}
607
608
609/*
610** Add a false to list of constants and return its index.
611*/
612static int boolF (FuncState *fs) {
613 TValue o;
614 setbfvalue(&o);
615 return addk(fs, &o, &o); /* use boolean itself as key */
616}
617
618
619/*
620** Add a true to list of constants and return its index.
621*/
622static int boolT (FuncState *fs) {
623 TValue o;
624 setbtvalue(&o);
625 return addk(fs, &o, &o); /* use boolean itself as key */
626}
627
628
629/*
630** Add nil to list of constants and return its index.
631*/
632static int nilK (FuncState *fs) {
633 TValue k, v;
634 setnilvalue(&v);
635 /* cannot use nil as key; instead use table itself to represent nil */
636 sethvalue(fs->ls->L, &k, fs->ls->h);
637 return addk(fs, &k, &v);
638}
639
640
641/*
642** Check whether 'i' can be stored in an 'sC' operand. Equivalent to
643** (0 <= int2sC(i) && int2sC(i) <= MAXARG_C) but without risk of
644** overflows in the hidden addition inside 'int2sC'.
645*/
646static int fitsC (lua_Integer i) {
647 return (l_castS2U(i) + OFFSET_sC <= cast_uint(MAXARG_C));
648}
649
650
651/*
652** Check whether 'i' can be stored in an 'sBx' operand.
653*/
654static int fitsBx (lua_Integer i) {
655 return (-OFFSET_sBx <= i && i <= MAXARG_Bx - OFFSET_sBx);
656}
657
658
659void luaK_int (FuncState *fs, int reg, lua_Integer i) {
660 if (fitsBx(i))
661 luaK_codeAsBx(fs, OP_LOADI, reg, cast_int(i));
662 else
663 luaK_codek(fs, reg, luaK_intK(fs, i));
664}
665
666
667static void luaK_float (FuncState *fs, int reg, lua_Number f) {
668 lua_Integer fi;
669 if (luaV_flttointeger(f, &fi, F2Ieq) && fitsBx(fi))
670 luaK_codeAsBx(fs, OP_LOADF, reg, cast_int(fi));
671 else
672 luaK_codek(fs, reg, luaK_numberK(fs, f));
673}
674
675
676/*
677** Convert a constant in 'v' into an expression description 'e'
678*/
679static void const2exp (TValue *v, expdesc *e) {
680 switch (ttypetag(v)) {
681 case LUA_VNUMINT:
682 e->k = VKINT; e->u.ival = ivalue(v);
683 break;
684 case LUA_VNUMFLT:
685 e->k = VKFLT; e->u.nval = fltvalue(v);
686 break;
687 case LUA_VFALSE:
688 e->k = VFALSE;
689 break;
690 case LUA_VTRUE:
691 e->k = VTRUE;
692 break;
693 case LUA_VNIL:
694 e->k = VNIL;
695 break;
696 case LUA_VSHRSTR: case LUA_VLNGSTR:
697 e->k = VKSTR; e->u.strval = tsvalue(v);
698 break;
699 default: lua_assert(0);
700 }
701}
702
703
704/*
705** Fix an expression to return the number of results 'nresults'.
706** 'e' must be a multi-ret expression (function call or vararg).
707*/
708void luaK_setreturns (FuncState *fs, expdesc *e, int nresults) {
709 Instruction *pc = &getinstruction(fs, e);
710 if (e->k == VCALL) /* expression is an open function call? */
711 SETARG_C(*pc, nresults + 1);
712 else {
713 lua_assert(e->k == VVARARG);
714 SETARG_C(*pc, nresults + 1);
715 SETARG_A(*pc, fs->freereg);
716 luaK_reserveregs(fs, 1);
717 }
718}
719
720
721/*
722** Convert a VKSTR to a VK
723*/
724static void str2K (FuncState *fs, expdesc *e) {
725 lua_assert(e->k == VKSTR);
726 e->u.info = stringK(fs, e->u.strval);
727 e->k = VK;
728}
729
730
731/*
732** Fix an expression to return one result.
733** If expression is not a multi-ret expression (function call or
734** vararg), it already returns one result, so nothing needs to be done.
735** Function calls become VNONRELOC expressions (as its result comes
736** fixed in the base register of the call), while vararg expressions
737** become VRELOC (as OP_VARARG puts its results where it wants).
738** (Calls are created returning one result, so that does not need
739** to be fixed.)
740*/
741void luaK_setoneret (FuncState *fs, expdesc *e) {
742 if (e->k == VCALL) { /* expression is an open function call? */
743 /* already returns 1 value */
744 lua_assert(GETARG_C(getinstruction(fs, e)) == 2);
745 e->k = VNONRELOC; /* result has fixed position */
746 e->u.info = GETARG_A(getinstruction(fs, e));
747 }
748 else if (e->k == VVARARG) {
749 SETARG_C(getinstruction(fs, e), 2);
750 e->k = VRELOC; /* can relocate its simple result */
751 }
752}
753
754
755/*
756** Ensure that expression 'e' is not a variable (nor a constant).
757** (Expression still may have jump lists.)
758*/
759void luaK_dischargevars (FuncState *fs, expdesc *e) {
760 switch (e->k) {
761 case VCONST: {
762 const2exp(const2val(fs, e), e);
763 break;
764 }
765 case VLOCAL: { /* already in a register */
766 e->u.info = e->u.var.sidx;
767 e->k = VNONRELOC; /* becomes a non-relocatable value */
768 break;
769 }
770 case VUPVAL: { /* move value to some (pending) register */
771 e->u.info = luaK_codeABC(fs, OP_GETUPVAL, 0, e->u.info, 0);
772 e->k = VRELOC;
773 break;
774 }
775 case VINDEXUP: {
776 e->u.info = luaK_codeABC(fs, OP_GETTABUP, 0, e->u.ind.t, e->u.ind.idx);
777 e->k = VRELOC;
778 break;
779 }
780 case VINDEXI: {
781 freereg(fs, e->u.ind.t);
782 e->u.info = luaK_codeABC(fs, OP_GETI, 0, e->u.ind.t, e->u.ind.idx);
783 e->k = VRELOC;
784 break;
785 }
786 case VINDEXSTR: {
787 freereg(fs, e->u.ind.t);
788 e->u.info = luaK_codeABC(fs, OP_GETFIELD, 0, e->u.ind.t, e->u.ind.idx);
789 e->k = VRELOC;
790 break;
791 }
792 case VINDEXED: {
793 freeregs(fs, e->u.ind.t, e->u.ind.idx);
794 e->u.info = luaK_codeABC(fs, OP_GETTABLE, 0, e->u.ind.t, e->u.ind.idx);
795 e->k = VRELOC;
796 break;
797 }
798 case VVARARG: case VCALL: {
799 luaK_setoneret(fs, e);
800 break;
801 }
802 default: break; /* there is one value available (somewhere) */
803 }
804}
805
806
807/*
808** Ensures expression value is in register 'reg' (and therefore
809** 'e' will become a non-relocatable expression).
810** (Expression still may have jump lists.)
811*/
812static void discharge2reg (FuncState *fs, expdesc *e, int reg) {
813 luaK_dischargevars(fs, e);
814 switch (e->k) {
815 case VNIL: {
816 luaK_nil(fs, reg, 1);
817 break;
818 }
819 case VFALSE: {
820 luaK_codeABC(fs, OP_LOADFALSE, reg, 0, 0);
821 break;
822 }
823 case VTRUE: {
824 luaK_codeABC(fs, OP_LOADTRUE, reg, 0, 0);
825 break;
826 }
827 case VKSTR: {
828 str2K(fs, e);
829 } /* FALLTHROUGH */
830 case VK: {
831 luaK_codek(fs, reg, e->u.info);
832 break;
833 }
834 case VKFLT: {
835 luaK_float(fs, reg, e->u.nval);
836 break;
837 }
838 case VKINT: {
839 luaK_int(fs, reg, e->u.ival);
840 break;
841 }
842 case VRELOC: {
843 Instruction *pc = &getinstruction(fs, e);
844 SETARG_A(*pc, reg); /* instruction will put result in 'reg' */
845 break;
846 }
847 case VNONRELOC: {
848 if (reg != e->u.info)
849 luaK_codeABC(fs, OP_MOVE, reg, e->u.info, 0);
850 break;
851 }
852 default: {
853 lua_assert(e->k == VJMP);
854 return; /* nothing to do... */
855 }
856 }
857 e->u.info = reg;
858 e->k = VNONRELOC;
859}
860
861
862/*
863** Ensures expression value is in any register.
864** (Expression still may have jump lists.)
865*/
866static void discharge2anyreg (FuncState *fs, expdesc *e) {
867 if (e->k != VNONRELOC) { /* no fixed register yet? */
868 luaK_reserveregs(fs, 1); /* get a register */
869 discharge2reg(fs, e, fs->freereg-1); /* put value there */
870 }
871}
872
873
874static int code_loadbool (FuncState *fs, int A, OpCode op) {
875 luaK_getlabel(fs); /* those instructions may be jump targets */
876 return luaK_codeABC(fs, op, A, 0, 0);
877}
878
879
880/*
881** check whether list has any jump that do not produce a value
882** or produce an inverted value
883*/
884static int need_value (FuncState *fs, int list) {
885 for (; list != NO_JUMP; list = getjump(fs, list)) {
886 Instruction i = *getjumpcontrol(fs, list);
887 if (GET_OPCODE(i) != OP_TESTSET) return 1;
888 }
889 return 0; /* not found */
890}
891
892
893/*
894** Ensures final expression result (which includes results from its
895** jump lists) is in register 'reg'.
896** If expression has jumps, need to patch these jumps either to
897** its final position or to "load" instructions (for those tests
898** that do not produce values).
899*/
900static void exp2reg (FuncState *fs, expdesc *e, int reg) {
901 discharge2reg(fs, e, reg);
902 if (e->k == VJMP) /* expression itself is a test? */
903 luaK_concat(fs, &e->t, e->u.info); /* put this jump in 't' list */
904 if (hasjumps(e)) {
905 int final; /* position after whole expression */
906 int p_f = NO_JUMP; /* position of an eventual LOAD false */
907 int p_t = NO_JUMP; /* position of an eventual LOAD true */
908 if (need_value(fs, e->t) || need_value(fs, e->f)) {
909 int fj = (e->k == VJMP) ? NO_JUMP : luaK_jump(fs);
910 p_f = code_loadbool(fs, reg, OP_LFALSESKIP); /* skip next inst. */
911 p_t = code_loadbool(fs, reg, OP_LOADTRUE);
912 /* jump around these booleans if 'e' is not a test */
913 luaK_patchtohere(fs, fj);
914 }
915 final = luaK_getlabel(fs);
916 patchlistaux(fs, e->f, final, reg, p_f);
917 patchlistaux(fs, e->t, final, reg, p_t);
918 }
919 e->f = e->t = NO_JUMP;
920 e->u.info = reg;
921 e->k = VNONRELOC;
922}
923
924
925/*
926** Ensures final expression result is in next available register.
927*/
928void luaK_exp2nextreg (FuncState *fs, expdesc *e) {
929 luaK_dischargevars(fs, e);
930 freeexp(fs, e);
931 luaK_reserveregs(fs, 1);
932 exp2reg(fs, e, fs->freereg - 1);
933}
934
935
936/*
937** Ensures final expression result is in some (any) register
938** and return that register.
939*/
940int luaK_exp2anyreg (FuncState *fs, expdesc *e) {
941 luaK_dischargevars(fs, e);
942 if (e->k == VNONRELOC) { /* expression already has a register? */
943 if (!hasjumps(e)) /* no jumps? */
944 return e->u.info; /* result is already in a register */
945 if (e->u.info >= luaY_nvarstack(fs)) { /* reg. is not a local? */
946 exp2reg(fs, e, e->u.info); /* put final result in it */
947 return e->u.info;
948 }
949 }
950 luaK_exp2nextreg(fs, e); /* otherwise, use next available register */
951 return e->u.info;
952}
953
954
955/*
956** Ensures final expression result is either in a register
957** or in an upvalue.
958*/
959void luaK_exp2anyregup (FuncState *fs, expdesc *e) {
960 if (e->k != VUPVAL || hasjumps(e))
961 luaK_exp2anyreg(fs, e);
962}
963
964
965/*
966** Ensures final expression result is either in a register
967** or it is a constant.
968*/
969void luaK_exp2val (FuncState *fs, expdesc *e) {
970 if (hasjumps(e))
971 luaK_exp2anyreg(fs, e);
972 else
973 luaK_dischargevars(fs, e);
974}
975
976
977/*
978** Try to make 'e' a K expression with an index in the range of R/K
979** indices. Return true iff succeeded.
980*/
981static int luaK_exp2K (FuncState *fs, expdesc *e) {
982 if (!hasjumps(e)) {
983 int info;
984 switch (e->k) { /* move constants to 'k' */
985 case VTRUE: info = boolT(fs); break;
986 case VFALSE: info = boolF(fs); break;
987 case VNIL: info = nilK(fs); break;
988 case VKINT: info = luaK_intK(fs, e->u.ival); break;
989 case VKFLT: info = luaK_numberK(fs, e->u.nval); break;
990 case VKSTR: info = stringK(fs, e->u.strval); break;
991 case VK: info = e->u.info; break;
992 default: return 0; /* not a constant */
993 }
994 if (info <= MAXINDEXRK) { /* does constant fit in 'argC'? */
995 e->k = VK; /* make expression a 'K' expression */
996 e->u.info = info;
997 return 1;
998 }
999 }
1000 /* else, expression doesn't fit; leave it unchanged */
1001 return 0;
1002}
1003
1004
1005/*
1006** Ensures final expression result is in a valid R/K index
1007** (that is, it is either in a register or in 'k' with an index
1008** in the range of R/K indices).
1009** Returns 1 iff expression is K.
1010*/
1011int luaK_exp2RK (FuncState *fs, expdesc *e) {
1012 if (luaK_exp2K(fs, e))
1013 return 1;
1014 else { /* not a constant in the right range: put it in a register */
1015 luaK_exp2anyreg(fs, e);
1016 return 0;
1017 }
1018}
1019
1020
1021static void codeABRK (FuncState *fs, OpCode o, int a, int b,
1022 expdesc *ec) {
1023 int k = luaK_exp2RK(fs, ec);
1024 luaK_codeABCk(fs, o, a, b, ec->u.info, k);
1025}
1026
1027
1028/*
1029** Generate code to store result of expression 'ex' into variable 'var'.
1030*/
1031void luaK_storevar (FuncState *fs, expdesc *var, expdesc *ex) {
1032 switch (var->k) {
1033 case VLOCAL: {
1034 freeexp(fs, ex);
1035 exp2reg(fs, ex, var->u.var.sidx); /* compute 'ex' into proper place */
1036 return;
1037 }
1038 case VUPVAL: {
1039 int e = luaK_exp2anyreg(fs, ex);
1040 luaK_codeABC(fs, OP_SETUPVAL, e, var->u.info, 0);
1041 break;
1042 }
1043 case VINDEXUP: {
1044 codeABRK(fs, OP_SETTABUP, var->u.ind.t, var->u.ind.idx, ex);
1045 break;
1046 }
1047 case VINDEXI: {
1048 codeABRK(fs, OP_SETI, var->u.ind.t, var->u.ind.idx, ex);
1049 break;
1050 }
1051 case VINDEXSTR: {
1052 codeABRK(fs, OP_SETFIELD, var->u.ind.t, var->u.ind.idx, ex);
1053 break;
1054 }
1055 case VINDEXED: {
1056 codeABRK(fs, OP_SETTABLE, var->u.ind.t, var->u.ind.idx, ex);
1057 break;
1058 }
1059 default: lua_assert(0); /* invalid var kind to store */
1060 }
1061 freeexp(fs, ex);
1062}
1063
1064
1065/*
1066** Emit SELF instruction (convert expression 'e' into 'e:key(e,').
1067*/
1068void luaK_self (FuncState *fs, expdesc *e, expdesc *key) {
1069 int ereg;
1070 luaK_exp2anyreg(fs, e);
1071 ereg = e->u.info; /* register where 'e' was placed */
1072 freeexp(fs, e);
1073 e->u.info = fs->freereg; /* base register for op_self */
1074 e->k = VNONRELOC; /* self expression has a fixed register */
1075 luaK_reserveregs(fs, 2); /* function and 'self' produced by op_self */
1076 codeABRK(fs, OP_SELF, e->u.info, ereg, key);
1077 freeexp(fs, key);
1078}
1079
1080
1081/*
1082** Negate condition 'e' (where 'e' is a comparison).
1083*/
1084static void negatecondition (FuncState *fs, expdesc *e) {
1085 Instruction *pc = getjumpcontrol(fs, e->u.info);
1086 lua_assert(testTMode(GET_OPCODE(*pc)) && GET_OPCODE(*pc) != OP_TESTSET &&
1087 GET_OPCODE(*pc) != OP_TEST);
1088 SETARG_k(*pc, (GETARG_k(*pc) ^ 1));
1089}
1090
1091
1092/*
1093** Emit instruction to jump if 'e' is 'cond' (that is, if 'cond'
1094** is true, code will jump if 'e' is true.) Return jump position.
1095** Optimize when 'e' is 'not' something, inverting the condition
1096** and removing the 'not'.
1097*/
1098static int jumponcond (FuncState *fs, expdesc *e, int cond) {
1099 if (e->k == VRELOC) {
1100 Instruction ie = getinstruction(fs, e);
1101 if (GET_OPCODE(ie) == OP_NOT) {
1102 removelastinstruction(fs); /* remove previous OP_NOT */
1103 return condjump(fs, OP_TEST, GETARG_B(ie), 0, 0, !cond);
1104 }
1105 /* else go through */
1106 }
1107 discharge2anyreg(fs, e);
1108 freeexp(fs, e);
1109 return condjump(fs, OP_TESTSET, NO_REG, e->u.info, 0, cond);
1110}
1111
1112
1113/*
1114** Emit code to go through if 'e' is true, jump otherwise.
1115*/
1116void luaK_goiftrue (FuncState *fs, expdesc *e) {
1117 int pc; /* pc of new jump */
1118 luaK_dischargevars(fs, e);
1119 switch (e->k) {
1120 case VJMP: { /* condition? */
1121 negatecondition(fs, e); /* jump when it is false */
1122 pc = e->u.info; /* save jump position */
1123 break;
1124 }
1125 case VK: case VKFLT: case VKINT: case VKSTR: case VTRUE: {
1126 pc = NO_JUMP; /* always true; do nothing */
1127 break;
1128 }
1129 default: {
1130 pc = jumponcond(fs, e, 0); /* jump when false */
1131 break;
1132 }
1133 }
1134 luaK_concat(fs, &e->f, pc); /* insert new jump in false list */
1135 luaK_patchtohere(fs, e->t); /* true list jumps to here (to go through) */
1136 e->t = NO_JUMP;
1137}
1138
1139
1140/*
1141** Emit code to go through if 'e' is false, jump otherwise.
1142*/
1143void luaK_goiffalse (FuncState *fs, expdesc *e) {
1144 int pc; /* pc of new jump */
1145 luaK_dischargevars(fs, e);
1146 switch (e->k) {
1147 case VJMP: {
1148 pc = e->u.info; /* already jump if true */
1149 break;
1150 }
1151 case VNIL: case VFALSE: {
1152 pc = NO_JUMP; /* always false; do nothing */
1153 break;
1154 }
1155 default: {
1156 pc = jumponcond(fs, e, 1); /* jump if true */
1157 break;
1158 }
1159 }
1160 luaK_concat(fs, &e->t, pc); /* insert new jump in 't' list */
1161 luaK_patchtohere(fs, e->f); /* false list jumps to here (to go through) */
1162 e->f = NO_JUMP;
1163}
1164
1165
1166/*
1167** Code 'not e', doing constant folding.
1168*/
1169static void codenot (FuncState *fs, expdesc *e) {
1170 switch (e->k) {
1171 case VNIL: case VFALSE: {
1172 e->k = VTRUE; /* true == not nil == not false */
1173 break;
1174 }
1175 case VK: case VKFLT: case VKINT: case VKSTR: case VTRUE: {
1176 e->k = VFALSE; /* false == not "x" == not 0.5 == not 1 == not true */
1177 break;
1178 }
1179 case VJMP: {
1180 negatecondition(fs, e);
1181 break;
1182 }
1183 case VRELOC:
1184 case VNONRELOC: {
1185 discharge2anyreg(fs, e);
1186 freeexp(fs, e);
1187 e->u.info = luaK_codeABC(fs, OP_NOT, 0, e->u.info, 0);
1188 e->k = VRELOC;
1189 break;
1190 }
1191 default: lua_assert(0); /* cannot happen */
1192 }
1193 /* interchange true and false lists */
1194 { int temp = e->f; e->f = e->t; e->t = temp; }
1195 removevalues(fs, e->f); /* values are useless when negated */
1196 removevalues(fs, e->t);
1197}
1198
1199
1200/*
1201** Check whether expression 'e' is a small literal string
1202*/
1203static int isKstr (FuncState *fs, expdesc *e) {
1204 return (e->k == VK && !hasjumps(e) && e->u.info <= MAXARG_B &&
1205 ttisshrstring(&fs->f->k[e->u.info]));
1206}
1207
1208/*
1209** Check whether expression 'e' is a literal integer.
1210*/
1211int luaK_isKint (expdesc *e) {
1212 return (e->k == VKINT && !hasjumps(e));
1213}
1214
1215
1216/*
1217** Check whether expression 'e' is a literal integer in
1218** proper range to fit in register C
1219*/
1220static int isCint (expdesc *e) {
1221 return luaK_isKint(e) && (l_castS2U(e->u.ival) <= l_castS2U(MAXARG_C));
1222}
1223
1224
1225/*
1226** Check whether expression 'e' is a literal integer in
1227** proper range to fit in register sC
1228*/
1229static int isSCint (expdesc *e) {
1230 return luaK_isKint(e) && fitsC(e->u.ival);
1231}
1232
1233
1234/*
1235** Check whether expression 'e' is a literal integer or float in
1236** proper range to fit in a register (sB or sC).
1237*/
1238static int isSCnumber (expdesc *e, int *pi, int *isfloat) {
1239 lua_Integer i;
1240 if (e->k == VKINT)
1241 i = e->u.ival;
1242 else if (e->k == VKFLT && luaV_flttointeger(e->u.nval, &i, F2Ieq))
1243 *isfloat = 1;
1244 else
1245 return 0; /* not a number */
1246 if (!hasjumps(e) && fitsC(i)) {
1247 *pi = int2sC(cast_int(i));
1248 return 1;
1249 }
1250 else
1251 return 0;
1252}
1253
1254
1255/*
1256** Create expression 't[k]'. 't' must have its final result already in a
1257** register or upvalue. Upvalues can only be indexed by literal strings.
1258** Keys can be literal strings in the constant table or arbitrary
1259** values in registers.
1260*/
1261void luaK_indexed (FuncState *fs, expdesc *t, expdesc *k) {
1262 if (k->k == VKSTR)
1263 str2K(fs, k);
1264 lua_assert(!hasjumps(t) &&
1265 (t->k == VLOCAL || t->k == VNONRELOC || t->k == VUPVAL));
1266 if (t->k == VUPVAL && !isKstr(fs, k)) /* upvalue indexed by non 'Kstr'? */
1267 luaK_exp2anyreg(fs, t); /* put it in a register */
1268 if (t->k == VUPVAL) {
1269 t->u.ind.t = t->u.info; /* upvalue index */
1270 t->u.ind.idx = k->u.info; /* literal string */
1271 t->k = VINDEXUP;
1272 }
1273 else {
1274 /* register index of the table */
1275 t->u.ind.t = (t->k == VLOCAL) ? t->u.var.sidx: t->u.info;
1276 if (isKstr(fs, k)) {
1277 t->u.ind.idx = k->u.info; /* literal string */
1278 t->k = VINDEXSTR;
1279 }
1280 else if (isCint(k)) {
1281 t->u.ind.idx = cast_int(k->u.ival); /* int. constant in proper range */
1282 t->k = VINDEXI;
1283 }
1284 else {
1285 t->u.ind.idx = luaK_exp2anyreg(fs, k); /* register */
1286 t->k = VINDEXED;
1287 }
1288 }
1289}
1290
1291
1292/*
1293** Return false if folding can raise an error.
1294** Bitwise operations need operands convertible to integers; division
1295** operations cannot have 0 as divisor.
1296*/
1297static int validop (int op, TValue *v1, TValue *v2) {
1298 switch (op) {
1299 case LUA_OPBAND: case LUA_OPBOR: case LUA_OPBXOR:
1300 case LUA_OPSHL: case LUA_OPSHR: case LUA_OPBNOT: { /* conversion errors */
1301 lua_Integer i;
1302 return (tointegerns(v1, &i) && tointegerns(v2, &i));
1303 }
1304 case LUA_OPDIV: case LUA_OPIDIV: case LUA_OPMOD: /* division by 0 */
1305 return (nvalue(v2) != 0);
1306 default: return 1; /* everything else is valid */
1307 }
1308}
1309
1310
1311/*
1312** Try to "constant-fold" an operation; return 1 iff successful.
1313** (In this case, 'e1' has the final result.)
1314*/
1315static int constfolding (FuncState *fs, int op, expdesc *e1,
1316 const expdesc *e2) {
1317 TValue v1, v2, res;
1318 if (!tonumeral(e1, &v1) || !tonumeral(e2, &v2) || !validop(op, &v1, &v2))
1319 return 0; /* non-numeric operands or not safe to fold */
1320 luaO_rawarith(fs->ls->L, op, &v1, &v2, &res); /* does operation */
1321 if (ttisinteger(&res)) {
1322 e1->k = VKINT;
1323 e1->u.ival = ivalue(&res);
1324 }
1325 else { /* folds neither NaN nor 0.0 (to avoid problems with -0.0) */
1326 lua_Number n = fltvalue(&res);
1327 if (luai_numisnan(n) || n == 0)
1328 return 0;
1329 e1->k = VKFLT;
1330 e1->u.nval = n;
1331 }
1332 return 1;
1333}
1334
1335
1336/*
1337** Emit code for unary expressions that "produce values"
1338** (everything but 'not').
1339** Expression to produce final result will be encoded in 'e'.
1340*/
1341static void codeunexpval (FuncState *fs, OpCode op, expdesc *e, int line) {
1342 int r = luaK_exp2anyreg(fs, e); /* opcodes operate only on registers */
1343 freeexp(fs, e);
1344 e->u.info = luaK_codeABC(fs, op, 0, r, 0); /* generate opcode */
1345 e->k = VRELOC; /* all those operations are relocatable */
1346 luaK_fixline(fs, line);
1347}
1348
1349
1350/*
1351** Emit code for binary expressions that "produce values"
1352** (everything but logical operators 'and'/'or' and comparison
1353** operators).
1354** Expression to produce final result will be encoded in 'e1'.
1355*/
1356static void finishbinexpval (FuncState *fs, expdesc *e1, expdesc *e2,
1357 OpCode op, int v2, int flip, int line,
1358 OpCode mmop, TMS event) {
1359 int v1 = luaK_exp2anyreg(fs, e1);
1360 int pc = luaK_codeABCk(fs, op, 0, v1, v2, 0);
1361 freeexps(fs, e1, e2);
1362 e1->u.info = pc;
1363 e1->k = VRELOC; /* all those operations are relocatable */
1364 luaK_fixline(fs, line);
1365 luaK_codeABCk(fs, mmop, v1, v2, event, flip); /* to call metamethod */
1366 luaK_fixline(fs, line);
1367}
1368
1369
1370/*
1371** Emit code for binary expressions that "produce values" over
1372** two registers.
1373*/
1374static void codebinexpval (FuncState *fs, OpCode op,
1375 expdesc *e1, expdesc *e2, int line) {
1376 int v2 = luaK_exp2anyreg(fs, e2); /* both operands are in registers */
1377 lua_assert(OP_ADD <= op && op <= OP_SHR);
1378 finishbinexpval(fs, e1, e2, op, v2, 0, line, OP_MMBIN,
1379 cast(TMS, (op - OP_ADD) + TM_ADD));
1380}
1381
1382
1383/*
1384** Code binary operators with immediate operands.
1385*/
1386static void codebini (FuncState *fs, OpCode op,
1387 expdesc *e1, expdesc *e2, int flip, int line,
1388 TMS event) {
1389 int v2 = int2sC(cast_int(e2->u.ival)); /* immediate operand */
1390 lua_assert(e2->k == VKINT);
1391 finishbinexpval(fs, e1, e2, op, v2, flip, line, OP_MMBINI, event);
1392}
1393
1394
1395/* Try to code a binary operator negating its second operand.
1396** For the metamethod, 2nd operand must keep its original value.
1397*/
1398static int finishbinexpneg (FuncState *fs, expdesc *e1, expdesc *e2,
1399 OpCode op, int line, TMS event) {
1400 if (!luaK_isKint(e2))
1401 return 0; /* not an integer constant */
1402 else {
1403 lua_Integer i2 = e2->u.ival;
1404 if (!(fitsC(i2) && fitsC(-i2)))
1405 return 0; /* not in the proper range */
1406 else { /* operating a small integer constant */
1407 int v2 = cast_int(i2);
1408 finishbinexpval(fs, e1, e2, op, int2sC(-v2), 0, line, OP_MMBINI, event);
1409 /* correct metamethod argument */
1410 SETARG_B(fs->f->code[fs->pc - 1], int2sC(v2));
1411 return 1; /* successfully coded */
1412 }
1413 }
1414}
1415
1416
1417static void swapexps (expdesc *e1, expdesc *e2) {
1418 expdesc temp = *e1; *e1 = *e2; *e2 = temp; /* swap 'e1' and 'e2' */
1419}
1420
1421
1422/*
1423** Code arithmetic operators ('+', '-', ...). If second operand is a
1424** constant in the proper range, use variant opcodes with K operands.
1425*/
1426static void codearith (FuncState *fs, BinOpr opr,
1427 expdesc *e1, expdesc *e2, int flip, int line) {
1428 TMS event = cast(TMS, opr + TM_ADD);
1429 if (tonumeral(e2, NULL) && luaK_exp2K(fs, e2)) { /* K operand? */
1430 int v2 = e2->u.info; /* K index */
1431 OpCode op = cast(OpCode, opr + OP_ADDK);
1432 finishbinexpval(fs, e1, e2, op, v2, flip, line, OP_MMBINK, event);
1433 }
1434 else { /* 'e2' is neither an immediate nor a K operand */
1435 OpCode op = cast(OpCode, opr + OP_ADD);
1436 if (flip)
1437 swapexps(e1, e2); /* back to original order */
1438 codebinexpval(fs, op, e1, e2, line); /* use standard operators */
1439 }
1440}
1441
1442
1443/*
1444** Code commutative operators ('+', '*'). If first operand is a
1445** numeric constant, change order of operands to try to use an
1446** immediate or K operator.
1447*/
1448static void codecommutative (FuncState *fs, BinOpr op,
1449 expdesc *e1, expdesc *e2, int line) {
1450 int flip = 0;
1451 if (tonumeral(e1, NULL)) { /* is first operand a numeric constant? */
1452 swapexps(e1, e2); /* change order */
1453 flip = 1;
1454 }
1455 if (op == OPR_ADD && isSCint(e2)) /* immediate operand? */
1456 codebini(fs, cast(OpCode, OP_ADDI), e1, e2, flip, line, TM_ADD);
1457 else
1458 codearith(fs, op, e1, e2, flip, line);
1459}
1460
1461
1462/*
1463** Code bitwise operations; they are all associative, so the function
1464** tries to put an integer constant as the 2nd operand (a K operand).
1465*/
1466static void codebitwise (FuncState *fs, BinOpr opr,
1467 expdesc *e1, expdesc *e2, int line) {
1468 int flip = 0;
1469 int v2;
1470 OpCode op;
1471 if (e1->k == VKINT && luaK_exp2RK(fs, e1)) {
1472 swapexps(e1, e2); /* 'e2' will be the constant operand */
1473 flip = 1;
1474 }
1475 else if (!(e2->k == VKINT && luaK_exp2RK(fs, e2))) { /* no constants? */
1476 op = cast(OpCode, opr + OP_ADD);
1477 codebinexpval(fs, op, e1, e2, line); /* all-register opcodes */
1478 return;
1479 }
1480 v2 = e2->u.info; /* index in K array */
1481 op = cast(OpCode, opr + OP_ADDK);
1482 lua_assert(ttisinteger(&fs->f->k[v2]));
1483 finishbinexpval(fs, e1, e2, op, v2, flip, line, OP_MMBINK,
1484 cast(TMS, opr + TM_ADD));
1485}
1486
1487
1488/*
1489** Emit code for order comparisons. When using an immediate operand,
1490** 'isfloat' tells whether the original value was a float.
1491*/
1492static void codeorder (FuncState *fs, OpCode op, expdesc *e1, expdesc *e2) {
1493 int r1, r2;
1494 int im;
1495 int isfloat = 0;
1496 if (isSCnumber(e2, &im, &isfloat)) {
1497 /* use immediate operand */
1498 r1 = luaK_exp2anyreg(fs, e1);
1499 r2 = im;
1500 op = cast(OpCode, (op - OP_LT) + OP_LTI);
1501 }
1502 else if (isSCnumber(e1, &im, &isfloat)) {
1503 /* transform (A < B) to (B > A) and (A <= B) to (B >= A) */
1504 r1 = luaK_exp2anyreg(fs, e2);
1505 r2 = im;
1506 op = (op == OP_LT) ? OP_GTI : OP_GEI;
1507 }
1508 else { /* regular case, compare two registers */
1509 r1 = luaK_exp2anyreg(fs, e1);
1510 r2 = luaK_exp2anyreg(fs, e2);
1511 }
1512 freeexps(fs, e1, e2);
1513 e1->u.info = condjump(fs, op, r1, r2, isfloat, 1);
1514 e1->k = VJMP;
1515}
1516
1517
1518/*
1519** Emit code for equality comparisons ('==', '~=').
1520** 'e1' was already put as RK by 'luaK_infix'.
1521*/
1522static void codeeq (FuncState *fs, BinOpr opr, expdesc *e1, expdesc *e2) {
1523 int r1, r2;
1524 int im;
1525 int isfloat = 0; /* not needed here, but kept for symmetry */
1526 OpCode op;
1527 if (e1->k != VNONRELOC) {
1528 lua_assert(e1->k == VK || e1->k == VKINT || e1->k == VKFLT);
1529 swapexps(e1, e2);
1530 }
1531 r1 = luaK_exp2anyreg(fs, e1); /* 1st expression must be in register */
1532 if (isSCnumber(e2, &im, &isfloat)) {
1533 op = OP_EQI;
1534 r2 = im; /* immediate operand */
1535 }
1536 else if (luaK_exp2RK(fs, e2)) { /* 1st expression is constant? */
1537 op = OP_EQK;
1538 r2 = e2->u.info; /* constant index */
1539 }
1540 else {
1541 op = OP_EQ; /* will compare two registers */
1542 r2 = luaK_exp2anyreg(fs, e2);
1543 }
1544 freeexps(fs, e1, e2);
1545 e1->u.info = condjump(fs, op, r1, r2, isfloat, (opr == OPR_EQ));
1546 e1->k = VJMP;
1547}
1548
1549
1550/*
1551** Apply prefix operation 'op' to expression 'e'.
1552*/
1553void luaK_prefix (FuncState *fs, UnOpr op, expdesc *e, int line) {
1554 static const expdesc ef = {VKINT, {0}, NO_JUMP, NO_JUMP};
1555 luaK_dischargevars(fs, e);
1556 switch (op) {
1557 case OPR_MINUS: case OPR_BNOT: /* use 'ef' as fake 2nd operand */
1558 if (constfolding(fs, op + LUA_OPUNM, e, &ef))
1559 break;
1560 /* else */ /* FALLTHROUGH */
1561 case OPR_LEN:
1562 codeunexpval(fs, cast(OpCode, op + OP_UNM), e, line);
1563 break;
1564 case OPR_NOT: codenot(fs, e); break;
1565 default: lua_assert(0);
1566 }
1567}
1568
1569
1570/*
1571** Process 1st operand 'v' of binary operation 'op' before reading
1572** 2nd operand.
1573*/
1574void luaK_infix (FuncState *fs, BinOpr op, expdesc *v) {
1575 luaK_dischargevars(fs, v);
1576 switch (op) {
1577 case OPR_AND: {
1578 luaK_goiftrue(fs, v); /* go ahead only if 'v' is true */
1579 break;
1580 }
1581 case OPR_OR: {
1582 luaK_goiffalse(fs, v); /* go ahead only if 'v' is false */
1583 break;
1584 }
1585 case OPR_CONCAT: {
1586 luaK_exp2nextreg(fs, v); /* operand must be on the stack */
1587 break;
1588 }
1589 case OPR_ADD: case OPR_SUB:
1590 case OPR_MUL: case OPR_DIV: case OPR_IDIV:
1591 case OPR_MOD: case OPR_POW:
1592 case OPR_BAND: case OPR_BOR: case OPR_BXOR:
1593 case OPR_SHL: case OPR_SHR: {
1594 if (!tonumeral(v, NULL))
1595 luaK_exp2anyreg(fs, v);
1596 /* else keep numeral, which may be folded with 2nd operand */
1597 break;
1598 }
1599 case OPR_EQ: case OPR_NE: {
1600 if (!tonumeral(v, NULL))
1601 luaK_exp2RK(fs, v);
1602 /* else keep numeral, which may be an immediate operand */
1603 break;
1604 }
1605 case OPR_LT: case OPR_LE:
1606 case OPR_GT: case OPR_GE: {
1607 int dummy, dummy2;
1608 if (!isSCnumber(v, &dummy, &dummy2))
1609 luaK_exp2anyreg(fs, v);
1610 /* else keep numeral, which may be an immediate operand */
1611 break;
1612 }
1613 default: lua_assert(0);
1614 }
1615}
1616
1617/*
1618** Create code for '(e1 .. e2)'.
1619** For '(e1 .. e2.1 .. e2.2)' (which is '(e1 .. (e2.1 .. e2.2))',
1620** because concatenation is right associative), merge both CONCATs.
1621*/
1622static void codeconcat (FuncState *fs, expdesc *e1, expdesc *e2, int line) {
1623 Instruction *ie2 = previousinstruction(fs);
1624 if (GET_OPCODE(*ie2) == OP_CONCAT) { /* is 'e2' a concatenation? */
1625 int n = GETARG_B(*ie2); /* # of elements concatenated in 'e2' */
1626 lua_assert(e1->u.info + 1 == GETARG_A(*ie2));
1627 freeexp(fs, e2);
1628 SETARG_A(*ie2, e1->u.info); /* correct first element ('e1') */
1629 SETARG_B(*ie2, n + 1); /* will concatenate one more element */
1630 }
1631 else { /* 'e2' is not a concatenation */
1632 luaK_codeABC(fs, OP_CONCAT, e1->u.info, 2, 0); /* new concat opcode */
1633 freeexp(fs, e2);
1634 luaK_fixline(fs, line);
1635 }
1636}
1637
1638
1639/*
1640** Finalize code for binary operation, after reading 2nd operand.
1641*/
1642void luaK_posfix (FuncState *fs, BinOpr opr,
1643 expdesc *e1, expdesc *e2, int line) {
1644 luaK_dischargevars(fs, e2);
1645 if (foldbinop(opr) && constfolding(fs, opr + LUA_OPADD, e1, e2))
1646 return; /* done by folding */
1647 switch (opr) {
1648 case OPR_AND: {
1649 lua_assert(e1->t == NO_JUMP); /* list closed by 'luaK_infix' */
1650 luaK_concat(fs, &e2->f, e1->f);
1651 *e1 = *e2;
1652 break;
1653 }
1654 case OPR_OR: {
1655 lua_assert(e1->f == NO_JUMP); /* list closed by 'luaK_infix' */
1656 luaK_concat(fs, &e2->t, e1->t);
1657 *e1 = *e2;
1658 break;
1659 }
1660 case OPR_CONCAT: { /* e1 .. e2 */
1661 luaK_exp2nextreg(fs, e2);
1662 codeconcat(fs, e1, e2, line);
1663 break;
1664 }
1665 case OPR_ADD: case OPR_MUL: {
1666 codecommutative(fs, opr, e1, e2, line);
1667 break;
1668 }
1669 case OPR_SUB: {
1670 if (finishbinexpneg(fs, e1, e2, OP_ADDI, line, TM_SUB))
1671 break; /* coded as (r1 + -I) */
1672 /* ELSE */
1673 } /* FALLTHROUGH */
1674 case OPR_DIV: case OPR_IDIV: case OPR_MOD: case OPR_POW: {
1675 codearith(fs, opr, e1, e2, 0, line);
1676 break;
1677 }
1678 case OPR_BAND: case OPR_BOR: case OPR_BXOR: {
1679 codebitwise(fs, opr, e1, e2, line);
1680 break;
1681 }
1682 case OPR_SHL: {
1683 if (isSCint(e1)) {
1684 swapexps(e1, e2);
1685 codebini(fs, OP_SHLI, e1, e2, 1, line, TM_SHL); /* I << r2 */
1686 }
1687 else if (finishbinexpneg(fs, e1, e2, OP_SHRI, line, TM_SHL)) {
1688 /* coded as (r1 >> -I) */;
1689 }
1690 else /* regular case (two registers) */
1691 codebinexpval(fs, OP_SHL, e1, e2, line);
1692 break;
1693 }
1694 case OPR_SHR: {
1695 if (isSCint(e2))
1696 codebini(fs, OP_SHRI, e1, e2, 0, line, TM_SHR); /* r1 >> I */
1697 else /* regular case (two registers) */
1698 codebinexpval(fs, OP_SHR, e1, e2, line);
1699 break;
1700 }
1701 case OPR_EQ: case OPR_NE: {
1702 codeeq(fs, opr, e1, e2);
1703 break;
1704 }
1705 case OPR_LT: case OPR_LE: {
1706 OpCode op = cast(OpCode, (opr - OPR_EQ) + OP_EQ);
1707 codeorder(fs, op, e1, e2);
1708 break;
1709 }
1710 case OPR_GT: case OPR_GE: {
1711 /* '(a > b)' <=> '(b < a)'; '(a >= b)' <=> '(b <= a)' */
1712 OpCode op = cast(OpCode, (opr - OPR_NE) + OP_EQ);
1713 swapexps(e1, e2);
1714 codeorder(fs, op, e1, e2);
1715 break;
1716 }
1717 default: lua_assert(0);
1718 }
1719}
1720
1721
1722/*
1723** Change line information associated with current position, by removing
1724** previous info and adding it again with new line.
1725*/
1726void luaK_fixline (FuncState *fs, int line) {
1727 removelastlineinfo(fs);
1728 savelineinfo(fs, fs->f, line);
1729}
1730
1731
1732void luaK_settablesize (FuncState *fs, int pc, int ra, int asize, int hsize) {
1733 Instruction *inst = &fs->f->code[pc];
1734 int rb = (hsize != 0) ? luaO_ceillog2(hsize) + 1 : 0; /* hash size */
1735 int extra = asize / (MAXARG_C + 1); /* higher bits of array size */
1736 int rc = asize % (MAXARG_C + 1); /* lower bits of array size */
1737 int k = (extra > 0); /* true iff needs extra argument */
1738 *inst = CREATE_ABCk(OP_NEWTABLE, ra, rb, rc, k);
1739 *(inst + 1) = CREATE_Ax(OP_EXTRAARG, extra);
1740}
1741
1742
1743/*
1744** Emit a SETLIST instruction.
1745** 'base' is register that keeps table;
1746** 'nelems' is #table plus those to be stored now;
1747** 'tostore' is number of values (in registers 'base + 1',...) to add to
1748** table (or LUA_MULTRET to add up to stack top).
1749*/
1750void luaK_setlist (FuncState *fs, int base, int nelems, int tostore) {
1751 lua_assert(tostore != 0 && tostore <= LFIELDS_PER_FLUSH);
1752 if (tostore == LUA_MULTRET)
1753 tostore = 0;
1754 if (nelems <= MAXARG_C)
1755 luaK_codeABC(fs, OP_SETLIST, base, tostore, nelems);
1756 else {
1757 int extra = nelems / (MAXARG_C + 1);
1758 nelems %= (MAXARG_C + 1);
1759 luaK_codeABCk(fs, OP_SETLIST, base, tostore, nelems, 1);
1760 codeextraarg(fs, extra);
1761 }
1762 fs->freereg = base + 1; /* free registers with list values */
1763}
1764
1765
1766/*
1767** return the final target of a jump (skipping jumps to jumps)
1768*/
1769static int finaltarget (Instruction *code, int i) {
1770 int count;
1771 for (count = 0; count < 100; count++) { /* avoid infinite loops */
1772 Instruction pc = code[i];
1773 if (GET_OPCODE(pc) != OP_JMP)
1774 break;
1775 else
1776 i += GETARG_sJ(pc) + 1;
1777 }
1778 return i;
1779}
1780
1781
1782/*
1783** Do a final pass over the code of a function, doing small peephole
1784** optimizations and adjustments.
1785*/
1786void luaK_finish (FuncState *fs) {
1787 int i;
1788 Proto *p = fs->f;
1789 for (i = 0; i < fs->pc; i++) {
1790 Instruction *pc = &p->code[i];
1791 lua_assert(i == 0 || isOT(*(pc - 1)) == isIT(*pc));
1792 switch (GET_OPCODE(*pc)) {
1793 case OP_RETURN0: case OP_RETURN1: {
1794 if (!(fs->needclose || p->is_vararg))
1795 break; /* no extra work */
1796 /* else use OP_RETURN to do the extra work */
1797 SET_OPCODE(*pc, OP_RETURN);
1798 } /* FALLTHROUGH */
1799 case OP_RETURN: case OP_TAILCALL: {
1800 if (fs->needclose)
1801 SETARG_k(*pc, 1); /* signal that it needs to close */
1802 if (p->is_vararg)
1803 SETARG_C(*pc, p->numparams + 1); /* signal that it is vararg */
1804 break;
1805 }
1806 case OP_JMP: {
1807 int target = finaltarget(p->code, i);
1808 fixjump(fs, i, target);
1809 break;
1810 }
1811 default: break;
1812 }
1813 }
1814}
diff --git a/src/lua/lcode.h b/src/lua/lcode.h
new file mode 100644
index 0000000..3265824
--- /dev/null
+++ b/src/lua/lcode.h
@@ -0,0 +1,104 @@
1/*
2** $Id: lcode.h $
3** Code generator for Lua
4** See Copyright Notice in lua.h
5*/
6
7#ifndef lcode_h
8#define lcode_h
9
10#include "llex.h"
11#include "lobject.h"
12#include "lopcodes.h"
13#include "lparser.h"
14
15
16/*
17** Marks the end of a patch list. It is an invalid value both as an absolute
18** address, and as a list link (would link an element to itself).
19*/
20#define NO_JUMP (-1)
21
22
23/*
24** grep "ORDER OPR" if you change these enums (ORDER OP)
25*/
26typedef enum BinOpr {
27 /* arithmetic operators */
28 OPR_ADD, OPR_SUB, OPR_MUL, OPR_MOD, OPR_POW,
29 OPR_DIV, OPR_IDIV,
30 /* bitwise operators */
31 OPR_BAND, OPR_BOR, OPR_BXOR,
32 OPR_SHL, OPR_SHR,
33 /* string operator */
34 OPR_CONCAT,
35 /* comparison operators */
36 OPR_EQ, OPR_LT, OPR_LE,
37 OPR_NE, OPR_GT, OPR_GE,
38 /* logical operators */
39 OPR_AND, OPR_OR,
40 OPR_NOBINOPR
41} BinOpr;
42
43
44/* true if operation is foldable (that is, it is arithmetic or bitwise) */
45#define foldbinop(op) ((op) <= OPR_SHR)
46
47
48#define luaK_codeABC(fs,o,a,b,c) luaK_codeABCk(fs,o,a,b,c,0)
49
50
51typedef enum UnOpr { OPR_MINUS, OPR_BNOT, OPR_NOT, OPR_LEN, OPR_NOUNOPR } UnOpr;
52
53
54/* get (pointer to) instruction of given 'expdesc' */
55#define getinstruction(fs,e) ((fs)->f->code[(e)->u.info])
56
57
58#define luaK_setmultret(fs,e) luaK_setreturns(fs, e, LUA_MULTRET)
59
60#define luaK_jumpto(fs,t) luaK_patchlist(fs, luaK_jump(fs), t)
61
62LUAI_FUNC int luaK_code (FuncState *fs, Instruction i);
63LUAI_FUNC int luaK_codeABx (FuncState *fs, OpCode o, int A, unsigned int Bx);
64LUAI_FUNC int luaK_codeAsBx (FuncState *fs, OpCode o, int A, int Bx);
65LUAI_FUNC int luaK_codeABCk (FuncState *fs, OpCode o, int A,
66 int B, int C, int k);
67LUAI_FUNC int luaK_isKint (expdesc *e);
68LUAI_FUNC int luaK_exp2const (FuncState *fs, const expdesc *e, TValue *v);
69LUAI_FUNC void luaK_fixline (FuncState *fs, int line);
70LUAI_FUNC void luaK_nil (FuncState *fs, int from, int n);
71LUAI_FUNC void luaK_reserveregs (FuncState *fs, int n);
72LUAI_FUNC void luaK_checkstack (FuncState *fs, int n);
73LUAI_FUNC void luaK_int (FuncState *fs, int reg, lua_Integer n);
74LUAI_FUNC void luaK_dischargevars (FuncState *fs, expdesc *e);
75LUAI_FUNC int luaK_exp2anyreg (FuncState *fs, expdesc *e);
76LUAI_FUNC void luaK_exp2anyregup (FuncState *fs, expdesc *e);
77LUAI_FUNC void luaK_exp2nextreg (FuncState *fs, expdesc *e);
78LUAI_FUNC void luaK_exp2val (FuncState *fs, expdesc *e);
79LUAI_FUNC int luaK_exp2RK (FuncState *fs, expdesc *e);
80LUAI_FUNC void luaK_self (FuncState *fs, expdesc *e, expdesc *key);
81LUAI_FUNC void luaK_indexed (FuncState *fs, expdesc *t, expdesc *k);
82LUAI_FUNC void luaK_goiftrue (FuncState *fs, expdesc *e);
83LUAI_FUNC void luaK_goiffalse (FuncState *fs, expdesc *e);
84LUAI_FUNC void luaK_storevar (FuncState *fs, expdesc *var, expdesc *e);
85LUAI_FUNC void luaK_setreturns (FuncState *fs, expdesc *e, int nresults);
86LUAI_FUNC void luaK_setoneret (FuncState *fs, expdesc *e);
87LUAI_FUNC int luaK_jump (FuncState *fs);
88LUAI_FUNC void luaK_ret (FuncState *fs, int first, int nret);
89LUAI_FUNC void luaK_patchlist (FuncState *fs, int list, int target);
90LUAI_FUNC void luaK_patchtohere (FuncState *fs, int list);
91LUAI_FUNC void luaK_concat (FuncState *fs, int *l1, int l2);
92LUAI_FUNC int luaK_getlabel (FuncState *fs);
93LUAI_FUNC void luaK_prefix (FuncState *fs, UnOpr op, expdesc *v, int line);
94LUAI_FUNC void luaK_infix (FuncState *fs, BinOpr op, expdesc *v);
95LUAI_FUNC void luaK_posfix (FuncState *fs, BinOpr op, expdesc *v1,
96 expdesc *v2, int line);
97LUAI_FUNC void luaK_settablesize (FuncState *fs, int pc,
98 int ra, int asize, int hsize);
99LUAI_FUNC void luaK_setlist (FuncState *fs, int base, int nelems, int tostore);
100LUAI_FUNC void luaK_finish (FuncState *fs);
101LUAI_FUNC l_noret luaK_semerror (LexState *ls, const char *msg);
102
103
104#endif
diff --git a/src/lua/lcorolib.c b/src/lua/lcorolib.c
new file mode 100644
index 0000000..7d6e585
--- /dev/null
+++ b/src/lua/lcorolib.c
@@ -0,0 +1,206 @@
1/*
2** $Id: lcorolib.c $
3** Coroutine Library
4** See Copyright Notice in lua.h
5*/
6
7#define lcorolib_c
8#define LUA_LIB
9
10#include "lprefix.h"
11
12
13#include <stdlib.h>
14
15#include "lua.h"
16
17#include "lauxlib.h"
18#include "lualib.h"
19
20
21static lua_State *getco (lua_State *L) {
22 lua_State *co = lua_tothread(L, 1);
23 luaL_argexpected(L, co, 1, "thread");
24 return co;
25}
26
27
28/*
29** Resumes a coroutine. Returns the number of results for non-error
30** cases or -1 for errors.
31*/
32static int auxresume (lua_State *L, lua_State *co, int narg) {
33 int status, nres;
34 if (!lua_checkstack(co, narg)) {
35 lua_pushliteral(L, "too many arguments to resume");
36 return -1; /* error flag */
37 }
38 lua_xmove(L, co, narg);
39 status = lua_resume(co, L, narg, &nres);
40 if (status == LUA_OK || status == LUA_YIELD) {
41 if (!lua_checkstack(L, nres + 1)) {
42 lua_pop(co, nres); /* remove results anyway */
43 lua_pushliteral(L, "too many results to resume");
44 return -1; /* error flag */
45 }
46 lua_xmove(co, L, nres); /* move yielded values */
47 return nres;
48 }
49 else {
50 lua_xmove(co, L, 1); /* move error message */
51 return -1; /* error flag */
52 }
53}
54
55
56static int luaB_coresume (lua_State *L) {
57 lua_State *co = getco(L);
58 int r;
59 r = auxresume(L, co, lua_gettop(L) - 1);
60 if (r < 0) {
61 lua_pushboolean(L, 0);
62 lua_insert(L, -2);
63 return 2; /* return false + error message */
64 }
65 else {
66 lua_pushboolean(L, 1);
67 lua_insert(L, -(r + 1));
68 return r + 1; /* return true + 'resume' returns */
69 }
70}
71
72
73static int luaB_auxwrap (lua_State *L) {
74 lua_State *co = lua_tothread(L, lua_upvalueindex(1));
75 int r = auxresume(L, co, lua_gettop(L));
76 if (r < 0) {
77 int stat = lua_status(co);
78 if (stat != LUA_OK && stat != LUA_YIELD)
79 lua_resetthread(co); /* close variables in case of errors */
80 if (lua_type(L, -1) == LUA_TSTRING) { /* error object is a string? */
81 luaL_where(L, 1); /* add extra info, if available */
82 lua_insert(L, -2);
83 lua_concat(L, 2);
84 }
85 return lua_error(L); /* propagate error */
86 }
87 return r;
88}
89
90
91static int luaB_cocreate (lua_State *L) {
92 lua_State *NL;
93 luaL_checktype(L, 1, LUA_TFUNCTION);
94 NL = lua_newthread(L);
95 lua_pushvalue(L, 1); /* move function to top */
96 lua_xmove(L, NL, 1); /* move function from L to NL */
97 return 1;
98}
99
100
101static int luaB_cowrap (lua_State *L) {
102 luaB_cocreate(L);
103 lua_pushcclosure(L, luaB_auxwrap, 1);
104 return 1;
105}
106
107
108static int luaB_yield (lua_State *L) {
109 return lua_yield(L, lua_gettop(L));
110}
111
112
113#define COS_RUN 0
114#define COS_DEAD 1
115#define COS_YIELD 2
116#define COS_NORM 3
117
118
119static const char *const statname[] =
120 {"running", "dead", "suspended", "normal"};
121
122
123static int auxstatus (lua_State *L, lua_State *co) {
124 if (L == co) return COS_RUN;
125 else {
126 switch (lua_status(co)) {
127 case LUA_YIELD:
128 return COS_YIELD;
129 case LUA_OK: {
130 lua_Debug ar;
131 if (lua_getstack(co, 0, &ar)) /* does it have frames? */
132 return COS_NORM; /* it is running */
133 else if (lua_gettop(co) == 0)
134 return COS_DEAD;
135 else
136 return COS_YIELD; /* initial state */
137 }
138 default: /* some error occurred */
139 return COS_DEAD;
140 }
141 }
142}
143
144
145static int luaB_costatus (lua_State *L) {
146 lua_State *co = getco(L);
147 lua_pushstring(L, statname[auxstatus(L, co)]);
148 return 1;
149}
150
151
152static int luaB_yieldable (lua_State *L) {
153 lua_State *co = lua_isnone(L, 1) ? L : getco(L);
154 lua_pushboolean(L, lua_isyieldable(co));
155 return 1;
156}
157
158
159static int luaB_corunning (lua_State *L) {
160 int ismain = lua_pushthread(L);
161 lua_pushboolean(L, ismain);
162 return 2;
163}
164
165
166static int luaB_close (lua_State *L) {
167 lua_State *co = getco(L);
168 int status = auxstatus(L, co);
169 switch (status) {
170 case COS_DEAD: case COS_YIELD: {
171 status = lua_resetthread(co);
172 if (status == LUA_OK) {
173 lua_pushboolean(L, 1);
174 return 1;
175 }
176 else {
177 lua_pushboolean(L, 0);
178 lua_xmove(co, L, 1); /* copy error message */
179 return 2;
180 }
181 }
182 default: /* normal or running coroutine */
183 return luaL_error(L, "cannot close a %s coroutine", statname[status]);
184 }
185}
186
187
188static const luaL_Reg co_funcs[] = {
189 {"create", luaB_cocreate},
190 {"resume", luaB_coresume},
191 {"running", luaB_corunning},
192 {"status", luaB_costatus},
193 {"wrap", luaB_cowrap},
194 {"yield", luaB_yield},
195 {"isyieldable", luaB_yieldable},
196 {"close", luaB_close},
197 {NULL, NULL}
198};
199
200
201
202LUAMOD_API int luaopen_coroutine (lua_State *L) {
203 luaL_newlib(L, co_funcs);
204 return 1;
205}
206
diff --git a/src/lua/lctype.c b/src/lua/lctype.c
new file mode 100644
index 0000000..9542280
--- /dev/null
+++ b/src/lua/lctype.c
@@ -0,0 +1,64 @@
1/*
2** $Id: lctype.c $
3** 'ctype' functions for Lua
4** See Copyright Notice in lua.h
5*/
6
7#define lctype_c
8#define LUA_CORE
9
10#include "lprefix.h"
11
12
13#include "lctype.h"
14
15#if !LUA_USE_CTYPE /* { */
16
17#include <limits.h>
18
19
20#if defined (LUA_UCID) /* accept UniCode IDentifiers? */
21/* consider all non-ascii codepoints to be alphabetic */
22#define NONA 0x01
23#else
24#define NONA 0x00 /* default */
25#endif
26
27
28LUAI_DDEF const lu_byte luai_ctype_[UCHAR_MAX + 2] = {
29 0x00, /* EOZ */
30 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* 0. */
31 0x00, 0x08, 0x08, 0x08, 0x08, 0x08, 0x00, 0x00,
32 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* 1. */
33 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
34 0x0c, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04, /* 2. */
35 0x04, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04,
36 0x16, 0x16, 0x16, 0x16, 0x16, 0x16, 0x16, 0x16, /* 3. */
37 0x16, 0x16, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04,
38 0x04, 0x15, 0x15, 0x15, 0x15, 0x15, 0x15, 0x05, /* 4. */
39 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05,
40 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, /* 5. */
41 0x05, 0x05, 0x05, 0x04, 0x04, 0x04, 0x04, 0x05,
42 0x04, 0x15, 0x15, 0x15, 0x15, 0x15, 0x15, 0x05, /* 6. */
43 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05,
44 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, /* 7. */
45 0x05, 0x05, 0x05, 0x04, 0x04, 0x04, 0x04, 0x00,
46 NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA, /* 8. */
47 NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA,
48 NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA, /* 9. */
49 NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA,
50 NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA, /* a. */
51 NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA,
52 NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA, /* b. */
53 NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA,
54 0x00, 0x00, NONA, NONA, NONA, NONA, NONA, NONA, /* c. */
55 NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA,
56 NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA, /* d. */
57 NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA,
58 NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA, /* e. */
59 NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA,
60 NONA, NONA, NONA, NONA, NONA, 0x00, 0x00, 0x00, /* f. */
61 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
62};
63
64#endif /* } */
diff --git a/src/lua/lctype.h b/src/lua/lctype.h
new file mode 100644
index 0000000..cbff4d7
--- /dev/null
+++ b/src/lua/lctype.h
@@ -0,0 +1,95 @@
1/*
2** $Id: lctype.h $
3** 'ctype' functions for Lua
4** See Copyright Notice in lua.h
5*/
6
7#ifndef lctype_h
8#define lctype_h
9
10#include "lua.h"
11
12
13/*
14** WARNING: the functions defined here do not necessarily correspond
15** to the similar functions in the standard C ctype.h. They are
16** optimized for the specific needs of Lua
17*/
18
19#if !defined(LUA_USE_CTYPE)
20
21#if 'A' == 65 && '0' == 48
22/* ASCII case: can use its own tables; faster and fixed */
23#define LUA_USE_CTYPE 0
24#else
25/* must use standard C ctype */
26#define LUA_USE_CTYPE 1
27#endif
28
29#endif
30
31
32#if !LUA_USE_CTYPE /* { */
33
34#include <limits.h>
35
36#include "llimits.h"
37
38
39#define ALPHABIT 0
40#define DIGITBIT 1
41#define PRINTBIT 2
42#define SPACEBIT 3
43#define XDIGITBIT 4
44
45
46#define MASK(B) (1 << (B))
47
48
49/*
50** add 1 to char to allow index -1 (EOZ)
51*/
52#define testprop(c,p) (luai_ctype_[(c)+1] & (p))
53
54/*
55** 'lalpha' (Lua alphabetic) and 'lalnum' (Lua alphanumeric) both include '_'
56*/
57#define lislalpha(c) testprop(c, MASK(ALPHABIT))
58#define lislalnum(c) testprop(c, (MASK(ALPHABIT) | MASK(DIGITBIT)))
59#define lisdigit(c) testprop(c, MASK(DIGITBIT))
60#define lisspace(c) testprop(c, MASK(SPACEBIT))
61#define lisprint(c) testprop(c, MASK(PRINTBIT))
62#define lisxdigit(c) testprop(c, MASK(XDIGITBIT))
63
64/*
65** this 'ltolower' only works for alphabetic characters
66*/
67#define ltolower(c) ((c) | ('A' ^ 'a'))
68
69
70/* two more entries for 0 and -1 (EOZ) */
71LUAI_DDEC(const lu_byte luai_ctype_[UCHAR_MAX + 2];)
72
73
74#else /* }{ */
75
76/*
77** use standard C ctypes
78*/
79
80#include <ctype.h>
81
82
83#define lislalpha(c) (isalpha(c) || (c) == '_')
84#define lislalnum(c) (isalnum(c) || (c) == '_')
85#define lisdigit(c) (isdigit(c))
86#define lisspace(c) (isspace(c))
87#define lisprint(c) (isprint(c))
88#define lisxdigit(c) (isxdigit(c))
89
90#define ltolower(c) (tolower(c))
91
92#endif /* } */
93
94#endif
95
diff --git a/src/lua/ldblib.c b/src/lua/ldblib.c
new file mode 100644
index 0000000..59eb8f0
--- /dev/null
+++ b/src/lua/ldblib.c
@@ -0,0 +1,477 @@
1/*
2** $Id: ldblib.c $
3** Interface from Lua to its debug API
4** See Copyright Notice in lua.h
5*/
6
7#define ldblib_c
8#define LUA_LIB
9
10#include "lprefix.h"
11
12
13#include <stdio.h>
14#include <stdlib.h>
15#include <string.h>
16
17#include "lua.h"
18
19#include "lauxlib.h"
20#include "lualib.h"
21
22
23/*
24** The hook table at registry[HOOKKEY] maps threads to their current
25** hook function.
26*/
27static const char *const HOOKKEY = "_HOOKKEY";
28
29
30/*
31** If L1 != L, L1 can be in any state, and therefore there are no
32** guarantees about its stack space; any push in L1 must be
33** checked.
34*/
35static void checkstack (lua_State *L, lua_State *L1, int n) {
36 if (L != L1 && !lua_checkstack(L1, n))
37 luaL_error(L, "stack overflow");
38}
39
40
41static int db_getregistry (lua_State *L) {
42 lua_pushvalue(L, LUA_REGISTRYINDEX);
43 return 1;
44}
45
46
47static int db_getmetatable (lua_State *L) {
48 luaL_checkany(L, 1);
49 if (!lua_getmetatable(L, 1)) {
50 lua_pushnil(L); /* no metatable */
51 }
52 return 1;
53}
54
55
56static int db_setmetatable (lua_State *L) {
57 int t = lua_type(L, 2);
58 luaL_argexpected(L, t == LUA_TNIL || t == LUA_TTABLE, 2, "nil or table");
59 lua_settop(L, 2);
60 lua_setmetatable(L, 1);
61 return 1; /* return 1st argument */
62}
63
64
65static int db_getuservalue (lua_State *L) {
66 int n = (int)luaL_optinteger(L, 2, 1);
67 if (lua_type(L, 1) != LUA_TUSERDATA)
68 luaL_pushfail(L);
69 else if (lua_getiuservalue(L, 1, n) != LUA_TNONE) {
70 lua_pushboolean(L, 1);
71 return 2;
72 }
73 return 1;
74}
75
76
77static int db_setuservalue (lua_State *L) {
78 int n = (int)luaL_optinteger(L, 3, 1);
79 luaL_checktype(L, 1, LUA_TUSERDATA);
80 luaL_checkany(L, 2);
81 lua_settop(L, 2);
82 if (!lua_setiuservalue(L, 1, n))
83 luaL_pushfail(L);
84 return 1;
85}
86
87
88/*
89** Auxiliary function used by several library functions: check for
90** an optional thread as function's first argument and set 'arg' with
91** 1 if this argument is present (so that functions can skip it to
92** access their other arguments)
93*/
94static lua_State *getthread (lua_State *L, int *arg) {
95 if (lua_isthread(L, 1)) {
96 *arg = 1;
97 return lua_tothread(L, 1);
98 }
99 else {
100 *arg = 0;
101 return L; /* function will operate over current thread */
102 }
103}
104
105
106/*
107** Variations of 'lua_settable', used by 'db_getinfo' to put results
108** from 'lua_getinfo' into result table. Key is always a string;
109** value can be a string, an int, or a boolean.
110*/
111static void settabss (lua_State *L, const char *k, const char *v) {
112 lua_pushstring(L, v);
113 lua_setfield(L, -2, k);
114}
115
116static void settabsi (lua_State *L, const char *k, int v) {
117 lua_pushinteger(L, v);
118 lua_setfield(L, -2, k);
119}
120
121static void settabsb (lua_State *L, const char *k, int v) {
122 lua_pushboolean(L, v);
123 lua_setfield(L, -2, k);
124}
125
126
127/*
128** In function 'db_getinfo', the call to 'lua_getinfo' may push
129** results on the stack; later it creates the result table to put
130** these objects. Function 'treatstackoption' puts the result from
131** 'lua_getinfo' on top of the result table so that it can call
132** 'lua_setfield'.
133*/
134static void treatstackoption (lua_State *L, lua_State *L1, const char *fname) {
135 if (L == L1)
136 lua_rotate(L, -2, 1); /* exchange object and table */
137 else
138 lua_xmove(L1, L, 1); /* move object to the "main" stack */
139 lua_setfield(L, -2, fname); /* put object into table */
140}
141
142
143/*
144** Calls 'lua_getinfo' and collects all results in a new table.
145** L1 needs stack space for an optional input (function) plus
146** two optional outputs (function and line table) from function
147** 'lua_getinfo'.
148*/
149static int db_getinfo (lua_State *L) {
150 lua_Debug ar;
151 int arg;
152 lua_State *L1 = getthread(L, &arg);
153 const char *options = luaL_optstring(L, arg+2, "flnSrtu");
154 checkstack(L, L1, 3);
155 if (lua_isfunction(L, arg + 1)) { /* info about a function? */
156 options = lua_pushfstring(L, ">%s", options); /* add '>' to 'options' */
157 lua_pushvalue(L, arg + 1); /* move function to 'L1' stack */
158 lua_xmove(L, L1, 1);
159 }
160 else { /* stack level */
161 if (!lua_getstack(L1, (int)luaL_checkinteger(L, arg + 1), &ar)) {
162 luaL_pushfail(L); /* level out of range */
163 return 1;
164 }
165 }
166 if (!lua_getinfo(L1, options, &ar))
167 return luaL_argerror(L, arg+2, "invalid option");
168 lua_newtable(L); /* table to collect results */
169 if (strchr(options, 'S')) {
170 lua_pushlstring(L, ar.source, ar.srclen);
171 lua_setfield(L, -2, "source");
172 settabss(L, "short_src", ar.short_src);
173 settabsi(L, "linedefined", ar.linedefined);
174 settabsi(L, "lastlinedefined", ar.lastlinedefined);
175 settabss(L, "what", ar.what);
176 }
177 if (strchr(options, 'l'))
178 settabsi(L, "currentline", ar.currentline);
179 if (strchr(options, 'u')) {
180 settabsi(L, "nups", ar.nups);
181 settabsi(L, "nparams", ar.nparams);
182 settabsb(L, "isvararg", ar.isvararg);
183 }
184 if (strchr(options, 'n')) {
185 settabss(L, "name", ar.name);
186 settabss(L, "namewhat", ar.namewhat);
187 }
188 if (strchr(options, 'r')) {
189 settabsi(L, "ftransfer", ar.ftransfer);
190 settabsi(L, "ntransfer", ar.ntransfer);
191 }
192 if (strchr(options, 't'))
193 settabsb(L, "istailcall", ar.istailcall);
194 if (strchr(options, 'L'))
195 treatstackoption(L, L1, "activelines");
196 if (strchr(options, 'f'))
197 treatstackoption(L, L1, "func");
198 return 1; /* return table */
199}
200
201
202static int db_getlocal (lua_State *L) {
203 int arg;
204 lua_State *L1 = getthread(L, &arg);
205 int nvar = (int)luaL_checkinteger(L, arg + 2); /* local-variable index */
206 if (lua_isfunction(L, arg + 1)) { /* function argument? */
207 lua_pushvalue(L, arg + 1); /* push function */
208 lua_pushstring(L, lua_getlocal(L, NULL, nvar)); /* push local name */
209 return 1; /* return only name (there is no value) */
210 }
211 else { /* stack-level argument */
212 lua_Debug ar;
213 const char *name;
214 int level = (int)luaL_checkinteger(L, arg + 1);
215 if (!lua_getstack(L1, level, &ar)) /* out of range? */
216 return luaL_argerror(L, arg+1, "level out of range");
217 checkstack(L, L1, 1);
218 name = lua_getlocal(L1, &ar, nvar);
219 if (name) {
220 lua_xmove(L1, L, 1); /* move local value */
221 lua_pushstring(L, name); /* push name */
222 lua_rotate(L, -2, 1); /* re-order */
223 return 2;
224 }
225 else {
226 luaL_pushfail(L); /* no name (nor value) */
227 return 1;
228 }
229 }
230}
231
232
233static int db_setlocal (lua_State *L) {
234 int arg;
235 const char *name;
236 lua_State *L1 = getthread(L, &arg);
237 lua_Debug ar;
238 int level = (int)luaL_checkinteger(L, arg + 1);
239 int nvar = (int)luaL_checkinteger(L, arg + 2);
240 if (!lua_getstack(L1, level, &ar)) /* out of range? */
241 return luaL_argerror(L, arg+1, "level out of range");
242 luaL_checkany(L, arg+3);
243 lua_settop(L, arg+3);
244 checkstack(L, L1, 1);
245 lua_xmove(L, L1, 1);
246 name = lua_setlocal(L1, &ar, nvar);
247 if (name == NULL)
248 lua_pop(L1, 1); /* pop value (if not popped by 'lua_setlocal') */
249 lua_pushstring(L, name);
250 return 1;
251}
252
253
254/*
255** get (if 'get' is true) or set an upvalue from a closure
256*/
257static int auxupvalue (lua_State *L, int get) {
258 const char *name;
259 int n = (int)luaL_checkinteger(L, 2); /* upvalue index */
260 luaL_checktype(L, 1, LUA_TFUNCTION); /* closure */
261 name = get ? lua_getupvalue(L, 1, n) : lua_setupvalue(L, 1, n);
262 if (name == NULL) return 0;
263 lua_pushstring(L, name);
264 lua_insert(L, -(get+1)); /* no-op if get is false */
265 return get + 1;
266}
267
268
269static int db_getupvalue (lua_State *L) {
270 return auxupvalue(L, 1);
271}
272
273
274static int db_setupvalue (lua_State *L) {
275 luaL_checkany(L, 3);
276 return auxupvalue(L, 0);
277}
278
279
280/*
281** Check whether a given upvalue from a given closure exists and
282** returns its index
283*/
284static int checkupval (lua_State *L, int argf, int argnup) {
285 int nup = (int)luaL_checkinteger(L, argnup); /* upvalue index */
286 luaL_checktype(L, argf, LUA_TFUNCTION); /* closure */
287 luaL_argcheck(L, (lua_getupvalue(L, argf, nup) != NULL), argnup,
288 "invalid upvalue index");
289 return nup;
290}
291
292
293static int db_upvalueid (lua_State *L) {
294 int n = checkupval(L, 1, 2);
295 lua_pushlightuserdata(L, lua_upvalueid(L, 1, n));
296 return 1;
297}
298
299
300static int db_upvaluejoin (lua_State *L) {
301 int n1 = checkupval(L, 1, 2);
302 int n2 = checkupval(L, 3, 4);
303 luaL_argcheck(L, !lua_iscfunction(L, 1), 1, "Lua function expected");
304 luaL_argcheck(L, !lua_iscfunction(L, 3), 3, "Lua function expected");
305 lua_upvaluejoin(L, 1, n1, 3, n2);
306 return 0;
307}
308
309
310/*
311** Call hook function registered at hook table for the current
312** thread (if there is one)
313*/
314static void hookf (lua_State *L, lua_Debug *ar) {
315 static const char *const hooknames[] =
316 {"call", "return", "line", "count", "tail call"};
317 lua_getfield(L, LUA_REGISTRYINDEX, HOOKKEY);
318 lua_pushthread(L);
319 if (lua_rawget(L, -2) == LUA_TFUNCTION) { /* is there a hook function? */
320 lua_pushstring(L, hooknames[(int)ar->event]); /* push event name */
321 if (ar->currentline >= 0)
322 lua_pushinteger(L, ar->currentline); /* push current line */
323 else lua_pushnil(L);
324 lua_assert(lua_getinfo(L, "lS", ar));
325 lua_call(L, 2, 0); /* call hook function */
326 }
327}
328
329
330/*
331** Convert a string mask (for 'sethook') into a bit mask
332*/
333static int makemask (const char *smask, int count) {
334 int mask = 0;
335 if (strchr(smask, 'c')) mask |= LUA_MASKCALL;
336 if (strchr(smask, 'r')) mask |= LUA_MASKRET;
337 if (strchr(smask, 'l')) mask |= LUA_MASKLINE;
338 if (count > 0) mask |= LUA_MASKCOUNT;
339 return mask;
340}
341
342
343/*
344** Convert a bit mask (for 'gethook') into a string mask
345*/
346static char *unmakemask (int mask, char *smask) {
347 int i = 0;
348 if (mask & LUA_MASKCALL) smask[i++] = 'c';
349 if (mask & LUA_MASKRET) smask[i++] = 'r';
350 if (mask & LUA_MASKLINE) smask[i++] = 'l';
351 smask[i] = '\0';
352 return smask;
353}
354
355
356static int db_sethook (lua_State *L) {
357 int arg, mask, count;
358 lua_Hook func;
359 lua_State *L1 = getthread(L, &arg);
360 if (lua_isnoneornil(L, arg+1)) { /* no hook? */
361 lua_settop(L, arg+1);
362 func = NULL; mask = 0; count = 0; /* turn off hooks */
363 }
364 else {
365 const char *smask = luaL_checkstring(L, arg+2);
366 luaL_checktype(L, arg+1, LUA_TFUNCTION);
367 count = (int)luaL_optinteger(L, arg + 3, 0);
368 func = hookf; mask = makemask(smask, count);
369 }
370 if (!luaL_getsubtable(L, LUA_REGISTRYINDEX, HOOKKEY)) {
371 /* table just created; initialize it */
372 lua_pushstring(L, "k");
373 lua_setfield(L, -2, "__mode"); /** hooktable.__mode = "k" */
374 lua_pushvalue(L, -1);
375 lua_setmetatable(L, -2); /* metatable(hooktable) = hooktable */
376 }
377 checkstack(L, L1, 1);
378 lua_pushthread(L1); lua_xmove(L1, L, 1); /* key (thread) */
379 lua_pushvalue(L, arg + 1); /* value (hook function) */
380 lua_rawset(L, -3); /* hooktable[L1] = new Lua hook */
381 lua_sethook(L1, func, mask, count);
382 return 0;
383}
384
385
386static int db_gethook (lua_State *L) {
387 int arg;
388 lua_State *L1 = getthread(L, &arg);
389 char buff[5];
390 int mask = lua_gethookmask(L1);
391 lua_Hook hook = lua_gethook(L1);
392 if (hook == NULL) { /* no hook? */
393 luaL_pushfail(L);
394 return 1;
395 }
396 else if (hook != hookf) /* external hook? */
397 lua_pushliteral(L, "external hook");
398 else { /* hook table must exist */
399 lua_getfield(L, LUA_REGISTRYINDEX, HOOKKEY);
400 checkstack(L, L1, 1);
401 lua_pushthread(L1); lua_xmove(L1, L, 1);
402 lua_rawget(L, -2); /* 1st result = hooktable[L1] */
403 lua_remove(L, -2); /* remove hook table */
404 }
405 lua_pushstring(L, unmakemask(mask, buff)); /* 2nd result = mask */
406 lua_pushinteger(L, lua_gethookcount(L1)); /* 3rd result = count */
407 return 3;
408}
409
410
411static int db_debug (lua_State *L) {
412 for (;;) {
413 char buffer[250];
414 lua_writestringerror("%s", "lua_debug> ");
415 if (fgets(buffer, sizeof(buffer), stdin) == 0 ||
416 strcmp(buffer, "cont\n") == 0)
417 return 0;
418 if (luaL_loadbuffer(L, buffer, strlen(buffer), "=(debug command)") ||
419 lua_pcall(L, 0, 0, 0))
420 lua_writestringerror("%s\n", luaL_tolstring(L, -1, NULL));
421 lua_settop(L, 0); /* remove eventual returns */
422 }
423}
424
425
426static int db_traceback (lua_State *L) {
427 int arg;
428 lua_State *L1 = getthread(L, &arg);
429 const char *msg = lua_tostring(L, arg + 1);
430 if (msg == NULL && !lua_isnoneornil(L, arg + 1)) /* non-string 'msg'? */
431 lua_pushvalue(L, arg + 1); /* return it untouched */
432 else {
433 int level = (int)luaL_optinteger(L, arg + 2, (L == L1) ? 1 : 0);
434 luaL_traceback(L, L1, msg, level);
435 }
436 return 1;
437}
438
439
440static int db_setcstacklimit (lua_State *L) {
441 int limit = (int)luaL_checkinteger(L, 1);
442 int res = lua_setcstacklimit(L, limit);
443 if (res == 0)
444 lua_pushboolean(L, 0);
445 else
446 lua_pushinteger(L, res);
447 return 1;
448}
449
450
451static const luaL_Reg dblib[] = {
452 {"debug", db_debug},
453 {"getuservalue", db_getuservalue},
454 {"gethook", db_gethook},
455 {"getinfo", db_getinfo},
456 {"getlocal", db_getlocal},
457 {"getregistry", db_getregistry},
458 {"getmetatable", db_getmetatable},
459 {"getupvalue", db_getupvalue},
460 {"upvaluejoin", db_upvaluejoin},
461 {"upvalueid", db_upvalueid},
462 {"setuservalue", db_setuservalue},
463 {"sethook", db_sethook},
464 {"setlocal", db_setlocal},
465 {"setmetatable", db_setmetatable},
466 {"setupvalue", db_setupvalue},
467 {"traceback", db_traceback},
468 {"setcstacklimit", db_setcstacklimit},
469 {NULL, NULL}
470};
471
472
473LUAMOD_API int luaopen_debug (lua_State *L) {
474 luaL_newlib(L, dblib);
475 return 1;
476}
477
diff --git a/src/lua/ldebug.c b/src/lua/ldebug.c
new file mode 100644
index 0000000..afdc2b7
--- /dev/null
+++ b/src/lua/ldebug.c
@@ -0,0 +1,841 @@
1/*
2** $Id: ldebug.c $
3** Debug Interface
4** See Copyright Notice in lua.h
5*/
6
7#define ldebug_c
8#define LUA_CORE
9
10#include "lprefix.h"
11
12
13#include <stdarg.h>
14#include <stddef.h>
15#include <string.h>
16
17#include "lua.h"
18
19#include "lapi.h"
20#include "lcode.h"
21#include "ldebug.h"
22#include "ldo.h"
23#include "lfunc.h"
24#include "lobject.h"
25#include "lopcodes.h"
26#include "lstate.h"
27#include "lstring.h"
28#include "ltable.h"
29#include "ltm.h"
30#include "lvm.h"
31
32
33
34#define noLuaClosure(f) ((f) == NULL || (f)->c.tt == LUA_VCCL)
35
36
37/* Active Lua function (given call info) */
38#define ci_func(ci) (clLvalue(s2v((ci)->func)))
39
40
41static const char *funcnamefromcode (lua_State *L, CallInfo *ci,
42 const char **name);
43
44
45static int currentpc (CallInfo *ci) {
46 lua_assert(isLua(ci));
47 return pcRel(ci->u.l.savedpc, ci_func(ci)->p);
48}
49
50
51/*
52** Get a "base line" to find the line corresponding to an instruction.
53** For that, search the array of absolute line info for the largest saved
54** instruction smaller or equal to the wanted instruction. A special
55** case is when there is no absolute info or the instruction is before
56** the first absolute one.
57*/
58static int getbaseline (const Proto *f, int pc, int *basepc) {
59 if (f->sizeabslineinfo == 0 || pc < f->abslineinfo[0].pc) {
60 *basepc = -1; /* start from the beginning */
61 return f->linedefined;
62 }
63 else {
64 unsigned int i;
65 if (pc >= f->abslineinfo[f->sizeabslineinfo - 1].pc)
66 i = f->sizeabslineinfo - 1; /* instruction is after last saved one */
67 else { /* binary search */
68 unsigned int j = f->sizeabslineinfo - 1; /* pc < anchorlines[j] */
69 i = 0; /* abslineinfo[i] <= pc */
70 while (i < j - 1) {
71 unsigned int m = (j + i) / 2;
72 if (pc >= f->abslineinfo[m].pc)
73 i = m;
74 else
75 j = m;
76 }
77 }
78 *basepc = f->abslineinfo[i].pc;
79 return f->abslineinfo[i].line;
80 }
81}
82
83
84/*
85** Get the line corresponding to instruction 'pc' in function 'f';
86** first gets a base line and from there does the increments until
87** the desired instruction.
88*/
89int luaG_getfuncline (const Proto *f, int pc) {
90 if (f->lineinfo == NULL) /* no debug information? */
91 return -1;
92 else {
93 int basepc;
94 int baseline = getbaseline(f, pc, &basepc);
95 while (basepc++ < pc) { /* walk until given instruction */
96 lua_assert(f->lineinfo[basepc] != ABSLINEINFO);
97 baseline += f->lineinfo[basepc]; /* correct line */
98 }
99 return baseline;
100 }
101}
102
103
104static int getcurrentline (CallInfo *ci) {
105 return luaG_getfuncline(ci_func(ci)->p, currentpc(ci));
106}
107
108
109/*
110** Set 'trap' for all active Lua frames.
111** This function can be called during a signal, under "reasonable"
112** assumptions. A new 'ci' is completely linked in the list before it
113** becomes part of the "active" list, and we assume that pointers are
114** atomic; see comment in next function.
115** (A compiler doing interprocedural optimizations could, theoretically,
116** reorder memory writes in such a way that the list could be
117** temporarily broken while inserting a new element. We simply assume it
118** has no good reasons to do that.)
119*/
120static void settraps (CallInfo *ci) {
121 for (; ci != NULL; ci = ci->previous)
122 if (isLua(ci))
123 ci->u.l.trap = 1;
124}
125
126
127/*
128** This function can be called during a signal, under "reasonable"
129** assumptions.
130** Fields 'oldpc', 'basehookcount', and 'hookcount' (set by
131** 'resethookcount') are for debug only, and it is no problem if they
132** get arbitrary values (causes at most one wrong hook call). 'hookmask'
133** is an atomic value. We assume that pointers are atomic too (e.g., gcc
134** ensures that for all platforms where it runs). Moreover, 'hook' is
135** always checked before being called (see 'luaD_hook').
136*/
137LUA_API void lua_sethook (lua_State *L, lua_Hook func, int mask, int count) {
138 if (func == NULL || mask == 0) { /* turn off hooks? */
139 mask = 0;
140 func = NULL;
141 }
142 if (isLua(L->ci))
143 L->oldpc = L->ci->u.l.savedpc;
144 L->hook = func;
145 L->basehookcount = count;
146 resethookcount(L);
147 L->hookmask = cast_byte(mask);
148 if (mask)
149 settraps(L->ci); /* to trace inside 'luaV_execute' */
150}
151
152
153LUA_API lua_Hook lua_gethook (lua_State *L) {
154 return L->hook;
155}
156
157
158LUA_API int lua_gethookmask (lua_State *L) {
159 return L->hookmask;
160}
161
162
163LUA_API int lua_gethookcount (lua_State *L) {
164 return L->basehookcount;
165}
166
167
168LUA_API int lua_getstack (lua_State *L, int level, lua_Debug *ar) {
169 int status;
170 CallInfo *ci;
171 if (level < 0) return 0; /* invalid (negative) level */
172 lua_lock(L);
173 for (ci = L->ci; level > 0 && ci != &L->base_ci; ci = ci->previous)
174 level--;
175 if (level == 0 && ci != &L->base_ci) { /* level found? */
176 status = 1;
177 ar->i_ci = ci;
178 }
179 else status = 0; /* no such level */
180 lua_unlock(L);
181 return status;
182}
183
184
185static const char *upvalname (const Proto *p, int uv) {
186 TString *s = check_exp(uv < p->sizeupvalues, p->upvalues[uv].name);
187 if (s == NULL) return "?";
188 else return getstr(s);
189}
190
191
192static const char *findvararg (CallInfo *ci, int n, StkId *pos) {
193 if (clLvalue(s2v(ci->func))->p->is_vararg) {
194 int nextra = ci->u.l.nextraargs;
195 if (n <= nextra) {
196 *pos = ci->func - nextra + (n - 1);
197 return "(vararg)"; /* generic name for any vararg */
198 }
199 }
200 return NULL; /* no such vararg */
201}
202
203
204const char *luaG_findlocal (lua_State *L, CallInfo *ci, int n, StkId *pos) {
205 StkId base = ci->func + 1;
206 const char *name = NULL;
207 if (isLua(ci)) {
208 if (n < 0) /* access to vararg values? */
209 return findvararg(ci, -n, pos);
210 else
211 name = luaF_getlocalname(ci_func(ci)->p, n, currentpc(ci));
212 }
213 if (name == NULL) { /* no 'standard' name? */
214 StkId limit = (ci == L->ci) ? L->top : ci->next->func;
215 if (limit - base >= n && n > 0) { /* is 'n' inside 'ci' stack? */
216 /* generic name for any valid slot */
217 name = isLua(ci) ? "(temporary)" : "(C temporary)";
218 }
219 else
220 return NULL; /* no name */
221 }
222 if (pos)
223 *pos = base + (n - 1);
224 return name;
225}
226
227
228LUA_API const char *lua_getlocal (lua_State *L, const lua_Debug *ar, int n) {
229 const char *name;
230 lua_lock(L);
231 if (ar == NULL) { /* information about non-active function? */
232 if (!isLfunction(s2v(L->top - 1))) /* not a Lua function? */
233 name = NULL;
234 else /* consider live variables at function start (parameters) */
235 name = luaF_getlocalname(clLvalue(s2v(L->top - 1))->p, n, 0);
236 }
237 else { /* active function; get information through 'ar' */
238 StkId pos = NULL; /* to avoid warnings */
239 name = luaG_findlocal(L, ar->i_ci, n, &pos);
240 if (name) {
241 setobjs2s(L, L->top, pos);
242 api_incr_top(L);
243 }
244 }
245 lua_unlock(L);
246 return name;
247}
248
249
250LUA_API const char *lua_setlocal (lua_State *L, const lua_Debug *ar, int n) {
251 StkId pos = NULL; /* to avoid warnings */
252 const char *name;
253 lua_lock(L);
254 name = luaG_findlocal(L, ar->i_ci, n, &pos);
255 if (name) {
256 setobjs2s(L, pos, L->top - 1);
257 L->top--; /* pop value */
258 }
259 lua_unlock(L);
260 return name;
261}
262
263
264static void funcinfo (lua_Debug *ar, Closure *cl) {
265 if (noLuaClosure(cl)) {
266 ar->source = "=[C]";
267 ar->srclen = LL("=[C]");
268 ar->linedefined = -1;
269 ar->lastlinedefined = -1;
270 ar->what = "C";
271 }
272 else {
273 const Proto *p = cl->l.p;
274 if (p->source) {
275 ar->source = getstr(p->source);
276 ar->srclen = tsslen(p->source);
277 }
278 else {
279 ar->source = "=?";
280 ar->srclen = LL("=?");
281 }
282 ar->linedefined = p->linedefined;
283 ar->lastlinedefined = p->lastlinedefined;
284 ar->what = (ar->linedefined == 0) ? "main" : "Lua";
285 }
286 luaO_chunkid(ar->short_src, ar->source, ar->srclen);
287}
288
289
290static int nextline (const Proto *p, int currentline, int pc) {
291 if (p->lineinfo[pc] != ABSLINEINFO)
292 return currentline + p->lineinfo[pc];
293 else
294 return luaG_getfuncline(p, pc);
295}
296
297
298static void collectvalidlines (lua_State *L, Closure *f) {
299 if (noLuaClosure(f)) {
300 setnilvalue(s2v(L->top));
301 api_incr_top(L);
302 }
303 else {
304 int i;
305 TValue v;
306 const Proto *p = f->l.p;
307 int currentline = p->linedefined;
308 Table *t = luaH_new(L); /* new table to store active lines */
309 sethvalue2s(L, L->top, t); /* push it on stack */
310 api_incr_top(L);
311 setbtvalue(&v); /* boolean 'true' to be the value of all indices */
312 for (i = 0; i < p->sizelineinfo; i++) { /* for all lines with code */
313 currentline = nextline(p, currentline, i);
314 luaH_setint(L, t, currentline, &v); /* table[line] = true */
315 }
316 }
317}
318
319
320static const char *getfuncname (lua_State *L, CallInfo *ci, const char **name) {
321 if (ci == NULL) /* no 'ci'? */
322 return NULL; /* no info */
323 else if (ci->callstatus & CIST_FIN) { /* is this a finalizer? */
324 *name = "__gc";
325 return "metamethod"; /* report it as such */
326 }
327 /* calling function is a known Lua function? */
328 else if (!(ci->callstatus & CIST_TAIL) && isLua(ci->previous))
329 return funcnamefromcode(L, ci->previous, name);
330 else return NULL; /* no way to find a name */
331}
332
333
334static int auxgetinfo (lua_State *L, const char *what, lua_Debug *ar,
335 Closure *f, CallInfo *ci) {
336 int status = 1;
337 for (; *what; what++) {
338 switch (*what) {
339 case 'S': {
340 funcinfo(ar, f);
341 break;
342 }
343 case 'l': {
344 ar->currentline = (ci && isLua(ci)) ? getcurrentline(ci) : -1;
345 break;
346 }
347 case 'u': {
348 ar->nups = (f == NULL) ? 0 : f->c.nupvalues;
349 if (noLuaClosure(f)) {
350 ar->isvararg = 1;
351 ar->nparams = 0;
352 }
353 else {
354 ar->isvararg = f->l.p->is_vararg;
355 ar->nparams = f->l.p->numparams;
356 }
357 break;
358 }
359 case 't': {
360 ar->istailcall = (ci) ? ci->callstatus & CIST_TAIL : 0;
361 break;
362 }
363 case 'n': {
364 ar->namewhat = getfuncname(L, ci, &ar->name);
365 if (ar->namewhat == NULL) {
366 ar->namewhat = ""; /* not found */
367 ar->name = NULL;
368 }
369 break;
370 }
371 case 'r': {
372 if (ci == NULL || !(ci->callstatus & CIST_TRAN))
373 ar->ftransfer = ar->ntransfer = 0;
374 else {
375 ar->ftransfer = ci->u2.transferinfo.ftransfer;
376 ar->ntransfer = ci->u2.transferinfo.ntransfer;
377 }
378 break;
379 }
380 case 'L':
381 case 'f': /* handled by lua_getinfo */
382 break;
383 default: status = 0; /* invalid option */
384 }
385 }
386 return status;
387}
388
389
390LUA_API int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar) {
391 int status;
392 Closure *cl;
393 CallInfo *ci;
394 TValue *func;
395 lua_lock(L);
396 if (*what == '>') {
397 ci = NULL;
398 func = s2v(L->top - 1);
399 api_check(L, ttisfunction(func), "function expected");
400 what++; /* skip the '>' */
401 L->top--; /* pop function */
402 }
403 else {
404 ci = ar->i_ci;
405 func = s2v(ci->func);
406 lua_assert(ttisfunction(func));
407 }
408 cl = ttisclosure(func) ? clvalue(func) : NULL;
409 status = auxgetinfo(L, what, ar, cl, ci);
410 if (strchr(what, 'f')) {
411 setobj2s(L, L->top, func);
412 api_incr_top(L);
413 }
414 if (strchr(what, 'L'))
415 collectvalidlines(L, cl);
416 lua_unlock(L);
417 return status;
418}
419
420
421/*
422** {======================================================
423** Symbolic Execution
424** =======================================================
425*/
426
427static const char *getobjname (const Proto *p, int lastpc, int reg,
428 const char **name);
429
430
431/*
432** Find a "name" for the constant 'c'.
433*/
434static void kname (const Proto *p, int c, const char **name) {
435 TValue *kvalue = &p->k[c];
436 *name = (ttisstring(kvalue)) ? svalue(kvalue) : "?";
437}
438
439
440/*
441** Find a "name" for the register 'c'.
442*/
443static void rname (const Proto *p, int pc, int c, const char **name) {
444 const char *what = getobjname(p, pc, c, name); /* search for 'c' */
445 if (!(what && *what == 'c')) /* did not find a constant name? */
446 *name = "?";
447}
448
449
450/*
451** Find a "name" for a 'C' value in an RK instruction.
452*/
453static void rkname (const Proto *p, int pc, Instruction i, const char **name) {
454 int c = GETARG_C(i); /* key index */
455 if (GETARG_k(i)) /* is 'c' a constant? */
456 kname(p, c, name);
457 else /* 'c' is a register */
458 rname(p, pc, c, name);
459}
460
461
462static int filterpc (int pc, int jmptarget) {
463 if (pc < jmptarget) /* is code conditional (inside a jump)? */
464 return -1; /* cannot know who sets that register */
465 else return pc; /* current position sets that register */
466}
467
468
469/*
470** Try to find last instruction before 'lastpc' that modified register 'reg'.
471*/
472static int findsetreg (const Proto *p, int lastpc, int reg) {
473 int pc;
474 int setreg = -1; /* keep last instruction that changed 'reg' */
475 int jmptarget = 0; /* any code before this address is conditional */
476 if (testMMMode(GET_OPCODE(p->code[lastpc])))
477 lastpc--; /* previous instruction was not actually executed */
478 for (pc = 0; pc < lastpc; pc++) {
479 Instruction i = p->code[pc];
480 OpCode op = GET_OPCODE(i);
481 int a = GETARG_A(i);
482 int change; /* true if current instruction changed 'reg' */
483 switch (op) {
484 case OP_LOADNIL: { /* set registers from 'a' to 'a+b' */
485 int b = GETARG_B(i);
486 change = (a <= reg && reg <= a + b);
487 break;
488 }
489 case OP_TFORCALL: { /* affect all regs above its base */
490 change = (reg >= a + 2);
491 break;
492 }
493 case OP_CALL:
494 case OP_TAILCALL: { /* affect all registers above base */
495 change = (reg >= a);
496 break;
497 }
498 case OP_JMP: { /* doesn't change registers, but changes 'jmptarget' */
499 int b = GETARG_sJ(i);
500 int dest = pc + 1 + b;
501 /* jump does not skip 'lastpc' and is larger than current one? */
502 if (dest <= lastpc && dest > jmptarget)
503 jmptarget = dest; /* update 'jmptarget' */
504 change = 0;
505 break;
506 }
507 default: /* any instruction that sets A */
508 change = (testAMode(op) && reg == a);
509 break;
510 }
511 if (change)
512 setreg = filterpc(pc, jmptarget);
513 }
514 return setreg;
515}
516
517
518/*
519** Check whether table being indexed by instruction 'i' is the
520** environment '_ENV'
521*/
522static const char *gxf (const Proto *p, int pc, Instruction i, int isup) {
523 int t = GETARG_B(i); /* table index */
524 const char *name; /* name of indexed variable */
525 if (isup) /* is an upvalue? */
526 name = upvalname(p, t);
527 else
528 getobjname(p, pc, t, &name);
529 return (name && strcmp(name, LUA_ENV) == 0) ? "global" : "field";
530}
531
532
533static const char *getobjname (const Proto *p, int lastpc, int reg,
534 const char **name) {
535 int pc;
536 *name = luaF_getlocalname(p, reg + 1, lastpc);
537 if (*name) /* is a local? */
538 return "local";
539 /* else try symbolic execution */
540 pc = findsetreg(p, lastpc, reg);
541 if (pc != -1) { /* could find instruction? */
542 Instruction i = p->code[pc];
543 OpCode op = GET_OPCODE(i);
544 switch (op) {
545 case OP_MOVE: {
546 int b = GETARG_B(i); /* move from 'b' to 'a' */
547 if (b < GETARG_A(i))
548 return getobjname(p, pc, b, name); /* get name for 'b' */
549 break;
550 }
551 case OP_GETTABUP: {
552 int k = GETARG_C(i); /* key index */
553 kname(p, k, name);
554 return gxf(p, pc, i, 1);
555 }
556 case OP_GETTABLE: {
557 int k = GETARG_C(i); /* key index */
558 rname(p, pc, k, name);
559 return gxf(p, pc, i, 0);
560 }
561 case OP_GETI: {
562 *name = "integer index";
563 return "field";
564 }
565 case OP_GETFIELD: {
566 int k = GETARG_C(i); /* key index */
567 kname(p, k, name);
568 return gxf(p, pc, i, 0);
569 }
570 case OP_GETUPVAL: {
571 *name = upvalname(p, GETARG_B(i));
572 return "upvalue";
573 }
574 case OP_LOADK:
575 case OP_LOADKX: {
576 int b = (op == OP_LOADK) ? GETARG_Bx(i)
577 : GETARG_Ax(p->code[pc + 1]);
578 if (ttisstring(&p->k[b])) {
579 *name = svalue(&p->k[b]);
580 return "constant";
581 }
582 break;
583 }
584 case OP_SELF: {
585 rkname(p, pc, i, name);
586 return "method";
587 }
588 default: break; /* go through to return NULL */
589 }
590 }
591 return NULL; /* could not find reasonable name */
592}
593
594
595/*
596** Try to find a name for a function based on the code that called it.
597** (Only works when function was called by a Lua function.)
598** Returns what the name is (e.g., "for iterator", "method",
599** "metamethod") and sets '*name' to point to the name.
600*/
601static const char *funcnamefromcode (lua_State *L, CallInfo *ci,
602 const char **name) {
603 TMS tm = (TMS)0; /* (initial value avoids warnings) */
604 const Proto *p = ci_func(ci)->p; /* calling function */
605 int pc = currentpc(ci); /* calling instruction index */
606 Instruction i = p->code[pc]; /* calling instruction */
607 if (ci->callstatus & CIST_HOOKED) { /* was it called inside a hook? */
608 *name = "?";
609 return "hook";
610 }
611 switch (GET_OPCODE(i)) {
612 case OP_CALL:
613 case OP_TAILCALL:
614 return getobjname(p, pc, GETARG_A(i), name); /* get function name */
615 case OP_TFORCALL: { /* for iterator */
616 *name = "for iterator";
617 return "for iterator";
618 }
619 /* other instructions can do calls through metamethods */
620 case OP_SELF: case OP_GETTABUP: case OP_GETTABLE:
621 case OP_GETI: case OP_GETFIELD:
622 tm = TM_INDEX;
623 break;
624 case OP_SETTABUP: case OP_SETTABLE: case OP_SETI: case OP_SETFIELD:
625 tm = TM_NEWINDEX;
626 break;
627 case OP_MMBIN: case OP_MMBINI: case OP_MMBINK: {
628 tm = cast(TMS, GETARG_C(i));
629 break;
630 }
631 case OP_UNM: tm = TM_UNM; break;
632 case OP_BNOT: tm = TM_BNOT; break;
633 case OP_LEN: tm = TM_LEN; break;
634 case OP_CONCAT: tm = TM_CONCAT; break;
635 case OP_EQ: tm = TM_EQ; break;
636 case OP_LT: case OP_LE: case OP_LTI: case OP_LEI:
637 *name = "order"; /* '<=' can call '__lt', etc. */
638 return "metamethod";
639 case OP_CLOSE: case OP_RETURN:
640 *name = "close";
641 return "metamethod";
642 default:
643 return NULL; /* cannot find a reasonable name */
644 }
645 *name = getstr(G(L)->tmname[tm]) + 2;
646 return "metamethod";
647}
648
649/* }====================================================== */
650
651
652
653/*
654** The subtraction of two potentially unrelated pointers is
655** not ISO C, but it should not crash a program; the subsequent
656** checks are ISO C and ensure a correct result.
657*/
658static int isinstack (CallInfo *ci, const TValue *o) {
659 StkId base = ci->func + 1;
660 ptrdiff_t i = cast(StkId, o) - base;
661 return (0 <= i && i < (ci->top - base) && s2v(base + i) == o);
662}
663
664
665/*
666** Checks whether value 'o' came from an upvalue. (That can only happen
667** with instructions OP_GETTABUP/OP_SETTABUP, which operate directly on
668** upvalues.)
669*/
670static const char *getupvalname (CallInfo *ci, const TValue *o,
671 const char **name) {
672 LClosure *c = ci_func(ci);
673 int i;
674 for (i = 0; i < c->nupvalues; i++) {
675 if (c->upvals[i]->v == o) {
676 *name = upvalname(c->p, i);
677 return "upvalue";
678 }
679 }
680 return NULL;
681}
682
683
684static const char *varinfo (lua_State *L, const TValue *o) {
685 const char *name = NULL; /* to avoid warnings */
686 CallInfo *ci = L->ci;
687 const char *kind = NULL;
688 if (isLua(ci)) {
689 kind = getupvalname(ci, o, &name); /* check whether 'o' is an upvalue */
690 if (!kind && isinstack(ci, o)) /* no? try a register */
691 kind = getobjname(ci_func(ci)->p, currentpc(ci),
692 cast_int(cast(StkId, o) - (ci->func + 1)), &name);
693 }
694 return (kind) ? luaO_pushfstring(L, " (%s '%s')", kind, name) : "";
695}
696
697
698l_noret luaG_typeerror (lua_State *L, const TValue *o, const char *op) {
699 const char *t = luaT_objtypename(L, o);
700 luaG_runerror(L, "attempt to %s a %s value%s", op, t, varinfo(L, o));
701}
702
703
704l_noret luaG_forerror (lua_State *L, const TValue *o, const char *what) {
705 luaG_runerror(L, "bad 'for' %s (number expected, got %s)",
706 what, luaT_objtypename(L, o));
707}
708
709
710l_noret luaG_concaterror (lua_State *L, const TValue *p1, const TValue *p2) {
711 if (ttisstring(p1) || cvt2str(p1)) p1 = p2;
712 luaG_typeerror(L, p1, "concatenate");
713}
714
715
716l_noret luaG_opinterror (lua_State *L, const TValue *p1,
717 const TValue *p2, const char *msg) {
718 if (!ttisnumber(p1)) /* first operand is wrong? */
719 p2 = p1; /* now second is wrong */
720 luaG_typeerror(L, p2, msg);
721}
722
723
724/*
725** Error when both values are convertible to numbers, but not to integers
726*/
727l_noret luaG_tointerror (lua_State *L, const TValue *p1, const TValue *p2) {
728 lua_Integer temp;
729 if (!tointegerns(p1, &temp))
730 p2 = p1;
731 luaG_runerror(L, "number%s has no integer representation", varinfo(L, p2));
732}
733
734
735l_noret luaG_ordererror (lua_State *L, const TValue *p1, const TValue *p2) {
736 const char *t1 = luaT_objtypename(L, p1);
737 const char *t2 = luaT_objtypename(L, p2);
738 if (strcmp(t1, t2) == 0)
739 luaG_runerror(L, "attempt to compare two %s values", t1);
740 else
741 luaG_runerror(L, "attempt to compare %s with %s", t1, t2);
742}
743
744
745/* add src:line information to 'msg' */
746const char *luaG_addinfo (lua_State *L, const char *msg, TString *src,
747 int line) {
748 char buff[LUA_IDSIZE];
749 if (src)
750 luaO_chunkid(buff, getstr(src), tsslen(src));
751 else { /* no source available; use "?" instead */
752 buff[0] = '?'; buff[1] = '\0';
753 }
754 return luaO_pushfstring(L, "%s:%d: %s", buff, line, msg);
755}
756
757
758l_noret luaG_errormsg (lua_State *L) {
759 if (L->errfunc != 0) { /* is there an error handling function? */
760 StkId errfunc = restorestack(L, L->errfunc);
761 lua_assert(ttisfunction(s2v(errfunc)));
762 setobjs2s(L, L->top, L->top - 1); /* move argument */
763 setobjs2s(L, L->top - 1, errfunc); /* push function */
764 L->top++; /* assume EXTRA_STACK */
765 luaD_callnoyield(L, L->top - 2, 1); /* call it */
766 }
767 luaD_throw(L, LUA_ERRRUN);
768}
769
770
771l_noret luaG_runerror (lua_State *L, const char *fmt, ...) {
772 CallInfo *ci = L->ci;
773 const char *msg;
774 va_list argp;
775 luaC_checkGC(L); /* error message uses memory */
776 va_start(argp, fmt);
777 msg = luaO_pushvfstring(L, fmt, argp); /* format message */
778 va_end(argp);
779 if (isLua(ci)) /* if Lua function, add source:line information */
780 luaG_addinfo(L, msg, ci_func(ci)->p->source, getcurrentline(ci));
781 luaG_errormsg(L);
782}
783
784
785/*
786** Check whether new instruction 'newpc' is in a different line from
787** previous instruction 'oldpc'.
788*/
789static int changedline (const Proto *p, int oldpc, int newpc) {
790 while (oldpc++ < newpc) {
791 if (p->lineinfo[oldpc] != 0)
792 return (luaG_getfuncline(p, oldpc - 1) != luaG_getfuncline(p, newpc));
793 }
794 return 0; /* no line changes in the way */
795}
796
797
798int luaG_traceexec (lua_State *L, const Instruction *pc) {
799 CallInfo *ci = L->ci;
800 lu_byte mask = L->hookmask;
801 int counthook;
802 if (!(mask & (LUA_MASKLINE | LUA_MASKCOUNT))) { /* no hooks? */
803 ci->u.l.trap = 0; /* don't need to stop again */
804 return 0; /* turn off 'trap' */
805 }
806 pc++; /* reference is always next instruction */
807 ci->u.l.savedpc = pc; /* save 'pc' */
808 counthook = (--L->hookcount == 0 && (mask & LUA_MASKCOUNT));
809 if (counthook)
810 resethookcount(L); /* reset count */
811 else if (!(mask & LUA_MASKLINE))
812 return 1; /* no line hook and count != 0; nothing to be done now */
813 if (ci->callstatus & CIST_HOOKYIELD) { /* called hook last time? */
814 ci->callstatus &= ~CIST_HOOKYIELD; /* erase mark */
815 return 1; /* do not call hook again (VM yielded, so it did not move) */
816 }
817 if (!isIT(*(ci->u.l.savedpc - 1)))
818 L->top = ci->top; /* prepare top */
819 if (counthook)
820 luaD_hook(L, LUA_HOOKCOUNT, -1, 0, 0); /* call count hook */
821 if (mask & LUA_MASKLINE) {
822 const Proto *p = ci_func(ci)->p;
823 int npci = pcRel(pc, p);
824 if (npci == 0 || /* call linehook when enter a new function, */
825 pc <= L->oldpc || /* when jump back (loop), or when */
826 changedline(p, pcRel(L->oldpc, p), npci)) { /* enter new line */
827 int newline = luaG_getfuncline(p, npci);
828 luaD_hook(L, LUA_HOOKLINE, newline, 0, 0); /* call line hook */
829 }
830 L->oldpc = pc; /* 'pc' of last call to line hook */
831 }
832 if (L->status == LUA_YIELD) { /* did hook yield? */
833 if (counthook)
834 L->hookcount = 1; /* undo decrement to zero */
835 ci->u.l.savedpc--; /* undo increment (resume will increment it again) */
836 ci->callstatus |= CIST_HOOKYIELD; /* mark that it yielded */
837 luaD_throw(L, LUA_YIELD);
838 }
839 return 1; /* keep 'trap' on */
840}
841
diff --git a/src/lua/ldebug.h b/src/lua/ldebug.h
new file mode 100644
index 0000000..1fe0efa
--- /dev/null
+++ b/src/lua/ldebug.h
@@ -0,0 +1,47 @@
1/*
2** $Id: ldebug.h $
3** Auxiliary functions from Debug Interface module
4** See Copyright Notice in lua.h
5*/
6
7#ifndef ldebug_h
8#define ldebug_h
9
10
11#include "lstate.h"
12
13
14#define pcRel(pc, p) (cast_int((pc) - (p)->code) - 1)
15
16#define resethookcount(L) (L->hookcount = L->basehookcount)
17
18/*
19** mark for entries in 'lineinfo' array that has absolute information in
20** 'abslineinfo' array
21*/
22#define ABSLINEINFO (-0x80)
23
24LUAI_FUNC int luaG_getfuncline (const Proto *f, int pc);
25LUAI_FUNC const char *luaG_findlocal (lua_State *L, CallInfo *ci, int n,
26 StkId *pos);
27LUAI_FUNC l_noret luaG_typeerror (lua_State *L, const TValue *o,
28 const char *opname);
29LUAI_FUNC l_noret luaG_forerror (lua_State *L, const TValue *o,
30 const char *what);
31LUAI_FUNC l_noret luaG_concaterror (lua_State *L, const TValue *p1,
32 const TValue *p2);
33LUAI_FUNC l_noret luaG_opinterror (lua_State *L, const TValue *p1,
34 const TValue *p2,
35 const char *msg);
36LUAI_FUNC l_noret luaG_tointerror (lua_State *L, const TValue *p1,
37 const TValue *p2);
38LUAI_FUNC l_noret luaG_ordererror (lua_State *L, const TValue *p1,
39 const TValue *p2);
40LUAI_FUNC l_noret luaG_runerror (lua_State *L, const char *fmt, ...);
41LUAI_FUNC const char *luaG_addinfo (lua_State *L, const char *msg,
42 TString *src, int line);
43LUAI_FUNC l_noret luaG_errormsg (lua_State *L);
44LUAI_FUNC int luaG_traceexec (lua_State *L, const Instruction *pc);
45
46
47#endif
diff --git a/src/lua/ldo.c b/src/lua/ldo.c
new file mode 100644
index 0000000..c563b1d
--- /dev/null
+++ b/src/lua/ldo.c
@@ -0,0 +1,822 @@
1/*
2** $Id: ldo.c $
3** Stack and Call structure of Lua
4** See Copyright Notice in lua.h
5*/
6
7#define ldo_c
8#define LUA_CORE
9
10#include "lprefix.h"
11
12
13#include <setjmp.h>
14#include <stdlib.h>
15#include <string.h>
16
17#include "lua.h"
18
19#include "lapi.h"
20#include "ldebug.h"
21#include "ldo.h"
22#include "lfunc.h"
23#include "lgc.h"
24#include "lmem.h"
25#include "lobject.h"
26#include "lopcodes.h"
27#include "lparser.h"
28#include "lstate.h"
29#include "lstring.h"
30#include "ltable.h"
31#include "ltm.h"
32#include "lundump.h"
33#include "lvm.h"
34#include "lzio.h"
35
36
37
38#define errorstatus(s) ((s) > LUA_YIELD)
39
40
41/*
42** {======================================================
43** Error-recovery functions
44** =======================================================
45*/
46
47/*
48** LUAI_THROW/LUAI_TRY define how Lua does exception handling. By
49** default, Lua handles errors with exceptions when compiling as
50** C++ code, with _longjmp/_setjmp when asked to use them, and with
51** longjmp/setjmp otherwise.
52*/
53#if !defined(LUAI_THROW) /* { */
54
55#if defined(__cplusplus) && !defined(LUA_USE_LONGJMP) /* { */
56
57/* C++ exceptions */
58#define LUAI_THROW(L,c) throw(c)
59#define LUAI_TRY(L,c,a) \
60 try { a } catch(...) { if ((c)->status == 0) (c)->status = -1; }
61#define luai_jmpbuf int /* dummy variable */
62
63#elif defined(LUA_USE_POSIX) /* }{ */
64
65/* in POSIX, try _longjmp/_setjmp (more efficient) */
66#define LUAI_THROW(L,c) _longjmp((c)->b, 1)
67#define LUAI_TRY(L,c,a) if (_setjmp((c)->b) == 0) { a }
68#define luai_jmpbuf jmp_buf
69
70#else /* }{ */
71
72/* ISO C handling with long jumps */
73#define LUAI_THROW(L,c) longjmp((c)->b, 1)
74#define LUAI_TRY(L,c,a) if (setjmp((c)->b) == 0) { a }
75#define luai_jmpbuf jmp_buf
76
77#endif /* } */
78
79#endif /* } */
80
81
82
83/* chain list of long jump buffers */
84struct lua_longjmp {
85 struct lua_longjmp *previous;
86 luai_jmpbuf b;
87 volatile int status; /* error code */
88};
89
90
91void luaD_seterrorobj (lua_State *L, int errcode, StkId oldtop) {
92 switch (errcode) {
93 case LUA_ERRMEM: { /* memory error? */
94 setsvalue2s(L, oldtop, G(L)->memerrmsg); /* reuse preregistered msg. */
95 break;
96 }
97 case LUA_ERRERR: {
98 setsvalue2s(L, oldtop, luaS_newliteral(L, "error in error handling"));
99 break;
100 }
101 case CLOSEPROTECT: {
102 setnilvalue(s2v(oldtop)); /* no error message */
103 break;
104 }
105 default: {
106 setobjs2s(L, oldtop, L->top - 1); /* error message on current top */
107 break;
108 }
109 }
110 L->top = oldtop + 1;
111}
112
113
114l_noret luaD_throw (lua_State *L, int errcode) {
115 if (L->errorJmp) { /* thread has an error handler? */
116 L->errorJmp->status = errcode; /* set status */
117 LUAI_THROW(L, L->errorJmp); /* jump to it */
118 }
119 else { /* thread has no error handler */
120 global_State *g = G(L);
121 errcode = luaF_close(L, L->stack, errcode); /* close all upvalues */
122 L->status = cast_byte(errcode); /* mark it as dead */
123 if (g->mainthread->errorJmp) { /* main thread has a handler? */
124 setobjs2s(L, g->mainthread->top++, L->top - 1); /* copy error obj. */
125 luaD_throw(g->mainthread, errcode); /* re-throw in main thread */
126 }
127 else { /* no handler at all; abort */
128 if (g->panic) { /* panic function? */
129 luaD_seterrorobj(L, errcode, L->top); /* assume EXTRA_STACK */
130 if (L->ci->top < L->top)
131 L->ci->top = L->top; /* pushing msg. can break this invariant */
132 lua_unlock(L);
133 g->panic(L); /* call panic function (last chance to jump out) */
134 }
135 abort();
136 }
137 }
138}
139
140
141int luaD_rawrunprotected (lua_State *L, Pfunc f, void *ud) {
142 global_State *g = G(L);
143 l_uint32 oldnCcalls = g->Cstacklimit - (L->nCcalls + L->nci);
144 struct lua_longjmp lj;
145 lj.status = LUA_OK;
146 lj.previous = L->errorJmp; /* chain new error handler */
147 L->errorJmp = &lj;
148 LUAI_TRY(L, &lj,
149 (*f)(L, ud);
150 );
151 L->errorJmp = lj.previous; /* restore old error handler */
152 L->nCcalls = g->Cstacklimit - oldnCcalls - L->nci;
153 return lj.status;
154}
155
156/* }====================================================== */
157
158
159/*
160** {==================================================================
161** Stack reallocation
162** ===================================================================
163*/
164static void correctstack (lua_State *L, StkId oldstack, StkId newstack) {
165 CallInfo *ci;
166 UpVal *up;
167 if (oldstack == newstack)
168 return; /* stack address did not change */
169 L->top = (L->top - oldstack) + newstack;
170 for (up = L->openupval; up != NULL; up = up->u.open.next)
171 up->v = s2v((uplevel(up) - oldstack) + newstack);
172 for (ci = L->ci; ci != NULL; ci = ci->previous) {
173 ci->top = (ci->top - oldstack) + newstack;
174 ci->func = (ci->func - oldstack) + newstack;
175 if (isLua(ci))
176 ci->u.l.trap = 1; /* signal to update 'trap' in 'luaV_execute' */
177 }
178}
179
180
181/* some space for error handling */
182#define ERRORSTACKSIZE (LUAI_MAXSTACK + 200)
183
184
185int luaD_reallocstack (lua_State *L, int newsize, int raiseerror) {
186 int lim = L->stacksize;
187 StkId newstack = luaM_reallocvector(L, L->stack, lim, newsize, StackValue);
188 lua_assert(newsize <= LUAI_MAXSTACK || newsize == ERRORSTACKSIZE);
189 lua_assert(L->stack_last - L->stack == L->stacksize - EXTRA_STACK);
190 if (unlikely(newstack == NULL)) { /* reallocation failed? */
191 if (raiseerror)
192 luaM_error(L);
193 else return 0; /* do not raise an error */
194 }
195 for (; lim < newsize; lim++)
196 setnilvalue(s2v(newstack + lim)); /* erase new segment */
197 correctstack(L, L->stack, newstack);
198 L->stack = newstack;
199 L->stacksize = newsize;
200 L->stack_last = L->stack + newsize - EXTRA_STACK;
201 return 1;
202}
203
204
205/*
206** Try to grow the stack by at least 'n' elements. when 'raiseerror'
207** is true, raises any error; otherwise, return 0 in case of errors.
208*/
209int luaD_growstack (lua_State *L, int n, int raiseerror) {
210 int size = L->stacksize;
211 int newsize = 2 * size; /* tentative new size */
212 if (unlikely(size > LUAI_MAXSTACK)) { /* need more space after extra size? */
213 if (raiseerror)
214 luaD_throw(L, LUA_ERRERR); /* error inside message handler */
215 else return 0;
216 }
217 else {
218 int needed = cast_int(L->top - L->stack) + n + EXTRA_STACK;
219 if (newsize > LUAI_MAXSTACK) /* cannot cross the limit */
220 newsize = LUAI_MAXSTACK;
221 if (newsize < needed) /* but must respect what was asked for */
222 newsize = needed;
223 if (unlikely(newsize > LUAI_MAXSTACK)) { /* stack overflow? */
224 /* add extra size to be able to handle the error message */
225 luaD_reallocstack(L, ERRORSTACKSIZE, raiseerror);
226 if (raiseerror)
227 luaG_runerror(L, "stack overflow");
228 else return 0;
229 }
230 } /* else no errors */
231 return luaD_reallocstack(L, newsize, raiseerror);
232}
233
234
235static int stackinuse (lua_State *L) {
236 CallInfo *ci;
237 StkId lim = L->top;
238 for (ci = L->ci; ci != NULL; ci = ci->previous) {
239 if (lim < ci->top) lim = ci->top;
240 }
241 lua_assert(lim <= L->stack_last);
242 return cast_int(lim - L->stack) + 1; /* part of stack in use */
243}
244
245
246void luaD_shrinkstack (lua_State *L) {
247 int inuse = stackinuse(L);
248 int goodsize = inuse + (inuse / 8) + 2*EXTRA_STACK;
249 if (goodsize > LUAI_MAXSTACK)
250 goodsize = LUAI_MAXSTACK; /* respect stack limit */
251 /* if thread is currently not handling a stack overflow and its
252 good size is smaller than current size, shrink its stack */
253 if (inuse <= (LUAI_MAXSTACK - EXTRA_STACK) &&
254 goodsize < L->stacksize)
255 luaD_reallocstack(L, goodsize, 0); /* ok if that fails */
256 else /* don't change stack */
257 condmovestack(L,{},{}); /* (change only for debugging) */
258 luaE_shrinkCI(L); /* shrink CI list */
259}
260
261
262void luaD_inctop (lua_State *L) {
263 luaD_checkstack(L, 1);
264 L->top++;
265}
266
267/* }================================================================== */
268
269
270/*
271** Call a hook for the given event. Make sure there is a hook to be
272** called. (Both 'L->hook' and 'L->hookmask', which trigger this
273** function, can be changed asynchronously by signals.)
274*/
275void luaD_hook (lua_State *L, int event, int line,
276 int ftransfer, int ntransfer) {
277 lua_Hook hook = L->hook;
278 if (hook && L->allowhook) { /* make sure there is a hook */
279 int mask = CIST_HOOKED;
280 CallInfo *ci = L->ci;
281 ptrdiff_t top = savestack(L, L->top);
282 ptrdiff_t ci_top = savestack(L, ci->top);
283 lua_Debug ar;
284 ar.event = event;
285 ar.currentline = line;
286 ar.i_ci = ci;
287 if (ntransfer != 0) {
288 mask |= CIST_TRAN; /* 'ci' has transfer information */
289 ci->u2.transferinfo.ftransfer = ftransfer;
290 ci->u2.transferinfo.ntransfer = ntransfer;
291 }
292 luaD_checkstack(L, LUA_MINSTACK); /* ensure minimum stack size */
293 if (L->top + LUA_MINSTACK > ci->top)
294 ci->top = L->top + LUA_MINSTACK;
295 L->allowhook = 0; /* cannot call hooks inside a hook */
296 ci->callstatus |= mask;
297 lua_unlock(L);
298 (*hook)(L, &ar);
299 lua_lock(L);
300 lua_assert(!L->allowhook);
301 L->allowhook = 1;
302 ci->top = restorestack(L, ci_top);
303 L->top = restorestack(L, top);
304 ci->callstatus &= ~mask;
305 }
306}
307
308
309/*
310** Executes a call hook for Lua functions. This function is called
311** whenever 'hookmask' is not zero, so it checks whether call hooks are
312** active.
313*/
314void luaD_hookcall (lua_State *L, CallInfo *ci) {
315 int hook = (ci->callstatus & CIST_TAIL) ? LUA_HOOKTAILCALL : LUA_HOOKCALL;
316 Proto *p;
317 if (!(L->hookmask & LUA_MASKCALL)) /* some other hook? */
318 return; /* don't call hook */
319 p = clLvalue(s2v(ci->func))->p;
320 L->top = ci->top; /* prepare top */
321 ci->u.l.savedpc++; /* hooks assume 'pc' is already incremented */
322 luaD_hook(L, hook, -1, 1, p->numparams);
323 ci->u.l.savedpc--; /* correct 'pc' */
324}
325
326
327static StkId rethook (lua_State *L, CallInfo *ci, StkId firstres, int nres) {
328 ptrdiff_t oldtop = savestack(L, L->top); /* hook may change top */
329 int delta = 0;
330 if (isLuacode(ci)) {
331 Proto *p = clLvalue(s2v(ci->func))->p;
332 if (p->is_vararg)
333 delta = ci->u.l.nextraargs + p->numparams + 1;
334 if (L->top < ci->top)
335 L->top = ci->top; /* correct top to run hook */
336 }
337 if (L->hookmask & LUA_MASKRET) { /* is return hook on? */
338 int ftransfer;
339 ci->func += delta; /* if vararg, back to virtual 'func' */
340 ftransfer = cast(unsigned short, firstres - ci->func);
341 luaD_hook(L, LUA_HOOKRET, -1, ftransfer, nres); /* call it */
342 ci->func -= delta;
343 }
344 if (isLua(ci->previous))
345 L->oldpc = ci->previous->u.l.savedpc; /* update 'oldpc' */
346 return restorestack(L, oldtop);
347}
348
349
350/*
351** Check whether 'func' has a '__call' metafield. If so, put it in the
352** stack, below original 'func', so that 'luaD_call' can call it. Raise
353** an error if there is no '__call' metafield.
354*/
355void luaD_tryfuncTM (lua_State *L, StkId func) {
356 const TValue *tm = luaT_gettmbyobj(L, s2v(func), TM_CALL);
357 StkId p;
358 if (unlikely(ttisnil(tm)))
359 luaG_typeerror(L, s2v(func), "call"); /* nothing to call */
360 for (p = L->top; p > func; p--) /* open space for metamethod */
361 setobjs2s(L, p, p-1);
362 L->top++; /* stack space pre-allocated by the caller */
363 setobj2s(L, func, tm); /* metamethod is the new function to be called */
364}
365
366
367/*
368** Given 'nres' results at 'firstResult', move 'wanted' of them to 'res'.
369** Handle most typical cases (zero results for commands, one result for
370** expressions, multiple results for tail calls/single parameters)
371** separated.
372*/
373static void moveresults (lua_State *L, StkId res, int nres, int wanted) {
374 StkId firstresult;
375 int i;
376 switch (wanted) { /* handle typical cases separately */
377 case 0: /* no values needed */
378 L->top = res;
379 return;
380 case 1: /* one value needed */
381 if (nres == 0) /* no results? */
382 setnilvalue(s2v(res)); /* adjust with nil */
383 else
384 setobjs2s(L, res, L->top - nres); /* move it to proper place */
385 L->top = res + 1;
386 return;
387 case LUA_MULTRET:
388 wanted = nres; /* we want all results */
389 break;
390 default: /* multiple results (or to-be-closed variables) */
391 if (hastocloseCfunc(wanted)) { /* to-be-closed variables? */
392 ptrdiff_t savedres = savestack(L, res);
393 luaF_close(L, res, LUA_OK); /* may change the stack */
394 res = restorestack(L, savedres);
395 wanted = codeNresults(wanted); /* correct value */
396 if (wanted == LUA_MULTRET)
397 wanted = nres;
398 }
399 break;
400 }
401 firstresult = L->top - nres; /* index of first result */
402 /* move all results to correct place */
403 for (i = 0; i < nres && i < wanted; i++)
404 setobjs2s(L, res + i, firstresult + i);
405 for (; i < wanted; i++) /* complete wanted number of results */
406 setnilvalue(s2v(res + i));
407 L->top = res + wanted; /* top points after the last result */
408}
409
410
411/*
412** Finishes a function call: calls hook if necessary, removes CallInfo,
413** moves current number of results to proper place.
414*/
415void luaD_poscall (lua_State *L, CallInfo *ci, int nres) {
416 if (L->hookmask)
417 L->top = rethook(L, ci, L->top - nres, nres);
418 L->ci = ci->previous; /* back to caller */
419 /* move results to proper place */
420 moveresults(L, ci->func, nres, ci->nresults);
421}
422
423
424
425#define next_ci(L) (L->ci->next ? L->ci->next : luaE_extendCI(L))
426
427
428/*
429** Prepare a function for a tail call, building its call info on top
430** of the current call info. 'narg1' is the number of arguments plus 1
431** (so that it includes the function itself).
432*/
433void luaD_pretailcall (lua_State *L, CallInfo *ci, StkId func, int narg1) {
434 Proto *p = clLvalue(s2v(func))->p;
435 int fsize = p->maxstacksize; /* frame size */
436 int nfixparams = p->numparams;
437 int i;
438 for (i = 0; i < narg1; i++) /* move down function and arguments */
439 setobjs2s(L, ci->func + i, func + i);
440 checkstackGC(L, fsize);
441 func = ci->func; /* moved-down function */
442 for (; narg1 <= nfixparams; narg1++)
443 setnilvalue(s2v(func + narg1)); /* complete missing arguments */
444 ci->top = func + 1 + fsize; /* top for new function */
445 lua_assert(ci->top <= L->stack_last);
446 ci->u.l.savedpc = p->code; /* starting point */
447 ci->callstatus |= CIST_TAIL;
448 L->top = func + narg1; /* set top */
449}
450
451
452/*
453** Call a function (C or Lua). The function to be called is at *func.
454** The arguments are on the stack, right after the function.
455** When returns, all the results are on the stack, starting at the original
456** function position.
457*/
458void luaD_call (lua_State *L, StkId func, int nresults) {
459 lua_CFunction f;
460 retry:
461 switch (ttypetag(s2v(func))) {
462 case LUA_VCCL: /* C closure */
463 f = clCvalue(s2v(func))->f;
464 goto Cfunc;
465 case LUA_VLCF: /* light C function */
466 f = fvalue(s2v(func));
467 Cfunc: {
468 int n; /* number of returns */
469 CallInfo *ci = next_ci(L);
470 checkstackp(L, LUA_MINSTACK, func); /* ensure minimum stack size */
471 ci->nresults = nresults;
472 ci->callstatus = CIST_C;
473 ci->top = L->top + LUA_MINSTACK;
474 ci->func = func;
475 L->ci = ci;
476 lua_assert(ci->top <= L->stack_last);
477 if (L->hookmask & LUA_MASKCALL) {
478 int narg = cast_int(L->top - func) - 1;
479 luaD_hook(L, LUA_HOOKCALL, -1, 1, narg);
480 }
481 lua_unlock(L);
482 n = (*f)(L); /* do the actual call */
483 lua_lock(L);
484 api_checknelems(L, n);
485 luaD_poscall(L, ci, n);
486 break;
487 }
488 case LUA_VLCL: { /* Lua function */
489 CallInfo *ci = next_ci(L);
490 Proto *p = clLvalue(s2v(func))->p;
491 int narg = cast_int(L->top - func) - 1; /* number of real arguments */
492 int nfixparams = p->numparams;
493 int fsize = p->maxstacksize; /* frame size */
494 checkstackp(L, fsize, func);
495 ci->nresults = nresults;
496 ci->u.l.savedpc = p->code; /* starting point */
497 ci->callstatus = 0;
498 ci->top = func + 1 + fsize;
499 ci->func = func;
500 L->ci = ci;
501 for (; narg < nfixparams; narg++)
502 setnilvalue(s2v(L->top++)); /* complete missing arguments */
503 lua_assert(ci->top <= L->stack_last);
504 luaV_execute(L, ci); /* run the function */
505 break;
506 }
507 default: { /* not a function */
508 checkstackp(L, 1, func); /* space for metamethod */
509 luaD_tryfuncTM(L, func); /* try to get '__call' metamethod */
510 goto retry; /* try again with metamethod */
511 }
512 }
513}
514
515
516/*
517** Similar to 'luaD_call', but does not allow yields during the call.
518** If there is a stack overflow, freeing all CI structures will
519** force the subsequent call to invoke 'luaE_extendCI', which then
520** will raise any errors.
521*/
522void luaD_callnoyield (lua_State *L, StkId func, int nResults) {
523 incXCcalls(L);
524 if (getCcalls(L) <= CSTACKERR) /* possible stack overflow? */
525 luaE_freeCI(L);
526 luaD_call(L, func, nResults);
527 decXCcalls(L);
528}
529
530
531/*
532** Completes the execution of an interrupted C function, calling its
533** continuation function.
534*/
535static void finishCcall (lua_State *L, int status) {
536 CallInfo *ci = L->ci;
537 int n;
538 /* must have a continuation and must be able to call it */
539 lua_assert(ci->u.c.k != NULL && yieldable(L));
540 /* error status can only happen in a protected call */
541 lua_assert((ci->callstatus & CIST_YPCALL) || status == LUA_YIELD);
542 if (ci->callstatus & CIST_YPCALL) { /* was inside a pcall? */
543 ci->callstatus &= ~CIST_YPCALL; /* continuation is also inside it */
544 L->errfunc = ci->u.c.old_errfunc; /* with the same error function */
545 }
546 /* finish 'lua_callk'/'lua_pcall'; CIST_YPCALL and 'errfunc' already
547 handled */
548 adjustresults(L, ci->nresults);
549 lua_unlock(L);
550 n = (*ci->u.c.k)(L, status, ci->u.c.ctx); /* call continuation function */
551 lua_lock(L);
552 api_checknelems(L, n);
553 luaD_poscall(L, ci, n); /* finish 'luaD_call' */
554}
555
556
557/*
558** Executes "full continuation" (everything in the stack) of a
559** previously interrupted coroutine until the stack is empty (or another
560** interruption long-jumps out of the loop). If the coroutine is
561** recovering from an error, 'ud' points to the error status, which must
562** be passed to the first continuation function (otherwise the default
563** status is LUA_YIELD).
564*/
565static void unroll (lua_State *L, void *ud) {
566 CallInfo *ci;
567 if (ud != NULL) /* error status? */
568 finishCcall(L, *(int *)ud); /* finish 'lua_pcallk' callee */
569 while ((ci = L->ci) != &L->base_ci) { /* something in the stack */
570 if (!isLua(ci)) /* C function? */
571 finishCcall(L, LUA_YIELD); /* complete its execution */
572 else { /* Lua function */
573 luaV_finishOp(L); /* finish interrupted instruction */
574 luaV_execute(L, ci); /* execute down to higher C 'boundary' */
575 }
576 }
577}
578
579
580/*
581** Try to find a suspended protected call (a "recover point") for the
582** given thread.
583*/
584static CallInfo *findpcall (lua_State *L) {
585 CallInfo *ci;
586 for (ci = L->ci; ci != NULL; ci = ci->previous) { /* search for a pcall */
587 if (ci->callstatus & CIST_YPCALL)
588 return ci;
589 }
590 return NULL; /* no pending pcall */
591}
592
593
594/*
595** Recovers from an error in a coroutine. Finds a recover point (if
596** there is one) and completes the execution of the interrupted
597** 'luaD_pcall'. If there is no recover point, returns zero.
598*/
599static int recover (lua_State *L, int status) {
600 StkId oldtop;
601 CallInfo *ci = findpcall(L);
602 if (ci == NULL) return 0; /* no recovery point */
603 /* "finish" luaD_pcall */
604 oldtop = restorestack(L, ci->u2.funcidx);
605 luaF_close(L, oldtop, status); /* may change the stack */
606 oldtop = restorestack(L, ci->u2.funcidx);
607 luaD_seterrorobj(L, status, oldtop);
608 L->ci = ci;
609 L->allowhook = getoah(ci->callstatus); /* restore original 'allowhook' */
610 luaD_shrinkstack(L);
611 L->errfunc = ci->u.c.old_errfunc;
612 return 1; /* continue running the coroutine */
613}
614
615
616/*
617** Signal an error in the call to 'lua_resume', not in the execution
618** of the coroutine itself. (Such errors should not be handled by any
619** coroutine error handler and should not kill the coroutine.)
620*/
621static int resume_error (lua_State *L, const char *msg, int narg) {
622 L->top -= narg; /* remove args from the stack */
623 setsvalue2s(L, L->top, luaS_new(L, msg)); /* push error message */
624 api_incr_top(L);
625 lua_unlock(L);
626 return LUA_ERRRUN;
627}
628
629
630/*
631** Do the work for 'lua_resume' in protected mode. Most of the work
632** depends on the status of the coroutine: initial state, suspended
633** inside a hook, or regularly suspended (optionally with a continuation
634** function), plus erroneous cases: non-suspended coroutine or dead
635** coroutine.
636*/
637static void resume (lua_State *L, void *ud) {
638 int n = *(cast(int*, ud)); /* number of arguments */
639 StkId firstArg = L->top - n; /* first argument */
640 CallInfo *ci = L->ci;
641 if (L->status == LUA_OK) { /* starting a coroutine? */
642 luaD_call(L, firstArg - 1, LUA_MULTRET);
643 }
644 else { /* resuming from previous yield */
645 lua_assert(L->status == LUA_YIELD);
646 L->status = LUA_OK; /* mark that it is running (again) */
647 if (isLua(ci)) /* yielded inside a hook? */
648 luaV_execute(L, ci); /* just continue running Lua code */
649 else { /* 'common' yield */
650 if (ci->u.c.k != NULL) { /* does it have a continuation function? */
651 lua_unlock(L);
652 n = (*ci->u.c.k)(L, LUA_YIELD, ci->u.c.ctx); /* call continuation */
653 lua_lock(L);
654 api_checknelems(L, n);
655 }
656 luaD_poscall(L, ci, n); /* finish 'luaD_call' */
657 }
658 unroll(L, NULL); /* run continuation */
659 }
660}
661
662LUA_API int lua_resume (lua_State *L, lua_State *from, int nargs,
663 int *nresults) {
664 int status;
665 lua_lock(L);
666 if (L->status == LUA_OK) { /* may be starting a coroutine */
667 if (L->ci != &L->base_ci) /* not in base level? */
668 return resume_error(L, "cannot resume non-suspended coroutine", nargs);
669 else if (L->top - (L->ci->func + 1) == nargs) /* no function? */
670 return resume_error(L, "cannot resume dead coroutine", nargs);
671 }
672 else if (L->status != LUA_YIELD) /* ended with errors? */
673 return resume_error(L, "cannot resume dead coroutine", nargs);
674 if (from == NULL)
675 L->nCcalls = CSTACKTHREAD;
676 else /* correct 'nCcalls' for this thread */
677 L->nCcalls = getCcalls(from) + from->nci - L->nci - CSTACKCF;
678 if (L->nCcalls <= CSTACKERR)
679 return resume_error(L, "C stack overflow", nargs);
680 luai_userstateresume(L, nargs);
681 api_checknelems(L, (L->status == LUA_OK) ? nargs + 1 : nargs);
682 status = luaD_rawrunprotected(L, resume, &nargs);
683 /* continue running after recoverable errors */
684 while (errorstatus(status) && recover(L, status)) {
685 /* unroll continuation */
686 status = luaD_rawrunprotected(L, unroll, &status);
687 }
688 if (likely(!errorstatus(status)))
689 lua_assert(status == L->status); /* normal end or yield */
690 else { /* unrecoverable error */
691 L->status = cast_byte(status); /* mark thread as 'dead' */
692 luaD_seterrorobj(L, status, L->top); /* push error message */
693 L->ci->top = L->top;
694 }
695 *nresults = (status == LUA_YIELD) ? L->ci->u2.nyield
696 : cast_int(L->top - (L->ci->func + 1));
697 lua_unlock(L);
698 return status;
699}
700
701
702LUA_API int lua_isyieldable (lua_State *L) {
703 return yieldable(L);
704}
705
706
707LUA_API int lua_yieldk (lua_State *L, int nresults, lua_KContext ctx,
708 lua_KFunction k) {
709 CallInfo *ci = L->ci;
710 luai_userstateyield(L, nresults);
711 lua_lock(L);
712 api_checknelems(L, nresults);
713 if (unlikely(!yieldable(L))) {
714 if (L != G(L)->mainthread)
715 luaG_runerror(L, "attempt to yield across a C-call boundary");
716 else
717 luaG_runerror(L, "attempt to yield from outside a coroutine");
718 }
719 L->status = LUA_YIELD;
720 if (isLua(ci)) { /* inside a hook? */
721 lua_assert(!isLuacode(ci));
722 api_check(L, k == NULL, "hooks cannot continue after yielding");
723 ci->u2.nyield = 0; /* no results */
724 }
725 else {
726 if ((ci->u.c.k = k) != NULL) /* is there a continuation? */
727 ci->u.c.ctx = ctx; /* save context */
728 ci->u2.nyield = nresults; /* save number of results */
729 luaD_throw(L, LUA_YIELD);
730 }
731 lua_assert(ci->callstatus & CIST_HOOKED); /* must be inside a hook */
732 lua_unlock(L);
733 return 0; /* return to 'luaD_hook' */
734}
735
736
737/*
738** Call the C function 'func' in protected mode, restoring basic
739** thread information ('allowhook', etc.) and in particular
740** its stack level in case of errors.
741*/
742int luaD_pcall (lua_State *L, Pfunc func, void *u,
743 ptrdiff_t old_top, ptrdiff_t ef) {
744 int status;
745 CallInfo *old_ci = L->ci;
746 lu_byte old_allowhooks = L->allowhook;
747 ptrdiff_t old_errfunc = L->errfunc;
748 L->errfunc = ef;
749 status = luaD_rawrunprotected(L, func, u);
750 if (unlikely(status != LUA_OK)) { /* an error occurred? */
751 StkId oldtop = restorestack(L, old_top);
752 L->ci = old_ci;
753 L->allowhook = old_allowhooks;
754 status = luaF_close(L, oldtop, status);
755 oldtop = restorestack(L, old_top); /* previous call may change stack */
756 luaD_seterrorobj(L, status, oldtop);
757 luaD_shrinkstack(L);
758 }
759 L->errfunc = old_errfunc;
760 return status;
761}
762
763
764
765/*
766** Execute a protected parser.
767*/
768struct SParser { /* data to 'f_parser' */
769 ZIO *z;
770 Mbuffer buff; /* dynamic structure used by the scanner */
771 Dyndata dyd; /* dynamic structures used by the parser */
772 const char *mode;
773 const char *name;
774};
775
776
777static void checkmode (lua_State *L, const char *mode, const char *x) {
778 if (mode && strchr(mode, x[0]) == NULL) {
779 luaO_pushfstring(L,
780 "attempt to load a %s chunk (mode is '%s')", x, mode);
781 luaD_throw(L, LUA_ERRSYNTAX);
782 }
783}
784
785
786static void f_parser (lua_State *L, void *ud) {
787 LClosure *cl;
788 struct SParser *p = cast(struct SParser *, ud);
789 int c = zgetc(p->z); /* read first character */
790 if (c == LUA_SIGNATURE[0]) {
791 checkmode(L, p->mode, "binary");
792 cl = luaU_undump(L, p->z, p->name);
793 }
794 else {
795 checkmode(L, p->mode, "text");
796 cl = luaY_parser(L, p->z, &p->buff, &p->dyd, p->name, c);
797 }
798 lua_assert(cl->nupvalues == cl->p->sizeupvalues);
799 luaF_initupvals(L, cl);
800}
801
802
803int luaD_protectedparser (lua_State *L, ZIO *z, const char *name,
804 const char *mode) {
805 struct SParser p;
806 int status;
807 incnny(L); /* cannot yield during parsing */
808 p.z = z; p.name = name; p.mode = mode;
809 p.dyd.actvar.arr = NULL; p.dyd.actvar.size = 0;
810 p.dyd.gt.arr = NULL; p.dyd.gt.size = 0;
811 p.dyd.label.arr = NULL; p.dyd.label.size = 0;
812 luaZ_initbuffer(L, &p.buff);
813 status = luaD_pcall(L, f_parser, &p, savestack(L, L->top), L->errfunc);
814 luaZ_freebuffer(L, &p.buff);
815 luaM_freearray(L, p.dyd.actvar.arr, p.dyd.actvar.size);
816 luaM_freearray(L, p.dyd.gt.arr, p.dyd.gt.size);
817 luaM_freearray(L, p.dyd.label.arr, p.dyd.label.size);
818 decnny(L);
819 return status;
820}
821
822
diff --git a/src/lua/ldo.h b/src/lua/ldo.h
new file mode 100644
index 0000000..7760f85
--- /dev/null
+++ b/src/lua/ldo.h
@@ -0,0 +1,75 @@
1/*
2** $Id: ldo.h $
3** Stack and Call structure of Lua
4** See Copyright Notice in lua.h
5*/
6
7#ifndef ldo_h
8#define ldo_h
9
10
11#include "lobject.h"
12#include "lstate.h"
13#include "lzio.h"
14
15
16/*
17** Macro to check stack size and grow stack if needed. Parameters
18** 'pre'/'pos' allow the macro to preserve a pointer into the
19** stack across reallocations, doing the work only when needed.
20** 'condmovestack' is used in heavy tests to force a stack reallocation
21** at every check.
22*/
23#define luaD_checkstackaux(L,n,pre,pos) \
24 if (L->stack_last - L->top <= (n)) \
25 { pre; luaD_growstack(L, n, 1); pos; } \
26 else { condmovestack(L,pre,pos); }
27
28/* In general, 'pre'/'pos' are empty (nothing to save) */
29#define luaD_checkstack(L,n) luaD_checkstackaux(L,n,(void)0,(void)0)
30
31
32
33#define savestack(L,p) ((char *)(p) - (char *)L->stack)
34#define restorestack(L,n) ((StkId)((char *)L->stack + (n)))
35
36
37/* macro to check stack size, preserving 'p' */
38#define checkstackp(L,n,p) \
39 luaD_checkstackaux(L, n, \
40 ptrdiff_t t__ = savestack(L, p); /* save 'p' */ \
41 luaC_checkGC(L), /* stack grow uses memory */ \
42 p = restorestack(L, t__)) /* 'pos' part: restore 'p' */
43
44
45/* macro to check stack size and GC */
46#define checkstackGC(L,fsize) \
47 luaD_checkstackaux(L, (fsize), (void)0, luaC_checkGC(L))
48
49
50/* type of protected functions, to be ran by 'runprotected' */
51typedef void (*Pfunc) (lua_State *L, void *ud);
52
53LUAI_FUNC void luaD_seterrorobj (lua_State *L, int errcode, StkId oldtop);
54LUAI_FUNC int luaD_protectedparser (lua_State *L, ZIO *z, const char *name,
55 const char *mode);
56LUAI_FUNC void luaD_hook (lua_State *L, int event, int line,
57 int fTransfer, int nTransfer);
58LUAI_FUNC void luaD_hookcall (lua_State *L, CallInfo *ci);
59LUAI_FUNC void luaD_pretailcall (lua_State *L, CallInfo *ci, StkId func, int n);
60LUAI_FUNC void luaD_call (lua_State *L, StkId func, int nResults);
61LUAI_FUNC void luaD_callnoyield (lua_State *L, StkId func, int nResults);
62LUAI_FUNC void luaD_tryfuncTM (lua_State *L, StkId func);
63LUAI_FUNC int luaD_pcall (lua_State *L, Pfunc func, void *u,
64 ptrdiff_t oldtop, ptrdiff_t ef);
65LUAI_FUNC void luaD_poscall (lua_State *L, CallInfo *ci, int nres);
66LUAI_FUNC int luaD_reallocstack (lua_State *L, int newsize, int raiseerror);
67LUAI_FUNC int luaD_growstack (lua_State *L, int n, int raiseerror);
68LUAI_FUNC void luaD_shrinkstack (lua_State *L);
69LUAI_FUNC void luaD_inctop (lua_State *L);
70
71LUAI_FUNC l_noret luaD_throw (lua_State *L, int errcode);
72LUAI_FUNC int luaD_rawrunprotected (lua_State *L, Pfunc f, void *ud);
73
74#endif
75
diff --git a/src/lua/ldump.c b/src/lua/ldump.c
new file mode 100644
index 0000000..f848b66
--- /dev/null
+++ b/src/lua/ldump.c
@@ -0,0 +1,226 @@
1/*
2** $Id: ldump.c $
3** save precompiled Lua chunks
4** See Copyright Notice in lua.h
5*/
6
7#define ldump_c
8#define LUA_CORE
9
10#include "lprefix.h"
11
12
13#include <stddef.h>
14
15#include "lua.h"
16
17#include "lobject.h"
18#include "lstate.h"
19#include "lundump.h"
20
21
22typedef struct {
23 lua_State *L;
24 lua_Writer writer;
25 void *data;
26 int strip;
27 int status;
28} DumpState;
29
30
31/*
32** All high-level dumps go through dumpVector; you can change it to
33** change the endianness of the result
34*/
35#define dumpVector(D,v,n) dumpBlock(D,v,(n)*sizeof((v)[0]))
36
37#define dumpLiteral(D, s) dumpBlock(D,s,sizeof(s) - sizeof(char))
38
39
40static void dumpBlock (DumpState *D, const void *b, size_t size) {
41 if (D->status == 0 && size > 0) {
42 lua_unlock(D->L);
43 D->status = (*D->writer)(D->L, b, size, D->data);
44 lua_lock(D->L);
45 }
46}
47
48
49#define dumpVar(D,x) dumpVector(D,&x,1)
50
51
52static void dumpByte (DumpState *D, int y) {
53 lu_byte x = (lu_byte)y;
54 dumpVar(D, x);
55}
56
57
58/* dumpInt Buff Size */
59#define DIBS ((sizeof(size_t) * 8 / 7) + 1)
60
61static void dumpSize (DumpState *D, size_t x) {
62 lu_byte buff[DIBS];
63 int n = 0;
64 do {
65 buff[DIBS - (++n)] = x & 0x7f; /* fill buffer in reverse order */
66 x >>= 7;
67 } while (x != 0);
68 buff[DIBS - 1] |= 0x80; /* mark last byte */
69 dumpVector(D, buff + DIBS - n, n);
70}
71
72
73static void dumpInt (DumpState *D, int x) {
74 dumpSize(D, x);
75}
76
77
78static void dumpNumber (DumpState *D, lua_Number x) {
79 dumpVar(D, x);
80}
81
82
83static void dumpInteger (DumpState *D, lua_Integer x) {
84 dumpVar(D, x);
85}
86
87
88static void dumpString (DumpState *D, const TString *s) {
89 if (s == NULL)
90 dumpSize(D, 0);
91 else {
92 size_t size = tsslen(s);
93 const char *str = getstr(s);
94 dumpSize(D, size + 1);
95 dumpVector(D, str, size);
96 }
97}
98
99
100static void dumpCode (DumpState *D, const Proto *f) {
101 dumpInt(D, f->sizecode);
102 dumpVector(D, f->code, f->sizecode);
103}
104
105
106static void dumpFunction(DumpState *D, const Proto *f, TString *psource);
107
108static void dumpConstants (DumpState *D, const Proto *f) {
109 int i;
110 int n = f->sizek;
111 dumpInt(D, n);
112 for (i = 0; i < n; i++) {
113 const TValue *o = &f->k[i];
114 int tt = ttypetag(o);
115 dumpByte(D, tt);
116 switch (tt) {
117 case LUA_VNUMFLT:
118 dumpNumber(D, fltvalue(o));
119 break;
120 case LUA_VNUMINT:
121 dumpInteger(D, ivalue(o));
122 break;
123 case LUA_VSHRSTR:
124 case LUA_VLNGSTR:
125 dumpString(D, tsvalue(o));
126 break;
127 default:
128 lua_assert(tt == LUA_VNIL || tt == LUA_VFALSE || tt == LUA_VTRUE);
129 }
130 }
131}
132
133
134static void dumpProtos (DumpState *D, const Proto *f) {
135 int i;
136 int n = f->sizep;
137 dumpInt(D, n);
138 for (i = 0; i < n; i++)
139 dumpFunction(D, f->p[i], f->source);
140}
141
142
143static void dumpUpvalues (DumpState *D, const Proto *f) {
144 int i, n = f->sizeupvalues;
145 dumpInt(D, n);
146 for (i = 0; i < n; i++) {
147 dumpByte(D, f->upvalues[i].instack);
148 dumpByte(D, f->upvalues[i].idx);
149 dumpByte(D, f->upvalues[i].kind);
150 }
151}
152
153
154static void dumpDebug (DumpState *D, const Proto *f) {
155 int i, n;
156 n = (D->strip) ? 0 : f->sizelineinfo;
157 dumpInt(D, n);
158 dumpVector(D, f->lineinfo, n);
159 n = (D->strip) ? 0 : f->sizeabslineinfo;
160 dumpInt(D, n);
161 for (i = 0; i < n; i++) {
162 dumpInt(D, f->abslineinfo[i].pc);
163 dumpInt(D, f->abslineinfo[i].line);
164 }
165 n = (D->strip) ? 0 : f->sizelocvars;
166 dumpInt(D, n);
167 for (i = 0; i < n; i++) {
168 dumpString(D, f->locvars[i].varname);
169 dumpInt(D, f->locvars[i].startpc);
170 dumpInt(D, f->locvars[i].endpc);
171 }
172 n = (D->strip) ? 0 : f->sizeupvalues;
173 dumpInt(D, n);
174 for (i = 0; i < n; i++)
175 dumpString(D, f->upvalues[i].name);
176}
177
178
179static void dumpFunction (DumpState *D, const Proto *f, TString *psource) {
180 if (D->strip || f->source == psource)
181 dumpString(D, NULL); /* no debug info or same source as its parent */
182 else
183 dumpString(D, f->source);
184 dumpInt(D, f->linedefined);
185 dumpInt(D, f->lastlinedefined);
186 dumpByte(D, f->numparams);
187 dumpByte(D, f->is_vararg);
188 dumpByte(D, f->maxstacksize);
189 dumpCode(D, f);
190 dumpConstants(D, f);
191 dumpUpvalues(D, f);
192 dumpProtos(D, f);
193 dumpDebug(D, f);
194}
195
196
197static void dumpHeader (DumpState *D) {
198 dumpLiteral(D, LUA_SIGNATURE);
199 dumpByte(D, LUAC_VERSION);
200 dumpByte(D, LUAC_FORMAT);
201 dumpLiteral(D, LUAC_DATA);
202 dumpByte(D, sizeof(Instruction));
203 dumpByte(D, sizeof(lua_Integer));
204 dumpByte(D, sizeof(lua_Number));
205 dumpInteger(D, LUAC_INT);
206 dumpNumber(D, LUAC_NUM);
207}
208
209
210/*
211** dump Lua function as precompiled chunk
212*/
213int luaU_dump(lua_State *L, const Proto *f, lua_Writer w, void *data,
214 int strip) {
215 DumpState D;
216 D.L = L;
217 D.writer = w;
218 D.data = data;
219 D.strip = strip;
220 D.status = 0;
221 dumpHeader(&D);
222 dumpByte(&D, f->sizeupvalues);
223 dumpFunction(&D, f, NULL);
224 return D.status;
225}
226
diff --git a/src/lua/lfunc.c b/src/lua/lfunc.c
new file mode 100644
index 0000000..10100e5
--- /dev/null
+++ b/src/lua/lfunc.c
@@ -0,0 +1,299 @@
1/*
2** $Id: lfunc.c $
3** Auxiliary functions to manipulate prototypes and closures
4** See Copyright Notice in lua.h
5*/
6
7#define lfunc_c
8#define LUA_CORE
9
10#include "lprefix.h"
11
12
13#include <stddef.h>
14
15#include "lua.h"
16
17#include "ldebug.h"
18#include "ldo.h"
19#include "lfunc.h"
20#include "lgc.h"
21#include "lmem.h"
22#include "lobject.h"
23#include "lstate.h"
24
25
26
27CClosure *luaF_newCclosure (lua_State *L, int nupvals) {
28 GCObject *o = luaC_newobj(L, LUA_VCCL, sizeCclosure(nupvals));
29 CClosure *c = gco2ccl(o);
30 c->nupvalues = cast_byte(nupvals);
31 return c;
32}
33
34
35LClosure *luaF_newLclosure (lua_State *L, int nupvals) {
36 GCObject *o = luaC_newobj(L, LUA_VLCL, sizeLclosure(nupvals));
37 LClosure *c = gco2lcl(o);
38 c->p = NULL;
39 c->nupvalues = cast_byte(nupvals);
40 while (nupvals--) c->upvals[nupvals] = NULL;
41 return c;
42}
43
44
45/*
46** fill a closure with new closed upvalues
47*/
48void luaF_initupvals (lua_State *L, LClosure *cl) {
49 int i;
50 for (i = 0; i < cl->nupvalues; i++) {
51 GCObject *o = luaC_newobj(L, LUA_VUPVAL, sizeof(UpVal));
52 UpVal *uv = gco2upv(o);
53 uv->v = &uv->u.value; /* make it closed */
54 setnilvalue(uv->v);
55 cl->upvals[i] = uv;
56 luaC_objbarrier(L, cl, o);
57 }
58}
59
60
61/*
62** Create a new upvalue at the given level, and link it to the list of
63** open upvalues of 'L' after entry 'prev'.
64**/
65static UpVal *newupval (lua_State *L, int tbc, StkId level, UpVal **prev) {
66 GCObject *o = luaC_newobj(L, LUA_VUPVAL, sizeof(UpVal));
67 UpVal *uv = gco2upv(o);
68 UpVal *next = *prev;
69 uv->v = s2v(level); /* current value lives in the stack */
70 uv->tbc = tbc;
71 uv->u.open.next = next; /* link it to list of open upvalues */
72 uv->u.open.previous = prev;
73 if (next)
74 next->u.open.previous = &uv->u.open.next;
75 *prev = uv;
76 if (!isintwups(L)) { /* thread not in list of threads with upvalues? */
77 L->twups = G(L)->twups; /* link it to the list */
78 G(L)->twups = L;
79 }
80 return uv;
81}
82
83
84/*
85** Find and reuse, or create if it does not exist, an upvalue
86** at the given level.
87*/
88UpVal *luaF_findupval (lua_State *L, StkId level) {
89 UpVal **pp = &L->openupval;
90 UpVal *p;
91 lua_assert(isintwups(L) || L->openupval == NULL);
92 while ((p = *pp) != NULL && uplevel(p) >= level) { /* search for it */
93 lua_assert(!isdead(G(L), p));
94 if (uplevel(p) == level) /* corresponding upvalue? */
95 return p; /* return it */
96 pp = &p->u.open.next;
97 }
98 /* not found: create a new upvalue after 'pp' */
99 return newupval(L, 0, level, pp);
100}
101
102
103static void callclose (lua_State *L, void *ud) {
104 UNUSED(ud);
105 luaD_callnoyield(L, L->top - 3, 0);
106}
107
108
109/*
110** Prepare closing method plus its arguments for object 'obj' with
111** error message 'err'. (This function assumes EXTRA_STACK.)
112*/
113static int prepclosingmethod (lua_State *L, TValue *obj, TValue *err) {
114 StkId top = L->top;
115 const TValue *tm = luaT_gettmbyobj(L, obj, TM_CLOSE);
116 if (ttisnil(tm)) /* no metamethod? */
117 return 0; /* nothing to call */
118 setobj2s(L, top, tm); /* will call metamethod... */
119 setobj2s(L, top + 1, obj); /* with 'self' as the 1st argument */
120 setobj2s(L, top + 2, err); /* and error msg. as 2nd argument */
121 L->top = top + 3; /* add function and arguments */
122 return 1;
123}
124
125
126/*
127** Raise an error with message 'msg', inserting the name of the
128** local variable at position 'level' in the stack.
129*/
130static void varerror (lua_State *L, StkId level, const char *msg) {
131 int idx = cast_int(level - L->ci->func);
132 const char *vname = luaG_findlocal(L, L->ci, idx, NULL);
133 if (vname == NULL) vname = "?";
134 luaG_runerror(L, msg, vname);
135}
136
137
138/*
139** Prepare and call a closing method. If status is OK, code is still
140** inside the original protected call, and so any error will be handled
141** there. Otherwise, a previous error already activated the original
142** protected call, and so the call to the closing method must be
143** protected here. (A status == CLOSEPROTECT behaves like a previous
144** error, to also run the closing method in protected mode).
145** If status is OK, the call to the closing method will be pushed
146** at the top of the stack. Otherwise, values are pushed after
147** the 'level' of the upvalue being closed, as everything after
148** that won't be used again.
149*/
150static int callclosemth (lua_State *L, StkId level, int status) {
151 TValue *uv = s2v(level); /* value being closed */
152 if (likely(status == LUA_OK)) {
153 if (prepclosingmethod(L, uv, &G(L)->nilvalue)) /* something to call? */
154 callclose(L, NULL); /* call closing method */
155 else if (!l_isfalse(uv)) /* non-closable non-false value? */
156 varerror(L, level, "attempt to close non-closable variable '%s'");
157 }
158 else { /* must close the object in protected mode */
159 ptrdiff_t oldtop;
160 level++; /* space for error message */
161 oldtop = savestack(L, level + 1); /* top will be after that */
162 luaD_seterrorobj(L, status, level); /* set error message */
163 if (prepclosingmethod(L, uv, s2v(level))) { /* something to call? */
164 int newstatus = luaD_pcall(L, callclose, NULL, oldtop, 0);
165 if (newstatus != LUA_OK && status == CLOSEPROTECT) /* first error? */
166 status = newstatus; /* this will be the new error */
167 else {
168 if (newstatus != LUA_OK) /* suppressed error? */
169 luaE_warnerror(L, "__close metamethod");
170 /* leave original error (or nil) on top */
171 L->top = restorestack(L, oldtop);
172 }
173 }
174 /* else no metamethod; ignore this case and keep original error */
175 }
176 return status;
177}
178
179
180/*
181** Try to create a to-be-closed upvalue
182** (can raise a memory-allocation error)
183*/
184static void trynewtbcupval (lua_State *L, void *ud) {
185 newupval(L, 1, cast(StkId, ud), &L->openupval);
186}
187
188
189/*
190** Create a to-be-closed upvalue. If there is a memory error
191** when creating the upvalue, the closing method must be called here,
192** as there is no upvalue to call it later.
193*/
194void luaF_newtbcupval (lua_State *L, StkId level) {
195 TValue *obj = s2v(level);
196 lua_assert(L->openupval == NULL || uplevel(L->openupval) < level);
197 if (!l_isfalse(obj)) { /* false doesn't need to be closed */
198 int status;
199 const TValue *tm = luaT_gettmbyobj(L, obj, TM_CLOSE);
200 if (ttisnil(tm)) /* no metamethod? */
201 varerror(L, level, "variable '%s' got a non-closable value");
202 status = luaD_rawrunprotected(L, trynewtbcupval, level);
203 if (unlikely(status != LUA_OK)) { /* memory error creating upvalue? */
204 lua_assert(status == LUA_ERRMEM);
205 luaD_seterrorobj(L, LUA_ERRMEM, level + 1); /* save error message */
206 /* next call must succeed, as object is closable */
207 prepclosingmethod(L, s2v(level), s2v(level + 1));
208 callclose(L, NULL); /* call closing method */
209 luaD_throw(L, LUA_ERRMEM); /* throw memory error */
210 }
211 }
212}
213
214
215void luaF_unlinkupval (UpVal *uv) {
216 lua_assert(upisopen(uv));
217 *uv->u.open.previous = uv->u.open.next;
218 if (uv->u.open.next)
219 uv->u.open.next->u.open.previous = uv->u.open.previous;
220}
221
222
223int luaF_close (lua_State *L, StkId level, int status) {
224 UpVal *uv;
225 while ((uv = L->openupval) != NULL && uplevel(uv) >= level) {
226 TValue *slot = &uv->u.value; /* new position for value */
227 lua_assert(uplevel(uv) < L->top);
228 if (uv->tbc && status != NOCLOSINGMETH) {
229 /* must run closing method, which may change the stack */
230 ptrdiff_t levelrel = savestack(L, level);
231 status = callclosemth(L, uplevel(uv), status);
232 level = restorestack(L, levelrel);
233 }
234 luaF_unlinkupval(uv);
235 setobj(L, slot, uv->v); /* move value to upvalue slot */
236 uv->v = slot; /* now current value lives here */
237 if (!iswhite(uv))
238 gray2black(uv); /* closed upvalues cannot be gray */
239 luaC_barrier(L, uv, slot);
240 }
241 return status;
242}
243
244
245Proto *luaF_newproto (lua_State *L) {
246 GCObject *o = luaC_newobj(L, LUA_VPROTO, sizeof(Proto));
247 Proto *f = gco2p(o);
248 f->k = NULL;
249 f->sizek = 0;
250 f->p = NULL;
251 f->sizep = 0;
252 f->code = NULL;
253 f->sizecode = 0;
254 f->lineinfo = NULL;
255 f->sizelineinfo = 0;
256 f->abslineinfo = NULL;
257 f->sizeabslineinfo = 0;
258 f->upvalues = NULL;
259 f->sizeupvalues = 0;
260 f->numparams = 0;
261 f->is_vararg = 0;
262 f->maxstacksize = 0;
263 f->locvars = NULL;
264 f->sizelocvars = 0;
265 f->linedefined = 0;
266 f->lastlinedefined = 0;
267 f->source = NULL;
268 return f;
269}
270
271
272void luaF_freeproto (lua_State *L, Proto *f) {
273 luaM_freearray(L, f->code, f->sizecode);
274 luaM_freearray(L, f->p, f->sizep);
275 luaM_freearray(L, f->k, f->sizek);
276 luaM_freearray(L, f->lineinfo, f->sizelineinfo);
277 luaM_freearray(L, f->abslineinfo, f->sizeabslineinfo);
278 luaM_freearray(L, f->locvars, f->sizelocvars);
279 luaM_freearray(L, f->upvalues, f->sizeupvalues);
280 luaM_free(L, f);
281}
282
283
284/*
285** Look for n-th local variable at line 'line' in function 'func'.
286** Returns NULL if not found.
287*/
288const char *luaF_getlocalname (const Proto *f, int local_number, int pc) {
289 int i;
290 for (i = 0; i<f->sizelocvars && f->locvars[i].startpc <= pc; i++) {
291 if (pc < f->locvars[i].endpc) { /* is variable active? */
292 local_number--;
293 if (local_number == 0)
294 return getstr(f->locvars[i].varname);
295 }
296 }
297 return NULL; /* not found */
298}
299
diff --git a/src/lua/lfunc.h b/src/lua/lfunc.h
new file mode 100644
index 0000000..8d6f965
--- /dev/null
+++ b/src/lua/lfunc.h
@@ -0,0 +1,69 @@
1/*
2** $Id: lfunc.h $
3** Auxiliary functions to manipulate prototypes and closures
4** See Copyright Notice in lua.h
5*/
6
7#ifndef lfunc_h
8#define lfunc_h
9
10
11#include "lobject.h"
12
13
14#define sizeCclosure(n) (cast_int(offsetof(CClosure, upvalue)) + \
15 cast_int(sizeof(TValue)) * (n))
16
17#define sizeLclosure(n) (cast_int(offsetof(LClosure, upvals)) + \
18 cast_int(sizeof(TValue *)) * (n))
19
20
21/* test whether thread is in 'twups' list */
22#define isintwups(L) (L->twups != L)
23
24
25/*
26** maximum number of upvalues in a closure (both C and Lua). (Value
27** must fit in a VM register.)
28*/
29#define MAXUPVAL 255
30
31
32#define upisopen(up) ((up)->v != &(up)->u.value)
33
34
35#define uplevel(up) check_exp(upisopen(up), cast(StkId, (up)->v))
36
37
38/*
39** maximum number of misses before giving up the cache of closures
40** in prototypes
41*/
42#define MAXMISS 10
43
44
45/*
46** Special "status" for 'luaF_close'
47*/
48
49/* close upvalues without running their closing methods */
50#define NOCLOSINGMETH (-1)
51
52/* close upvalues running all closing methods in protected mode */
53#define CLOSEPROTECT (-2)
54
55
56LUAI_FUNC Proto *luaF_newproto (lua_State *L);
57LUAI_FUNC CClosure *luaF_newCclosure (lua_State *L, int nupvals);
58LUAI_FUNC LClosure *luaF_newLclosure (lua_State *L, int nupvals);
59LUAI_FUNC void luaF_initupvals (lua_State *L, LClosure *cl);
60LUAI_FUNC UpVal *luaF_findupval (lua_State *L, StkId level);
61LUAI_FUNC void luaF_newtbcupval (lua_State *L, StkId level);
62LUAI_FUNC int luaF_close (lua_State *L, StkId level, int status);
63LUAI_FUNC void luaF_unlinkupval (UpVal *uv);
64LUAI_FUNC void luaF_freeproto (lua_State *L, Proto *f);
65LUAI_FUNC const char *luaF_getlocalname (const Proto *func, int local_number,
66 int pc);
67
68
69#endif
diff --git a/src/lua/lgc.c b/src/lua/lgc.c
new file mode 100644
index 0000000..f26c921
--- /dev/null
+++ b/src/lua/lgc.c
@@ -0,0 +1,1616 @@
1/*
2** $Id: lgc.c $
3** Garbage Collector
4** See Copyright Notice in lua.h
5*/
6
7#define lgc_c
8#define LUA_CORE
9
10#include "lprefix.h"
11
12#include <stdio.h>
13#include <string.h>
14
15
16#include "lua.h"
17
18#include "ldebug.h"
19#include "ldo.h"
20#include "lfunc.h"
21#include "lgc.h"
22#include "lmem.h"
23#include "lobject.h"
24#include "lstate.h"
25#include "lstring.h"
26#include "ltable.h"
27#include "ltm.h"
28
29
30/*
31** Maximum number of elements to sweep in each single step.
32** (Large enough to dissipate fixed overheads but small enough
33** to allow small steps for the collector.)
34*/
35#define GCSWEEPMAX 100
36
37/*
38** Maximum number of finalizers to call in each single step.
39*/
40#define GCFINMAX 10
41
42
43/*
44** Cost of calling one finalizer.
45*/
46#define GCFINALIZECOST 50
47
48
49/*
50** The equivalent, in bytes, of one unit of "work" (visiting a slot,
51** sweeping an object, etc.)
52*/
53#define WORK2MEM sizeof(TValue)
54
55
56/*
57** macro to adjust 'pause': 'pause' is actually used like
58** 'pause / PAUSEADJ' (value chosen by tests)
59*/
60#define PAUSEADJ 100
61
62
63/* mask to erase all color bits (plus gen. related stuff) */
64#define maskcolors (~(bitmask(BLACKBIT) | WHITEBITS | AGEBITS))
65
66
67/* macro to erase all color bits then sets only the current white bit */
68#define makewhite(g,x) \
69 (x->marked = cast_byte((x->marked & maskcolors) | luaC_white(g)))
70
71#define white2gray(x) resetbits(x->marked, WHITEBITS)
72#define black2gray(x) resetbit(x->marked, BLACKBIT)
73
74
75#define valiswhite(x) (iscollectable(x) && iswhite(gcvalue(x)))
76
77#define keyiswhite(n) (keyiscollectable(n) && iswhite(gckey(n)))
78
79
80#define checkconsistency(obj) \
81 lua_longassert(!iscollectable(obj) || righttt(obj))
82
83/*
84** Protected access to objects in values
85*/
86#define gcvalueN(o) (iscollectable(o) ? gcvalue(o) : NULL)
87
88
89#define markvalue(g,o) { checkconsistency(o); \
90 if (valiswhite(o)) reallymarkobject(g,gcvalue(o)); }
91
92#define markkey(g, n) { if keyiswhite(n) reallymarkobject(g,gckey(n)); }
93
94#define markobject(g,t) { if (iswhite(t)) reallymarkobject(g, obj2gco(t)); }
95
96/*
97** mark an object that can be NULL (either because it is really optional,
98** or it was stripped as debug info, or inside an uncompleted structure)
99*/
100#define markobjectN(g,t) { if (t) markobject(g,t); }
101
102static void reallymarkobject (global_State *g, GCObject *o);
103static lu_mem atomic (lua_State *L);
104static void entersweep (lua_State *L);
105
106
107/*
108** {======================================================
109** Generic functions
110** =======================================================
111*/
112
113
114/*
115** one after last element in a hash array
116*/
117#define gnodelast(h) gnode(h, cast_sizet(sizenode(h)))
118
119
120static GCObject **getgclist (GCObject *o) {
121 switch (o->tt) {
122 case LUA_VTABLE: return &gco2t(o)->gclist;
123 case LUA_VLCL: return &gco2lcl(o)->gclist;
124 case LUA_VCCL: return &gco2ccl(o)->gclist;
125 case LUA_VTHREAD: return &gco2th(o)->gclist;
126 case LUA_VPROTO: return &gco2p(o)->gclist;
127 case LUA_VUSERDATA: {
128 Udata *u = gco2u(o);
129 lua_assert(u->nuvalue > 0);
130 return &u->gclist;
131 }
132 default: lua_assert(0); return 0;
133 }
134}
135
136
137/*
138** Link a collectable object 'o' with a known type into list pointed by 'p'.
139*/
140#define linkgclist(o,p) ((o)->gclist = (p), (p) = obj2gco(o))
141
142
143/*
144** Link a generic collectable object 'o' into list pointed by 'p'.
145*/
146#define linkobjgclist(o,p) (*getgclist(o) = (p), (p) = obj2gco(o))
147
148
149
150/*
151** Clear keys for empty entries in tables. If entry is empty
152** and its key is not marked, mark its entry as dead. This allows the
153** collection of the key, but keeps its entry in the table (its removal
154** could break a chain). The main feature of a dead key is that it must
155** be different from any other value, to do not disturb searches.
156** Other places never manipulate dead keys, because its associated empty
157** value is enough to signal that the entry is logically empty.
158*/
159static void clearkey (Node *n) {
160 lua_assert(isempty(gval(n)));
161 if (keyiswhite(n))
162 setdeadkey(n); /* unused and unmarked key; remove it */
163}
164
165
166/*
167** tells whether a key or value can be cleared from a weak
168** table. Non-collectable objects are never removed from weak
169** tables. Strings behave as 'values', so are never removed too. for
170** other objects: if really collected, cannot keep them; for objects
171** being finalized, keep them in keys, but not in values
172*/
173static int iscleared (global_State *g, const GCObject *o) {
174 if (o == NULL) return 0; /* non-collectable value */
175 else if (novariant(o->tt) == LUA_TSTRING) {
176 markobject(g, o); /* strings are 'values', so are never weak */
177 return 0;
178 }
179 else return iswhite(o);
180}
181
182
183/*
184** barrier that moves collector forward, that is, mark the white object
185** 'v' being pointed by the black object 'o'. (If in sweep phase, clear
186** the black object to white [sweep it] to avoid other barrier calls for
187** this same object.) In the generational mode, 'v' must also become
188** old, if 'o' is old; however, it cannot be changed directly to OLD,
189** because it may still point to non-old objects. So, it is marked as
190** OLD0. In the next cycle it will become OLD1, and in the next it
191** will finally become OLD (regular old).
192*/
193void luaC_barrier_ (lua_State *L, GCObject *o, GCObject *v) {
194 global_State *g = G(L);
195 lua_assert(isblack(o) && iswhite(v) && !isdead(g, v) && !isdead(g, o));
196 if (keepinvariant(g)) { /* must keep invariant? */
197 reallymarkobject(g, v); /* restore invariant */
198 if (isold(o)) {
199 lua_assert(!isold(v)); /* white object could not be old */
200 setage(v, G_OLD0); /* restore generational invariant */
201 }
202 }
203 else { /* sweep phase */
204 lua_assert(issweepphase(g));
205 makewhite(g, o); /* mark main obj. as white to avoid other barriers */
206 }
207}
208
209
210/*
211** barrier that moves collector backward, that is, mark the black object
212** pointing to a white object as gray again.
213*/
214void luaC_barrierback_ (lua_State *L, GCObject *o) {
215 global_State *g = G(L);
216 lua_assert(isblack(o) && !isdead(g, o));
217 lua_assert(g->gckind != KGC_GEN || (isold(o) && getage(o) != G_TOUCHED1));
218 if (getage(o) != G_TOUCHED2) /* not already in gray list? */
219 linkobjgclist(o, g->grayagain); /* link it in 'grayagain' */
220 black2gray(o); /* make object gray (again) */
221 setage(o, G_TOUCHED1); /* touched in current cycle */
222}
223
224
225void luaC_fix (lua_State *L, GCObject *o) {
226 global_State *g = G(L);
227 lua_assert(g->allgc == o); /* object must be 1st in 'allgc' list! */
228 white2gray(o); /* they will be gray forever */
229 setage(o, G_OLD); /* and old forever */
230 g->allgc = o->next; /* remove object from 'allgc' list */
231 o->next = g->fixedgc; /* link it to 'fixedgc' list */
232 g->fixedgc = o;
233}
234
235
236/*
237** create a new collectable object (with given type and size) and link
238** it to 'allgc' list.
239*/
240GCObject *luaC_newobj (lua_State *L, int tt, size_t sz) {
241 global_State *g = G(L);
242 GCObject *o = cast(GCObject *, luaM_newobject(L, novariant(tt), sz));
243 o->marked = luaC_white(g);
244 o->tt = tt;
245 o->next = g->allgc;
246 g->allgc = o;
247 return o;
248}
249
250/* }====================================================== */
251
252
253
254/*
255** {======================================================
256** Mark functions
257** =======================================================
258*/
259
260
261/*
262** Mark an object. Userdata, strings, and closed upvalues are visited
263** and turned black here. Other objects are marked gray and added
264** to appropriate list to be visited (and turned black) later. (Open
265** upvalues are already linked in 'headuv' list. They are kept gray
266** to avoid barriers, as their values will be revisited by the thread.)
267*/
268static void reallymarkobject (global_State *g, GCObject *o) {
269 white2gray(o);
270 switch (o->tt) {
271 case LUA_VSHRSTR:
272 case LUA_VLNGSTR: {
273 gray2black(o);
274 break;
275 }
276 case LUA_VUPVAL: {
277 UpVal *uv = gco2upv(o);
278 if (!upisopen(uv)) /* open upvalues are kept gray */
279 gray2black(o);
280 markvalue(g, uv->v); /* mark its content */
281 break;
282 }
283 case LUA_VUSERDATA: {
284 Udata *u = gco2u(o);
285 if (u->nuvalue == 0) { /* no user values? */
286 markobjectN(g, u->metatable); /* mark its metatable */
287 gray2black(o); /* nothing else to mark */
288 break;
289 }
290 /* else... */
291 } /* FALLTHROUGH */
292 case LUA_VLCL: case LUA_VCCL: case LUA_VTABLE:
293 case LUA_VTHREAD: case LUA_VPROTO: {
294 linkobjgclist(o, g->gray);
295 break;
296 }
297 default: lua_assert(0); break;
298 }
299}
300
301
302/*
303** mark metamethods for basic types
304*/
305static void markmt (global_State *g) {
306 int i;
307 for (i=0; i < LUA_NUMTAGS; i++)
308 markobjectN(g, g->mt[i]);
309}
310
311
312/*
313** mark all objects in list of being-finalized
314*/
315static lu_mem markbeingfnz (global_State *g) {
316 GCObject *o;
317 lu_mem count = 0;
318 for (o = g->tobefnz; o != NULL; o = o->next) {
319 count++;
320 markobject(g, o);
321 }
322 return count;
323}
324
325
326/*
327** Mark all values stored in marked open upvalues from non-marked threads.
328** (Values from marked threads were already marked when traversing the
329** thread.) Remove from the list threads that no longer have upvalues and
330** not-marked threads.
331*/
332static int remarkupvals (global_State *g) {
333 lua_State *thread;
334 lua_State **p = &g->twups;
335 int work = 0;
336 while ((thread = *p) != NULL) {
337 work++;
338 lua_assert(!isblack(thread)); /* threads are never black */
339 if (isgray(thread) && thread->openupval != NULL)
340 p = &thread->twups; /* keep marked thread with upvalues in the list */
341 else { /* thread is not marked or without upvalues */
342 UpVal *uv;
343 *p = thread->twups; /* remove thread from the list */
344 thread->twups = thread; /* mark that it is out of list */
345 for (uv = thread->openupval; uv != NULL; uv = uv->u.open.next) {
346 work++;
347 if (!iswhite(uv)) /* upvalue already visited? */
348 markvalue(g, uv->v); /* mark its value */
349 }
350 }
351 }
352 return work;
353}
354
355
356/*
357** mark root set and reset all gray lists, to start a new collection
358*/
359static void restartcollection (global_State *g) {
360 g->gray = g->grayagain = NULL;
361 g->weak = g->allweak = g->ephemeron = NULL;
362 markobject(g, g->mainthread);
363 markvalue(g, &g->l_registry);
364 markmt(g);
365 markbeingfnz(g); /* mark any finalizing object left from previous cycle */
366}
367
368/* }====================================================== */
369
370
371/*
372** {======================================================
373** Traverse functions
374** =======================================================
375*/
376
377/*
378** Traverse a table with weak values and link it to proper list. During
379** propagate phase, keep it in 'grayagain' list, to be revisited in the
380** atomic phase. In the atomic phase, if table has any white value,
381** put it in 'weak' list, to be cleared.
382*/
383static void traverseweakvalue (global_State *g, Table *h) {
384 Node *n, *limit = gnodelast(h);
385 /* if there is array part, assume it may have white values (it is not
386 worth traversing it now just to check) */
387 int hasclears = (h->alimit > 0);
388 for (n = gnode(h, 0); n < limit; n++) { /* traverse hash part */
389 if (isempty(gval(n))) /* entry is empty? */
390 clearkey(n); /* clear its key */
391 else {
392 lua_assert(!keyisnil(n));
393 markkey(g, n);
394 if (!hasclears && iscleared(g, gcvalueN(gval(n)))) /* a white value? */
395 hasclears = 1; /* table will have to be cleared */
396 }
397 }
398 if (g->gcstate == GCSatomic && hasclears)
399 linkgclist(h, g->weak); /* has to be cleared later */
400 else
401 linkgclist(h, g->grayagain); /* must retraverse it in atomic phase */
402}
403
404
405/*
406** Traverse an ephemeron table and link it to proper list. Returns true
407** iff any object was marked during this traversal (which implies that
408** convergence has to continue). During propagation phase, keep table
409** in 'grayagain' list, to be visited again in the atomic phase. In
410** the atomic phase, if table has any white->white entry, it has to
411** be revisited during ephemeron convergence (as that key may turn
412** black). Otherwise, if it has any white key, table has to be cleared
413** (in the atomic phase). In generational mode, it (like all visited
414** tables) must be kept in some gray list for post-processing.
415*/
416static int traverseephemeron (global_State *g, Table *h, int inv) {
417 int marked = 0; /* true if an object is marked in this traversal */
418 int hasclears = 0; /* true if table has white keys */
419 int hasww = 0; /* true if table has entry "white-key -> white-value" */
420 unsigned int i;
421 unsigned int asize = luaH_realasize(h);
422 unsigned int nsize = sizenode(h);
423 /* traverse array part */
424 for (i = 0; i < asize; i++) {
425 if (valiswhite(&h->array[i])) {
426 marked = 1;
427 reallymarkobject(g, gcvalue(&h->array[i]));
428 }
429 }
430 /* traverse hash part; if 'inv', traverse descending
431 (see 'convergeephemerons') */
432 for (i = 0; i < nsize; i++) {
433 Node *n = inv ? gnode(h, nsize - 1 - i) : gnode(h, i);
434 if (isempty(gval(n))) /* entry is empty? */
435 clearkey(n); /* clear its key */
436 else if (iscleared(g, gckeyN(n))) { /* key is not marked (yet)? */
437 hasclears = 1; /* table must be cleared */
438 if (valiswhite(gval(n))) /* value not marked yet? */
439 hasww = 1; /* white-white entry */
440 }
441 else if (valiswhite(gval(n))) { /* value not marked yet? */
442 marked = 1;
443 reallymarkobject(g, gcvalue(gval(n))); /* mark it now */
444 }
445 }
446 /* link table into proper list */
447 if (g->gcstate == GCSpropagate)
448 linkgclist(h, g->grayagain); /* must retraverse it in atomic phase */
449 else if (hasww) /* table has white->white entries? */
450 linkgclist(h, g->ephemeron); /* have to propagate again */
451 else if (hasclears) /* table has white keys? */
452 linkgclist(h, g->allweak); /* may have to clean white keys */
453 else if (g->gckind == KGC_GEN)
454 linkgclist(h, g->grayagain); /* keep it in some list */
455 else
456 gray2black(h);
457 return marked;
458}
459
460
461static void traversestrongtable (global_State *g, Table *h) {
462 Node *n, *limit = gnodelast(h);
463 unsigned int i;
464 unsigned int asize = luaH_realasize(h);
465 for (i = 0; i < asize; i++) /* traverse array part */
466 markvalue(g, &h->array[i]);
467 for (n = gnode(h, 0); n < limit; n++) { /* traverse hash part */
468 if (isempty(gval(n))) /* entry is empty? */
469 clearkey(n); /* clear its key */
470 else {
471 lua_assert(!keyisnil(n));
472 markkey(g, n);
473 markvalue(g, gval(n));
474 }
475 }
476 if (g->gckind == KGC_GEN) {
477 linkgclist(h, g->grayagain); /* keep it in some gray list */
478 black2gray(h);
479 }
480}
481
482
483static lu_mem traversetable (global_State *g, Table *h) {
484 const char *weakkey, *weakvalue;
485 const TValue *mode = gfasttm(g, h->metatable, TM_MODE);
486 markobjectN(g, h->metatable);
487 if (mode && ttisstring(mode) && /* is there a weak mode? */
488 (cast_void(weakkey = strchr(svalue(mode), 'k')),
489 cast_void(weakvalue = strchr(svalue(mode), 'v')),
490 (weakkey || weakvalue))) { /* is really weak? */
491 black2gray(h); /* keep table gray */
492 if (!weakkey) /* strong keys? */
493 traverseweakvalue(g, h);
494 else if (!weakvalue) /* strong values? */
495 traverseephemeron(g, h, 0);
496 else /* all weak */
497 linkgclist(h, g->allweak); /* nothing to traverse now */
498 }
499 else /* not weak */
500 traversestrongtable(g, h);
501 return 1 + h->alimit + 2 * allocsizenode(h);
502}
503
504
505static int traverseudata (global_State *g, Udata *u) {
506 int i;
507 markobjectN(g, u->metatable); /* mark its metatable */
508 for (i = 0; i < u->nuvalue; i++)
509 markvalue(g, &u->uv[i].uv);
510 if (g->gckind == KGC_GEN) {
511 linkgclist(u, g->grayagain); /* keep it in some gray list */
512 black2gray(u);
513 }
514 return 1 + u->nuvalue;
515}
516
517
518/*
519** Traverse a prototype. (While a prototype is being build, its
520** arrays can be larger than needed; the extra slots are filled with
521** NULL, so the use of 'markobjectN')
522*/
523static int traverseproto (global_State *g, Proto *f) {
524 int i;
525 markobjectN(g, f->source);
526 for (i = 0; i < f->sizek; i++) /* mark literals */
527 markvalue(g, &f->k[i]);
528 for (i = 0; i < f->sizeupvalues; i++) /* mark upvalue names */
529 markobjectN(g, f->upvalues[i].name);
530 for (i = 0; i < f->sizep; i++) /* mark nested protos */
531 markobjectN(g, f->p[i]);
532 for (i = 0; i < f->sizelocvars; i++) /* mark local-variable names */
533 markobjectN(g, f->locvars[i].varname);
534 return 1 + f->sizek + f->sizeupvalues + f->sizep + f->sizelocvars;
535}
536
537
538static int traverseCclosure (global_State *g, CClosure *cl) {
539 int i;
540 for (i = 0; i < cl->nupvalues; i++) /* mark its upvalues */
541 markvalue(g, &cl->upvalue[i]);
542 return 1 + cl->nupvalues;
543}
544
545/*
546** Traverse a Lua closure, marking its prototype and its upvalues.
547** (Both can be NULL while closure is being created.)
548*/
549static int traverseLclosure (global_State *g, LClosure *cl) {
550 int i;
551 markobjectN(g, cl->p); /* mark its prototype */
552 for (i = 0; i < cl->nupvalues; i++) { /* visit its upvalues */
553 UpVal *uv = cl->upvals[i];
554 markobjectN(g, uv); /* mark upvalue */
555 }
556 return 1 + cl->nupvalues;
557}
558
559
560/*
561** Traverse a thread, marking the elements in the stack up to its top
562** and cleaning the rest of the stack in the final traversal.
563** That ensures that the entire stack have valid (non-dead) objects.
564*/
565static int traversethread (global_State *g, lua_State *th) {
566 UpVal *uv;
567 StkId o = th->stack;
568 if (o == NULL)
569 return 1; /* stack not completely built yet */
570 lua_assert(g->gcstate == GCSatomic ||
571 th->openupval == NULL || isintwups(th));
572 for (; o < th->top; o++) /* mark live elements in the stack */
573 markvalue(g, s2v(o));
574 for (uv = th->openupval; uv != NULL; uv = uv->u.open.next)
575 markobject(g, uv); /* open upvalues cannot be collected */
576 if (g->gcstate == GCSatomic) { /* final traversal? */
577 StkId lim = th->stack + th->stacksize; /* real end of stack */
578 for (; o < lim; o++) /* clear not-marked stack slice */
579 setnilvalue(s2v(o));
580 /* 'remarkupvals' may have removed thread from 'twups' list */
581 if (!isintwups(th) && th->openupval != NULL) {
582 th->twups = g->twups; /* link it back to the list */
583 g->twups = th;
584 }
585 }
586 else if (!g->gcemergency)
587 luaD_shrinkstack(th); /* do not change stack in emergency cycle */
588 return 1 + th->stacksize;
589}
590
591
592/*
593** traverse one gray object, turning it to black (except for threads,
594** which are always gray).
595*/
596static lu_mem propagatemark (global_State *g) {
597 GCObject *o = g->gray;
598 gray2black(o);
599 g->gray = *getgclist(o); /* remove from 'gray' list */
600 switch (o->tt) {
601 case LUA_VTABLE: return traversetable(g, gco2t(o));
602 case LUA_VUSERDATA: return traverseudata(g, gco2u(o));
603 case LUA_VLCL: return traverseLclosure(g, gco2lcl(o));
604 case LUA_VCCL: return traverseCclosure(g, gco2ccl(o));
605 case LUA_VPROTO: return traverseproto(g, gco2p(o));
606 case LUA_VTHREAD: {
607 lua_State *th = gco2th(o);
608 linkgclist(th, g->grayagain); /* insert into 'grayagain' list */
609 black2gray(o);
610 return traversethread(g, th);
611 }
612 default: lua_assert(0); return 0;
613 }
614}
615
616
617static lu_mem propagateall (global_State *g) {
618 lu_mem tot = 0;
619 while (g->gray)
620 tot += propagatemark(g);
621 return tot;
622}
623
624
625/*
626** Traverse all ephemeron tables propagating marks from keys to values.
627** Repeat until it converges, that is, nothing new is marked. 'dir'
628** inverts the direction of the traversals, trying to speed up
629** convergence on chains in the same table.
630**
631*/
632static void convergeephemerons (global_State *g) {
633 int changed;
634 int dir = 0;
635 do {
636 GCObject *w;
637 GCObject *next = g->ephemeron; /* get ephemeron list */
638 g->ephemeron = NULL; /* tables may return to this list when traversed */
639 changed = 0;
640 while ((w = next) != NULL) { /* for each ephemeron table */
641 next = gco2t(w)->gclist; /* list is rebuilt during loop */
642 if (traverseephemeron(g, gco2t(w), dir)) { /* marked some value? */
643 propagateall(g); /* propagate changes */
644 changed = 1; /* will have to revisit all ephemeron tables */
645 }
646 }
647 dir = !dir; /* invert direction next time */
648 } while (changed); /* repeat until no more changes */
649}
650
651/* }====================================================== */
652
653
654/*
655** {======================================================
656** Sweep Functions
657** =======================================================
658*/
659
660
661/*
662** clear entries with unmarked keys from all weaktables in list 'l'
663*/
664static void clearbykeys (global_State *g, GCObject *l) {
665 for (; l; l = gco2t(l)->gclist) {
666 Table *h = gco2t(l);
667 Node *limit = gnodelast(h);
668 Node *n;
669 for (n = gnode(h, 0); n < limit; n++) {
670 if (iscleared(g, gckeyN(n))) /* unmarked key? */
671 setempty(gval(n)); /* remove entry */
672 if (isempty(gval(n))) /* is entry empty? */
673 clearkey(n); /* clear its key */
674 }
675 }
676}
677
678
679/*
680** clear entries with unmarked values from all weaktables in list 'l' up
681** to element 'f'
682*/
683static void clearbyvalues (global_State *g, GCObject *l, GCObject *f) {
684 for (; l != f; l = gco2t(l)->gclist) {
685 Table *h = gco2t(l);
686 Node *n, *limit = gnodelast(h);
687 unsigned int i;
688 unsigned int asize = luaH_realasize(h);
689 for (i = 0; i < asize; i++) {
690 TValue *o = &h->array[i];
691 if (iscleared(g, gcvalueN(o))) /* value was collected? */
692 setempty(o); /* remove entry */
693 }
694 for (n = gnode(h, 0); n < limit; n++) {
695 if (iscleared(g, gcvalueN(gval(n)))) /* unmarked value? */
696 setempty(gval(n)); /* remove entry */
697 if (isempty(gval(n))) /* is entry empty? */
698 clearkey(n); /* clear its key */
699 }
700 }
701}
702
703
704static void freeupval (lua_State *L, UpVal *uv) {
705 if (upisopen(uv))
706 luaF_unlinkupval(uv);
707 luaM_free(L, uv);
708}
709
710
711static void freeobj (lua_State *L, GCObject *o) {
712 switch (o->tt) {
713 case LUA_VPROTO:
714 luaF_freeproto(L, gco2p(o));
715 break;
716 case LUA_VUPVAL:
717 freeupval(L, gco2upv(o));
718 break;
719 case LUA_VLCL:
720 luaM_freemem(L, o, sizeLclosure(gco2lcl(o)->nupvalues));
721 break;
722 case LUA_VCCL:
723 luaM_freemem(L, o, sizeCclosure(gco2ccl(o)->nupvalues));
724 break;
725 case LUA_VTABLE:
726 luaH_free(L, gco2t(o));
727 break;
728 case LUA_VTHREAD:
729 luaE_freethread(L, gco2th(o));
730 break;
731 case LUA_VUSERDATA: {
732 Udata *u = gco2u(o);
733 luaM_freemem(L, o, sizeudata(u->nuvalue, u->len));
734 break;
735 }
736 case LUA_VSHRSTR:
737 luaS_remove(L, gco2ts(o)); /* remove it from hash table */
738 luaM_freemem(L, o, sizelstring(gco2ts(o)->shrlen));
739 break;
740 case LUA_VLNGSTR:
741 luaM_freemem(L, o, sizelstring(gco2ts(o)->u.lnglen));
742 break;
743 default: lua_assert(0);
744 }
745}
746
747
748/*
749** sweep at most 'countin' elements from a list of GCObjects erasing dead
750** objects, where a dead object is one marked with the old (non current)
751** white; change all non-dead objects back to white, preparing for next
752** collection cycle. Return where to continue the traversal or NULL if
753** list is finished. ('*countout' gets the number of elements traversed.)
754*/
755static GCObject **sweeplist (lua_State *L, GCObject **p, int countin,
756 int *countout) {
757 global_State *g = G(L);
758 int ow = otherwhite(g);
759 int i;
760 int white = luaC_white(g); /* current white */
761 for (i = 0; *p != NULL && i < countin; i++) {
762 GCObject *curr = *p;
763 int marked = curr->marked;
764 if (isdeadm(ow, marked)) { /* is 'curr' dead? */
765 *p = curr->next; /* remove 'curr' from list */
766 freeobj(L, curr); /* erase 'curr' */
767 }
768 else { /* change mark to 'white' */
769 curr->marked = cast_byte((marked & maskcolors) | white);
770 p = &curr->next; /* go to next element */
771 }
772 }
773 if (countout)
774 *countout = i; /* number of elements traversed */
775 return (*p == NULL) ? NULL : p;
776}
777
778
779/*
780** sweep a list until a live object (or end of list)
781*/
782static GCObject **sweeptolive (lua_State *L, GCObject **p) {
783 GCObject **old = p;
784 do {
785 p = sweeplist(L, p, 1, NULL);
786 } while (p == old);
787 return p;
788}
789
790/* }====================================================== */
791
792
793/*
794** {======================================================
795** Finalization
796** =======================================================
797*/
798
799/*
800** If possible, shrink string table.
801*/
802static void checkSizes (lua_State *L, global_State *g) {
803 if (!g->gcemergency) {
804 if (g->strt.nuse < g->strt.size / 4) { /* string table too big? */
805 l_mem olddebt = g->GCdebt;
806 luaS_resize(L, g->strt.size / 2);
807 g->GCestimate += g->GCdebt - olddebt; /* correct estimate */
808 }
809 }
810}
811
812
813/*
814** Get the next udata to be finalized from the 'tobefnz' list, and
815** link it back into the 'allgc' list.
816*/
817static GCObject *udata2finalize (global_State *g) {
818 GCObject *o = g->tobefnz; /* get first element */
819 lua_assert(tofinalize(o));
820 g->tobefnz = o->next; /* remove it from 'tobefnz' list */
821 o->next = g->allgc; /* return it to 'allgc' list */
822 g->allgc = o;
823 resetbit(o->marked, FINALIZEDBIT); /* object is "normal" again */
824 if (issweepphase(g))
825 makewhite(g, o); /* "sweep" object */
826 return o;
827}
828
829
830static void dothecall (lua_State *L, void *ud) {
831 UNUSED(ud);
832 luaD_callnoyield(L, L->top - 2, 0);
833}
834
835
836static void GCTM (lua_State *L) {
837 global_State *g = G(L);
838 const TValue *tm;
839 TValue v;
840 lua_assert(!g->gcemergency);
841 setgcovalue(L, &v, udata2finalize(g));
842 tm = luaT_gettmbyobj(L, &v, TM_GC);
843 if (!notm(tm)) { /* is there a finalizer? */
844 int status;
845 lu_byte oldah = L->allowhook;
846 int running = g->gcrunning;
847 L->allowhook = 0; /* stop debug hooks during GC metamethod */
848 g->gcrunning = 0; /* avoid GC steps */
849 setobj2s(L, L->top++, tm); /* push finalizer... */
850 setobj2s(L, L->top++, &v); /* ... and its argument */
851 L->ci->callstatus |= CIST_FIN; /* will run a finalizer */
852 status = luaD_pcall(L, dothecall, NULL, savestack(L, L->top - 2), 0);
853 L->ci->callstatus &= ~CIST_FIN; /* not running a finalizer anymore */
854 L->allowhook = oldah; /* restore hooks */
855 g->gcrunning = running; /* restore state */
856 if (unlikely(status != LUA_OK)) { /* error while running __gc? */
857 luaE_warnerror(L, "__gc metamethod");
858 L->top--; /* pops error object */
859 }
860 }
861}
862
863
864/*
865** Call a few finalizers
866*/
867static int runafewfinalizers (lua_State *L, int n) {
868 global_State *g = G(L);
869 int i;
870 for (i = 0; i < n && g->tobefnz; i++)
871 GCTM(L); /* call one finalizer */
872 return i;
873}
874
875
876/*
877** call all pending finalizers
878*/
879static void callallpendingfinalizers (lua_State *L) {
880 global_State *g = G(L);
881 while (g->tobefnz)
882 GCTM(L);
883}
884
885
886/*
887** find last 'next' field in list 'p' list (to add elements in its end)
888*/
889static GCObject **findlast (GCObject **p) {
890 while (*p != NULL)
891 p = &(*p)->next;
892 return p;
893}
894
895
896/*
897** Move all unreachable objects (or 'all' objects) that need
898** finalization from list 'finobj' to list 'tobefnz' (to be finalized).
899** (Note that objects after 'finobjold' cannot be white, so they
900** don't need to be traversed. In incremental mode, 'finobjold' is NULL,
901** so the whole list is traversed.)
902*/
903static void separatetobefnz (global_State *g, int all) {
904 GCObject *curr;
905 GCObject **p = &g->finobj;
906 GCObject **lastnext = findlast(&g->tobefnz);
907 while ((curr = *p) != g->finobjold) { /* traverse all finalizable objects */
908 lua_assert(tofinalize(curr));
909 if (!(iswhite(curr) || all)) /* not being collected? */
910 p = &curr->next; /* don't bother with it */
911 else {
912 if (curr == g->finobjsur) /* removing 'finobjsur'? */
913 g->finobjsur = curr->next; /* correct it */
914 *p = curr->next; /* remove 'curr' from 'finobj' list */
915 curr->next = *lastnext; /* link at the end of 'tobefnz' list */
916 *lastnext = curr;
917 lastnext = &curr->next;
918 }
919 }
920}
921
922
923/*
924** if object 'o' has a finalizer, remove it from 'allgc' list (must
925** search the list to find it) and link it in 'finobj' list.
926*/
927void luaC_checkfinalizer (lua_State *L, GCObject *o, Table *mt) {
928 global_State *g = G(L);
929 if (tofinalize(o) || /* obj. is already marked... */
930 gfasttm(g, mt, TM_GC) == NULL) /* or has no finalizer? */
931 return; /* nothing to be done */
932 else { /* move 'o' to 'finobj' list */
933 GCObject **p;
934 if (issweepphase(g)) {
935 makewhite(g, o); /* "sweep" object 'o' */
936 if (g->sweepgc == &o->next) /* should not remove 'sweepgc' object */
937 g->sweepgc = sweeptolive(L, g->sweepgc); /* change 'sweepgc' */
938 }
939 else { /* correct pointers into 'allgc' list, if needed */
940 if (o == g->survival)
941 g->survival = o->next;
942 if (o == g->old)
943 g->old = o->next;
944 if (o == g->reallyold)
945 g->reallyold = o->next;
946 }
947 /* search for pointer pointing to 'o' */
948 for (p = &g->allgc; *p != o; p = &(*p)->next) { /* empty */ }
949 *p = o->next; /* remove 'o' from 'allgc' list */
950 o->next = g->finobj; /* link it in 'finobj' list */
951 g->finobj = o;
952 l_setbit(o->marked, FINALIZEDBIT); /* mark it as such */
953 }
954}
955
956/* }====================================================== */
957
958
959/*
960** {======================================================
961** Generational Collector
962** =======================================================
963*/
964
965static void setpause (global_State *g);
966
967
968/* mask to erase all color bits, not changing gen-related stuff */
969#define maskgencolors (~(bitmask(BLACKBIT) | WHITEBITS))
970
971
972/*
973** Sweep a list of objects, deleting dead ones and turning
974** the non dead to old (without changing their colors).
975*/
976static void sweep2old (lua_State *L, GCObject **p) {
977 GCObject *curr;
978 while ((curr = *p) != NULL) {
979 if (iswhite(curr)) { /* is 'curr' dead? */
980 lua_assert(isdead(G(L), curr));
981 *p = curr->next; /* remove 'curr' from list */
982 freeobj(L, curr); /* erase 'curr' */
983 }
984 else { /* all surviving objects become old */
985 setage(curr, G_OLD);
986 p = &curr->next; /* go to next element */
987 }
988 }
989}
990
991
992/*
993** Sweep for generational mode. Delete dead objects. (Because the
994** collection is not incremental, there are no "new white" objects
995** during the sweep. So, any white object must be dead.) For
996** non-dead objects, advance their ages and clear the color of
997** new objects. (Old objects keep their colors.)
998*/
999static GCObject **sweepgen (lua_State *L, global_State *g, GCObject **p,
1000 GCObject *limit) {
1001 static const lu_byte nextage[] = {
1002 G_SURVIVAL, /* from G_NEW */
1003 G_OLD1, /* from G_SURVIVAL */
1004 G_OLD1, /* from G_OLD0 */
1005 G_OLD, /* from G_OLD1 */
1006 G_OLD, /* from G_OLD (do not change) */
1007 G_TOUCHED1, /* from G_TOUCHED1 (do not change) */
1008 G_TOUCHED2 /* from G_TOUCHED2 (do not change) */
1009 };
1010 int white = luaC_white(g);
1011 GCObject *curr;
1012 while ((curr = *p) != limit) {
1013 if (iswhite(curr)) { /* is 'curr' dead? */
1014 lua_assert(!isold(curr) && isdead(g, curr));
1015 *p = curr->next; /* remove 'curr' from list */
1016 freeobj(L, curr); /* erase 'curr' */
1017 }
1018 else { /* correct mark and age */
1019 if (getage(curr) == G_NEW)
1020 curr->marked = cast_byte((curr->marked & maskgencolors) | white);
1021 setage(curr, nextage[getage(curr)]);
1022 p = &curr->next; /* go to next element */
1023 }
1024 }
1025 return p;
1026}
1027
1028
1029/*
1030** Traverse a list making all its elements white and clearing their
1031** age.
1032*/
1033static void whitelist (global_State *g, GCObject *p) {
1034 int white = luaC_white(g);
1035 for (; p != NULL; p = p->next)
1036 p->marked = cast_byte((p->marked & maskcolors) | white);
1037}
1038
1039
1040/*
1041** Correct a list of gray objects.
1042** Because this correction is done after sweeping, young objects might
1043** be turned white and still be in the list. They are only removed.
1044** For tables and userdata, advance 'touched1' to 'touched2'; 'touched2'
1045** objects become regular old and are removed from the list.
1046** For threads, just remove white ones from the list.
1047*/
1048static GCObject **correctgraylist (GCObject **p) {
1049 GCObject *curr;
1050 while ((curr = *p) != NULL) {
1051 switch (curr->tt) {
1052 case LUA_VTABLE: case LUA_VUSERDATA: {
1053 GCObject **next = getgclist(curr);
1054 if (getage(curr) == G_TOUCHED1) { /* touched in this cycle? */
1055 lua_assert(isgray(curr));
1056 gray2black(curr); /* make it black, for next barrier */
1057 changeage(curr, G_TOUCHED1, G_TOUCHED2);
1058 p = next; /* go to next element */
1059 }
1060 else { /* not touched in this cycle */
1061 if (!iswhite(curr)) { /* not white? */
1062 lua_assert(isold(curr));
1063 if (getage(curr) == G_TOUCHED2) /* advance from G_TOUCHED2... */
1064 changeage(curr, G_TOUCHED2, G_OLD); /* ... to G_OLD */
1065 gray2black(curr); /* make it black */
1066 }
1067 /* else, object is white: just remove it from this list */
1068 *p = *next; /* remove 'curr' from gray list */
1069 }
1070 break;
1071 }
1072 case LUA_VTHREAD: {
1073 lua_State *th = gco2th(curr);
1074 lua_assert(!isblack(th));
1075 if (iswhite(th)) /* new object? */
1076 *p = th->gclist; /* remove from gray list */
1077 else /* old threads remain gray */
1078 p = &th->gclist; /* go to next element */
1079 break;
1080 }
1081 default: lua_assert(0); /* nothing more could be gray here */
1082 }
1083 }
1084 return p;
1085}
1086
1087
1088/*
1089** Correct all gray lists, coalescing them into 'grayagain'.
1090*/
1091static void correctgraylists (global_State *g) {
1092 GCObject **list = correctgraylist(&g->grayagain);
1093 *list = g->weak; g->weak = NULL;
1094 list = correctgraylist(list);
1095 *list = g->allweak; g->allweak = NULL;
1096 list = correctgraylist(list);
1097 *list = g->ephemeron; g->ephemeron = NULL;
1098 correctgraylist(list);
1099}
1100
1101
1102/*
1103** Mark 'OLD1' objects when starting a new young collection.
1104** Gray objects are already in some gray list, and so will be visited
1105** in the atomic step.
1106*/
1107static void markold (global_State *g, GCObject *from, GCObject *to) {
1108 GCObject *p;
1109 for (p = from; p != to; p = p->next) {
1110 if (getage(p) == G_OLD1) {
1111 lua_assert(!iswhite(p));
1112 if (isblack(p)) {
1113 black2gray(p); /* should be '2white', but gray works too */
1114 reallymarkobject(g, p);
1115 }
1116 }
1117 }
1118}
1119
1120
1121/*
1122** Finish a young-generation collection.
1123*/
1124static void finishgencycle (lua_State *L, global_State *g) {
1125 correctgraylists(g);
1126 checkSizes(L, g);
1127 g->gcstate = GCSpropagate; /* skip restart */
1128 if (!g->gcemergency)
1129 callallpendingfinalizers(L);
1130}
1131
1132
1133/*
1134** Does a young collection. First, mark 'OLD1' objects. (Only survival
1135** and "recent old" lists can contain 'OLD1' objects. New lists cannot
1136** contain 'OLD1' objects, at most 'OLD0' objects that were already
1137** visited when marked old.) Then does the atomic step. Then,
1138** sweep all lists and advance pointers. Finally, finish the collection.
1139*/
1140static void youngcollection (lua_State *L, global_State *g) {
1141 GCObject **psurvival; /* to point to first non-dead survival object */
1142 lua_assert(g->gcstate == GCSpropagate);
1143 markold(g, g->survival, g->reallyold);
1144 markold(g, g->finobj, g->finobjrold);
1145 atomic(L);
1146
1147 /* sweep nursery and get a pointer to its last live element */
1148 psurvival = sweepgen(L, g, &g->allgc, g->survival);
1149 /* sweep 'survival' and 'old' */
1150 sweepgen(L, g, psurvival, g->reallyold);
1151 g->reallyold = g->old;
1152 g->old = *psurvival; /* 'survival' survivals are old now */
1153 g->survival = g->allgc; /* all news are survivals */
1154
1155 /* repeat for 'finobj' lists */
1156 psurvival = sweepgen(L, g, &g->finobj, g->finobjsur);
1157 /* sweep 'survival' and 'old' */
1158 sweepgen(L, g, psurvival, g->finobjrold);
1159 g->finobjrold = g->finobjold;
1160 g->finobjold = *psurvival; /* 'survival' survivals are old now */
1161 g->finobjsur = g->finobj; /* all news are survivals */
1162
1163 sweepgen(L, g, &g->tobefnz, NULL);
1164
1165 finishgencycle(L, g);
1166}
1167
1168
1169static void atomic2gen (lua_State *L, global_State *g) {
1170 /* sweep all elements making them old */
1171 sweep2old(L, &g->allgc);
1172 /* everything alive now is old */
1173 g->reallyold = g->old = g->survival = g->allgc;
1174
1175 /* repeat for 'finobj' lists */
1176 sweep2old(L, &g->finobj);
1177 g->finobjrold = g->finobjold = g->finobjsur = g->finobj;
1178
1179 sweep2old(L, &g->tobefnz);
1180
1181 g->gckind = KGC_GEN;
1182 g->lastatomic = 0;
1183 g->GCestimate = gettotalbytes(g); /* base for memory control */
1184 finishgencycle(L, g);
1185}
1186
1187
1188/*
1189** Enter generational mode. Must go until the end of an atomic cycle
1190** to ensure that all threads and weak tables are in the gray lists.
1191** Then, turn all objects into old and finishes the collection.
1192*/
1193static lu_mem entergen (lua_State *L, global_State *g) {
1194 lu_mem numobjs;
1195 luaC_runtilstate(L, bitmask(GCSpause)); /* prepare to start a new cycle */
1196 luaC_runtilstate(L, bitmask(GCSpropagate)); /* start new cycle */
1197 numobjs = atomic(L); /* propagates all and then do the atomic stuff */
1198 atomic2gen(L, g);
1199 return numobjs;
1200}
1201
1202
1203/*
1204** Enter incremental mode. Turn all objects white, make all
1205** intermediate lists point to NULL (to avoid invalid pointers),
1206** and go to the pause state.
1207*/
1208static void enterinc (global_State *g) {
1209 whitelist(g, g->allgc);
1210 g->reallyold = g->old = g->survival = NULL;
1211 whitelist(g, g->finobj);
1212 whitelist(g, g->tobefnz);
1213 g->finobjrold = g->finobjold = g->finobjsur = NULL;
1214 g->gcstate = GCSpause;
1215 g->gckind = KGC_INC;
1216 g->lastatomic = 0;
1217}
1218
1219
1220/*
1221** Change collector mode to 'newmode'.
1222*/
1223void luaC_changemode (lua_State *L, int newmode) {
1224 global_State *g = G(L);
1225 if (newmode != g->gckind) {
1226 if (newmode == KGC_GEN) /* entering generational mode? */
1227 entergen(L, g);
1228 else
1229 enterinc(g); /* entering incremental mode */
1230 }
1231 g->lastatomic = 0;
1232}
1233
1234
1235/*
1236** Does a full collection in generational mode.
1237*/
1238static lu_mem fullgen (lua_State *L, global_State *g) {
1239 enterinc(g);
1240 return entergen(L, g);
1241}
1242
1243
1244/*
1245** Set debt for the next minor collection, which will happen when
1246** memory grows 'genminormul'%.
1247*/
1248static void setminordebt (global_State *g) {
1249 luaE_setdebt(g, -(cast(l_mem, (gettotalbytes(g) / 100)) * g->genminormul));
1250}
1251
1252
1253/*
1254** Does a major collection after last collection was a "bad collection".
1255**
1256** When the program is building a big structure, it allocates lots of
1257** memory but generates very little garbage. In those scenarios,
1258** the generational mode just wastes time doing small collections, and
1259** major collections are frequently what we call a "bad collection", a
1260** collection that frees too few objects. To avoid the cost of switching
1261** between generational mode and the incremental mode needed for full
1262** (major) collections, the collector tries to stay in incremental mode
1263** after a bad collection, and to switch back to generational mode only
1264** after a "good" collection (one that traverses less than 9/8 objects
1265** of the previous one).
1266** The collector must choose whether to stay in incremental mode or to
1267** switch back to generational mode before sweeping. At this point, it
1268** does not know the real memory in use, so it cannot use memory to
1269** decide whether to return to generational mode. Instead, it uses the
1270** number of objects traversed (returned by 'atomic') as a proxy. The
1271** field 'g->lastatomic' keeps this count from the last collection.
1272** ('g->lastatomic != 0' also means that the last collection was bad.)
1273*/
1274static void stepgenfull (lua_State *L, global_State *g) {
1275 lu_mem newatomic; /* count of traversed objects */
1276 lu_mem lastatomic = g->lastatomic; /* count from last collection */
1277 if (g->gckind == KGC_GEN) /* still in generational mode? */
1278 enterinc(g); /* enter incremental mode */
1279 luaC_runtilstate(L, bitmask(GCSpropagate)); /* start new cycle */
1280 newatomic = atomic(L); /* mark everybody */
1281 if (newatomic < lastatomic + (lastatomic >> 3)) { /* good collection? */
1282 atomic2gen(L, g); /* return to generational mode */
1283 setminordebt(g);
1284 }
1285 else { /* another bad collection; stay in incremental mode */
1286 g->GCestimate = gettotalbytes(g); /* first estimate */;
1287 entersweep(L);
1288 luaC_runtilstate(L, bitmask(GCSpause)); /* finish collection */
1289 setpause(g);
1290 g->lastatomic = newatomic;
1291 }
1292}
1293
1294
1295/*
1296** Does a generational "step".
1297** Usually, this means doing a minor collection and setting the debt to
1298** make another collection when memory grows 'genminormul'% larger.
1299**
1300** However, there are exceptions. If memory grows 'genmajormul'%
1301** larger than it was at the end of the last major collection (kept
1302** in 'g->GCestimate'), the function does a major collection. At the
1303** end, it checks whether the major collection was able to free a
1304** decent amount of memory (at least half the growth in memory since
1305** previous major collection). If so, the collector keeps its state,
1306** and the next collection will probably be minor again. Otherwise,
1307** we have what we call a "bad collection". In that case, set the field
1308** 'g->lastatomic' to signal that fact, so that the next collection will
1309** go to 'stepgenfull'.
1310**
1311** 'GCdebt <= 0' means an explicit call to GC step with "size" zero;
1312** in that case, do a minor collection.
1313*/
1314static void genstep (lua_State *L, global_State *g) {
1315 if (g->lastatomic != 0) /* last collection was a bad one? */
1316 stepgenfull(L, g); /* do a full step */
1317 else {
1318 lu_mem majorbase = g->GCestimate; /* memory after last major collection */
1319 lu_mem majorinc = (majorbase / 100) * getgcparam(g->genmajormul);
1320 if (g->GCdebt > 0 && gettotalbytes(g) > majorbase + majorinc) {
1321 lu_mem numobjs = fullgen(L, g); /* do a major collection */
1322 if (gettotalbytes(g) < majorbase + (majorinc / 2)) {
1323 /* collected at least half of memory growth since last major
1324 collection; keep doing minor collections */
1325 setminordebt(g);
1326 }
1327 else { /* bad collection */
1328 g->lastatomic = numobjs; /* signal that last collection was bad */
1329 setpause(g); /* do a long wait for next (major) collection */
1330 }
1331 }
1332 else { /* regular case; do a minor collection */
1333 youngcollection(L, g);
1334 setminordebt(g);
1335 g->GCestimate = majorbase; /* preserve base value */
1336 }
1337 }
1338 lua_assert(isdecGCmodegen(g));
1339}
1340
1341/* }====================================================== */
1342
1343
1344/*
1345** {======================================================
1346** GC control
1347** =======================================================
1348*/
1349
1350
1351/*
1352** Set the "time" to wait before starting a new GC cycle; cycle will
1353** start when memory use hits the threshold of ('estimate' * pause /
1354** PAUSEADJ). (Division by 'estimate' should be OK: it cannot be zero,
1355** because Lua cannot even start with less than PAUSEADJ bytes).
1356*/
1357static void setpause (global_State *g) {
1358 l_mem threshold, debt;
1359 int pause = getgcparam(g->gcpause);
1360 l_mem estimate = g->GCestimate / PAUSEADJ; /* adjust 'estimate' */
1361 lua_assert(estimate > 0);
1362 threshold = (pause < MAX_LMEM / estimate) /* overflow? */
1363 ? estimate * pause /* no overflow */
1364 : MAX_LMEM; /* overflow; truncate to maximum */
1365 debt = gettotalbytes(g) - threshold;
1366 if (debt > 0) debt = 0;
1367 luaE_setdebt(g, debt);
1368}
1369
1370
1371/*
1372** Enter first sweep phase.
1373** The call to 'sweeptolive' makes the pointer point to an object
1374** inside the list (instead of to the header), so that the real sweep do
1375** not need to skip objects created between "now" and the start of the
1376** real sweep.
1377*/
1378static void entersweep (lua_State *L) {
1379 global_State *g = G(L);
1380 g->gcstate = GCSswpallgc;
1381 lua_assert(g->sweepgc == NULL);
1382 g->sweepgc = sweeptolive(L, &g->allgc);
1383}
1384
1385
1386/*
1387** Delete all objects in list 'p' until (but not including) object
1388** 'limit'.
1389*/
1390static void deletelist (lua_State *L, GCObject *p, GCObject *limit) {
1391 while (p != limit) {
1392 GCObject *next = p->next;
1393 freeobj(L, p);
1394 p = next;
1395 }
1396}
1397
1398
1399/*
1400** Call all finalizers of the objects in the given Lua state, and
1401** then free all objects, except for the main thread.
1402*/
1403void luaC_freeallobjects (lua_State *L) {
1404 global_State *g = G(L);
1405 luaC_changemode(L, KGC_INC);
1406 separatetobefnz(g, 1); /* separate all objects with finalizers */
1407 lua_assert(g->finobj == NULL);
1408 callallpendingfinalizers(L);
1409 deletelist(L, g->allgc, obj2gco(g->mainthread));
1410 deletelist(L, g->finobj, NULL);
1411 deletelist(L, g->fixedgc, NULL); /* collect fixed objects */
1412 lua_assert(g->strt.nuse == 0);
1413}
1414
1415
1416static lu_mem atomic (lua_State *L) {
1417 global_State *g = G(L);
1418 lu_mem work = 0;
1419 GCObject *origweak, *origall;
1420 GCObject *grayagain = g->grayagain; /* save original list */
1421 g->grayagain = NULL;
1422 lua_assert(g->ephemeron == NULL && g->weak == NULL);
1423 lua_assert(!iswhite(g->mainthread));
1424 g->gcstate = GCSatomic;
1425 markobject(g, L); /* mark running thread */
1426 /* registry and global metatables may be changed by API */
1427 markvalue(g, &g->l_registry);
1428 markmt(g); /* mark global metatables */
1429 work += propagateall(g); /* empties 'gray' list */
1430 /* remark occasional upvalues of (maybe) dead threads */
1431 work += remarkupvals(g);
1432 work += propagateall(g); /* propagate changes */
1433 g->gray = grayagain;
1434 work += propagateall(g); /* traverse 'grayagain' list */
1435 convergeephemerons(g);
1436 /* at this point, all strongly accessible objects are marked. */
1437 /* Clear values from weak tables, before checking finalizers */
1438 clearbyvalues(g, g->weak, NULL);
1439 clearbyvalues(g, g->allweak, NULL);
1440 origweak = g->weak; origall = g->allweak;
1441 separatetobefnz(g, 0); /* separate objects to be finalized */
1442 work += markbeingfnz(g); /* mark objects that will be finalized */
1443 work += propagateall(g); /* remark, to propagate 'resurrection' */
1444 convergeephemerons(g);
1445 /* at this point, all resurrected objects are marked. */
1446 /* remove dead objects from weak tables */
1447 clearbykeys(g, g->ephemeron); /* clear keys from all ephemeron tables */
1448 clearbykeys(g, g->allweak); /* clear keys from all 'allweak' tables */
1449 /* clear values from resurrected weak tables */
1450 clearbyvalues(g, g->weak, origweak);
1451 clearbyvalues(g, g->allweak, origall);
1452 luaS_clearcache(g);
1453 g->currentwhite = cast_byte(otherwhite(g)); /* flip current white */
1454 lua_assert(g->gray == NULL);
1455 return work; /* estimate of slots marked by 'atomic' */
1456}
1457
1458
1459static int sweepstep (lua_State *L, global_State *g,
1460 int nextstate, GCObject **nextlist) {
1461 if (g->sweepgc) {
1462 l_mem olddebt = g->GCdebt;
1463 int count;
1464 g->sweepgc = sweeplist(L, g->sweepgc, GCSWEEPMAX, &count);
1465 g->GCestimate += g->GCdebt - olddebt; /* update estimate */
1466 return count;
1467 }
1468 else { /* enter next state */
1469 g->gcstate = nextstate;
1470 g->sweepgc = nextlist;
1471 return 0; /* no work done */
1472 }
1473}
1474
1475
1476static lu_mem singlestep (lua_State *L) {
1477 global_State *g = G(L);
1478 switch (g->gcstate) {
1479 case GCSpause: {
1480 restartcollection(g);
1481 g->gcstate = GCSpropagate;
1482 return 1;
1483 }
1484 case GCSpropagate: {
1485 if (g->gray == NULL) { /* no more gray objects? */
1486 g->gcstate = GCSenteratomic; /* finish propagate phase */
1487 return 0;
1488 }
1489 else
1490 return propagatemark(g); /* traverse one gray object */
1491 }
1492 case GCSenteratomic: {
1493 lu_mem work = atomic(L); /* work is what was traversed by 'atomic' */
1494 entersweep(L);
1495 g->GCestimate = gettotalbytes(g); /* first estimate */;
1496 return work;
1497 }
1498 case GCSswpallgc: { /* sweep "regular" objects */
1499 return sweepstep(L, g, GCSswpfinobj, &g->finobj);
1500 }
1501 case GCSswpfinobj: { /* sweep objects with finalizers */
1502 return sweepstep(L, g, GCSswptobefnz, &g->tobefnz);
1503 }
1504 case GCSswptobefnz: { /* sweep objects to be finalized */
1505 return sweepstep(L, g, GCSswpend, NULL);
1506 }
1507 case GCSswpend: { /* finish sweeps */
1508 checkSizes(L, g);
1509 g->gcstate = GCScallfin;
1510 return 0;
1511 }
1512 case GCScallfin: { /* call remaining finalizers */
1513 if (g->tobefnz && !g->gcemergency) {
1514 int n = runafewfinalizers(L, GCFINMAX);
1515 return n * GCFINALIZECOST;
1516 }
1517 else { /* emergency mode or no more finalizers */
1518 g->gcstate = GCSpause; /* finish collection */
1519 return 0;
1520 }
1521 }
1522 default: lua_assert(0); return 0;
1523 }
1524}
1525
1526
1527/*
1528** advances the garbage collector until it reaches a state allowed
1529** by 'statemask'
1530*/
1531void luaC_runtilstate (lua_State *L, int statesmask) {
1532 global_State *g = G(L);
1533 while (!testbit(statesmask, g->gcstate))
1534 singlestep(L);
1535}
1536
1537
1538/*
1539** Performs a basic incremental step. The debt and step size are
1540** converted from bytes to "units of work"; then the function loops
1541** running single steps until adding that many units of work or
1542** finishing a cycle (pause state). Finally, it sets the debt that
1543** controls when next step will be performed.
1544*/
1545static void incstep (lua_State *L, global_State *g) {
1546 int stepmul = (getgcparam(g->gcstepmul) | 1); /* avoid division by 0 */
1547 l_mem debt = (g->GCdebt / WORK2MEM) * stepmul;
1548 l_mem stepsize = (g->gcstepsize <= log2maxs(l_mem))
1549 ? ((cast(l_mem, 1) << g->gcstepsize) / WORK2MEM) * stepmul
1550 : MAX_LMEM; /* overflow; keep maximum value */
1551 do { /* repeat until pause or enough "credit" (negative debt) */
1552 lu_mem work = singlestep(L); /* perform one single step */
1553 debt -= work;
1554 } while (debt > -stepsize && g->gcstate != GCSpause);
1555 if (g->gcstate == GCSpause)
1556 setpause(g); /* pause until next cycle */
1557 else {
1558 debt = (debt / stepmul) * WORK2MEM; /* convert 'work units' to bytes */
1559 luaE_setdebt(g, debt);
1560 }
1561}
1562
1563/*
1564** performs a basic GC step if collector is running
1565*/
1566void luaC_step (lua_State *L) {
1567 global_State *g = G(L);
1568 lua_assert(!g->gcemergency);
1569 if (g->gcrunning) { /* running? */
1570 if(isdecGCmodegen(g))
1571 genstep(L, g);
1572 else
1573 incstep(L, g);
1574 }
1575}
1576
1577
1578/*
1579** Perform a full collection in incremental mode.
1580** Before running the collection, check 'keepinvariant'; if it is true,
1581** there may be some objects marked as black, so the collector has
1582** to sweep all objects to turn them back to white (as white has not
1583** changed, nothing will be collected).
1584*/
1585static void fullinc (lua_State *L, global_State *g) {
1586 if (keepinvariant(g)) /* black objects? */
1587 entersweep(L); /* sweep everything to turn them back to white */
1588 /* finish any pending sweep phase to start a new cycle */
1589 luaC_runtilstate(L, bitmask(GCSpause));
1590 luaC_runtilstate(L, bitmask(GCScallfin)); /* run up to finalizers */
1591 /* estimate must be correct after a full GC cycle */
1592 lua_assert(g->GCestimate == gettotalbytes(g));
1593 luaC_runtilstate(L, bitmask(GCSpause)); /* finish collection */
1594 setpause(g);
1595}
1596
1597
1598/*
1599** Performs a full GC cycle; if 'isemergency', set a flag to avoid
1600** some operations which could change the interpreter state in some
1601** unexpected ways (running finalizers and shrinking some structures).
1602*/
1603void luaC_fullgc (lua_State *L, int isemergency) {
1604 global_State *g = G(L);
1605 lua_assert(!g->gcemergency);
1606 g->gcemergency = isemergency; /* set flag */
1607 if (g->gckind == KGC_INC)
1608 fullinc(L, g);
1609 else
1610 fullgen(L, g);
1611 g->gcemergency = 0;
1612}
1613
1614/* }====================================================== */
1615
1616
diff --git a/src/lua/lgc.h b/src/lua/lgc.h
new file mode 100644
index 0000000..b972472
--- /dev/null
+++ b/src/lua/lgc.h
@@ -0,0 +1,186 @@
1/*
2** $Id: lgc.h $
3** Garbage Collector
4** See Copyright Notice in lua.h
5*/
6
7#ifndef lgc_h
8#define lgc_h
9
10
11#include "lobject.h"
12#include "lstate.h"
13
14/*
15** Collectable objects may have one of three colors: white, which
16** means the object is not marked; gray, which means the
17** object is marked, but its references may be not marked; and
18** black, which means that the object and all its references are marked.
19** The main invariant of the garbage collector, while marking objects,
20** is that a black object can never point to a white one. Moreover,
21** any gray object must be in a "gray list" (gray, grayagain, weak,
22** allweak, ephemeron) so that it can be visited again before finishing
23** the collection cycle. These lists have no meaning when the invariant
24** is not being enforced (e.g., sweep phase).
25*/
26
27
28/*
29** Possible states of the Garbage Collector
30*/
31#define GCSpropagate 0
32#define GCSenteratomic 1
33#define GCSatomic 2
34#define GCSswpallgc 3
35#define GCSswpfinobj 4
36#define GCSswptobefnz 5
37#define GCSswpend 6
38#define GCScallfin 7
39#define GCSpause 8
40
41
42#define issweepphase(g) \
43 (GCSswpallgc <= (g)->gcstate && (g)->gcstate <= GCSswpend)
44
45
46/*
47** macro to tell when main invariant (white objects cannot point to black
48** ones) must be kept. During a collection, the sweep
49** phase may break the invariant, as objects turned white may point to
50** still-black objects. The invariant is restored when sweep ends and
51** all objects are white again.
52*/
53
54#define keepinvariant(g) ((g)->gcstate <= GCSatomic)
55
56
57/*
58** some useful bit tricks
59*/
60#define resetbits(x,m) ((x) &= cast_byte(~(m)))
61#define setbits(x,m) ((x) |= (m))
62#define testbits(x,m) ((x) & (m))
63#define bitmask(b) (1<<(b))
64#define bit2mask(b1,b2) (bitmask(b1) | bitmask(b2))
65#define l_setbit(x,b) setbits(x, bitmask(b))
66#define resetbit(x,b) resetbits(x, bitmask(b))
67#define testbit(x,b) testbits(x, bitmask(b))
68
69
70/*
71** Layout for bit use in 'marked' field. First three bits are
72** used for object "age" in generational mode. Last bit is free
73** to be used by respective objects.
74*/
75#define WHITE0BIT 3 /* object is white (type 0) */
76#define WHITE1BIT 4 /* object is white (type 1) */
77#define BLACKBIT 5 /* object is black */
78#define FINALIZEDBIT 6 /* object has been marked for finalization */
79
80
81
82#define WHITEBITS bit2mask(WHITE0BIT, WHITE1BIT)
83
84
85#define iswhite(x) testbits((x)->marked, WHITEBITS)
86#define isblack(x) testbit((x)->marked, BLACKBIT)
87#define isgray(x) /* neither white nor black */ \
88 (!testbits((x)->marked, WHITEBITS | bitmask(BLACKBIT)))
89
90#define tofinalize(x) testbit((x)->marked, FINALIZEDBIT)
91
92#define otherwhite(g) ((g)->currentwhite ^ WHITEBITS)
93#define isdeadm(ow,m) ((m) & (ow))
94#define isdead(g,v) isdeadm(otherwhite(g), (v)->marked)
95
96#define changewhite(x) ((x)->marked ^= WHITEBITS)
97#define gray2black(x) l_setbit((x)->marked, BLACKBIT)
98
99#define luaC_white(g) cast_byte((g)->currentwhite & WHITEBITS)
100
101
102/* object age in generational mode */
103#define G_NEW 0 /* created in current cycle */
104#define G_SURVIVAL 1 /* created in previous cycle */
105#define G_OLD0 2 /* marked old by frw. barrier in this cycle */
106#define G_OLD1 3 /* first full cycle as old */
107#define G_OLD 4 /* really old object (not to be visited) */
108#define G_TOUCHED1 5 /* old object touched this cycle */
109#define G_TOUCHED2 6 /* old object touched in previous cycle */
110
111#define AGEBITS 7 /* all age bits (111) */
112
113#define getage(o) ((o)->marked & AGEBITS)
114#define setage(o,a) ((o)->marked = cast_byte(((o)->marked & (~AGEBITS)) | a))
115#define isold(o) (getage(o) > G_SURVIVAL)
116
117#define changeage(o,f,t) \
118 check_exp(getage(o) == (f), (o)->marked ^= ((f)^(t)))
119
120
121/* Default Values for GC parameters */
122#define LUAI_GENMAJORMUL 100
123#define LUAI_GENMINORMUL 20
124
125/* wait memory to double before starting new cycle */
126#define LUAI_GCPAUSE 200
127
128/*
129** some gc parameters are stored divided by 4 to allow a maximum value
130** up to 1023 in a 'lu_byte'.
131*/
132#define getgcparam(p) ((p) * 4)
133#define setgcparam(p,v) ((p) = (v) / 4)
134
135#define LUAI_GCMUL 100
136
137/* how much to allocate before next GC step (log2) */
138#define LUAI_GCSTEPSIZE 13 /* 8 KB */
139
140
141/*
142** Check whether the declared GC mode is generational. While in
143** generational mode, the collector can go temporarily to incremental
144** mode to improve performance. This is signaled by 'g->lastatomic != 0'.
145*/
146#define isdecGCmodegen(g) (g->gckind == KGC_GEN || g->lastatomic != 0)
147
148/*
149** Does one step of collection when debt becomes positive. 'pre'/'pos'
150** allows some adjustments to be done only when needed. macro
151** 'condchangemem' is used only for heavy tests (forcing a full
152** GC cycle on every opportunity)
153*/
154#define luaC_condGC(L,pre,pos) \
155 { if (G(L)->GCdebt > 0) { pre; luaC_step(L); pos;}; \
156 condchangemem(L,pre,pos); }
157
158/* more often than not, 'pre'/'pos' are empty */
159#define luaC_checkGC(L) luaC_condGC(L,(void)0,(void)0)
160
161
162#define luaC_barrier(L,p,v) ( \
163 (iscollectable(v) && isblack(p) && iswhite(gcvalue(v))) ? \
164 luaC_barrier_(L,obj2gco(p),gcvalue(v)) : cast_void(0))
165
166#define luaC_barrierback(L,p,v) ( \
167 (iscollectable(v) && isblack(p) && iswhite(gcvalue(v))) ? \
168 luaC_barrierback_(L,p) : cast_void(0))
169
170#define luaC_objbarrier(L,p,o) ( \
171 (isblack(p) && iswhite(o)) ? \
172 luaC_barrier_(L,obj2gco(p),obj2gco(o)) : cast_void(0))
173
174LUAI_FUNC void luaC_fix (lua_State *L, GCObject *o);
175LUAI_FUNC void luaC_freeallobjects (lua_State *L);
176LUAI_FUNC void luaC_step (lua_State *L);
177LUAI_FUNC void luaC_runtilstate (lua_State *L, int statesmask);
178LUAI_FUNC void luaC_fullgc (lua_State *L, int isemergency);
179LUAI_FUNC GCObject *luaC_newobj (lua_State *L, int tt, size_t sz);
180LUAI_FUNC void luaC_barrier_ (lua_State *L, GCObject *o, GCObject *v);
181LUAI_FUNC void luaC_barrierback_ (lua_State *L, GCObject *o);
182LUAI_FUNC void luaC_checkfinalizer (lua_State *L, GCObject *o, Table *mt);
183LUAI_FUNC void luaC_changemode (lua_State *L, int newmode);
184
185
186#endif
diff --git a/src/lua/linit.c b/src/lua/linit.c
new file mode 100644
index 0000000..69808f8
--- /dev/null
+++ b/src/lua/linit.c
@@ -0,0 +1,65 @@
1/*
2** $Id: linit.c $
3** Initialization of libraries for lua.c and other clients
4** See Copyright Notice in lua.h
5*/
6
7
8#define linit_c
9#define LUA_LIB
10
11/*
12** If you embed Lua in your program and need to open the standard
13** libraries, call luaL_openlibs in your program. If you need a
14** different set of libraries, copy this file to your project and edit
15** it to suit your needs.
16**
17** You can also *preload* libraries, so that a later 'require' can
18** open the library, which is already linked to the application.
19** For that, do the following code:
20**
21** luaL_getsubtable(L, LUA_REGISTRYINDEX, LUA_PRELOAD_TABLE);
22** lua_pushcfunction(L, luaopen_modname);
23** lua_setfield(L, -2, modname);
24** lua_pop(L, 1); // remove PRELOAD table
25*/
26
27#include "lprefix.h"
28
29
30#include <stddef.h>
31
32#include "lua.h"
33
34#include "lualib.h"
35#include "lauxlib.h"
36
37
38/*
39** these libs are loaded by lua.c and are readily available to any Lua
40** program
41*/
42static const luaL_Reg loadedlibs[] = {
43 {LUA_GNAME, luaopen_base},
44 {LUA_LOADLIBNAME, luaopen_package},
45 {LUA_COLIBNAME, luaopen_coroutine},
46 {LUA_TABLIBNAME, luaopen_table},
47 {LUA_IOLIBNAME, luaopen_io},
48 {LUA_OSLIBNAME, luaopen_os},
49 {LUA_STRLIBNAME, luaopen_string},
50 {LUA_MATHLIBNAME, luaopen_math},
51 {LUA_UTF8LIBNAME, luaopen_utf8},
52 {LUA_DBLIBNAME, luaopen_debug},
53 {NULL, NULL}
54};
55
56
57LUALIB_API void luaL_openlibs (lua_State *L) {
58 const luaL_Reg *lib;
59 /* "require" functions from 'loadedlibs' and set results to global table */
60 for (lib = loadedlibs; lib->func; lib++) {
61 luaL_requiref(L, lib->name, lib->func, 1);
62 lua_pop(L, 1); /* remove lib */
63 }
64}
65
diff --git a/src/lua/liolib.c b/src/lua/liolib.c
new file mode 100644
index 0000000..7ac3444
--- /dev/null
+++ b/src/lua/liolib.c
@@ -0,0 +1,814 @@
1/*
2** $Id: liolib.c $
3** Standard I/O (and system) library
4** See Copyright Notice in lua.h
5*/
6
7#define liolib_c
8#define LUA_LIB
9
10#include "lprefix.h"
11
12
13#include <ctype.h>
14#include <errno.h>
15#include <locale.h>
16#include <stdio.h>
17#include <stdlib.h>
18#include <string.h>
19
20#include "lua.h"
21
22#include "lauxlib.h"
23#include "lualib.h"
24
25
26
27
28/*
29** Change this macro to accept other modes for 'fopen' besides
30** the standard ones.
31*/
32#if !defined(l_checkmode)
33
34/* accepted extensions to 'mode' in 'fopen' */
35#if !defined(L_MODEEXT)
36#define L_MODEEXT "b"
37#endif
38
39/* Check whether 'mode' matches '[rwa]%+?[L_MODEEXT]*' */
40static int l_checkmode (const char *mode) {
41 return (*mode != '\0' && strchr("rwa", *(mode++)) != NULL &&
42 (*mode != '+' || ((void)(++mode), 1)) && /* skip if char is '+' */
43 (strspn(mode, L_MODEEXT) == strlen(mode))); /* check extensions */
44}
45
46#endif
47
48/*
49** {======================================================
50** l_popen spawns a new process connected to the current
51** one through the file streams.
52** =======================================================
53*/
54
55#if !defined(l_popen) /* { */
56
57#if defined(LUA_USE_POSIX) /* { */
58
59#define l_popen(L,c,m) (fflush(NULL), popen(c,m))
60#define l_pclose(L,file) (pclose(file))
61
62#elif defined(LUA_USE_WINDOWS) /* }{ */
63
64#define l_popen(L,c,m) (_popen(c,m))
65#define l_pclose(L,file) (_pclose(file))
66
67#else /* }{ */
68
69/* ISO C definitions */
70#define l_popen(L,c,m) \
71 ((void)c, (void)m, \
72 luaL_error(L, "'popen' not supported"), \
73 (FILE*)0)
74#define l_pclose(L,file) ((void)L, (void)file, -1)
75
76#endif /* } */
77
78#endif /* } */
79
80/* }====================================================== */
81
82
83#if !defined(l_getc) /* { */
84
85#if defined(LUA_USE_POSIX)
86#define l_getc(f) getc_unlocked(f)
87#define l_lockfile(f) flockfile(f)
88#define l_unlockfile(f) funlockfile(f)
89#else
90#define l_getc(f) getc(f)
91#define l_lockfile(f) ((void)0)
92#define l_unlockfile(f) ((void)0)
93#endif
94
95#endif /* } */
96
97
98/*
99** {======================================================
100** l_fseek: configuration for longer offsets
101** =======================================================
102*/
103
104#if !defined(l_fseek) /* { */
105
106#if defined(LUA_USE_POSIX) /* { */
107
108#include <sys/types.h>
109
110#define l_fseek(f,o,w) fseeko(f,o,w)
111#define l_ftell(f) ftello(f)
112#define l_seeknum off_t
113
114#elif defined(LUA_USE_WINDOWS) && !defined(_CRTIMP_TYPEINFO) \
115 && defined(_MSC_VER) && (_MSC_VER >= 1400) /* }{ */
116
117/* Windows (but not DDK) and Visual C++ 2005 or higher */
118#define l_fseek(f,o,w) _fseeki64(f,o,w)
119#define l_ftell(f) _ftelli64(f)
120#define l_seeknum __int64
121
122#else /* }{ */
123
124/* ISO C definitions */
125#define l_fseek(f,o,w) fseek(f,o,w)
126#define l_ftell(f) ftell(f)
127#define l_seeknum long
128
129#endif /* } */
130
131#endif /* } */
132
133/* }====================================================== */
134
135
136
137#define IO_PREFIX "_IO_"
138#define IOPREF_LEN (sizeof(IO_PREFIX)/sizeof(char) - 1)
139#define IO_INPUT (IO_PREFIX "input")
140#define IO_OUTPUT (IO_PREFIX "output")
141
142
143typedef luaL_Stream LStream;
144
145
146#define tolstream(L) ((LStream *)luaL_checkudata(L, 1, LUA_FILEHANDLE))
147
148#define isclosed(p) ((p)->closef == NULL)
149
150
151static int io_type (lua_State *L) {
152 LStream *p;
153 luaL_checkany(L, 1);
154 p = (LStream *)luaL_testudata(L, 1, LUA_FILEHANDLE);
155 if (p == NULL)
156 luaL_pushfail(L); /* not a file */
157 else if (isclosed(p))
158 lua_pushliteral(L, "closed file");
159 else
160 lua_pushliteral(L, "file");
161 return 1;
162}
163
164
165static int f_tostring (lua_State *L) {
166 LStream *p = tolstream(L);
167 if (isclosed(p))
168 lua_pushliteral(L, "file (closed)");
169 else
170 lua_pushfstring(L, "file (%p)", p->f);
171 return 1;
172}
173
174
175static FILE *tofile (lua_State *L) {
176 LStream *p = tolstream(L);
177 if (isclosed(p))
178 luaL_error(L, "attempt to use a closed file");
179 lua_assert(p->f);
180 return p->f;
181}
182
183
184/*
185** When creating file handles, always creates a 'closed' file handle
186** before opening the actual file; so, if there is a memory error, the
187** handle is in a consistent state.
188*/
189static LStream *newprefile (lua_State *L) {
190 LStream *p = (LStream *)lua_newuserdatauv(L, sizeof(LStream), 0);
191 p->closef = NULL; /* mark file handle as 'closed' */
192 luaL_setmetatable(L, LUA_FILEHANDLE);
193 return p;
194}
195
196
197/*
198** Calls the 'close' function from a file handle. The 'volatile' avoids
199** a bug in some versions of the Clang compiler (e.g., clang 3.0 for
200** 32 bits).
201*/
202static int aux_close (lua_State *L) {
203 LStream *p = tolstream(L);
204 volatile lua_CFunction cf = p->closef;
205 p->closef = NULL; /* mark stream as closed */
206 return (*cf)(L); /* close it */
207}
208
209
210static int f_close (lua_State *L) {
211 tofile(L); /* make sure argument is an open stream */
212 return aux_close(L);
213}
214
215
216static int io_close (lua_State *L) {
217 if (lua_isnone(L, 1)) /* no argument? */
218 lua_getfield(L, LUA_REGISTRYINDEX, IO_OUTPUT); /* use default output */
219 return f_close(L);
220}
221
222
223static int f_gc (lua_State *L) {
224 LStream *p = tolstream(L);
225 if (!isclosed(p) && p->f != NULL)
226 aux_close(L); /* ignore closed and incompletely open files */
227 return 0;
228}
229
230
231/*
232** function to close regular files
233*/
234static int io_fclose (lua_State *L) {
235 LStream *p = tolstream(L);
236 int res = fclose(p->f);
237 return luaL_fileresult(L, (res == 0), NULL);
238}
239
240
241static LStream *newfile (lua_State *L) {
242 LStream *p = newprefile(L);
243 p->f = NULL;
244 p->closef = &io_fclose;
245 return p;
246}
247
248
249static void opencheck (lua_State *L, const char *fname, const char *mode) {
250 LStream *p = newfile(L);
251 p->f = fopen(fname, mode);
252 if (p->f == NULL)
253 luaL_error(L, "cannot open file '%s' (%s)", fname, strerror(errno));
254}
255
256
257static int io_open (lua_State *L) {
258 const char *filename = luaL_checkstring(L, 1);
259 const char *mode = luaL_optstring(L, 2, "r");
260 LStream *p = newfile(L);
261 const char *md = mode; /* to traverse/check mode */
262 luaL_argcheck(L, l_checkmode(md), 2, "invalid mode");
263 p->f = fopen(filename, mode);
264 return (p->f == NULL) ? luaL_fileresult(L, 0, filename) : 1;
265}
266
267
268/*
269** function to close 'popen' files
270*/
271static int io_pclose (lua_State *L) {
272 LStream *p = tolstream(L);
273 errno = 0;
274 return luaL_execresult(L, l_pclose(L, p->f));
275}
276
277
278static int io_popen (lua_State *L) {
279 const char *filename = luaL_checkstring(L, 1);
280 const char *mode = luaL_optstring(L, 2, "r");
281 LStream *p = newprefile(L);
282 p->f = l_popen(L, filename, mode);
283 p->closef = &io_pclose;
284 return (p->f == NULL) ? luaL_fileresult(L, 0, filename) : 1;
285}
286
287
288static int io_tmpfile (lua_State *L) {
289 LStream *p = newfile(L);
290 p->f = tmpfile();
291 return (p->f == NULL) ? luaL_fileresult(L, 0, NULL) : 1;
292}
293
294
295static FILE *getiofile (lua_State *L, const char *findex) {
296 LStream *p;
297 lua_getfield(L, LUA_REGISTRYINDEX, findex);
298 p = (LStream *)lua_touserdata(L, -1);
299 if (isclosed(p))
300 luaL_error(L, "default %s file is closed", findex + IOPREF_LEN);
301 return p->f;
302}
303
304
305static int g_iofile (lua_State *L, const char *f, const char *mode) {
306 if (!lua_isnoneornil(L, 1)) {
307 const char *filename = lua_tostring(L, 1);
308 if (filename)
309 opencheck(L, filename, mode);
310 else {
311 tofile(L); /* check that it's a valid file handle */
312 lua_pushvalue(L, 1);
313 }
314 lua_setfield(L, LUA_REGISTRYINDEX, f);
315 }
316 /* return current value */
317 lua_getfield(L, LUA_REGISTRYINDEX, f);
318 return 1;
319}
320
321
322static int io_input (lua_State *L) {
323 return g_iofile(L, IO_INPUT, "r");
324}
325
326
327static int io_output (lua_State *L) {
328 return g_iofile(L, IO_OUTPUT, "w");
329}
330
331
332static int io_readline (lua_State *L);
333
334
335/*
336** maximum number of arguments to 'f:lines'/'io.lines' (it + 3 must fit
337** in the limit for upvalues of a closure)
338*/
339#define MAXARGLINE 250
340
341/*
342** Auxiliary function to create the iteration function for 'lines'.
343** The iteration function is a closure over 'io_readline', with
344** the following upvalues:
345** 1) The file being read (first value in the stack)
346** 2) the number of arguments to read
347** 3) a boolean, true iff file has to be closed when finished ('toclose')
348** *) a variable number of format arguments (rest of the stack)
349*/
350static void aux_lines (lua_State *L, int toclose) {
351 int n = lua_gettop(L) - 1; /* number of arguments to read */
352 luaL_argcheck(L, n <= MAXARGLINE, MAXARGLINE + 2, "too many arguments");
353 lua_pushvalue(L, 1); /* file */
354 lua_pushinteger(L, n); /* number of arguments to read */
355 lua_pushboolean(L, toclose); /* close/not close file when finished */
356 lua_rotate(L, 2, 3); /* move the three values to their positions */
357 lua_pushcclosure(L, io_readline, 3 + n);
358}
359
360
361static int f_lines (lua_State *L) {
362 tofile(L); /* check that it's a valid file handle */
363 aux_lines(L, 0);
364 return 1;
365}
366
367
368/*
369** Return an iteration function for 'io.lines'. If file has to be
370** closed, also returns the file itself as a second result (to be
371** closed as the state at the exit of a generic for).
372*/
373static int io_lines (lua_State *L) {
374 int toclose;
375 if (lua_isnone(L, 1)) lua_pushnil(L); /* at least one argument */
376 if (lua_isnil(L, 1)) { /* no file name? */
377 lua_getfield(L, LUA_REGISTRYINDEX, IO_INPUT); /* get default input */
378 lua_replace(L, 1); /* put it at index 1 */
379 tofile(L); /* check that it's a valid file handle */
380 toclose = 0; /* do not close it after iteration */
381 }
382 else { /* open a new file */
383 const char *filename = luaL_checkstring(L, 1);
384 opencheck(L, filename, "r");
385 lua_replace(L, 1); /* put file at index 1 */
386 toclose = 1; /* close it after iteration */
387 }
388 aux_lines(L, toclose); /* push iteration function */
389 if (toclose) {
390 lua_pushnil(L); /* state */
391 lua_pushnil(L); /* control */
392 lua_pushvalue(L, 1); /* file is the to-be-closed variable (4th result) */
393 return 4;
394 }
395 else
396 return 1;
397}
398
399
400/*
401** {======================================================
402** READ
403** =======================================================
404*/
405
406
407/* maximum length of a numeral */
408#if !defined (L_MAXLENNUM)
409#define L_MAXLENNUM 200
410#endif
411
412
413/* auxiliary structure used by 'read_number' */
414typedef struct {
415 FILE *f; /* file being read */
416 int c; /* current character (look ahead) */
417 int n; /* number of elements in buffer 'buff' */
418 char buff[L_MAXLENNUM + 1]; /* +1 for ending '\0' */
419} RN;
420
421
422/*
423** Add current char to buffer (if not out of space) and read next one
424*/
425static int nextc (RN *rn) {
426 if (rn->n >= L_MAXLENNUM) { /* buffer overflow? */
427 rn->buff[0] = '\0'; /* invalidate result */
428 return 0; /* fail */
429 }
430 else {
431 rn->buff[rn->n++] = rn->c; /* save current char */
432 rn->c = l_getc(rn->f); /* read next one */
433 return 1;
434 }
435}
436
437
438/*
439** Accept current char if it is in 'set' (of size 2)
440*/
441static int test2 (RN *rn, const char *set) {
442 if (rn->c == set[0] || rn->c == set[1])
443 return nextc(rn);
444 else return 0;
445}
446
447
448/*
449** Read a sequence of (hex)digits
450*/
451static int readdigits (RN *rn, int hex) {
452 int count = 0;
453 while ((hex ? isxdigit(rn->c) : isdigit(rn->c)) && nextc(rn))
454 count++;
455 return count;
456}
457
458
459/*
460** Read a number: first reads a valid prefix of a numeral into a buffer.
461** Then it calls 'lua_stringtonumber' to check whether the format is
462** correct and to convert it to a Lua number.
463*/
464static int read_number (lua_State *L, FILE *f) {
465 RN rn;
466 int count = 0;
467 int hex = 0;
468 char decp[2];
469 rn.f = f; rn.n = 0;
470 decp[0] = lua_getlocaledecpoint(); /* get decimal point from locale */
471 decp[1] = '.'; /* always accept a dot */
472 l_lockfile(rn.f);
473 do { rn.c = l_getc(rn.f); } while (isspace(rn.c)); /* skip spaces */
474 test2(&rn, "-+"); /* optional sign */
475 if (test2(&rn, "00")) {
476 if (test2(&rn, "xX")) hex = 1; /* numeral is hexadecimal */
477 else count = 1; /* count initial '0' as a valid digit */
478 }
479 count += readdigits(&rn, hex); /* integral part */
480 if (test2(&rn, decp)) /* decimal point? */
481 count += readdigits(&rn, hex); /* fractional part */
482 if (count > 0 && test2(&rn, (hex ? "pP" : "eE"))) { /* exponent mark? */
483 test2(&rn, "-+"); /* exponent sign */
484 readdigits(&rn, 0); /* exponent digits */
485 }
486 ungetc(rn.c, rn.f); /* unread look-ahead char */
487 l_unlockfile(rn.f);
488 rn.buff[rn.n] = '\0'; /* finish string */
489 if (lua_stringtonumber(L, rn.buff)) /* is this a valid number? */
490 return 1; /* ok */
491 else { /* invalid format */
492 lua_pushnil(L); /* "result" to be removed */
493 return 0; /* read fails */
494 }
495}
496
497
498static int test_eof (lua_State *L, FILE *f) {
499 int c = getc(f);
500 ungetc(c, f); /* no-op when c == EOF */
501 lua_pushliteral(L, "");
502 return (c != EOF);
503}
504
505
506static int read_line (lua_State *L, FILE *f, int chop) {
507 luaL_Buffer b;
508 int c;
509 luaL_buffinit(L, &b);
510 do { /* may need to read several chunks to get whole line */
511 char *buff = luaL_prepbuffer(&b); /* preallocate buffer space */
512 int i = 0;
513 l_lockfile(f); /* no memory errors can happen inside the lock */
514 while (i < LUAL_BUFFERSIZE && (c = l_getc(f)) != EOF && c != '\n')
515 buff[i++] = c; /* read up to end of line or buffer limit */
516 l_unlockfile(f);
517 luaL_addsize(&b, i);
518 } while (c != EOF && c != '\n'); /* repeat until end of line */
519 if (!chop && c == '\n') /* want a newline and have one? */
520 luaL_addchar(&b, c); /* add ending newline to result */
521 luaL_pushresult(&b); /* close buffer */
522 /* return ok if read something (either a newline or something else) */
523 return (c == '\n' || lua_rawlen(L, -1) > 0);
524}
525
526
527static void read_all (lua_State *L, FILE *f) {
528 size_t nr;
529 luaL_Buffer b;
530 luaL_buffinit(L, &b);
531 do { /* read file in chunks of LUAL_BUFFERSIZE bytes */
532 char *p = luaL_prepbuffer(&b);
533 nr = fread(p, sizeof(char), LUAL_BUFFERSIZE, f);
534 luaL_addsize(&b, nr);
535 } while (nr == LUAL_BUFFERSIZE);
536 luaL_pushresult(&b); /* close buffer */
537}
538
539
540static int read_chars (lua_State *L, FILE *f, size_t n) {
541 size_t nr; /* number of chars actually read */
542 char *p;
543 luaL_Buffer b;
544 luaL_buffinit(L, &b);
545 p = luaL_prepbuffsize(&b, n); /* prepare buffer to read whole block */
546 nr = fread(p, sizeof(char), n, f); /* try to read 'n' chars */
547 luaL_addsize(&b, nr);
548 luaL_pushresult(&b); /* close buffer */
549 return (nr > 0); /* true iff read something */
550}
551
552
553static int g_read (lua_State *L, FILE *f, int first) {
554 int nargs = lua_gettop(L) - 1;
555 int n, success;
556 clearerr(f);
557 if (nargs == 0) { /* no arguments? */
558 success = read_line(L, f, 1);
559 n = first + 1; /* to return 1 result */
560 }
561 else {
562 /* ensure stack space for all results and for auxlib's buffer */
563 luaL_checkstack(L, nargs+LUA_MINSTACK, "too many arguments");
564 success = 1;
565 for (n = first; nargs-- && success; n++) {
566 if (lua_type(L, n) == LUA_TNUMBER) {
567 size_t l = (size_t)luaL_checkinteger(L, n);
568 success = (l == 0) ? test_eof(L, f) : read_chars(L, f, l);
569 }
570 else {
571 const char *p = luaL_checkstring(L, n);
572 if (*p == '*') p++; /* skip optional '*' (for compatibility) */
573 switch (*p) {
574 case 'n': /* number */
575 success = read_number(L, f);
576 break;
577 case 'l': /* line */
578 success = read_line(L, f, 1);
579 break;
580 case 'L': /* line with end-of-line */
581 success = read_line(L, f, 0);
582 break;
583 case 'a': /* file */
584 read_all(L, f); /* read entire file */
585 success = 1; /* always success */
586 break;
587 default:
588 return luaL_argerror(L, n, "invalid format");
589 }
590 }
591 }
592 }
593 if (ferror(f))
594 return luaL_fileresult(L, 0, NULL);
595 if (!success) {
596 lua_pop(L, 1); /* remove last result */
597 luaL_pushfail(L); /* push nil instead */
598 }
599 return n - first;
600}
601
602
603static int io_read (lua_State *L) {
604 return g_read(L, getiofile(L, IO_INPUT), 1);
605}
606
607
608static int f_read (lua_State *L) {
609 return g_read(L, tofile(L), 2);
610}
611
612
613/*
614** Iteration function for 'lines'.
615*/
616static int io_readline (lua_State *L) {
617 LStream *p = (LStream *)lua_touserdata(L, lua_upvalueindex(1));
618 int i;
619 int n = (int)lua_tointeger(L, lua_upvalueindex(2));
620 if (isclosed(p)) /* file is already closed? */
621 return luaL_error(L, "file is already closed");
622 lua_settop(L , 1);
623 luaL_checkstack(L, n, "too many arguments");
624 for (i = 1; i <= n; i++) /* push arguments to 'g_read' */
625 lua_pushvalue(L, lua_upvalueindex(3 + i));
626 n = g_read(L, p->f, 2); /* 'n' is number of results */
627 lua_assert(n > 0); /* should return at least a nil */
628 if (lua_toboolean(L, -n)) /* read at least one value? */
629 return n; /* return them */
630 else { /* first result is false: EOF or error */
631 if (n > 1) { /* is there error information? */
632 /* 2nd result is error message */
633 return luaL_error(L, "%s", lua_tostring(L, -n + 1));
634 }
635 if (lua_toboolean(L, lua_upvalueindex(3))) { /* generator created file? */
636 lua_settop(L, 0); /* clear stack */
637 lua_pushvalue(L, lua_upvalueindex(1)); /* push file at index 1 */
638 aux_close(L); /* close it */
639 }
640 return 0;
641 }
642}
643
644/* }====================================================== */
645
646
647static int g_write (lua_State *L, FILE *f, int arg) {
648 int nargs = lua_gettop(L) - arg;
649 int status = 1;
650 for (; nargs--; arg++) {
651 if (lua_type(L, arg) == LUA_TNUMBER) {
652 /* optimization: could be done exactly as for strings */
653 int len = lua_isinteger(L, arg)
654 ? fprintf(f, LUA_INTEGER_FMT,
655 (LUAI_UACINT)lua_tointeger(L, arg))
656 : fprintf(f, LUA_NUMBER_FMT,
657 (LUAI_UACNUMBER)lua_tonumber(L, arg));
658 status = status && (len > 0);
659 }
660 else {
661 size_t l;
662 const char *s = luaL_checklstring(L, arg, &l);
663 status = status && (fwrite(s, sizeof(char), l, f) == l);
664 }
665 }
666 if (status) return 1; /* file handle already on stack top */
667 else return luaL_fileresult(L, status, NULL);
668}
669
670
671static int io_write (lua_State *L) {
672 return g_write(L, getiofile(L, IO_OUTPUT), 1);
673}
674
675
676static int f_write (lua_State *L) {
677 FILE *f = tofile(L);
678 lua_pushvalue(L, 1); /* push file at the stack top (to be returned) */
679 return g_write(L, f, 2);
680}
681
682
683static int f_seek (lua_State *L) {
684 static const int mode[] = {SEEK_SET, SEEK_CUR, SEEK_END};
685 static const char *const modenames[] = {"set", "cur", "end", NULL};
686 FILE *f = tofile(L);
687 int op = luaL_checkoption(L, 2, "cur", modenames);
688 lua_Integer p3 = luaL_optinteger(L, 3, 0);
689 l_seeknum offset = (l_seeknum)p3;
690 luaL_argcheck(L, (lua_Integer)offset == p3, 3,
691 "not an integer in proper range");
692 op = l_fseek(f, offset, mode[op]);
693 if (op)
694 return luaL_fileresult(L, 0, NULL); /* error */
695 else {
696 lua_pushinteger(L, (lua_Integer)l_ftell(f));
697 return 1;
698 }
699}
700
701
702static int f_setvbuf (lua_State *L) {
703 static const int mode[] = {_IONBF, _IOFBF, _IOLBF};
704 static const char *const modenames[] = {"no", "full", "line", NULL};
705 FILE *f = tofile(L);
706 int op = luaL_checkoption(L, 2, NULL, modenames);
707 lua_Integer sz = luaL_optinteger(L, 3, LUAL_BUFFERSIZE);
708 int res = setvbuf(f, NULL, mode[op], (size_t)sz);
709 return luaL_fileresult(L, res == 0, NULL);
710}
711
712
713
714static int io_flush (lua_State *L) {
715 return luaL_fileresult(L, fflush(getiofile(L, IO_OUTPUT)) == 0, NULL);
716}
717
718
719static int f_flush (lua_State *L) {
720 return luaL_fileresult(L, fflush(tofile(L)) == 0, NULL);
721}
722
723
724/*
725** functions for 'io' library
726*/
727static const luaL_Reg iolib[] = {
728 {"close", io_close},
729 {"flush", io_flush},
730 {"input", io_input},
731 {"lines", io_lines},
732 {"open", io_open},
733 {"output", io_output},
734 {"popen", io_popen},
735 {"read", io_read},
736 {"tmpfile", io_tmpfile},
737 {"type", io_type},
738 {"write", io_write},
739 {NULL, NULL}
740};
741
742
743/*
744** methods for file handles
745*/
746static const luaL_Reg meth[] = {
747 {"read", f_read},
748 {"write", f_write},
749 {"lines", f_lines},
750 {"flush", f_flush},
751 {"seek", f_seek},
752 {"close", f_close},
753 {"setvbuf", f_setvbuf},
754 {NULL, NULL}
755};
756
757
758/*
759** metamethods for file handles
760*/
761static const luaL_Reg metameth[] = {
762 {"__index", NULL}, /* place holder */
763 {"__gc", f_gc},
764 {"__close", f_gc},
765 {"__tostring", f_tostring},
766 {NULL, NULL}
767};
768
769
770static void createmeta (lua_State *L) {
771 luaL_newmetatable(L, LUA_FILEHANDLE); /* metatable for file handles */
772 luaL_setfuncs(L, metameth, 0); /* add metamethods to new metatable */
773 luaL_newlibtable(L, meth); /* create method table */
774 luaL_setfuncs(L, meth, 0); /* add file methods to method table */
775 lua_setfield(L, -2, "__index"); /* metatable.__index = method table */
776 lua_pop(L, 1); /* pop metatable */
777}
778
779
780/*
781** function to (not) close the standard files stdin, stdout, and stderr
782*/
783static int io_noclose (lua_State *L) {
784 LStream *p = tolstream(L);
785 p->closef = &io_noclose; /* keep file opened */
786 luaL_pushfail(L);
787 lua_pushliteral(L, "cannot close standard file");
788 return 2;
789}
790
791
792static void createstdfile (lua_State *L, FILE *f, const char *k,
793 const char *fname) {
794 LStream *p = newprefile(L);
795 p->f = f;
796 p->closef = &io_noclose;
797 if (k != NULL) {
798 lua_pushvalue(L, -1);
799 lua_setfield(L, LUA_REGISTRYINDEX, k); /* add file to registry */
800 }
801 lua_setfield(L, -2, fname); /* add file to module */
802}
803
804
805LUAMOD_API int luaopen_io (lua_State *L) {
806 luaL_newlib(L, iolib); /* new module */
807 createmeta(L);
808 /* create (and set) default files */
809 createstdfile(L, stdin, IO_INPUT, "stdin");
810 createstdfile(L, stdout, IO_OUTPUT, "stdout");
811 createstdfile(L, stderr, NULL, "stderr");
812 return 1;
813}
814
diff --git a/src/lua/ljumptab.h b/src/lua/ljumptab.h
new file mode 100644
index 0000000..8306f25
--- /dev/null
+++ b/src/lua/ljumptab.h
@@ -0,0 +1,112 @@
1/*
2** $Id: ljumptab.h $
3** Jump Table for the Lua interpreter
4** See Copyright Notice in lua.h
5*/
6
7
8#undef vmdispatch
9#undef vmcase
10#undef vmbreak
11
12#define vmdispatch(x) goto *disptab[x];
13
14#define vmcase(l) L_##l:
15
16#define vmbreak vmfetch(); vmdispatch(GET_OPCODE(i));
17
18
19static const void *const disptab[NUM_OPCODES] = {
20
21#if 0
22** you can update the following list with this command:
23**
24** sed -n '/^OP_/\!d; s/OP_/\&\&L_OP_/ ; s/,.*/,/ ; s/\/.*// ; p' lopcodes.h
25**
26#endif
27
28&&L_OP_MOVE,
29&&L_OP_LOADI,
30&&L_OP_LOADF,
31&&L_OP_LOADK,
32&&L_OP_LOADKX,
33&&L_OP_LOADFALSE,
34&&L_OP_LFALSESKIP,
35&&L_OP_LOADTRUE,
36&&L_OP_LOADNIL,
37&&L_OP_GETUPVAL,
38&&L_OP_SETUPVAL,
39&&L_OP_GETTABUP,
40&&L_OP_GETTABLE,
41&&L_OP_GETI,
42&&L_OP_GETFIELD,
43&&L_OP_SETTABUP,
44&&L_OP_SETTABLE,
45&&L_OP_SETI,
46&&L_OP_SETFIELD,
47&&L_OP_NEWTABLE,
48&&L_OP_SELF,
49&&L_OP_ADDI,
50&&L_OP_ADDK,
51&&L_OP_SUBK,
52&&L_OP_MULK,
53&&L_OP_MODK,
54&&L_OP_POWK,
55&&L_OP_DIVK,
56&&L_OP_IDIVK,
57&&L_OP_BANDK,
58&&L_OP_BORK,
59&&L_OP_BXORK,
60&&L_OP_SHRI,
61&&L_OP_SHLI,
62&&L_OP_ADD,
63&&L_OP_SUB,
64&&L_OP_MUL,
65&&L_OP_MOD,
66&&L_OP_POW,
67&&L_OP_DIV,
68&&L_OP_IDIV,
69&&L_OP_BAND,
70&&L_OP_BOR,
71&&L_OP_BXOR,
72&&L_OP_SHL,
73&&L_OP_SHR,
74&&L_OP_MMBIN,
75&&L_OP_MMBINI,
76&&L_OP_MMBINK,
77&&L_OP_UNM,
78&&L_OP_BNOT,
79&&L_OP_NOT,
80&&L_OP_LEN,
81&&L_OP_CONCAT,
82&&L_OP_CLOSE,
83&&L_OP_TBC,
84&&L_OP_JMP,
85&&L_OP_EQ,
86&&L_OP_LT,
87&&L_OP_LE,
88&&L_OP_EQK,
89&&L_OP_EQI,
90&&L_OP_LTI,
91&&L_OP_LEI,
92&&L_OP_GTI,
93&&L_OP_GEI,
94&&L_OP_TEST,
95&&L_OP_TESTSET,
96&&L_OP_CALL,
97&&L_OP_TAILCALL,
98&&L_OP_RETURN,
99&&L_OP_RETURN0,
100&&L_OP_RETURN1,
101&&L_OP_FORLOOP,
102&&L_OP_FORPREP,
103&&L_OP_TFORPREP,
104&&L_OP_TFORCALL,
105&&L_OP_TFORLOOP,
106&&L_OP_SETLIST,
107&&L_OP_CLOSURE,
108&&L_OP_VARARG,
109&&L_OP_VARARGPREP,
110&&L_OP_EXTRAARG
111
112};
diff --git a/src/lua/llex.c b/src/lua/llex.c
new file mode 100644
index 0000000..90a7951
--- /dev/null
+++ b/src/lua/llex.c
@@ -0,0 +1,578 @@
1/*
2** $Id: llex.c $
3** Lexical Analyzer
4** See Copyright Notice in lua.h
5*/
6
7#define llex_c
8#define LUA_CORE
9
10#include "lprefix.h"
11
12
13#include <locale.h>
14#include <string.h>
15
16#include "lua.h"
17
18#include "lctype.h"
19#include "ldebug.h"
20#include "ldo.h"
21#include "lgc.h"
22#include "llex.h"
23#include "lobject.h"
24#include "lparser.h"
25#include "lstate.h"
26#include "lstring.h"
27#include "ltable.h"
28#include "lzio.h"
29
30
31
32#define next(ls) (ls->current = zgetc(ls->z))
33
34
35
36#define currIsNewline(ls) (ls->current == '\n' || ls->current == '\r')
37
38
39/* ORDER RESERVED */
40static const char *const luaX_tokens [] = {
41 "and", "break", "do", "else", "elseif",
42 "end", "false", "for", "function", "goto", "if",
43 "in", "local", "nil", "not", "or", "repeat",
44 "return", "then", "true", "until", "while",
45 "//", "..", "...", "==", ">=", "<=", "~=",
46 "<<", ">>", "::", "<eof>",
47 "<number>", "<integer>", "<name>", "<string>"
48};
49
50
51#define save_and_next(ls) (save(ls, ls->current), next(ls))
52
53
54static l_noret lexerror (LexState *ls, const char *msg, int token);
55
56
57static void save (LexState *ls, int c) {
58 Mbuffer *b = ls->buff;
59 if (luaZ_bufflen(b) + 1 > luaZ_sizebuffer(b)) {
60 size_t newsize;
61 if (luaZ_sizebuffer(b) >= MAX_SIZE/2)
62 lexerror(ls, "lexical element too long", 0);
63 newsize = luaZ_sizebuffer(b) * 2;
64 luaZ_resizebuffer(ls->L, b, newsize);
65 }
66 b->buffer[luaZ_bufflen(b)++] = cast_char(c);
67}
68
69
70void luaX_init (lua_State *L) {
71 int i;
72 TString *e = luaS_newliteral(L, LUA_ENV); /* create env name */
73 luaC_fix(L, obj2gco(e)); /* never collect this name */
74 for (i=0; i<NUM_RESERVED; i++) {
75 TString *ts = luaS_new(L, luaX_tokens[i]);
76 luaC_fix(L, obj2gco(ts)); /* reserved words are never collected */
77 ts->extra = cast_byte(i+1); /* reserved word */
78 }
79}
80
81
82const char *luaX_token2str (LexState *ls, int token) {
83 if (token < FIRST_RESERVED) { /* single-byte symbols? */
84 lua_assert(token == cast_uchar(token));
85 if (lisprint(token))
86 return luaO_pushfstring(ls->L, "'%c'", token);
87 else /* control character */
88 return luaO_pushfstring(ls->L, "'<\\%d>'", token);
89 }
90 else {
91 const char *s = luaX_tokens[token - FIRST_RESERVED];
92 if (token < TK_EOS) /* fixed format (symbols and reserved words)? */
93 return luaO_pushfstring(ls->L, "'%s'", s);
94 else /* names, strings, and numerals */
95 return s;
96 }
97}
98
99
100static const char *txtToken (LexState *ls, int token) {
101 switch (token) {
102 case TK_NAME: case TK_STRING:
103 case TK_FLT: case TK_INT:
104 save(ls, '\0');
105 return luaO_pushfstring(ls->L, "'%s'", luaZ_buffer(ls->buff));
106 default:
107 return luaX_token2str(ls, token);
108 }
109}
110
111
112static l_noret lexerror (LexState *ls, const char *msg, int token) {
113 msg = luaG_addinfo(ls->L, msg, ls->source, ls->linenumber);
114 if (token)
115 luaO_pushfstring(ls->L, "%s near %s", msg, txtToken(ls, token));
116 luaD_throw(ls->L, LUA_ERRSYNTAX);
117}
118
119
120l_noret luaX_syntaxerror (LexState *ls, const char *msg) {
121 lexerror(ls, msg, ls->t.token);
122}
123
124
125/*
126** creates a new string and anchors it in scanner's table so that
127** it will not be collected until the end of the compilation
128** (by that time it should be anchored somewhere)
129*/
130TString *luaX_newstring (LexState *ls, const char *str, size_t l) {
131 lua_State *L = ls->L;
132 TValue *o; /* entry for 'str' */
133 TString *ts = luaS_newlstr(L, str, l); /* create new string */
134 setsvalue2s(L, L->top++, ts); /* temporarily anchor it in stack */
135 o = luaH_set(L, ls->h, s2v(L->top - 1));
136 if (isempty(o)) { /* not in use yet? */
137 /* boolean value does not need GC barrier;
138 table is not a metatable, so it does not need to invalidate cache */
139 setbtvalue(o); /* t[string] = true */
140 luaC_checkGC(L);
141 }
142 else { /* string already present */
143 ts = keystrval(nodefromval(o)); /* re-use value previously stored */
144 }
145 L->top--; /* remove string from stack */
146 return ts;
147}
148
149
150/*
151** increment line number and skips newline sequence (any of
152** \n, \r, \n\r, or \r\n)
153*/
154static void inclinenumber (LexState *ls) {
155 int old = ls->current;
156 lua_assert(currIsNewline(ls));
157 next(ls); /* skip '\n' or '\r' */
158 if (currIsNewline(ls) && ls->current != old)
159 next(ls); /* skip '\n\r' or '\r\n' */
160 if (++ls->linenumber >= MAX_INT)
161 lexerror(ls, "chunk has too many lines", 0);
162}
163
164
165void luaX_setinput (lua_State *L, LexState *ls, ZIO *z, TString *source,
166 int firstchar) {
167 ls->t.token = 0;
168 ls->L = L;
169 ls->current = firstchar;
170 ls->lookahead.token = TK_EOS; /* no look-ahead token */
171 ls->z = z;
172 ls->fs = NULL;
173 ls->linenumber = 1;
174 ls->lastline = 1;
175 ls->source = source;
176 ls->envn = luaS_newliteral(L, LUA_ENV); /* get env name */
177 luaZ_resizebuffer(ls->L, ls->buff, LUA_MINBUFFER); /* initialize buffer */
178}
179
180
181
182/*
183** =======================================================
184** LEXICAL ANALYZER
185** =======================================================
186*/
187
188
189static int check_next1 (LexState *ls, int c) {
190 if (ls->current == c) {
191 next(ls);
192 return 1;
193 }
194 else return 0;
195}
196
197
198/*
199** Check whether current char is in set 'set' (with two chars) and
200** saves it
201*/
202static int check_next2 (LexState *ls, const char *set) {
203 lua_assert(set[2] == '\0');
204 if (ls->current == set[0] || ls->current == set[1]) {
205 save_and_next(ls);
206 return 1;
207 }
208 else return 0;
209}
210
211
212/* LUA_NUMBER */
213/*
214** This function is quite liberal in what it accepts, as 'luaO_str2num'
215** will reject ill-formed numerals. Roughly, it accepts the following
216** pattern:
217**
218** %d(%x|%.|([Ee][+-]?))* | 0[Xx](%x|%.|([Pp][+-]?))*
219**
220** The only tricky part is to accept [+-] only after a valid exponent
221** mark, to avoid reading '3-4' or '0xe+1' as a single number.
222**
223** The caller might have already read an initial dot.
224*/
225static int read_numeral (LexState *ls, SemInfo *seminfo) {
226 TValue obj;
227 const char *expo = "Ee";
228 int first = ls->current;
229 lua_assert(lisdigit(ls->current));
230 save_and_next(ls);
231 if (first == '0' && check_next2(ls, "xX")) /* hexadecimal? */
232 expo = "Pp";
233 for (;;) {
234 if (check_next2(ls, expo)) /* exponent mark? */
235 check_next2(ls, "-+"); /* optional exponent sign */
236 else if (lisxdigit(ls->current) || ls->current == '.') /* '%x|%.' */
237 save_and_next(ls);
238 else break;
239 }
240 if (lislalpha(ls->current)) /* is numeral touching a letter? */
241 save_and_next(ls); /* force an error */
242 save(ls, '\0');
243 if (luaO_str2num(luaZ_buffer(ls->buff), &obj) == 0) /* format error? */
244 lexerror(ls, "malformed number", TK_FLT);
245 if (ttisinteger(&obj)) {
246 seminfo->i = ivalue(&obj);
247 return TK_INT;
248 }
249 else {
250 lua_assert(ttisfloat(&obj));
251 seminfo->r = fltvalue(&obj);
252 return TK_FLT;
253 }
254}
255
256
257/*
258** reads a sequence '[=*[' or ']=*]', leaving the last bracket.
259** If sequence is well formed, return its number of '='s + 2; otherwise,
260** return 1 if there is no '='s or 0 otherwise (an unfinished '[==...').
261*/
262static size_t skip_sep (LexState *ls) {
263 size_t count = 0;
264 int s = ls->current;
265 lua_assert(s == '[' || s == ']');
266 save_and_next(ls);
267 while (ls->current == '=') {
268 save_and_next(ls);
269 count++;
270 }
271 return (ls->current == s) ? count + 2
272 : (count == 0) ? 1
273 : 0;
274}
275
276
277static void read_long_string (LexState *ls, SemInfo *seminfo, size_t sep) {
278 int line = ls->linenumber; /* initial line (for error message) */
279 save_and_next(ls); /* skip 2nd '[' */
280 if (currIsNewline(ls)) /* string starts with a newline? */
281 inclinenumber(ls); /* skip it */
282 for (;;) {
283 switch (ls->current) {
284 case EOZ: { /* error */
285 const char *what = (seminfo ? "string" : "comment");
286 const char *msg = luaO_pushfstring(ls->L,
287 "unfinished long %s (starting at line %d)", what, line);
288 lexerror(ls, msg, TK_EOS);
289 break; /* to avoid warnings */
290 }
291 case ']': {
292 if (skip_sep(ls) == sep) {
293 save_and_next(ls); /* skip 2nd ']' */
294 goto endloop;
295 }
296 break;
297 }
298 case '\n': case '\r': {
299 save(ls, '\n');
300 inclinenumber(ls);
301 if (!seminfo) luaZ_resetbuffer(ls->buff); /* avoid wasting space */
302 break;
303 }
304 default: {
305 if (seminfo) save_and_next(ls);
306 else next(ls);
307 }
308 }
309 } endloop:
310 if (seminfo)
311 seminfo->ts = luaX_newstring(ls, luaZ_buffer(ls->buff) + sep,
312 luaZ_bufflen(ls->buff) - 2 * sep);
313}
314
315
316static void esccheck (LexState *ls, int c, const char *msg) {
317 if (!c) {
318 if (ls->current != EOZ)
319 save_and_next(ls); /* add current to buffer for error message */
320 lexerror(ls, msg, TK_STRING);
321 }
322}
323
324
325static int gethexa (LexState *ls) {
326 save_and_next(ls);
327 esccheck (ls, lisxdigit(ls->current), "hexadecimal digit expected");
328 return luaO_hexavalue(ls->current);
329}
330
331
332static int readhexaesc (LexState *ls) {
333 int r = gethexa(ls);
334 r = (r << 4) + gethexa(ls);
335 luaZ_buffremove(ls->buff, 2); /* remove saved chars from buffer */
336 return r;
337}
338
339
340static unsigned long readutf8esc (LexState *ls) {
341 unsigned long r;
342 int i = 4; /* chars to be removed: '\', 'u', '{', and first digit */
343 save_and_next(ls); /* skip 'u' */
344 esccheck(ls, ls->current == '{', "missing '{'");
345 r = gethexa(ls); /* must have at least one digit */
346 while (cast_void(save_and_next(ls)), lisxdigit(ls->current)) {
347 i++;
348 esccheck(ls, r <= (0x7FFFFFFFu >> 4), "UTF-8 value too large");
349 r = (r << 4) + luaO_hexavalue(ls->current);
350 }
351 esccheck(ls, ls->current == '}', "missing '}'");
352 next(ls); /* skip '}' */
353 luaZ_buffremove(ls->buff, i); /* remove saved chars from buffer */
354 return r;
355}
356
357
358static void utf8esc (LexState *ls) {
359 char buff[UTF8BUFFSZ];
360 int n = luaO_utf8esc(buff, readutf8esc(ls));
361 for (; n > 0; n--) /* add 'buff' to string */
362 save(ls, buff[UTF8BUFFSZ - n]);
363}
364
365
366static int readdecesc (LexState *ls) {
367 int i;
368 int r = 0; /* result accumulator */
369 for (i = 0; i < 3 && lisdigit(ls->current); i++) { /* read up to 3 digits */
370 r = 10*r + ls->current - '0';
371 save_and_next(ls);
372 }
373 esccheck(ls, r <= UCHAR_MAX, "decimal escape too large");
374 luaZ_buffremove(ls->buff, i); /* remove read digits from buffer */
375 return r;
376}
377
378
379static void read_string (LexState *ls, int del, SemInfo *seminfo) {
380 save_and_next(ls); /* keep delimiter (for error messages) */
381 while (ls->current != del) {
382 switch (ls->current) {
383 case EOZ:
384 lexerror(ls, "unfinished string", TK_EOS);
385 break; /* to avoid warnings */
386 case '\n':
387 case '\r':
388 lexerror(ls, "unfinished string", TK_STRING);
389 break; /* to avoid warnings */
390 case '\\': { /* escape sequences */
391 int c; /* final character to be saved */
392 save_and_next(ls); /* keep '\\' for error messages */
393 switch (ls->current) {
394 case 'a': c = '\a'; goto read_save;
395 case 'b': c = '\b'; goto read_save;
396 case 'f': c = '\f'; goto read_save;
397 case 'n': c = '\n'; goto read_save;
398 case 'r': c = '\r'; goto read_save;
399 case 't': c = '\t'; goto read_save;
400 case 'v': c = '\v'; goto read_save;
401 case 'x': c = readhexaesc(ls); goto read_save;
402 case 'u': utf8esc(ls); goto no_save;
403 case '\n': case '\r':
404 inclinenumber(ls); c = '\n'; goto only_save;
405 case '\\': case '\"': case '\'':
406 c = ls->current; goto read_save;
407 case EOZ: goto no_save; /* will raise an error next loop */
408 case 'z': { /* zap following span of spaces */
409 luaZ_buffremove(ls->buff, 1); /* remove '\\' */
410 next(ls); /* skip the 'z' */
411 while (lisspace(ls->current)) {
412 if (currIsNewline(ls)) inclinenumber(ls);
413 else next(ls);
414 }
415 goto no_save;
416 }
417 default: {
418 esccheck(ls, lisdigit(ls->current), "invalid escape sequence");
419 c = readdecesc(ls); /* digital escape '\ddd' */
420 goto only_save;
421 }
422 }
423 read_save:
424 next(ls);
425 /* go through */
426 only_save:
427 luaZ_buffremove(ls->buff, 1); /* remove '\\' */
428 save(ls, c);
429 /* go through */
430 no_save: break;
431 }
432 default:
433 save_and_next(ls);
434 }
435 }
436 save_and_next(ls); /* skip delimiter */
437 seminfo->ts = luaX_newstring(ls, luaZ_buffer(ls->buff) + 1,
438 luaZ_bufflen(ls->buff) - 2);
439}
440
441
442static int llex (LexState *ls, SemInfo *seminfo) {
443 luaZ_resetbuffer(ls->buff);
444 for (;;) {
445 switch (ls->current) {
446 case '\n': case '\r': { /* line breaks */
447 inclinenumber(ls);
448 break;
449 }
450 case ' ': case '\f': case '\t': case '\v': { /* spaces */
451 next(ls);
452 break;
453 }
454 case '-': { /* '-' or '--' (comment) */
455 next(ls);
456 if (ls->current != '-') return '-';
457 /* else is a comment */
458 next(ls);
459 if (ls->current == '[') { /* long comment? */
460 size_t sep = skip_sep(ls);
461 luaZ_resetbuffer(ls->buff); /* 'skip_sep' may dirty the buffer */
462 if (sep >= 2) {
463 read_long_string(ls, NULL, sep); /* skip long comment */
464 luaZ_resetbuffer(ls->buff); /* previous call may dirty the buff. */
465 break;
466 }
467 }
468 /* else short comment */
469 while (!currIsNewline(ls) && ls->current != EOZ)
470 next(ls); /* skip until end of line (or end of file) */
471 break;
472 }
473 case '[': { /* long string or simply '[' */
474 size_t sep = skip_sep(ls);
475 if (sep >= 2) {
476 read_long_string(ls, seminfo, sep);
477 return TK_STRING;
478 }
479 else if (sep == 0) /* '[=...' missing second bracket? */
480 lexerror(ls, "invalid long string delimiter", TK_STRING);
481 return '[';
482 }
483 case '=': {
484 next(ls);
485 if (check_next1(ls, '=')) return TK_EQ;
486 else return '=';
487 }
488 case '<': {
489 next(ls);
490 if (check_next1(ls, '=')) return TK_LE;
491 else if (check_next1(ls, '<')) return TK_SHL;
492 else return '<';
493 }
494 case '>': {
495 next(ls);
496 if (check_next1(ls, '=')) return TK_GE;
497 else if (check_next1(ls, '>')) return TK_SHR;
498 else return '>';
499 }
500 case '/': {
501 next(ls);
502 if (check_next1(ls, '/')) return TK_IDIV;
503 else return '/';
504 }
505 case '~': {
506 next(ls);
507 if (check_next1(ls, '=')) return TK_NE;
508 else return '~';
509 }
510 case ':': {
511 next(ls);
512 if (check_next1(ls, ':')) return TK_DBCOLON;
513 else return ':';
514 }
515 case '"': case '\'': { /* short literal strings */
516 read_string(ls, ls->current, seminfo);
517 return TK_STRING;
518 }
519 case '.': { /* '.', '..', '...', or number */
520 save_and_next(ls);
521 if (check_next1(ls, '.')) {
522 if (check_next1(ls, '.'))
523 return TK_DOTS; /* '...' */
524 else return TK_CONCAT; /* '..' */
525 }
526 else if (!lisdigit(ls->current)) return '.';
527 else return read_numeral(ls, seminfo);
528 }
529 case '0': case '1': case '2': case '3': case '4':
530 case '5': case '6': case '7': case '8': case '9': {
531 return read_numeral(ls, seminfo);
532 }
533 case EOZ: {
534 return TK_EOS;
535 }
536 default: {
537 if (lislalpha(ls->current)) { /* identifier or reserved word? */
538 TString *ts;
539 do {
540 save_and_next(ls);
541 } while (lislalnum(ls->current));
542 ts = luaX_newstring(ls, luaZ_buffer(ls->buff),
543 luaZ_bufflen(ls->buff));
544 seminfo->ts = ts;
545 if (isreserved(ts)) /* reserved word? */
546 return ts->extra - 1 + FIRST_RESERVED;
547 else {
548 return TK_NAME;
549 }
550 }
551 else { /* single-char tokens (+ - / ...) */
552 int c = ls->current;
553 next(ls);
554 return c;
555 }
556 }
557 }
558 }
559}
560
561
562void luaX_next (LexState *ls) {
563 ls->lastline = ls->linenumber;
564 if (ls->lookahead.token != TK_EOS) { /* is there a look-ahead token? */
565 ls->t = ls->lookahead; /* use this one */
566 ls->lookahead.token = TK_EOS; /* and discharge it */
567 }
568 else
569 ls->t.token = llex(ls, &ls->t.seminfo); /* read next token */
570}
571
572
573int luaX_lookahead (LexState *ls) {
574 lua_assert(ls->lookahead.token == TK_EOS);
575 ls->lookahead.token = llex(ls, &ls->lookahead.seminfo);
576 return ls->lookahead.token;
577}
578
diff --git a/src/lua/llex.h b/src/lua/llex.h
new file mode 100644
index 0000000..d1a4cba
--- /dev/null
+++ b/src/lua/llex.h
@@ -0,0 +1,85 @@
1/*
2** $Id: llex.h $
3** Lexical Analyzer
4** See Copyright Notice in lua.h
5*/
6
7#ifndef llex_h
8#define llex_h
9
10#include "lobject.h"
11#include "lzio.h"
12
13
14#define FIRST_RESERVED 257
15
16
17#if !defined(LUA_ENV)
18#define LUA_ENV "_ENV"
19#endif
20
21
22/*
23* WARNING: if you change the order of this enumeration,
24* grep "ORDER RESERVED"
25*/
26enum RESERVED {
27 /* terminal symbols denoted by reserved words */
28 TK_AND = FIRST_RESERVED, TK_BREAK,
29 TK_DO, TK_ELSE, TK_ELSEIF, TK_END, TK_FALSE, TK_FOR, TK_FUNCTION,
30 TK_GOTO, TK_IF, TK_IN, TK_LOCAL, TK_NIL, TK_NOT, TK_OR, TK_REPEAT,
31 TK_RETURN, TK_THEN, TK_TRUE, TK_UNTIL, TK_WHILE,
32 /* other terminal symbols */
33 TK_IDIV, TK_CONCAT, TK_DOTS, TK_EQ, TK_GE, TK_LE, TK_NE,
34 TK_SHL, TK_SHR,
35 TK_DBCOLON, TK_EOS,
36 TK_FLT, TK_INT, TK_NAME, TK_STRING
37};
38
39/* number of reserved words */
40#define NUM_RESERVED (cast_int(TK_WHILE-FIRST_RESERVED + 1))
41
42
43typedef union {
44 lua_Number r;
45 lua_Integer i;
46 TString *ts;
47} SemInfo; /* semantics information */
48
49
50typedef struct Token {
51 int token;
52 SemInfo seminfo;
53} Token;
54
55
56/* state of the lexer plus state of the parser when shared by all
57 functions */
58typedef struct LexState {
59 int current; /* current character (charint) */
60 int linenumber; /* input line counter */
61 int lastline; /* line of last token 'consumed' */
62 Token t; /* current token */
63 Token lookahead; /* look ahead token */
64 struct FuncState *fs; /* current function (parser) */
65 struct lua_State *L;
66 ZIO *z; /* input stream */
67 Mbuffer *buff; /* buffer for tokens */
68 Table *h; /* to avoid collection/reuse strings */
69 struct Dyndata *dyd; /* dynamic structures used by the parser */
70 TString *source; /* current source name */
71 TString *envn; /* environment variable name */
72} LexState;
73
74
75LUAI_FUNC void luaX_init (lua_State *L);
76LUAI_FUNC void luaX_setinput (lua_State *L, LexState *ls, ZIO *z,
77 TString *source, int firstchar);
78LUAI_FUNC TString *luaX_newstring (LexState *ls, const char *str, size_t l);
79LUAI_FUNC void luaX_next (LexState *ls);
80LUAI_FUNC int luaX_lookahead (LexState *ls);
81LUAI_FUNC l_noret luaX_syntaxerror (LexState *ls, const char *s);
82LUAI_FUNC const char *luaX_token2str (LexState *ls, int token);
83
84
85#endif
diff --git a/src/lua/llimits.h b/src/lua/llimits.h
new file mode 100644
index 0000000..b86d345
--- /dev/null
+++ b/src/lua/llimits.h
@@ -0,0 +1,349 @@
1/*
2** $Id: llimits.h $
3** Limits, basic types, and some other 'installation-dependent' definitions
4** See Copyright Notice in lua.h
5*/
6
7#ifndef llimits_h
8#define llimits_h
9
10
11#include <limits.h>
12#include <stddef.h>
13
14
15#include "lua.h"
16
17
18/*
19** 'lu_mem' and 'l_mem' are unsigned/signed integers big enough to count
20** the total memory used by Lua (in bytes). Usually, 'size_t' and
21** 'ptrdiff_t' should work, but we use 'long' for 16-bit machines.
22*/
23#if defined(LUAI_MEM) /* { external definitions? */
24typedef LUAI_UMEM lu_mem;
25typedef LUAI_MEM l_mem;
26#elif LUAI_IS32INT /* }{ */
27typedef size_t lu_mem;
28typedef ptrdiff_t l_mem;
29#else /* 16-bit ints */ /* }{ */
30typedef unsigned long lu_mem;
31typedef long l_mem;
32#endif /* } */
33
34
35/* chars used as small naturals (so that 'char' is reserved for characters) */
36typedef unsigned char lu_byte;
37typedef signed char ls_byte;
38
39
40/* maximum value for size_t */
41#define MAX_SIZET ((size_t)(~(size_t)0))
42
43/* maximum size visible for Lua (must be representable in a lua_Integer) */
44#define MAX_SIZE (sizeof(size_t) < sizeof(lua_Integer) ? MAX_SIZET \
45 : (size_t)(LUA_MAXINTEGER))
46
47
48#define MAX_LUMEM ((lu_mem)(~(lu_mem)0))
49
50#define MAX_LMEM ((l_mem)(MAX_LUMEM >> 1))
51
52
53#define MAX_INT INT_MAX /* maximum value of an int */
54
55
56/*
57** floor of the log2 of the maximum signed value for integral type 't'.
58** (That is, maximum 'n' such that '2^n' fits in the given signed type.)
59*/
60#define log2maxs(t) (sizeof(t) * 8 - 2)
61
62
63/*
64** test whether an unsigned value is a power of 2 (or zero)
65*/
66#define ispow2(x) (((x) & ((x) - 1)) == 0)
67
68
69/* number of chars of a literal string without the ending \0 */
70#define LL(x) (sizeof(x)/sizeof(char) - 1)
71
72
73/*
74** conversion of pointer to unsigned integer:
75** this is for hashing only; there is no problem if the integer
76** cannot hold the whole pointer value
77*/
78#define point2uint(p) ((unsigned int)((size_t)(p) & UINT_MAX))
79
80
81
82/* types of 'usual argument conversions' for lua_Number and lua_Integer */
83typedef LUAI_UACNUMBER l_uacNumber;
84typedef LUAI_UACINT l_uacInt;
85
86
87/* internal assertions for in-house debugging */
88#if defined(lua_assert)
89#define check_exp(c,e) (lua_assert(c), (e))
90/* to avoid problems with conditions too long */
91#define lua_longassert(c) ((c) ? (void)0 : lua_assert(0))
92#else
93#define lua_assert(c) ((void)0)
94#define check_exp(c,e) (e)
95#define lua_longassert(c) ((void)0)
96#endif
97
98/*
99** assertion for checking API calls
100*/
101#if !defined(luai_apicheck)
102#define luai_apicheck(l,e) ((void)l, lua_assert(e))
103#endif
104
105#define api_check(l,e,msg) luai_apicheck(l,(e) && msg)
106
107
108/* macro to avoid warnings about unused variables */
109#if !defined(UNUSED)
110#define UNUSED(x) ((void)(x))
111#endif
112
113
114/* type casts (a macro highlights casts in the code) */
115#define cast(t, exp) ((t)(exp))
116
117#define cast_void(i) cast(void, (i))
118#define cast_voidp(i) cast(void *, (i))
119#define cast_num(i) cast(lua_Number, (i))
120#define cast_int(i) cast(int, (i))
121#define cast_uint(i) cast(unsigned int, (i))
122#define cast_byte(i) cast(lu_byte, (i))
123#define cast_uchar(i) cast(unsigned char, (i))
124#define cast_char(i) cast(char, (i))
125#define cast_charp(i) cast(char *, (i))
126#define cast_sizet(i) cast(size_t, (i))
127
128
129/* cast a signed lua_Integer to lua_Unsigned */
130#if !defined(l_castS2U)
131#define l_castS2U(i) ((lua_Unsigned)(i))
132#endif
133
134/*
135** cast a lua_Unsigned to a signed lua_Integer; this cast is
136** not strict ISO C, but two-complement architectures should
137** work fine.
138*/
139#if !defined(l_castU2S)
140#define l_castU2S(i) ((lua_Integer)(i))
141#endif
142
143
144/*
145** macros to improve jump prediction (used mainly for error handling)
146*/
147#if !defined(likely)
148
149#if defined(__GNUC__)
150#define likely(x) (__builtin_expect(((x) != 0), 1))
151#define unlikely(x) (__builtin_expect(((x) != 0), 0))
152#else
153#define likely(x) (x)
154#define unlikely(x) (x)
155#endif
156
157#endif
158
159
160/*
161** non-return type
162*/
163#if !defined(l_noret)
164
165#if defined(__GNUC__)
166#define l_noret void __attribute__((noreturn))
167#elif defined(_MSC_VER) && _MSC_VER >= 1200
168#define l_noret void __declspec(noreturn)
169#else
170#define l_noret void
171#endif
172
173#endif
174
175
176/*
177** type for virtual-machine instructions;
178** must be an unsigned with (at least) 4 bytes (see details in lopcodes.h)
179*/
180#if LUAI_IS32INT
181typedef unsigned int l_uint32;
182#else
183typedef unsigned long l_uint32;
184#endif
185
186typedef l_uint32 Instruction;
187
188
189
190/*
191** Maximum length for short strings, that is, strings that are
192** internalized. (Cannot be smaller than reserved words or tags for
193** metamethods, as these strings must be internalized;
194** #("function") = 8, #("__newindex") = 10.)
195*/
196#if !defined(LUAI_MAXSHORTLEN)
197#define LUAI_MAXSHORTLEN 40
198#endif
199
200
201/*
202** Initial size for the string table (must be power of 2).
203** The Lua core alone registers ~50 strings (reserved words +
204** metaevent keys + a few others). Libraries would typically add
205** a few dozens more.
206*/
207#if !defined(MINSTRTABSIZE)
208#define MINSTRTABSIZE 128
209#endif
210
211
212/*
213** Size of cache for strings in the API. 'N' is the number of
214** sets (better be a prime) and "M" is the size of each set (M == 1
215** makes a direct cache.)
216*/
217#if !defined(STRCACHE_N)
218#define STRCACHE_N 53
219#define STRCACHE_M 2
220#endif
221
222
223/* minimum size for string buffer */
224#if !defined(LUA_MINBUFFER)
225#define LUA_MINBUFFER 32
226#endif
227
228
229/*
230** macros that are executed whenever program enters the Lua core
231** ('lua_lock') and leaves the core ('lua_unlock')
232*/
233#if !defined(lua_lock)
234#define lua_lock(L) ((void) 0)
235#define lua_unlock(L) ((void) 0)
236#endif
237
238/*
239** macro executed during Lua functions at points where the
240** function can yield.
241*/
242#if !defined(luai_threadyield)
243#define luai_threadyield(L) {lua_unlock(L); lua_lock(L);}
244#endif
245
246
247/*
248** these macros allow user-specific actions when a thread is
249** created/deleted/resumed/yielded.
250*/
251#if !defined(luai_userstateopen)
252#define luai_userstateopen(L) ((void)L)
253#endif
254
255#if !defined(luai_userstateclose)
256#define luai_userstateclose(L) ((void)L)
257#endif
258
259#if !defined(luai_userstatethread)
260#define luai_userstatethread(L,L1) ((void)L)
261#endif
262
263#if !defined(luai_userstatefree)
264#define luai_userstatefree(L,L1) ((void)L)
265#endif
266
267#if !defined(luai_userstateresume)
268#define luai_userstateresume(L,n) ((void)L)
269#endif
270
271#if !defined(luai_userstateyield)
272#define luai_userstateyield(L,n) ((void)L)
273#endif
274
275
276
277/*
278** The luai_num* macros define the primitive operations over numbers.
279*/
280
281/* floor division (defined as 'floor(a/b)') */
282#if !defined(luai_numidiv)
283#define luai_numidiv(L,a,b) ((void)L, l_floor(luai_numdiv(L,a,b)))
284#endif
285
286/* float division */
287#if !defined(luai_numdiv)
288#define luai_numdiv(L,a,b) ((a)/(b))
289#endif
290
291/*
292** modulo: defined as 'a - floor(a/b)*b'; the direct computation
293** using this definition has several problems with rounding errors,
294** so it is better to use 'fmod'. 'fmod' gives the result of
295** 'a - trunc(a/b)*b', and therefore must be corrected when
296** 'trunc(a/b) ~= floor(a/b)'. That happens when the division has a
297** non-integer negative result: non-integer result is equivalent to
298** a non-zero remainder 'm'; negative result is equivalent to 'a' and
299** 'b' with different signs, or 'm' and 'b' with different signs
300** (as the result 'm' of 'fmod' has the same sign of 'a').
301*/
302#if !defined(luai_nummod)
303#define luai_nummod(L,a,b,m) \
304 { (void)L; (m) = l_mathop(fmod)(a,b); \
305 if (((m) > 0) ? (b) < 0 : ((m) < 0 && (b) > 0)) (m) += (b); }
306#endif
307
308/* exponentiation */
309#if !defined(luai_numpow)
310#define luai_numpow(L,a,b) ((void)L, l_mathop(pow)(a,b))
311#endif
312
313/* the others are quite standard operations */
314#if !defined(luai_numadd)
315#define luai_numadd(L,a,b) ((a)+(b))
316#define luai_numsub(L,a,b) ((a)-(b))
317#define luai_nummul(L,a,b) ((a)*(b))
318#define luai_numunm(L,a) (-(a))
319#define luai_numeq(a,b) ((a)==(b))
320#define luai_numlt(a,b) ((a)<(b))
321#define luai_numle(a,b) ((a)<=(b))
322#define luai_numgt(a,b) ((a)>(b))
323#define luai_numge(a,b) ((a)>=(b))
324#define luai_numisnan(a) (!luai_numeq((a), (a)))
325#endif
326
327
328
329
330
331/*
332** macro to control inclusion of some hard tests on stack reallocation
333*/
334#if !defined(HARDSTACKTESTS)
335#define condmovestack(L,pre,pos) ((void)0)
336#else
337/* realloc stack keeping its size */
338#define condmovestack(L,pre,pos) \
339 { int sz_ = (L)->stacksize; pre; luaD_reallocstack((L), sz_, 0); pos; }
340#endif
341
342#if !defined(HARDMEMTESTS)
343#define condchangemem(L,pre,pos) ((void)0)
344#else
345#define condchangemem(L,pre,pos) \
346 { if (G(L)->gcrunning) { pre; luaC_fullgc(L, 0); pos; } }
347#endif
348
349#endif
diff --git a/src/lua/lmathlib.c b/src/lua/lmathlib.c
new file mode 100644
index 0000000..86def47
--- /dev/null
+++ b/src/lua/lmathlib.c
@@ -0,0 +1,763 @@
1/*
2** $Id: lmathlib.c $
3** Standard mathematical library
4** See Copyright Notice in lua.h
5*/
6
7#define lmathlib_c
8#define LUA_LIB
9
10#include "lprefix.h"
11
12
13#include <float.h>
14#include <limits.h>
15#include <math.h>
16#include <stdlib.h>
17#include <time.h>
18
19#include "lua.h"
20
21#include "lauxlib.h"
22#include "lualib.h"
23
24
25#undef PI
26#define PI (l_mathop(3.141592653589793238462643383279502884))
27
28
29static int math_abs (lua_State *L) {
30 if (lua_isinteger(L, 1)) {
31 lua_Integer n = lua_tointeger(L, 1);
32 if (n < 0) n = (lua_Integer)(0u - (lua_Unsigned)n);
33 lua_pushinteger(L, n);
34 }
35 else
36 lua_pushnumber(L, l_mathop(fabs)(luaL_checknumber(L, 1)));
37 return 1;
38}
39
40static int math_sin (lua_State *L) {
41 lua_pushnumber(L, l_mathop(sin)(luaL_checknumber(L, 1)));
42 return 1;
43}
44
45static int math_cos (lua_State *L) {
46 lua_pushnumber(L, l_mathop(cos)(luaL_checknumber(L, 1)));
47 return 1;
48}
49
50static int math_tan (lua_State *L) {
51 lua_pushnumber(L, l_mathop(tan)(luaL_checknumber(L, 1)));
52 return 1;
53}
54
55static int math_asin (lua_State *L) {
56 lua_pushnumber(L, l_mathop(asin)(luaL_checknumber(L, 1)));
57 return 1;
58}
59
60static int math_acos (lua_State *L) {
61 lua_pushnumber(L, l_mathop(acos)(luaL_checknumber(L, 1)));
62 return 1;
63}
64
65static int math_atan (lua_State *L) {
66 lua_Number y = luaL_checknumber(L, 1);
67 lua_Number x = luaL_optnumber(L, 2, 1);
68 lua_pushnumber(L, l_mathop(atan2)(y, x));
69 return 1;
70}
71
72
73static int math_toint (lua_State *L) {
74 int valid;
75 lua_Integer n = lua_tointegerx(L, 1, &valid);
76 if (valid)
77 lua_pushinteger(L, n);
78 else {
79 luaL_checkany(L, 1);
80 luaL_pushfail(L); /* value is not convertible to integer */
81 }
82 return 1;
83}
84
85
86static void pushnumint (lua_State *L, lua_Number d) {
87 lua_Integer n;
88 if (lua_numbertointeger(d, &n)) /* does 'd' fit in an integer? */
89 lua_pushinteger(L, n); /* result is integer */
90 else
91 lua_pushnumber(L, d); /* result is float */
92}
93
94
95static int math_floor (lua_State *L) {
96 if (lua_isinteger(L, 1))
97 lua_settop(L, 1); /* integer is its own floor */
98 else {
99 lua_Number d = l_mathop(floor)(luaL_checknumber(L, 1));
100 pushnumint(L, d);
101 }
102 return 1;
103}
104
105
106static int math_ceil (lua_State *L) {
107 if (lua_isinteger(L, 1))
108 lua_settop(L, 1); /* integer is its own ceil */
109 else {
110 lua_Number d = l_mathop(ceil)(luaL_checknumber(L, 1));
111 pushnumint(L, d);
112 }
113 return 1;
114}
115
116
117static int math_fmod (lua_State *L) {
118 if (lua_isinteger(L, 1) && lua_isinteger(L, 2)) {
119 lua_Integer d = lua_tointeger(L, 2);
120 if ((lua_Unsigned)d + 1u <= 1u) { /* special cases: -1 or 0 */
121 luaL_argcheck(L, d != 0, 2, "zero");
122 lua_pushinteger(L, 0); /* avoid overflow with 0x80000... / -1 */
123 }
124 else
125 lua_pushinteger(L, lua_tointeger(L, 1) % d);
126 }
127 else
128 lua_pushnumber(L, l_mathop(fmod)(luaL_checknumber(L, 1),
129 luaL_checknumber(L, 2)));
130 return 1;
131}
132
133
134/*
135** next function does not use 'modf', avoiding problems with 'double*'
136** (which is not compatible with 'float*') when lua_Number is not
137** 'double'.
138*/
139static int math_modf (lua_State *L) {
140 if (lua_isinteger(L ,1)) {
141 lua_settop(L, 1); /* number is its own integer part */
142 lua_pushnumber(L, 0); /* no fractional part */
143 }
144 else {
145 lua_Number n = luaL_checknumber(L, 1);
146 /* integer part (rounds toward zero) */
147 lua_Number ip = (n < 0) ? l_mathop(ceil)(n) : l_mathop(floor)(n);
148 pushnumint(L, ip);
149 /* fractional part (test needed for inf/-inf) */
150 lua_pushnumber(L, (n == ip) ? l_mathop(0.0) : (n - ip));
151 }
152 return 2;
153}
154
155
156static int math_sqrt (lua_State *L) {
157 lua_pushnumber(L, l_mathop(sqrt)(luaL_checknumber(L, 1)));
158 return 1;
159}
160
161
162static int math_ult (lua_State *L) {
163 lua_Integer a = luaL_checkinteger(L, 1);
164 lua_Integer b = luaL_checkinteger(L, 2);
165 lua_pushboolean(L, (lua_Unsigned)a < (lua_Unsigned)b);
166 return 1;
167}
168
169static int math_log (lua_State *L) {
170 lua_Number x = luaL_checknumber(L, 1);
171 lua_Number res;
172 if (lua_isnoneornil(L, 2))
173 res = l_mathop(log)(x);
174 else {
175 lua_Number base = luaL_checknumber(L, 2);
176#if !defined(LUA_USE_C89)
177 if (base == l_mathop(2.0))
178 res = l_mathop(log2)(x); else
179#endif
180 if (base == l_mathop(10.0))
181 res = l_mathop(log10)(x);
182 else
183 res = l_mathop(log)(x)/l_mathop(log)(base);
184 }
185 lua_pushnumber(L, res);
186 return 1;
187}
188
189static int math_exp (lua_State *L) {
190 lua_pushnumber(L, l_mathop(exp)(luaL_checknumber(L, 1)));
191 return 1;
192}
193
194static int math_deg (lua_State *L) {
195 lua_pushnumber(L, luaL_checknumber(L, 1) * (l_mathop(180.0) / PI));
196 return 1;
197}
198
199static int math_rad (lua_State *L) {
200 lua_pushnumber(L, luaL_checknumber(L, 1) * (PI / l_mathop(180.0)));
201 return 1;
202}
203
204
205static int math_min (lua_State *L) {
206 int n = lua_gettop(L); /* number of arguments */
207 int imin = 1; /* index of current minimum value */
208 int i;
209 luaL_argcheck(L, n >= 1, 1, "value expected");
210 for (i = 2; i <= n; i++) {
211 if (lua_compare(L, i, imin, LUA_OPLT))
212 imin = i;
213 }
214 lua_pushvalue(L, imin);
215 return 1;
216}
217
218
219static int math_max (lua_State *L) {
220 int n = lua_gettop(L); /* number of arguments */
221 int imax = 1; /* index of current maximum value */
222 int i;
223 luaL_argcheck(L, n >= 1, 1, "value expected");
224 for (i = 2; i <= n; i++) {
225 if (lua_compare(L, imax, i, LUA_OPLT))
226 imax = i;
227 }
228 lua_pushvalue(L, imax);
229 return 1;
230}
231
232
233static int math_type (lua_State *L) {
234 if (lua_type(L, 1) == LUA_TNUMBER)
235 lua_pushstring(L, (lua_isinteger(L, 1)) ? "integer" : "float");
236 else {
237 luaL_checkany(L, 1);
238 luaL_pushfail(L);
239 }
240 return 1;
241}
242
243
244
245/*
246** {==================================================================
247** Pseudo-Random Number Generator based on 'xoshiro256**'.
248** ===================================================================
249*/
250
251/* number of binary digits in the mantissa of a float */
252#define FIGS l_floatatt(MANT_DIG)
253
254#if FIGS > 64
255/* there are only 64 random bits; use them all */
256#undef FIGS
257#define FIGS 64
258#endif
259
260
261/*
262** LUA_RAND32 forces the use of 32-bit integers in the implementation
263** of the PRN generator (mainly for testing).
264*/
265#if !defined(LUA_RAND32) && !defined(Rand64)
266
267/* try to find an integer type with at least 64 bits */
268
269#if (ULONG_MAX >> 31 >> 31) >= 3
270
271/* 'long' has at least 64 bits */
272#define Rand64 unsigned long
273
274#elif !defined(LUA_USE_C89) && defined(LLONG_MAX)
275
276/* there is a 'long long' type (which must have at least 64 bits) */
277#define Rand64 unsigned long long
278
279#elif (LUA_MAXUNSIGNED >> 31 >> 31) >= 3
280
281/* 'lua_Integer' has at least 64 bits */
282#define Rand64 lua_Unsigned
283
284#endif
285
286#endif
287
288
289#if defined(Rand64) /* { */
290
291/*
292** Standard implementation, using 64-bit integers.
293** If 'Rand64' has more than 64 bits, the extra bits do not interfere
294** with the 64 initial bits, except in a right shift. Moreover, the
295** final result has to discard the extra bits.
296*/
297
298/* avoid using extra bits when needed */
299#define trim64(x) ((x) & 0xffffffffffffffffu)
300
301
302/* rotate left 'x' by 'n' bits */
303static Rand64 rotl (Rand64 x, int n) {
304 return (x << n) | (trim64(x) >> (64 - n));
305}
306
307static Rand64 nextrand (Rand64 *state) {
308 Rand64 state0 = state[0];
309 Rand64 state1 = state[1];
310 Rand64 state2 = state[2] ^ state0;
311 Rand64 state3 = state[3] ^ state1;
312 Rand64 res = rotl(state1 * 5, 7) * 9;
313 state[0] = state0 ^ state3;
314 state[1] = state1 ^ state2;
315 state[2] = state2 ^ (state1 << 17);
316 state[3] = rotl(state3, 45);
317 return res;
318}
319
320
321/* must take care to not shift stuff by more than 63 slots */
322
323
324/*
325** Convert bits from a random integer into a float in the
326** interval [0,1), getting the higher FIG bits from the
327** random unsigned integer and converting that to a float.
328*/
329
330/* must throw out the extra (64 - FIGS) bits */
331#define shift64_FIG (64 - FIGS)
332
333/* to scale to [0, 1), multiply by scaleFIG = 2^(-FIGS) */
334#define scaleFIG (l_mathop(0.5) / ((Rand64)1 << (FIGS - 1)))
335
336static lua_Number I2d (Rand64 x) {
337 return (lua_Number)(trim64(x) >> shift64_FIG) * scaleFIG;
338}
339
340/* convert a 'Rand64' to a 'lua_Unsigned' */
341#define I2UInt(x) ((lua_Unsigned)trim64(x))
342
343/* convert a 'lua_Unsigned' to a 'Rand64' */
344#define Int2I(x) ((Rand64)(x))
345
346
347#else /* no 'Rand64' }{ */
348
349/* get an integer with at least 32 bits */
350#if LUAI_IS32INT
351typedef unsigned int lu_int32;
352#else
353typedef unsigned long lu_int32;
354#endif
355
356
357/*
358** Use two 32-bit integers to represent a 64-bit quantity.
359*/
360typedef struct Rand64 {
361 lu_int32 h; /* higher half */
362 lu_int32 l; /* lower half */
363} Rand64;
364
365
366/*
367** If 'lu_int32' has more than 32 bits, the extra bits do not interfere
368** with the 32 initial bits, except in a right shift and comparisons.
369** Moreover, the final result has to discard the extra bits.
370*/
371
372/* avoid using extra bits when needed */
373#define trim32(x) ((x) & 0xffffffffu)
374
375
376/*
377** basic operations on 'Rand64' values
378*/
379
380/* build a new Rand64 value */
381static Rand64 packI (lu_int32 h, lu_int32 l) {
382 Rand64 result;
383 result.h = h;
384 result.l = l;
385 return result;
386}
387
388/* return i << n */
389static Rand64 Ishl (Rand64 i, int n) {
390 lua_assert(n > 0 && n < 32);
391 return packI((i.h << n) | (trim32(i.l) >> (32 - n)), i.l << n);
392}
393
394/* i1 ^= i2 */
395static void Ixor (Rand64 *i1, Rand64 i2) {
396 i1->h ^= i2.h;
397 i1->l ^= i2.l;
398}
399
400/* return i1 + i2 */
401static Rand64 Iadd (Rand64 i1, Rand64 i2) {
402 Rand64 result = packI(i1.h + i2.h, i1.l + i2.l);
403 if (trim32(result.l) < trim32(i1.l)) /* carry? */
404 result.h++;
405 return result;
406}
407
408/* return i * 5 */
409static Rand64 times5 (Rand64 i) {
410 return Iadd(Ishl(i, 2), i); /* i * 5 == (i << 2) + i */
411}
412
413/* return i * 9 */
414static Rand64 times9 (Rand64 i) {
415 return Iadd(Ishl(i, 3), i); /* i * 9 == (i << 3) + i */
416}
417
418/* return 'i' rotated left 'n' bits */
419static Rand64 rotl (Rand64 i, int n) {
420 lua_assert(n > 0 && n < 32);
421 return packI((i.h << n) | (trim32(i.l) >> (32 - n)),
422 (trim32(i.h) >> (32 - n)) | (i.l << n));
423}
424
425/* for offsets larger than 32, rotate right by 64 - offset */
426static Rand64 rotl1 (Rand64 i, int n) {
427 lua_assert(n > 32 && n < 64);
428 n = 64 - n;
429 return packI((trim32(i.h) >> n) | (i.l << (32 - n)),
430 (i.h << (32 - n)) | (trim32(i.l) >> n));
431}
432
433/*
434** implementation of 'xoshiro256**' algorithm on 'Rand64' values
435*/
436static Rand64 nextrand (Rand64 *state) {
437 Rand64 res = times9(rotl(times5(state[1]), 7));
438 Rand64 t = Ishl(state[1], 17);
439 Ixor(&state[2], state[0]);
440 Ixor(&state[3], state[1]);
441 Ixor(&state[1], state[2]);
442 Ixor(&state[0], state[3]);
443 Ixor(&state[2], t);
444 state[3] = rotl1(state[3], 45);
445 return res;
446}
447
448
449/*
450** Converts a 'Rand64' into a float.
451*/
452
453/* an unsigned 1 with proper type */
454#define UONE ((lu_int32)1)
455
456
457#if FIGS <= 32
458
459/* 2^(-FIGS) */
460#define scaleFIG (l_mathop(0.5) / (UONE << (FIGS - 1)))
461
462/*
463** get up to 32 bits from higher half, shifting right to
464** throw out the extra bits.
465*/
466static lua_Number I2d (Rand64 x) {
467 lua_Number h = (lua_Number)(trim32(x.h) >> (32 - FIGS));
468 return h * scaleFIG;
469}
470
471#else /* 32 < FIGS <= 64 */
472
473/* must take care to not shift stuff by more than 31 slots */
474
475/* 2^(-FIGS) = 1.0 / 2^30 / 2^3 / 2^(FIGS-33) */
476#define scaleFIG \
477 ((lua_Number)1.0 / (UONE << 30) / 8.0 / (UONE << (FIGS - 33)))
478
479/*
480** use FIGS - 32 bits from lower half, throwing out the other
481** (32 - (FIGS - 32)) = (64 - FIGS) bits
482*/
483#define shiftLOW (64 - FIGS)
484
485/*
486** higher 32 bits go after those (FIGS - 32) bits: shiftHI = 2^(FIGS - 32)
487*/
488#define shiftHI ((lua_Number)(UONE << (FIGS - 33)) * 2.0)
489
490
491static lua_Number I2d (Rand64 x) {
492 lua_Number h = (lua_Number)trim32(x.h) * shiftHI;
493 lua_Number l = (lua_Number)(trim32(x.l) >> shiftLOW);
494 return (h + l) * scaleFIG;
495}
496
497#endif
498
499
500/* convert a 'Rand64' to a 'lua_Unsigned' */
501static lua_Unsigned I2UInt (Rand64 x) {
502 return ((lua_Unsigned)trim32(x.h) << 31 << 1) | (lua_Unsigned)trim32(x.l);
503}
504
505/* convert a 'lua_Unsigned' to a 'Rand64' */
506static Rand64 Int2I (lua_Unsigned n) {
507 return packI((lu_int32)(n >> 31 >> 1), (lu_int32)n);
508}
509
510#endif /* } */
511
512
513/*
514** A state uses four 'Rand64' values.
515*/
516typedef struct {
517 Rand64 s[4];
518} RanState;
519
520
521/*
522** Project the random integer 'ran' into the interval [0, n].
523** Because 'ran' has 2^B possible values, the projection can only be
524** uniform when the size of the interval is a power of 2 (exact
525** division). Otherwise, to get a uniform projection into [0, n], we
526** first compute 'lim', the smallest Mersenne number not smaller than
527** 'n'. We then project 'ran' into the interval [0, lim]. If the result
528** is inside [0, n], we are done. Otherwise, we try with another 'ran',
529** until we have a result inside the interval.
530*/
531static lua_Unsigned project (lua_Unsigned ran, lua_Unsigned n,
532 RanState *state) {
533 if ((n & (n + 1)) == 0) /* is 'n + 1' a power of 2? */
534 return ran & n; /* no bias */
535 else {
536 lua_Unsigned lim = n;
537 /* compute the smallest (2^b - 1) not smaller than 'n' */
538 lim |= (lim >> 1);
539 lim |= (lim >> 2);
540 lim |= (lim >> 4);
541 lim |= (lim >> 8);
542 lim |= (lim >> 16);
543#if (LUA_MAXUNSIGNED >> 31) >= 3
544 lim |= (lim >> 32); /* integer type has more than 32 bits */
545#endif
546 lua_assert((lim & (lim + 1)) == 0 /* 'lim + 1' is a power of 2, */
547 && lim >= n /* not smaller than 'n', */
548 && (lim >> 1) < n); /* and it is the smallest one */
549 while ((ran &= lim) > n) /* project 'ran' into [0..lim] */
550 ran = I2UInt(nextrand(state->s)); /* not inside [0..n]? try again */
551 return ran;
552 }
553}
554
555
556static int math_random (lua_State *L) {
557 lua_Integer low, up;
558 lua_Unsigned p;
559 RanState *state = (RanState *)lua_touserdata(L, lua_upvalueindex(1));
560 Rand64 rv = nextrand(state->s); /* next pseudo-random value */
561 switch (lua_gettop(L)) { /* check number of arguments */
562 case 0: { /* no arguments */
563 lua_pushnumber(L, I2d(rv)); /* float between 0 and 1 */
564 return 1;
565 }
566 case 1: { /* only upper limit */
567 low = 1;
568 up = luaL_checkinteger(L, 1);
569 if (up == 0) { /* single 0 as argument? */
570 lua_pushinteger(L, I2UInt(rv)); /* full random integer */
571 return 1;
572 }
573 break;
574 }
575 case 2: { /* lower and upper limits */
576 low = luaL_checkinteger(L, 1);
577 up = luaL_checkinteger(L, 2);
578 break;
579 }
580 default: return luaL_error(L, "wrong number of arguments");
581 }
582 /* random integer in the interval [low, up] */
583 luaL_argcheck(L, low <= up, 1, "interval is empty");
584 /* project random integer into the interval [0, up - low] */
585 p = project(I2UInt(rv), (lua_Unsigned)up - (lua_Unsigned)low, state);
586 lua_pushinteger(L, p + (lua_Unsigned)low);
587 return 1;
588}
589
590
591static void setseed (lua_State *L, Rand64 *state,
592 lua_Unsigned n1, lua_Unsigned n2) {
593 int i;
594 state[0] = Int2I(n1);
595 state[1] = Int2I(0xff); /* avoid a zero state */
596 state[2] = Int2I(n2);
597 state[3] = Int2I(0);
598 for (i = 0; i < 16; i++)
599 nextrand(state); /* discard initial values to "spread" seed */
600 lua_pushinteger(L, n1);
601 lua_pushinteger(L, n2);
602}
603
604
605/*
606** Set a "random" seed. To get some randomness, use the current time
607** and the address of 'L' (in case the machine does address space layout
608** randomization).
609*/
610static void randseed (lua_State *L, RanState *state) {
611 lua_Unsigned seed1 = (lua_Unsigned)time(NULL);
612 lua_Unsigned seed2 = (lua_Unsigned)(size_t)L;
613 setseed(L, state->s, seed1, seed2);
614}
615
616
617static int math_randomseed (lua_State *L) {
618 RanState *state = (RanState *)lua_touserdata(L, lua_upvalueindex(1));
619 if (lua_isnone(L, 1)) {
620 randseed(L, state);
621 }
622 else {
623 lua_Integer n1 = luaL_checkinteger(L, 1);
624 lua_Integer n2 = luaL_optinteger(L, 2, 0);
625 setseed(L, state->s, n1, n2);
626 }
627 return 2; /* return seeds */
628}
629
630
631static const luaL_Reg randfuncs[] = {
632 {"random", math_random},
633 {"randomseed", math_randomseed},
634 {NULL, NULL}
635};
636
637
638/*
639** Register the random functions and initialize their state.
640*/
641static void setrandfunc (lua_State *L) {
642 RanState *state = (RanState *)lua_newuserdatauv(L, sizeof(RanState), 0);
643 randseed(L, state); /* initialize with a "random" seed */
644 lua_pop(L, 2); /* remove pushed seeds */
645 luaL_setfuncs(L, randfuncs, 1);
646}
647
648/* }================================================================== */
649
650
651/*
652** {==================================================================
653** Deprecated functions (for compatibility only)
654** ===================================================================
655*/
656#if defined(LUA_COMPAT_MATHLIB)
657
658static int math_cosh (lua_State *L) {
659 lua_pushnumber(L, l_mathop(cosh)(luaL_checknumber(L, 1)));
660 return 1;
661}
662
663static int math_sinh (lua_State *L) {
664 lua_pushnumber(L, l_mathop(sinh)(luaL_checknumber(L, 1)));
665 return 1;
666}
667
668static int math_tanh (lua_State *L) {
669 lua_pushnumber(L, l_mathop(tanh)(luaL_checknumber(L, 1)));
670 return 1;
671}
672
673static int math_pow (lua_State *L) {
674 lua_Number x = luaL_checknumber(L, 1);
675 lua_Number y = luaL_checknumber(L, 2);
676 lua_pushnumber(L, l_mathop(pow)(x, y));
677 return 1;
678}
679
680static int math_frexp (lua_State *L) {
681 int e;
682 lua_pushnumber(L, l_mathop(frexp)(luaL_checknumber(L, 1), &e));
683 lua_pushinteger(L, e);
684 return 2;
685}
686
687static int math_ldexp (lua_State *L) {
688 lua_Number x = luaL_checknumber(L, 1);
689 int ep = (int)luaL_checkinteger(L, 2);
690 lua_pushnumber(L, l_mathop(ldexp)(x, ep));
691 return 1;
692}
693
694static int math_log10 (lua_State *L) {
695 lua_pushnumber(L, l_mathop(log10)(luaL_checknumber(L, 1)));
696 return 1;
697}
698
699#endif
700/* }================================================================== */
701
702
703
704static const luaL_Reg mathlib[] = {
705 {"abs", math_abs},
706 {"acos", math_acos},
707 {"asin", math_asin},
708 {"atan", math_atan},
709 {"ceil", math_ceil},
710 {"cos", math_cos},
711 {"deg", math_deg},
712 {"exp", math_exp},
713 {"tointeger", math_toint},
714 {"floor", math_floor},
715 {"fmod", math_fmod},
716 {"ult", math_ult},
717 {"log", math_log},
718 {"max", math_max},
719 {"min", math_min},
720 {"modf", math_modf},
721 {"rad", math_rad},
722 {"sin", math_sin},
723 {"sqrt", math_sqrt},
724 {"tan", math_tan},
725 {"type", math_type},
726#if defined(LUA_COMPAT_MATHLIB)
727 {"atan2", math_atan},
728 {"cosh", math_cosh},
729 {"sinh", math_sinh},
730 {"tanh", math_tanh},
731 {"pow", math_pow},
732 {"frexp", math_frexp},
733 {"ldexp", math_ldexp},
734 {"log10", math_log10},
735#endif
736 /* placeholders */
737 {"random", NULL},
738 {"randomseed", NULL},
739 {"pi", NULL},
740 {"huge", NULL},
741 {"maxinteger", NULL},
742 {"mininteger", NULL},
743 {NULL, NULL}
744};
745
746
747/*
748** Open math library
749*/
750LUAMOD_API int luaopen_math (lua_State *L) {
751 luaL_newlib(L, mathlib);
752 lua_pushnumber(L, PI);
753 lua_setfield(L, -2, "pi");
754 lua_pushnumber(L, (lua_Number)HUGE_VAL);
755 lua_setfield(L, -2, "huge");
756 lua_pushinteger(L, LUA_MAXINTEGER);
757 lua_setfield(L, -2, "maxinteger");
758 lua_pushinteger(L, LUA_MININTEGER);
759 lua_setfield(L, -2, "mininteger");
760 setrandfunc(L);
761 return 1;
762}
763
diff --git a/src/lua/lmem.c b/src/lua/lmem.c
new file mode 100644
index 0000000..65bfa52
--- /dev/null
+++ b/src/lua/lmem.c
@@ -0,0 +1,202 @@
1/*
2** $Id: lmem.c $
3** Interface to Memory Manager
4** See Copyright Notice in lua.h
5*/
6
7#define lmem_c
8#define LUA_CORE
9
10#include "lprefix.h"
11
12
13#include <stddef.h>
14
15#include "lua.h"
16
17#include "ldebug.h"
18#include "ldo.h"
19#include "lgc.h"
20#include "lmem.h"
21#include "lobject.h"
22#include "lstate.h"
23
24
25#if defined(HARDMEMTESTS)
26/*
27** First allocation will fail whenever not building initial state
28** and not shrinking a block. (This fail will trigger 'tryagain' and
29** a full GC cycle at every allocation.)
30*/
31static void *firsttry (global_State *g, void *block, size_t os, size_t ns) {
32 if (ttisnil(&g->nilvalue) && ns > os)
33 return NULL; /* fail */
34 else /* normal allocation */
35 return (*g->frealloc)(g->ud, block, os, ns);
36}
37#else
38#define firsttry(g,block,os,ns) ((*g->frealloc)(g->ud, block, os, ns))
39#endif
40
41
42
43
44
45/*
46** About the realloc function:
47** void *frealloc (void *ud, void *ptr, size_t osize, size_t nsize);
48** ('osize' is the old size, 'nsize' is the new size)
49**
50** - frealloc(ud, p, x, 0) frees the block 'p' and returns NULL.
51** Particularly, frealloc(ud, NULL, 0, 0) does nothing,
52** which is equivalent to free(NULL) in ISO C.
53**
54** - frealloc(ud, NULL, x, s) creates a new block of size 's'
55** (no matter 'x'). Returns NULL if it cannot create the new block.
56**
57** - otherwise, frealloc(ud, b, x, y) reallocates the block 'b' from
58** size 'x' to size 'y'. Returns NULL if it cannot reallocate the
59** block to the new size.
60*/
61
62
63
64
65/*
66** {==================================================================
67** Functions to allocate/deallocate arrays for the Parser
68** ===================================================================
69*/
70
71/*
72** Minimum size for arrays during parsing, to avoid overhead of
73** reallocating to size 1, then 2, and then 4. All these arrays
74** will be reallocated to exact sizes or erased when parsing ends.
75*/
76#define MINSIZEARRAY 4
77
78
79void *luaM_growaux_ (lua_State *L, void *block, int nelems, int *psize,
80 int size_elems, int limit, const char *what) {
81 void *newblock;
82 int size = *psize;
83 if (nelems + 1 <= size) /* does one extra element still fit? */
84 return block; /* nothing to be done */
85 if (size >= limit / 2) { /* cannot double it? */
86 if (unlikely(size >= limit)) /* cannot grow even a little? */
87 luaG_runerror(L, "too many %s (limit is %d)", what, limit);
88 size = limit; /* still have at least one free place */
89 }
90 else {
91 size *= 2;
92 if (size < MINSIZEARRAY)
93 size = MINSIZEARRAY; /* minimum size */
94 }
95 lua_assert(nelems + 1 <= size && size <= limit);
96 /* 'limit' ensures that multiplication will not overflow */
97 newblock = luaM_saferealloc_(L, block, cast_sizet(*psize) * size_elems,
98 cast_sizet(size) * size_elems);
99 *psize = size; /* update only when everything else is OK */
100 return newblock;
101}
102
103
104/*
105** In prototypes, the size of the array is also its number of
106** elements (to save memory). So, if it cannot shrink an array
107** to its number of elements, the only option is to raise an
108** error.
109*/
110void *luaM_shrinkvector_ (lua_State *L, void *block, int *size,
111 int final_n, int size_elem) {
112 void *newblock;
113 size_t oldsize = cast_sizet((*size) * size_elem);
114 size_t newsize = cast_sizet(final_n * size_elem);
115 lua_assert(newsize <= oldsize);
116 newblock = luaM_saferealloc_(L, block, oldsize, newsize);
117 *size = final_n;
118 return newblock;
119}
120
121/* }================================================================== */
122
123
124l_noret luaM_toobig (lua_State *L) {
125 luaG_runerror(L, "memory allocation error: block too big");
126}
127
128
129/*
130** Free memory
131*/
132void luaM_free_ (lua_State *L, void *block, size_t osize) {
133 global_State *g = G(L);
134 lua_assert((osize == 0) == (block == NULL));
135 (*g->frealloc)(g->ud, block, osize, 0);
136 g->GCdebt -= osize;
137}
138
139
140/*
141** In case of allocation fail, this function will call the GC to try
142** to free some memory and then try the allocation again.
143** (It should not be called when shrinking a block, because then the
144** interpreter may be in the middle of a collection step.)
145*/
146static void *tryagain (lua_State *L, void *block,
147 size_t osize, size_t nsize) {
148 global_State *g = G(L);
149 if (ttisnil(&g->nilvalue)) { /* is state fully build? */
150 luaC_fullgc(L, 1); /* try to free some memory... */
151 return (*g->frealloc)(g->ud, block, osize, nsize); /* try again */
152 }
153 else return NULL; /* cannot free any memory without a full state */
154}
155
156
157/*
158** Generic allocation routine.
159** If allocation fails while shrinking a block, do not try again; the
160** GC shrinks some blocks and it is not reentrant.
161*/
162void *luaM_realloc_ (lua_State *L, void *block, size_t osize, size_t nsize) {
163 void *newblock;
164 global_State *g = G(L);
165 lua_assert((osize == 0) == (block == NULL));
166 newblock = firsttry(g, block, osize, nsize);
167 if (unlikely(newblock == NULL && nsize > 0)) {
168 if (nsize > osize) /* not shrinking a block? */
169 newblock = tryagain(L, block, osize, nsize);
170 if (newblock == NULL) /* still no memory? */
171 return NULL; /* do not update 'GCdebt' */
172 }
173 lua_assert((nsize == 0) == (newblock == NULL));
174 g->GCdebt = (g->GCdebt + nsize) - osize;
175 return newblock;
176}
177
178
179void *luaM_saferealloc_ (lua_State *L, void *block, size_t osize,
180 size_t nsize) {
181 void *newblock = luaM_realloc_(L, block, osize, nsize);
182 if (unlikely(newblock == NULL && nsize > 0)) /* allocation failed? */
183 luaM_error(L);
184 return newblock;
185}
186
187
188void *luaM_malloc_ (lua_State *L, size_t size, int tag) {
189 if (size == 0)
190 return NULL; /* that's all */
191 else {
192 global_State *g = G(L);
193 void *newblock = firsttry(g, NULL, tag, size);
194 if (unlikely(newblock == NULL)) {
195 newblock = tryagain(L, NULL, tag, size);
196 if (newblock == NULL)
197 luaM_error(L);
198 }
199 g->GCdebt += size;
200 return newblock;
201 }
202}
diff --git a/src/lua/lmem.h b/src/lua/lmem.h
new file mode 100644
index 0000000..8c75a44
--- /dev/null
+++ b/src/lua/lmem.h
@@ -0,0 +1,93 @@
1/*
2** $Id: lmem.h $
3** Interface to Memory Manager
4** See Copyright Notice in lua.h
5*/
6
7#ifndef lmem_h
8#define lmem_h
9
10
11#include <stddef.h>
12
13#include "llimits.h"
14#include "lua.h"
15
16
17#define luaM_error(L) luaD_throw(L, LUA_ERRMEM)
18
19
20/*
21** This macro tests whether it is safe to multiply 'n' by the size of
22** type 't' without overflows. Because 'e' is always constant, it avoids
23** the runtime division MAX_SIZET/(e).
24** (The macro is somewhat complex to avoid warnings: The 'sizeof'
25** comparison avoids a runtime comparison when overflow cannot occur.
26** The compiler should be able to optimize the real test by itself, but
27** when it does it, it may give a warning about "comparison is always
28** false due to limited range of data type"; the +1 tricks the compiler,
29** avoiding this warning but also this optimization.)
30*/
31#define luaM_testsize(n,e) \
32 (sizeof(n) >= sizeof(size_t) && cast_sizet((n)) + 1 > MAX_SIZET/(e))
33
34#define luaM_checksize(L,n,e) \
35 (luaM_testsize(n,e) ? luaM_toobig(L) : cast_void(0))
36
37
38/*
39** Computes the minimum between 'n' and 'MAX_SIZET/sizeof(t)', so that
40** the result is not larger than 'n' and cannot overflow a 'size_t'
41** when multiplied by the size of type 't'. (Assumes that 'n' is an
42** 'int' or 'unsigned int' and that 'int' is not larger than 'size_t'.)
43*/
44#define luaM_limitN(n,t) \
45 ((cast_sizet(n) <= MAX_SIZET/sizeof(t)) ? (n) : \
46 cast_uint((MAX_SIZET/sizeof(t))))
47
48
49/*
50** Arrays of chars do not need any test
51*/
52#define luaM_reallocvchar(L,b,on,n) \
53 cast_charp(luaM_saferealloc_(L, (b), (on)*sizeof(char), (n)*sizeof(char)))
54
55#define luaM_freemem(L, b, s) luaM_free_(L, (b), (s))
56#define luaM_free(L, b) luaM_free_(L, (b), sizeof(*(b)))
57#define luaM_freearray(L, b, n) luaM_free_(L, (b), (n)*sizeof(*(b)))
58
59#define luaM_new(L,t) cast(t*, luaM_malloc_(L, sizeof(t), 0))
60#define luaM_newvector(L,n,t) cast(t*, luaM_malloc_(L, (n)*sizeof(t), 0))
61#define luaM_newvectorchecked(L,n,t) \
62 (luaM_checksize(L,n,sizeof(t)), luaM_newvector(L,n,t))
63
64#define luaM_newobject(L,tag,s) luaM_malloc_(L, (s), tag)
65
66#define luaM_growvector(L,v,nelems,size,t,limit,e) \
67 ((v)=cast(t *, luaM_growaux_(L,v,nelems,&(size),sizeof(t), \
68 luaM_limitN(limit,t),e)))
69
70#define luaM_reallocvector(L, v,oldn,n,t) \
71 (cast(t *, luaM_realloc_(L, v, cast_sizet(oldn) * sizeof(t), \
72 cast_sizet(n) * sizeof(t))))
73
74#define luaM_shrinkvector(L,v,size,fs,t) \
75 ((v)=cast(t *, luaM_shrinkvector_(L, v, &(size), fs, sizeof(t))))
76
77LUAI_FUNC l_noret luaM_toobig (lua_State *L);
78
79/* not to be called directly */
80LUAI_FUNC void *luaM_realloc_ (lua_State *L, void *block, size_t oldsize,
81 size_t size);
82LUAI_FUNC void *luaM_saferealloc_ (lua_State *L, void *block, size_t oldsize,
83 size_t size);
84LUAI_FUNC void luaM_free_ (lua_State *L, void *block, size_t osize);
85LUAI_FUNC void *luaM_growaux_ (lua_State *L, void *block, int nelems,
86 int *size, int size_elem, int limit,
87 const char *what);
88LUAI_FUNC void *luaM_shrinkvector_ (lua_State *L, void *block, int *nelem,
89 int final_n, int size_elem);
90LUAI_FUNC void *luaM_malloc_ (lua_State *L, size_t size, int tag);
91
92#endif
93
diff --git a/src/lua/loadlib.c b/src/lua/loadlib.c
new file mode 100644
index 0000000..c0ec9a1
--- /dev/null
+++ b/src/lua/loadlib.c
@@ -0,0 +1,759 @@
1/*
2** $Id: loadlib.c $
3** Dynamic library loader for Lua
4** See Copyright Notice in lua.h
5**
6** This module contains an implementation of loadlib for Unix systems
7** that have dlfcn, an implementation for Windows, and a stub for other
8** systems.
9*/
10
11#define loadlib_c
12#define LUA_LIB
13
14#include "lprefix.h"
15
16
17#include <stdio.h>
18#include <stdlib.h>
19#include <string.h>
20
21#include "lua.h"
22
23#include "lauxlib.h"
24#include "lualib.h"
25
26
27/*
28** LUA_IGMARK is a mark to ignore all before it when building the
29** luaopen_ function name.
30*/
31#if !defined (LUA_IGMARK)
32#define LUA_IGMARK "-"
33#endif
34
35
36/*
37** LUA_CSUBSEP is the character that replaces dots in submodule names
38** when searching for a C loader.
39** LUA_LSUBSEP is the character that replaces dots in submodule names
40** when searching for a Lua loader.
41*/
42#if !defined(LUA_CSUBSEP)
43#define LUA_CSUBSEP LUA_DIRSEP
44#endif
45
46#if !defined(LUA_LSUBSEP)
47#define LUA_LSUBSEP LUA_DIRSEP
48#endif
49
50
51/* prefix for open functions in C libraries */
52#define LUA_POF "luaopen_"
53
54/* separator for open functions in C libraries */
55#define LUA_OFSEP "_"
56
57
58/*
59** key for table in the registry that keeps handles
60** for all loaded C libraries
61*/
62static const char *const CLIBS = "_CLIBS";
63
64#define LIB_FAIL "open"
65
66
67#define setprogdir(L) ((void)0)
68
69
70/*
71** Special type equivalent to '(void*)' for functions in gcc
72** (to suppress warnings when converting function pointers)
73*/
74typedef void (*voidf)(void);
75
76
77/*
78** system-dependent functions
79*/
80
81/*
82** unload library 'lib'
83*/
84static void lsys_unloadlib (void *lib);
85
86/*
87** load C library in file 'path'. If 'seeglb', load with all names in
88** the library global.
89** Returns the library; in case of error, returns NULL plus an
90** error string in the stack.
91*/
92static void *lsys_load (lua_State *L, const char *path, int seeglb);
93
94/*
95** Try to find a function named 'sym' in library 'lib'.
96** Returns the function; in case of error, returns NULL plus an
97** error string in the stack.
98*/
99static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym);
100
101
102
103
104#if defined(LUA_USE_DLOPEN) /* { */
105/*
106** {========================================================================
107** This is an implementation of loadlib based on the dlfcn interface.
108** The dlfcn interface is available in Linux, SunOS, Solaris, IRIX, FreeBSD,
109** NetBSD, AIX 4.2, HPUX 11, and probably most other Unix flavors, at least
110** as an emulation layer on top of native functions.
111** =========================================================================
112*/
113
114#include <dlfcn.h>
115
116/*
117** Macro to convert pointer-to-void* to pointer-to-function. This cast
118** is undefined according to ISO C, but POSIX assumes that it works.
119** (The '__extension__' in gnu compilers is only to avoid warnings.)
120*/
121#if defined(__GNUC__)
122#define cast_func(p) (__extension__ (lua_CFunction)(p))
123#else
124#define cast_func(p) ((lua_CFunction)(p))
125#endif
126
127
128static void lsys_unloadlib (void *lib) {
129 dlclose(lib);
130}
131
132
133static void *lsys_load (lua_State *L, const char *path, int seeglb) {
134 void *lib = dlopen(path, RTLD_NOW | (seeglb ? RTLD_GLOBAL : RTLD_LOCAL));
135 if (lib == NULL) lua_pushstring(L, dlerror());
136 return lib;
137}
138
139
140static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym) {
141 lua_CFunction f = cast_func(dlsym(lib, sym));
142 if (f == NULL) lua_pushstring(L, dlerror());
143 return f;
144}
145
146/* }====================================================== */
147
148
149
150#elif defined(LUA_DL_DLL) /* }{ */
151/*
152** {======================================================================
153** This is an implementation of loadlib for Windows using native functions.
154** =======================================================================
155*/
156
157#include <windows.h>
158
159
160/*
161** optional flags for LoadLibraryEx
162*/
163#if !defined(LUA_LLE_FLAGS)
164#define LUA_LLE_FLAGS 0
165#endif
166
167
168#undef setprogdir
169
170
171/*
172** Replace in the path (on the top of the stack) any occurrence
173** of LUA_EXEC_DIR with the executable's path.
174*/
175static void setprogdir (lua_State *L) {
176 char buff[MAX_PATH + 1];
177 char *lb;
178 DWORD nsize = sizeof(buff)/sizeof(char);
179 DWORD n = GetModuleFileNameA(NULL, buff, nsize); /* get exec. name */
180 if (n == 0 || n == nsize || (lb = strrchr(buff, '\\')) == NULL)
181 luaL_error(L, "unable to get ModuleFileName");
182 else {
183 *lb = '\0'; /* cut name on the last '\\' to get the path */
184 luaL_gsub(L, lua_tostring(L, -1), LUA_EXEC_DIR, buff);
185 lua_remove(L, -2); /* remove original string */
186 }
187}
188
189
190
191
192static void pusherror (lua_State *L) {
193 int error = GetLastError();
194 char buffer[128];
195 if (FormatMessageA(FORMAT_MESSAGE_IGNORE_INSERTS | FORMAT_MESSAGE_FROM_SYSTEM,
196 NULL, error, 0, buffer, sizeof(buffer)/sizeof(char), NULL))
197 lua_pushstring(L, buffer);
198 else
199 lua_pushfstring(L, "system error %d\n", error);
200}
201
202static void lsys_unloadlib (void *lib) {
203 FreeLibrary((HMODULE)lib);
204}
205
206
207static void *lsys_load (lua_State *L, const char *path, int seeglb) {
208 HMODULE lib = LoadLibraryExA(path, NULL, LUA_LLE_FLAGS);
209 (void)(seeglb); /* not used: symbols are 'global' by default */
210 if (lib == NULL) pusherror(L);
211 return lib;
212}
213
214
215static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym) {
216 lua_CFunction f = (lua_CFunction)(voidf)GetProcAddress((HMODULE)lib, sym);
217 if (f == NULL) pusherror(L);
218 return f;
219}
220
221/* }====================================================== */
222
223
224#else /* }{ */
225/*
226** {======================================================
227** Fallback for other systems
228** =======================================================
229*/
230
231#undef LIB_FAIL
232#define LIB_FAIL "absent"
233
234
235#define DLMSG "dynamic libraries not enabled; check your Lua installation"
236
237
238static void lsys_unloadlib (void *lib) {
239 (void)(lib); /* not used */
240}
241
242
243static void *lsys_load (lua_State *L, const char *path, int seeglb) {
244 (void)(path); (void)(seeglb); /* not used */
245 lua_pushliteral(L, DLMSG);
246 return NULL;
247}
248
249
250static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym) {
251 (void)(lib); (void)(sym); /* not used */
252 lua_pushliteral(L, DLMSG);
253 return NULL;
254}
255
256/* }====================================================== */
257#endif /* } */
258
259
260/*
261** {==================================================================
262** Set Paths
263** ===================================================================
264*/
265
266/*
267** LUA_PATH_VAR and LUA_CPATH_VAR are the names of the environment
268** variables that Lua check to set its paths.
269*/
270#if !defined(LUA_PATH_VAR)
271#define LUA_PATH_VAR "LUA_PATH"
272#endif
273
274#if !defined(LUA_CPATH_VAR)
275#define LUA_CPATH_VAR "LUA_CPATH"
276#endif
277
278
279
280/*
281** return registry.LUA_NOENV as a boolean
282*/
283static int noenv (lua_State *L) {
284 int b;
285 lua_getfield(L, LUA_REGISTRYINDEX, "LUA_NOENV");
286 b = lua_toboolean(L, -1);
287 lua_pop(L, 1); /* remove value */
288 return b;
289}
290
291
292/*
293** Set a path
294*/
295static void setpath (lua_State *L, const char *fieldname,
296 const char *envname,
297 const char *dft) {
298 const char *dftmark;
299 const char *nver = lua_pushfstring(L, "%s%s", envname, LUA_VERSUFFIX);
300 const char *path = getenv(nver); /* try versioned name */
301 if (path == NULL) /* no versioned environment variable? */
302 path = getenv(envname); /* try unversioned name */
303 if (path == NULL || noenv(L)) /* no environment variable? */
304 lua_pushstring(L, dft); /* use default */
305 else if ((dftmark = strstr(path, LUA_PATH_SEP LUA_PATH_SEP)) == NULL)
306 lua_pushstring(L, path); /* nothing to change */
307 else { /* path contains a ";;": insert default path in its place */
308 size_t len = strlen(path);
309 luaL_Buffer b;
310 luaL_buffinit(L, &b);
311 if (path < dftmark) { /* is there a prefix before ';;'? */
312 luaL_addlstring(&b, path, dftmark - path); /* add it */
313 luaL_addchar(&b, *LUA_PATH_SEP);
314 }
315 luaL_addstring(&b, dft); /* add default */
316 if (dftmark < path + len - 2) { /* is there a suffix after ';;'? */
317 luaL_addchar(&b, *LUA_PATH_SEP);
318 luaL_addlstring(&b, dftmark + 2, (path + len - 2) - dftmark);
319 }
320 luaL_pushresult(&b);
321 }
322 setprogdir(L);
323 lua_setfield(L, -3, fieldname); /* package[fieldname] = path value */
324 lua_pop(L, 1); /* pop versioned variable name ('nver') */
325}
326
327/* }================================================================== */
328
329
330/*
331** return registry.CLIBS[path]
332*/
333static void *checkclib (lua_State *L, const char *path) {
334 void *plib;
335 lua_getfield(L, LUA_REGISTRYINDEX, CLIBS);
336 lua_getfield(L, -1, path);
337 plib = lua_touserdata(L, -1); /* plib = CLIBS[path] */
338 lua_pop(L, 2); /* pop CLIBS table and 'plib' */
339 return plib;
340}
341
342
343/*
344** registry.CLIBS[path] = plib -- for queries
345** registry.CLIBS[#CLIBS + 1] = plib -- also keep a list of all libraries
346*/
347static void addtoclib (lua_State *L, const char *path, void *plib) {
348 lua_getfield(L, LUA_REGISTRYINDEX, CLIBS);
349 lua_pushlightuserdata(L, plib);
350 lua_pushvalue(L, -1);
351 lua_setfield(L, -3, path); /* CLIBS[path] = plib */
352 lua_rawseti(L, -2, luaL_len(L, -2) + 1); /* CLIBS[#CLIBS + 1] = plib */
353 lua_pop(L, 1); /* pop CLIBS table */
354}
355
356
357/*
358** __gc tag method for CLIBS table: calls 'lsys_unloadlib' for all lib
359** handles in list CLIBS
360*/
361static int gctm (lua_State *L) {
362 lua_Integer n = luaL_len(L, 1);
363 for (; n >= 1; n--) { /* for each handle, in reverse order */
364 lua_rawgeti(L, 1, n); /* get handle CLIBS[n] */
365 lsys_unloadlib(lua_touserdata(L, -1));
366 lua_pop(L, 1); /* pop handle */
367 }
368 return 0;
369}
370
371
372
373/* error codes for 'lookforfunc' */
374#define ERRLIB 1
375#define ERRFUNC 2
376
377/*
378** Look for a C function named 'sym' in a dynamically loaded library
379** 'path'.
380** First, check whether the library is already loaded; if not, try
381** to load it.
382** Then, if 'sym' is '*', return true (as library has been loaded).
383** Otherwise, look for symbol 'sym' in the library and push a
384** C function with that symbol.
385** Return 0 and 'true' or a function in the stack; in case of
386** errors, return an error code and an error message in the stack.
387*/
388static int lookforfunc (lua_State *L, const char *path, const char *sym) {
389 void *reg = checkclib(L, path); /* check loaded C libraries */
390 if (reg == NULL) { /* must load library? */
391 reg = lsys_load(L, path, *sym == '*'); /* global symbols if 'sym'=='*' */
392 if (reg == NULL) return ERRLIB; /* unable to load library */
393 addtoclib(L, path, reg);
394 }
395 if (*sym == '*') { /* loading only library (no function)? */
396 lua_pushboolean(L, 1); /* return 'true' */
397 return 0; /* no errors */
398 }
399 else {
400 lua_CFunction f = lsys_sym(L, reg, sym);
401 if (f == NULL)
402 return ERRFUNC; /* unable to find function */
403 lua_pushcfunction(L, f); /* else create new function */
404 return 0; /* no errors */
405 }
406}
407
408
409static int ll_loadlib (lua_State *L) {
410 const char *path = luaL_checkstring(L, 1);
411 const char *init = luaL_checkstring(L, 2);
412 int stat = lookforfunc(L, path, init);
413 if (stat == 0) /* no errors? */
414 return 1; /* return the loaded function */
415 else { /* error; error message is on stack top */
416 luaL_pushfail(L);
417 lua_insert(L, -2);
418 lua_pushstring(L, (stat == ERRLIB) ? LIB_FAIL : "init");
419 return 3; /* return fail, error message, and where */
420 }
421}
422
423
424
425/*
426** {======================================================
427** 'require' function
428** =======================================================
429*/
430
431
432static int readable (const char *filename) {
433 FILE *f = fopen(filename, "r"); /* try to open file */
434 if (f == NULL) return 0; /* open failed */
435 fclose(f);
436 return 1;
437}
438
439
440/*
441** Get the next name in '*path' = 'name1;name2;name3;...', changing
442** the ending ';' to '\0' to create a zero-terminated string. Return
443** NULL when list ends.
444*/
445static const char *getnextfilename (char **path, char *end) {
446 char *sep;
447 char *name = *path;
448 if (name == end)
449 return NULL; /* no more names */
450 else if (*name == '\0') { /* from previous iteration? */
451 *name = *LUA_PATH_SEP; /* restore separator */
452 name++; /* skip it */
453 }
454 sep = strchr(name, *LUA_PATH_SEP); /* find next separator */
455 if (sep == NULL) /* separator not found? */
456 sep = end; /* name goes until the end */
457 *sep = '\0'; /* finish file name */
458 *path = sep; /* will start next search from here */
459 return name;
460}
461
462
463/*
464** Given a path such as ";blabla.so;blublu.so", pushes the string
465**
466** no file 'blabla.so'
467** no file 'blublu.so'
468*/
469static void pusherrornotfound (lua_State *L, const char *path) {
470 luaL_Buffer b;
471 luaL_buffinit(L, &b);
472 luaL_addstring(&b, "no file '");
473 luaL_addgsub(&b, path, LUA_PATH_SEP, "'\n\tno file '");
474 luaL_addstring(&b, "'");
475 luaL_pushresult(&b);
476}
477
478
479static const char *searchpath (lua_State *L, const char *name,
480 const char *path,
481 const char *sep,
482 const char *dirsep) {
483 luaL_Buffer buff;
484 char *pathname; /* path with name inserted */
485 char *endpathname; /* its end */
486 const char *filename;
487 /* separator is non-empty and appears in 'name'? */
488 if (*sep != '\0' && strchr(name, *sep) != NULL)
489 name = luaL_gsub(L, name, sep, dirsep); /* replace it by 'dirsep' */
490 luaL_buffinit(L, &buff);
491 /* add path to the buffer, replacing marks ('?') with the file name */
492 luaL_addgsub(&buff, path, LUA_PATH_MARK, name);
493 luaL_addchar(&buff, '\0');
494 pathname = luaL_buffaddr(&buff); /* writable list of file names */
495 endpathname = pathname + luaL_bufflen(&buff) - 1;
496 while ((filename = getnextfilename(&pathname, endpathname)) != NULL) {
497 if (readable(filename)) /* does file exist and is readable? */
498 return lua_pushstring(L, filename); /* save and return name */
499 }
500 luaL_pushresult(&buff); /* push path to create error message */
501 pusherrornotfound(L, lua_tostring(L, -1)); /* create error message */
502 return NULL; /* not found */
503}
504
505
506static int ll_searchpath (lua_State *L) {
507 const char *f = searchpath(L, luaL_checkstring(L, 1),
508 luaL_checkstring(L, 2),
509 luaL_optstring(L, 3, "."),
510 luaL_optstring(L, 4, LUA_DIRSEP));
511 if (f != NULL) return 1;
512 else { /* error message is on top of the stack */
513 luaL_pushfail(L);
514 lua_insert(L, -2);
515 return 2; /* return fail + error message */
516 }
517}
518
519
520static const char *findfile (lua_State *L, const char *name,
521 const char *pname,
522 const char *dirsep) {
523 const char *path;
524 lua_getfield(L, lua_upvalueindex(1), pname);
525 path = lua_tostring(L, -1);
526 if (path == NULL)
527 luaL_error(L, "'package.%s' must be a string", pname);
528 return searchpath(L, name, path, ".", dirsep);
529}
530
531
532static int checkload (lua_State *L, int stat, const char *filename) {
533 if (stat) { /* module loaded successfully? */
534 lua_pushstring(L, filename); /* will be 2nd argument to module */
535 return 2; /* return open function and file name */
536 }
537 else
538 return luaL_error(L, "error loading module '%s' from file '%s':\n\t%s",
539 lua_tostring(L, 1), filename, lua_tostring(L, -1));
540}
541
542
543static int searcher_Lua (lua_State *L) {
544 const char *filename;
545 const char *name = luaL_checkstring(L, 1);
546 filename = findfile(L, name, "path", LUA_LSUBSEP);
547 if (filename == NULL) return 1; /* module not found in this path */
548 return checkload(L, (luaL_loadfile(L, filename) == LUA_OK), filename);
549}
550
551
552/*
553** Try to find a load function for module 'modname' at file 'filename'.
554** First, change '.' to '_' in 'modname'; then, if 'modname' has
555** the form X-Y (that is, it has an "ignore mark"), build a function
556** name "luaopen_X" and look for it. (For compatibility, if that
557** fails, it also tries "luaopen_Y".) If there is no ignore mark,
558** look for a function named "luaopen_modname".
559*/
560static int loadfunc (lua_State *L, const char *filename, const char *modname) {
561 const char *openfunc;
562 const char *mark;
563 modname = luaL_gsub(L, modname, ".", LUA_OFSEP);
564 mark = strchr(modname, *LUA_IGMARK);
565 if (mark) {
566 int stat;
567 openfunc = lua_pushlstring(L, modname, mark - modname);
568 openfunc = lua_pushfstring(L, LUA_POF"%s", openfunc);
569 stat = lookforfunc(L, filename, openfunc);
570 if (stat != ERRFUNC) return stat;
571 modname = mark + 1; /* else go ahead and try old-style name */
572 }
573 openfunc = lua_pushfstring(L, LUA_POF"%s", modname);
574 return lookforfunc(L, filename, openfunc);
575}
576
577
578static int searcher_C (lua_State *L) {
579 const char *name = luaL_checkstring(L, 1);
580 const char *filename = findfile(L, name, "cpath", LUA_CSUBSEP);
581 if (filename == NULL) return 1; /* module not found in this path */
582 return checkload(L, (loadfunc(L, filename, name) == 0), filename);
583}
584
585
586static int searcher_Croot (lua_State *L) {
587 const char *filename;
588 const char *name = luaL_checkstring(L, 1);
589 const char *p = strchr(name, '.');
590 int stat;
591 if (p == NULL) return 0; /* is root */
592 lua_pushlstring(L, name, p - name);
593 filename = findfile(L, lua_tostring(L, -1), "cpath", LUA_CSUBSEP);
594 if (filename == NULL) return 1; /* root not found */
595 if ((stat = loadfunc(L, filename, name)) != 0) {
596 if (stat != ERRFUNC)
597 return checkload(L, 0, filename); /* real error */
598 else { /* open function not found */
599 lua_pushfstring(L, "no module '%s' in file '%s'", name, filename);
600 return 1;
601 }
602 }
603 lua_pushstring(L, filename); /* will be 2nd argument to module */
604 return 2;
605}
606
607
608static int searcher_preload (lua_State *L) {
609 const char *name = luaL_checkstring(L, 1);
610 lua_getfield(L, LUA_REGISTRYINDEX, LUA_PRELOAD_TABLE);
611 if (lua_getfield(L, -1, name) == LUA_TNIL) { /* not found? */
612 lua_pushfstring(L, "no field package.preload['%s']", name);
613 return 1;
614 }
615 else {
616 lua_pushliteral(L, ":preload:");
617 return 2;
618 }
619}
620
621
622static void findloader (lua_State *L, const char *name) {
623 int i;
624 luaL_Buffer msg; /* to build error message */
625 /* push 'package.searchers' to index 3 in the stack */
626 if (lua_getfield(L, lua_upvalueindex(1), "searchers") != LUA_TTABLE)
627 luaL_error(L, "'package.searchers' must be a table");
628 luaL_buffinit(L, &msg);
629 /* iterate over available searchers to find a loader */
630 for (i = 1; ; i++) {
631 luaL_addstring(&msg, "\n\t"); /* error-message prefix */
632 if (lua_rawgeti(L, 3, i) == LUA_TNIL) { /* no more searchers? */
633 lua_pop(L, 1); /* remove nil */
634 luaL_buffsub(&msg, 2); /* remove prefix */
635 luaL_pushresult(&msg); /* create error message */
636 luaL_error(L, "module '%s' not found:%s", name, lua_tostring(L, -1));
637 }
638 lua_pushstring(L, name);
639 lua_call(L, 1, 2); /* call it */
640 if (lua_isfunction(L, -2)) /* did it find a loader? */
641 return; /* module loader found */
642 else if (lua_isstring(L, -2)) { /* searcher returned error message? */
643 lua_pop(L, 1); /* remove extra return */
644 luaL_addvalue(&msg); /* concatenate error message */
645 }
646 else { /* no error message */
647 lua_pop(L, 2); /* remove both returns */
648 luaL_buffsub(&msg, 2); /* remove prefix */
649 }
650 }
651}
652
653
654static int ll_require (lua_State *L) {
655 const char *name = luaL_checkstring(L, 1);
656 lua_settop(L, 1); /* LOADED table will be at index 2 */
657 lua_getfield(L, LUA_REGISTRYINDEX, LUA_LOADED_TABLE);
658 lua_getfield(L, 2, name); /* LOADED[name] */
659 if (lua_toboolean(L, -1)) /* is it there? */
660 return 1; /* package is already loaded */
661 /* else must load package */
662 lua_pop(L, 1); /* remove 'getfield' result */
663 findloader(L, name);
664 lua_rotate(L, -2, 1); /* function <-> loader data */
665 lua_pushvalue(L, 1); /* name is 1st argument to module loader */
666 lua_pushvalue(L, -3); /* loader data is 2nd argument */
667 /* stack: ...; loader data; loader function; mod. name; loader data */
668 lua_call(L, 2, 1); /* run loader to load module */
669 /* stack: ...; loader data; result from loader */
670 if (!lua_isnil(L, -1)) /* non-nil return? */
671 lua_setfield(L, 2, name); /* LOADED[name] = returned value */
672 else
673 lua_pop(L, 1); /* pop nil */
674 if (lua_getfield(L, 2, name) == LUA_TNIL) { /* module set no value? */
675 lua_pushboolean(L, 1); /* use true as result */
676 lua_copy(L, -1, -2); /* replace loader result */
677 lua_setfield(L, 2, name); /* LOADED[name] = true */
678 }
679 lua_rotate(L, -2, 1); /* loader data <-> module result */
680 return 2; /* return module result and loader data */
681}
682
683/* }====================================================== */
684
685
686
687
688static const luaL_Reg pk_funcs[] = {
689 {"loadlib", ll_loadlib},
690 {"searchpath", ll_searchpath},
691 /* placeholders */
692 {"preload", NULL},
693 {"cpath", NULL},
694 {"path", NULL},
695 {"searchers", NULL},
696 {"loaded", NULL},
697 {NULL, NULL}
698};
699
700
701static const luaL_Reg ll_funcs[] = {
702 {"require", ll_require},
703 {NULL, NULL}
704};
705
706
707static void createsearcherstable (lua_State *L) {
708 static const lua_CFunction searchers[] =
709 {searcher_preload, searcher_Lua, searcher_C, searcher_Croot, NULL};
710 int i;
711 /* create 'searchers' table */
712 lua_createtable(L, sizeof(searchers)/sizeof(searchers[0]) - 1, 0);
713 /* fill it with predefined searchers */
714 for (i=0; searchers[i] != NULL; i++) {
715 lua_pushvalue(L, -2); /* set 'package' as upvalue for all searchers */
716 lua_pushcclosure(L, searchers[i], 1);
717 lua_rawseti(L, -2, i+1);
718 }
719 lua_setfield(L, -2, "searchers"); /* put it in field 'searchers' */
720}
721
722
723/*
724** create table CLIBS to keep track of loaded C libraries,
725** setting a finalizer to close all libraries when closing state.
726*/
727static void createclibstable (lua_State *L) {
728 luaL_getsubtable(L, LUA_REGISTRYINDEX, CLIBS); /* create CLIBS table */
729 lua_createtable(L, 0, 1); /* create metatable for CLIBS */
730 lua_pushcfunction(L, gctm);
731 lua_setfield(L, -2, "__gc"); /* set finalizer for CLIBS table */
732 lua_setmetatable(L, -2);
733}
734
735
736LUAMOD_API int luaopen_package (lua_State *L) {
737 createclibstable(L);
738 luaL_newlib(L, pk_funcs); /* create 'package' table */
739 createsearcherstable(L);
740 /* set paths */
741 setpath(L, "path", LUA_PATH_VAR, LUA_PATH_DEFAULT);
742 setpath(L, "cpath", LUA_CPATH_VAR, LUA_CPATH_DEFAULT);
743 /* store config information */
744 lua_pushliteral(L, LUA_DIRSEP "\n" LUA_PATH_SEP "\n" LUA_PATH_MARK "\n"
745 LUA_EXEC_DIR "\n" LUA_IGMARK "\n");
746 lua_setfield(L, -2, "config");
747 /* set field 'loaded' */
748 luaL_getsubtable(L, LUA_REGISTRYINDEX, LUA_LOADED_TABLE);
749 lua_setfield(L, -2, "loaded");
750 /* set field 'preload' */
751 luaL_getsubtable(L, LUA_REGISTRYINDEX, LUA_PRELOAD_TABLE);
752 lua_setfield(L, -2, "preload");
753 lua_pushglobaltable(L);
754 lua_pushvalue(L, -2); /* set 'package' as upvalue for next lib */
755 luaL_setfuncs(L, ll_funcs, 1); /* open lib into global table */
756 lua_pop(L, 1); /* pop global table */
757 return 1; /* return 'package' table */
758}
759
diff --git a/src/lua/lobject.c b/src/lua/lobject.c
new file mode 100644
index 0000000..b4efae4
--- /dev/null
+++ b/src/lua/lobject.c
@@ -0,0 +1,583 @@
1/*
2** $Id: lobject.c $
3** Some generic functions over Lua objects
4** See Copyright Notice in lua.h
5*/
6
7#define lobject_c
8#define LUA_CORE
9
10#include "lprefix.h"
11
12
13#include <locale.h>
14#include <math.h>
15#include <stdarg.h>
16#include <stdio.h>
17#include <stdlib.h>
18#include <string.h>
19
20#include "lua.h"
21
22#include "lctype.h"
23#include "ldebug.h"
24#include "ldo.h"
25#include "lmem.h"
26#include "lobject.h"
27#include "lstate.h"
28#include "lstring.h"
29#include "lvm.h"
30
31
32/*
33** Computes ceil(log2(x))
34*/
35int luaO_ceillog2 (unsigned int x) {
36 static const lu_byte log_2[256] = { /* log_2[i] = ceil(log2(i - 1)) */
37 0,1,2,2,3,3,3,3,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,
38 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,
39 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
40 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
41 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,
42 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,
43 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,
44 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8
45 };
46 int l = 0;
47 x--;
48 while (x >= 256) { l += 8; x >>= 8; }
49 return l + log_2[x];
50}
51
52
53static lua_Integer intarith (lua_State *L, int op, lua_Integer v1,
54 lua_Integer v2) {
55 switch (op) {
56 case LUA_OPADD: return intop(+, v1, v2);
57 case LUA_OPSUB:return intop(-, v1, v2);
58 case LUA_OPMUL:return intop(*, v1, v2);
59 case LUA_OPMOD: return luaV_mod(L, v1, v2);
60 case LUA_OPIDIV: return luaV_idiv(L, v1, v2);
61 case LUA_OPBAND: return intop(&, v1, v2);
62 case LUA_OPBOR: return intop(|, v1, v2);
63 case LUA_OPBXOR: return intop(^, v1, v2);
64 case LUA_OPSHL: return luaV_shiftl(v1, v2);
65 case LUA_OPSHR: return luaV_shiftl(v1, -v2);
66 case LUA_OPUNM: return intop(-, 0, v1);
67 case LUA_OPBNOT: return intop(^, ~l_castS2U(0), v1);
68 default: lua_assert(0); return 0;
69 }
70}
71
72
73static lua_Number numarith (lua_State *L, int op, lua_Number v1,
74 lua_Number v2) {
75 switch (op) {
76 case LUA_OPADD: return luai_numadd(L, v1, v2);
77 case LUA_OPSUB: return luai_numsub(L, v1, v2);
78 case LUA_OPMUL: return luai_nummul(L, v1, v2);
79 case LUA_OPDIV: return luai_numdiv(L, v1, v2);
80 case LUA_OPPOW: return luai_numpow(L, v1, v2);
81 case LUA_OPIDIV: return luai_numidiv(L, v1, v2);
82 case LUA_OPUNM: return luai_numunm(L, v1);
83 case LUA_OPMOD: return luaV_modf(L, v1, v2);
84 default: lua_assert(0); return 0;
85 }
86}
87
88
89int luaO_rawarith (lua_State *L, int op, const TValue *p1, const TValue *p2,
90 TValue *res) {
91 switch (op) {
92 case LUA_OPBAND: case LUA_OPBOR: case LUA_OPBXOR:
93 case LUA_OPSHL: case LUA_OPSHR:
94 case LUA_OPBNOT: { /* operate only on integers */
95 lua_Integer i1; lua_Integer i2;
96 if (tointegerns(p1, &i1) && tointegerns(p2, &i2)) {
97 setivalue(res, intarith(L, op, i1, i2));
98 return 1;
99 }
100 else return 0; /* fail */
101 }
102 case LUA_OPDIV: case LUA_OPPOW: { /* operate only on floats */
103 lua_Number n1; lua_Number n2;
104 if (tonumberns(p1, n1) && tonumberns(p2, n2)) {
105 setfltvalue(res, numarith(L, op, n1, n2));
106 return 1;
107 }
108 else return 0; /* fail */
109 }
110 default: { /* other operations */
111 lua_Number n1; lua_Number n2;
112 if (ttisinteger(p1) && ttisinteger(p2)) {
113 setivalue(res, intarith(L, op, ivalue(p1), ivalue(p2)));
114 return 1;
115 }
116 else if (tonumberns(p1, n1) && tonumberns(p2, n2)) {
117 setfltvalue(res, numarith(L, op, n1, n2));
118 return 1;
119 }
120 else return 0; /* fail */
121 }
122 }
123}
124
125
126void luaO_arith (lua_State *L, int op, const TValue *p1, const TValue *p2,
127 StkId res) {
128 if (!luaO_rawarith(L, op, p1, p2, s2v(res))) {
129 /* could not perform raw operation; try metamethod */
130 luaT_trybinTM(L, p1, p2, res, cast(TMS, (op - LUA_OPADD) + TM_ADD));
131 }
132}
133
134
135int luaO_hexavalue (int c) {
136 if (lisdigit(c)) return c - '0';
137 else return (ltolower(c) - 'a') + 10;
138}
139
140
141static int isneg (const char **s) {
142 if (**s == '-') { (*s)++; return 1; }
143 else if (**s == '+') (*s)++;
144 return 0;
145}
146
147
148
149/*
150** {==================================================================
151** Lua's implementation for 'lua_strx2number'
152** ===================================================================
153*/
154
155#if !defined(lua_strx2number)
156
157/* maximum number of significant digits to read (to avoid overflows
158 even with single floats) */
159#define MAXSIGDIG 30
160
161/*
162** convert a hexadecimal numeric string to a number, following
163** C99 specification for 'strtod'
164*/
165static lua_Number lua_strx2number (const char *s, char **endptr) {
166 int dot = lua_getlocaledecpoint();
167 lua_Number r = 0.0; /* result (accumulator) */
168 int sigdig = 0; /* number of significant digits */
169 int nosigdig = 0; /* number of non-significant digits */
170 int e = 0; /* exponent correction */
171 int neg; /* 1 if number is negative */
172 int hasdot = 0; /* true after seen a dot */
173 *endptr = cast_charp(s); /* nothing is valid yet */
174 while (lisspace(cast_uchar(*s))) s++; /* skip initial spaces */
175 neg = isneg(&s); /* check sign */
176 if (!(*s == '0' && (*(s + 1) == 'x' || *(s + 1) == 'X'))) /* check '0x' */
177 return 0.0; /* invalid format (no '0x') */
178 for (s += 2; ; s++) { /* skip '0x' and read numeral */
179 if (*s == dot) {
180 if (hasdot) break; /* second dot? stop loop */
181 else hasdot = 1;
182 }
183 else if (lisxdigit(cast_uchar(*s))) {
184 if (sigdig == 0 && *s == '0') /* non-significant digit (zero)? */
185 nosigdig++;
186 else if (++sigdig <= MAXSIGDIG) /* can read it without overflow? */
187 r = (r * cast_num(16.0)) + luaO_hexavalue(*s);
188 else e++; /* too many digits; ignore, but still count for exponent */
189 if (hasdot) e--; /* decimal digit? correct exponent */
190 }
191 else break; /* neither a dot nor a digit */
192 }
193 if (nosigdig + sigdig == 0) /* no digits? */
194 return 0.0; /* invalid format */
195 *endptr = cast_charp(s); /* valid up to here */
196 e *= 4; /* each digit multiplies/divides value by 2^4 */
197 if (*s == 'p' || *s == 'P') { /* exponent part? */
198 int exp1 = 0; /* exponent value */
199 int neg1; /* exponent sign */
200 s++; /* skip 'p' */
201 neg1 = isneg(&s); /* sign */
202 if (!lisdigit(cast_uchar(*s)))
203 return 0.0; /* invalid; must have at least one digit */
204 while (lisdigit(cast_uchar(*s))) /* read exponent */
205 exp1 = exp1 * 10 + *(s++) - '0';
206 if (neg1) exp1 = -exp1;
207 e += exp1;
208 *endptr = cast_charp(s); /* valid up to here */
209 }
210 if (neg) r = -r;
211 return l_mathop(ldexp)(r, e);
212}
213
214#endif
215/* }====================================================== */
216
217
218/* maximum length of a numeral */
219#if !defined (L_MAXLENNUM)
220#define L_MAXLENNUM 200
221#endif
222
223static const char *l_str2dloc (const char *s, lua_Number *result, int mode) {
224 char *endptr;
225 *result = (mode == 'x') ? lua_strx2number(s, &endptr) /* try to convert */
226 : lua_str2number(s, &endptr);
227 if (endptr == s) return NULL; /* nothing recognized? */
228 while (lisspace(cast_uchar(*endptr))) endptr++; /* skip trailing spaces */
229 return (*endptr == '\0') ? endptr : NULL; /* OK if no trailing characters */
230}
231
232
233/*
234** Convert string 's' to a Lua number (put in 'result'). Return NULL
235** on fail or the address of the ending '\0' on success.
236** 'pmode' points to (and 'mode' contains) special things in the string:
237** - 'x'/'X' means a hexadecimal numeral
238** - 'n'/'N' means 'inf' or 'nan' (which should be rejected)
239** - '.' just optimizes the search for the common case (nothing special)
240** This function accepts both the current locale or a dot as the radix
241** mark. If the conversion fails, it may mean number has a dot but
242** locale accepts something else. In that case, the code copies 's'
243** to a buffer (because 's' is read-only), changes the dot to the
244** current locale radix mark, and tries to convert again.
245*/
246static const char *l_str2d (const char *s, lua_Number *result) {
247 const char *endptr;
248 const char *pmode = strpbrk(s, ".xXnN");
249 int mode = pmode ? ltolower(cast_uchar(*pmode)) : 0;
250 if (mode == 'n') /* reject 'inf' and 'nan' */
251 return NULL;
252 endptr = l_str2dloc(s, result, mode); /* try to convert */
253 if (endptr == NULL) { /* failed? may be a different locale */
254 char buff[L_MAXLENNUM + 1];
255 const char *pdot = strchr(s, '.');
256 if (strlen(s) > L_MAXLENNUM || pdot == NULL)
257 return NULL; /* string too long or no dot; fail */
258 strcpy(buff, s); /* copy string to buffer */
259 buff[pdot - s] = lua_getlocaledecpoint(); /* correct decimal point */
260 endptr = l_str2dloc(buff, result, mode); /* try again */
261 if (endptr != NULL)
262 endptr = s + (endptr - buff); /* make relative to 's' */
263 }
264 return endptr;
265}
266
267
268#define MAXBY10 cast(lua_Unsigned, LUA_MAXINTEGER / 10)
269#define MAXLASTD cast_int(LUA_MAXINTEGER % 10)
270
271static const char *l_str2int (const char *s, lua_Integer *result) {
272 lua_Unsigned a = 0;
273 int empty = 1;
274 int neg;
275 while (lisspace(cast_uchar(*s))) s++; /* skip initial spaces */
276 neg = isneg(&s);
277 if (s[0] == '0' &&
278 (s[1] == 'x' || s[1] == 'X')) { /* hex? */
279 s += 2; /* skip '0x' */
280 for (; lisxdigit(cast_uchar(*s)); s++) {
281 a = a * 16 + luaO_hexavalue(*s);
282 empty = 0;
283 }
284 }
285 else { /* decimal */
286 for (; lisdigit(cast_uchar(*s)); s++) {
287 int d = *s - '0';
288 if (a >= MAXBY10 && (a > MAXBY10 || d > MAXLASTD + neg)) /* overflow? */
289 return NULL; /* do not accept it (as integer) */
290 a = a * 10 + d;
291 empty = 0;
292 }
293 }
294 while (lisspace(cast_uchar(*s))) s++; /* skip trailing spaces */
295 if (empty || *s != '\0') return NULL; /* something wrong in the numeral */
296 else {
297 *result = l_castU2S((neg) ? 0u - a : a);
298 return s;
299 }
300}
301
302
303size_t luaO_str2num (const char *s, TValue *o) {
304 lua_Integer i; lua_Number n;
305 const char *e;
306 if ((e = l_str2int(s, &i)) != NULL) { /* try as an integer */
307 setivalue(o, i);
308 }
309 else if ((e = l_str2d(s, &n)) != NULL) { /* else try as a float */
310 setfltvalue(o, n);
311 }
312 else
313 return 0; /* conversion failed */
314 return (e - s) + 1; /* success; return string size */
315}
316
317
318int luaO_utf8esc (char *buff, unsigned long x) {
319 int n = 1; /* number of bytes put in buffer (backwards) */
320 lua_assert(x <= 0x7FFFFFFFu);
321 if (x < 0x80) /* ascii? */
322 buff[UTF8BUFFSZ - 1] = cast_char(x);
323 else { /* need continuation bytes */
324 unsigned int mfb = 0x3f; /* maximum that fits in first byte */
325 do { /* add continuation bytes */
326 buff[UTF8BUFFSZ - (n++)] = cast_char(0x80 | (x & 0x3f));
327 x >>= 6; /* remove added bits */
328 mfb >>= 1; /* now there is one less bit available in first byte */
329 } while (x > mfb); /* still needs continuation byte? */
330 buff[UTF8BUFFSZ - n] = cast_char((~mfb << 1) | x); /* add first byte */
331 }
332 return n;
333}
334
335
336/* maximum length of the conversion of a number to a string */
337#define MAXNUMBER2STR 50
338
339
340/*
341** Convert a number object to a string, adding it to a buffer
342*/
343static int tostringbuff (TValue *obj, char *buff) {
344 int len;
345 lua_assert(ttisnumber(obj));
346 if (ttisinteger(obj))
347 len = lua_integer2str(buff, MAXNUMBER2STR, ivalue(obj));
348 else {
349 len = lua_number2str(buff, MAXNUMBER2STR, fltvalue(obj));
350 if (buff[strspn(buff, "-0123456789")] == '\0') { /* looks like an int? */
351 buff[len++] = lua_getlocaledecpoint();
352 buff[len++] = '0'; /* adds '.0' to result */
353 }
354 }
355 return len;
356}
357
358
359/*
360** Convert a number object to a Lua string, replacing the value at 'obj'
361*/
362void luaO_tostring (lua_State *L, TValue *obj) {
363 char buff[MAXNUMBER2STR];
364 int len = tostringbuff(obj, buff);
365 setsvalue(L, obj, luaS_newlstr(L, buff, len));
366}
367
368
369
370
371/*
372** {==================================================================
373** 'luaO_pushvfstring'
374** ===================================================================
375*/
376
377/* size for buffer space used by 'luaO_pushvfstring' */
378#define BUFVFS 400
379
380/* buffer used by 'luaO_pushvfstring' */
381typedef struct BuffFS {
382 lua_State *L;
383 int pushed; /* number of string pieces already on the stack */
384 int blen; /* length of partial string in 'space' */
385 char space[BUFVFS]; /* holds last part of the result */
386} BuffFS;
387
388
389/*
390** Push given string to the stack, as part of the buffer. If the stack
391** is almost full, join all partial strings in the stack into one.
392*/
393static void pushstr (BuffFS *buff, const char *str, size_t l) {
394 lua_State *L = buff->L;
395 setsvalue2s(L, L->top, luaS_newlstr(L, str, l));
396 L->top++; /* may use one extra slot */
397 buff->pushed++;
398 if (buff->pushed > 1 && L->top + 1 >= L->stack_last) {
399 luaV_concat(L, buff->pushed); /* join all partial results into one */
400 buff->pushed = 1;
401 }
402}
403
404
405/*
406** empty the buffer space into the stack
407*/
408static void clearbuff (BuffFS *buff) {
409 pushstr(buff, buff->space, buff->blen); /* push buffer contents */
410 buff->blen = 0; /* space now is empty */
411}
412
413
414/*
415** Get a space of size 'sz' in the buffer. If buffer has not enough
416** space, empty it. 'sz' must fit in an empty buffer.
417*/
418static char *getbuff (BuffFS *buff, int sz) {
419 lua_assert(buff->blen <= BUFVFS); lua_assert(sz <= BUFVFS);
420 if (sz > BUFVFS - buff->blen) /* not enough space? */
421 clearbuff(buff);
422 return buff->space + buff->blen;
423}
424
425
426#define addsize(b,sz) ((b)->blen += (sz))
427
428
429/*
430** Add 'str' to the buffer. If string is larger than the buffer space,
431** push the string directly to the stack.
432*/
433static void addstr2buff (BuffFS *buff, const char *str, size_t slen) {
434 if (slen <= BUFVFS) { /* does string fit into buffer? */
435 char *bf = getbuff(buff, cast_int(slen));
436 memcpy(bf, str, slen); /* add string to buffer */
437 addsize(buff, cast_int(slen));
438 }
439 else { /* string larger than buffer */
440 clearbuff(buff); /* string comes after buffer's content */
441 pushstr(buff, str, slen); /* push string */
442 }
443}
444
445
446/*
447** Add a number to the buffer.
448*/
449static void addnum2buff (BuffFS *buff, TValue *num) {
450 char *numbuff = getbuff(buff, MAXNUMBER2STR);
451 int len = tostringbuff(num, numbuff); /* format number into 'numbuff' */
452 addsize(buff, len);
453}
454
455
456/*
457** this function handles only '%d', '%c', '%f', '%p', '%s', and '%%'
458 conventional formats, plus Lua-specific '%I' and '%U'
459*/
460const char *luaO_pushvfstring (lua_State *L, const char *fmt, va_list argp) {
461 BuffFS buff; /* holds last part of the result */
462 const char *e; /* points to next '%' */
463 buff.pushed = buff.blen = 0;
464 buff.L = L;
465 while ((e = strchr(fmt, '%')) != NULL) {
466 addstr2buff(&buff, fmt, e - fmt); /* add 'fmt' up to '%' */
467 switch (*(e + 1)) { /* conversion specifier */
468 case 's': { /* zero-terminated string */
469 const char *s = va_arg(argp, char *);
470 if (s == NULL) s = "(null)";
471 addstr2buff(&buff, s, strlen(s));
472 break;
473 }
474 case 'c': { /* an 'int' as a character */
475 char c = cast_uchar(va_arg(argp, int));
476 addstr2buff(&buff, &c, sizeof(char));
477 break;
478 }
479 case 'd': { /* an 'int' */
480 TValue num;
481 setivalue(&num, va_arg(argp, int));
482 addnum2buff(&buff, &num);
483 break;
484 }
485 case 'I': { /* a 'lua_Integer' */
486 TValue num;
487 setivalue(&num, cast(lua_Integer, va_arg(argp, l_uacInt)));
488 addnum2buff(&buff, &num);
489 break;
490 }
491 case 'f': { /* a 'lua_Number' */
492 TValue num;
493 setfltvalue(&num, cast_num(va_arg(argp, l_uacNumber)));
494 addnum2buff(&buff, &num);
495 break;
496 }
497 case 'p': { /* a pointer */
498 const int sz = 3 * sizeof(void*) + 8; /* enough space for '%p' */
499 char *bf = getbuff(&buff, sz);
500 void *p = va_arg(argp, void *);
501 int len = lua_pointer2str(bf, sz, p);
502 addsize(&buff, len);
503 break;
504 }
505 case 'U': { /* a 'long' as a UTF-8 sequence */
506 char bf[UTF8BUFFSZ];
507 int len = luaO_utf8esc(bf, va_arg(argp, long));
508 addstr2buff(&buff, bf + UTF8BUFFSZ - len, len);
509 break;
510 }
511 case '%': {
512 addstr2buff(&buff, "%", 1);
513 break;
514 }
515 default: {
516 luaG_runerror(L, "invalid option '%%%c' to 'lua_pushfstring'",
517 *(e + 1));
518 }
519 }
520 fmt = e + 2; /* skip '%' and the specifier */
521 }
522 addstr2buff(&buff, fmt, strlen(fmt)); /* rest of 'fmt' */
523 clearbuff(&buff); /* empty buffer into the stack */
524 if (buff.pushed > 1)
525 luaV_concat(L, buff.pushed); /* join all partial results */
526 return svalue(s2v(L->top - 1));
527}
528
529
530const char *luaO_pushfstring (lua_State *L, const char *fmt, ...) {
531 const char *msg;
532 va_list argp;
533 va_start(argp, fmt);
534 msg = luaO_pushvfstring(L, fmt, argp);
535 va_end(argp);
536 return msg;
537}
538
539/* }================================================================== */
540
541
542#define RETS "..."
543#define PRE "[string \""
544#define POS "\"]"
545
546#define addstr(a,b,l) ( memcpy(a,b,(l) * sizeof(char)), a += (l) )
547
548void luaO_chunkid (char *out, const char *source, size_t srclen) {
549 size_t bufflen = LUA_IDSIZE; /* free space in buffer */
550 if (*source == '=') { /* 'literal' source */
551 if (srclen <= bufflen) /* small enough? */
552 memcpy(out, source + 1, srclen * sizeof(char));
553 else { /* truncate it */
554 addstr(out, source + 1, bufflen - 1);
555 *out = '\0';
556 }
557 }
558 else if (*source == '@') { /* file name */
559 if (srclen <= bufflen) /* small enough? */
560 memcpy(out, source + 1, srclen * sizeof(char));
561 else { /* add '...' before rest of name */
562 addstr(out, RETS, LL(RETS));
563 bufflen -= LL(RETS);
564 memcpy(out, source + 1 + srclen - bufflen, bufflen * sizeof(char));
565 }
566 }
567 else { /* string; format as [string "source"] */
568 const char *nl = strchr(source, '\n'); /* find first new line (if any) */
569 addstr(out, PRE, LL(PRE)); /* add prefix */
570 bufflen -= LL(PRE RETS POS) + 1; /* save space for prefix+suffix+'\0' */
571 if (srclen < bufflen && nl == NULL) { /* small one-line source? */
572 addstr(out, source, srclen); /* keep it */
573 }
574 else {
575 if (nl != NULL) srclen = nl - source; /* stop at first newline */
576 if (srclen > bufflen) srclen = bufflen;
577 addstr(out, source, srclen);
578 addstr(out, RETS, LL(RETS));
579 }
580 memcpy(out, POS, (LL(POS) + 1) * sizeof(char));
581 }
582}
583
diff --git a/src/lua/lobject.h b/src/lua/lobject.h
new file mode 100644
index 0000000..04a81d3
--- /dev/null
+++ b/src/lua/lobject.h
@@ -0,0 +1,787 @@
1/*
2** $Id: lobject.h $
3** Type definitions for Lua objects
4** See Copyright Notice in lua.h
5*/
6
7
8#ifndef lobject_h
9#define lobject_h
10
11
12#include <stdarg.h>
13
14
15#include "llimits.h"
16#include "lua.h"
17
18
19/*
20** Extra types for collectable non-values
21*/
22#define LUA_TUPVAL LUA_NUMTYPES /* upvalues */
23#define LUA_TPROTO (LUA_NUMTYPES+1) /* function prototypes */
24
25
26/*
27** number of all possible types (including LUA_TNONE)
28*/
29#define LUA_TOTALTYPES (LUA_TPROTO + 2)
30
31
32/*
33** tags for Tagged Values have the following use of bits:
34** bits 0-3: actual tag (a LUA_T* constant)
35** bits 4-5: variant bits
36** bit 6: whether value is collectable
37*/
38
39/* add variant bits to a type */
40#define makevariant(t,v) ((t) | ((v) << 4))
41
42
43
44/*
45** Union of all Lua values
46*/
47typedef union Value {
48 struct GCObject *gc; /* collectable objects */
49 void *p; /* light userdata */
50 lua_CFunction f; /* light C functions */
51 lua_Integer i; /* integer numbers */
52 lua_Number n; /* float numbers */
53} Value;
54
55
56/*
57** Tagged Values. This is the basic representation of values in Lua:
58** an actual value plus a tag with its type.
59*/
60
61#define TValuefields Value value_; lu_byte tt_
62
63typedef struct TValue {
64 TValuefields;
65} TValue;
66
67
68#define val_(o) ((o)->value_)
69#define valraw(o) (&val_(o))
70
71
72/* raw type tag of a TValue */
73#define rawtt(o) ((o)->tt_)
74
75/* tag with no variants (bits 0-3) */
76#define novariant(t) ((t) & 0x0F)
77
78/* type tag of a TValue (bits 0-3 for tags + variant bits 4-5) */
79#define withvariant(t) ((t) & 0x3F)
80#define ttypetag(o) withvariant(rawtt(o))
81
82/* type of a TValue */
83#define ttype(o) (novariant(rawtt(o)))
84
85
86/* Macros to test type */
87#define checktag(o,t) (rawtt(o) == (t))
88#define checktype(o,t) (ttype(o) == (t))
89
90
91/* Macros for internal tests */
92
93/* collectable object has the same tag as the original value */
94#define righttt(obj) (ttypetag(obj) == gcvalue(obj)->tt)
95
96/*
97** Any value being manipulated by the program either is non
98** collectable, or the collectable object has the right tag
99** and it is not dead.
100*/
101#define checkliveness(L,obj) \
102 ((void)L, lua_longassert(!iscollectable(obj) || \
103 (righttt(obj) && (L == NULL || !isdead(G(L),gcvalue(obj))))))
104
105
106/* Macros to set values */
107
108/* set a value's tag */
109#define settt_(o,t) ((o)->tt_=(t))
110
111
112/* main macro to copy values (from 'obj1' to 'obj2') */
113#define setobj(L,obj1,obj2) \
114 { TValue *io1=(obj1); const TValue *io2=(obj2); \
115 io1->value_ = io2->value_; settt_(io1, io2->tt_); \
116 checkliveness(L,io1); lua_assert(!isnonstrictnil(io1)); }
117
118/*
119** Different types of assignments, according to source and destination.
120** (They are mostly equal now, but may be different in the future.)
121*/
122
123/* from stack to stack */
124#define setobjs2s(L,o1,o2) setobj(L,s2v(o1),s2v(o2))
125/* to stack (not from same stack) */
126#define setobj2s(L,o1,o2) setobj(L,s2v(o1),o2)
127/* from table to same table */
128#define setobjt2t setobj
129/* to new object */
130#define setobj2n setobj
131/* to table */
132#define setobj2t setobj
133
134
135/*
136** Entries in the Lua stack
137*/
138typedef union StackValue {
139 TValue val;
140} StackValue;
141
142
143/* index to stack elements */
144typedef StackValue *StkId;
145
146/* convert a 'StackValue' to a 'TValue' */
147#define s2v(o) (&(o)->val)
148
149
150
151/*
152** {==================================================================
153** Nil
154** ===================================================================
155*/
156
157/* Standard nil */
158#define LUA_VNIL makevariant(LUA_TNIL, 0)
159
160/* Empty slot (which might be different from a slot containing nil) */
161#define LUA_VEMPTY makevariant(LUA_TNIL, 1)
162
163/* Value returned for a key not found in a table (absent key) */
164#define LUA_VABSTKEY makevariant(LUA_TNIL, 2)
165
166
167/* macro to test for (any kind of) nil */
168#define ttisnil(v) checktype((v), LUA_TNIL)
169
170
171/* macro to test for a standard nil */
172#define ttisstrictnil(o) checktag((o), LUA_VNIL)
173
174
175#define setnilvalue(obj) settt_(obj, LUA_VNIL)
176
177
178#define isabstkey(v) checktag((v), LUA_VABSTKEY)
179
180
181/*
182** macro to detect non-standard nils (used only in assertions)
183*/
184#define isnonstrictnil(v) (ttisnil(v) && !ttisstrictnil(v))
185
186
187/*
188** By default, entries with any kind of nil are considered empty.
189** (In any definition, values associated with absent keys must also
190** be accepted as empty.)
191*/
192#define isempty(v) ttisnil(v)
193
194
195/* macro defining a value corresponding to an absent key */
196#define ABSTKEYCONSTANT {NULL}, LUA_VABSTKEY
197
198
199/* mark an entry as empty */
200#define setempty(v) settt_(v, LUA_VEMPTY)
201
202
203
204/* }================================================================== */
205
206
207/*
208** {==================================================================
209** Booleans
210** ===================================================================
211*/
212
213
214#define LUA_VFALSE makevariant(LUA_TBOOLEAN, 0)
215#define LUA_VTRUE makevariant(LUA_TBOOLEAN, 1)
216
217#define ttisboolean(o) checktype((o), LUA_TBOOLEAN)
218#define ttisfalse(o) checktag((o), LUA_VFALSE)
219#define ttistrue(o) checktag((o), LUA_VTRUE)
220
221
222#define l_isfalse(o) (ttisfalse(o) || ttisnil(o))
223
224
225#define setbfvalue(obj) settt_(obj, LUA_VFALSE)
226#define setbtvalue(obj) settt_(obj, LUA_VTRUE)
227
228/* }================================================================== */
229
230
231/*
232** {==================================================================
233** Threads
234** ===================================================================
235*/
236
237#define LUA_VTHREAD makevariant(LUA_TTHREAD, 0)
238
239#define ttisthread(o) checktag((o), ctb(LUA_VTHREAD))
240
241#define thvalue(o) check_exp(ttisthread(o), gco2th(val_(o).gc))
242
243#define setthvalue(L,obj,x) \
244 { TValue *io = (obj); lua_State *x_ = (x); \
245 val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_VTHREAD)); \
246 checkliveness(L,io); }
247
248#define setthvalue2s(L,o,t) setthvalue(L,s2v(o),t)
249
250/* }================================================================== */
251
252
253/*
254** {==================================================================
255** Collectable Objects
256** ===================================================================
257*/
258
259/*
260** Common Header for all collectable objects (in macro form, to be
261** included in other objects)
262*/
263#define CommonHeader struct GCObject *next; lu_byte tt; lu_byte marked
264
265
266/* Common type for all collectable objects */
267typedef struct GCObject {
268 CommonHeader;
269} GCObject;
270
271
272/* Bit mark for collectable types */
273#define BIT_ISCOLLECTABLE (1 << 6)
274
275#define iscollectable(o) (rawtt(o) & BIT_ISCOLLECTABLE)
276
277/* mark a tag as collectable */
278#define ctb(t) ((t) | BIT_ISCOLLECTABLE)
279
280#define gcvalue(o) check_exp(iscollectable(o), val_(o).gc)
281
282#define gcvalueraw(v) ((v).gc)
283
284#define setgcovalue(L,obj,x) \
285 { TValue *io = (obj); GCObject *i_g=(x); \
286 val_(io).gc = i_g; settt_(io, ctb(i_g->tt)); }
287
288/* }================================================================== */
289
290
291/*
292** {==================================================================
293** Numbers
294** ===================================================================
295*/
296
297/* Variant tags for numbers */
298#define LUA_VNUMINT makevariant(LUA_TNUMBER, 0) /* integer numbers */
299#define LUA_VNUMFLT makevariant(LUA_TNUMBER, 1) /* float numbers */
300
301#define ttisnumber(o) checktype((o), LUA_TNUMBER)
302#define ttisfloat(o) checktag((o), LUA_VNUMFLT)
303#define ttisinteger(o) checktag((o), LUA_VNUMINT)
304
305#define nvalue(o) check_exp(ttisnumber(o), \
306 (ttisinteger(o) ? cast_num(ivalue(o)) : fltvalue(o)))
307#define fltvalue(o) check_exp(ttisfloat(o), val_(o).n)
308#define ivalue(o) check_exp(ttisinteger(o), val_(o).i)
309
310#define fltvalueraw(v) ((v).n)
311#define ivalueraw(v) ((v).i)
312
313#define setfltvalue(obj,x) \
314 { TValue *io=(obj); val_(io).n=(x); settt_(io, LUA_VNUMFLT); }
315
316#define chgfltvalue(obj,x) \
317 { TValue *io=(obj); lua_assert(ttisfloat(io)); val_(io).n=(x); }
318
319#define setivalue(obj,x) \
320 { TValue *io=(obj); val_(io).i=(x); settt_(io, LUA_VNUMINT); }
321
322#define chgivalue(obj,x) \
323 { TValue *io=(obj); lua_assert(ttisinteger(io)); val_(io).i=(x); }
324
325/* }================================================================== */
326
327
328/*
329** {==================================================================
330** Strings
331** ===================================================================
332*/
333
334/* Variant tags for strings */
335#define LUA_VSHRSTR makevariant(LUA_TSTRING, 0) /* short strings */
336#define LUA_VLNGSTR makevariant(LUA_TSTRING, 1) /* long strings */
337
338#define ttisstring(o) checktype((o), LUA_TSTRING)
339#define ttisshrstring(o) checktag((o), ctb(LUA_VSHRSTR))
340#define ttislngstring(o) checktag((o), ctb(LUA_VLNGSTR))
341
342#define tsvalueraw(v) (gco2ts((v).gc))
343
344#define tsvalue(o) check_exp(ttisstring(o), gco2ts(val_(o).gc))
345
346#define setsvalue(L,obj,x) \
347 { TValue *io = (obj); TString *x_ = (x); \
348 val_(io).gc = obj2gco(x_); settt_(io, ctb(x_->tt)); \
349 checkliveness(L,io); }
350
351/* set a string to the stack */
352#define setsvalue2s(L,o,s) setsvalue(L,s2v(o),s)
353
354/* set a string to a new object */
355#define setsvalue2n setsvalue
356
357
358/*
359** Header for a string value.
360*/
361typedef struct TString {
362 CommonHeader;
363 lu_byte extra; /* reserved words for short strings; "has hash" for longs */
364 lu_byte shrlen; /* length for short strings */
365 unsigned int hash;
366 union {
367 size_t lnglen; /* length for long strings */
368 struct TString *hnext; /* linked list for hash table */
369 } u;
370 char contents[1];
371} TString;
372
373
374
375/*
376** Get the actual string (array of bytes) from a 'TString'.
377*/
378#define getstr(ts) ((ts)->contents)
379
380
381/* get the actual string (array of bytes) from a Lua value */
382#define svalue(o) getstr(tsvalue(o))
383
384/* get string length from 'TString *s' */
385#define tsslen(s) ((s)->tt == LUA_VSHRSTR ? (s)->shrlen : (s)->u.lnglen)
386
387/* get string length from 'TValue *o' */
388#define vslen(o) tsslen(tsvalue(o))
389
390/* }================================================================== */
391
392
393/*
394** {==================================================================
395** Userdata
396** ===================================================================
397*/
398
399
400/*
401** Light userdata should be a variant of userdata, but for compatibility
402** reasons they are also different types.
403*/
404#define LUA_VLIGHTUSERDATA makevariant(LUA_TLIGHTUSERDATA, 0)
405
406#define LUA_VUSERDATA makevariant(LUA_TUSERDATA, 0)
407
408#define ttislightuserdata(o) checktag((o), LUA_VLIGHTUSERDATA)
409#define ttisfulluserdata(o) checktag((o), ctb(LUA_VUSERDATA))
410
411#define pvalue(o) check_exp(ttislightuserdata(o), val_(o).p)
412#define uvalue(o) check_exp(ttisfulluserdata(o), gco2u(val_(o).gc))
413
414#define pvalueraw(v) ((v).p)
415
416#define setpvalue(obj,x) \
417 { TValue *io=(obj); val_(io).p=(x); settt_(io, LUA_VLIGHTUSERDATA); }
418
419#define setuvalue(L,obj,x) \
420 { TValue *io = (obj); Udata *x_ = (x); \
421 val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_VUSERDATA)); \
422 checkliveness(L,io); }
423
424
425/* Ensures that addresses after this type are always fully aligned. */
426typedef union UValue {
427 TValue uv;
428 LUAI_MAXALIGN; /* ensures maximum alignment for udata bytes */
429} UValue;
430
431
432/*
433** Header for userdata with user values;
434** memory area follows the end of this structure.
435*/
436typedef struct Udata {
437 CommonHeader;
438 unsigned short nuvalue; /* number of user values */
439 size_t len; /* number of bytes */
440 struct Table *metatable;
441 GCObject *gclist;
442 UValue uv[1]; /* user values */
443} Udata;
444
445
446/*
447** Header for userdata with no user values. These userdata do not need
448** to be gray during GC, and therefore do not need a 'gclist' field.
449** To simplify, the code always use 'Udata' for both kinds of userdata,
450** making sure it never accesses 'gclist' on userdata with no user values.
451** This structure here is used only to compute the correct size for
452** this representation. (The 'bindata' field in its end ensures correct
453** alignment for binary data following this header.)
454*/
455typedef struct Udata0 {
456 CommonHeader;
457 unsigned short nuvalue; /* number of user values */
458 size_t len; /* number of bytes */
459 struct Table *metatable;
460 union {LUAI_MAXALIGN;} bindata;
461} Udata0;
462
463
464/* compute the offset of the memory area of a userdata */
465#define udatamemoffset(nuv) \
466 ((nuv) == 0 ? offsetof(Udata0, bindata) \
467 : offsetof(Udata, uv) + (sizeof(UValue) * (nuv)))
468
469/* get the address of the memory block inside 'Udata' */
470#define getudatamem(u) (cast_charp(u) + udatamemoffset((u)->nuvalue))
471
472/* compute the size of a userdata */
473#define sizeudata(nuv,nb) (udatamemoffset(nuv) + (nb))
474
475/* }================================================================== */
476
477
478/*
479** {==================================================================
480** Prototypes
481** ===================================================================
482*/
483
484#define LUA_VPROTO makevariant(LUA_TPROTO, 0)
485
486
487/*
488** Description of an upvalue for function prototypes
489*/
490typedef struct Upvaldesc {
491 TString *name; /* upvalue name (for debug information) */
492 lu_byte instack; /* whether it is in stack (register) */
493 lu_byte idx; /* index of upvalue (in stack or in outer function's list) */
494 lu_byte kind; /* kind of corresponding variable */
495} Upvaldesc;
496
497
498/*
499** Description of a local variable for function prototypes
500** (used for debug information)
501*/
502typedef struct LocVar {
503 TString *varname;
504 int startpc; /* first point where variable is active */
505 int endpc; /* first point where variable is dead */
506} LocVar;
507
508
509/*
510** Associates the absolute line source for a given instruction ('pc').
511** The array 'lineinfo' gives, for each instruction, the difference in
512** lines from the previous instruction. When that difference does not
513** fit into a byte, Lua saves the absolute line for that instruction.
514** (Lua also saves the absolute line periodically, to speed up the
515** computation of a line number: we can use binary search in the
516** absolute-line array, but we must traverse the 'lineinfo' array
517** linearly to compute a line.)
518*/
519typedef struct AbsLineInfo {
520 int pc;
521 int line;
522} AbsLineInfo;
523
524/*
525** Function Prototypes
526*/
527typedef struct Proto {
528 CommonHeader;
529 lu_byte numparams; /* number of fixed (named) parameters */
530 lu_byte is_vararg;
531 lu_byte maxstacksize; /* number of registers needed by this function */
532 int sizeupvalues; /* size of 'upvalues' */
533 int sizek; /* size of 'k' */
534 int sizecode;
535 int sizelineinfo;
536 int sizep; /* size of 'p' */
537 int sizelocvars;
538 int sizeabslineinfo; /* size of 'abslineinfo' */
539 int linedefined; /* debug information */
540 int lastlinedefined; /* debug information */
541 TValue *k; /* constants used by the function */
542 Instruction *code; /* opcodes */
543 struct Proto **p; /* functions defined inside the function */
544 Upvaldesc *upvalues; /* upvalue information */
545 ls_byte *lineinfo; /* information about source lines (debug information) */
546 AbsLineInfo *abslineinfo; /* idem */
547 LocVar *locvars; /* information about local variables (debug information) */
548 TString *source; /* used for debug information */
549 GCObject *gclist;
550} Proto;
551
552/* }================================================================== */
553
554
555/*
556** {==================================================================
557** Closures
558** ===================================================================
559*/
560
561#define LUA_VUPVAL makevariant(LUA_TUPVAL, 0)
562
563
564/* Variant tags for functions */
565#define LUA_VLCL makevariant(LUA_TFUNCTION, 0) /* Lua closure */
566#define LUA_VLCF makevariant(LUA_TFUNCTION, 1) /* light C function */
567#define LUA_VCCL makevariant(LUA_TFUNCTION, 2) /* C closure */
568
569#define ttisfunction(o) checktype(o, LUA_TFUNCTION)
570#define ttisclosure(o) ((rawtt(o) & 0x1F) == LUA_VLCL)
571#define ttisLclosure(o) checktag((o), ctb(LUA_VLCL))
572#define ttislcf(o) checktag((o), LUA_VLCF)
573#define ttisCclosure(o) checktag((o), ctb(LUA_VCCL))
574
575#define isLfunction(o) ttisLclosure(o)
576
577#define clvalue(o) check_exp(ttisclosure(o), gco2cl(val_(o).gc))
578#define clLvalue(o) check_exp(ttisLclosure(o), gco2lcl(val_(o).gc))
579#define fvalue(o) check_exp(ttislcf(o), val_(o).f)
580#define clCvalue(o) check_exp(ttisCclosure(o), gco2ccl(val_(o).gc))
581
582#define fvalueraw(v) ((v).f)
583
584#define setclLvalue(L,obj,x) \
585 { TValue *io = (obj); LClosure *x_ = (x); \
586 val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_VLCL)); \
587 checkliveness(L,io); }
588
589#define setclLvalue2s(L,o,cl) setclLvalue(L,s2v(o),cl)
590
591#define setfvalue(obj,x) \
592 { TValue *io=(obj); val_(io).f=(x); settt_(io, LUA_VLCF); }
593
594#define setclCvalue(L,obj,x) \
595 { TValue *io = (obj); CClosure *x_ = (x); \
596 val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_VCCL)); \
597 checkliveness(L,io); }
598
599
600/*
601** Upvalues for Lua closures
602*/
603typedef struct UpVal {
604 CommonHeader;
605 lu_byte tbc; /* true if it represents a to-be-closed variable */
606 TValue *v; /* points to stack or to its own value */
607 union {
608 struct { /* (when open) */
609 struct UpVal *next; /* linked list */
610 struct UpVal **previous;
611 } open;
612 TValue value; /* the value (when closed) */
613 } u;
614} UpVal;
615
616
617
618#define ClosureHeader \
619 CommonHeader; lu_byte nupvalues; GCObject *gclist
620
621typedef struct CClosure {
622 ClosureHeader;
623 lua_CFunction f;
624 TValue upvalue[1]; /* list of upvalues */
625} CClosure;
626
627
628typedef struct LClosure {
629 ClosureHeader;
630 struct Proto *p;
631 UpVal *upvals[1]; /* list of upvalues */
632} LClosure;
633
634
635typedef union Closure {
636 CClosure c;
637 LClosure l;
638} Closure;
639
640
641#define getproto(o) (clLvalue(o)->p)
642
643/* }================================================================== */
644
645
646/*
647** {==================================================================
648** Tables
649** ===================================================================
650*/
651
652#define LUA_VTABLE makevariant(LUA_TTABLE, 0)
653
654#define ttistable(o) checktag((o), ctb(LUA_VTABLE))
655
656#define hvalue(o) check_exp(ttistable(o), gco2t(val_(o).gc))
657
658#define sethvalue(L,obj,x) \
659 { TValue *io = (obj); Table *x_ = (x); \
660 val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_VTABLE)); \
661 checkliveness(L,io); }
662
663#define sethvalue2s(L,o,h) sethvalue(L,s2v(o),h)
664
665
666/*
667** Nodes for Hash tables: A pack of two TValue's (key-value pairs)
668** plus a 'next' field to link colliding entries. The distribution
669** of the key's fields ('key_tt' and 'key_val') not forming a proper
670** 'TValue' allows for a smaller size for 'Node' both in 4-byte
671** and 8-byte alignments.
672*/
673typedef union Node {
674 struct NodeKey {
675 TValuefields; /* fields for value */
676 lu_byte key_tt; /* key type */
677 int next; /* for chaining */
678 Value key_val; /* key value */
679 } u;
680 TValue i_val; /* direct access to node's value as a proper 'TValue' */
681} Node;
682
683
684/* copy a value into a key */
685#define setnodekey(L,node,obj) \
686 { Node *n_=(node); const TValue *io_=(obj); \
687 n_->u.key_val = io_->value_; n_->u.key_tt = io_->tt_; \
688 checkliveness(L,io_); }
689
690
691/* copy a value from a key */
692#define getnodekey(L,obj,node) \
693 { TValue *io_=(obj); const Node *n_=(node); \
694 io_->value_ = n_->u.key_val; io_->tt_ = n_->u.key_tt; \
695 checkliveness(L,io_); }
696
697
698/*
699** About 'alimit': if 'isrealasize(t)' is true, then 'alimit' is the
700** real size of 'array'. Otherwise, the real size of 'array' is the
701** smallest power of two not smaller than 'alimit' (or zero iff 'alimit'
702** is zero); 'alimit' is then used as a hint for #t.
703*/
704
705#define BITRAS (1 << 7)
706#define isrealasize(t) (!((t)->marked & BITRAS))
707#define setrealasize(t) ((t)->marked &= cast_byte(~BITRAS))
708#define setnorealasize(t) ((t)->marked |= BITRAS)
709
710
711typedef struct Table {
712 CommonHeader;
713 lu_byte flags; /* 1<<p means tagmethod(p) is not present */
714 lu_byte lsizenode; /* log2 of size of 'node' array */
715 unsigned int alimit; /* "limit" of 'array' array */
716 TValue *array; /* array part */
717 Node *node;
718 Node *lastfree; /* any free position is before this position */
719 struct Table *metatable;
720 GCObject *gclist;
721} Table;
722
723
724/*
725** Macros to manipulate keys inserted in nodes
726*/
727#define keytt(node) ((node)->u.key_tt)
728#define keyval(node) ((node)->u.key_val)
729
730#define keyisnil(node) (keytt(node) == LUA_TNIL)
731#define keyisinteger(node) (keytt(node) == LUA_VNUMINT)
732#define keyival(node) (keyval(node).i)
733#define keyisshrstr(node) (keytt(node) == ctb(LUA_VSHRSTR))
734#define keystrval(node) (gco2ts(keyval(node).gc))
735
736#define setnilkey(node) (keytt(node) = LUA_TNIL)
737
738#define keyiscollectable(n) (keytt(n) & BIT_ISCOLLECTABLE)
739
740#define gckey(n) (keyval(n).gc)
741#define gckeyN(n) (keyiscollectable(n) ? gckey(n) : NULL)
742
743
744/*
745** Use a "nil table" to mark dead keys in a table. Those keys serve
746** to keep space for removed entries, which may still be part of
747** chains. Note that the 'keytt' does not have the BIT_ISCOLLECTABLE
748** set, so these values are considered not collectable and are different
749** from any valid value.
750*/
751#define setdeadkey(n) (keytt(n) = LUA_TTABLE, gckey(n) = NULL)
752
753/* }================================================================== */
754
755
756
757/*
758** 'module' operation for hashing (size is always a power of 2)
759*/
760#define lmod(s,size) \
761 (check_exp((size&(size-1))==0, (cast_int((s) & ((size)-1)))))
762
763
764#define twoto(x) (1<<(x))
765#define sizenode(t) (twoto((t)->lsizenode))
766
767
768/* size of buffer for 'luaO_utf8esc' function */
769#define UTF8BUFFSZ 8
770
771LUAI_FUNC int luaO_utf8esc (char *buff, unsigned long x);
772LUAI_FUNC int luaO_ceillog2 (unsigned int x);
773LUAI_FUNC int luaO_rawarith (lua_State *L, int op, const TValue *p1,
774 const TValue *p2, TValue *res);
775LUAI_FUNC void luaO_arith (lua_State *L, int op, const TValue *p1,
776 const TValue *p2, StkId res);
777LUAI_FUNC size_t luaO_str2num (const char *s, TValue *o);
778LUAI_FUNC int luaO_hexavalue (int c);
779LUAI_FUNC void luaO_tostring (lua_State *L, TValue *obj);
780LUAI_FUNC const char *luaO_pushvfstring (lua_State *L, const char *fmt,
781 va_list argp);
782LUAI_FUNC const char *luaO_pushfstring (lua_State *L, const char *fmt, ...);
783LUAI_FUNC void luaO_chunkid (char *out, const char *source, size_t srclen);
784
785
786#endif
787
diff --git a/src/lua/lopcodes.c b/src/lua/lopcodes.c
new file mode 100644
index 0000000..c67aa22
--- /dev/null
+++ b/src/lua/lopcodes.c
@@ -0,0 +1,104 @@
1/*
2** $Id: lopcodes.c $
3** Opcodes for Lua virtual machine
4** See Copyright Notice in lua.h
5*/
6
7#define lopcodes_c
8#define LUA_CORE
9
10#include "lprefix.h"
11
12
13#include "lopcodes.h"
14
15
16/* ORDER OP */
17
18LUAI_DDEF const lu_byte luaP_opmodes[NUM_OPCODES] = {
19/* MM OT IT T A mode opcode */
20 opmode(0, 0, 0, 0, 1, iABC) /* OP_MOVE */
21 ,opmode(0, 0, 0, 0, 1, iAsBx) /* OP_LOADI */
22 ,opmode(0, 0, 0, 0, 1, iAsBx) /* OP_LOADF */
23 ,opmode(0, 0, 0, 0, 1, iABx) /* OP_LOADK */
24 ,opmode(0, 0, 0, 0, 1, iABx) /* OP_LOADKX */
25 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_LOADFALSE */
26 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_LFALSESKIP */
27 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_LOADTRUE */
28 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_LOADNIL */
29 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_GETUPVAL */
30 ,opmode(0, 0, 0, 0, 0, iABC) /* OP_SETUPVAL */
31 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_GETTABUP */
32 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_GETTABLE */
33 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_GETI */
34 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_GETFIELD */
35 ,opmode(0, 0, 0, 0, 0, iABC) /* OP_SETTABUP */
36 ,opmode(0, 0, 0, 0, 0, iABC) /* OP_SETTABLE */
37 ,opmode(0, 0, 0, 0, 0, iABC) /* OP_SETI */
38 ,opmode(0, 0, 0, 0, 0, iABC) /* OP_SETFIELD */
39 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_NEWTABLE */
40 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_SELF */
41 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_ADDI */
42 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_ADDK */
43 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_SUBK */
44 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_MULK */
45 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_MODK */
46 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_POWK */
47 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_DIVK */
48 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_IDIVK */
49 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_BANDK */
50 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_BORK */
51 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_BXORK */
52 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_SHRI */
53 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_SHLI */
54 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_ADD */
55 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_SUB */
56 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_MUL */
57 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_MOD */
58 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_POW */
59 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_DIV */
60 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_IDIV */
61 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_BAND */
62 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_BOR */
63 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_BXOR */
64 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_SHL */
65 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_SHR */
66 ,opmode(1, 0, 0, 0, 0, iABC) /* OP_MMBIN */
67 ,opmode(1, 0, 0, 0, 0, iABC) /* OP_MMBINI*/
68 ,opmode(1, 0, 0, 0, 0, iABC) /* OP_MMBINK*/
69 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_UNM */
70 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_BNOT */
71 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_NOT */
72 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_LEN */
73 ,opmode(0, 0, 0, 0, 1, iABC) /* OP_CONCAT */
74 ,opmode(0, 0, 0, 0, 0, iABC) /* OP_CLOSE */
75 ,opmode(0, 0, 0, 0, 0, iABC) /* OP_TBC */
76 ,opmode(0, 0, 0, 0, 0, isJ) /* OP_JMP */
77 ,opmode(0, 0, 0, 1, 0, iABC) /* OP_EQ */
78 ,opmode(0, 0, 0, 1, 0, iABC) /* OP_LT */
79 ,opmode(0, 0, 0, 1, 0, iABC) /* OP_LE */
80 ,opmode(0, 0, 0, 1, 0, iABC) /* OP_EQK */
81 ,opmode(0, 0, 0, 1, 0, iABC) /* OP_EQI */
82 ,opmode(0, 0, 0, 1, 0, iABC) /* OP_LTI */
83 ,opmode(0, 0, 0, 1, 0, iABC) /* OP_LEI */
84 ,opmode(0, 0, 0, 1, 0, iABC) /* OP_GTI */
85 ,opmode(0, 0, 0, 1, 0, iABC) /* OP_GEI */
86 ,opmode(0, 0, 0, 1, 0, iABC) /* OP_TEST */
87 ,opmode(0, 0, 0, 1, 1, iABC) /* OP_TESTSET */
88 ,opmode(0, 1, 1, 0, 1, iABC) /* OP_CALL */
89 ,opmode(0, 1, 1, 0, 1, iABC) /* OP_TAILCALL */
90 ,opmode(0, 0, 1, 0, 0, iABC) /* OP_RETURN */
91 ,opmode(0, 0, 0, 0, 0, iABC) /* OP_RETURN0 */
92 ,opmode(0, 0, 0, 0, 0, iABC) /* OP_RETURN1 */
93 ,opmode(0, 0, 0, 0, 1, iABx) /* OP_FORLOOP */
94 ,opmode(0, 0, 0, 0, 1, iABx) /* OP_FORPREP */
95 ,opmode(0, 0, 0, 0, 0, iABx) /* OP_TFORPREP */
96 ,opmode(0, 0, 0, 0, 0, iABC) /* OP_TFORCALL */
97 ,opmode(0, 0, 0, 0, 1, iABx) /* OP_TFORLOOP */
98 ,opmode(0, 0, 1, 0, 0, iABC) /* OP_SETLIST */
99 ,opmode(0, 0, 0, 0, 1, iABx) /* OP_CLOSURE */
100 ,opmode(0, 1, 0, 0, 1, iABC) /* OP_VARARG */
101 ,opmode(0, 0, 1, 0, 1, iABC) /* OP_VARARGPREP */
102 ,opmode(0, 0, 0, 0, 0, iAx) /* OP_EXTRAARG */
103};
104
diff --git a/src/lua/lopcodes.h b/src/lua/lopcodes.h
new file mode 100644
index 0000000..122e5d2
--- /dev/null
+++ b/src/lua/lopcodes.h
@@ -0,0 +1,392 @@
1/*
2** $Id: lopcodes.h $
3** Opcodes for Lua virtual machine
4** See Copyright Notice in lua.h
5*/
6
7#ifndef lopcodes_h
8#define lopcodes_h
9
10#include "llimits.h"
11
12
13/*===========================================================================
14 We assume that instructions are unsigned 32-bit integers.
15 All instructions have an opcode in the first 7 bits.
16 Instructions can have the following formats:
17
18 3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0
19 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
20iABC C(8) | B(8) |k| A(8) | Op(7) |
21iABx Bx(17) | A(8) | Op(7) |
22iAsBx sBx (signed)(17) | A(8) | Op(7) |
23iAx Ax(25) | Op(7) |
24isJ sJ(25) | Op(7) |
25
26 A signed argument is represented in excess K: the represented value is
27 the written unsigned value minus K, where K is half the maximum for the
28 corresponding unsigned argument.
29===========================================================================*/
30
31
32enum OpMode {iABC, iABx, iAsBx, iAx, isJ}; /* basic instruction formats */
33
34
35/*
36** size and position of opcode arguments.
37*/
38#define SIZE_C 8
39#define SIZE_B 8
40#define SIZE_Bx (SIZE_C + SIZE_B + 1)
41#define SIZE_A 8
42#define SIZE_Ax (SIZE_Bx + SIZE_A)
43#define SIZE_sJ (SIZE_Bx + SIZE_A)
44
45#define SIZE_OP 7
46
47#define POS_OP 0
48
49#define POS_A (POS_OP + SIZE_OP)
50#define POS_k (POS_A + SIZE_A)
51#define POS_B (POS_k + 1)
52#define POS_C (POS_B + SIZE_B)
53
54#define POS_Bx POS_k
55
56#define POS_Ax POS_A
57
58#define POS_sJ POS_A
59
60
61/*
62** limits for opcode arguments.
63** we use (signed) 'int' to manipulate most arguments,
64** so they must fit in ints.
65*/
66
67/* Check whether type 'int' has at least 'b' bits ('b' < 32) */
68#define L_INTHASBITS(b) ((UINT_MAX >> ((b) - 1)) >= 1)
69
70
71#if L_INTHASBITS(SIZE_Bx)
72#define MAXARG_Bx ((1<<SIZE_Bx)-1)
73#else
74#define MAXARG_Bx MAX_INT
75#endif
76
77#define OFFSET_sBx (MAXARG_Bx>>1) /* 'sBx' is signed */
78
79
80#if L_INTHASBITS(SIZE_Ax)
81#define MAXARG_Ax ((1<<SIZE_Ax)-1)
82#else
83#define MAXARG_Ax MAX_INT
84#endif
85
86#if L_INTHASBITS(SIZE_sJ)
87#define MAXARG_sJ ((1 << SIZE_sJ) - 1)
88#else
89#define MAXARG_sJ MAX_INT
90#endif
91
92#define OFFSET_sJ (MAXARG_sJ >> 1)
93
94
95#define MAXARG_A ((1<<SIZE_A)-1)
96#define MAXARG_B ((1<<SIZE_B)-1)
97#define MAXARG_C ((1<<SIZE_C)-1)
98#define OFFSET_sC (MAXARG_C >> 1)
99
100#define int2sC(i) ((i) + OFFSET_sC)
101#define sC2int(i) ((i) - OFFSET_sC)
102
103
104/* creates a mask with 'n' 1 bits at position 'p' */
105#define MASK1(n,p) ((~((~(Instruction)0)<<(n)))<<(p))
106
107/* creates a mask with 'n' 0 bits at position 'p' */
108#define MASK0(n,p) (~MASK1(n,p))
109
110/*
111** the following macros help to manipulate instructions
112*/
113
114#define GET_OPCODE(i) (cast(OpCode, ((i)>>POS_OP) & MASK1(SIZE_OP,0)))
115#define SET_OPCODE(i,o) ((i) = (((i)&MASK0(SIZE_OP,POS_OP)) | \
116 ((cast(Instruction, o)<<POS_OP)&MASK1(SIZE_OP,POS_OP))))
117
118#define checkopm(i,m) (getOpMode(GET_OPCODE(i)) == m)
119
120
121#define getarg(i,pos,size) (cast_int(((i)>>(pos)) & MASK1(size,0)))
122#define setarg(i,v,pos,size) ((i) = (((i)&MASK0(size,pos)) | \
123 ((cast(Instruction, v)<<pos)&MASK1(size,pos))))
124
125#define GETARG_A(i) getarg(i, POS_A, SIZE_A)
126#define SETARG_A(i,v) setarg(i, v, POS_A, SIZE_A)
127
128#define GETARG_B(i) check_exp(checkopm(i, iABC), getarg(i, POS_B, SIZE_B))
129#define GETARG_sB(i) sC2int(GETARG_B(i))
130#define SETARG_B(i,v) setarg(i, v, POS_B, SIZE_B)
131
132#define GETARG_C(i) check_exp(checkopm(i, iABC), getarg(i, POS_C, SIZE_C))
133#define GETARG_sC(i) sC2int(GETARG_C(i))
134#define SETARG_C(i,v) setarg(i, v, POS_C, SIZE_C)
135
136#define TESTARG_k(i) check_exp(checkopm(i, iABC), (cast_int(((i) & (1u << POS_k)))))
137#define GETARG_k(i) check_exp(checkopm(i, iABC), getarg(i, POS_k, 1))
138#define SETARG_k(i,v) setarg(i, v, POS_k, 1)
139
140#define GETARG_Bx(i) check_exp(checkopm(i, iABx), getarg(i, POS_Bx, SIZE_Bx))
141#define SETARG_Bx(i,v) setarg(i, v, POS_Bx, SIZE_Bx)
142
143#define GETARG_Ax(i) check_exp(checkopm(i, iAx), getarg(i, POS_Ax, SIZE_Ax))
144#define SETARG_Ax(i,v) setarg(i, v, POS_Ax, SIZE_Ax)
145
146#define GETARG_sBx(i) \
147 check_exp(checkopm(i, iAsBx), getarg(i, POS_Bx, SIZE_Bx) - OFFSET_sBx)
148#define SETARG_sBx(i,b) SETARG_Bx((i),cast_uint((b)+OFFSET_sBx))
149
150#define GETARG_sJ(i) \
151 check_exp(checkopm(i, isJ), getarg(i, POS_sJ, SIZE_sJ) - OFFSET_sJ)
152#define SETARG_sJ(i,j) \
153 setarg(i, cast_uint((j)+OFFSET_sJ), POS_sJ, SIZE_sJ)
154
155
156#define CREATE_ABCk(o,a,b,c,k) ((cast(Instruction, o)<<POS_OP) \
157 | (cast(Instruction, a)<<POS_A) \
158 | (cast(Instruction, b)<<POS_B) \
159 | (cast(Instruction, c)<<POS_C) \
160 | (cast(Instruction, k)<<POS_k))
161
162#define CREATE_ABx(o,a,bc) ((cast(Instruction, o)<<POS_OP) \
163 | (cast(Instruction, a)<<POS_A) \
164 | (cast(Instruction, bc)<<POS_Bx))
165
166#define CREATE_Ax(o,a) ((cast(Instruction, o)<<POS_OP) \
167 | (cast(Instruction, a)<<POS_Ax))
168
169#define CREATE_sJ(o,j,k) ((cast(Instruction, o) << POS_OP) \
170 | (cast(Instruction, j) << POS_sJ) \
171 | (cast(Instruction, k) << POS_k))
172
173
174#if !defined(MAXINDEXRK) /* (for debugging only) */
175#define MAXINDEXRK MAXARG_B
176#endif
177
178
179/*
180** invalid register that fits in 8 bits
181*/
182#define NO_REG MAXARG_A
183
184
185/*
186** R[x] - register
187** K[x] - constant (in constant table)
188** RK(x) == if k(i) then K[x] else R[x]
189*/
190
191
192/*
193** grep "ORDER OP" if you change these enums
194*/
195
196typedef enum {
197/*----------------------------------------------------------------------
198 name args description
199------------------------------------------------------------------------*/
200OP_MOVE,/* A B R[A] := R[B] */
201OP_LOADI,/* A sBx R[A] := sBx */
202OP_LOADF,/* A sBx R[A] := (lua_Number)sBx */
203OP_LOADK,/* A Bx R[A] := K[Bx] */
204OP_LOADKX,/* A R[A] := K[extra arg] */
205OP_LOADFALSE,/* A R[A] := false */
206OP_LFALSESKIP,/*A R[A] := false; pc++ */
207OP_LOADTRUE,/* A R[A] := true */
208OP_LOADNIL,/* A B R[A], R[A+1], ..., R[A+B] := nil */
209OP_GETUPVAL,/* A B R[A] := UpValue[B] */
210OP_SETUPVAL,/* A B UpValue[B] := R[A] */
211
212OP_GETTABUP,/* A B C R[A] := UpValue[B][K[C]:string] */
213OP_GETTABLE,/* A B C R[A] := R[B][R[C]] */
214OP_GETI,/* A B C R[A] := R[B][C] */
215OP_GETFIELD,/* A B C R[A] := R[B][K[C]:string] */
216
217OP_SETTABUP,/* A B C UpValue[A][K[B]:string] := RK(C) */
218OP_SETTABLE,/* A B C R[A][R[B]] := RK(C) */
219OP_SETI,/* A B C R[A][B] := RK(C) */
220OP_SETFIELD,/* A B C R[A][K[B]:string] := RK(C) */
221
222OP_NEWTABLE,/* A B C k R[A] := {} */
223
224OP_SELF,/* A B C R[A+1] := R[B]; R[A] := R[B][RK(C):string] */
225
226OP_ADDI,/* A B sC R[A] := R[B] + sC */
227
228OP_ADDK,/* A B C R[A] := R[B] + K[C] */
229OP_SUBK,/* A B C R[A] := R[B] - K[C] */
230OP_MULK,/* A B C R[A] := R[B] * K[C] */
231OP_MODK,/* A B C R[A] := R[B] % K[C] */
232OP_POWK,/* A B C R[A] := R[B] ^ K[C] */
233OP_DIVK,/* A B C R[A] := R[B] / K[C] */
234OP_IDIVK,/* A B C R[A] := R[B] // K[C] */
235
236OP_BANDK,/* A B C R[A] := R[B] & K[C]:integer */
237OP_BORK,/* A B C R[A] := R[B] | K[C]:integer */
238OP_BXORK,/* A B C R[A] := R[B] ~ K[C]:integer */
239
240OP_SHRI,/* A B sC R[A] := R[B] >> sC */
241OP_SHLI,/* A B sC R[A] := sC << R[B] */
242
243OP_ADD,/* A B C R[A] := R[B] + R[C] */
244OP_SUB,/* A B C R[A] := R[B] - R[C] */
245OP_MUL,/* A B C R[A] := R[B] * R[C] */
246OP_MOD,/* A B C R[A] := R[B] % R[C] */
247OP_POW,/* A B C R[A] := R[B] ^ R[C] */
248OP_DIV,/* A B C R[A] := R[B] / R[C] */
249OP_IDIV,/* A B C R[A] := R[B] // R[C] */
250
251OP_BAND,/* A B C R[A] := R[B] & R[C] */
252OP_BOR,/* A B C R[A] := R[B] | R[C] */
253OP_BXOR,/* A B C R[A] := R[B] ~ R[C] */
254OP_SHL,/* A B C R[A] := R[B] << R[C] */
255OP_SHR,/* A B C R[A] := R[B] >> R[C] */
256
257OP_MMBIN,/* A B C call C metamethod over R[A] and R[B] */
258OP_MMBINI,/* A sB C k call C metamethod over R[A] and sB */
259OP_MMBINK,/* A B C k call C metamethod over R[A] and K[B] */
260
261OP_UNM,/* A B R[A] := -R[B] */
262OP_BNOT,/* A B R[A] := ~R[B] */
263OP_NOT,/* A B R[A] := not R[B] */
264OP_LEN,/* A B R[A] := length of R[B] */
265
266OP_CONCAT,/* A B R[A] := R[A].. ... ..R[A + B - 1] */
267
268OP_CLOSE,/* A close all upvalues >= R[A] */
269OP_TBC,/* A mark variable A "to be closed" */
270OP_JMP,/* sJ pc += sJ */
271OP_EQ,/* A B k if ((R[A] == R[B]) ~= k) then pc++ */
272OP_LT,/* A B k if ((R[A] < R[B]) ~= k) then pc++ */
273OP_LE,/* A B k if ((R[A] <= R[B]) ~= k) then pc++ */
274
275OP_EQK,/* A B k if ((R[A] == K[B]) ~= k) then pc++ */
276OP_EQI,/* A sB k if ((R[A] == sB) ~= k) then pc++ */
277OP_LTI,/* A sB k if ((R[A] < sB) ~= k) then pc++ */
278OP_LEI,/* A sB k if ((R[A] <= sB) ~= k) then pc++ */
279OP_GTI,/* A sB k if ((R[A] > sB) ~= k) then pc++ */
280OP_GEI,/* A sB k if ((R[A] >= sB) ~= k) then pc++ */
281
282OP_TEST,/* A k if (not R[A] == k) then pc++ */
283OP_TESTSET,/* A B k if (not R[B] == k) then pc++ else R[A] := R[B] */
284
285OP_CALL,/* A B C R[A], ... ,R[A+C-2] := R[A](R[A+1], ... ,R[A+B-1]) */
286OP_TAILCALL,/* A B C k return R[A](R[A+1], ... ,R[A+B-1]) */
287
288OP_RETURN,/* A B C k return R[A], ... ,R[A+B-2] (see note) */
289OP_RETURN0,/* return */
290OP_RETURN1,/* A return R[A] */
291
292OP_FORLOOP,/* A Bx update counters; if loop continues then pc-=Bx; */
293OP_FORPREP,/* A Bx <check values and prepare counters>;
294 if not to run then pc+=Bx+1; */
295
296OP_TFORPREP,/* A Bx create upvalue for R[A + 3]; pc+=Bx */
297OP_TFORCALL,/* A C R[A+4], ... ,R[A+3+C] := R[A](R[A+1], R[A+2]); */
298OP_TFORLOOP,/* A Bx if R[A+2] ~= nil then { R[A]=R[A+2]; pc -= Bx } */
299
300OP_SETLIST,/* A B C k R[A][(C-1)*FPF+i] := R[A+i], 1 <= i <= B */
301
302OP_CLOSURE,/* A Bx R[A] := closure(KPROTO[Bx]) */
303
304OP_VARARG,/* A C R[A], R[A+1], ..., R[A+C-2] = vararg */
305
306OP_VARARGPREP,/*A (adjust vararg parameters) */
307
308OP_EXTRAARG/* Ax extra (larger) argument for previous opcode */
309} OpCode;
310
311
312#define NUM_OPCODES ((int)(OP_EXTRAARG) + 1)
313
314
315
316/*===========================================================================
317 Notes:
318 (*) In OP_CALL, if (B == 0) then B = top - A. If (C == 0), then
319 'top' is set to last_result+1, so next open instruction (OP_CALL,
320 OP_RETURN*, OP_SETLIST) may use 'top'.
321
322 (*) In OP_VARARG, if (C == 0) then use actual number of varargs and
323 set top (like in OP_CALL with C == 0).
324
325 (*) In OP_RETURN, if (B == 0) then return up to 'top'.
326
327 (*) In OP_LOADKX and OP_NEWTABLE, the next instruction is always
328 OP_EXTRAARG.
329
330 (*) In OP_SETLIST, if (B == 0) then real B = 'top'; if k, then
331 real C = EXTRAARG _ C (the bits of EXTRAARG concatenated with the
332 bits of C).
333
334 (*) In OP_NEWTABLE, B is log2 of the hash size (which is always a
335 power of 2) plus 1, or zero for size zero. If not k, the array size
336 is C. Otherwise, the array size is EXTRAARG _ C.
337
338 (*) For comparisons, k specifies what condition the test should accept
339 (true or false).
340
341 (*) In OP_MMBINI/OP_MMBINK, k means the arguments were flipped
342 (the constant is the first operand).
343
344 (*) All 'skips' (pc++) assume that next instruction is a jump.
345
346 (*) In instructions OP_RETURN/OP_TAILCALL, 'k' specifies that the
347 function builds upvalues, which may need to be closed. C > 0 means
348 the function is vararg, so that its 'func' must be corrected before
349 returning; in this case, (C - 1) is its number of fixed parameters.
350
351 (*) In comparisons with an immediate operand, C signals whether the
352 original operand was a float. (It must be corrected in case of
353 metamethods.)
354
355===========================================================================*/
356
357
358/*
359** masks for instruction properties. The format is:
360** bits 0-2: op mode
361** bit 3: instruction set register A
362** bit 4: operator is a test (next instruction must be a jump)
363** bit 5: instruction uses 'L->top' set by previous instruction (when B == 0)
364** bit 6: instruction sets 'L->top' for next instruction (when C == 0)
365** bit 7: instruction is an MM instruction (call a metamethod)
366*/
367
368LUAI_DDEC(const lu_byte luaP_opmodes[NUM_OPCODES];)
369
370#define getOpMode(m) (cast(enum OpMode, luaP_opmodes[m] & 7))
371#define testAMode(m) (luaP_opmodes[m] & (1 << 3))
372#define testTMode(m) (luaP_opmodes[m] & (1 << 4))
373#define testITMode(m) (luaP_opmodes[m] & (1 << 5))
374#define testOTMode(m) (luaP_opmodes[m] & (1 << 6))
375#define testMMMode(m) (luaP_opmodes[m] & (1 << 7))
376
377/* "out top" (set top for next instruction) */
378#define isOT(i) \
379 ((testOTMode(GET_OPCODE(i)) && GETARG_C(i) == 0) || \
380 GET_OPCODE(i) == OP_TAILCALL)
381
382/* "in top" (uses top from previous instruction) */
383#define isIT(i) (testITMode(GET_OPCODE(i)) && GETARG_B(i) == 0)
384
385#define opmode(mm,ot,it,t,a,m) \
386 (((mm) << 7) | ((ot) << 6) | ((it) << 5) | ((t) << 4) | ((a) << 3) | (m))
387
388
389/* number of list items to accumulate before a SETLIST instruction */
390#define LFIELDS_PER_FLUSH 50
391
392#endif
diff --git a/src/lua/lopnames.h b/src/lua/lopnames.h
new file mode 100644
index 0000000..965cec9
--- /dev/null
+++ b/src/lua/lopnames.h
@@ -0,0 +1,103 @@
1/*
2** $Id: lopnames.h $
3** Opcode names
4** See Copyright Notice in lua.h
5*/
6
7#if !defined(lopnames_h)
8#define lopnames_h
9
10#include <stddef.h>
11
12
13/* ORDER OP */
14
15static const char *const opnames[] = {
16 "MOVE",
17 "LOADI",
18 "LOADF",
19 "LOADK",
20 "LOADKX",
21 "LOADFALSE",
22 "LFALSESKIP",
23 "LOADTRUE",
24 "LOADNIL",
25 "GETUPVAL",
26 "SETUPVAL",
27 "GETTABUP",
28 "GETTABLE",
29 "GETI",
30 "GETFIELD",
31 "SETTABUP",
32 "SETTABLE",
33 "SETI",
34 "SETFIELD",
35 "NEWTABLE",
36 "SELF",
37 "ADDI",
38 "ADDK",
39 "SUBK",
40 "MULK",
41 "MODK",
42 "POWK",
43 "DIVK",
44 "IDIVK",
45 "BANDK",
46 "BORK",
47 "BXORK",
48 "SHRI",
49 "SHLI",
50 "ADD",
51 "SUB",
52 "MUL",
53 "MOD",
54 "POW",
55 "DIV",
56 "IDIV",
57 "BAND",
58 "BOR",
59 "BXOR",
60 "SHL",
61 "SHR",
62 "MMBIN",
63 "MMBINI",
64 "MMBINK",
65 "UNM",
66 "BNOT",
67 "NOT",
68 "LEN",
69 "CONCAT",
70 "CLOSE",
71 "TBC",
72 "JMP",
73 "EQ",
74 "LT",
75 "LE",
76 "EQK",
77 "EQI",
78 "LTI",
79 "LEI",
80 "GTI",
81 "GEI",
82 "TEST",
83 "TESTSET",
84 "CALL",
85 "TAILCALL",
86 "RETURN",
87 "RETURN0",
88 "RETURN1",
89 "FORLOOP",
90 "FORPREP",
91 "TFORPREP",
92 "TFORCALL",
93 "TFORLOOP",
94 "SETLIST",
95 "CLOSURE",
96 "VARARG",
97 "VARARGPREP",
98 "EXTRAARG",
99 NULL
100};
101
102#endif
103
diff --git a/src/lua/loslib.c b/src/lua/loslib.c
new file mode 100644
index 0000000..e65e188
--- /dev/null
+++ b/src/lua/loslib.c
@@ -0,0 +1,430 @@
1/*
2** $Id: loslib.c $
3** Standard Operating System library
4** See Copyright Notice in lua.h
5*/
6
7#define loslib_c
8#define LUA_LIB
9
10#include "lprefix.h"
11
12
13#include <errno.h>
14#include <locale.h>
15#include <stdlib.h>
16#include <string.h>
17#include <time.h>
18
19#include "lua.h"
20
21#include "lauxlib.h"
22#include "lualib.h"
23
24
25/*
26** {==================================================================
27** List of valid conversion specifiers for the 'strftime' function;
28** options are grouped by length; group of length 2 start with '||'.
29** ===================================================================
30*/
31#if !defined(LUA_STRFTIMEOPTIONS) /* { */
32
33/* options for ANSI C 89 (only 1-char options) */
34#define L_STRFTIMEC89 "aAbBcdHIjmMpSUwWxXyYZ%"
35
36/* options for ISO C 99 and POSIX */
37#define L_STRFTIMEC99 "aAbBcCdDeFgGhHIjmMnprRStTuUVwWxXyYzZ%" \
38 "||" "EcECExEXEyEY" "OdOeOHOIOmOMOSOuOUOVOwOWOy" /* two-char options */
39
40/* options for Windows */
41#define L_STRFTIMEWIN "aAbBcdHIjmMpSUwWxXyYzZ%" \
42 "||" "#c#x#d#H#I#j#m#M#S#U#w#W#y#Y" /* two-char options */
43
44#if defined(LUA_USE_WINDOWS)
45#define LUA_STRFTIMEOPTIONS L_STRFTIMEWIN
46#elif defined(LUA_USE_C89)
47#define LUA_STRFTIMEOPTIONS L_STRFTIMEC89
48#else /* C99 specification */
49#define LUA_STRFTIMEOPTIONS L_STRFTIMEC99
50#endif
51
52#endif /* } */
53/* }================================================================== */
54
55
56/*
57** {==================================================================
58** Configuration for time-related stuff
59** ===================================================================
60*/
61
62/*
63** type to represent time_t in Lua
64*/
65#if !defined(LUA_NUMTIME) /* { */
66
67#define l_timet lua_Integer
68#define l_pushtime(L,t) lua_pushinteger(L,(lua_Integer)(t))
69#define l_gettime(L,arg) luaL_checkinteger(L, arg)
70
71#else /* }{ */
72
73#define l_timet lua_Number
74#define l_pushtime(L,t) lua_pushnumber(L,(lua_Number)(t))
75#define l_gettime(L,arg) luaL_checknumber(L, arg)
76
77#endif /* } */
78
79
80#if !defined(l_gmtime) /* { */
81/*
82** By default, Lua uses gmtime/localtime, except when POSIX is available,
83** where it uses gmtime_r/localtime_r
84*/
85
86#if defined(LUA_USE_POSIX) /* { */
87
88#define l_gmtime(t,r) gmtime_r(t,r)
89#define l_localtime(t,r) localtime_r(t,r)
90
91#else /* }{ */
92
93/* ISO C definitions */
94#define l_gmtime(t,r) ((void)(r)->tm_sec, gmtime(t))
95#define l_localtime(t,r) ((void)(r)->tm_sec, localtime(t))
96
97#endif /* } */
98
99#endif /* } */
100
101/* }================================================================== */
102
103
104/*
105** {==================================================================
106** Configuration for 'tmpnam':
107** By default, Lua uses tmpnam except when POSIX is available, where
108** it uses mkstemp.
109** ===================================================================
110*/
111#if !defined(lua_tmpnam) /* { */
112
113#if defined(LUA_USE_POSIX) /* { */
114
115#include <unistd.h>
116
117#define LUA_TMPNAMBUFSIZE 32
118
119#if !defined(LUA_TMPNAMTEMPLATE)
120#define LUA_TMPNAMTEMPLATE "/tmp/lua_XXXXXX"
121#endif
122
123#define lua_tmpnam(b,e) { \
124 strcpy(b, LUA_TMPNAMTEMPLATE); \
125 e = mkstemp(b); \
126 if (e != -1) close(e); \
127 e = (e == -1); }
128
129#else /* }{ */
130
131/* ISO C definitions */
132#define LUA_TMPNAMBUFSIZE L_tmpnam
133#define lua_tmpnam(b,e) { e = (tmpnam(b) == NULL); }
134
135#endif /* } */
136
137#endif /* } */
138/* }================================================================== */
139
140
141
142static int os_execute (lua_State *L) {
143 const char *cmd = luaL_optstring(L, 1, NULL);
144 int stat;
145 errno = 0;
146 stat = system(cmd);
147 if (cmd != NULL)
148 return luaL_execresult(L, stat);
149 else {
150 lua_pushboolean(L, stat); /* true if there is a shell */
151 return 1;
152 }
153}
154
155
156static int os_remove (lua_State *L) {
157 const char *filename = luaL_checkstring(L, 1);
158 return luaL_fileresult(L, remove(filename) == 0, filename);
159}
160
161
162static int os_rename (lua_State *L) {
163 const char *fromname = luaL_checkstring(L, 1);
164 const char *toname = luaL_checkstring(L, 2);
165 return luaL_fileresult(L, rename(fromname, toname) == 0, NULL);
166}
167
168
169static int os_tmpname (lua_State *L) {
170 char buff[LUA_TMPNAMBUFSIZE];
171 int err;
172 lua_tmpnam(buff, err);
173 if (err)
174 return luaL_error(L, "unable to generate a unique filename");
175 lua_pushstring(L, buff);
176 return 1;
177}
178
179
180static int os_getenv (lua_State *L) {
181 lua_pushstring(L, getenv(luaL_checkstring(L, 1))); /* if NULL push nil */
182 return 1;
183}
184
185
186static int os_clock (lua_State *L) {
187 lua_pushnumber(L, ((lua_Number)clock())/(lua_Number)CLOCKS_PER_SEC);
188 return 1;
189}
190
191
192/*
193** {======================================================
194** Time/Date operations
195** { year=%Y, month=%m, day=%d, hour=%H, min=%M, sec=%S,
196** wday=%w+1, yday=%j, isdst=? }
197** =======================================================
198*/
199
200/*
201** About the overflow check: an overflow cannot occur when time
202** is represented by a lua_Integer, because either lua_Integer is
203** large enough to represent all int fields or it is not large enough
204** to represent a time that cause a field to overflow. However, if
205** times are represented as doubles and lua_Integer is int, then the
206** time 0x1.e1853b0d184f6p+55 would cause an overflow when adding 1900
207** to compute the year.
208*/
209static void setfield (lua_State *L, const char *key, int value, int delta) {
210 #if (defined(LUA_NUMTIME) && LUA_MAXINTEGER <= INT_MAX)
211 if (value > LUA_MAXINTEGER - delta)
212 luaL_error(L, "field '%s' is out-of-bound", key);
213 #endif
214 lua_pushinteger(L, (lua_Integer)value + delta);
215 lua_setfield(L, -2, key);
216}
217
218
219static void setboolfield (lua_State *L, const char *key, int value) {
220 if (value < 0) /* undefined? */
221 return; /* does not set field */
222 lua_pushboolean(L, value);
223 lua_setfield(L, -2, key);
224}
225
226
227/*
228** Set all fields from structure 'tm' in the table on top of the stack
229*/
230static void setallfields (lua_State *L, struct tm *stm) {
231 setfield(L, "year", stm->tm_year, 1900);
232 setfield(L, "month", stm->tm_mon, 1);
233 setfield(L, "day", stm->tm_mday, 0);
234 setfield(L, "hour", stm->tm_hour, 0);
235 setfield(L, "min", stm->tm_min, 0);
236 setfield(L, "sec", stm->tm_sec, 0);
237 setfield(L, "yday", stm->tm_yday, 1);
238 setfield(L, "wday", stm->tm_wday, 1);
239 setboolfield(L, "isdst", stm->tm_isdst);
240}
241
242
243static int getboolfield (lua_State *L, const char *key) {
244 int res;
245 res = (lua_getfield(L, -1, key) == LUA_TNIL) ? -1 : lua_toboolean(L, -1);
246 lua_pop(L, 1);
247 return res;
248}
249
250
251static int getfield (lua_State *L, const char *key, int d, int delta) {
252 int isnum;
253 int t = lua_getfield(L, -1, key); /* get field and its type */
254 lua_Integer res = lua_tointegerx(L, -1, &isnum);
255 if (!isnum) { /* field is not an integer? */
256 if (t != LUA_TNIL) /* some other value? */
257 return luaL_error(L, "field '%s' is not an integer", key);
258 else if (d < 0) /* absent field; no default? */
259 return luaL_error(L, "field '%s' missing in date table", key);
260 res = d;
261 }
262 else {
263 /* unsigned avoids overflow when lua_Integer has 32 bits */
264 if (!(res >= 0 ? (lua_Unsigned)res <= (lua_Unsigned)INT_MAX + delta
265 : (lua_Integer)INT_MIN + delta <= res))
266 return luaL_error(L, "field '%s' is out-of-bound", key);
267 res -= delta;
268 }
269 lua_pop(L, 1);
270 return (int)res;
271}
272
273
274static const char *checkoption (lua_State *L, const char *conv,
275 ptrdiff_t convlen, char *buff) {
276 const char *option = LUA_STRFTIMEOPTIONS;
277 int oplen = 1; /* length of options being checked */
278 for (; *option != '\0' && oplen <= convlen; option += oplen) {
279 if (*option == '|') /* next block? */
280 oplen++; /* will check options with next length (+1) */
281 else if (memcmp(conv, option, oplen) == 0) { /* match? */
282 memcpy(buff, conv, oplen); /* copy valid option to buffer */
283 buff[oplen] = '\0';
284 return conv + oplen; /* return next item */
285 }
286 }
287 luaL_argerror(L, 1,
288 lua_pushfstring(L, "invalid conversion specifier '%%%s'", conv));
289 return conv; /* to avoid warnings */
290}
291
292
293static time_t l_checktime (lua_State *L, int arg) {
294 l_timet t = l_gettime(L, arg);
295 luaL_argcheck(L, (time_t)t == t, arg, "time out-of-bounds");
296 return (time_t)t;
297}
298
299
300/* maximum size for an individual 'strftime' item */
301#define SIZETIMEFMT 250
302
303
304static int os_date (lua_State *L) {
305 size_t slen;
306 const char *s = luaL_optlstring(L, 1, "%c", &slen);
307 time_t t = luaL_opt(L, l_checktime, 2, time(NULL));
308 const char *se = s + slen; /* 's' end */
309 struct tm tmr, *stm;
310 if (*s == '!') { /* UTC? */
311 stm = l_gmtime(&t, &tmr);
312 s++; /* skip '!' */
313 }
314 else
315 stm = l_localtime(&t, &tmr);
316 if (stm == NULL) /* invalid date? */
317 return luaL_error(L,
318 "date result cannot be represented in this installation");
319 if (strcmp(s, "*t") == 0) {
320 lua_createtable(L, 0, 9); /* 9 = number of fields */
321 setallfields(L, stm);
322 }
323 else {
324 char cc[4]; /* buffer for individual conversion specifiers */
325 luaL_Buffer b;
326 cc[0] = '%';
327 luaL_buffinit(L, &b);
328 while (s < se) {
329 if (*s != '%') /* not a conversion specifier? */
330 luaL_addchar(&b, *s++);
331 else {
332 size_t reslen;
333 char *buff = luaL_prepbuffsize(&b, SIZETIMEFMT);
334 s++; /* skip '%' */
335 s = checkoption(L, s, se - s, cc + 1); /* copy specifier to 'cc' */
336 reslen = strftime(buff, SIZETIMEFMT, cc, stm);
337 luaL_addsize(&b, reslen);
338 }
339 }
340 luaL_pushresult(&b);
341 }
342 return 1;
343}
344
345
346static int os_time (lua_State *L) {
347 time_t t;
348 if (lua_isnoneornil(L, 1)) /* called without args? */
349 t = time(NULL); /* get current time */
350 else {
351 struct tm ts;
352 luaL_checktype(L, 1, LUA_TTABLE);
353 lua_settop(L, 1); /* make sure table is at the top */
354 ts.tm_year = getfield(L, "year", -1, 1900);
355 ts.tm_mon = getfield(L, "month", -1, 1);
356 ts.tm_mday = getfield(L, "day", -1, 0);
357 ts.tm_hour = getfield(L, "hour", 12, 0);
358 ts.tm_min = getfield(L, "min", 0, 0);
359 ts.tm_sec = getfield(L, "sec", 0, 0);
360 ts.tm_isdst = getboolfield(L, "isdst");
361 t = mktime(&ts);
362 setallfields(L, &ts); /* update fields with normalized values */
363 }
364 if (t != (time_t)(l_timet)t || t == (time_t)(-1))
365 return luaL_error(L,
366 "time result cannot be represented in this installation");
367 l_pushtime(L, t);
368 return 1;
369}
370
371
372static int os_difftime (lua_State *L) {
373 time_t t1 = l_checktime(L, 1);
374 time_t t2 = l_checktime(L, 2);
375 lua_pushnumber(L, (lua_Number)difftime(t1, t2));
376 return 1;
377}
378
379/* }====================================================== */
380
381
382static int os_setlocale (lua_State *L) {
383 static const int cat[] = {LC_ALL, LC_COLLATE, LC_CTYPE, LC_MONETARY,
384 LC_NUMERIC, LC_TIME};
385 static const char *const catnames[] = {"all", "collate", "ctype", "monetary",
386 "numeric", "time", NULL};
387 const char *l = luaL_optstring(L, 1, NULL);
388 int op = luaL_checkoption(L, 2, "all", catnames);
389 lua_pushstring(L, setlocale(cat[op], l));
390 return 1;
391}
392
393
394static int os_exit (lua_State *L) {
395 int status;
396 if (lua_isboolean(L, 1))
397 status = (lua_toboolean(L, 1) ? EXIT_SUCCESS : EXIT_FAILURE);
398 else
399 status = (int)luaL_optinteger(L, 1, EXIT_SUCCESS);
400 if (lua_toboolean(L, 2))
401 lua_close(L);
402 if (L) exit(status); /* 'if' to avoid warnings for unreachable 'return' */
403 return 0;
404}
405
406
407static const luaL_Reg syslib[] = {
408 {"clock", os_clock},
409 {"date", os_date},
410 {"difftime", os_difftime},
411 {"execute", os_execute},
412 {"exit", os_exit},
413 {"getenv", os_getenv},
414 {"remove", os_remove},
415 {"rename", os_rename},
416 {"setlocale", os_setlocale},
417 {"time", os_time},
418 {"tmpname", os_tmpname},
419 {NULL, NULL}
420};
421
422/* }====================================================== */
423
424
425
426LUAMOD_API int luaopen_os (lua_State *L) {
427 luaL_newlib(L, syslib);
428 return 1;
429}
430
diff --git a/src/lua/lparser.c b/src/lua/lparser.c
new file mode 100644
index 0000000..bc7d9a4
--- /dev/null
+++ b/src/lua/lparser.c
@@ -0,0 +1,1996 @@
1/*
2** $Id: lparser.c $
3** Lua Parser
4** See Copyright Notice in lua.h
5*/
6
7#define lparser_c
8#define LUA_CORE
9
10#include "lprefix.h"
11
12
13#include <limits.h>
14#include <string.h>
15
16#include "lua.h"
17
18#include "lcode.h"
19#include "ldebug.h"
20#include "ldo.h"
21#include "lfunc.h"
22#include "llex.h"
23#include "lmem.h"
24#include "lobject.h"
25#include "lopcodes.h"
26#include "lparser.h"
27#include "lstate.h"
28#include "lstring.h"
29#include "ltable.h"
30
31
32
33/* maximum number of local variables per function (must be smaller
34 than 250, due to the bytecode format) */
35#define MAXVARS 200
36
37
38#define hasmultret(k) ((k) == VCALL || (k) == VVARARG)
39
40
41/* because all strings are unified by the scanner, the parser
42 can use pointer equality for string equality */
43#define eqstr(a,b) ((a) == (b))
44
45
46/*
47** nodes for block list (list of active blocks)
48*/
49typedef struct BlockCnt {
50 struct BlockCnt *previous; /* chain */
51 int firstlabel; /* index of first label in this block */
52 int firstgoto; /* index of first pending goto in this block */
53 lu_byte nactvar; /* # active locals outside the block */
54 lu_byte upval; /* true if some variable in the block is an upvalue */
55 lu_byte isloop; /* true if 'block' is a loop */
56 lu_byte insidetbc; /* true if inside the scope of a to-be-closed var. */
57} BlockCnt;
58
59
60
61/*
62** prototypes for recursive non-terminal functions
63*/
64static void statement (LexState *ls);
65static void expr (LexState *ls, expdesc *v);
66
67
68static l_noret error_expected (LexState *ls, int token) {
69 luaX_syntaxerror(ls,
70 luaO_pushfstring(ls->L, "%s expected", luaX_token2str(ls, token)));
71}
72
73
74static l_noret errorlimit (FuncState *fs, int limit, const char *what) {
75 lua_State *L = fs->ls->L;
76 const char *msg;
77 int line = fs->f->linedefined;
78 const char *where = (line == 0)
79 ? "main function"
80 : luaO_pushfstring(L, "function at line %d", line);
81 msg = luaO_pushfstring(L, "too many %s (limit is %d) in %s",
82 what, limit, where);
83 luaX_syntaxerror(fs->ls, msg);
84}
85
86
87static void checklimit (FuncState *fs, int v, int l, const char *what) {
88 if (v > l) errorlimit(fs, l, what);
89}
90
91
92/*
93** Test whether next token is 'c'; if so, skip it.
94*/
95static int testnext (LexState *ls, int c) {
96 if (ls->t.token == c) {
97 luaX_next(ls);
98 return 1;
99 }
100 else return 0;
101}
102
103
104/*
105** Check that next token is 'c'.
106*/
107static void check (LexState *ls, int c) {
108 if (ls->t.token != c)
109 error_expected(ls, c);
110}
111
112
113/*
114** Check that next token is 'c' and skip it.
115*/
116static void checknext (LexState *ls, int c) {
117 check(ls, c);
118 luaX_next(ls);
119}
120
121
122#define check_condition(ls,c,msg) { if (!(c)) luaX_syntaxerror(ls, msg); }
123
124
125/*
126** Check that next token is 'what' and skip it. In case of error,
127** raise an error that the expected 'what' should match a 'who'
128** in line 'where' (if that is not the current line).
129*/
130static void check_match (LexState *ls, int what, int who, int where) {
131 if (unlikely(!testnext(ls, what))) {
132 if (where == ls->linenumber) /* all in the same line? */
133 error_expected(ls, what); /* do not need a complex message */
134 else {
135 luaX_syntaxerror(ls, luaO_pushfstring(ls->L,
136 "%s expected (to close %s at line %d)",
137 luaX_token2str(ls, what), luaX_token2str(ls, who), where));
138 }
139 }
140}
141
142
143static TString *str_checkname (LexState *ls) {
144 TString *ts;
145 check(ls, TK_NAME);
146 ts = ls->t.seminfo.ts;
147 luaX_next(ls);
148 return ts;
149}
150
151
152static void init_exp (expdesc *e, expkind k, int i) {
153 e->f = e->t = NO_JUMP;
154 e->k = k;
155 e->u.info = i;
156}
157
158
159static void codestring (expdesc *e, TString *s) {
160 e->f = e->t = NO_JUMP;
161 e->k = VKSTR;
162 e->u.strval = s;
163}
164
165
166static void codename (LexState *ls, expdesc *e) {
167 codestring(e, str_checkname(ls));
168}
169
170
171/*
172** Register a new local variable in the active 'Proto' (for debug
173** information).
174*/
175static int registerlocalvar (LexState *ls, FuncState *fs, TString *varname) {
176 Proto *f = fs->f;
177 int oldsize = f->sizelocvars;
178 luaM_growvector(ls->L, f->locvars, fs->ndebugvars, f->sizelocvars,
179 LocVar, SHRT_MAX, "local variables");
180 while (oldsize < f->sizelocvars)
181 f->locvars[oldsize++].varname = NULL;
182 f->locvars[fs->ndebugvars].varname = varname;
183 f->locvars[fs->ndebugvars].startpc = fs->pc;
184 luaC_objbarrier(ls->L, f, varname);
185 return fs->ndebugvars++;
186}
187
188
189/*
190** Create a new local variable with the given 'name'. Return its index
191** in the function.
192*/
193static int new_localvar (LexState *ls, TString *name) {
194 lua_State *L = ls->L;
195 FuncState *fs = ls->fs;
196 Dyndata *dyd = ls->dyd;
197 Vardesc *var;
198 checklimit(fs, dyd->actvar.n + 1 - fs->firstlocal,
199 MAXVARS, "local variables");
200 luaM_growvector(L, dyd->actvar.arr, dyd->actvar.n + 1,
201 dyd->actvar.size, Vardesc, USHRT_MAX, "local variables");
202 var = &dyd->actvar.arr[dyd->actvar.n++];
203 var->vd.kind = VDKREG; /* default */
204 var->vd.name = name;
205 return dyd->actvar.n - 1 - fs->firstlocal;
206}
207
208#define new_localvarliteral(ls,v) \
209 new_localvar(ls, \
210 luaX_newstring(ls, "" v, (sizeof(v)/sizeof(char)) - 1));
211
212
213
214/*
215** Return the "variable description" (Vardesc) of a given variable.
216** (Unless noted otherwise, all variables are referred to by their
217** compiler indices.)
218*/
219static Vardesc *getlocalvardesc (FuncState *fs, int vidx) {
220 return &fs->ls->dyd->actvar.arr[fs->firstlocal + vidx];
221}
222
223
224/*
225** Convert 'nvar', a compiler index level, to it corresponding
226** stack index level. For that, search for the highest variable
227** below that level that is in the stack and uses its stack
228** index ('sidx').
229*/
230static int stacklevel (FuncState *fs, int nvar) {
231 while (nvar-- > 0) {
232 Vardesc *vd = getlocalvardesc(fs, nvar); /* get variable */
233 if (vd->vd.kind != RDKCTC) /* is in the stack? */
234 return vd->vd.sidx + 1;
235 }
236 return 0; /* no variables in the stack */
237}
238
239
240/*
241** Return the number of variables in the stack for function 'fs'
242*/
243int luaY_nvarstack (FuncState *fs) {
244 return stacklevel(fs, fs->nactvar);
245}
246
247
248/*
249** Get the debug-information entry for current variable 'vidx'.
250*/
251static LocVar *localdebuginfo (FuncState *fs, int vidx) {
252 Vardesc *vd = getlocalvardesc(fs, vidx);
253 if (vd->vd.kind == RDKCTC)
254 return NULL; /* no debug info. for constants */
255 else {
256 int idx = vd->vd.pidx;
257 lua_assert(idx < fs->ndebugvars);
258 return &fs->f->locvars[idx];
259 }
260}
261
262
263/*
264** Create an expression representing variable 'vidx'
265*/
266static void init_var (FuncState *fs, expdesc *e, int vidx) {
267 e->f = e->t = NO_JUMP;
268 e->k = VLOCAL;
269 e->u.var.vidx = vidx;
270 e->u.var.sidx = getlocalvardesc(fs, vidx)->vd.sidx;
271}
272
273
274/*
275** Raises an error if variable described by 'e' is read only
276*/
277static void check_readonly (LexState *ls, expdesc *e) {
278 FuncState *fs = ls->fs;
279 TString *varname = NULL; /* to be set if variable is const */
280 switch (e->k) {
281 case VCONST: {
282 varname = ls->dyd->actvar.arr[e->u.info].vd.name;
283 break;
284 }
285 case VLOCAL: {
286 Vardesc *vardesc = getlocalvardesc(fs, e->u.var.vidx);
287 if (vardesc->vd.kind != VDKREG) /* not a regular variable? */
288 varname = vardesc->vd.name;
289 break;
290 }
291 case VUPVAL: {
292 Upvaldesc *up = &fs->f->upvalues[e->u.info];
293 if (up->kind != VDKREG)
294 varname = up->name;
295 break;
296 }
297 default:
298 return; /* other cases cannot be read-only */
299 }
300 if (varname) {
301 const char *msg = luaO_pushfstring(ls->L,
302 "attempt to assign to const variable '%s'", getstr(varname));
303 luaK_semerror(ls, msg); /* error */
304 }
305}
306
307
308/*
309** Start the scope for the last 'nvars' created variables.
310*/
311static void adjustlocalvars (LexState *ls, int nvars) {
312 FuncState *fs = ls->fs;
313 int stklevel = luaY_nvarstack(fs);
314 int i;
315 for (i = 0; i < nvars; i++) {
316 int vidx = fs->nactvar++;
317 Vardesc *var = getlocalvardesc(fs, vidx);
318 var->vd.sidx = stklevel++;
319 var->vd.pidx = registerlocalvar(ls, fs, var->vd.name);
320 }
321}
322
323
324/*
325** Close the scope for all variables up to level 'tolevel'.
326** (debug info.)
327*/
328static void removevars (FuncState *fs, int tolevel) {
329 fs->ls->dyd->actvar.n -= (fs->nactvar - tolevel);
330 while (fs->nactvar > tolevel) {
331 LocVar *var = localdebuginfo(fs, --fs->nactvar);
332 if (var) /* does it have debug information? */
333 var->endpc = fs->pc;
334 }
335}
336
337
338/*
339** Search the upvalues of the function 'fs' for one
340** with the given 'name'.
341*/
342static int searchupvalue (FuncState *fs, TString *name) {
343 int i;
344 Upvaldesc *up = fs->f->upvalues;
345 for (i = 0; i < fs->nups; i++) {
346 if (eqstr(up[i].name, name)) return i;
347 }
348 return -1; /* not found */
349}
350
351
352static Upvaldesc *allocupvalue (FuncState *fs) {
353 Proto *f = fs->f;
354 int oldsize = f->sizeupvalues;
355 checklimit(fs, fs->nups + 1, MAXUPVAL, "upvalues");
356 luaM_growvector(fs->ls->L, f->upvalues, fs->nups, f->sizeupvalues,
357 Upvaldesc, MAXUPVAL, "upvalues");
358 while (oldsize < f->sizeupvalues)
359 f->upvalues[oldsize++].name = NULL;
360 return &f->upvalues[fs->nups++];
361}
362
363
364static int newupvalue (FuncState *fs, TString *name, expdesc *v) {
365 Upvaldesc *up = allocupvalue(fs);
366 FuncState *prev = fs->prev;
367 if (v->k == VLOCAL) {
368 up->instack = 1;
369 up->idx = v->u.var.sidx;
370 up->kind = getlocalvardesc(prev, v->u.var.vidx)->vd.kind;
371 lua_assert(eqstr(name, getlocalvardesc(prev, v->u.var.vidx)->vd.name));
372 }
373 else {
374 up->instack = 0;
375 up->idx = cast_byte(v->u.info);
376 up->kind = prev->f->upvalues[v->u.info].kind;
377 lua_assert(eqstr(name, prev->f->upvalues[v->u.info].name));
378 }
379 up->name = name;
380 luaC_objbarrier(fs->ls->L, fs->f, name);
381 return fs->nups - 1;
382}
383
384
385/*
386** Look for an active local variable with the name 'n' in the
387** function 'fs'. If found, initialize 'var' with it and return
388** its expression kind; otherwise return -1.
389*/
390static int searchvar (FuncState *fs, TString *n, expdesc *var) {
391 int i;
392 for (i = cast_int(fs->nactvar) - 1; i >= 0; i--) {
393 Vardesc *vd = getlocalvardesc(fs, i);
394 if (eqstr(n, vd->vd.name)) { /* found? */
395 if (vd->vd.kind == RDKCTC) /* compile-time constant? */
396 init_exp(var, VCONST, fs->firstlocal + i);
397 else /* real variable */
398 init_var(fs, var, i);
399 return var->k;
400 }
401 }
402 return -1; /* not found */
403}
404
405
406/*
407** Mark block where variable at given level was defined
408** (to emit close instructions later).
409*/
410static void markupval (FuncState *fs, int level) {
411 BlockCnt *bl = fs->bl;
412 while (bl->nactvar > level)
413 bl = bl->previous;
414 bl->upval = 1;
415 fs->needclose = 1;
416}
417
418
419/*
420** Find a variable with the given name 'n'. If it is an upvalue, add
421** this upvalue into all intermediate functions. If it is a global, set
422** 'var' as 'void' as a flag.
423*/
424static void singlevaraux (FuncState *fs, TString *n, expdesc *var, int base) {
425 if (fs == NULL) /* no more levels? */
426 init_exp(var, VVOID, 0); /* default is global */
427 else {
428 int v = searchvar(fs, n, var); /* look up locals at current level */
429 if (v >= 0) { /* found? */
430 if (v == VLOCAL && !base)
431 markupval(fs, var->u.var.vidx); /* local will be used as an upval */
432 }
433 else { /* not found as local at current level; try upvalues */
434 int idx = searchupvalue(fs, n); /* try existing upvalues */
435 if (idx < 0) { /* not found? */
436 singlevaraux(fs->prev, n, var, 0); /* try upper levels */
437 if (var->k == VLOCAL || var->k == VUPVAL) /* local or upvalue? */
438 idx = newupvalue(fs, n, var); /* will be a new upvalue */
439 else /* it is a global or a constant */
440 return; /* don't need to do anything at this level */
441 }
442 init_exp(var, VUPVAL, idx); /* new or old upvalue */
443 }
444 }
445}
446
447
448/*
449** Find a variable with the given name 'n', handling global variables
450** too.
451*/
452static void singlevar (LexState *ls, expdesc *var) {
453 TString *varname = str_checkname(ls);
454 FuncState *fs = ls->fs;
455 singlevaraux(fs, varname, var, 1);
456 if (var->k == VVOID) { /* global name? */
457 expdesc key;
458 singlevaraux(fs, ls->envn, var, 1); /* get environment variable */
459 lua_assert(var->k != VVOID); /* this one must exist */
460 codestring(&key, varname); /* key is variable name */
461 luaK_indexed(fs, var, &key); /* env[varname] */
462 }
463}
464
465
466/*
467** Adjust the number of results from an expression list 'e' with 'nexps'
468** expressions to 'nvars' values.
469*/
470static void adjust_assign (LexState *ls, int nvars, int nexps, expdesc *e) {
471 FuncState *fs = ls->fs;
472 int needed = nvars - nexps; /* extra values needed */
473 if (hasmultret(e->k)) { /* last expression has multiple returns? */
474 int extra = needed + 1; /* discount last expression itself */
475 if (extra < 0)
476 extra = 0;
477 luaK_setreturns(fs, e, extra); /* last exp. provides the difference */
478 }
479 else {
480 if (e->k != VVOID) /* at least one expression? */
481 luaK_exp2nextreg(fs, e); /* close last expression */
482 if (needed > 0) /* missing values? */
483 luaK_nil(fs, fs->freereg, needed); /* complete with nils */
484 }
485 if (needed > 0)
486 luaK_reserveregs(fs, needed); /* registers for extra values */
487 else /* adding 'needed' is actually a subtraction */
488 fs->freereg += needed; /* remove extra values */
489}
490
491
492/*
493** Macros to limit the maximum recursion depth while parsing
494*/
495#define enterlevel(ls) luaE_enterCcall((ls)->L)
496
497#define leavelevel(ls) luaE_exitCcall((ls)->L)
498
499
500/*
501** Generates an error that a goto jumps into the scope of some
502** local variable.
503*/
504static l_noret jumpscopeerror (LexState *ls, Labeldesc *gt) {
505 const char *varname = getstr(getlocalvardesc(ls->fs, gt->nactvar)->vd.name);
506 const char *msg = "<goto %s> at line %d jumps into the scope of local '%s'";
507 msg = luaO_pushfstring(ls->L, msg, getstr(gt->name), gt->line, varname);
508 luaK_semerror(ls, msg); /* raise the error */
509}
510
511
512/*
513** Solves the goto at index 'g' to given 'label' and removes it
514** from the list of pending goto's.
515** If it jumps into the scope of some variable, raises an error.
516*/
517static void solvegoto (LexState *ls, int g, Labeldesc *label) {
518 int i;
519 Labellist *gl = &ls->dyd->gt; /* list of goto's */
520 Labeldesc *gt = &gl->arr[g]; /* goto to be resolved */
521 lua_assert(eqstr(gt->name, label->name));
522 if (unlikely(gt->nactvar < label->nactvar)) /* enter some scope? */
523 jumpscopeerror(ls, gt);
524 luaK_patchlist(ls->fs, gt->pc, label->pc);
525 for (i = g; i < gl->n - 1; i++) /* remove goto from pending list */
526 gl->arr[i] = gl->arr[i + 1];
527 gl->n--;
528}
529
530
531/*
532** Search for an active label with the given name.
533*/
534static Labeldesc *findlabel (LexState *ls, TString *name) {
535 int i;
536 Dyndata *dyd = ls->dyd;
537 /* check labels in current function for a match */
538 for (i = ls->fs->firstlabel; i < dyd->label.n; i++) {
539 Labeldesc *lb = &dyd->label.arr[i];
540 if (eqstr(lb->name, name)) /* correct label? */
541 return lb;
542 }
543 return NULL; /* label not found */
544}
545
546
547/*
548** Adds a new label/goto in the corresponding list.
549*/
550static int newlabelentry (LexState *ls, Labellist *l, TString *name,
551 int line, int pc) {
552 int n = l->n;
553 luaM_growvector(ls->L, l->arr, n, l->size,
554 Labeldesc, SHRT_MAX, "labels/gotos");
555 l->arr[n].name = name;
556 l->arr[n].line = line;
557 l->arr[n].nactvar = ls->fs->nactvar;
558 l->arr[n].close = 0;
559 l->arr[n].pc = pc;
560 l->n = n + 1;
561 return n;
562}
563
564
565static int newgotoentry (LexState *ls, TString *name, int line, int pc) {
566 return newlabelentry(ls, &ls->dyd->gt, name, line, pc);
567}
568
569
570/*
571** Solves forward jumps. Check whether new label 'lb' matches any
572** pending gotos in current block and solves them. Return true
573** if any of the goto's need to close upvalues.
574*/
575static int solvegotos (LexState *ls, Labeldesc *lb) {
576 Labellist *gl = &ls->dyd->gt;
577 int i = ls->fs->bl->firstgoto;
578 int needsclose = 0;
579 while (i < gl->n) {
580 if (eqstr(gl->arr[i].name, lb->name)) {
581 needsclose |= gl->arr[i].close;
582 solvegoto(ls, i, lb); /* will remove 'i' from the list */
583 }
584 else
585 i++;
586 }
587 return needsclose;
588}
589
590
591/*
592** Create a new label with the given 'name' at the given 'line'.
593** 'last' tells whether label is the last non-op statement in its
594** block. Solves all pending goto's to this new label and adds
595** a close instruction if necessary.
596** Returns true iff it added a close instruction.
597*/
598static int createlabel (LexState *ls, TString *name, int line,
599 int last) {
600 FuncState *fs = ls->fs;
601 Labellist *ll = &ls->dyd->label;
602 int l = newlabelentry(ls, ll, name, line, luaK_getlabel(fs));
603 if (last) { /* label is last no-op statement in the block? */
604 /* assume that locals are already out of scope */
605 ll->arr[l].nactvar = fs->bl->nactvar;
606 }
607 if (solvegotos(ls, &ll->arr[l])) { /* need close? */
608 luaK_codeABC(fs, OP_CLOSE, luaY_nvarstack(fs), 0, 0);
609 return 1;
610 }
611 return 0;
612}
613
614
615/*
616** Adjust pending gotos to outer level of a block.
617*/
618static void movegotosout (FuncState *fs, BlockCnt *bl) {
619 int i;
620 Labellist *gl = &fs->ls->dyd->gt;
621 /* correct pending gotos to current block */
622 for (i = bl->firstgoto; i < gl->n; i++) { /* for each pending goto */
623 Labeldesc *gt = &gl->arr[i];
624 /* leaving a variable scope? */
625 if (stacklevel(fs, gt->nactvar) > stacklevel(fs, bl->nactvar))
626 gt->close |= bl->upval; /* jump may need a close */
627 gt->nactvar = bl->nactvar; /* update goto level */
628 }
629}
630
631
632static void enterblock (FuncState *fs, BlockCnt *bl, lu_byte isloop) {
633 bl->isloop = isloop;
634 bl->nactvar = fs->nactvar;
635 bl->firstlabel = fs->ls->dyd->label.n;
636 bl->firstgoto = fs->ls->dyd->gt.n;
637 bl->upval = 0;
638 bl->insidetbc = (fs->bl != NULL && fs->bl->insidetbc);
639 bl->previous = fs->bl;
640 fs->bl = bl;
641 lua_assert(fs->freereg == luaY_nvarstack(fs));
642}
643
644
645/*
646** generates an error for an undefined 'goto'.
647*/
648static l_noret undefgoto (LexState *ls, Labeldesc *gt) {
649 const char *msg;
650 if (eqstr(gt->name, luaS_newliteral(ls->L, "break"))) {
651 msg = "break outside loop at line %d";
652 msg = luaO_pushfstring(ls->L, msg, gt->line);
653 }
654 else {
655 msg = "no visible label '%s' for <goto> at line %d";
656 msg = luaO_pushfstring(ls->L, msg, getstr(gt->name), gt->line);
657 }
658 luaK_semerror(ls, msg);
659}
660
661
662static void leaveblock (FuncState *fs) {
663 BlockCnt *bl = fs->bl;
664 LexState *ls = fs->ls;
665 int hasclose = 0;
666 int stklevel = stacklevel(fs, bl->nactvar); /* level outside the block */
667 if (bl->isloop) /* fix pending breaks? */
668 hasclose = createlabel(ls, luaS_newliteral(ls->L, "break"), 0, 0);
669 if (!hasclose && bl->previous && bl->upval)
670 luaK_codeABC(fs, OP_CLOSE, stklevel, 0, 0);
671 fs->bl = bl->previous;
672 removevars(fs, bl->nactvar);
673 lua_assert(bl->nactvar == fs->nactvar);
674 fs->freereg = stklevel; /* free registers */
675 ls->dyd->label.n = bl->firstlabel; /* remove local labels */
676 if (bl->previous) /* inner block? */
677 movegotosout(fs, bl); /* update pending gotos to outer block */
678 else {
679 if (bl->firstgoto < ls->dyd->gt.n) /* pending gotos in outer block? */
680 undefgoto(ls, &ls->dyd->gt.arr[bl->firstgoto]); /* error */
681 }
682}
683
684
685/*
686** adds a new prototype into list of prototypes
687*/
688static Proto *addprototype (LexState *ls) {
689 Proto *clp;
690 lua_State *L = ls->L;
691 FuncState *fs = ls->fs;
692 Proto *f = fs->f; /* prototype of current function */
693 if (fs->np >= f->sizep) {
694 int oldsize = f->sizep;
695 luaM_growvector(L, f->p, fs->np, f->sizep, Proto *, MAXARG_Bx, "functions");
696 while (oldsize < f->sizep)
697 f->p[oldsize++] = NULL;
698 }
699 f->p[fs->np++] = clp = luaF_newproto(L);
700 luaC_objbarrier(L, f, clp);
701 return clp;
702}
703
704
705/*
706** codes instruction to create new closure in parent function.
707** The OP_CLOSURE instruction uses the last available register,
708** so that, if it invokes the GC, the GC knows which registers
709** are in use at that time.
710
711*/
712static void codeclosure (LexState *ls, expdesc *v) {
713 FuncState *fs = ls->fs->prev;
714 init_exp(v, VRELOC, luaK_codeABx(fs, OP_CLOSURE, 0, fs->np - 1));
715 luaK_exp2nextreg(fs, v); /* fix it at the last register */
716}
717
718
719static void open_func (LexState *ls, FuncState *fs, BlockCnt *bl) {
720 Proto *f = fs->f;
721 fs->prev = ls->fs; /* linked list of funcstates */
722 fs->ls = ls;
723 ls->fs = fs;
724 fs->pc = 0;
725 fs->previousline = f->linedefined;
726 fs->iwthabs = 0;
727 fs->lasttarget = 0;
728 fs->freereg = 0;
729 fs->nk = 0;
730 fs->nabslineinfo = 0;
731 fs->np = 0;
732 fs->nups = 0;
733 fs->ndebugvars = 0;
734 fs->nactvar = 0;
735 fs->needclose = 0;
736 fs->firstlocal = ls->dyd->actvar.n;
737 fs->firstlabel = ls->dyd->label.n;
738 fs->bl = NULL;
739 f->source = ls->source;
740 luaC_objbarrier(ls->L, f, f->source);
741 f->maxstacksize = 2; /* registers 0/1 are always valid */
742 enterblock(fs, bl, 0);
743}
744
745
746static void close_func (LexState *ls) {
747 lua_State *L = ls->L;
748 FuncState *fs = ls->fs;
749 Proto *f = fs->f;
750 luaK_ret(fs, luaY_nvarstack(fs), 0); /* final return */
751 leaveblock(fs);
752 lua_assert(fs->bl == NULL);
753 luaK_finish(fs);
754 luaM_shrinkvector(L, f->code, f->sizecode, fs->pc, Instruction);
755 luaM_shrinkvector(L, f->lineinfo, f->sizelineinfo, fs->pc, ls_byte);
756 luaM_shrinkvector(L, f->abslineinfo, f->sizeabslineinfo,
757 fs->nabslineinfo, AbsLineInfo);
758 luaM_shrinkvector(L, f->k, f->sizek, fs->nk, TValue);
759 luaM_shrinkvector(L, f->p, f->sizep, fs->np, Proto *);
760 luaM_shrinkvector(L, f->locvars, f->sizelocvars, fs->ndebugvars, LocVar);
761 luaM_shrinkvector(L, f->upvalues, f->sizeupvalues, fs->nups, Upvaldesc);
762 ls->fs = fs->prev;
763 luaC_checkGC(L);
764}
765
766
767
768/*============================================================*/
769/* GRAMMAR RULES */
770/*============================================================*/
771
772
773/*
774** check whether current token is in the follow set of a block.
775** 'until' closes syntactical blocks, but do not close scope,
776** so it is handled in separate.
777*/
778static int block_follow (LexState *ls, int withuntil) {
779 switch (ls->t.token) {
780 case TK_ELSE: case TK_ELSEIF:
781 case TK_END: case TK_EOS:
782 return 1;
783 case TK_UNTIL: return withuntil;
784 default: return 0;
785 }
786}
787
788
789static void statlist (LexState *ls) {
790 /* statlist -> { stat [';'] } */
791 while (!block_follow(ls, 1)) {
792 if (ls->t.token == TK_RETURN) {
793 statement(ls);
794 return; /* 'return' must be last statement */
795 }
796 statement(ls);
797 }
798}
799
800
801static void fieldsel (LexState *ls, expdesc *v) {
802 /* fieldsel -> ['.' | ':'] NAME */
803 FuncState *fs = ls->fs;
804 expdesc key;
805 luaK_exp2anyregup(fs, v);
806 luaX_next(ls); /* skip the dot or colon */
807 codename(ls, &key);
808 luaK_indexed(fs, v, &key);
809}
810
811
812static void yindex (LexState *ls, expdesc *v) {
813 /* index -> '[' expr ']' */
814 luaX_next(ls); /* skip the '[' */
815 expr(ls, v);
816 luaK_exp2val(ls->fs, v);
817 checknext(ls, ']');
818}
819
820
821/*
822** {======================================================================
823** Rules for Constructors
824** =======================================================================
825*/
826
827
828typedef struct ConsControl {
829 expdesc v; /* last list item read */
830 expdesc *t; /* table descriptor */
831 int nh; /* total number of 'record' elements */
832 int na; /* number of array elements already stored */
833 int tostore; /* number of array elements pending to be stored */
834} ConsControl;
835
836
837static void recfield (LexState *ls, ConsControl *cc) {
838 /* recfield -> (NAME | '['exp']') = exp */
839 FuncState *fs = ls->fs;
840 int reg = ls->fs->freereg;
841 expdesc tab, key, val;
842 if (ls->t.token == TK_NAME) {
843 checklimit(fs, cc->nh, MAX_INT, "items in a constructor");
844 codename(ls, &key);
845 }
846 else /* ls->t.token == '[' */
847 yindex(ls, &key);
848 cc->nh++;
849 checknext(ls, '=');
850 tab = *cc->t;
851 luaK_indexed(fs, &tab, &key);
852 expr(ls, &val);
853 luaK_storevar(fs, &tab, &val);
854 fs->freereg = reg; /* free registers */
855}
856
857
858static void closelistfield (FuncState *fs, ConsControl *cc) {
859 if (cc->v.k == VVOID) return; /* there is no list item */
860 luaK_exp2nextreg(fs, &cc->v);
861 cc->v.k = VVOID;
862 if (cc->tostore == LFIELDS_PER_FLUSH) {
863 luaK_setlist(fs, cc->t->u.info, cc->na, cc->tostore); /* flush */
864 cc->na += cc->tostore;
865 cc->tostore = 0; /* no more items pending */
866 }
867}
868
869
870static void lastlistfield (FuncState *fs, ConsControl *cc) {
871 if (cc->tostore == 0) return;
872 if (hasmultret(cc->v.k)) {
873 luaK_setmultret(fs, &cc->v);
874 luaK_setlist(fs, cc->t->u.info, cc->na, LUA_MULTRET);
875 cc->na--; /* do not count last expression (unknown number of elements) */
876 }
877 else {
878 if (cc->v.k != VVOID)
879 luaK_exp2nextreg(fs, &cc->v);
880 luaK_setlist(fs, cc->t->u.info, cc->na, cc->tostore);
881 }
882 cc->na += cc->tostore;
883}
884
885
886static void listfield (LexState *ls, ConsControl *cc) {
887 /* listfield -> exp */
888 expr(ls, &cc->v);
889 cc->tostore++;
890}
891
892
893static void field (LexState *ls, ConsControl *cc) {
894 /* field -> listfield | recfield */
895 switch(ls->t.token) {
896 case TK_NAME: { /* may be 'listfield' or 'recfield' */
897 if (luaX_lookahead(ls) != '=') /* expression? */
898 listfield(ls, cc);
899 else
900 recfield(ls, cc);
901 break;
902 }
903 case '[': {
904 recfield(ls, cc);
905 break;
906 }
907 default: {
908 listfield(ls, cc);
909 break;
910 }
911 }
912}
913
914
915static void constructor (LexState *ls, expdesc *t) {
916 /* constructor -> '{' [ field { sep field } [sep] ] '}'
917 sep -> ',' | ';' */
918 FuncState *fs = ls->fs;
919 int line = ls->linenumber;
920 int pc = luaK_codeABC(fs, OP_NEWTABLE, 0, 0, 0);
921 ConsControl cc;
922 luaK_code(fs, 0); /* space for extra arg. */
923 cc.na = cc.nh = cc.tostore = 0;
924 cc.t = t;
925 init_exp(t, VNONRELOC, fs->freereg); /* table will be at stack top */
926 luaK_reserveregs(fs, 1);
927 init_exp(&cc.v, VVOID, 0); /* no value (yet) */
928 checknext(ls, '{');
929 do {
930 lua_assert(cc.v.k == VVOID || cc.tostore > 0);
931 if (ls->t.token == '}') break;
932 closelistfield(fs, &cc);
933 field(ls, &cc);
934 } while (testnext(ls, ',') || testnext(ls, ';'));
935 check_match(ls, '}', '{', line);
936 lastlistfield(fs, &cc);
937 luaK_settablesize(fs, pc, t->u.info, cc.na, cc.nh);
938}
939
940/* }====================================================================== */
941
942
943static void setvararg (FuncState *fs, int nparams) {
944 fs->f->is_vararg = 1;
945 luaK_codeABC(fs, OP_VARARGPREP, nparams, 0, 0);
946}
947
948
949static void parlist (LexState *ls) {
950 /* parlist -> [ param { ',' param } ] */
951 FuncState *fs = ls->fs;
952 Proto *f = fs->f;
953 int nparams = 0;
954 int isvararg = 0;
955 if (ls->t.token != ')') { /* is 'parlist' not empty? */
956 do {
957 switch (ls->t.token) {
958 case TK_NAME: { /* param -> NAME */
959 new_localvar(ls, str_checkname(ls));
960 nparams++;
961 break;
962 }
963 case TK_DOTS: { /* param -> '...' */
964 luaX_next(ls);
965 isvararg = 1;
966 break;
967 }
968 default: luaX_syntaxerror(ls, "<name> or '...' expected");
969 }
970 } while (!isvararg && testnext(ls, ','));
971 }
972 adjustlocalvars(ls, nparams);
973 f->numparams = cast_byte(fs->nactvar);
974 if (isvararg)
975 setvararg(fs, f->numparams); /* declared vararg */
976 luaK_reserveregs(fs, fs->nactvar); /* reserve registers for parameters */
977}
978
979
980static void body (LexState *ls, expdesc *e, int ismethod, int line) {
981 /* body -> '(' parlist ')' block END */
982 FuncState new_fs;
983 BlockCnt bl;
984 new_fs.f = addprototype(ls);
985 new_fs.f->linedefined = line;
986 open_func(ls, &new_fs, &bl);
987 checknext(ls, '(');
988 if (ismethod) {
989 new_localvarliteral(ls, "self"); /* create 'self' parameter */
990 adjustlocalvars(ls, 1);
991 }
992 parlist(ls);
993 checknext(ls, ')');
994 statlist(ls);
995 new_fs.f->lastlinedefined = ls->linenumber;
996 check_match(ls, TK_END, TK_FUNCTION, line);
997 codeclosure(ls, e);
998 close_func(ls);
999}
1000
1001
1002static int explist (LexState *ls, expdesc *v) {
1003 /* explist -> expr { ',' expr } */
1004 int n = 1; /* at least one expression */
1005 expr(ls, v);
1006 while (testnext(ls, ',')) {
1007 luaK_exp2nextreg(ls->fs, v);
1008 expr(ls, v);
1009 n++;
1010 }
1011 return n;
1012}
1013
1014
1015static void funcargs (LexState *ls, expdesc *f, int line) {
1016 FuncState *fs = ls->fs;
1017 expdesc args;
1018 int base, nparams;
1019 switch (ls->t.token) {
1020 case '(': { /* funcargs -> '(' [ explist ] ')' */
1021 luaX_next(ls);
1022 if (ls->t.token == ')') /* arg list is empty? */
1023 args.k = VVOID;
1024 else {
1025 explist(ls, &args);
1026 if (hasmultret(args.k))
1027 luaK_setmultret(fs, &args);
1028 }
1029 check_match(ls, ')', '(', line);
1030 break;
1031 }
1032 case '{': { /* funcargs -> constructor */
1033 constructor(ls, &args);
1034 break;
1035 }
1036 case TK_STRING: { /* funcargs -> STRING */
1037 codestring(&args, ls->t.seminfo.ts);
1038 luaX_next(ls); /* must use 'seminfo' before 'next' */
1039 break;
1040 }
1041 default: {
1042 luaX_syntaxerror(ls, "function arguments expected");
1043 }
1044 }
1045 lua_assert(f->k == VNONRELOC);
1046 base = f->u.info; /* base register for call */
1047 if (hasmultret(args.k))
1048 nparams = LUA_MULTRET; /* open call */
1049 else {
1050 if (args.k != VVOID)
1051 luaK_exp2nextreg(fs, &args); /* close last argument */
1052 nparams = fs->freereg - (base+1);
1053 }
1054 init_exp(f, VCALL, luaK_codeABC(fs, OP_CALL, base, nparams+1, 2));
1055 luaK_fixline(fs, line);
1056 fs->freereg = base+1; /* call remove function and arguments and leaves
1057 (unless changed) one result */
1058}
1059
1060
1061
1062
1063/*
1064** {======================================================================
1065** Expression parsing
1066** =======================================================================
1067*/
1068
1069
1070static void primaryexp (LexState *ls, expdesc *v) {
1071 /* primaryexp -> NAME | '(' expr ')' */
1072 switch (ls->t.token) {
1073 case '(': {
1074 int line = ls->linenumber;
1075 luaX_next(ls);
1076 expr(ls, v);
1077 check_match(ls, ')', '(', line);
1078 luaK_dischargevars(ls->fs, v);
1079 return;
1080 }
1081 case TK_NAME: {
1082 singlevar(ls, v);
1083 return;
1084 }
1085 default: {
1086 luaX_syntaxerror(ls, "unexpected symbol");
1087 }
1088 }
1089}
1090
1091
1092static void suffixedexp (LexState *ls, expdesc *v) {
1093 /* suffixedexp ->
1094 primaryexp { '.' NAME | '[' exp ']' | ':' NAME funcargs | funcargs } */
1095 FuncState *fs = ls->fs;
1096 int line = ls->linenumber;
1097 primaryexp(ls, v);
1098 for (;;) {
1099 switch (ls->t.token) {
1100 case '.': { /* fieldsel */
1101 fieldsel(ls, v);
1102 break;
1103 }
1104 case '[': { /* '[' exp ']' */
1105 expdesc key;
1106 luaK_exp2anyregup(fs, v);
1107 yindex(ls, &key);
1108 luaK_indexed(fs, v, &key);
1109 break;
1110 }
1111 case ':': { /* ':' NAME funcargs */
1112 expdesc key;
1113 luaX_next(ls);
1114 codename(ls, &key);
1115 luaK_self(fs, v, &key);
1116 funcargs(ls, v, line);
1117 break;
1118 }
1119 case '(': case TK_STRING: case '{': { /* funcargs */
1120 luaK_exp2nextreg(fs, v);
1121 funcargs(ls, v, line);
1122 break;
1123 }
1124 default: return;
1125 }
1126 }
1127}
1128
1129
1130static void simpleexp (LexState *ls, expdesc *v) {
1131 /* simpleexp -> FLT | INT | STRING | NIL | TRUE | FALSE | ... |
1132 constructor | FUNCTION body | suffixedexp */
1133 switch (ls->t.token) {
1134 case TK_FLT: {
1135 init_exp(v, VKFLT, 0);
1136 v->u.nval = ls->t.seminfo.r;
1137 break;
1138 }
1139 case TK_INT: {
1140 init_exp(v, VKINT, 0);
1141 v->u.ival = ls->t.seminfo.i;
1142 break;
1143 }
1144 case TK_STRING: {
1145 codestring(v, ls->t.seminfo.ts);
1146 break;
1147 }
1148 case TK_NIL: {
1149 init_exp(v, VNIL, 0);
1150 break;
1151 }
1152 case TK_TRUE: {
1153 init_exp(v, VTRUE, 0);
1154 break;
1155 }
1156 case TK_FALSE: {
1157 init_exp(v, VFALSE, 0);
1158 break;
1159 }
1160 case TK_DOTS: { /* vararg */
1161 FuncState *fs = ls->fs;
1162 check_condition(ls, fs->f->is_vararg,
1163 "cannot use '...' outside a vararg function");
1164 init_exp(v, VVARARG, luaK_codeABC(fs, OP_VARARG, 0, 0, 1));
1165 break;
1166 }
1167 case '{': { /* constructor */
1168 constructor(ls, v);
1169 return;
1170 }
1171 case TK_FUNCTION: {
1172 luaX_next(ls);
1173 body(ls, v, 0, ls->linenumber);
1174 return;
1175 }
1176 default: {
1177 suffixedexp(ls, v);
1178 return;
1179 }
1180 }
1181 luaX_next(ls);
1182}
1183
1184
1185static UnOpr getunopr (int op) {
1186 switch (op) {
1187 case TK_NOT: return OPR_NOT;
1188 case '-': return OPR_MINUS;
1189 case '~': return OPR_BNOT;
1190 case '#': return OPR_LEN;
1191 default: return OPR_NOUNOPR;
1192 }
1193}
1194
1195
1196static BinOpr getbinopr (int op) {
1197 switch (op) {
1198 case '+': return OPR_ADD;
1199 case '-': return OPR_SUB;
1200 case '*': return OPR_MUL;
1201 case '%': return OPR_MOD;
1202 case '^': return OPR_POW;
1203 case '/': return OPR_DIV;
1204 case TK_IDIV: return OPR_IDIV;
1205 case '&': return OPR_BAND;
1206 case '|': return OPR_BOR;
1207 case '~': return OPR_BXOR;
1208 case TK_SHL: return OPR_SHL;
1209 case TK_SHR: return OPR_SHR;
1210 case TK_CONCAT: return OPR_CONCAT;
1211 case TK_NE: return OPR_NE;
1212 case TK_EQ: return OPR_EQ;
1213 case '<': return OPR_LT;
1214 case TK_LE: return OPR_LE;
1215 case '>': return OPR_GT;
1216 case TK_GE: return OPR_GE;
1217 case TK_AND: return OPR_AND;
1218 case TK_OR: return OPR_OR;
1219 default: return OPR_NOBINOPR;
1220 }
1221}
1222
1223
1224/*
1225** Priority table for binary operators.
1226*/
1227static const struct {
1228 lu_byte left; /* left priority for each binary operator */
1229 lu_byte right; /* right priority */
1230} priority[] = { /* ORDER OPR */
1231 {10, 10}, {10, 10}, /* '+' '-' */
1232 {11, 11}, {11, 11}, /* '*' '%' */
1233 {14, 13}, /* '^' (right associative) */
1234 {11, 11}, {11, 11}, /* '/' '//' */
1235 {6, 6}, {4, 4}, {5, 5}, /* '&' '|' '~' */
1236 {7, 7}, {7, 7}, /* '<<' '>>' */
1237 {9, 8}, /* '..' (right associative) */
1238 {3, 3}, {3, 3}, {3, 3}, /* ==, <, <= */
1239 {3, 3}, {3, 3}, {3, 3}, /* ~=, >, >= */
1240 {2, 2}, {1, 1} /* and, or */
1241};
1242
1243#define UNARY_PRIORITY 12 /* priority for unary operators */
1244
1245
1246/*
1247** subexpr -> (simpleexp | unop subexpr) { binop subexpr }
1248** where 'binop' is any binary operator with a priority higher than 'limit'
1249*/
1250static BinOpr subexpr (LexState *ls, expdesc *v, int limit) {
1251 BinOpr op;
1252 UnOpr uop;
1253 enterlevel(ls);
1254 uop = getunopr(ls->t.token);
1255 if (uop != OPR_NOUNOPR) { /* prefix (unary) operator? */
1256 int line = ls->linenumber;
1257 luaX_next(ls); /* skip operator */
1258 subexpr(ls, v, UNARY_PRIORITY);
1259 luaK_prefix(ls->fs, uop, v, line);
1260 }
1261 else simpleexp(ls, v);
1262 /* expand while operators have priorities higher than 'limit' */
1263 op = getbinopr(ls->t.token);
1264 while (op != OPR_NOBINOPR && priority[op].left > limit) {
1265 expdesc v2;
1266 BinOpr nextop;
1267 int line = ls->linenumber;
1268 luaX_next(ls); /* skip operator */
1269 luaK_infix(ls->fs, op, v);
1270 /* read sub-expression with higher priority */
1271 nextop = subexpr(ls, &v2, priority[op].right);
1272 luaK_posfix(ls->fs, op, v, &v2, line);
1273 op = nextop;
1274 }
1275 leavelevel(ls);
1276 return op; /* return first untreated operator */
1277}
1278
1279
1280static void expr (LexState *ls, expdesc *v) {
1281 subexpr(ls, v, 0);
1282}
1283
1284/* }==================================================================== */
1285
1286
1287
1288/*
1289** {======================================================================
1290** Rules for Statements
1291** =======================================================================
1292*/
1293
1294
1295static void block (LexState *ls) {
1296 /* block -> statlist */
1297 FuncState *fs = ls->fs;
1298 BlockCnt bl;
1299 enterblock(fs, &bl, 0);
1300 statlist(ls);
1301 leaveblock(fs);
1302}
1303
1304
1305/*
1306** structure to chain all variables in the left-hand side of an
1307** assignment
1308*/
1309struct LHS_assign {
1310 struct LHS_assign *prev;
1311 expdesc v; /* variable (global, local, upvalue, or indexed) */
1312};
1313
1314
1315/*
1316** check whether, in an assignment to an upvalue/local variable, the
1317** upvalue/local variable is begin used in a previous assignment to a
1318** table. If so, save original upvalue/local value in a safe place and
1319** use this safe copy in the previous assignment.
1320*/
1321static void check_conflict (LexState *ls, struct LHS_assign *lh, expdesc *v) {
1322 FuncState *fs = ls->fs;
1323 int extra = fs->freereg; /* eventual position to save local variable */
1324 int conflict = 0;
1325 for (; lh; lh = lh->prev) { /* check all previous assignments */
1326 if (vkisindexed(lh->v.k)) { /* assignment to table field? */
1327 if (lh->v.k == VINDEXUP) { /* is table an upvalue? */
1328 if (v->k == VUPVAL && lh->v.u.ind.t == v->u.info) {
1329 conflict = 1; /* table is the upvalue being assigned now */
1330 lh->v.k = VINDEXSTR;
1331 lh->v.u.ind.t = extra; /* assignment will use safe copy */
1332 }
1333 }
1334 else { /* table is a register */
1335 if (v->k == VLOCAL && lh->v.u.ind.t == v->u.var.sidx) {
1336 conflict = 1; /* table is the local being assigned now */
1337 lh->v.u.ind.t = extra; /* assignment will use safe copy */
1338 }
1339 /* is index the local being assigned? */
1340 if (lh->v.k == VINDEXED && v->k == VLOCAL &&
1341 lh->v.u.ind.idx == v->u.var.sidx) {
1342 conflict = 1;
1343 lh->v.u.ind.idx = extra; /* previous assignment will use safe copy */
1344 }
1345 }
1346 }
1347 }
1348 if (conflict) {
1349 /* copy upvalue/local value to a temporary (in position 'extra') */
1350 if (v->k == VLOCAL)
1351 luaK_codeABC(fs, OP_MOVE, extra, v->u.var.sidx, 0);
1352 else
1353 luaK_codeABC(fs, OP_GETUPVAL, extra, v->u.info, 0);
1354 luaK_reserveregs(fs, 1);
1355 }
1356}
1357
1358/*
1359** Parse and compile a multiple assignment. The first "variable"
1360** (a 'suffixedexp') was already read by the caller.
1361**
1362** assignment -> suffixedexp restassign
1363** restassign -> ',' suffixedexp restassign | '=' explist
1364*/
1365static void restassign (LexState *ls, struct LHS_assign *lh, int nvars) {
1366 expdesc e;
1367 check_condition(ls, vkisvar(lh->v.k), "syntax error");
1368 check_readonly(ls, &lh->v);
1369 if (testnext(ls, ',')) { /* restassign -> ',' suffixedexp restassign */
1370 struct LHS_assign nv;
1371 nv.prev = lh;
1372 suffixedexp(ls, &nv.v);
1373 if (!vkisindexed(nv.v.k))
1374 check_conflict(ls, lh, &nv.v);
1375 enterlevel(ls); /* control recursion depth */
1376 restassign(ls, &nv, nvars+1);
1377 leavelevel(ls);
1378 }
1379 else { /* restassign -> '=' explist */
1380 int nexps;
1381 checknext(ls, '=');
1382 nexps = explist(ls, &e);
1383 if (nexps != nvars)
1384 adjust_assign(ls, nvars, nexps, &e);
1385 else {
1386 luaK_setoneret(ls->fs, &e); /* close last expression */
1387 luaK_storevar(ls->fs, &lh->v, &e);
1388 return; /* avoid default */
1389 }
1390 }
1391 init_exp(&e, VNONRELOC, ls->fs->freereg-1); /* default assignment */
1392 luaK_storevar(ls->fs, &lh->v, &e);
1393}
1394
1395
1396static int cond (LexState *ls) {
1397 /* cond -> exp */
1398 expdesc v;
1399 expr(ls, &v); /* read condition */
1400 if (v.k == VNIL) v.k = VFALSE; /* 'falses' are all equal here */
1401 luaK_goiftrue(ls->fs, &v);
1402 return v.f;
1403}
1404
1405
1406static void gotostat (LexState *ls) {
1407 FuncState *fs = ls->fs;
1408 int line = ls->linenumber;
1409 TString *name = str_checkname(ls); /* label's name */
1410 Labeldesc *lb = findlabel(ls, name);
1411 if (lb == NULL) /* no label? */
1412 /* forward jump; will be resolved when the label is declared */
1413 newgotoentry(ls, name, line, luaK_jump(fs));
1414 else { /* found a label */
1415 /* backward jump; will be resolved here */
1416 int lblevel = stacklevel(fs, lb->nactvar); /* label level */
1417 if (luaY_nvarstack(fs) > lblevel) /* leaving the scope of a variable? */
1418 luaK_codeABC(fs, OP_CLOSE, lblevel, 0, 0);
1419 /* create jump and link it to the label */
1420 luaK_patchlist(fs, luaK_jump(fs), lb->pc);
1421 }
1422}
1423
1424
1425/*
1426** Break statement. Semantically equivalent to "goto break".
1427*/
1428static void breakstat (LexState *ls) {
1429 int line = ls->linenumber;
1430 luaX_next(ls); /* skip break */
1431 newgotoentry(ls, luaS_newliteral(ls->L, "break"), line, luaK_jump(ls->fs));
1432}
1433
1434
1435/*
1436** Check whether there is already a label with the given 'name'.
1437*/
1438static void checkrepeated (LexState *ls, TString *name) {
1439 Labeldesc *lb = findlabel(ls, name);
1440 if (unlikely(lb != NULL)) { /* already defined? */
1441 const char *msg = "label '%s' already defined on line %d";
1442 msg = luaO_pushfstring(ls->L, msg, getstr(name), lb->line);
1443 luaK_semerror(ls, msg); /* error */
1444 }
1445}
1446
1447
1448static void labelstat (LexState *ls, TString *name, int line) {
1449 /* label -> '::' NAME '::' */
1450 checknext(ls, TK_DBCOLON); /* skip double colon */
1451 while (ls->t.token == ';' || ls->t.token == TK_DBCOLON)
1452 statement(ls); /* skip other no-op statements */
1453 checkrepeated(ls, name); /* check for repeated labels */
1454 createlabel(ls, name, line, block_follow(ls, 0));
1455}
1456
1457
1458static void whilestat (LexState *ls, int line) {
1459 /* whilestat -> WHILE cond DO block END */
1460 FuncState *fs = ls->fs;
1461 int whileinit;
1462 int condexit;
1463 BlockCnt bl;
1464 luaX_next(ls); /* skip WHILE */
1465 whileinit = luaK_getlabel(fs);
1466 condexit = cond(ls);
1467 enterblock(fs, &bl, 1);
1468 checknext(ls, TK_DO);
1469 block(ls);
1470 luaK_jumpto(fs, whileinit);
1471 check_match(ls, TK_END, TK_WHILE, line);
1472 leaveblock(fs);
1473 luaK_patchtohere(fs, condexit); /* false conditions finish the loop */
1474}
1475
1476
1477static void repeatstat (LexState *ls, int line) {
1478 /* repeatstat -> REPEAT block UNTIL cond */
1479 int condexit;
1480 FuncState *fs = ls->fs;
1481 int repeat_init = luaK_getlabel(fs);
1482 BlockCnt bl1, bl2;
1483 enterblock(fs, &bl1, 1); /* loop block */
1484 enterblock(fs, &bl2, 0); /* scope block */
1485 luaX_next(ls); /* skip REPEAT */
1486 statlist(ls);
1487 check_match(ls, TK_UNTIL, TK_REPEAT, line);
1488 condexit = cond(ls); /* read condition (inside scope block) */
1489 leaveblock(fs); /* finish scope */
1490 if (bl2.upval) { /* upvalues? */
1491 int exit = luaK_jump(fs); /* normal exit must jump over fix */
1492 luaK_patchtohere(fs, condexit); /* repetition must close upvalues */
1493 luaK_codeABC(fs, OP_CLOSE, stacklevel(fs, bl2.nactvar), 0, 0);
1494 condexit = luaK_jump(fs); /* repeat after closing upvalues */
1495 luaK_patchtohere(fs, exit); /* normal exit comes to here */
1496 }
1497 luaK_patchlist(fs, condexit, repeat_init); /* close the loop */
1498 leaveblock(fs); /* finish loop */
1499}
1500
1501
1502/*
1503** Read an expression and generate code to put its results in next
1504** stack slot.
1505**
1506*/
1507static void exp1 (LexState *ls) {
1508 expdesc e;
1509 expr(ls, &e);
1510 luaK_exp2nextreg(ls->fs, &e);
1511 lua_assert(e.k == VNONRELOC);
1512}
1513
1514
1515/*
1516** Fix for instruction at position 'pc' to jump to 'dest'.
1517** (Jump addresses are relative in Lua). 'back' true means
1518** a back jump.
1519*/
1520static void fixforjump (FuncState *fs, int pc, int dest, int back) {
1521 Instruction *jmp = &fs->f->code[pc];
1522 int offset = dest - (pc + 1);
1523 if (back)
1524 offset = -offset;
1525 if (unlikely(offset > MAXARG_Bx))
1526 luaX_syntaxerror(fs->ls, "control structure too long");
1527 SETARG_Bx(*jmp, offset);
1528}
1529
1530
1531/*
1532** Generate code for a 'for' loop.
1533*/
1534static void forbody (LexState *ls, int base, int line, int nvars, int isgen) {
1535 /* forbody -> DO block */
1536 static const OpCode forprep[2] = {OP_FORPREP, OP_TFORPREP};
1537 static const OpCode forloop[2] = {OP_FORLOOP, OP_TFORLOOP};
1538 BlockCnt bl;
1539 FuncState *fs = ls->fs;
1540 int prep, endfor;
1541 checknext(ls, TK_DO);
1542 prep = luaK_codeABx(fs, forprep[isgen], base, 0);
1543 enterblock(fs, &bl, 0); /* scope for declared variables */
1544 adjustlocalvars(ls, nvars);
1545 luaK_reserveregs(fs, nvars);
1546 block(ls);
1547 leaveblock(fs); /* end of scope for declared variables */
1548 fixforjump(fs, prep, luaK_getlabel(fs), 0);
1549 if (isgen) { /* generic for? */
1550 luaK_codeABC(fs, OP_TFORCALL, base, 0, nvars);
1551 luaK_fixline(fs, line);
1552 }
1553 endfor = luaK_codeABx(fs, forloop[isgen], base, 0);
1554 fixforjump(fs, endfor, prep + 1, 1);
1555 luaK_fixline(fs, line);
1556}
1557
1558
1559static void fornum (LexState *ls, TString *varname, int line) {
1560 /* fornum -> NAME = exp,exp[,exp] forbody */
1561 FuncState *fs = ls->fs;
1562 int base = fs->freereg;
1563 new_localvarliteral(ls, "(for state)");
1564 new_localvarliteral(ls, "(for state)");
1565 new_localvarliteral(ls, "(for state)");
1566 new_localvar(ls, varname);
1567 checknext(ls, '=');
1568 exp1(ls); /* initial value */
1569 checknext(ls, ',');
1570 exp1(ls); /* limit */
1571 if (testnext(ls, ','))
1572 exp1(ls); /* optional step */
1573 else { /* default step = 1 */
1574 luaK_int(fs, fs->freereg, 1);
1575 luaK_reserveregs(fs, 1);
1576 }
1577 adjustlocalvars(ls, 3); /* control variables */
1578 forbody(ls, base, line, 1, 0);
1579}
1580
1581
1582static void forlist (LexState *ls, TString *indexname) {
1583 /* forlist -> NAME {,NAME} IN explist forbody */
1584 FuncState *fs = ls->fs;
1585 expdesc e;
1586 int nvars = 5; /* gen, state, control, toclose, 'indexname' */
1587 int line;
1588 int base = fs->freereg;
1589 /* create control variables */
1590 new_localvarliteral(ls, "(for state)");
1591 new_localvarliteral(ls, "(for state)");
1592 new_localvarliteral(ls, "(for state)");
1593 new_localvarliteral(ls, "(for state)");
1594 /* create declared variables */
1595 new_localvar(ls, indexname);
1596 while (testnext(ls, ',')) {
1597 new_localvar(ls, str_checkname(ls));
1598 nvars++;
1599 }
1600 checknext(ls, TK_IN);
1601 line = ls->linenumber;
1602 adjust_assign(ls, 4, explist(ls, &e), &e);
1603 adjustlocalvars(ls, 4); /* control variables */
1604 markupval(fs, fs->nactvar); /* last control var. must be closed */
1605 luaK_checkstack(fs, 3); /* extra space to call generator */
1606 forbody(ls, base, line, nvars - 4, 1);
1607}
1608
1609
1610static void forstat (LexState *ls, int line) {
1611 /* forstat -> FOR (fornum | forlist) END */
1612 FuncState *fs = ls->fs;
1613 TString *varname;
1614 BlockCnt bl;
1615 enterblock(fs, &bl, 1); /* scope for loop and control variables */
1616 luaX_next(ls); /* skip 'for' */
1617 varname = str_checkname(ls); /* first variable name */
1618 switch (ls->t.token) {
1619 case '=': fornum(ls, varname, line); break;
1620 case ',': case TK_IN: forlist(ls, varname); break;
1621 default: luaX_syntaxerror(ls, "'=' or 'in' expected");
1622 }
1623 check_match(ls, TK_END, TK_FOR, line);
1624 leaveblock(fs); /* loop scope ('break' jumps to this point) */
1625}
1626
1627
1628/*
1629** Check whether next instruction is a single jump (a 'break', a 'goto'
1630** to a forward label, or a 'goto' to a backward label with no variable
1631** to close). If so, set the name of the 'label' it is jumping to
1632** ("break" for a 'break') or to where it is jumping to ('target') and
1633** return true. If not a single jump, leave input unchanged, to be
1634** handled as a regular statement.
1635*/
1636static int issinglejump (LexState *ls, TString **label, int *target) {
1637 if (testnext(ls, TK_BREAK)) { /* a break? */
1638 *label = luaS_newliteral(ls->L, "break");
1639 return 1;
1640 }
1641 else if (ls->t.token != TK_GOTO || luaX_lookahead(ls) != TK_NAME)
1642 return 0; /* not a valid goto */
1643 else {
1644 TString *lname = ls->lookahead.seminfo.ts; /* label's id */
1645 Labeldesc *lb = findlabel(ls, lname);
1646 if (lb) { /* a backward jump? */
1647 /* does it need to close variables? */
1648 if (luaY_nvarstack(ls->fs) > stacklevel(ls->fs, lb->nactvar))
1649 return 0; /* not a single jump; cannot optimize */
1650 *target = lb->pc;
1651 }
1652 else /* jump forward */
1653 *label = lname;
1654 luaX_next(ls); /* skip goto */
1655 luaX_next(ls); /* skip name */
1656 return 1;
1657 }
1658}
1659
1660
1661static void test_then_block (LexState *ls, int *escapelist) {
1662 /* test_then_block -> [IF | ELSEIF] cond THEN block */
1663 BlockCnt bl;
1664 int line;
1665 FuncState *fs = ls->fs;
1666 TString *jlb = NULL;
1667 int target = NO_JUMP;
1668 expdesc v;
1669 int jf; /* instruction to skip 'then' code (if condition is false) */
1670 luaX_next(ls); /* skip IF or ELSEIF */
1671 expr(ls, &v); /* read condition */
1672 checknext(ls, TK_THEN);
1673 line = ls->linenumber;
1674 if (issinglejump(ls, &jlb, &target)) { /* 'if x then goto' ? */
1675 luaK_goiffalse(ls->fs, &v); /* will jump to label if condition is true */
1676 enterblock(fs, &bl, 0); /* must enter block before 'goto' */
1677 if (jlb != NULL) /* forward jump? */
1678 newgotoentry(ls, jlb, line, v.t); /* will be resolved later */
1679 else /* backward jump */
1680 luaK_patchlist(fs, v.t, target); /* jump directly to 'target' */
1681 while (testnext(ls, ';')) {} /* skip semicolons */
1682 if (block_follow(ls, 0)) { /* jump is the entire block? */
1683 leaveblock(fs);
1684 return; /* and that is it */
1685 }
1686 else /* must skip over 'then' part if condition is false */
1687 jf = luaK_jump(fs);
1688 }
1689 else { /* regular case (not a jump) */
1690 luaK_goiftrue(ls->fs, &v); /* skip over block if condition is false */
1691 enterblock(fs, &bl, 0);
1692 jf = v.f;
1693 }
1694 statlist(ls); /* 'then' part */
1695 leaveblock(fs);
1696 if (ls->t.token == TK_ELSE ||
1697 ls->t.token == TK_ELSEIF) /* followed by 'else'/'elseif'? */
1698 luaK_concat(fs, escapelist, luaK_jump(fs)); /* must jump over it */
1699 luaK_patchtohere(fs, jf);
1700}
1701
1702
1703static void ifstat (LexState *ls, int line) {
1704 /* ifstat -> IF cond THEN block {ELSEIF cond THEN block} [ELSE block] END */
1705 FuncState *fs = ls->fs;
1706 int escapelist = NO_JUMP; /* exit list for finished parts */
1707 test_then_block(ls, &escapelist); /* IF cond THEN block */
1708 while (ls->t.token == TK_ELSEIF)
1709 test_then_block(ls, &escapelist); /* ELSEIF cond THEN block */
1710 if (testnext(ls, TK_ELSE))
1711 block(ls); /* 'else' part */
1712 check_match(ls, TK_END, TK_IF, line);
1713 luaK_patchtohere(fs, escapelist); /* patch escape list to 'if' end */
1714}
1715
1716
1717static void localfunc (LexState *ls) {
1718 expdesc b;
1719 FuncState *fs = ls->fs;
1720 int fvar = fs->nactvar; /* function's variable index */
1721 new_localvar(ls, str_checkname(ls)); /* new local variable */
1722 adjustlocalvars(ls, 1); /* enter its scope */
1723 body(ls, &b, 0, ls->linenumber); /* function created in next register */
1724 /* debug information will only see the variable after this point! */
1725 localdebuginfo(fs, fvar)->startpc = fs->pc;
1726}
1727
1728
1729static int getlocalattribute (LexState *ls) {
1730 /* ATTRIB -> ['<' Name '>'] */
1731 if (testnext(ls, '<')) {
1732 const char *attr = getstr(str_checkname(ls));
1733 checknext(ls, '>');
1734 if (strcmp(attr, "const") == 0)
1735 return RDKCONST; /* read-only variable */
1736 else if (strcmp(attr, "close") == 0)
1737 return RDKTOCLOSE; /* to-be-closed variable */
1738 else
1739 luaK_semerror(ls,
1740 luaO_pushfstring(ls->L, "unknown attribute '%s'", attr));
1741 }
1742 return VDKREG; /* regular variable */
1743}
1744
1745
1746static void checktoclose (LexState *ls, int level) {
1747 if (level != -1) { /* is there a to-be-closed variable? */
1748 FuncState *fs = ls->fs;
1749 markupval(fs, level + 1);
1750 fs->bl->insidetbc = 1; /* in the scope of a to-be-closed variable */
1751 luaK_codeABC(fs, OP_TBC, stacklevel(fs, level), 0, 0);
1752 }
1753}
1754
1755
1756static void localstat (LexState *ls) {
1757 /* stat -> LOCAL ATTRIB NAME {',' ATTRIB NAME} ['=' explist] */
1758 FuncState *fs = ls->fs;
1759 int toclose = -1; /* index of to-be-closed variable (if any) */
1760 Vardesc *var; /* last variable */
1761 int vidx, kind; /* index and kind of last variable */
1762 int nvars = 0;
1763 int nexps;
1764 expdesc e;
1765 do {
1766 vidx = new_localvar(ls, str_checkname(ls));
1767 kind = getlocalattribute(ls);
1768 getlocalvardesc(fs, vidx)->vd.kind = kind;
1769 if (kind == RDKTOCLOSE) { /* to-be-closed? */
1770 if (toclose != -1) /* one already present? */
1771 luaK_semerror(ls, "multiple to-be-closed variables in local list");
1772 toclose = fs->nactvar + nvars;
1773 }
1774 nvars++;
1775 } while (testnext(ls, ','));
1776 if (testnext(ls, '='))
1777 nexps = explist(ls, &e);
1778 else {
1779 e.k = VVOID;
1780 nexps = 0;
1781 }
1782 var = getlocalvardesc(fs, vidx); /* get last variable */
1783 if (nvars == nexps && /* no adjustments? */
1784 var->vd.kind == RDKCONST && /* last variable is const? */
1785 luaK_exp2const(fs, &e, &var->k)) { /* compile-time constant? */
1786 var->vd.kind = RDKCTC; /* variable is a compile-time constant */
1787 adjustlocalvars(ls, nvars - 1); /* exclude last variable */
1788 fs->nactvar++; /* but count it */
1789 }
1790 else {
1791 adjust_assign(ls, nvars, nexps, &e);
1792 adjustlocalvars(ls, nvars);
1793 }
1794 checktoclose(ls, toclose);
1795}
1796
1797
1798static int funcname (LexState *ls, expdesc *v) {
1799 /* funcname -> NAME {fieldsel} [':' NAME] */
1800 int ismethod = 0;
1801 singlevar(ls, v);
1802 while (ls->t.token == '.')
1803 fieldsel(ls, v);
1804 if (ls->t.token == ':') {
1805 ismethod = 1;
1806 fieldsel(ls, v);
1807 }
1808 return ismethod;
1809}
1810
1811
1812static void funcstat (LexState *ls, int line) {
1813 /* funcstat -> FUNCTION funcname body */
1814 int ismethod;
1815 expdesc v, b;
1816 luaX_next(ls); /* skip FUNCTION */
1817 ismethod = funcname(ls, &v);
1818 body(ls, &b, ismethod, line);
1819 luaK_storevar(ls->fs, &v, &b);
1820 luaK_fixline(ls->fs, line); /* definition "happens" in the first line */
1821}
1822
1823
1824static void exprstat (LexState *ls) {
1825 /* stat -> func | assignment */
1826 FuncState *fs = ls->fs;
1827 struct LHS_assign v;
1828 suffixedexp(ls, &v.v);
1829 if (ls->t.token == '=' || ls->t.token == ',') { /* stat -> assignment ? */
1830 v.prev = NULL;
1831 restassign(ls, &v, 1);
1832 }
1833 else { /* stat -> func */
1834 Instruction *inst;
1835 check_condition(ls, v.v.k == VCALL, "syntax error");
1836 inst = &getinstruction(fs, &v.v);
1837 SETARG_C(*inst, 1); /* call statement uses no results */
1838 }
1839}
1840
1841
1842static void retstat (LexState *ls) {
1843 /* stat -> RETURN [explist] [';'] */
1844 FuncState *fs = ls->fs;
1845 expdesc e;
1846 int nret; /* number of values being returned */
1847 int first = luaY_nvarstack(fs); /* first slot to be returned */
1848 if (block_follow(ls, 1) || ls->t.token == ';')
1849 nret = 0; /* return no values */
1850 else {
1851 nret = explist(ls, &e); /* optional return values */
1852 if (hasmultret(e.k)) {
1853 luaK_setmultret(fs, &e);
1854 if (e.k == VCALL && nret == 1 && !fs->bl->insidetbc) { /* tail call? */
1855 SET_OPCODE(getinstruction(fs,&e), OP_TAILCALL);
1856 lua_assert(GETARG_A(getinstruction(fs,&e)) == luaY_nvarstack(fs));
1857 }
1858 nret = LUA_MULTRET; /* return all values */
1859 }
1860 else {
1861 if (nret == 1) /* only one single value? */
1862 first = luaK_exp2anyreg(fs, &e); /* can use original slot */
1863 else { /* values must go to the top of the stack */
1864 luaK_exp2nextreg(fs, &e);
1865 lua_assert(nret == fs->freereg - first);
1866 }
1867 }
1868 }
1869 luaK_ret(fs, first, nret);
1870 testnext(ls, ';'); /* skip optional semicolon */
1871}
1872
1873
1874static void statement (LexState *ls) {
1875 int line = ls->linenumber; /* may be needed for error messages */
1876 enterlevel(ls);
1877 switch (ls->t.token) {
1878 case ';': { /* stat -> ';' (empty statement) */
1879 luaX_next(ls); /* skip ';' */
1880 break;
1881 }
1882 case TK_IF: { /* stat -> ifstat */
1883 ifstat(ls, line);
1884 break;
1885 }
1886 case TK_WHILE: { /* stat -> whilestat */
1887 whilestat(ls, line);
1888 break;
1889 }
1890 case TK_DO: { /* stat -> DO block END */
1891 luaX_next(ls); /* skip DO */
1892 block(ls);
1893 check_match(ls, TK_END, TK_DO, line);
1894 break;
1895 }
1896 case TK_FOR: { /* stat -> forstat */
1897 forstat(ls, line);
1898 break;
1899 }
1900 case TK_REPEAT: { /* stat -> repeatstat */
1901 repeatstat(ls, line);
1902 break;
1903 }
1904 case TK_FUNCTION: { /* stat -> funcstat */
1905 funcstat(ls, line);
1906 break;
1907 }
1908 case TK_LOCAL: { /* stat -> localstat */
1909 luaX_next(ls); /* skip LOCAL */
1910 if (testnext(ls, TK_FUNCTION)) /* local function? */
1911 localfunc(ls);
1912 else
1913 localstat(ls);
1914 break;
1915 }
1916 case TK_DBCOLON: { /* stat -> label */
1917 luaX_next(ls); /* skip double colon */
1918 labelstat(ls, str_checkname(ls), line);
1919 break;
1920 }
1921 case TK_RETURN: { /* stat -> retstat */
1922 luaX_next(ls); /* skip RETURN */
1923 retstat(ls);
1924 break;
1925 }
1926 case TK_BREAK: { /* stat -> breakstat */
1927 breakstat(ls);
1928 break;
1929 }
1930 case TK_GOTO: { /* stat -> 'goto' NAME */
1931 luaX_next(ls); /* skip 'goto' */
1932 gotostat(ls);
1933 break;
1934 }
1935 default: { /* stat -> func | assignment */
1936 exprstat(ls);
1937 break;
1938 }
1939 }
1940 lua_assert(ls->fs->f->maxstacksize >= ls->fs->freereg &&
1941 ls->fs->freereg >= luaY_nvarstack(ls->fs));
1942 ls->fs->freereg = luaY_nvarstack(ls->fs); /* free registers */
1943 leavelevel(ls);
1944}
1945
1946/* }====================================================================== */
1947
1948
1949/*
1950** compiles the main function, which is a regular vararg function with an
1951** upvalue named LUA_ENV
1952*/
1953static void mainfunc (LexState *ls, FuncState *fs) {
1954 BlockCnt bl;
1955 Upvaldesc *env;
1956 open_func(ls, fs, &bl);
1957 setvararg(fs, 0); /* main function is always declared vararg */
1958 env = allocupvalue(fs); /* ...set environment upvalue */
1959 env->instack = 1;
1960 env->idx = 0;
1961 env->kind = VDKREG;
1962 env->name = ls->envn;
1963 luaC_objbarrier(ls->L, fs->f, env->name);
1964 luaX_next(ls); /* read first token */
1965 statlist(ls); /* parse main body */
1966 check(ls, TK_EOS);
1967 close_func(ls);
1968}
1969
1970
1971LClosure *luaY_parser (lua_State *L, ZIO *z, Mbuffer *buff,
1972 Dyndata *dyd, const char *name, int firstchar) {
1973 LexState lexstate;
1974 FuncState funcstate;
1975 LClosure *cl = luaF_newLclosure(L, 1); /* create main closure */
1976 setclLvalue2s(L, L->top, cl); /* anchor it (to avoid being collected) */
1977 luaD_inctop(L);
1978 lexstate.h = luaH_new(L); /* create table for scanner */
1979 sethvalue2s(L, L->top, lexstate.h); /* anchor it */
1980 luaD_inctop(L);
1981 funcstate.f = cl->p = luaF_newproto(L);
1982 luaC_objbarrier(L, cl, cl->p);
1983 funcstate.f->source = luaS_new(L, name); /* create and anchor TString */
1984 luaC_objbarrier(L, funcstate.f, funcstate.f->source);
1985 lexstate.buff = buff;
1986 lexstate.dyd = dyd;
1987 dyd->actvar.n = dyd->gt.n = dyd->label.n = 0;
1988 luaX_setinput(L, &lexstate, z, funcstate.f->source, firstchar);
1989 mainfunc(&lexstate, &funcstate);
1990 lua_assert(!funcstate.prev && funcstate.nups == 1 && !lexstate.fs);
1991 /* all scopes should be correctly finished */
1992 lua_assert(dyd->actvar.n == 0 && dyd->gt.n == 0 && dyd->label.n == 0);
1993 L->top--; /* remove scanner's table */
1994 return cl; /* closure is on the stack, too */
1995}
1996
diff --git a/src/lua/lparser.h b/src/lua/lparser.h
new file mode 100644
index 0000000..618cb01
--- /dev/null
+++ b/src/lua/lparser.h
@@ -0,0 +1,170 @@
1/*
2** $Id: lparser.h $
3** Lua Parser
4** See Copyright Notice in lua.h
5*/
6
7#ifndef lparser_h
8#define lparser_h
9
10#include "llimits.h"
11#include "lobject.h"
12#include "lzio.h"
13
14
15/*
16** Expression and variable descriptor.
17** Code generation for variables and expressions can be delayed to allow
18** optimizations; An 'expdesc' structure describes a potentially-delayed
19** variable/expression. It has a description of its "main" value plus a
20** list of conditional jumps that can also produce its value (generated
21** by short-circuit operators 'and'/'or').
22*/
23
24/* kinds of variables/expressions */
25typedef enum {
26 VVOID, /* when 'expdesc' describes the last expression a list,
27 this kind means an empty list (so, no expression) */
28 VNIL, /* constant nil */
29 VTRUE, /* constant true */
30 VFALSE, /* constant false */
31 VK, /* constant in 'k'; info = index of constant in 'k' */
32 VKFLT, /* floating constant; nval = numerical float value */
33 VKINT, /* integer constant; ival = numerical integer value */
34 VKSTR, /* string constant; strval = TString address;
35 (string is fixed by the lexer) */
36 VNONRELOC, /* expression has its value in a fixed register;
37 info = result register */
38 VLOCAL, /* local variable; var.sidx = stack index (local register);
39 var.vidx = relative index in 'actvar.arr' */
40 VUPVAL, /* upvalue variable; info = index of upvalue in 'upvalues' */
41 VCONST, /* compile-time constant; info = absolute index in 'actvar.arr' */
42 VINDEXED, /* indexed variable;
43 ind.t = table register;
44 ind.idx = key's R index */
45 VINDEXUP, /* indexed upvalue;
46 ind.t = table upvalue;
47 ind.idx = key's K index */
48 VINDEXI, /* indexed variable with constant integer;
49 ind.t = table register;
50 ind.idx = key's value */
51 VINDEXSTR, /* indexed variable with literal string;
52 ind.t = table register;
53 ind.idx = key's K index */
54 VJMP, /* expression is a test/comparison;
55 info = pc of corresponding jump instruction */
56 VRELOC, /* expression can put result in any register;
57 info = instruction pc */
58 VCALL, /* expression is a function call; info = instruction pc */
59 VVARARG /* vararg expression; info = instruction pc */
60} expkind;
61
62
63#define vkisvar(k) (VLOCAL <= (k) && (k) <= VINDEXSTR)
64#define vkisindexed(k) (VINDEXED <= (k) && (k) <= VINDEXSTR)
65
66
67typedef struct expdesc {
68 expkind k;
69 union {
70 lua_Integer ival; /* for VKINT */
71 lua_Number nval; /* for VKFLT */
72 TString *strval; /* for VKSTR */
73 int info; /* for generic use */
74 struct { /* for indexed variables */
75 short idx; /* index (R or "long" K) */
76 lu_byte t; /* table (register or upvalue) */
77 } ind;
78 struct { /* for local variables */
79 lu_byte sidx; /* index in the stack */
80 unsigned short vidx; /* compiler index (in 'actvar.arr') */
81 } var;
82 } u;
83 int t; /* patch list of 'exit when true' */
84 int f; /* patch list of 'exit when false' */
85} expdesc;
86
87
88/* kinds of variables */
89#define VDKREG 0 /* regular */
90#define RDKCONST 1 /* constant */
91#define RDKTOCLOSE 2 /* to-be-closed */
92#define RDKCTC 3 /* compile-time constant */
93
94/* description of an active local variable */
95typedef union Vardesc {
96 struct {
97 TValuefields; /* constant value (if it is a compile-time constant) */
98 lu_byte kind;
99 lu_byte sidx; /* index of the variable in the stack */
100 short pidx; /* index of the variable in the Proto's 'locvars' array */
101 TString *name; /* variable name */
102 } vd;
103 TValue k; /* constant value (if any) */
104} Vardesc;
105
106
107
108/* description of pending goto statements and label statements */
109typedef struct Labeldesc {
110 TString *name; /* label identifier */
111 int pc; /* position in code */
112 int line; /* line where it appeared */
113 lu_byte nactvar; /* number of active variables in that position */
114 lu_byte close; /* goto that escapes upvalues */
115} Labeldesc;
116
117
118/* list of labels or gotos */
119typedef struct Labellist {
120 Labeldesc *arr; /* array */
121 int n; /* number of entries in use */
122 int size; /* array size */
123} Labellist;
124
125
126/* dynamic structures used by the parser */
127typedef struct Dyndata {
128 struct { /* list of all active local variables */
129 Vardesc *arr;
130 int n;
131 int size;
132 } actvar;
133 Labellist gt; /* list of pending gotos */
134 Labellist label; /* list of active labels */
135} Dyndata;
136
137
138/* control of blocks */
139struct BlockCnt; /* defined in lparser.c */
140
141
142/* state needed to generate code for a given function */
143typedef struct FuncState {
144 Proto *f; /* current function header */
145 struct FuncState *prev; /* enclosing function */
146 struct LexState *ls; /* lexical state */
147 struct BlockCnt *bl; /* chain of current blocks */
148 int pc; /* next position to code (equivalent to 'ncode') */
149 int lasttarget; /* 'label' of last 'jump label' */
150 int previousline; /* last line that was saved in 'lineinfo' */
151 int nk; /* number of elements in 'k' */
152 int np; /* number of elements in 'p' */
153 int nabslineinfo; /* number of elements in 'abslineinfo' */
154 int firstlocal; /* index of first local var (in Dyndata array) */
155 int firstlabel; /* index of first label (in 'dyd->label->arr') */
156 short ndebugvars; /* number of elements in 'f->locvars' */
157 lu_byte nactvar; /* number of active local variables */
158 lu_byte nups; /* number of upvalues */
159 lu_byte freereg; /* first free register */
160 lu_byte iwthabs; /* instructions issued since last absolute line info */
161 lu_byte needclose; /* function needs to close upvalues when returning */
162} FuncState;
163
164
165LUAI_FUNC int luaY_nvarstack (FuncState *fs);
166LUAI_FUNC LClosure *luaY_parser (lua_State *L, ZIO *z, Mbuffer *buff,
167 Dyndata *dyd, const char *name, int firstchar);
168
169
170#endif
diff --git a/src/lua/lprefix.h b/src/lua/lprefix.h
new file mode 100644
index 0000000..484f2ad
--- /dev/null
+++ b/src/lua/lprefix.h
@@ -0,0 +1,45 @@
1/*
2** $Id: lprefix.h $
3** Definitions for Lua code that must come before any other header file
4** See Copyright Notice in lua.h
5*/
6
7#ifndef lprefix_h
8#define lprefix_h
9
10
11/*
12** Allows POSIX/XSI stuff
13*/
14#if !defined(LUA_USE_C89) /* { */
15
16#if !defined(_XOPEN_SOURCE)
17#define _XOPEN_SOURCE 600
18#elif _XOPEN_SOURCE == 0
19#undef _XOPEN_SOURCE /* use -D_XOPEN_SOURCE=0 to undefine it */
20#endif
21
22/*
23** Allows manipulation of large files in gcc and some other compilers
24*/
25#if !defined(LUA_32BITS) && !defined(_FILE_OFFSET_BITS)
26#define _LARGEFILE_SOURCE 1
27#define _FILE_OFFSET_BITS 64
28#endif
29
30#endif /* } */
31
32
33/*
34** Windows stuff
35*/
36#if defined(_WIN32) /* { */
37
38#if !defined(_CRT_SECURE_NO_WARNINGS)
39#define _CRT_SECURE_NO_WARNINGS /* avoid warnings about ISO C functions */
40#endif
41
42#endif /* } */
43
44#endif
45
diff --git a/src/lua/lstate.c b/src/lua/lstate.c
new file mode 100644
index 0000000..4434211
--- /dev/null
+++ b/src/lua/lstate.c
@@ -0,0 +1,467 @@
1/*
2** $Id: lstate.c $
3** Global State
4** See Copyright Notice in lua.h
5*/
6
7#define lstate_c
8#define LUA_CORE
9
10#include "lprefix.h"
11
12
13#include <stddef.h>
14#include <string.h>
15
16#include "lua.h"
17
18#include "lapi.h"
19#include "ldebug.h"
20#include "ldo.h"
21#include "lfunc.h"
22#include "lgc.h"
23#include "llex.h"
24#include "lmem.h"
25#include "lstate.h"
26#include "lstring.h"
27#include "ltable.h"
28#include "ltm.h"
29
30
31
32/*
33** thread state + extra space
34*/
35typedef struct LX {
36 lu_byte extra_[LUA_EXTRASPACE];
37 lua_State l;
38} LX;
39
40
41/*
42** Main thread combines a thread state and the global state
43*/
44typedef struct LG {
45 LX l;
46 global_State g;
47} LG;
48
49
50
51#define fromstate(L) (cast(LX *, cast(lu_byte *, (L)) - offsetof(LX, l)))
52
53
54/*
55** A macro to create a "random" seed when a state is created;
56** the seed is used to randomize string hashes.
57*/
58#if !defined(luai_makeseed)
59
60#include <time.h>
61
62/*
63** Compute an initial seed with some level of randomness.
64** Rely on Address Space Layout Randomization (if present) and
65** current time.
66*/
67#define addbuff(b,p,e) \
68 { size_t t = cast_sizet(e); \
69 memcpy(b + p, &t, sizeof(t)); p += sizeof(t); }
70
71static unsigned int luai_makeseed (lua_State *L) {
72 char buff[3 * sizeof(size_t)];
73 unsigned int h = cast_uint(time(NULL));
74 int p = 0;
75 addbuff(buff, p, L); /* heap variable */
76 addbuff(buff, p, &h); /* local variable */
77 addbuff(buff, p, &lua_newstate); /* public function */
78 lua_assert(p == sizeof(buff));
79 return luaS_hash(buff, p, h, 1);
80}
81
82#endif
83
84
85/*
86** set GCdebt to a new value keeping the value (totalbytes + GCdebt)
87** invariant (and avoiding underflows in 'totalbytes')
88*/
89void luaE_setdebt (global_State *g, l_mem debt) {
90 l_mem tb = gettotalbytes(g);
91 lua_assert(tb > 0);
92 if (debt < tb - MAX_LMEM)
93 debt = tb - MAX_LMEM; /* will make 'totalbytes == MAX_LMEM' */
94 g->totalbytes = tb - debt;
95 g->GCdebt = debt;
96}
97
98
99LUA_API int lua_setcstacklimit (lua_State *L, unsigned int limit) {
100 global_State *g = G(L);
101 int ccalls;
102 luaE_freeCI(L); /* release unused CIs */
103 ccalls = getCcalls(L);
104 if (limit >= 40000)
105 return 0; /* out of bounds */
106 limit += CSTACKERR;
107 if (L != g-> mainthread)
108 return 0; /* only main thread can change the C stack */
109 else if (ccalls <= CSTACKERR)
110 return 0; /* handling overflow */
111 else {
112 int diff = limit - g->Cstacklimit;
113 if (ccalls + diff <= CSTACKERR)
114 return 0; /* new limit would cause an overflow */
115 g->Cstacklimit = limit; /* set new limit */
116 L->nCcalls += diff; /* correct 'nCcalls' */
117 return limit - diff - CSTACKERR; /* success; return previous limit */
118 }
119}
120
121
122/*
123** Decrement count of "C calls" and check for overflows. In case of
124** a stack overflow, check appropriate error ("regular" overflow or
125** overflow while handling stack overflow). If 'nCcalls' is smaller
126** than CSTACKERR but larger than CSTACKMARK, it means it has just
127** entered the "overflow zone", so the function raises an overflow
128** error. If 'nCcalls' is smaller than CSTACKMARK (which means it is
129** already handling an overflow) but larger than CSTACKERRMARK, does
130** not report an error (to allow message handling to work). Otherwise,
131** report a stack overflow while handling a stack overflow (probably
132** caused by a repeating error in the message handling function).
133*/
134
135void luaE_enterCcall (lua_State *L) {
136 int ncalls = getCcalls(L);
137 L->nCcalls--;
138 if (ncalls <= CSTACKERR) { /* possible overflow? */
139 luaE_freeCI(L); /* release unused CIs */
140 ncalls = getCcalls(L); /* update call count */
141 if (ncalls <= CSTACKERR) { /* still overflow? */
142 if (ncalls <= CSTACKERRMARK) /* below error-handling zone? */
143 luaD_throw(L, LUA_ERRERR); /* error while handling stack error */
144 else if (ncalls >= CSTACKMARK) {
145 /* not in error-handling zone; raise the error now */
146 L->nCcalls = (CSTACKMARK - 1); /* enter error-handling zone */
147 luaG_runerror(L, "C stack overflow");
148 }
149 /* else stack is in the error-handling zone;
150 allow message handler to work */
151 }
152 }
153}
154
155
156CallInfo *luaE_extendCI (lua_State *L) {
157 CallInfo *ci;
158 lua_assert(L->ci->next == NULL);
159 luaE_enterCcall(L);
160 ci = luaM_new(L, CallInfo);
161 lua_assert(L->ci->next == NULL);
162 L->ci->next = ci;
163 ci->previous = L->ci;
164 ci->next = NULL;
165 ci->u.l.trap = 0;
166 L->nci++;
167 return ci;
168}
169
170
171/*
172** free all CallInfo structures not in use by a thread
173*/
174void luaE_freeCI (lua_State *L) {
175 CallInfo *ci = L->ci;
176 CallInfo *next = ci->next;
177 ci->next = NULL;
178 L->nCcalls += L->nci; /* add removed elements back to 'nCcalls' */
179 while ((ci = next) != NULL) {
180 next = ci->next;
181 luaM_free(L, ci);
182 L->nci--;
183 }
184 L->nCcalls -= L->nci; /* adjust result */
185}
186
187
188/*
189** free half of the CallInfo structures not in use by a thread,
190** keeping the first one.
191*/
192void luaE_shrinkCI (lua_State *L) {
193 CallInfo *ci = L->ci->next; /* first free CallInfo */
194 CallInfo *next;
195 if (ci == NULL)
196 return; /* no extra elements */
197 L->nCcalls += L->nci; /* add removed elements back to 'nCcalls' */
198 while ((next = ci->next) != NULL) { /* two extra elements? */
199 CallInfo *next2 = next->next; /* next's next */
200 ci->next = next2; /* remove next from the list */
201 L->nci--;
202 luaM_free(L, next); /* free next */
203 if (next2 == NULL)
204 break; /* no more elements */
205 else {
206 next2->previous = ci;
207 ci = next2; /* continue */
208 }
209 }
210 L->nCcalls -= L->nci; /* adjust result */
211}
212
213
214static void stack_init (lua_State *L1, lua_State *L) {
215 int i; CallInfo *ci;
216 /* initialize stack array */
217 L1->stack = luaM_newvector(L, BASIC_STACK_SIZE, StackValue);
218 L1->stacksize = BASIC_STACK_SIZE;
219 for (i = 0; i < BASIC_STACK_SIZE; i++)
220 setnilvalue(s2v(L1->stack + i)); /* erase new stack */
221 L1->top = L1->stack;
222 L1->stack_last = L1->stack + L1->stacksize - EXTRA_STACK;
223 /* initialize first ci */
224 ci = &L1->base_ci;
225 ci->next = ci->previous = NULL;
226 ci->callstatus = CIST_C;
227 ci->func = L1->top;
228 ci->u.c.k = NULL;
229 ci->nresults = 0;
230 setnilvalue(s2v(L1->top)); /* 'function' entry for this 'ci' */
231 L1->top++;
232 ci->top = L1->top + LUA_MINSTACK;
233 L1->ci = ci;
234}
235
236
237static void freestack (lua_State *L) {
238 if (L->stack == NULL)
239 return; /* stack not completely built yet */
240 L->ci = &L->base_ci; /* free the entire 'ci' list */
241 luaE_freeCI(L);
242 lua_assert(L->nci == 0);
243 luaM_freearray(L, L->stack, L->stacksize); /* free stack array */
244}
245
246
247/*
248** Create registry table and its predefined values
249*/
250static void init_registry (lua_State *L, global_State *g) {
251 TValue temp;
252 /* create registry */
253 Table *registry = luaH_new(L);
254 sethvalue(L, &g->l_registry, registry);
255 luaH_resize(L, registry, LUA_RIDX_LAST, 0);
256 /* registry[LUA_RIDX_MAINTHREAD] = L */
257 setthvalue(L, &temp, L); /* temp = L */
258 luaH_setint(L, registry, LUA_RIDX_MAINTHREAD, &temp);
259 /* registry[LUA_RIDX_GLOBALS] = table of globals */
260 sethvalue(L, &temp, luaH_new(L)); /* temp = new table (global table) */
261 luaH_setint(L, registry, LUA_RIDX_GLOBALS, &temp);
262}
263
264
265/*
266** open parts of the state that may cause memory-allocation errors.
267** ('g->nilvalue' being a nil value flags that the state was completely
268** build.)
269*/
270static void f_luaopen (lua_State *L, void *ud) {
271 global_State *g = G(L);
272 UNUSED(ud);
273 stack_init(L, L); /* init stack */
274 init_registry(L, g);
275 luaS_init(L);
276 luaT_init(L);
277 luaX_init(L);
278 g->gcrunning = 1; /* allow gc */
279 setnilvalue(&g->nilvalue);
280 luai_userstateopen(L);
281}
282
283
284/*
285** preinitialize a thread with consistent values without allocating
286** any memory (to avoid errors)
287*/
288static void preinit_thread (lua_State *L, global_State *g) {
289 G(L) = g;
290 L->stack = NULL;
291 L->ci = NULL;
292 L->nci = 0;
293 L->stacksize = 0;
294 L->twups = L; /* thread has no upvalues */
295 L->errorJmp = NULL;
296 L->hook = NULL;
297 L->hookmask = 0;
298 L->basehookcount = 0;
299 L->allowhook = 1;
300 resethookcount(L);
301 L->openupval = NULL;
302 L->status = LUA_OK;
303 L->errfunc = 0;
304}
305
306
307static void close_state (lua_State *L) {
308 global_State *g = G(L);
309 luaF_close(L, L->stack, CLOSEPROTECT); /* close all upvalues */
310 luaC_freeallobjects(L); /* collect all objects */
311 if (ttisnil(&g->nilvalue)) /* closing a fully built state? */
312 luai_userstateclose(L);
313 luaM_freearray(L, G(L)->strt.hash, G(L)->strt.size);
314 freestack(L);
315 lua_assert(gettotalbytes(g) == sizeof(LG));
316 (*g->frealloc)(g->ud, fromstate(L), sizeof(LG), 0); /* free main block */
317}
318
319
320LUA_API lua_State *lua_newthread (lua_State *L) {
321 global_State *g = G(L);
322 lua_State *L1;
323 lua_lock(L);
324 luaC_checkGC(L);
325 /* create new thread */
326 L1 = &cast(LX *, luaM_newobject(L, LUA_TTHREAD, sizeof(LX)))->l;
327 L1->marked = luaC_white(g);
328 L1->tt = LUA_VTHREAD;
329 /* link it on list 'allgc' */
330 L1->next = g->allgc;
331 g->allgc = obj2gco(L1);
332 /* anchor it on L stack */
333 setthvalue2s(L, L->top, L1);
334 api_incr_top(L);
335 preinit_thread(L1, g);
336 L1->nCcalls = getCcalls(L);
337 L1->hookmask = L->hookmask;
338 L1->basehookcount = L->basehookcount;
339 L1->hook = L->hook;
340 resethookcount(L1);
341 /* initialize L1 extra space */
342 memcpy(lua_getextraspace(L1), lua_getextraspace(g->mainthread),
343 LUA_EXTRASPACE);
344 luai_userstatethread(L, L1);
345 stack_init(L1, L); /* init stack */
346 lua_unlock(L);
347 return L1;
348}
349
350
351void luaE_freethread (lua_State *L, lua_State *L1) {
352 LX *l = fromstate(L1);
353 luaF_close(L1, L1->stack, NOCLOSINGMETH); /* close all upvalues */
354 lua_assert(L1->openupval == NULL);
355 luai_userstatefree(L, L1);
356 freestack(L1);
357 luaM_free(L, l);
358}
359
360
361int lua_resetthread (lua_State *L) {
362 CallInfo *ci;
363 int status;
364 lua_lock(L);
365 L->ci = ci = &L->base_ci; /* unwind CallInfo list */
366 setnilvalue(s2v(L->stack)); /* 'function' entry for basic 'ci' */
367 ci->func = L->stack;
368 ci->callstatus = CIST_C;
369 status = luaF_close(L, L->stack, CLOSEPROTECT);
370 if (status != CLOSEPROTECT) /* real errors? */
371 luaD_seterrorobj(L, status, L->stack + 1);
372 else {
373 status = LUA_OK;
374 L->top = L->stack + 1;
375 }
376 ci->top = L->top + LUA_MINSTACK;
377 L->status = status;
378 lua_unlock(L);
379 return status;
380}
381
382
383LUA_API lua_State *lua_newstate (lua_Alloc f, void *ud) {
384 int i;
385 lua_State *L;
386 global_State *g;
387 LG *l = cast(LG *, (*f)(ud, NULL, LUA_TTHREAD, sizeof(LG)));
388 if (l == NULL) return NULL;
389 L = &l->l.l;
390 g = &l->g;
391 L->tt = LUA_VTHREAD;
392 g->currentwhite = bitmask(WHITE0BIT);
393 L->marked = luaC_white(g);
394 preinit_thread(L, g);
395 g->allgc = obj2gco(L); /* by now, only object is the main thread */
396 L->next = NULL;
397 g->Cstacklimit = L->nCcalls = LUAI_MAXCSTACK + CSTACKERR;
398 g->frealloc = f;
399 g->ud = ud;
400 g->warnf = NULL;
401 g->ud_warn = NULL;
402 g->mainthread = L;
403 g->seed = luai_makeseed(L);
404 g->gcrunning = 0; /* no GC while building state */
405 g->strt.size = g->strt.nuse = 0;
406 g->strt.hash = NULL;
407 setnilvalue(&g->l_registry);
408 g->panic = NULL;
409 g->gcstate = GCSpause;
410 g->gckind = KGC_INC;
411 g->gcemergency = 0;
412 g->finobj = g->tobefnz = g->fixedgc = NULL;
413 g->survival = g->old = g->reallyold = NULL;
414 g->finobjsur = g->finobjold = g->finobjrold = NULL;
415 g->sweepgc = NULL;
416 g->gray = g->grayagain = NULL;
417 g->weak = g->ephemeron = g->allweak = NULL;
418 g->twups = NULL;
419 g->totalbytes = sizeof(LG);
420 g->GCdebt = 0;
421 g->lastatomic = 0;
422 setivalue(&g->nilvalue, 0); /* to signal that state is not yet built */
423 setgcparam(g->gcpause, LUAI_GCPAUSE);
424 setgcparam(g->gcstepmul, LUAI_GCMUL);
425 g->gcstepsize = LUAI_GCSTEPSIZE;
426 setgcparam(g->genmajormul, LUAI_GENMAJORMUL);
427 g->genminormul = LUAI_GENMINORMUL;
428 for (i=0; i < LUA_NUMTAGS; i++) g->mt[i] = NULL;
429 if (luaD_rawrunprotected(L, f_luaopen, NULL) != LUA_OK) {
430 /* memory allocation error: free partial state */
431 close_state(L);
432 L = NULL;
433 }
434 return L;
435}
436
437
438LUA_API void lua_close (lua_State *L) {
439 L = G(L)->mainthread; /* only the main thread can be closed */
440 lua_lock(L);
441 close_state(L);
442}
443
444
445void luaE_warning (lua_State *L, const char *msg, int tocont) {
446 lua_WarnFunction wf = G(L)->warnf;
447 if (wf != NULL)
448 wf(G(L)->ud_warn, msg, tocont);
449}
450
451
452/*
453** Generate a warning from an error message
454*/
455void luaE_warnerror (lua_State *L, const char *where) {
456 TValue *errobj = s2v(L->top - 1); /* error object */
457 const char *msg = (ttisstring(errobj))
458 ? svalue(errobj)
459 : "error object is not a string";
460 /* produce warning "error in %s (%s)" (where, msg) */
461 luaE_warning(L, "error in ", 1);
462 luaE_warning(L, where, 1);
463 luaE_warning(L, " (", 1);
464 luaE_warning(L, msg, 1);
465 luaE_warning(L, ")", 0);
466}
467
diff --git a/src/lua/lstate.h b/src/lua/lstate.h
new file mode 100644
index 0000000..2e8bd6c
--- /dev/null
+++ b/src/lua/lstate.h
@@ -0,0 +1,364 @@
1/*
2** $Id: lstate.h $
3** Global State
4** See Copyright Notice in lua.h
5*/
6
7#ifndef lstate_h
8#define lstate_h
9
10#include "lua.h"
11
12#include "lobject.h"
13#include "ltm.h"
14#include "lzio.h"
15
16
17/*
18** Some notes about garbage-collected objects: All objects in Lua must
19** be kept somehow accessible until being freed, so all objects always
20** belong to one (and only one) of these lists, using field 'next' of
21** the 'CommonHeader' for the link:
22**
23** 'allgc': all objects not marked for finalization;
24** 'finobj': all objects marked for finalization;
25** 'tobefnz': all objects ready to be finalized;
26** 'fixedgc': all objects that are not to be collected (currently
27** only small strings, such as reserved words).
28**
29** For the generational collector, some of these lists have marks for
30** generations. Each mark points to the first element in the list for
31** that particular generation; that generation goes until the next mark.
32**
33** 'allgc' -> 'survival': new objects;
34** 'survival' -> 'old': objects that survived one collection;
35** 'old' -> 'reallyold': objects that became old in last collection;
36** 'reallyold' -> NULL: objects old for more than one cycle.
37**
38** 'finobj' -> 'finobjsur': new objects marked for finalization;
39** 'finobjsur' -> 'finobjold': survived """";
40** 'finobjold' -> 'finobjrold': just old """";
41** 'finobjrold' -> NULL: really old """".
42*/
43
44/*
45** Moreover, there is another set of lists that control gray objects.
46** These lists are linked by fields 'gclist'. (All objects that
47** can become gray have such a field. The field is not the same
48** in all objects, but it always has this name.) Any gray object
49** must belong to one of these lists, and all objects in these lists
50** must be gray:
51**
52** 'gray': regular gray objects, still waiting to be visited.
53** 'grayagain': objects that must be revisited at the atomic phase.
54** That includes
55** - black objects got in a write barrier;
56** - all kinds of weak tables during propagation phase;
57** - all threads.
58** 'weak': tables with weak values to be cleared;
59** 'ephemeron': ephemeron tables with white->white entries;
60** 'allweak': tables with weak keys and/or weak values to be cleared.
61*/
62
63
64
65/*
66** About 'nCcalls': each thread in Lua (a lua_State) keeps a count of
67** how many "C calls" it still can do in the C stack, to avoid C-stack
68** overflow. This count is very rough approximation; it considers only
69** recursive functions inside the interpreter, as non-recursive calls
70** can be considered using a fixed (although unknown) amount of stack
71** space.
72**
73** The count has two parts: the lower part is the count itself; the
74** higher part counts the number of non-yieldable calls in the stack.
75** (They are together so that we can change both with one instruction.)
76**
77** Because calls to external C functions can use an unknown amount
78** of space (e.g., functions using an auxiliary buffer), calls
79** to these functions add more than one to the count (see CSTACKCF).
80**
81** The proper count excludes the number of CallInfo structures allocated
82** by Lua, as a kind of "potential" calls. So, when Lua calls a function
83** (and "consumes" one CallInfo), it needs neither to decrement nor to
84** check 'nCcalls', as its use of C stack is already accounted for.
85*/
86
87/* number of "C stack slots" used by an external C function */
88#define CSTACKCF 10
89
90
91/*
92** The C-stack size is sliced in the following zones:
93** - larger than CSTACKERR: normal stack;
94** - [CSTACKMARK, CSTACKERR]: buffer zone to signal a stack overflow;
95** - [CSTACKCF, CSTACKERRMARK]: error-handling zone;
96** - below CSTACKERRMARK: buffer zone to signal overflow during overflow;
97** (Because the counter can be decremented CSTACKCF at once, we need
98** the so called "buffer zones", with at least that size, to properly
99** detect a change from one zone to the next.)
100*/
101#define CSTACKERR (8 * CSTACKCF)
102#define CSTACKMARK (CSTACKERR - (CSTACKCF + 2))
103#define CSTACKERRMARK (CSTACKCF + 2)
104
105
106/* initial limit for the C-stack of threads */
107#define CSTACKTHREAD (2 * CSTACKERR)
108
109
110/* true if this thread does not have non-yieldable calls in the stack */
111#define yieldable(L) (((L)->nCcalls & 0xffff0000) == 0)
112
113/* real number of C calls */
114#define getCcalls(L) ((L)->nCcalls & 0xffff)
115
116
117/* Increment the number of non-yieldable calls */
118#define incnny(L) ((L)->nCcalls += 0x10000)
119
120/* Decrement the number of non-yieldable calls */
121#define decnny(L) ((L)->nCcalls -= 0x10000)
122
123/* Increment the number of non-yieldable calls and decrement nCcalls */
124#define incXCcalls(L) ((L)->nCcalls += 0x10000 - CSTACKCF)
125
126/* Decrement the number of non-yieldable calls and increment nCcalls */
127#define decXCcalls(L) ((L)->nCcalls -= 0x10000 - CSTACKCF)
128
129
130
131
132
133
134struct lua_longjmp; /* defined in ldo.c */
135
136
137/*
138** Atomic type (relative to signals) to better ensure that 'lua_sethook'
139** is thread safe
140*/
141#if !defined(l_signalT)
142#include <signal.h>
143#define l_signalT sig_atomic_t
144#endif
145
146
147/* extra stack space to handle TM calls and some other extras */
148#define EXTRA_STACK 5
149
150
151#define BASIC_STACK_SIZE (2*LUA_MINSTACK)
152
153
154/* kinds of Garbage Collection */
155#define KGC_INC 0 /* incremental gc */
156#define KGC_GEN 1 /* generational gc */
157
158
159typedef struct stringtable {
160 TString **hash;
161 int nuse; /* number of elements */
162 int size;
163} stringtable;
164
165
166/*
167** Information about a call.
168*/
169typedef struct CallInfo {
170 StkId func; /* function index in the stack */
171 StkId top; /* top for this function */
172 struct CallInfo *previous, *next; /* dynamic call link */
173 union {
174 struct { /* only for Lua functions */
175 const Instruction *savedpc;
176 volatile l_signalT trap;
177 int nextraargs; /* # of extra arguments in vararg functions */
178 } l;
179 struct { /* only for C functions */
180 lua_KFunction k; /* continuation in case of yields */
181 ptrdiff_t old_errfunc;
182 lua_KContext ctx; /* context info. in case of yields */
183 } c;
184 } u;
185 union {
186 int funcidx; /* called-function index */
187 int nyield; /* number of values yielded */
188 struct { /* info about transferred values (for call/return hooks) */
189 unsigned short ftransfer; /* offset of first value transferred */
190 unsigned short ntransfer; /* number of values transferred */
191 } transferinfo;
192 } u2;
193 short nresults; /* expected number of results from this function */
194 unsigned short callstatus;
195} CallInfo;
196
197
198/*
199** Bits in CallInfo status
200*/
201#define CIST_OAH (1<<0) /* original value of 'allowhook' */
202#define CIST_C (1<<1) /* call is running a C function */
203#define CIST_HOOKED (1<<2) /* call is running a debug hook */
204#define CIST_YPCALL (1<<3) /* call is a yieldable protected call */
205#define CIST_TAIL (1<<4) /* call was tail called */
206#define CIST_HOOKYIELD (1<<5) /* last hook called yielded */
207#define CIST_FIN (1<<6) /* call is running a finalizer */
208#define CIST_TRAN (1<<7) /* 'ci' has transfer information */
209#if defined(LUA_COMPAT_LT_LE)
210#define CIST_LEQ (1<<8) /* using __lt for __le */
211#endif
212
213/* active function is a Lua function */
214#define isLua(ci) (!((ci)->callstatus & CIST_C))
215
216/* call is running Lua code (not a hook) */
217#define isLuacode(ci) (!((ci)->callstatus & (CIST_C | CIST_HOOKED)))
218
219/* assume that CIST_OAH has offset 0 and that 'v' is strictly 0/1 */
220#define setoah(st,v) ((st) = ((st) & ~CIST_OAH) | (v))
221#define getoah(st) ((st) & CIST_OAH)
222
223
224/*
225** 'global state', shared by all threads of this state
226*/
227typedef struct global_State {
228 lua_Alloc frealloc; /* function to reallocate memory */
229 void *ud; /* auxiliary data to 'frealloc' */
230 l_mem totalbytes; /* number of bytes currently allocated - GCdebt */
231 l_mem GCdebt; /* bytes allocated not yet compensated by the collector */
232 lu_mem GCestimate; /* an estimate of the non-garbage memory in use */
233 lu_mem lastatomic; /* see function 'genstep' in file 'lgc.c' */
234 stringtable strt; /* hash table for strings */
235 TValue l_registry;
236 TValue nilvalue; /* a nil value */
237 unsigned int seed; /* randomized seed for hashes */
238 lu_byte currentwhite;
239 lu_byte gcstate; /* state of garbage collector */
240 lu_byte gckind; /* kind of GC running */
241 lu_byte genminormul; /* control for minor generational collections */
242 lu_byte genmajormul; /* control for major generational collections */
243 lu_byte gcrunning; /* true if GC is running */
244 lu_byte gcemergency; /* true if this is an emergency collection */
245 lu_byte gcpause; /* size of pause between successive GCs */
246 lu_byte gcstepmul; /* GC "speed" */
247 lu_byte gcstepsize; /* (log2 of) GC granularity */
248 GCObject *allgc; /* list of all collectable objects */
249 GCObject **sweepgc; /* current position of sweep in list */
250 GCObject *finobj; /* list of collectable objects with finalizers */
251 GCObject *gray; /* list of gray objects */
252 GCObject *grayagain; /* list of objects to be traversed atomically */
253 GCObject *weak; /* list of tables with weak values */
254 GCObject *ephemeron; /* list of ephemeron tables (weak keys) */
255 GCObject *allweak; /* list of all-weak tables */
256 GCObject *tobefnz; /* list of userdata to be GC */
257 GCObject *fixedgc; /* list of objects not to be collected */
258 /* fields for generational collector */
259 GCObject *survival; /* start of objects that survived one GC cycle */
260 GCObject *old; /* start of old objects */
261 GCObject *reallyold; /* old objects with more than one cycle */
262 GCObject *finobjsur; /* list of survival objects with finalizers */
263 GCObject *finobjold; /* list of old objects with finalizers */
264 GCObject *finobjrold; /* list of really old objects with finalizers */
265 struct lua_State *twups; /* list of threads with open upvalues */
266 lua_CFunction panic; /* to be called in unprotected errors */
267 struct lua_State *mainthread;
268 TString *memerrmsg; /* message for memory-allocation errors */
269 TString *tmname[TM_N]; /* array with tag-method names */
270 struct Table *mt[LUA_NUMTAGS]; /* metatables for basic types */
271 TString *strcache[STRCACHE_N][STRCACHE_M]; /* cache for strings in API */
272 lua_WarnFunction warnf; /* warning function */
273 void *ud_warn; /* auxiliary data to 'warnf' */
274 unsigned int Cstacklimit; /* current limit for the C stack */
275} global_State;
276
277
278/*
279** 'per thread' state
280*/
281struct lua_State {
282 CommonHeader;
283 lu_byte status;
284 lu_byte allowhook;
285 unsigned short nci; /* number of items in 'ci' list */
286 StkId top; /* first free slot in the stack */
287 global_State *l_G;
288 CallInfo *ci; /* call info for current function */
289 const Instruction *oldpc; /* last pc traced */
290 StkId stack_last; /* last free slot in the stack */
291 StkId stack; /* stack base */
292 UpVal *openupval; /* list of open upvalues in this stack */
293 GCObject *gclist;
294 struct lua_State *twups; /* list of threads with open upvalues */
295 struct lua_longjmp *errorJmp; /* current error recover point */
296 CallInfo base_ci; /* CallInfo for first level (C calling Lua) */
297 volatile lua_Hook hook;
298 ptrdiff_t errfunc; /* current error handling function (stack index) */
299 l_uint32 nCcalls; /* number of allowed nested C calls - 'nci' */
300 int stacksize;
301 int basehookcount;
302 int hookcount;
303 volatile l_signalT hookmask;
304};
305
306
307#define G(L) (L->l_G)
308
309
310/*
311** Union of all collectable objects (only for conversions)
312*/
313union GCUnion {
314 GCObject gc; /* common header */
315 struct TString ts;
316 struct Udata u;
317 union Closure cl;
318 struct Table h;
319 struct Proto p;
320 struct lua_State th; /* thread */
321 struct UpVal upv;
322};
323
324
325#define cast_u(o) cast(union GCUnion *, (o))
326
327/* macros to convert a GCObject into a specific value */
328#define gco2ts(o) \
329 check_exp(novariant((o)->tt) == LUA_TSTRING, &((cast_u(o))->ts))
330#define gco2u(o) check_exp((o)->tt == LUA_VUSERDATA, &((cast_u(o))->u))
331#define gco2lcl(o) check_exp((o)->tt == LUA_VLCL, &((cast_u(o))->cl.l))
332#define gco2ccl(o) check_exp((o)->tt == LUA_VCCL, &((cast_u(o))->cl.c))
333#define gco2cl(o) \
334 check_exp(novariant((o)->tt) == LUA_TFUNCTION, &((cast_u(o))->cl))
335#define gco2t(o) check_exp((o)->tt == LUA_VTABLE, &((cast_u(o))->h))
336#define gco2p(o) check_exp((o)->tt == LUA_VPROTO, &((cast_u(o))->p))
337#define gco2th(o) check_exp((o)->tt == LUA_VTHREAD, &((cast_u(o))->th))
338#define gco2upv(o) check_exp((o)->tt == LUA_VUPVAL, &((cast_u(o))->upv))
339
340
341/*
342** macro to convert a Lua object into a GCObject
343** (The access to 'tt' tries to ensure that 'v' is actually a Lua object.)
344*/
345#define obj2gco(v) check_exp((v)->tt >= LUA_TSTRING, &(cast_u(v)->gc))
346
347
348/* actual number of total bytes allocated */
349#define gettotalbytes(g) cast(lu_mem, (g)->totalbytes + (g)->GCdebt)
350
351LUAI_FUNC void luaE_setdebt (global_State *g, l_mem debt);
352LUAI_FUNC void luaE_freethread (lua_State *L, lua_State *L1);
353LUAI_FUNC CallInfo *luaE_extendCI (lua_State *L);
354LUAI_FUNC void luaE_freeCI (lua_State *L);
355LUAI_FUNC void luaE_shrinkCI (lua_State *L);
356LUAI_FUNC void luaE_enterCcall (lua_State *L);
357LUAI_FUNC void luaE_warning (lua_State *L, const char *msg, int tocont);
358LUAI_FUNC void luaE_warnerror (lua_State *L, const char *where);
359
360
361#define luaE_exitCcall(L) ((L)->nCcalls++)
362
363#endif
364
diff --git a/src/lua/lstring.c b/src/lua/lstring.c
new file mode 100644
index 0000000..6f15747
--- /dev/null
+++ b/src/lua/lstring.c
@@ -0,0 +1,285 @@
1/*
2** $Id: lstring.c $
3** String table (keeps all strings handled by Lua)
4** See Copyright Notice in lua.h
5*/
6
7#define lstring_c
8#define LUA_CORE
9
10#include "lprefix.h"
11
12
13#include <string.h>
14
15#include "lua.h"
16
17#include "ldebug.h"
18#include "ldo.h"
19#include "lmem.h"
20#include "lobject.h"
21#include "lstate.h"
22#include "lstring.h"
23
24
25/*
26** Lua will use at most ~(2^LUAI_HASHLIMIT) bytes from a long string to
27** compute its hash
28*/
29#if !defined(LUAI_HASHLIMIT)
30#define LUAI_HASHLIMIT 5
31#endif
32
33
34
35/*
36** Maximum size for string table.
37*/
38#define MAXSTRTB cast_int(luaM_limitN(MAX_INT, TString*))
39
40
41/*
42** equality for long strings
43*/
44int luaS_eqlngstr (TString *a, TString *b) {
45 size_t len = a->u.lnglen;
46 lua_assert(a->tt == LUA_VLNGSTR && b->tt == LUA_VLNGSTR);
47 return (a == b) || /* same instance or... */
48 ((len == b->u.lnglen) && /* equal length and ... */
49 (memcmp(getstr(a), getstr(b), len) == 0)); /* equal contents */
50}
51
52
53unsigned int luaS_hash (const char *str, size_t l, unsigned int seed,
54 size_t step) {
55 unsigned int h = seed ^ cast_uint(l);
56 for (; l >= step; l -= step)
57 h ^= ((h<<5) + (h>>2) + cast_byte(str[l - 1]));
58 return h;
59}
60
61
62unsigned int luaS_hashlongstr (TString *ts) {
63 lua_assert(ts->tt == LUA_VLNGSTR);
64 if (ts->extra == 0) { /* no hash? */
65 size_t len = ts->u.lnglen;
66 size_t step = (len >> LUAI_HASHLIMIT) + 1;
67 ts->hash = luaS_hash(getstr(ts), len, ts->hash, step);
68 ts->extra = 1; /* now it has its hash */
69 }
70 return ts->hash;
71}
72
73
74static void tablerehash (TString **vect, int osize, int nsize) {
75 int i;
76 for (i = osize; i < nsize; i++) /* clear new elements */
77 vect[i] = NULL;
78 for (i = 0; i < osize; i++) { /* rehash old part of the array */
79 TString *p = vect[i];
80 vect[i] = NULL;
81 while (p) { /* for each string in the list */
82 TString *hnext = p->u.hnext; /* save next */
83 unsigned int h = lmod(p->hash, nsize); /* new position */
84 p->u.hnext = vect[h]; /* chain it into array */
85 vect[h] = p;
86 p = hnext;
87 }
88 }
89}
90
91
92/*
93** Resize the string table. If allocation fails, keep the current size.
94** (This can degrade performance, but any non-zero size should work
95** correctly.)
96*/
97void luaS_resize (lua_State *L, int nsize) {
98 stringtable *tb = &G(L)->strt;
99 int osize = tb->size;
100 TString **newvect;
101 if (nsize < osize) /* shrinking table? */
102 tablerehash(tb->hash, osize, nsize); /* depopulate shrinking part */
103 newvect = luaM_reallocvector(L, tb->hash, osize, nsize, TString*);
104 if (unlikely(newvect == NULL)) { /* reallocation failed? */
105 if (nsize < osize) /* was it shrinking table? */
106 tablerehash(tb->hash, nsize, osize); /* restore to original size */
107 /* leave table as it was */
108 }
109 else { /* allocation succeeded */
110 tb->hash = newvect;
111 tb->size = nsize;
112 if (nsize > osize)
113 tablerehash(newvect, osize, nsize); /* rehash for new size */
114 }
115}
116
117
118/*
119** Clear API string cache. (Entries cannot be empty, so fill them with
120** a non-collectable string.)
121*/
122void luaS_clearcache (global_State *g) {
123 int i, j;
124 for (i = 0; i < STRCACHE_N; i++)
125 for (j = 0; j < STRCACHE_M; j++) {
126 if (iswhite(g->strcache[i][j])) /* will entry be collected? */
127 g->strcache[i][j] = g->memerrmsg; /* replace it with something fixed */
128 }
129}
130
131
132/*
133** Initialize the string table and the string cache
134*/
135void luaS_init (lua_State *L) {
136 global_State *g = G(L);
137 int i, j;
138 stringtable *tb = &G(L)->strt;
139 tb->hash = luaM_newvector(L, MINSTRTABSIZE, TString*);
140 tablerehash(tb->hash, 0, MINSTRTABSIZE); /* clear array */
141 tb->size = MINSTRTABSIZE;
142 /* pre-create memory-error message */
143 g->memerrmsg = luaS_newliteral(L, MEMERRMSG);
144 luaC_fix(L, obj2gco(g->memerrmsg)); /* it should never be collected */
145 for (i = 0; i < STRCACHE_N; i++) /* fill cache with valid strings */
146 for (j = 0; j < STRCACHE_M; j++)
147 g->strcache[i][j] = g->memerrmsg;
148}
149
150
151
152/*
153** creates a new string object
154*/
155static TString *createstrobj (lua_State *L, size_t l, int tag, unsigned int h) {
156 TString *ts;
157 GCObject *o;
158 size_t totalsize; /* total size of TString object */
159 totalsize = sizelstring(l);
160 o = luaC_newobj(L, tag, totalsize);
161 ts = gco2ts(o);
162 ts->hash = h;
163 ts->extra = 0;
164 getstr(ts)[l] = '\0'; /* ending 0 */
165 return ts;
166}
167
168
169TString *luaS_createlngstrobj (lua_State *L, size_t l) {
170 TString *ts = createstrobj(L, l, LUA_VLNGSTR, G(L)->seed);
171 ts->u.lnglen = l;
172 return ts;
173}
174
175
176void luaS_remove (lua_State *L, TString *ts) {
177 stringtable *tb = &G(L)->strt;
178 TString **p = &tb->hash[lmod(ts->hash, tb->size)];
179 while (*p != ts) /* find previous element */
180 p = &(*p)->u.hnext;
181 *p = (*p)->u.hnext; /* remove element from its list */
182 tb->nuse--;
183}
184
185
186static void growstrtab (lua_State *L, stringtable *tb) {
187 if (unlikely(tb->nuse == MAX_INT)) { /* too many strings? */
188 luaC_fullgc(L, 1); /* try to free some... */
189 if (tb->nuse == MAX_INT) /* still too many? */
190 luaM_error(L); /* cannot even create a message... */
191 }
192 if (tb->size <= MAXSTRTB / 2) /* can grow string table? */
193 luaS_resize(L, tb->size * 2);
194}
195
196
197/*
198** Checks whether short string exists and reuses it or creates a new one.
199*/
200static TString *internshrstr (lua_State *L, const char *str, size_t l) {
201 TString *ts;
202 global_State *g = G(L);
203 stringtable *tb = &g->strt;
204 unsigned int h = luaS_hash(str, l, g->seed, 1);
205 TString **list = &tb->hash[lmod(h, tb->size)];
206 lua_assert(str != NULL); /* otherwise 'memcmp'/'memcpy' are undefined */
207 for (ts = *list; ts != NULL; ts = ts->u.hnext) {
208 if (l == ts->shrlen && (memcmp(str, getstr(ts), l * sizeof(char)) == 0)) {
209 /* found! */
210 if (isdead(g, ts)) /* dead (but not collected yet)? */
211 changewhite(ts); /* resurrect it */
212 return ts;
213 }
214 }
215 /* else must create a new string */
216 if (tb->nuse >= tb->size) { /* need to grow string table? */
217 growstrtab(L, tb);
218 list = &tb->hash[lmod(h, tb->size)]; /* rehash with new size */
219 }
220 ts = createstrobj(L, l, LUA_VSHRSTR, h);
221 memcpy(getstr(ts), str, l * sizeof(char));
222 ts->shrlen = cast_byte(l);
223 ts->u.hnext = *list;
224 *list = ts;
225 tb->nuse++;
226 return ts;
227}
228
229
230/*
231** new string (with explicit length)
232*/
233TString *luaS_newlstr (lua_State *L, const char *str, size_t l) {
234 if (l <= LUAI_MAXSHORTLEN) /* short string? */
235 return internshrstr(L, str, l);
236 else {
237 TString *ts;
238 if (unlikely(l >= (MAX_SIZE - sizeof(TString))/sizeof(char)))
239 luaM_toobig(L);
240 ts = luaS_createlngstrobj(L, l);
241 memcpy(getstr(ts), str, l * sizeof(char));
242 return ts;
243 }
244}
245
246
247/*
248** Create or reuse a zero-terminated string, first checking in the
249** cache (using the string address as a key). The cache can contain
250** only zero-terminated strings, so it is safe to use 'strcmp' to
251** check hits.
252*/
253TString *luaS_new (lua_State *L, const char *str) {
254 unsigned int i = point2uint(str) % STRCACHE_N; /* hash */
255 int j;
256 TString **p = G(L)->strcache[i];
257 for (j = 0; j < STRCACHE_M; j++) {
258 if (strcmp(str, getstr(p[j])) == 0) /* hit? */
259 return p[j]; /* that is it */
260 }
261 /* normal route */
262 for (j = STRCACHE_M - 1; j > 0; j--)
263 p[j] = p[j - 1]; /* move out last element */
264 /* new element is first in the list */
265 p[0] = luaS_newlstr(L, str, strlen(str));
266 return p[0];
267}
268
269
270Udata *luaS_newudata (lua_State *L, size_t s, int nuvalue) {
271 Udata *u;
272 int i;
273 GCObject *o;
274 if (unlikely(s > MAX_SIZE - udatamemoffset(nuvalue)))
275 luaM_toobig(L);
276 o = luaC_newobj(L, LUA_VUSERDATA, sizeudata(nuvalue, s));
277 u = gco2u(o);
278 u->len = s;
279 u->nuvalue = nuvalue;
280 u->metatable = NULL;
281 for (i = 0; i < nuvalue; i++)
282 setnilvalue(&u->uv[i].uv);
283 return u;
284}
285
diff --git a/src/lua/lstring.h b/src/lua/lstring.h
new file mode 100644
index 0000000..a413a9d
--- /dev/null
+++ b/src/lua/lstring.h
@@ -0,0 +1,58 @@
1/*
2** $Id: lstring.h $
3** String table (keep all strings handled by Lua)
4** See Copyright Notice in lua.h
5*/
6
7#ifndef lstring_h
8#define lstring_h
9
10#include "lgc.h"
11#include "lobject.h"
12#include "lstate.h"
13
14
15/*
16** Memory-allocation error message must be preallocated (it cannot
17** be created after memory is exhausted)
18*/
19#define MEMERRMSG "not enough memory"
20
21
22/*
23** Size of a TString: Size of the header plus space for the string
24** itself (including final '\0').
25*/
26#define sizelstring(l) (offsetof(TString, contents) + ((l) + 1) * sizeof(char))
27
28#define luaS_newliteral(L, s) (luaS_newlstr(L, "" s, \
29 (sizeof(s)/sizeof(char))-1))
30
31
32/*
33** test whether a string is a reserved word
34*/
35#define isreserved(s) ((s)->tt == LUA_VSHRSTR && (s)->extra > 0)
36
37
38/*
39** equality for short strings, which are always internalized
40*/
41#define eqshrstr(a,b) check_exp((a)->tt == LUA_VSHRSTR, (a) == (b))
42
43
44LUAI_FUNC unsigned int luaS_hash (const char *str, size_t l,
45 unsigned int seed, size_t step);
46LUAI_FUNC unsigned int luaS_hashlongstr (TString *ts);
47LUAI_FUNC int luaS_eqlngstr (TString *a, TString *b);
48LUAI_FUNC void luaS_resize (lua_State *L, int newsize);
49LUAI_FUNC void luaS_clearcache (global_State *g);
50LUAI_FUNC void luaS_init (lua_State *L);
51LUAI_FUNC void luaS_remove (lua_State *L, TString *ts);
52LUAI_FUNC Udata *luaS_newudata (lua_State *L, size_t s, int nuvalue);
53LUAI_FUNC TString *luaS_newlstr (lua_State *L, const char *str, size_t l);
54LUAI_FUNC TString *luaS_new (lua_State *L, const char *str);
55LUAI_FUNC TString *luaS_createlngstrobj (lua_State *L, size_t l);
56
57
58#endif
diff --git a/src/lua/lstrlib.c b/src/lua/lstrlib.c
new file mode 100644
index 0000000..2ba8bde
--- /dev/null
+++ b/src/lua/lstrlib.c
@@ -0,0 +1,1805 @@
1/*
2** $Id: lstrlib.c $
3** Standard library for string operations and pattern-matching
4** See Copyright Notice in lua.h
5*/
6
7#define lstrlib_c
8#define LUA_LIB
9
10#include "lprefix.h"
11
12
13#include <ctype.h>
14#include <float.h>
15#include <limits.h>
16#include <locale.h>
17#include <math.h>
18#include <stddef.h>
19#include <stdio.h>
20#include <stdlib.h>
21#include <string.h>
22
23#include "lua.h"
24
25#include "lauxlib.h"
26#include "lualib.h"
27
28
29/*
30** maximum number of captures that a pattern can do during
31** pattern-matching. This limit is arbitrary, but must fit in
32** an unsigned char.
33*/
34#if !defined(LUA_MAXCAPTURES)
35#define LUA_MAXCAPTURES 32
36#endif
37
38
39/* macro to 'unsign' a character */
40#define uchar(c) ((unsigned char)(c))
41
42
43/*
44** Some sizes are better limited to fit in 'int', but must also fit in
45** 'size_t'. (We assume that 'lua_Integer' cannot be smaller than 'int'.)
46*/
47#define MAX_SIZET ((size_t)(~(size_t)0))
48
49#define MAXSIZE \
50 (sizeof(size_t) < sizeof(int) ? MAX_SIZET : (size_t)(INT_MAX))
51
52
53
54
55static int str_len (lua_State *L) {
56 size_t l;
57 luaL_checklstring(L, 1, &l);
58 lua_pushinteger(L, (lua_Integer)l);
59 return 1;
60}
61
62
63/*
64** translate a relative initial string position
65** (negative means back from end): clip result to [1, inf).
66** The length of any string in Lua must fit in a lua_Integer,
67** so there are no overflows in the casts.
68** The inverted comparison avoids a possible overflow
69** computing '-pos'.
70*/
71static size_t posrelatI (lua_Integer pos, size_t len) {
72 if (pos > 0)
73 return (size_t)pos;
74 else if (pos == 0)
75 return 1;
76 else if (pos < -(lua_Integer)len) /* inverted comparison */
77 return 1; /* clip to 1 */
78 else return len + (size_t)pos + 1;
79}
80
81
82/*
83** Gets an optional ending string position from argument 'arg',
84** with default value 'def'.
85** Negative means back from end: clip result to [0, len]
86*/
87static size_t getendpos (lua_State *L, int arg, lua_Integer def,
88 size_t len) {
89 lua_Integer pos = luaL_optinteger(L, arg, def);
90 if (pos > (lua_Integer)len)
91 return len;
92 else if (pos >= 0)
93 return (size_t)pos;
94 else if (pos < -(lua_Integer)len)
95 return 0;
96 else return len + (size_t)pos + 1;
97}
98
99
100static int str_sub (lua_State *L) {
101 size_t l;
102 const char *s = luaL_checklstring(L, 1, &l);
103 size_t start = posrelatI(luaL_checkinteger(L, 2), l);
104 size_t end = getendpos(L, 3, -1, l);
105 if (start <= end)
106 lua_pushlstring(L, s + start - 1, (end - start) + 1);
107 else lua_pushliteral(L, "");
108 return 1;
109}
110
111
112static int str_reverse (lua_State *L) {
113 size_t l, i;
114 luaL_Buffer b;
115 const char *s = luaL_checklstring(L, 1, &l);
116 char *p = luaL_buffinitsize(L, &b, l);
117 for (i = 0; i < l; i++)
118 p[i] = s[l - i - 1];
119 luaL_pushresultsize(&b, l);
120 return 1;
121}
122
123
124static int str_lower (lua_State *L) {
125 size_t l;
126 size_t i;
127 luaL_Buffer b;
128 const char *s = luaL_checklstring(L, 1, &l);
129 char *p = luaL_buffinitsize(L, &b, l);
130 for (i=0; i<l; i++)
131 p[i] = tolower(uchar(s[i]));
132 luaL_pushresultsize(&b, l);
133 return 1;
134}
135
136
137static int str_upper (lua_State *L) {
138 size_t l;
139 size_t i;
140 luaL_Buffer b;
141 const char *s = luaL_checklstring(L, 1, &l);
142 char *p = luaL_buffinitsize(L, &b, l);
143 for (i=0; i<l; i++)
144 p[i] = toupper(uchar(s[i]));
145 luaL_pushresultsize(&b, l);
146 return 1;
147}
148
149
150static int str_rep (lua_State *L) {
151 size_t l, lsep;
152 const char *s = luaL_checklstring(L, 1, &l);
153 lua_Integer n = luaL_checkinteger(L, 2);
154 const char *sep = luaL_optlstring(L, 3, "", &lsep);
155 if (n <= 0) lua_pushliteral(L, "");
156 else if (l + lsep < l || l + lsep > MAXSIZE / n) /* may overflow? */
157 return luaL_error(L, "resulting string too large");
158 else {
159 size_t totallen = (size_t)n * l + (size_t)(n - 1) * lsep;
160 luaL_Buffer b;
161 char *p = luaL_buffinitsize(L, &b, totallen);
162 while (n-- > 1) { /* first n-1 copies (followed by separator) */
163 memcpy(p, s, l * sizeof(char)); p += l;
164 if (lsep > 0) { /* empty 'memcpy' is not that cheap */
165 memcpy(p, sep, lsep * sizeof(char));
166 p += lsep;
167 }
168 }
169 memcpy(p, s, l * sizeof(char)); /* last copy (not followed by separator) */
170 luaL_pushresultsize(&b, totallen);
171 }
172 return 1;
173}
174
175
176static int str_byte (lua_State *L) {
177 size_t l;
178 const char *s = luaL_checklstring(L, 1, &l);
179 lua_Integer pi = luaL_optinteger(L, 2, 1);
180 size_t posi = posrelatI(pi, l);
181 size_t pose = getendpos(L, 3, pi, l);
182 int n, i;
183 if (posi > pose) return 0; /* empty interval; return no values */
184 if (pose - posi >= (size_t)INT_MAX) /* arithmetic overflow? */
185 return luaL_error(L, "string slice too long");
186 n = (int)(pose - posi) + 1;
187 luaL_checkstack(L, n, "string slice too long");
188 for (i=0; i<n; i++)
189 lua_pushinteger(L, uchar(s[posi+i-1]));
190 return n;
191}
192
193
194static int str_char (lua_State *L) {
195 int n = lua_gettop(L); /* number of arguments */
196 int i;
197 luaL_Buffer b;
198 char *p = luaL_buffinitsize(L, &b, n);
199 for (i=1; i<=n; i++) {
200 lua_Unsigned c = (lua_Unsigned)luaL_checkinteger(L, i);
201 luaL_argcheck(L, c <= (lua_Unsigned)UCHAR_MAX, i, "value out of range");
202 p[i - 1] = uchar(c);
203 }
204 luaL_pushresultsize(&b, n);
205 return 1;
206}
207
208
209/*
210** Buffer to store the result of 'string.dump'. It must be initialized
211** after the call to 'lua_dump', to ensure that the function is on the
212** top of the stack when 'lua_dump' is called. ('luaL_buffinit' might
213** push stuff.)
214*/
215struct str_Writer {
216 int init; /* true iff buffer has been initialized */
217 luaL_Buffer B;
218};
219
220
221static int writer (lua_State *L, const void *b, size_t size, void *ud) {
222 struct str_Writer *state = (struct str_Writer *)ud;
223 if (!state->init) {
224 state->init = 1;
225 luaL_buffinit(L, &state->B);
226 }
227 luaL_addlstring(&state->B, (const char *)b, size);
228 return 0;
229}
230
231
232static int str_dump (lua_State *L) {
233 struct str_Writer state;
234 int strip = lua_toboolean(L, 2);
235 luaL_checktype(L, 1, LUA_TFUNCTION);
236 lua_settop(L, 1); /* ensure function is on the top of the stack */
237 state.init = 0;
238 if (lua_dump(L, writer, &state, strip) != 0)
239 return luaL_error(L, "unable to dump given function");
240 luaL_pushresult(&state.B);
241 return 1;
242}
243
244
245
246/*
247** {======================================================
248** METAMETHODS
249** =======================================================
250*/
251
252#if defined(LUA_NOCVTS2N) /* { */
253
254/* no coercion from strings to numbers */
255
256static const luaL_Reg stringmetamethods[] = {
257 {"__index", NULL}, /* placeholder */
258 {NULL, NULL}
259};
260
261#else /* }{ */
262
263static int tonum (lua_State *L, int arg) {
264 if (lua_type(L, arg) == LUA_TNUMBER) { /* already a number? */
265 lua_pushvalue(L, arg);
266 return 1;
267 }
268 else { /* check whether it is a numerical string */
269 size_t len;
270 const char *s = lua_tolstring(L, arg, &len);
271 return (s != NULL && lua_stringtonumber(L, s) == len + 1);
272 }
273}
274
275
276static void trymt (lua_State *L, const char *mtname) {
277 lua_settop(L, 2); /* back to the original arguments */
278 if (lua_type(L, 2) == LUA_TSTRING || !luaL_getmetafield(L, 2, mtname))
279 luaL_error(L, "attempt to %s a '%s' with a '%s'", mtname + 2,
280 luaL_typename(L, -2), luaL_typename(L, -1));
281 lua_insert(L, -3); /* put metamethod before arguments */
282 lua_call(L, 2, 1); /* call metamethod */
283}
284
285
286static int arith (lua_State *L, int op, const char *mtname) {
287 if (tonum(L, 1) && tonum(L, 2))
288 lua_arith(L, op); /* result will be on the top */
289 else
290 trymt(L, mtname);
291 return 1;
292}
293
294
295static int arith_add (lua_State *L) {
296 return arith(L, LUA_OPADD, "__add");
297}
298
299static int arith_sub (lua_State *L) {
300 return arith(L, LUA_OPSUB, "__sub");
301}
302
303static int arith_mul (lua_State *L) {
304 return arith(L, LUA_OPMUL, "__mul");
305}
306
307static int arith_mod (lua_State *L) {
308 return arith(L, LUA_OPMOD, "__mod");
309}
310
311static int arith_pow (lua_State *L) {
312 return arith(L, LUA_OPPOW, "__pow");
313}
314
315static int arith_div (lua_State *L) {
316 return arith(L, LUA_OPDIV, "__div");
317}
318
319static int arith_idiv (lua_State *L) {
320 return arith(L, LUA_OPIDIV, "__idiv");
321}
322
323static int arith_unm (lua_State *L) {
324 return arith(L, LUA_OPUNM, "__unm");
325}
326
327
328static const luaL_Reg stringmetamethods[] = {
329 {"__add", arith_add},
330 {"__sub", arith_sub},
331 {"__mul", arith_mul},
332 {"__mod", arith_mod},
333 {"__pow", arith_pow},
334 {"__div", arith_div},
335 {"__idiv", arith_idiv},
336 {"__unm", arith_unm},
337 {"__index", NULL}, /* placeholder */
338 {NULL, NULL}
339};
340
341#endif /* } */
342
343/* }====================================================== */
344
345/*
346** {======================================================
347** PATTERN MATCHING
348** =======================================================
349*/
350
351
352#define CAP_UNFINISHED (-1)
353#define CAP_POSITION (-2)
354
355
356typedef struct MatchState {
357 const char *src_init; /* init of source string */
358 const char *src_end; /* end ('\0') of source string */
359 const char *p_end; /* end ('\0') of pattern */
360 lua_State *L;
361 int matchdepth; /* control for recursive depth (to avoid C stack overflow) */
362 unsigned char level; /* total number of captures (finished or unfinished) */
363 struct {
364 const char *init;
365 ptrdiff_t len;
366 } capture[LUA_MAXCAPTURES];
367} MatchState;
368
369
370/* recursive function */
371static const char *match (MatchState *ms, const char *s, const char *p);
372
373
374/* maximum recursion depth for 'match' */
375#if !defined(MAXCCALLS)
376#define MAXCCALLS 200
377#endif
378
379
380#define L_ESC '%'
381#define SPECIALS "^$*+?.([%-"
382
383
384static int check_capture (MatchState *ms, int l) {
385 l -= '1';
386 if (l < 0 || l >= ms->level || ms->capture[l].len == CAP_UNFINISHED)
387 return luaL_error(ms->L, "invalid capture index %%%d", l + 1);
388 return l;
389}
390
391
392static int capture_to_close (MatchState *ms) {
393 int level = ms->level;
394 for (level--; level>=0; level--)
395 if (ms->capture[level].len == CAP_UNFINISHED) return level;
396 return luaL_error(ms->L, "invalid pattern capture");
397}
398
399
400static const char *classend (MatchState *ms, const char *p) {
401 switch (*p++) {
402 case L_ESC: {
403 if (p == ms->p_end)
404 luaL_error(ms->L, "malformed pattern (ends with '%%')");
405 return p+1;
406 }
407 case '[': {
408 if (*p == '^') p++;
409 do { /* look for a ']' */
410 if (p == ms->p_end)
411 luaL_error(ms->L, "malformed pattern (missing ']')");
412 if (*(p++) == L_ESC && p < ms->p_end)
413 p++; /* skip escapes (e.g. '%]') */
414 } while (*p != ']');
415 return p+1;
416 }
417 default: {
418 return p;
419 }
420 }
421}
422
423
424static int match_class (int c, int cl) {
425 int res;
426 switch (tolower(cl)) {
427 case 'a' : res = isalpha(c); break;
428 case 'c' : res = iscntrl(c); break;
429 case 'd' : res = isdigit(c); break;
430 case 'g' : res = isgraph(c); break;
431 case 'l' : res = islower(c); break;
432 case 'p' : res = ispunct(c); break;
433 case 's' : res = isspace(c); break;
434 case 'u' : res = isupper(c); break;
435 case 'w' : res = isalnum(c); break;
436 case 'x' : res = isxdigit(c); break;
437 case 'z' : res = (c == 0); break; /* deprecated option */
438 default: return (cl == c);
439 }
440 return (islower(cl) ? res : !res);
441}
442
443
444static int matchbracketclass (int c, const char *p, const char *ec) {
445 int sig = 1;
446 if (*(p+1) == '^') {
447 sig = 0;
448 p++; /* skip the '^' */
449 }
450 while (++p < ec) {
451 if (*p == L_ESC) {
452 p++;
453 if (match_class(c, uchar(*p)))
454 return sig;
455 }
456 else if ((*(p+1) == '-') && (p+2 < ec)) {
457 p+=2;
458 if (uchar(*(p-2)) <= c && c <= uchar(*p))
459 return sig;
460 }
461 else if (uchar(*p) == c) return sig;
462 }
463 return !sig;
464}
465
466
467static int singlematch (MatchState *ms, const char *s, const char *p,
468 const char *ep) {
469 if (s >= ms->src_end)
470 return 0;
471 else {
472 int c = uchar(*s);
473 switch (*p) {
474 case '.': return 1; /* matches any char */
475 case L_ESC: return match_class(c, uchar(*(p+1)));
476 case '[': return matchbracketclass(c, p, ep-1);
477 default: return (uchar(*p) == c);
478 }
479 }
480}
481
482
483static const char *matchbalance (MatchState *ms, const char *s,
484 const char *p) {
485 if (p >= ms->p_end - 1)
486 luaL_error(ms->L, "malformed pattern (missing arguments to '%%b')");
487 if (*s != *p) return NULL;
488 else {
489 int b = *p;
490 int e = *(p+1);
491 int cont = 1;
492 while (++s < ms->src_end) {
493 if (*s == e) {
494 if (--cont == 0) return s+1;
495 }
496 else if (*s == b) cont++;
497 }
498 }
499 return NULL; /* string ends out of balance */
500}
501
502
503static const char *max_expand (MatchState *ms, const char *s,
504 const char *p, const char *ep) {
505 ptrdiff_t i = 0; /* counts maximum expand for item */
506 while (singlematch(ms, s + i, p, ep))
507 i++;
508 /* keeps trying to match with the maximum repetitions */
509 while (i>=0) {
510 const char *res = match(ms, (s+i), ep+1);
511 if (res) return res;
512 i--; /* else didn't match; reduce 1 repetition to try again */
513 }
514 return NULL;
515}
516
517
518static const char *min_expand (MatchState *ms, const char *s,
519 const char *p, const char *ep) {
520 for (;;) {
521 const char *res = match(ms, s, ep+1);
522 if (res != NULL)
523 return res;
524 else if (singlematch(ms, s, p, ep))
525 s++; /* try with one more repetition */
526 else return NULL;
527 }
528}
529
530
531static const char *start_capture (MatchState *ms, const char *s,
532 const char *p, int what) {
533 const char *res;
534 int level = ms->level;
535 if (level >= LUA_MAXCAPTURES) luaL_error(ms->L, "too many captures");
536 ms->capture[level].init = s;
537 ms->capture[level].len = what;
538 ms->level = level+1;
539 if ((res=match(ms, s, p)) == NULL) /* match failed? */
540 ms->level--; /* undo capture */
541 return res;
542}
543
544
545static const char *end_capture (MatchState *ms, const char *s,
546 const char *p) {
547 int l = capture_to_close(ms);
548 const char *res;
549 ms->capture[l].len = s - ms->capture[l].init; /* close capture */
550 if ((res = match(ms, s, p)) == NULL) /* match failed? */
551 ms->capture[l].len = CAP_UNFINISHED; /* undo capture */
552 return res;
553}
554
555
556static const char *match_capture (MatchState *ms, const char *s, int l) {
557 size_t len;
558 l = check_capture(ms, l);
559 len = ms->capture[l].len;
560 if ((size_t)(ms->src_end-s) >= len &&
561 memcmp(ms->capture[l].init, s, len) == 0)
562 return s+len;
563 else return NULL;
564}
565
566
567static const char *match (MatchState *ms, const char *s, const char *p) {
568 if (ms->matchdepth-- == 0)
569 luaL_error(ms->L, "pattern too complex");
570 init: /* using goto's to optimize tail recursion */
571 if (p != ms->p_end) { /* end of pattern? */
572 switch (*p) {
573 case '(': { /* start capture */
574 if (*(p + 1) == ')') /* position capture? */
575 s = start_capture(ms, s, p + 2, CAP_POSITION);
576 else
577 s = start_capture(ms, s, p + 1, CAP_UNFINISHED);
578 break;
579 }
580 case ')': { /* end capture */
581 s = end_capture(ms, s, p + 1);
582 break;
583 }
584 case '$': {
585 if ((p + 1) != ms->p_end) /* is the '$' the last char in pattern? */
586 goto dflt; /* no; go to default */
587 s = (s == ms->src_end) ? s : NULL; /* check end of string */
588 break;
589 }
590 case L_ESC: { /* escaped sequences not in the format class[*+?-]? */
591 switch (*(p + 1)) {
592 case 'b': { /* balanced string? */
593 s = matchbalance(ms, s, p + 2);
594 if (s != NULL) {
595 p += 4; goto init; /* return match(ms, s, p + 4); */
596 } /* else fail (s == NULL) */
597 break;
598 }
599 case 'f': { /* frontier? */
600 const char *ep; char previous;
601 p += 2;
602 if (*p != '[')
603 luaL_error(ms->L, "missing '[' after '%%f' in pattern");
604 ep = classend(ms, p); /* points to what is next */
605 previous = (s == ms->src_init) ? '\0' : *(s - 1);
606 if (!matchbracketclass(uchar(previous), p, ep - 1) &&
607 matchbracketclass(uchar(*s), p, ep - 1)) {
608 p = ep; goto init; /* return match(ms, s, ep); */
609 }
610 s = NULL; /* match failed */
611 break;
612 }
613 case '0': case '1': case '2': case '3':
614 case '4': case '5': case '6': case '7':
615 case '8': case '9': { /* capture results (%0-%9)? */
616 s = match_capture(ms, s, uchar(*(p + 1)));
617 if (s != NULL) {
618 p += 2; goto init; /* return match(ms, s, p + 2) */
619 }
620 break;
621 }
622 default: goto dflt;
623 }
624 break;
625 }
626 default: dflt: { /* pattern class plus optional suffix */
627 const char *ep = classend(ms, p); /* points to optional suffix */
628 /* does not match at least once? */
629 if (!singlematch(ms, s, p, ep)) {
630 if (*ep == '*' || *ep == '?' || *ep == '-') { /* accept empty? */
631 p = ep + 1; goto init; /* return match(ms, s, ep + 1); */
632 }
633 else /* '+' or no suffix */
634 s = NULL; /* fail */
635 }
636 else { /* matched once */
637 switch (*ep) { /* handle optional suffix */
638 case '?': { /* optional */
639 const char *res;
640 if ((res = match(ms, s + 1, ep + 1)) != NULL)
641 s = res;
642 else {
643 p = ep + 1; goto init; /* else return match(ms, s, ep + 1); */
644 }
645 break;
646 }
647 case '+': /* 1 or more repetitions */
648 s++; /* 1 match already done */
649 /* FALLTHROUGH */
650 case '*': /* 0 or more repetitions */
651 s = max_expand(ms, s, p, ep);
652 break;
653 case '-': /* 0 or more repetitions (minimum) */
654 s = min_expand(ms, s, p, ep);
655 break;
656 default: /* no suffix */
657 s++; p = ep; goto init; /* return match(ms, s + 1, ep); */
658 }
659 }
660 break;
661 }
662 }
663 }
664 ms->matchdepth++;
665 return s;
666}
667
668
669
670static const char *lmemfind (const char *s1, size_t l1,
671 const char *s2, size_t l2) {
672 if (l2 == 0) return s1; /* empty strings are everywhere */
673 else if (l2 > l1) return NULL; /* avoids a negative 'l1' */
674 else {
675 const char *init; /* to search for a '*s2' inside 's1' */
676 l2--; /* 1st char will be checked by 'memchr' */
677 l1 = l1-l2; /* 's2' cannot be found after that */
678 while (l1 > 0 && (init = (const char *)memchr(s1, *s2, l1)) != NULL) {
679 init++; /* 1st char is already checked */
680 if (memcmp(init, s2+1, l2) == 0)
681 return init-1;
682 else { /* correct 'l1' and 's1' to try again */
683 l1 -= init-s1;
684 s1 = init;
685 }
686 }
687 return NULL; /* not found */
688 }
689}
690
691
692/*
693** get information about the i-th capture. If there are no captures
694** and 'i==0', return information about the whole match, which
695** is the range 's'..'e'. If the capture is a string, return
696** its length and put its address in '*cap'. If it is an integer
697** (a position), push it on the stack and return CAP_POSITION.
698*/
699static size_t get_onecapture (MatchState *ms, int i, const char *s,
700 const char *e, const char **cap) {
701 if (i >= ms->level) {
702 if (i != 0)
703 luaL_error(ms->L, "invalid capture index %%%d", i + 1);
704 *cap = s;
705 return e - s;
706 }
707 else {
708 ptrdiff_t capl = ms->capture[i].len;
709 *cap = ms->capture[i].init;
710 if (capl == CAP_UNFINISHED)
711 luaL_error(ms->L, "unfinished capture");
712 else if (capl == CAP_POSITION)
713 lua_pushinteger(ms->L, (ms->capture[i].init - ms->src_init) + 1);
714 return capl;
715 }
716}
717
718
719/*
720** Push the i-th capture on the stack.
721*/
722static void push_onecapture (MatchState *ms, int i, const char *s,
723 const char *e) {
724 const char *cap;
725 ptrdiff_t l = get_onecapture(ms, i, s, e, &cap);
726 if (l != CAP_POSITION)
727 lua_pushlstring(ms->L, cap, l);
728 /* else position was already pushed */
729}
730
731
732static int push_captures (MatchState *ms, const char *s, const char *e) {
733 int i;
734 int nlevels = (ms->level == 0 && s) ? 1 : ms->level;
735 luaL_checkstack(ms->L, nlevels, "too many captures");
736 for (i = 0; i < nlevels; i++)
737 push_onecapture(ms, i, s, e);
738 return nlevels; /* number of strings pushed */
739}
740
741
742/* check whether pattern has no special characters */
743static int nospecials (const char *p, size_t l) {
744 size_t upto = 0;
745 do {
746 if (strpbrk(p + upto, SPECIALS))
747 return 0; /* pattern has a special character */
748 upto += strlen(p + upto) + 1; /* may have more after \0 */
749 } while (upto <= l);
750 return 1; /* no special chars found */
751}
752
753
754static void prepstate (MatchState *ms, lua_State *L,
755 const char *s, size_t ls, const char *p, size_t lp) {
756 ms->L = L;
757 ms->matchdepth = MAXCCALLS;
758 ms->src_init = s;
759 ms->src_end = s + ls;
760 ms->p_end = p + lp;
761}
762
763
764static void reprepstate (MatchState *ms) {
765 ms->level = 0;
766 lua_assert(ms->matchdepth == MAXCCALLS);
767}
768
769
770static int str_find_aux (lua_State *L, int find) {
771 size_t ls, lp;
772 const char *s = luaL_checklstring(L, 1, &ls);
773 const char *p = luaL_checklstring(L, 2, &lp);
774 size_t init = posrelatI(luaL_optinteger(L, 3, 1), ls) - 1;
775 if (init > ls) { /* start after string's end? */
776 luaL_pushfail(L); /* cannot find anything */
777 return 1;
778 }
779 /* explicit request or no special characters? */
780 if (find && (lua_toboolean(L, 4) || nospecials(p, lp))) {
781 /* do a plain search */
782 const char *s2 = lmemfind(s + init, ls - init, p, lp);
783 if (s2) {
784 lua_pushinteger(L, (s2 - s) + 1);
785 lua_pushinteger(L, (s2 - s) + lp);
786 return 2;
787 }
788 }
789 else {
790 MatchState ms;
791 const char *s1 = s + init;
792 int anchor = (*p == '^');
793 if (anchor) {
794 p++; lp--; /* skip anchor character */
795 }
796 prepstate(&ms, L, s, ls, p, lp);
797 do {
798 const char *res;
799 reprepstate(&ms);
800 if ((res=match(&ms, s1, p)) != NULL) {
801 if (find) {
802 lua_pushinteger(L, (s1 - s) + 1); /* start */
803 lua_pushinteger(L, res - s); /* end */
804 return push_captures(&ms, NULL, 0) + 2;
805 }
806 else
807 return push_captures(&ms, s1, res);
808 }
809 } while (s1++ < ms.src_end && !anchor);
810 }
811 luaL_pushfail(L); /* not found */
812 return 1;
813}
814
815
816static int str_find (lua_State *L) {
817 return str_find_aux(L, 1);
818}
819
820
821static int str_match (lua_State *L) {
822 return str_find_aux(L, 0);
823}
824
825
826/* state for 'gmatch' */
827typedef struct GMatchState {
828 const char *src; /* current position */
829 const char *p; /* pattern */
830 const char *lastmatch; /* end of last match */
831 MatchState ms; /* match state */
832} GMatchState;
833
834
835static int gmatch_aux (lua_State *L) {
836 GMatchState *gm = (GMatchState *)lua_touserdata(L, lua_upvalueindex(3));
837 const char *src;
838 gm->ms.L = L;
839 for (src = gm->src; src <= gm->ms.src_end; src++) {
840 const char *e;
841 reprepstate(&gm->ms);
842 if ((e = match(&gm->ms, src, gm->p)) != NULL && e != gm->lastmatch) {
843 gm->src = gm->lastmatch = e;
844 return push_captures(&gm->ms, src, e);
845 }
846 }
847 return 0; /* not found */
848}
849
850
851static int gmatch (lua_State *L) {
852 size_t ls, lp;
853 const char *s = luaL_checklstring(L, 1, &ls);
854 const char *p = luaL_checklstring(L, 2, &lp);
855 size_t init = posrelatI(luaL_optinteger(L, 3, 1), ls) - 1;
856 GMatchState *gm;
857 lua_settop(L, 2); /* keep strings on closure to avoid being collected */
858 gm = (GMatchState *)lua_newuserdatauv(L, sizeof(GMatchState), 0);
859 if (init > ls) /* start after string's end? */
860 init = ls + 1; /* avoid overflows in 's + init' */
861 prepstate(&gm->ms, L, s, ls, p, lp);
862 gm->src = s + init; gm->p = p; gm->lastmatch = NULL;
863 lua_pushcclosure(L, gmatch_aux, 3);
864 return 1;
865}
866
867
868static void add_s (MatchState *ms, luaL_Buffer *b, const char *s,
869 const char *e) {
870 size_t l;
871 lua_State *L = ms->L;
872 const char *news = lua_tolstring(L, 3, &l);
873 const char *p;
874 while ((p = (char *)memchr(news, L_ESC, l)) != NULL) {
875 luaL_addlstring(b, news, p - news);
876 p++; /* skip ESC */
877 if (*p == L_ESC) /* '%%' */
878 luaL_addchar(b, *p);
879 else if (*p == '0') /* '%0' */
880 luaL_addlstring(b, s, e - s);
881 else if (isdigit(uchar(*p))) { /* '%n' */
882 const char *cap;
883 ptrdiff_t resl = get_onecapture(ms, *p - '1', s, e, &cap);
884 if (resl == CAP_POSITION)
885 luaL_addvalue(b); /* add position to accumulated result */
886 else
887 luaL_addlstring(b, cap, resl);
888 }
889 else
890 luaL_error(L, "invalid use of '%c' in replacement string", L_ESC);
891 l -= p + 1 - news;
892 news = p + 1;
893 }
894 luaL_addlstring(b, news, l);
895}
896
897
898/*
899** Add the replacement value to the string buffer 'b'.
900** Return true if the original string was changed. (Function calls and
901** table indexing resulting in nil or false do not change the subject.)
902*/
903static int add_value (MatchState *ms, luaL_Buffer *b, const char *s,
904 const char *e, int tr) {
905 lua_State *L = ms->L;
906 switch (tr) {
907 case LUA_TFUNCTION: { /* call the function */
908 int n;
909 lua_pushvalue(L, 3); /* push the function */
910 n = push_captures(ms, s, e); /* all captures as arguments */
911 lua_call(L, n, 1); /* call it */
912 break;
913 }
914 case LUA_TTABLE: { /* index the table */
915 push_onecapture(ms, 0, s, e); /* first capture is the index */
916 lua_gettable(L, 3);
917 break;
918 }
919 default: { /* LUA_TNUMBER or LUA_TSTRING */
920 add_s(ms, b, s, e); /* add value to the buffer */
921 return 1; /* something changed */
922 }
923 }
924 if (!lua_toboolean(L, -1)) { /* nil or false? */
925 lua_pop(L, 1); /* remove value */
926 luaL_addlstring(b, s, e - s); /* keep original text */
927 return 0; /* no changes */
928 }
929 else if (!lua_isstring(L, -1))
930 return luaL_error(L, "invalid replacement value (a %s)",
931 luaL_typename(L, -1));
932 else {
933 luaL_addvalue(b); /* add result to accumulator */
934 return 1; /* something changed */
935 }
936}
937
938
939static int str_gsub (lua_State *L) {
940 size_t srcl, lp;
941 const char *src = luaL_checklstring(L, 1, &srcl); /* subject */
942 const char *p = luaL_checklstring(L, 2, &lp); /* pattern */
943 const char *lastmatch = NULL; /* end of last match */
944 int tr = lua_type(L, 3); /* replacement type */
945 lua_Integer max_s = luaL_optinteger(L, 4, srcl + 1); /* max replacements */
946 int anchor = (*p == '^');
947 lua_Integer n = 0; /* replacement count */
948 int changed = 0; /* change flag */
949 MatchState ms;
950 luaL_Buffer b;
951 luaL_argexpected(L, tr == LUA_TNUMBER || tr == LUA_TSTRING ||
952 tr == LUA_TFUNCTION || tr == LUA_TTABLE, 3,
953 "string/function/table");
954 luaL_buffinit(L, &b);
955 if (anchor) {
956 p++; lp--; /* skip anchor character */
957 }
958 prepstate(&ms, L, src, srcl, p, lp);
959 while (n < max_s) {
960 const char *e;
961 reprepstate(&ms); /* (re)prepare state for new match */
962 if ((e = match(&ms, src, p)) != NULL && e != lastmatch) { /* match? */
963 n++;
964 changed = add_value(&ms, &b, src, e, tr) | changed;
965 src = lastmatch = e;
966 }
967 else if (src < ms.src_end) /* otherwise, skip one character */
968 luaL_addchar(&b, *src++);
969 else break; /* end of subject */
970 if (anchor) break;
971 }
972 if (!changed) /* no changes? */
973 lua_pushvalue(L, 1); /* return original string */
974 else { /* something changed */
975 luaL_addlstring(&b, src, ms.src_end-src);
976 luaL_pushresult(&b); /* create and return new string */
977 }
978 lua_pushinteger(L, n); /* number of substitutions */
979 return 2;
980}
981
982/* }====================================================== */
983
984
985
986/*
987** {======================================================
988** STRING FORMAT
989** =======================================================
990*/
991
992#if !defined(lua_number2strx) /* { */
993
994/*
995** Hexadecimal floating-point formatter
996*/
997
998#define SIZELENMOD (sizeof(LUA_NUMBER_FRMLEN)/sizeof(char))
999
1000
1001/*
1002** Number of bits that goes into the first digit. It can be any value
1003** between 1 and 4; the following definition tries to align the number
1004** to nibble boundaries by making what is left after that first digit a
1005** multiple of 4.
1006*/
1007#define L_NBFD ((l_floatatt(MANT_DIG) - 1)%4 + 1)
1008
1009
1010/*
1011** Add integer part of 'x' to buffer and return new 'x'
1012*/
1013static lua_Number adddigit (char *buff, int n, lua_Number x) {
1014 lua_Number dd = l_mathop(floor)(x); /* get integer part from 'x' */
1015 int d = (int)dd;
1016 buff[n] = (d < 10 ? d + '0' : d - 10 + 'a'); /* add to buffer */
1017 return x - dd; /* return what is left */
1018}
1019
1020
1021static int num2straux (char *buff, int sz, lua_Number x) {
1022 /* if 'inf' or 'NaN', format it like '%g' */
1023 if (x != x || x == (lua_Number)HUGE_VAL || x == -(lua_Number)HUGE_VAL)
1024 return l_sprintf(buff, sz, LUA_NUMBER_FMT, (LUAI_UACNUMBER)x);
1025 else if (x == 0) { /* can be -0... */
1026 /* create "0" or "-0" followed by exponent */
1027 return l_sprintf(buff, sz, LUA_NUMBER_FMT "x0p+0", (LUAI_UACNUMBER)x);
1028 }
1029 else {
1030 int e;
1031 lua_Number m = l_mathop(frexp)(x, &e); /* 'x' fraction and exponent */
1032 int n = 0; /* character count */
1033 if (m < 0) { /* is number negative? */
1034 buff[n++] = '-'; /* add sign */
1035 m = -m; /* make it positive */
1036 }
1037 buff[n++] = '0'; buff[n++] = 'x'; /* add "0x" */
1038 m = adddigit(buff, n++, m * (1 << L_NBFD)); /* add first digit */
1039 e -= L_NBFD; /* this digit goes before the radix point */
1040 if (m > 0) { /* more digits? */
1041 buff[n++] = lua_getlocaledecpoint(); /* add radix point */
1042 do { /* add as many digits as needed */
1043 m = adddigit(buff, n++, m * 16);
1044 } while (m > 0);
1045 }
1046 n += l_sprintf(buff + n, sz - n, "p%+d", e); /* add exponent */
1047 lua_assert(n < sz);
1048 return n;
1049 }
1050}
1051
1052
1053static int lua_number2strx (lua_State *L, char *buff, int sz,
1054 const char *fmt, lua_Number x) {
1055 int n = num2straux(buff, sz, x);
1056 if (fmt[SIZELENMOD] == 'A') {
1057 int i;
1058 for (i = 0; i < n; i++)
1059 buff[i] = toupper(uchar(buff[i]));
1060 }
1061 else if (fmt[SIZELENMOD] != 'a')
1062 return luaL_error(L, "modifiers for format '%%a'/'%%A' not implemented");
1063 return n;
1064}
1065
1066#endif /* } */
1067
1068
1069/*
1070** Maximum size for items formatted with '%f'. This size is produced
1071** by format('%.99f', -maxfloat), and is equal to 99 + 3 ('-', '.',
1072** and '\0') + number of decimal digits to represent maxfloat (which
1073** is maximum exponent + 1). (99+3+1, adding some extra, 110)
1074*/
1075#define MAX_ITEMF (110 + l_floatatt(MAX_10_EXP))
1076
1077
1078/*
1079** All formats except '%f' do not need that large limit. The other
1080** float formats use exponents, so that they fit in the 99 limit for
1081** significant digits; 's' for large strings and 'q' add items directly
1082** to the buffer; all integer formats also fit in the 99 limit. The
1083** worst case are floats: they may need 99 significant digits, plus
1084** '0x', '-', '.', 'e+XXXX', and '\0'. Adding some extra, 120.
1085*/
1086#define MAX_ITEM 120
1087
1088
1089/* valid flags in a format specification */
1090#if !defined(L_FMTFLAGS)
1091#define L_FMTFLAGS "-+ #0"
1092#endif
1093
1094
1095/*
1096** maximum size of each format specification (such as "%-099.99d")
1097*/
1098#define MAX_FORMAT 32
1099
1100
1101static void addquoted (luaL_Buffer *b, const char *s, size_t len) {
1102 luaL_addchar(b, '"');
1103 while (len--) {
1104 if (*s == '"' || *s == '\\' || *s == '\n') {
1105 luaL_addchar(b, '\\');
1106 luaL_addchar(b, *s);
1107 }
1108 else if (iscntrl(uchar(*s))) {
1109 char buff[10];
1110 if (!isdigit(uchar(*(s+1))))
1111 l_sprintf(buff, sizeof(buff), "\\%d", (int)uchar(*s));
1112 else
1113 l_sprintf(buff, sizeof(buff), "\\%03d", (int)uchar(*s));
1114 luaL_addstring(b, buff);
1115 }
1116 else
1117 luaL_addchar(b, *s);
1118 s++;
1119 }
1120 luaL_addchar(b, '"');
1121}
1122
1123
1124/*
1125** Serialize a floating-point number in such a way that it can be
1126** scanned back by Lua. Use hexadecimal format for "common" numbers
1127** (to preserve precision); inf, -inf, and NaN are handled separately.
1128** (NaN cannot be expressed as a numeral, so we write '(0/0)' for it.)
1129*/
1130static int quotefloat (lua_State *L, char *buff, lua_Number n) {
1131 const char *s; /* for the fixed representations */
1132 if (n == (lua_Number)HUGE_VAL) /* inf? */
1133 s = "1e9999";
1134 else if (n == -(lua_Number)HUGE_VAL) /* -inf? */
1135 s = "-1e9999";
1136 else if (n != n) /* NaN? */
1137 s = "(0/0)";
1138 else { /* format number as hexadecimal */
1139 int nb = lua_number2strx(L, buff, MAX_ITEM,
1140 "%" LUA_NUMBER_FRMLEN "a", n);
1141 /* ensures that 'buff' string uses a dot as the radix character */
1142 if (memchr(buff, '.', nb) == NULL) { /* no dot? */
1143 char point = lua_getlocaledecpoint(); /* try locale point */
1144 char *ppoint = (char *)memchr(buff, point, nb);
1145 if (ppoint) *ppoint = '.'; /* change it to a dot */
1146 }
1147 return nb;
1148 }
1149 /* for the fixed representations */
1150 return l_sprintf(buff, MAX_ITEM, "%s", s);
1151}
1152
1153
1154static void addliteral (lua_State *L, luaL_Buffer *b, int arg) {
1155 switch (lua_type(L, arg)) {
1156 case LUA_TSTRING: {
1157 size_t len;
1158 const char *s = lua_tolstring(L, arg, &len);
1159 addquoted(b, s, len);
1160 break;
1161 }
1162 case LUA_TNUMBER: {
1163 char *buff = luaL_prepbuffsize(b, MAX_ITEM);
1164 int nb;
1165 if (!lua_isinteger(L, arg)) /* float? */
1166 nb = quotefloat(L, buff, lua_tonumber(L, arg));
1167 else { /* integers */
1168 lua_Integer n = lua_tointeger(L, arg);
1169 const char *format = (n == LUA_MININTEGER) /* corner case? */
1170 ? "0x%" LUA_INTEGER_FRMLEN "x" /* use hex */
1171 : LUA_INTEGER_FMT; /* else use default format */
1172 nb = l_sprintf(buff, MAX_ITEM, format, (LUAI_UACINT)n);
1173 }
1174 luaL_addsize(b, nb);
1175 break;
1176 }
1177 case LUA_TNIL: case LUA_TBOOLEAN: {
1178 luaL_tolstring(L, arg, NULL);
1179 luaL_addvalue(b);
1180 break;
1181 }
1182 default: {
1183 luaL_argerror(L, arg, "value has no literal form");
1184 }
1185 }
1186}
1187
1188
1189static const char *scanformat (lua_State *L, const char *strfrmt, char *form) {
1190 const char *p = strfrmt;
1191 while (*p != '\0' && strchr(L_FMTFLAGS, *p) != NULL) p++; /* skip flags */
1192 if ((size_t)(p - strfrmt) >= sizeof(L_FMTFLAGS)/sizeof(char))
1193 luaL_error(L, "invalid format (repeated flags)");
1194 if (isdigit(uchar(*p))) p++; /* skip width */
1195 if (isdigit(uchar(*p))) p++; /* (2 digits at most) */
1196 if (*p == '.') {
1197 p++;
1198 if (isdigit(uchar(*p))) p++; /* skip precision */
1199 if (isdigit(uchar(*p))) p++; /* (2 digits at most) */
1200 }
1201 if (isdigit(uchar(*p)))
1202 luaL_error(L, "invalid format (width or precision too long)");
1203 *(form++) = '%';
1204 memcpy(form, strfrmt, ((p - strfrmt) + 1) * sizeof(char));
1205 form += (p - strfrmt) + 1;
1206 *form = '\0';
1207 return p;
1208}
1209
1210
1211/*
1212** add length modifier into formats
1213*/
1214static void addlenmod (char *form, const char *lenmod) {
1215 size_t l = strlen(form);
1216 size_t lm = strlen(lenmod);
1217 char spec = form[l - 1];
1218 strcpy(form + l - 1, lenmod);
1219 form[l + lm - 1] = spec;
1220 form[l + lm] = '\0';
1221}
1222
1223
1224static int str_format (lua_State *L) {
1225 int top = lua_gettop(L);
1226 int arg = 1;
1227 size_t sfl;
1228 const char *strfrmt = luaL_checklstring(L, arg, &sfl);
1229 const char *strfrmt_end = strfrmt+sfl;
1230 luaL_Buffer b;
1231 luaL_buffinit(L, &b);
1232 while (strfrmt < strfrmt_end) {
1233 if (*strfrmt != L_ESC)
1234 luaL_addchar(&b, *strfrmt++);
1235 else if (*++strfrmt == L_ESC)
1236 luaL_addchar(&b, *strfrmt++); /* %% */
1237 else { /* format item */
1238 char form[MAX_FORMAT]; /* to store the format ('%...') */
1239 int maxitem = MAX_ITEM;
1240 char *buff = luaL_prepbuffsize(&b, maxitem); /* to put formatted item */
1241 int nb = 0; /* number of bytes in added item */
1242 if (++arg > top)
1243 return luaL_argerror(L, arg, "no value");
1244 strfrmt = scanformat(L, strfrmt, form);
1245 switch (*strfrmt++) {
1246 case 'c': {
1247 nb = l_sprintf(buff, maxitem, form, (int)luaL_checkinteger(L, arg));
1248 break;
1249 }
1250 case 'd': case 'i':
1251 case 'o': case 'u': case 'x': case 'X': {
1252 lua_Integer n = luaL_checkinteger(L, arg);
1253 addlenmod(form, LUA_INTEGER_FRMLEN);
1254 nb = l_sprintf(buff, maxitem, form, (LUAI_UACINT)n);
1255 break;
1256 }
1257 case 'a': case 'A':
1258 addlenmod(form, LUA_NUMBER_FRMLEN);
1259 nb = lua_number2strx(L, buff, maxitem, form,
1260 luaL_checknumber(L, arg));
1261 break;
1262 case 'f':
1263 maxitem = MAX_ITEMF; /* extra space for '%f' */
1264 buff = luaL_prepbuffsize(&b, maxitem);
1265 /* FALLTHROUGH */
1266 case 'e': case 'E': case 'g': case 'G': {
1267 lua_Number n = luaL_checknumber(L, arg);
1268 addlenmod(form, LUA_NUMBER_FRMLEN);
1269 nb = l_sprintf(buff, maxitem, form, (LUAI_UACNUMBER)n);
1270 break;
1271 }
1272 case 'p': {
1273 const void *p = lua_topointer(L, arg);
1274 if (p == NULL) { /* avoid calling 'printf' with argument NULL */
1275 p = "(null)"; /* result */
1276 form[strlen(form) - 1] = 's'; /* format it as a string */
1277 }
1278 nb = l_sprintf(buff, maxitem, form, p);
1279 break;
1280 }
1281 case 'q': {
1282 if (form[2] != '\0') /* modifiers? */
1283 return luaL_error(L, "specifier '%%q' cannot have modifiers");
1284 addliteral(L, &b, arg);
1285 break;
1286 }
1287 case 's': {
1288 size_t l;
1289 const char *s = luaL_tolstring(L, arg, &l);
1290 if (form[2] == '\0') /* no modifiers? */
1291 luaL_addvalue(&b); /* keep entire string */
1292 else {
1293 luaL_argcheck(L, l == strlen(s), arg, "string contains zeros");
1294 if (!strchr(form, '.') && l >= 100) {
1295 /* no precision and string is too long to be formatted */
1296 luaL_addvalue(&b); /* keep entire string */
1297 }
1298 else { /* format the string into 'buff' */
1299 nb = l_sprintf(buff, maxitem, form, s);
1300 lua_pop(L, 1); /* remove result from 'luaL_tolstring' */
1301 }
1302 }
1303 break;
1304 }
1305 default: { /* also treat cases 'pnLlh' */
1306 return luaL_error(L, "invalid conversion '%s' to 'format'", form);
1307 }
1308 }
1309 lua_assert(nb < maxitem);
1310 luaL_addsize(&b, nb);
1311 }
1312 }
1313 luaL_pushresult(&b);
1314 return 1;
1315}
1316
1317/* }====================================================== */
1318
1319
1320/*
1321** {======================================================
1322** PACK/UNPACK
1323** =======================================================
1324*/
1325
1326
1327/* value used for padding */
1328#if !defined(LUAL_PACKPADBYTE)
1329#define LUAL_PACKPADBYTE 0x00
1330#endif
1331
1332/* maximum size for the binary representation of an integer */
1333#define MAXINTSIZE 16
1334
1335/* number of bits in a character */
1336#define NB CHAR_BIT
1337
1338/* mask for one character (NB 1's) */
1339#define MC ((1 << NB) - 1)
1340
1341/* size of a lua_Integer */
1342#define SZINT ((int)sizeof(lua_Integer))
1343
1344
1345/* dummy union to get native endianness */
1346static const union {
1347 int dummy;
1348 char little; /* true iff machine is little endian */
1349} nativeendian = {1};
1350
1351
1352/* dummy structure to get native alignment requirements */
1353struct cD {
1354 char c;
1355 union { double d; void *p; lua_Integer i; lua_Number n; } u;
1356};
1357
1358#define MAXALIGN (offsetof(struct cD, u))
1359
1360
1361/*
1362** Union for serializing floats
1363*/
1364typedef union Ftypes {
1365 float f;
1366 double d;
1367 lua_Number n;
1368 char buff[5 * sizeof(lua_Number)]; /* enough for any float type */
1369} Ftypes;
1370
1371
1372/*
1373** information to pack/unpack stuff
1374*/
1375typedef struct Header {
1376 lua_State *L;
1377 int islittle;
1378 int maxalign;
1379} Header;
1380
1381
1382/*
1383** options for pack/unpack
1384*/
1385typedef enum KOption {
1386 Kint, /* signed integers */
1387 Kuint, /* unsigned integers */
1388 Kfloat, /* floating-point numbers */
1389 Kchar, /* fixed-length strings */
1390 Kstring, /* strings with prefixed length */
1391 Kzstr, /* zero-terminated strings */
1392 Kpadding, /* padding */
1393 Kpaddalign, /* padding for alignment */
1394 Knop /* no-op (configuration or spaces) */
1395} KOption;
1396
1397
1398/*
1399** Read an integer numeral from string 'fmt' or return 'df' if
1400** there is no numeral
1401*/
1402static int digit (int c) { return '0' <= c && c <= '9'; }
1403
1404static int getnum (const char **fmt, int df) {
1405 if (!digit(**fmt)) /* no number? */
1406 return df; /* return default value */
1407 else {
1408 int a = 0;
1409 do {
1410 a = a*10 + (*((*fmt)++) - '0');
1411 } while (digit(**fmt) && a <= ((int)MAXSIZE - 9)/10);
1412 return a;
1413 }
1414}
1415
1416
1417/*
1418** Read an integer numeral and raises an error if it is larger
1419** than the maximum size for integers.
1420*/
1421static int getnumlimit (Header *h, const char **fmt, int df) {
1422 int sz = getnum(fmt, df);
1423 if (sz > MAXINTSIZE || sz <= 0)
1424 return luaL_error(h->L, "integral size (%d) out of limits [1,%d]",
1425 sz, MAXINTSIZE);
1426 return sz;
1427}
1428
1429
1430/*
1431** Initialize Header
1432*/
1433static void initheader (lua_State *L, Header *h) {
1434 h->L = L;
1435 h->islittle = nativeendian.little;
1436 h->maxalign = 1;
1437}
1438
1439
1440/*
1441** Read and classify next option. 'size' is filled with option's size.
1442*/
1443static KOption getoption (Header *h, const char **fmt, int *size) {
1444 int opt = *((*fmt)++);
1445 *size = 0; /* default */
1446 switch (opt) {
1447 case 'b': *size = sizeof(char); return Kint;
1448 case 'B': *size = sizeof(char); return Kuint;
1449 case 'h': *size = sizeof(short); return Kint;
1450 case 'H': *size = sizeof(short); return Kuint;
1451 case 'l': *size = sizeof(long); return Kint;
1452 case 'L': *size = sizeof(long); return Kuint;
1453 case 'j': *size = sizeof(lua_Integer); return Kint;
1454 case 'J': *size = sizeof(lua_Integer); return Kuint;
1455 case 'T': *size = sizeof(size_t); return Kuint;
1456 case 'f': *size = sizeof(float); return Kfloat;
1457 case 'd': *size = sizeof(double); return Kfloat;
1458 case 'n': *size = sizeof(lua_Number); return Kfloat;
1459 case 'i': *size = getnumlimit(h, fmt, sizeof(int)); return Kint;
1460 case 'I': *size = getnumlimit(h, fmt, sizeof(int)); return Kuint;
1461 case 's': *size = getnumlimit(h, fmt, sizeof(size_t)); return Kstring;
1462 case 'c':
1463 *size = getnum(fmt, -1);
1464 if (*size == -1)
1465 luaL_error(h->L, "missing size for format option 'c'");
1466 return Kchar;
1467 case 'z': return Kzstr;
1468 case 'x': *size = 1; return Kpadding;
1469 case 'X': return Kpaddalign;
1470 case ' ': break;
1471 case '<': h->islittle = 1; break;
1472 case '>': h->islittle = 0; break;
1473 case '=': h->islittle = nativeendian.little; break;
1474 case '!': h->maxalign = getnumlimit(h, fmt, MAXALIGN); break;
1475 default: luaL_error(h->L, "invalid format option '%c'", opt);
1476 }
1477 return Knop;
1478}
1479
1480
1481/*
1482** Read, classify, and fill other details about the next option.
1483** 'psize' is filled with option's size, 'notoalign' with its
1484** alignment requirements.
1485** Local variable 'size' gets the size to be aligned. (Kpadal option
1486** always gets its full alignment, other options are limited by
1487** the maximum alignment ('maxalign'). Kchar option needs no alignment
1488** despite its size.
1489*/
1490static KOption getdetails (Header *h, size_t totalsize,
1491 const char **fmt, int *psize, int *ntoalign) {
1492 KOption opt = getoption(h, fmt, psize);
1493 int align = *psize; /* usually, alignment follows size */
1494 if (opt == Kpaddalign) { /* 'X' gets alignment from following option */
1495 if (**fmt == '\0' || getoption(h, fmt, &align) == Kchar || align == 0)
1496 luaL_argerror(h->L, 1, "invalid next option for option 'X'");
1497 }
1498 if (align <= 1 || opt == Kchar) /* need no alignment? */
1499 *ntoalign = 0;
1500 else {
1501 if (align > h->maxalign) /* enforce maximum alignment */
1502 align = h->maxalign;
1503 if ((align & (align - 1)) != 0) /* is 'align' not a power of 2? */
1504 luaL_argerror(h->L, 1, "format asks for alignment not power of 2");
1505 *ntoalign = (align - (int)(totalsize & (align - 1))) & (align - 1);
1506 }
1507 return opt;
1508}
1509
1510
1511/*
1512** Pack integer 'n' with 'size' bytes and 'islittle' endianness.
1513** The final 'if' handles the case when 'size' is larger than
1514** the size of a Lua integer, correcting the extra sign-extension
1515** bytes if necessary (by default they would be zeros).
1516*/
1517static void packint (luaL_Buffer *b, lua_Unsigned n,
1518 int islittle, int size, int neg) {
1519 char *buff = luaL_prepbuffsize(b, size);
1520 int i;
1521 buff[islittle ? 0 : size - 1] = (char)(n & MC); /* first byte */
1522 for (i = 1; i < size; i++) {
1523 n >>= NB;
1524 buff[islittle ? i : size - 1 - i] = (char)(n & MC);
1525 }
1526 if (neg && size > SZINT) { /* negative number need sign extension? */
1527 for (i = SZINT; i < size; i++) /* correct extra bytes */
1528 buff[islittle ? i : size - 1 - i] = (char)MC;
1529 }
1530 luaL_addsize(b, size); /* add result to buffer */
1531}
1532
1533
1534/*
1535** Copy 'size' bytes from 'src' to 'dest', correcting endianness if
1536** given 'islittle' is different from native endianness.
1537*/
1538static void copywithendian (volatile char *dest, volatile const char *src,
1539 int size, int islittle) {
1540 if (islittle == nativeendian.little) {
1541 while (size-- != 0)
1542 *(dest++) = *(src++);
1543 }
1544 else {
1545 dest += size - 1;
1546 while (size-- != 0)
1547 *(dest--) = *(src++);
1548 }
1549}
1550
1551
1552static int str_pack (lua_State *L) {
1553 luaL_Buffer b;
1554 Header h;
1555 const char *fmt = luaL_checkstring(L, 1); /* format string */
1556 int arg = 1; /* current argument to pack */
1557 size_t totalsize = 0; /* accumulate total size of result */
1558 initheader(L, &h);
1559 lua_pushnil(L); /* mark to separate arguments from string buffer */
1560 luaL_buffinit(L, &b);
1561 while (*fmt != '\0') {
1562 int size, ntoalign;
1563 KOption opt = getdetails(&h, totalsize, &fmt, &size, &ntoalign);
1564 totalsize += ntoalign + size;
1565 while (ntoalign-- > 0)
1566 luaL_addchar(&b, LUAL_PACKPADBYTE); /* fill alignment */
1567 arg++;
1568 switch (opt) {
1569 case Kint: { /* signed integers */
1570 lua_Integer n = luaL_checkinteger(L, arg);
1571 if (size < SZINT) { /* need overflow check? */
1572 lua_Integer lim = (lua_Integer)1 << ((size * NB) - 1);
1573 luaL_argcheck(L, -lim <= n && n < lim, arg, "integer overflow");
1574 }
1575 packint(&b, (lua_Unsigned)n, h.islittle, size, (n < 0));
1576 break;
1577 }
1578 case Kuint: { /* unsigned integers */
1579 lua_Integer n = luaL_checkinteger(L, arg);
1580 if (size < SZINT) /* need overflow check? */
1581 luaL_argcheck(L, (lua_Unsigned)n < ((lua_Unsigned)1 << (size * NB)),
1582 arg, "unsigned overflow");
1583 packint(&b, (lua_Unsigned)n, h.islittle, size, 0);
1584 break;
1585 }
1586 case Kfloat: { /* floating-point options */
1587 volatile Ftypes u;
1588 char *buff = luaL_prepbuffsize(&b, size);
1589 lua_Number n = luaL_checknumber(L, arg); /* get argument */
1590 if (size == sizeof(u.f)) u.f = (float)n; /* copy it into 'u' */
1591 else if (size == sizeof(u.d)) u.d = (double)n;
1592 else u.n = n;
1593 /* move 'u' to final result, correcting endianness if needed */
1594 copywithendian(buff, u.buff, size, h.islittle);
1595 luaL_addsize(&b, size);
1596 break;
1597 }
1598 case Kchar: { /* fixed-size string */
1599 size_t len;
1600 const char *s = luaL_checklstring(L, arg, &len);
1601 luaL_argcheck(L, len <= (size_t)size, arg,
1602 "string longer than given size");
1603 luaL_addlstring(&b, s, len); /* add string */
1604 while (len++ < (size_t)size) /* pad extra space */
1605 luaL_addchar(&b, LUAL_PACKPADBYTE);
1606 break;
1607 }
1608 case Kstring: { /* strings with length count */
1609 size_t len;
1610 const char *s = luaL_checklstring(L, arg, &len);
1611 luaL_argcheck(L, size >= (int)sizeof(size_t) ||
1612 len < ((size_t)1 << (size * NB)),
1613 arg, "string length does not fit in given size");
1614 packint(&b, (lua_Unsigned)len, h.islittle, size, 0); /* pack length */
1615 luaL_addlstring(&b, s, len);
1616 totalsize += len;
1617 break;
1618 }
1619 case Kzstr: { /* zero-terminated string */
1620 size_t len;
1621 const char *s = luaL_checklstring(L, arg, &len);
1622 luaL_argcheck(L, strlen(s) == len, arg, "string contains zeros");
1623 luaL_addlstring(&b, s, len);
1624 luaL_addchar(&b, '\0'); /* add zero at the end */
1625 totalsize += len + 1;
1626 break;
1627 }
1628 case Kpadding: luaL_addchar(&b, LUAL_PACKPADBYTE); /* FALLTHROUGH */
1629 case Kpaddalign: case Knop:
1630 arg--; /* undo increment */
1631 break;
1632 }
1633 }
1634 luaL_pushresult(&b);
1635 return 1;
1636}
1637
1638
1639static int str_packsize (lua_State *L) {
1640 Header h;
1641 const char *fmt = luaL_checkstring(L, 1); /* format string */
1642 size_t totalsize = 0; /* accumulate total size of result */
1643 initheader(L, &h);
1644 while (*fmt != '\0') {
1645 int size, ntoalign;
1646 KOption opt = getdetails(&h, totalsize, &fmt, &size, &ntoalign);
1647 luaL_argcheck(L, opt != Kstring && opt != Kzstr, 1,
1648 "variable-length format");
1649 size += ntoalign; /* total space used by option */
1650 luaL_argcheck(L, totalsize <= MAXSIZE - size, 1,
1651 "format result too large");
1652 totalsize += size;
1653 }
1654 lua_pushinteger(L, (lua_Integer)totalsize);
1655 return 1;
1656}
1657
1658
1659/*
1660** Unpack an integer with 'size' bytes and 'islittle' endianness.
1661** If size is smaller than the size of a Lua integer and integer
1662** is signed, must do sign extension (propagating the sign to the
1663** higher bits); if size is larger than the size of a Lua integer,
1664** it must check the unread bytes to see whether they do not cause an
1665** overflow.
1666*/
1667static lua_Integer unpackint (lua_State *L, const char *str,
1668 int islittle, int size, int issigned) {
1669 lua_Unsigned res = 0;
1670 int i;
1671 int limit = (size <= SZINT) ? size : SZINT;
1672 for (i = limit - 1; i >= 0; i--) {
1673 res <<= NB;
1674 res |= (lua_Unsigned)(unsigned char)str[islittle ? i : size - 1 - i];
1675 }
1676 if (size < SZINT) { /* real size smaller than lua_Integer? */
1677 if (issigned) { /* needs sign extension? */
1678 lua_Unsigned mask = (lua_Unsigned)1 << (size*NB - 1);
1679 res = ((res ^ mask) - mask); /* do sign extension */
1680 }
1681 }
1682 else if (size > SZINT) { /* must check unread bytes */
1683 int mask = (!issigned || (lua_Integer)res >= 0) ? 0 : MC;
1684 for (i = limit; i < size; i++) {
1685 if ((unsigned char)str[islittle ? i : size - 1 - i] != mask)
1686 luaL_error(L, "%d-byte integer does not fit into Lua Integer", size);
1687 }
1688 }
1689 return (lua_Integer)res;
1690}
1691
1692
1693static int str_unpack (lua_State *L) {
1694 Header h;
1695 const char *fmt = luaL_checkstring(L, 1);
1696 size_t ld;
1697 const char *data = luaL_checklstring(L, 2, &ld);
1698 size_t pos = posrelatI(luaL_optinteger(L, 3, 1), ld) - 1;
1699 int n = 0; /* number of results */
1700 luaL_argcheck(L, pos <= ld, 3, "initial position out of string");
1701 initheader(L, &h);
1702 while (*fmt != '\0') {
1703 int size, ntoalign;
1704 KOption opt = getdetails(&h, pos, &fmt, &size, &ntoalign);
1705 luaL_argcheck(L, (size_t)ntoalign + size <= ld - pos, 2,
1706 "data string too short");
1707 pos += ntoalign; /* skip alignment */
1708 /* stack space for item + next position */
1709 luaL_checkstack(L, 2, "too many results");
1710 n++;
1711 switch (opt) {
1712 case Kint:
1713 case Kuint: {
1714 lua_Integer res = unpackint(L, data + pos, h.islittle, size,
1715 (opt == Kint));
1716 lua_pushinteger(L, res);
1717 break;
1718 }
1719 case Kfloat: {
1720 volatile Ftypes u;
1721 lua_Number num;
1722 copywithendian(u.buff, data + pos, size, h.islittle);
1723 if (size == sizeof(u.f)) num = (lua_Number)u.f;
1724 else if (size == sizeof(u.d)) num = (lua_Number)u.d;
1725 else num = u.n;
1726 lua_pushnumber(L, num);
1727 break;
1728 }
1729 case Kchar: {
1730 lua_pushlstring(L, data + pos, size);
1731 break;
1732 }
1733 case Kstring: {
1734 size_t len = (size_t)unpackint(L, data + pos, h.islittle, size, 0);
1735 luaL_argcheck(L, len <= ld - pos - size, 2, "data string too short");
1736 lua_pushlstring(L, data + pos + size, len);
1737 pos += len; /* skip string */
1738 break;
1739 }
1740 case Kzstr: {
1741 size_t len = (int)strlen(data + pos);
1742 luaL_argcheck(L, pos + len < ld, 2,
1743 "unfinished string for format 'z'");
1744 lua_pushlstring(L, data + pos, len);
1745 pos += len + 1; /* skip string plus final '\0' */
1746 break;
1747 }
1748 case Kpaddalign: case Kpadding: case Knop:
1749 n--; /* undo increment */
1750 break;
1751 }
1752 pos += size;
1753 }
1754 lua_pushinteger(L, pos + 1); /* next position */
1755 return n + 1;
1756}
1757
1758/* }====================================================== */
1759
1760
1761static const luaL_Reg strlib[] = {
1762 {"byte", str_byte},
1763 {"char", str_char},
1764 {"dump", str_dump},
1765 {"find", str_find},
1766 {"format", str_format},
1767 {"gmatch", gmatch},
1768 {"gsub", str_gsub},
1769 {"len", str_len},
1770 {"lower", str_lower},
1771 {"match", str_match},
1772 {"rep", str_rep},
1773 {"reverse", str_reverse},
1774 {"sub", str_sub},
1775 {"upper", str_upper},
1776 {"pack", str_pack},
1777 {"packsize", str_packsize},
1778 {"unpack", str_unpack},
1779 {NULL, NULL}
1780};
1781
1782
1783static void createmetatable (lua_State *L) {
1784 /* table to be metatable for strings */
1785 luaL_newlibtable(L, stringmetamethods);
1786 luaL_setfuncs(L, stringmetamethods, 0);
1787 lua_pushliteral(L, ""); /* dummy string */
1788 lua_pushvalue(L, -2); /* copy table */
1789 lua_setmetatable(L, -2); /* set table as metatable for strings */
1790 lua_pop(L, 1); /* pop dummy string */
1791 lua_pushvalue(L, -2); /* get string library */
1792 lua_setfield(L, -2, "__index"); /* metatable.__index = string */
1793 lua_pop(L, 1); /* pop metatable */
1794}
1795
1796
1797/*
1798** Open string library
1799*/
1800LUAMOD_API int luaopen_string (lua_State *L) {
1801 luaL_newlib(L, strlib);
1802 createmetatable(L);
1803 return 1;
1804}
1805
diff --git a/src/lua/ltable.c b/src/lua/ltable.c
new file mode 100644
index 0000000..d7eb69a
--- /dev/null
+++ b/src/lua/ltable.c
@@ -0,0 +1,924 @@
1/*
2** $Id: ltable.c $
3** Lua tables (hash)
4** See Copyright Notice in lua.h
5*/
6
7#define ltable_c
8#define LUA_CORE
9
10#include "lprefix.h"
11
12
13/*
14** Implementation of tables (aka arrays, objects, or hash tables).
15** Tables keep its elements in two parts: an array part and a hash part.
16** Non-negative integer keys are all candidates to be kept in the array
17** part. The actual size of the array is the largest 'n' such that
18** more than half the slots between 1 and n are in use.
19** Hash uses a mix of chained scatter table with Brent's variation.
20** A main invariant of these tables is that, if an element is not
21** in its main position (i.e. the 'original' position that its hash gives
22** to it), then the colliding element is in its own main position.
23** Hence even when the load factor reaches 100%, performance remains good.
24*/
25
26#include <math.h>
27#include <limits.h>
28
29#include "lua.h"
30
31#include "ldebug.h"
32#include "ldo.h"
33#include "lgc.h"
34#include "lmem.h"
35#include "lobject.h"
36#include "lstate.h"
37#include "lstring.h"
38#include "ltable.h"
39#include "lvm.h"
40
41
42/*
43** MAXABITS is the largest integer such that MAXASIZE fits in an
44** unsigned int.
45*/
46#define MAXABITS cast_int(sizeof(int) * CHAR_BIT - 1)
47
48
49/*
50** MAXASIZE is the maximum size of the array part. It is the minimum
51** between 2^MAXABITS and the maximum size that, measured in bytes,
52** fits in a 'size_t'.
53*/
54#define MAXASIZE luaM_limitN(1u << MAXABITS, TValue)
55
56/*
57** MAXHBITS is the largest integer such that 2^MAXHBITS fits in a
58** signed int.
59*/
60#define MAXHBITS (MAXABITS - 1)
61
62
63/*
64** MAXHSIZE is the maximum size of the hash part. It is the minimum
65** between 2^MAXHBITS and the maximum size such that, measured in bytes,
66** it fits in a 'size_t'.
67*/
68#define MAXHSIZE luaM_limitN(1u << MAXHBITS, Node)
69
70
71#define hashpow2(t,n) (gnode(t, lmod((n), sizenode(t))))
72
73#define hashstr(t,str) hashpow2(t, (str)->hash)
74#define hashboolean(t,p) hashpow2(t, p)
75#define hashint(t,i) hashpow2(t, i)
76
77
78/*
79** for some types, it is better to avoid modulus by power of 2, as
80** they tend to have many 2 factors.
81*/
82#define hashmod(t,n) (gnode(t, ((n) % ((sizenode(t)-1)|1))))
83
84
85#define hashpointer(t,p) hashmod(t, point2uint(p))
86
87
88#define dummynode (&dummynode_)
89
90static const Node dummynode_ = {
91 {{NULL}, LUA_VEMPTY, /* value's value and type */
92 LUA_VNIL, 0, {NULL}} /* key type, next, and key value */
93};
94
95
96static const TValue absentkey = {ABSTKEYCONSTANT};
97
98
99
100/*
101** Hash for floating-point numbers.
102** The main computation should be just
103** n = frexp(n, &i); return (n * INT_MAX) + i
104** but there are some numerical subtleties.
105** In a two-complement representation, INT_MAX does not has an exact
106** representation as a float, but INT_MIN does; because the absolute
107** value of 'frexp' is smaller than 1 (unless 'n' is inf/NaN), the
108** absolute value of the product 'frexp * -INT_MIN' is smaller or equal
109** to INT_MAX. Next, the use of 'unsigned int' avoids overflows when
110** adding 'i'; the use of '~u' (instead of '-u') avoids problems with
111** INT_MIN.
112*/
113#if !defined(l_hashfloat)
114static int l_hashfloat (lua_Number n) {
115 int i;
116 lua_Integer ni;
117 n = l_mathop(frexp)(n, &i) * -cast_num(INT_MIN);
118 if (!lua_numbertointeger(n, &ni)) { /* is 'n' inf/-inf/NaN? */
119 lua_assert(luai_numisnan(n) || l_mathop(fabs)(n) == cast_num(HUGE_VAL));
120 return 0;
121 }
122 else { /* normal case */
123 unsigned int u = cast_uint(i) + cast_uint(ni);
124 return cast_int(u <= cast_uint(INT_MAX) ? u : ~u);
125 }
126}
127#endif
128
129
130/*
131** returns the 'main' position of an element in a table (that is,
132** the index of its hash value). The key comes broken (tag in 'ktt'
133** and value in 'vkl') so that we can call it on keys inserted into
134** nodes.
135*/
136static Node *mainposition (const Table *t, int ktt, const Value *kvl) {
137 switch (withvariant(ktt)) {
138 case LUA_VNUMINT:
139 return hashint(t, ivalueraw(*kvl));
140 case LUA_VNUMFLT:
141 return hashmod(t, l_hashfloat(fltvalueraw(*kvl)));
142 case LUA_VSHRSTR:
143 return hashstr(t, tsvalueraw(*kvl));
144 case LUA_VLNGSTR:
145 return hashpow2(t, luaS_hashlongstr(tsvalueraw(*kvl)));
146 case LUA_VFALSE:
147 return hashboolean(t, 0);
148 case LUA_VTRUE:
149 return hashboolean(t, 1);
150 case LUA_VLIGHTUSERDATA:
151 return hashpointer(t, pvalueraw(*kvl));
152 case LUA_VLCF:
153 return hashpointer(t, fvalueraw(*kvl));
154 default:
155 return hashpointer(t, gcvalueraw(*kvl));
156 }
157}
158
159
160/*
161** Returns the main position of an element given as a 'TValue'
162*/
163static Node *mainpositionTV (const Table *t, const TValue *key) {
164 return mainposition(t, rawtt(key), valraw(key));
165}
166
167
168/*
169** Check whether key 'k1' is equal to the key in node 'n2'.
170** This equality is raw, so there are no metamethods. Floats
171** with integer values have been normalized, so integers cannot
172** be equal to floats. It is assumed that 'eqshrstr' is simply
173** pointer equality, so that short strings are handled in the
174** default case.
175*/
176static int equalkey (const TValue *k1, const Node *n2) {
177 if (rawtt(k1) != keytt(n2)) /* not the same variants? */
178 return 0; /* cannot be same key */
179 switch (ttypetag(k1)) {
180 case LUA_VNIL: case LUA_VFALSE: case LUA_VTRUE:
181 return 1;
182 case LUA_VNUMINT:
183 return (ivalue(k1) == keyival(n2));
184 case LUA_VNUMFLT:
185 return luai_numeq(fltvalue(k1), fltvalueraw(keyval(n2)));
186 case LUA_VLIGHTUSERDATA:
187 return pvalue(k1) == pvalueraw(keyval(n2));
188 case LUA_VLCF:
189 return fvalue(k1) == fvalueraw(keyval(n2));
190 case LUA_VLNGSTR:
191 return luaS_eqlngstr(tsvalue(k1), keystrval(n2));
192 default:
193 return gcvalue(k1) == gcvalueraw(keyval(n2));
194 }
195}
196
197
198/*
199** True if value of 'alimit' is equal to the real size of the array
200** part of table 't'. (Otherwise, the array part must be larger than
201** 'alimit'.)
202*/
203#define limitequalsasize(t) (isrealasize(t) || ispow2((t)->alimit))
204
205
206/*
207** Returns the real size of the 'array' array
208*/
209LUAI_FUNC unsigned int luaH_realasize (const Table *t) {
210 if (limitequalsasize(t))
211 return t->alimit; /* this is the size */
212 else {
213 unsigned int size = t->alimit;
214 /* compute the smallest power of 2 not smaller than 'n' */
215 size |= (size >> 1);
216 size |= (size >> 2);
217 size |= (size >> 4);
218 size |= (size >> 8);
219 size |= (size >> 16);
220#if (UINT_MAX >> 30) > 3
221 size |= (size >> 32); /* unsigned int has more than 32 bits */
222#endif
223 size++;
224 lua_assert(ispow2(size) && size/2 < t->alimit && t->alimit < size);
225 return size;
226 }
227}
228
229
230/*
231** Check whether real size of the array is a power of 2.
232** (If it is not, 'alimit' cannot be changed to any other value
233** without changing the real size.)
234*/
235static int ispow2realasize (const Table *t) {
236 return (!isrealasize(t) || ispow2(t->alimit));
237}
238
239
240static unsigned int setlimittosize (Table *t) {
241 t->alimit = luaH_realasize(t);
242 setrealasize(t);
243 return t->alimit;
244}
245
246
247#define limitasasize(t) check_exp(isrealasize(t), t->alimit)
248
249
250
251/*
252** "Generic" get version. (Not that generic: not valid for integers,
253** which may be in array part, nor for floats with integral values.)
254*/
255static const TValue *getgeneric (Table *t, const TValue *key) {
256 Node *n = mainpositionTV(t, key);
257 for (;;) { /* check whether 'key' is somewhere in the chain */
258 if (equalkey(key, n))
259 return gval(n); /* that's it */
260 else {
261 int nx = gnext(n);
262 if (nx == 0)
263 return &absentkey; /* not found */
264 n += nx;
265 }
266 }
267}
268
269
270/*
271** returns the index for 'k' if 'k' is an appropriate key to live in
272** the array part of a table, 0 otherwise.
273*/
274static unsigned int arrayindex (lua_Integer k) {
275 if (l_castS2U(k) - 1u < MAXASIZE) /* 'k' in [1, MAXASIZE]? */
276 return cast_uint(k); /* 'key' is an appropriate array index */
277 else
278 return 0;
279}
280
281
282/*
283** returns the index of a 'key' for table traversals. First goes all
284** elements in the array part, then elements in the hash part. The
285** beginning of a traversal is signaled by 0.
286*/
287static unsigned int findindex (lua_State *L, Table *t, TValue *key,
288 unsigned int asize) {
289 unsigned int i;
290 if (ttisnil(key)) return 0; /* first iteration */
291 i = ttisinteger(key) ? arrayindex(ivalue(key)) : 0;
292 if (i - 1u < asize) /* is 'key' inside array part? */
293 return i; /* yes; that's the index */
294 else {
295 const TValue *n = getgeneric(t, key);
296 if (unlikely(isabstkey(n)))
297 luaG_runerror(L, "invalid key to 'next'"); /* key not found */
298 i = cast_int(nodefromval(n) - gnode(t, 0)); /* key index in hash table */
299 /* hash elements are numbered after array ones */
300 return (i + 1) + asize;
301 }
302}
303
304
305int luaH_next (lua_State *L, Table *t, StkId key) {
306 unsigned int asize = luaH_realasize(t);
307 unsigned int i = findindex(L, t, s2v(key), asize); /* find original key */
308 for (; i < asize; i++) { /* try first array part */
309 if (!isempty(&t->array[i])) { /* a non-empty entry? */
310 setivalue(s2v(key), i + 1);
311 setobj2s(L, key + 1, &t->array[i]);
312 return 1;
313 }
314 }
315 for (i -= asize; cast_int(i) < sizenode(t); i++) { /* hash part */
316 if (!isempty(gval(gnode(t, i)))) { /* a non-empty entry? */
317 Node *n = gnode(t, i);
318 getnodekey(L, s2v(key), n);
319 setobj2s(L, key + 1, gval(n));
320 return 1;
321 }
322 }
323 return 0; /* no more elements */
324}
325
326
327static void freehash (lua_State *L, Table *t) {
328 if (!isdummy(t))
329 luaM_freearray(L, t->node, cast_sizet(sizenode(t)));
330}
331
332
333/*
334** {=============================================================
335** Rehash
336** ==============================================================
337*/
338
339/*
340** Compute the optimal size for the array part of table 't'. 'nums' is a
341** "count array" where 'nums[i]' is the number of integers in the table
342** between 2^(i - 1) + 1 and 2^i. 'pna' enters with the total number of
343** integer keys in the table and leaves with the number of keys that
344** will go to the array part; return the optimal size. (The condition
345** 'twotoi > 0' in the for loop stops the loop if 'twotoi' overflows.)
346*/
347static unsigned int computesizes (unsigned int nums[], unsigned int *pna) {
348 int i;
349 unsigned int twotoi; /* 2^i (candidate for optimal size) */
350 unsigned int a = 0; /* number of elements smaller than 2^i */
351 unsigned int na = 0; /* number of elements to go to array part */
352 unsigned int optimal = 0; /* optimal size for array part */
353 /* loop while keys can fill more than half of total size */
354 for (i = 0, twotoi = 1;
355 twotoi > 0 && *pna > twotoi / 2;
356 i++, twotoi *= 2) {
357 a += nums[i];
358 if (a > twotoi/2) { /* more than half elements present? */
359 optimal = twotoi; /* optimal size (till now) */
360 na = a; /* all elements up to 'optimal' will go to array part */
361 }
362 }
363 lua_assert((optimal == 0 || optimal / 2 < na) && na <= optimal);
364 *pna = na;
365 return optimal;
366}
367
368
369static int countint (lua_Integer key, unsigned int *nums) {
370 unsigned int k = arrayindex(key);
371 if (k != 0) { /* is 'key' an appropriate array index? */
372 nums[luaO_ceillog2(k)]++; /* count as such */
373 return 1;
374 }
375 else
376 return 0;
377}
378
379
380/*
381** Count keys in array part of table 't': Fill 'nums[i]' with
382** number of keys that will go into corresponding slice and return
383** total number of non-nil keys.
384*/
385static unsigned int numusearray (const Table *t, unsigned int *nums) {
386 int lg;
387 unsigned int ttlg; /* 2^lg */
388 unsigned int ause = 0; /* summation of 'nums' */
389 unsigned int i = 1; /* count to traverse all array keys */
390 unsigned int asize = limitasasize(t); /* real array size */
391 /* traverse each slice */
392 for (lg = 0, ttlg = 1; lg <= MAXABITS; lg++, ttlg *= 2) {
393 unsigned int lc = 0; /* counter */
394 unsigned int lim = ttlg;
395 if (lim > asize) {
396 lim = asize; /* adjust upper limit */
397 if (i > lim)
398 break; /* no more elements to count */
399 }
400 /* count elements in range (2^(lg - 1), 2^lg] */
401 for (; i <= lim; i++) {
402 if (!isempty(&t->array[i-1]))
403 lc++;
404 }
405 nums[lg] += lc;
406 ause += lc;
407 }
408 return ause;
409}
410
411
412static int numusehash (const Table *t, unsigned int *nums, unsigned int *pna) {
413 int totaluse = 0; /* total number of elements */
414 int ause = 0; /* elements added to 'nums' (can go to array part) */
415 int i = sizenode(t);
416 while (i--) {
417 Node *n = &t->node[i];
418 if (!isempty(gval(n))) {
419 if (keyisinteger(n))
420 ause += countint(keyival(n), nums);
421 totaluse++;
422 }
423 }
424 *pna += ause;
425 return totaluse;
426}
427
428
429/*
430** Creates an array for the hash part of a table with the given
431** size, or reuses the dummy node if size is zero.
432** The computation for size overflow is in two steps: the first
433** comparison ensures that the shift in the second one does not
434** overflow.
435*/
436static void setnodevector (lua_State *L, Table *t, unsigned int size) {
437 if (size == 0) { /* no elements to hash part? */
438 t->node = cast(Node *, dummynode); /* use common 'dummynode' */
439 t->lsizenode = 0;
440 t->lastfree = NULL; /* signal that it is using dummy node */
441 }
442 else {
443 int i;
444 int lsize = luaO_ceillog2(size);
445 if (lsize > MAXHBITS || (1u << lsize) > MAXHSIZE)
446 luaG_runerror(L, "table overflow");
447 size = twoto(lsize);
448 t->node = luaM_newvector(L, size, Node);
449 for (i = 0; i < (int)size; i++) {
450 Node *n = gnode(t, i);
451 gnext(n) = 0;
452 setnilkey(n);
453 setempty(gval(n));
454 }
455 t->lsizenode = cast_byte(lsize);
456 t->lastfree = gnode(t, size); /* all positions are free */
457 }
458}
459
460
461/*
462** (Re)insert all elements from the hash part of 'ot' into table 't'.
463*/
464static void reinsert (lua_State *L, Table *ot, Table *t) {
465 int j;
466 int size = sizenode(ot);
467 for (j = 0; j < size; j++) {
468 Node *old = gnode(ot, j);
469 if (!isempty(gval(old))) {
470 /* doesn't need barrier/invalidate cache, as entry was
471 already present in the table */
472 TValue k;
473 getnodekey(L, &k, old);
474 setobjt2t(L, luaH_set(L, t, &k), gval(old));
475 }
476 }
477}
478
479
480/*
481** Exchange the hash part of 't1' and 't2'.
482*/
483static void exchangehashpart (Table *t1, Table *t2) {
484 lu_byte lsizenode = t1->lsizenode;
485 Node *node = t1->node;
486 Node *lastfree = t1->lastfree;
487 t1->lsizenode = t2->lsizenode;
488 t1->node = t2->node;
489 t1->lastfree = t2->lastfree;
490 t2->lsizenode = lsizenode;
491 t2->node = node;
492 t2->lastfree = lastfree;
493}
494
495
496/*
497** Resize table 't' for the new given sizes. Both allocations (for
498** the hash part and for the array part) can fail, which creates some
499** subtleties. If the first allocation, for the hash part, fails, an
500** error is raised and that is it. Otherwise, it copies the elements from
501** the shrinking part of the array (if it is shrinking) into the new
502** hash. Then it reallocates the array part. If that fails, the table
503** is in its original state; the function frees the new hash part and then
504** raises the allocation error. Otherwise, it sets the new hash part
505** into the table, initializes the new part of the array (if any) with
506** nils and reinserts the elements of the old hash back into the new
507** parts of the table.
508*/
509void luaH_resize (lua_State *L, Table *t, unsigned int newasize,
510 unsigned int nhsize) {
511 unsigned int i;
512 Table newt; /* to keep the new hash part */
513 unsigned int oldasize = setlimittosize(t);
514 TValue *newarray;
515 /* create new hash part with appropriate size into 'newt' */
516 setnodevector(L, &newt, nhsize);
517 if (newasize < oldasize) { /* will array shrink? */
518 t->alimit = newasize; /* pretend array has new size... */
519 exchangehashpart(t, &newt); /* and new hash */
520 /* re-insert into the new hash the elements from vanishing slice */
521 for (i = newasize; i < oldasize; i++) {
522 if (!isempty(&t->array[i]))
523 luaH_setint(L, t, i + 1, &t->array[i]);
524 }
525 t->alimit = oldasize; /* restore current size... */
526 exchangehashpart(t, &newt); /* and hash (in case of errors) */
527 }
528 /* allocate new array */
529 newarray = luaM_reallocvector(L, t->array, oldasize, newasize, TValue);
530 if (unlikely(newarray == NULL && newasize > 0)) { /* allocation failed? */
531 freehash(L, &newt); /* release new hash part */
532 luaM_error(L); /* raise error (with array unchanged) */
533 }
534 /* allocation ok; initialize new part of the array */
535 exchangehashpart(t, &newt); /* 't' has the new hash ('newt' has the old) */
536 t->array = newarray; /* set new array part */
537 t->alimit = newasize;
538 for (i = oldasize; i < newasize; i++) /* clear new slice of the array */
539 setempty(&t->array[i]);
540 /* re-insert elements from old hash part into new parts */
541 reinsert(L, &newt, t); /* 'newt' now has the old hash */
542 freehash(L, &newt); /* free old hash part */
543}
544
545
546void luaH_resizearray (lua_State *L, Table *t, unsigned int nasize) {
547 int nsize = allocsizenode(t);
548 luaH_resize(L, t, nasize, nsize);
549}
550
551/*
552** nums[i] = number of keys 'k' where 2^(i - 1) < k <= 2^i
553*/
554static void rehash (lua_State *L, Table *t, const TValue *ek) {
555 unsigned int asize; /* optimal size for array part */
556 unsigned int na; /* number of keys in the array part */
557 unsigned int nums[MAXABITS + 1];
558 int i;
559 int totaluse;
560 for (i = 0; i <= MAXABITS; i++) nums[i] = 0; /* reset counts */
561 setlimittosize(t);
562 na = numusearray(t, nums); /* count keys in array part */
563 totaluse = na; /* all those keys are integer keys */
564 totaluse += numusehash(t, nums, &na); /* count keys in hash part */
565 /* count extra key */
566 if (ttisinteger(ek))
567 na += countint(ivalue(ek), nums);
568 totaluse++;
569 /* compute new size for array part */
570 asize = computesizes(nums, &na);
571 /* resize the table to new computed sizes */
572 luaH_resize(L, t, asize, totaluse - na);
573}
574
575
576
577/*
578** }=============================================================
579*/
580
581
582Table *luaH_new (lua_State *L) {
583 GCObject *o = luaC_newobj(L, LUA_VTABLE, sizeof(Table));
584 Table *t = gco2t(o);
585 t->metatable = NULL;
586 t->flags = cast_byte(~0);
587 t->array = NULL;
588 t->alimit = 0;
589 setnodevector(L, t, 0);
590 return t;
591}
592
593
594void luaH_free (lua_State *L, Table *t) {
595 freehash(L, t);
596 luaM_freearray(L, t->array, luaH_realasize(t));
597 luaM_free(L, t);
598}
599
600
601static Node *getfreepos (Table *t) {
602 if (!isdummy(t)) {
603 while (t->lastfree > t->node) {
604 t->lastfree--;
605 if (keyisnil(t->lastfree))
606 return t->lastfree;
607 }
608 }
609 return NULL; /* could not find a free place */
610}
611
612
613
614/*
615** inserts a new key into a hash table; first, check whether key's main
616** position is free. If not, check whether colliding node is in its main
617** position or not: if it is not, move colliding node to an empty place and
618** put new key in its main position; otherwise (colliding node is in its main
619** position), new key goes to an empty position.
620*/
621TValue *luaH_newkey (lua_State *L, Table *t, const TValue *key) {
622 Node *mp;
623 TValue aux;
624 if (unlikely(ttisnil(key)))
625 luaG_runerror(L, "table index is nil");
626 else if (ttisfloat(key)) {
627 lua_Number f = fltvalue(key);
628 lua_Integer k;
629 if (luaV_flttointeger(f, &k, F2Ieq)) { /* does key fit in an integer? */
630 setivalue(&aux, k);
631 key = &aux; /* insert it as an integer */
632 }
633 else if (unlikely(luai_numisnan(f)))
634 luaG_runerror(L, "table index is NaN");
635 }
636 mp = mainpositionTV(t, key);
637 if (!isempty(gval(mp)) || isdummy(t)) { /* main position is taken? */
638 Node *othern;
639 Node *f = getfreepos(t); /* get a free place */
640 if (f == NULL) { /* cannot find a free place? */
641 rehash(L, t, key); /* grow table */
642 /* whatever called 'newkey' takes care of TM cache */
643 return luaH_set(L, t, key); /* insert key into grown table */
644 }
645 lua_assert(!isdummy(t));
646 othern = mainposition(t, keytt(mp), &keyval(mp));
647 if (othern != mp) { /* is colliding node out of its main position? */
648 /* yes; move colliding node into free position */
649 while (othern + gnext(othern) != mp) /* find previous */
650 othern += gnext(othern);
651 gnext(othern) = cast_int(f - othern); /* rechain to point to 'f' */
652 *f = *mp; /* copy colliding node into free pos. (mp->next also goes) */
653 if (gnext(mp) != 0) {
654 gnext(f) += cast_int(mp - f); /* correct 'next' */
655 gnext(mp) = 0; /* now 'mp' is free */
656 }
657 setempty(gval(mp));
658 }
659 else { /* colliding node is in its own main position */
660 /* new node will go into free position */
661 if (gnext(mp) != 0)
662 gnext(f) = cast_int((mp + gnext(mp)) - f); /* chain new position */
663 else lua_assert(gnext(f) == 0);
664 gnext(mp) = cast_int(f - mp);
665 mp = f;
666 }
667 }
668 setnodekey(L, mp, key);
669 luaC_barrierback(L, obj2gco(t), key);
670 lua_assert(isempty(gval(mp)));
671 return gval(mp);
672}
673
674
675/*
676** Search function for integers. If integer is inside 'alimit', get it
677** directly from the array part. Otherwise, if 'alimit' is not equal to
678** the real size of the array, key still can be in the array part. In
679** this case, try to avoid a call to 'luaH_realasize' when key is just
680** one more than the limit (so that it can be incremented without
681** changing the real size of the array).
682*/
683const TValue *luaH_getint (Table *t, lua_Integer key) {
684 if (l_castS2U(key) - 1u < t->alimit) /* 'key' in [1, t->alimit]? */
685 return &t->array[key - 1];
686 else if (!limitequalsasize(t) && /* key still may be in the array part? */
687 (l_castS2U(key) == t->alimit + 1 ||
688 l_castS2U(key) - 1u < luaH_realasize(t))) {
689 t->alimit = cast_uint(key); /* probably '#t' is here now */
690 return &t->array[key - 1];
691 }
692 else {
693 Node *n = hashint(t, key);
694 for (;;) { /* check whether 'key' is somewhere in the chain */
695 if (keyisinteger(n) && keyival(n) == key)
696 return gval(n); /* that's it */
697 else {
698 int nx = gnext(n);
699 if (nx == 0) break;
700 n += nx;
701 }
702 }
703 return &absentkey;
704 }
705}
706
707
708/*
709** search function for short strings
710*/
711const TValue *luaH_getshortstr (Table *t, TString *key) {
712 Node *n = hashstr(t, key);
713 lua_assert(key->tt == LUA_VSHRSTR);
714 for (;;) { /* check whether 'key' is somewhere in the chain */
715 if (keyisshrstr(n) && eqshrstr(keystrval(n), key))
716 return gval(n); /* that's it */
717 else {
718 int nx = gnext(n);
719 if (nx == 0)
720 return &absentkey; /* not found */
721 n += nx;
722 }
723 }
724}
725
726
727const TValue *luaH_getstr (Table *t, TString *key) {
728 if (key->tt == LUA_VSHRSTR)
729 return luaH_getshortstr(t, key);
730 else { /* for long strings, use generic case */
731 TValue ko;
732 setsvalue(cast(lua_State *, NULL), &ko, key);
733 return getgeneric(t, &ko);
734 }
735}
736
737
738/*
739** main search function
740*/
741const TValue *luaH_get (Table *t, const TValue *key) {
742 switch (ttypetag(key)) {
743 case LUA_VSHRSTR: return luaH_getshortstr(t, tsvalue(key));
744 case LUA_VNUMINT: return luaH_getint(t, ivalue(key));
745 case LUA_VNIL: return &absentkey;
746 case LUA_VNUMFLT: {
747 lua_Integer k;
748 if (luaV_flttointeger(fltvalue(key), &k, F2Ieq)) /* integral index? */
749 return luaH_getint(t, k); /* use specialized version */
750 /* else... */
751 } /* FALLTHROUGH */
752 default:
753 return getgeneric(t, key);
754 }
755}
756
757
758/*
759** beware: when using this function you probably need to check a GC
760** barrier and invalidate the TM cache.
761*/
762TValue *luaH_set (lua_State *L, Table *t, const TValue *key) {
763 const TValue *p = luaH_get(t, key);
764 if (!isabstkey(p))
765 return cast(TValue *, p);
766 else return luaH_newkey(L, t, key);
767}
768
769
770void luaH_setint (lua_State *L, Table *t, lua_Integer key, TValue *value) {
771 const TValue *p = luaH_getint(t, key);
772 TValue *cell;
773 if (!isabstkey(p))
774 cell = cast(TValue *, p);
775 else {
776 TValue k;
777 setivalue(&k, key);
778 cell = luaH_newkey(L, t, &k);
779 }
780 setobj2t(L, cell, value);
781}
782
783
784/*
785** Try to find a boundary in the hash part of table 't'. From the
786** caller, we know that 'j' is zero or present and that 'j + 1' is
787** present. We want to find a larger key that is absent from the
788** table, so that we can do a binary search between the two keys to
789** find a boundary. We keep doubling 'j' until we get an absent index.
790** If the doubling would overflow, we try LUA_MAXINTEGER. If it is
791** absent, we are ready for the binary search. ('j', being max integer,
792** is larger or equal to 'i', but it cannot be equal because it is
793** absent while 'i' is present; so 'j > i'.) Otherwise, 'j' is a
794** boundary. ('j + 1' cannot be a present integer key because it is
795** not a valid integer in Lua.)
796*/
797static lua_Unsigned hash_search (Table *t, lua_Unsigned j) {
798 lua_Unsigned i;
799 if (j == 0) j++; /* the caller ensures 'j + 1' is present */
800 do {
801 i = j; /* 'i' is a present index */
802 if (j <= l_castS2U(LUA_MAXINTEGER) / 2)
803 j *= 2;
804 else {
805 j = LUA_MAXINTEGER;
806 if (isempty(luaH_getint(t, j))) /* t[j] not present? */
807 break; /* 'j' now is an absent index */
808 else /* weird case */
809 return j; /* well, max integer is a boundary... */
810 }
811 } while (!isempty(luaH_getint(t, j))); /* repeat until an absent t[j] */
812 /* i < j && t[i] present && t[j] absent */
813 while (j - i > 1u) { /* do a binary search between them */
814 lua_Unsigned m = (i + j) / 2;
815 if (isempty(luaH_getint(t, m))) j = m;
816 else i = m;
817 }
818 return i;
819}
820
821
822static unsigned int binsearch (const TValue *array, unsigned int i,
823 unsigned int j) {
824 while (j - i > 1u) { /* binary search */
825 unsigned int m = (i + j) / 2;
826 if (isempty(&array[m - 1])) j = m;
827 else i = m;
828 }
829 return i;
830}
831
832
833/*
834** Try to find a boundary in table 't'. (A 'boundary' is an integer index
835** such that t[i] is present and t[i+1] is absent, or 0 if t[1] is absent
836** and 'maxinteger' if t[maxinteger] is present.)
837** (In the next explanation, we use Lua indices, that is, with base 1.
838** The code itself uses base 0 when indexing the array part of the table.)
839** The code starts with 'limit = t->alimit', a position in the array
840** part that may be a boundary.
841**
842** (1) If 't[limit]' is empty, there must be a boundary before it.
843** As a common case (e.g., after 't[#t]=nil'), check whether 'limit-1'
844** is present. If so, it is a boundary. Otherwise, do a binary search
845** between 0 and limit to find a boundary. In both cases, try to
846** use this boundary as the new 'alimit', as a hint for the next call.
847**
848** (2) If 't[limit]' is not empty and the array has more elements
849** after 'limit', try to find a boundary there. Again, try first
850** the special case (which should be quite frequent) where 'limit+1'
851** is empty, so that 'limit' is a boundary. Otherwise, check the
852** last element of the array part. If it is empty, there must be a
853** boundary between the old limit (present) and the last element
854** (absent), which is found with a binary search. (This boundary always
855** can be a new limit.)
856**
857** (3) The last case is when there are no elements in the array part
858** (limit == 0) or its last element (the new limit) is present.
859** In this case, must check the hash part. If there is no hash part
860** or 'limit+1' is absent, 'limit' is a boundary. Otherwise, call
861** 'hash_search' to find a boundary in the hash part of the table.
862** (In those cases, the boundary is not inside the array part, and
863** therefore cannot be used as a new limit.)
864*/
865lua_Unsigned luaH_getn (Table *t) {
866 unsigned int limit = t->alimit;
867 if (limit > 0 && isempty(&t->array[limit - 1])) { /* (1)? */
868 /* there must be a boundary before 'limit' */
869 if (limit >= 2 && !isempty(&t->array[limit - 2])) {
870 /* 'limit - 1' is a boundary; can it be a new limit? */
871 if (ispow2realasize(t) && !ispow2(limit - 1)) {
872 t->alimit = limit - 1;
873 setnorealasize(t); /* now 'alimit' is not the real size */
874 }
875 return limit - 1;
876 }
877 else { /* must search for a boundary in [0, limit] */
878 unsigned int boundary = binsearch(t->array, 0, limit);
879 /* can this boundary represent the real size of the array? */
880 if (ispow2realasize(t) && boundary > luaH_realasize(t) / 2) {
881 t->alimit = boundary; /* use it as the new limit */
882 setnorealasize(t);
883 }
884 return boundary;
885 }
886 }
887 /* 'limit' is zero or present in table */
888 if (!limitequalsasize(t)) { /* (2)? */
889 /* 'limit' > 0 and array has more elements after 'limit' */
890 if (isempty(&t->array[limit])) /* 'limit + 1' is empty? */
891 return limit; /* this is the boundary */
892 /* else, try last element in the array */
893 limit = luaH_realasize(t);
894 if (isempty(&t->array[limit - 1])) { /* empty? */
895 /* there must be a boundary in the array after old limit,
896 and it must be a valid new limit */
897 unsigned int boundary = binsearch(t->array, t->alimit, limit);
898 t->alimit = boundary;
899 return boundary;
900 }
901 /* else, new limit is present in the table; check the hash part */
902 }
903 /* (3) 'limit' is the last element and either is zero or present in table */
904 lua_assert(limit == luaH_realasize(t) &&
905 (limit == 0 || !isempty(&t->array[limit - 1])));
906 if (isdummy(t) || isempty(luaH_getint(t, cast(lua_Integer, limit + 1))))
907 return limit; /* 'limit + 1' is absent */
908 else /* 'limit + 1' is also present */
909 return hash_search(t, limit);
910}
911
912
913
914#if defined(LUA_DEBUG)
915
916/* export these functions for the test library */
917
918Node *luaH_mainposition (const Table *t, const TValue *key) {
919 return mainpositionTV(t, key);
920}
921
922int luaH_isdummy (const Table *t) { return isdummy(t); }
923
924#endif
diff --git a/src/lua/ltable.h b/src/lua/ltable.h
new file mode 100644
index 0000000..ebd7f8e
--- /dev/null
+++ b/src/lua/ltable.h
@@ -0,0 +1,57 @@
1/*
2** $Id: ltable.h $
3** Lua tables (hash)
4** See Copyright Notice in lua.h
5*/
6
7#ifndef ltable_h
8#define ltable_h
9
10#include "lobject.h"
11
12
13#define gnode(t,i) (&(t)->node[i])
14#define gval(n) (&(n)->i_val)
15#define gnext(n) ((n)->u.next)
16
17
18#define invalidateTMcache(t) ((t)->flags = 0)
19
20
21/* true when 't' is using 'dummynode' as its hash part */
22#define isdummy(t) ((t)->lastfree == NULL)
23
24
25/* allocated size for hash nodes */
26#define allocsizenode(t) (isdummy(t) ? 0 : sizenode(t))
27
28
29/* returns the Node, given the value of a table entry */
30#define nodefromval(v) cast(Node *, (v))
31
32
33LUAI_FUNC const TValue *luaH_getint (Table *t, lua_Integer key);
34LUAI_FUNC void luaH_setint (lua_State *L, Table *t, lua_Integer key,
35 TValue *value);
36LUAI_FUNC const TValue *luaH_getshortstr (Table *t, TString *key);
37LUAI_FUNC const TValue *luaH_getstr (Table *t, TString *key);
38LUAI_FUNC const TValue *luaH_get (Table *t, const TValue *key);
39LUAI_FUNC TValue *luaH_newkey (lua_State *L, Table *t, const TValue *key);
40LUAI_FUNC TValue *luaH_set (lua_State *L, Table *t, const TValue *key);
41LUAI_FUNC Table *luaH_new (lua_State *L);
42LUAI_FUNC void luaH_resize (lua_State *L, Table *t, unsigned int nasize,
43 unsigned int nhsize);
44LUAI_FUNC void luaH_resizearray (lua_State *L, Table *t, unsigned int nasize);
45LUAI_FUNC void luaH_free (lua_State *L, Table *t);
46LUAI_FUNC int luaH_next (lua_State *L, Table *t, StkId key);
47LUAI_FUNC lua_Unsigned luaH_getn (Table *t);
48LUAI_FUNC unsigned int luaH_realasize (const Table *t);
49
50
51#if defined(LUA_DEBUG)
52LUAI_FUNC Node *luaH_mainposition (const Table *t, const TValue *key);
53LUAI_FUNC int luaH_isdummy (const Table *t);
54#endif
55
56
57#endif
diff --git a/src/lua/ltablib.c b/src/lua/ltablib.c
new file mode 100644
index 0000000..d344a47
--- /dev/null
+++ b/src/lua/ltablib.c
@@ -0,0 +1,428 @@
1/*
2** $Id: ltablib.c $
3** Library for Table Manipulation
4** See Copyright Notice in lua.h
5*/
6
7#define ltablib_c
8#define LUA_LIB
9
10#include "lprefix.h"
11
12
13#include <limits.h>
14#include <stddef.h>
15#include <string.h>
16
17#include "lua.h"
18
19#include "lauxlib.h"
20#include "lualib.h"
21
22
23/*
24** Operations that an object must define to mimic a table
25** (some functions only need some of them)
26*/
27#define TAB_R 1 /* read */
28#define TAB_W 2 /* write */
29#define TAB_L 4 /* length */
30#define TAB_RW (TAB_R | TAB_W) /* read/write */
31
32
33#define aux_getn(L,n,w) (checktab(L, n, (w) | TAB_L), luaL_len(L, n))
34
35
36static int checkfield (lua_State *L, const char *key, int n) {
37 lua_pushstring(L, key);
38 return (lua_rawget(L, -n) != LUA_TNIL);
39}
40
41
42/*
43** Check that 'arg' either is a table or can behave like one (that is,
44** has a metatable with the required metamethods)
45*/
46static void checktab (lua_State *L, int arg, int what) {
47 if (lua_type(L, arg) != LUA_TTABLE) { /* is it not a table? */
48 int n = 1; /* number of elements to pop */
49 if (lua_getmetatable(L, arg) && /* must have metatable */
50 (!(what & TAB_R) || checkfield(L, "__index", ++n)) &&
51 (!(what & TAB_W) || checkfield(L, "__newindex", ++n)) &&
52 (!(what & TAB_L) || checkfield(L, "__len", ++n))) {
53 lua_pop(L, n); /* pop metatable and tested metamethods */
54 }
55 else
56 luaL_checktype(L, arg, LUA_TTABLE); /* force an error */
57 }
58}
59
60
61static int tinsert (lua_State *L) {
62 lua_Integer e = aux_getn(L, 1, TAB_RW) + 1; /* first empty element */
63 lua_Integer pos; /* where to insert new element */
64 switch (lua_gettop(L)) {
65 case 2: { /* called with only 2 arguments */
66 pos = e; /* insert new element at the end */
67 break;
68 }
69 case 3: {
70 lua_Integer i;
71 pos = luaL_checkinteger(L, 2); /* 2nd argument is the position */
72 /* check whether 'pos' is in [1, e] */
73 luaL_argcheck(L, (lua_Unsigned)pos - 1u < (lua_Unsigned)e, 2,
74 "position out of bounds");
75 for (i = e; i > pos; i--) { /* move up elements */
76 lua_geti(L, 1, i - 1);
77 lua_seti(L, 1, i); /* t[i] = t[i - 1] */
78 }
79 break;
80 }
81 default: {
82 return luaL_error(L, "wrong number of arguments to 'insert'");
83 }
84 }
85 lua_seti(L, 1, pos); /* t[pos] = v */
86 return 0;
87}
88
89
90static int tremove (lua_State *L) {
91 lua_Integer size = aux_getn(L, 1, TAB_RW);
92 lua_Integer pos = luaL_optinteger(L, 2, size);
93 if (pos != size) /* validate 'pos' if given */
94 /* check whether 'pos' is in [1, size + 1] */
95 luaL_argcheck(L, (lua_Unsigned)pos - 1u <= (lua_Unsigned)size, 1,
96 "position out of bounds");
97 lua_geti(L, 1, pos); /* result = t[pos] */
98 for ( ; pos < size; pos++) {
99 lua_geti(L, 1, pos + 1);
100 lua_seti(L, 1, pos); /* t[pos] = t[pos + 1] */
101 }
102 lua_pushnil(L);
103 lua_seti(L, 1, pos); /* remove entry t[pos] */
104 return 1;
105}
106
107
108/*
109** Copy elements (1[f], ..., 1[e]) into (tt[t], tt[t+1], ...). Whenever
110** possible, copy in increasing order, which is better for rehashing.
111** "possible" means destination after original range, or smaller
112** than origin, or copying to another table.
113*/
114static int tmove (lua_State *L) {
115 lua_Integer f = luaL_checkinteger(L, 2);
116 lua_Integer e = luaL_checkinteger(L, 3);
117 lua_Integer t = luaL_checkinteger(L, 4);
118 int tt = !lua_isnoneornil(L, 5) ? 5 : 1; /* destination table */
119 checktab(L, 1, TAB_R);
120 checktab(L, tt, TAB_W);
121 if (e >= f) { /* otherwise, nothing to move */
122 lua_Integer n, i;
123 luaL_argcheck(L, f > 0 || e < LUA_MAXINTEGER + f, 3,
124 "too many elements to move");
125 n = e - f + 1; /* number of elements to move */
126 luaL_argcheck(L, t <= LUA_MAXINTEGER - n + 1, 4,
127 "destination wrap around");
128 if (t > e || t <= f || (tt != 1 && !lua_compare(L, 1, tt, LUA_OPEQ))) {
129 for (i = 0; i < n; i++) {
130 lua_geti(L, 1, f + i);
131 lua_seti(L, tt, t + i);
132 }
133 }
134 else {
135 for (i = n - 1; i >= 0; i--) {
136 lua_geti(L, 1, f + i);
137 lua_seti(L, tt, t + i);
138 }
139 }
140 }
141 lua_pushvalue(L, tt); /* return destination table */
142 return 1;
143}
144
145
146static void addfield (lua_State *L, luaL_Buffer *b, lua_Integer i) {
147 lua_geti(L, 1, i);
148 if (!lua_isstring(L, -1))
149 luaL_error(L, "invalid value (%s) at index %d in table for 'concat'",
150 luaL_typename(L, -1), i);
151 luaL_addvalue(b);
152}
153
154
155static int tconcat (lua_State *L) {
156 luaL_Buffer b;
157 lua_Integer last = aux_getn(L, 1, TAB_R);
158 size_t lsep;
159 const char *sep = luaL_optlstring(L, 2, "", &lsep);
160 lua_Integer i = luaL_optinteger(L, 3, 1);
161 last = luaL_optinteger(L, 4, last);
162 luaL_buffinit(L, &b);
163 for (; i < last; i++) {
164 addfield(L, &b, i);
165 luaL_addlstring(&b, sep, lsep);
166 }
167 if (i == last) /* add last value (if interval was not empty) */
168 addfield(L, &b, i);
169 luaL_pushresult(&b);
170 return 1;
171}
172
173
174/*
175** {======================================================
176** Pack/unpack
177** =======================================================
178*/
179
180static int tpack (lua_State *L) {
181 int i;
182 int n = lua_gettop(L); /* number of elements to pack */
183 lua_createtable(L, n, 1); /* create result table */
184 lua_insert(L, 1); /* put it at index 1 */
185 for (i = n; i >= 1; i--) /* assign elements */
186 lua_seti(L, 1, i);
187 lua_pushinteger(L, n);
188 lua_setfield(L, 1, "n"); /* t.n = number of elements */
189 return 1; /* return table */
190}
191
192
193static int tunpack (lua_State *L) {
194 lua_Unsigned n;
195 lua_Integer i = luaL_optinteger(L, 2, 1);
196 lua_Integer e = luaL_opt(L, luaL_checkinteger, 3, luaL_len(L, 1));
197 if (i > e) return 0; /* empty range */
198 n = (lua_Unsigned)e - i; /* number of elements minus 1 (avoid overflows) */
199 if (n >= (unsigned int)INT_MAX || !lua_checkstack(L, (int)(++n)))
200 return luaL_error(L, "too many results to unpack");
201 for (; i < e; i++) { /* push arg[i..e - 1] (to avoid overflows) */
202 lua_geti(L, 1, i);
203 }
204 lua_geti(L, 1, e); /* push last element */
205 return (int)n;
206}
207
208/* }====================================================== */
209
210
211
212/*
213** {======================================================
214** Quicksort
215** (based on 'Algorithms in MODULA-3', Robert Sedgewick;
216** Addison-Wesley, 1993.)
217** =======================================================
218*/
219
220
221/* type for array indices */
222typedef unsigned int IdxT;
223
224
225/*
226** Produce a "random" 'unsigned int' to randomize pivot choice. This
227** macro is used only when 'sort' detects a big imbalance in the result
228** of a partition. (If you don't want/need this "randomness", ~0 is a
229** good choice.)
230*/
231#if !defined(l_randomizePivot) /* { */
232
233#include <time.h>
234
235/* size of 'e' measured in number of 'unsigned int's */
236#define sof(e) (sizeof(e) / sizeof(unsigned int))
237
238/*
239** Use 'time' and 'clock' as sources of "randomness". Because we don't
240** know the types 'clock_t' and 'time_t', we cannot cast them to
241** anything without risking overflows. A safe way to use their values
242** is to copy them to an array of a known type and use the array values.
243*/
244static unsigned int l_randomizePivot (void) {
245 clock_t c = clock();
246 time_t t = time(NULL);
247 unsigned int buff[sof(c) + sof(t)];
248 unsigned int i, rnd = 0;
249 memcpy(buff, &c, sof(c) * sizeof(unsigned int));
250 memcpy(buff + sof(c), &t, sof(t) * sizeof(unsigned int));
251 for (i = 0; i < sof(buff); i++)
252 rnd += buff[i];
253 return rnd;
254}
255
256#endif /* } */
257
258
259/* arrays larger than 'RANLIMIT' may use randomized pivots */
260#define RANLIMIT 100u
261
262
263static void set2 (lua_State *L, IdxT i, IdxT j) {
264 lua_seti(L, 1, i);
265 lua_seti(L, 1, j);
266}
267
268
269/*
270** Return true iff value at stack index 'a' is less than the value at
271** index 'b' (according to the order of the sort).
272*/
273static int sort_comp (lua_State *L, int a, int b) {
274 if (lua_isnil(L, 2)) /* no function? */
275 return lua_compare(L, a, b, LUA_OPLT); /* a < b */
276 else { /* function */
277 int res;
278 lua_pushvalue(L, 2); /* push function */
279 lua_pushvalue(L, a-1); /* -1 to compensate function */
280 lua_pushvalue(L, b-2); /* -2 to compensate function and 'a' */
281 lua_call(L, 2, 1); /* call function */
282 res = lua_toboolean(L, -1); /* get result */
283 lua_pop(L, 1); /* pop result */
284 return res;
285 }
286}
287
288
289/*
290** Does the partition: Pivot P is at the top of the stack.
291** precondition: a[lo] <= P == a[up-1] <= a[up],
292** so it only needs to do the partition from lo + 1 to up - 2.
293** Pos-condition: a[lo .. i - 1] <= a[i] == P <= a[i + 1 .. up]
294** returns 'i'.
295*/
296static IdxT partition (lua_State *L, IdxT lo, IdxT up) {
297 IdxT i = lo; /* will be incremented before first use */
298 IdxT j = up - 1; /* will be decremented before first use */
299 /* loop invariant: a[lo .. i] <= P <= a[j .. up] */
300 for (;;) {
301 /* next loop: repeat ++i while a[i] < P */
302 while ((void)lua_geti(L, 1, ++i), sort_comp(L, -1, -2)) {
303 if (i == up - 1) /* a[i] < P but a[up - 1] == P ?? */
304 luaL_error(L, "invalid order function for sorting");
305 lua_pop(L, 1); /* remove a[i] */
306 }
307 /* after the loop, a[i] >= P and a[lo .. i - 1] < P */
308 /* next loop: repeat --j while P < a[j] */
309 while ((void)lua_geti(L, 1, --j), sort_comp(L, -3, -1)) {
310 if (j < i) /* j < i but a[j] > P ?? */
311 luaL_error(L, "invalid order function for sorting");
312 lua_pop(L, 1); /* remove a[j] */
313 }
314 /* after the loop, a[j] <= P and a[j + 1 .. up] >= P */
315 if (j < i) { /* no elements out of place? */
316 /* a[lo .. i - 1] <= P <= a[j + 1 .. i .. up] */
317 lua_pop(L, 1); /* pop a[j] */
318 /* swap pivot (a[up - 1]) with a[i] to satisfy pos-condition */
319 set2(L, up - 1, i);
320 return i;
321 }
322 /* otherwise, swap a[i] - a[j] to restore invariant and repeat */
323 set2(L, i, j);
324 }
325}
326
327
328/*
329** Choose an element in the middle (2nd-3th quarters) of [lo,up]
330** "randomized" by 'rnd'
331*/
332static IdxT choosePivot (IdxT lo, IdxT up, unsigned int rnd) {
333 IdxT r4 = (up - lo) / 4; /* range/4 */
334 IdxT p = rnd % (r4 * 2) + (lo + r4);
335 lua_assert(lo + r4 <= p && p <= up - r4);
336 return p;
337}
338
339
340/*
341** Quicksort algorithm (recursive function)
342*/
343static void auxsort (lua_State *L, IdxT lo, IdxT up,
344 unsigned int rnd) {
345 while (lo < up) { /* loop for tail recursion */
346 IdxT p; /* Pivot index */
347 IdxT n; /* to be used later */
348 /* sort elements 'lo', 'p', and 'up' */
349 lua_geti(L, 1, lo);
350 lua_geti(L, 1, up);
351 if (sort_comp(L, -1, -2)) /* a[up] < a[lo]? */
352 set2(L, lo, up); /* swap a[lo] - a[up] */
353 else
354 lua_pop(L, 2); /* remove both values */
355 if (up - lo == 1) /* only 2 elements? */
356 return; /* already sorted */
357 if (up - lo < RANLIMIT || rnd == 0) /* small interval or no randomize? */
358 p = (lo + up)/2; /* middle element is a good pivot */
359 else /* for larger intervals, it is worth a random pivot */
360 p = choosePivot(lo, up, rnd);
361 lua_geti(L, 1, p);
362 lua_geti(L, 1, lo);
363 if (sort_comp(L, -2, -1)) /* a[p] < a[lo]? */
364 set2(L, p, lo); /* swap a[p] - a[lo] */
365 else {
366 lua_pop(L, 1); /* remove a[lo] */
367 lua_geti(L, 1, up);
368 if (sort_comp(L, -1, -2)) /* a[up] < a[p]? */
369 set2(L, p, up); /* swap a[up] - a[p] */
370 else
371 lua_pop(L, 2);
372 }
373 if (up - lo == 2) /* only 3 elements? */
374 return; /* already sorted */
375 lua_geti(L, 1, p); /* get middle element (Pivot) */
376 lua_pushvalue(L, -1); /* push Pivot */
377 lua_geti(L, 1, up - 1); /* push a[up - 1] */
378 set2(L, p, up - 1); /* swap Pivot (a[p]) with a[up - 1] */
379 p = partition(L, lo, up);
380 /* a[lo .. p - 1] <= a[p] == P <= a[p + 1 .. up] */
381 if (p - lo < up - p) { /* lower interval is smaller? */
382 auxsort(L, lo, p - 1, rnd); /* call recursively for lower interval */
383 n = p - lo; /* size of smaller interval */
384 lo = p + 1; /* tail call for [p + 1 .. up] (upper interval) */
385 }
386 else {
387 auxsort(L, p + 1, up, rnd); /* call recursively for upper interval */
388 n = up - p; /* size of smaller interval */
389 up = p - 1; /* tail call for [lo .. p - 1] (lower interval) */
390 }
391 if ((up - lo) / 128 > n) /* partition too imbalanced? */
392 rnd = l_randomizePivot(); /* try a new randomization */
393 } /* tail call auxsort(L, lo, up, rnd) */
394}
395
396
397static int sort (lua_State *L) {
398 lua_Integer n = aux_getn(L, 1, TAB_RW);
399 if (n > 1) { /* non-trivial interval? */
400 luaL_argcheck(L, n < INT_MAX, 1, "array too big");
401 if (!lua_isnoneornil(L, 2)) /* is there a 2nd argument? */
402 luaL_checktype(L, 2, LUA_TFUNCTION); /* must be a function */
403 lua_settop(L, 2); /* make sure there are two arguments */
404 auxsort(L, 1, (IdxT)n, 0);
405 }
406 return 0;
407}
408
409/* }====================================================== */
410
411
412static const luaL_Reg tab_funcs[] = {
413 {"concat", tconcat},
414 {"insert", tinsert},
415 {"pack", tpack},
416 {"unpack", tunpack},
417 {"remove", tremove},
418 {"move", tmove},
419 {"sort", sort},
420 {NULL, NULL}
421};
422
423
424LUAMOD_API int luaopen_table (lua_State *L) {
425 luaL_newlib(L, tab_funcs);
426 return 1;
427}
428
diff --git a/src/lua/ltm.c b/src/lua/ltm.c
new file mode 100644
index 0000000..ae60983
--- /dev/null
+++ b/src/lua/ltm.c
@@ -0,0 +1,270 @@
1/*
2** $Id: ltm.c $
3** Tag methods
4** See Copyright Notice in lua.h
5*/
6
7#define ltm_c
8#define LUA_CORE
9
10#include "lprefix.h"
11
12
13#include <string.h>
14
15#include "lua.h"
16
17#include "ldebug.h"
18#include "ldo.h"
19#include "lgc.h"
20#include "lobject.h"
21#include "lstate.h"
22#include "lstring.h"
23#include "ltable.h"
24#include "ltm.h"
25#include "lvm.h"
26
27
28static const char udatatypename[] = "userdata";
29
30LUAI_DDEF const char *const luaT_typenames_[LUA_TOTALTYPES] = {
31 "no value",
32 "nil", "boolean", udatatypename, "number",
33 "string", "table", "function", udatatypename, "thread",
34 "upvalue", "proto" /* these last cases are used for tests only */
35};
36
37
38void luaT_init (lua_State *L) {
39 static const char *const luaT_eventname[] = { /* ORDER TM */
40 "__index", "__newindex",
41 "__gc", "__mode", "__len", "__eq",
42 "__add", "__sub", "__mul", "__mod", "__pow",
43 "__div", "__idiv",
44 "__band", "__bor", "__bxor", "__shl", "__shr",
45 "__unm", "__bnot", "__lt", "__le",
46 "__concat", "__call", "__close"
47 };
48 int i;
49 for (i=0; i<TM_N; i++) {
50 G(L)->tmname[i] = luaS_new(L, luaT_eventname[i]);
51 luaC_fix(L, obj2gco(G(L)->tmname[i])); /* never collect these names */
52 }
53}
54
55
56/*
57** function to be used with macro "fasttm": optimized for absence of
58** tag methods
59*/
60const TValue *luaT_gettm (Table *events, TMS event, TString *ename) {
61 const TValue *tm = luaH_getshortstr(events, ename);
62 lua_assert(event <= TM_EQ);
63 if (notm(tm)) { /* no tag method? */
64 events->flags |= cast_byte(1u<<event); /* cache this fact */
65 return NULL;
66 }
67 else return tm;
68}
69
70
71const TValue *luaT_gettmbyobj (lua_State *L, const TValue *o, TMS event) {
72 Table *mt;
73 switch (ttype(o)) {
74 case LUA_TTABLE:
75 mt = hvalue(o)->metatable;
76 break;
77 case LUA_TUSERDATA:
78 mt = uvalue(o)->metatable;
79 break;
80 default:
81 mt = G(L)->mt[ttype(o)];
82 }
83 return (mt ? luaH_getshortstr(mt, G(L)->tmname[event]) : &G(L)->nilvalue);
84}
85
86
87/*
88** Return the name of the type of an object. For tables and userdata
89** with metatable, use their '__name' metafield, if present.
90*/
91const char *luaT_objtypename (lua_State *L, const TValue *o) {
92 Table *mt;
93 if ((ttistable(o) && (mt = hvalue(o)->metatable) != NULL) ||
94 (ttisfulluserdata(o) && (mt = uvalue(o)->metatable) != NULL)) {
95 const TValue *name = luaH_getshortstr(mt, luaS_new(L, "__name"));
96 if (ttisstring(name)) /* is '__name' a string? */
97 return getstr(tsvalue(name)); /* use it as type name */
98 }
99 return ttypename(ttype(o)); /* else use standard type name */
100}
101
102
103void luaT_callTM (lua_State *L, const TValue *f, const TValue *p1,
104 const TValue *p2, const TValue *p3) {
105 StkId func = L->top;
106 setobj2s(L, func, f); /* push function (assume EXTRA_STACK) */
107 setobj2s(L, func + 1, p1); /* 1st argument */
108 setobj2s(L, func + 2, p2); /* 2nd argument */
109 setobj2s(L, func + 3, p3); /* 3rd argument */
110 L->top = func + 4;
111 /* metamethod may yield only when called from Lua code */
112 if (isLuacode(L->ci))
113 luaD_call(L, func, 0);
114 else
115 luaD_callnoyield(L, func, 0);
116}
117
118
119void luaT_callTMres (lua_State *L, const TValue *f, const TValue *p1,
120 const TValue *p2, StkId res) {
121 ptrdiff_t result = savestack(L, res);
122 StkId func = L->top;
123 setobj2s(L, func, f); /* push function (assume EXTRA_STACK) */
124 setobj2s(L, func + 1, p1); /* 1st argument */
125 setobj2s(L, func + 2, p2); /* 2nd argument */
126 L->top += 3;
127 /* metamethod may yield only when called from Lua code */
128 if (isLuacode(L->ci))
129 luaD_call(L, func, 1);
130 else
131 luaD_callnoyield(L, func, 1);
132 res = restorestack(L, result);
133 setobjs2s(L, res, --L->top); /* move result to its place */
134}
135
136
137static int callbinTM (lua_State *L, const TValue *p1, const TValue *p2,
138 StkId res, TMS event) {
139 const TValue *tm = luaT_gettmbyobj(L, p1, event); /* try first operand */
140 if (notm(tm))
141 tm = luaT_gettmbyobj(L, p2, event); /* try second operand */
142 if (notm(tm)) return 0;
143 luaT_callTMres(L, tm, p1, p2, res);
144 return 1;
145}
146
147
148void luaT_trybinTM (lua_State *L, const TValue *p1, const TValue *p2,
149 StkId res, TMS event) {
150 if (!callbinTM(L, p1, p2, res, event)) {
151 switch (event) {
152 case TM_BAND: case TM_BOR: case TM_BXOR:
153 case TM_SHL: case TM_SHR: case TM_BNOT: {
154 if (ttisnumber(p1) && ttisnumber(p2))
155 luaG_tointerror(L, p1, p2);
156 else
157 luaG_opinterror(L, p1, p2, "perform bitwise operation on");
158 }
159 /* calls never return, but to avoid warnings: *//* FALLTHROUGH */
160 default:
161 luaG_opinterror(L, p1, p2, "perform arithmetic on");
162 }
163 }
164}
165
166
167void luaT_tryconcatTM (lua_State *L) {
168 StkId top = L->top;
169 if (!callbinTM(L, s2v(top - 2), s2v(top - 1), top - 2, TM_CONCAT))
170 luaG_concaterror(L, s2v(top - 2), s2v(top - 1));
171}
172
173
174void luaT_trybinassocTM (lua_State *L, const TValue *p1, const TValue *p2,
175 int flip, StkId res, TMS event) {
176 if (flip)
177 luaT_trybinTM(L, p2, p1, res, event);
178 else
179 luaT_trybinTM(L, p1, p2, res, event);
180}
181
182
183void luaT_trybiniTM (lua_State *L, const TValue *p1, lua_Integer i2,
184 int flip, StkId res, TMS event) {
185 TValue aux;
186 setivalue(&aux, i2);
187 luaT_trybinassocTM(L, p1, &aux, flip, res, event);
188}
189
190
191/*
192** Calls an order tag method.
193** For lessequal, LUA_COMPAT_LT_LE keeps compatibility with old
194** behavior: if there is no '__le', try '__lt', based on l <= r iff
195** !(r < l) (assuming a total order). If the metamethod yields during
196** this substitution, the continuation has to know about it (to negate
197** the result of r<l); bit CIST_LEQ in the call status keeps that
198** information.
199*/
200int luaT_callorderTM (lua_State *L, const TValue *p1, const TValue *p2,
201 TMS event) {
202 if (callbinTM(L, p1, p2, L->top, event)) /* try original event */
203 return !l_isfalse(s2v(L->top));
204#if defined(LUA_COMPAT_LT_LE)
205 else if (event == TM_LE) {
206 /* try '!(p2 < p1)' for '(p1 <= p2)' */
207 L->ci->callstatus |= CIST_LEQ; /* mark it is doing 'lt' for 'le' */
208 if (callbinTM(L, p2, p1, L->top, TM_LT)) {
209 L->ci->callstatus ^= CIST_LEQ; /* clear mark */
210 return l_isfalse(s2v(L->top));
211 }
212 /* else error will remove this 'ci'; no need to clear mark */
213 }
214#endif
215 luaG_ordererror(L, p1, p2); /* no metamethod found */
216 return 0; /* to avoid warnings */
217}
218
219
220int luaT_callorderiTM (lua_State *L, const TValue *p1, int v2,
221 int flip, int isfloat, TMS event) {
222 TValue aux; const TValue *p2;
223 if (isfloat) {
224 setfltvalue(&aux, cast_num(v2));
225 }
226 else
227 setivalue(&aux, v2);
228 if (flip) { /* arguments were exchanged? */
229 p2 = p1; p1 = &aux; /* correct them */
230 }
231 else
232 p2 = &aux;
233 return luaT_callorderTM(L, p1, p2, event);
234}
235
236
237void luaT_adjustvarargs (lua_State *L, int nfixparams, CallInfo *ci,
238 const Proto *p) {
239 int i;
240 int actual = cast_int(L->top - ci->func) - 1; /* number of arguments */
241 int nextra = actual - nfixparams; /* number of extra arguments */
242 ci->u.l.nextraargs = nextra;
243 checkstackGC(L, p->maxstacksize + 1);
244 /* copy function to the top of the stack */
245 setobjs2s(L, L->top++, ci->func);
246 /* move fixed parameters to the top of the stack */
247 for (i = 1; i <= nfixparams; i++) {
248 setobjs2s(L, L->top++, ci->func + i);
249 setnilvalue(s2v(ci->func + i)); /* erase original parameter (for GC) */
250 }
251 ci->func += actual + 1;
252 ci->top += actual + 1;
253 lua_assert(L->top <= ci->top && ci->top <= L->stack_last);
254}
255
256
257void luaT_getvarargs (lua_State *L, CallInfo *ci, StkId where, int wanted) {
258 int i;
259 int nextra = ci->u.l.nextraargs;
260 if (wanted < 0) {
261 wanted = nextra; /* get all extra arguments available */
262 checkstackp(L, nextra, where); /* ensure stack space */
263 L->top = where + nextra; /* next instruction will need top */
264 }
265 for (i = 0; i < wanted && i < nextra; i++)
266 setobjs2s(L, where + i, ci->func - nextra + i);
267 for (; i < wanted; i++) /* complete required results with nil */
268 setnilvalue(s2v(where + i));
269}
270
diff --git a/src/lua/ltm.h b/src/lua/ltm.h
new file mode 100644
index 0000000..99b545e
--- /dev/null
+++ b/src/lua/ltm.h
@@ -0,0 +1,94 @@
1/*
2** $Id: ltm.h $
3** Tag methods
4** See Copyright Notice in lua.h
5*/
6
7#ifndef ltm_h
8#define ltm_h
9
10
11#include "lobject.h"
12
13
14/*
15* WARNING: if you change the order of this enumeration,
16* grep "ORDER TM" and "ORDER OP"
17*/
18typedef enum {
19 TM_INDEX,
20 TM_NEWINDEX,
21 TM_GC,
22 TM_MODE,
23 TM_LEN,
24 TM_EQ, /* last tag method with fast access */
25 TM_ADD,
26 TM_SUB,
27 TM_MUL,
28 TM_MOD,
29 TM_POW,
30 TM_DIV,
31 TM_IDIV,
32 TM_BAND,
33 TM_BOR,
34 TM_BXOR,
35 TM_SHL,
36 TM_SHR,
37 TM_UNM,
38 TM_BNOT,
39 TM_LT,
40 TM_LE,
41 TM_CONCAT,
42 TM_CALL,
43 TM_CLOSE,
44 TM_N /* number of elements in the enum */
45} TMS;
46
47
48/*
49** Test whether there is no tagmethod.
50** (Because tagmethods use raw accesses, the result may be an "empty" nil.)
51*/
52#define notm(tm) ttisnil(tm)
53
54
55#define gfasttm(g,et,e) ((et) == NULL ? NULL : \
56 ((et)->flags & (1u<<(e))) ? NULL : luaT_gettm(et, e, (g)->tmname[e]))
57
58#define fasttm(l,et,e) gfasttm(G(l), et, e)
59
60#define ttypename(x) luaT_typenames_[(x) + 1]
61
62LUAI_DDEC(const char *const luaT_typenames_[LUA_TOTALTYPES];)
63
64
65LUAI_FUNC const char *luaT_objtypename (lua_State *L, const TValue *o);
66
67LUAI_FUNC const TValue *luaT_gettm (Table *events, TMS event, TString *ename);
68LUAI_FUNC const TValue *luaT_gettmbyobj (lua_State *L, const TValue *o,
69 TMS event);
70LUAI_FUNC void luaT_init (lua_State *L);
71
72LUAI_FUNC void luaT_callTM (lua_State *L, const TValue *f, const TValue *p1,
73 const TValue *p2, const TValue *p3);
74LUAI_FUNC void luaT_callTMres (lua_State *L, const TValue *f,
75 const TValue *p1, const TValue *p2, StkId p3);
76LUAI_FUNC void luaT_trybinTM (lua_State *L, const TValue *p1, const TValue *p2,
77 StkId res, TMS event);
78LUAI_FUNC void luaT_tryconcatTM (lua_State *L);
79LUAI_FUNC void luaT_trybinassocTM (lua_State *L, const TValue *p1,
80 const TValue *p2, int inv, StkId res, TMS event);
81LUAI_FUNC void luaT_trybiniTM (lua_State *L, const TValue *p1, lua_Integer i2,
82 int inv, StkId res, TMS event);
83LUAI_FUNC int luaT_callorderTM (lua_State *L, const TValue *p1,
84 const TValue *p2, TMS event);
85LUAI_FUNC int luaT_callorderiTM (lua_State *L, const TValue *p1, int v2,
86 int inv, int isfloat, TMS event);
87
88LUAI_FUNC void luaT_adjustvarargs (lua_State *L, int nfixparams,
89 struct CallInfo *ci, const Proto *p);
90LUAI_FUNC void luaT_getvarargs (lua_State *L, struct CallInfo *ci,
91 StkId where, int wanted);
92
93
94#endif
diff --git a/src/lua/lua.h b/src/lua/lua.h
new file mode 100644
index 0000000..b348c14
--- /dev/null
+++ b/src/lua/lua.h
@@ -0,0 +1,517 @@
1/*
2** $Id: lua.h $
3** Lua - A Scripting Language
4** Lua.org, PUC-Rio, Brazil (http://www.lua.org)
5** See Copyright Notice at the end of this file
6*/
7
8
9#ifndef lua_h
10#define lua_h
11
12#include <stdarg.h>
13#include <stddef.h>
14
15
16#include "luaconf.h"
17
18
19#define LUA_VERSION_MAJOR "5"
20#define LUA_VERSION_MINOR "4"
21#define LUA_VERSION_RELEASE "0"
22
23#define LUA_VERSION_NUM 504
24#define LUA_VERSION_RELEASE_NUM (LUA_VERSION_NUM * 100 + 0)
25
26#define LUA_VERSION "Lua " LUA_VERSION_MAJOR "." LUA_VERSION_MINOR
27#define LUA_RELEASE LUA_VERSION "." LUA_VERSION_RELEASE
28#define LUA_COPYRIGHT LUA_RELEASE " Copyright (C) 1994-2020 Lua.org, PUC-Rio"
29#define LUA_AUTHORS "R. Ierusalimschy, L. H. de Figueiredo, W. Celes"
30
31
32/* mark for precompiled code ('<esc>Lua') */
33#define LUA_SIGNATURE "\x1bLua"
34
35/* option for multiple returns in 'lua_pcall' and 'lua_call' */
36#define LUA_MULTRET (-1)
37
38
39/*
40** Pseudo-indices
41** (-LUAI_MAXSTACK is the minimum valid index; we keep some free empty
42** space after that to help overflow detection)
43*/
44#define LUA_REGISTRYINDEX (-LUAI_MAXSTACK - 1000)
45#define lua_upvalueindex(i) (LUA_REGISTRYINDEX - (i))
46
47
48/* thread status */
49#define LUA_OK 0
50#define LUA_YIELD 1
51#define LUA_ERRRUN 2
52#define LUA_ERRSYNTAX 3
53#define LUA_ERRMEM 4
54#define LUA_ERRERR 5
55
56
57typedef struct lua_State lua_State;
58
59
60/*
61** basic types
62*/
63#define LUA_TNONE (-1)
64
65#define LUA_TNIL 0
66#define LUA_TBOOLEAN 1
67#define LUA_TLIGHTUSERDATA 2
68#define LUA_TNUMBER 3
69#define LUA_TSTRING 4
70#define LUA_TTABLE 5
71#define LUA_TFUNCTION 6
72#define LUA_TUSERDATA 7
73#define LUA_TTHREAD 8
74
75#define LUA_NUMTYPES 9
76
77
78
79/* minimum Lua stack available to a C function */
80#define LUA_MINSTACK 20
81
82
83/* predefined values in the registry */
84#define LUA_RIDX_MAINTHREAD 1
85#define LUA_RIDX_GLOBALS 2
86#define LUA_RIDX_LAST LUA_RIDX_GLOBALS
87
88
89/* type of numbers in Lua */
90typedef LUA_NUMBER lua_Number;
91
92
93/* type for integer functions */
94typedef LUA_INTEGER lua_Integer;
95
96/* unsigned integer type */
97typedef LUA_UNSIGNED lua_Unsigned;
98
99/* type for continuation-function contexts */
100typedef LUA_KCONTEXT lua_KContext;
101
102
103/*
104** Type for C functions registered with Lua
105*/
106typedef int (*lua_CFunction) (lua_State *L);
107
108/*
109** Type for continuation functions
110*/
111typedef int (*lua_KFunction) (lua_State *L, int status, lua_KContext ctx);
112
113
114/*
115** Type for functions that read/write blocks when loading/dumping Lua chunks
116*/
117typedef const char * (*lua_Reader) (lua_State *L, void *ud, size_t *sz);
118
119typedef int (*lua_Writer) (lua_State *L, const void *p, size_t sz, void *ud);
120
121
122/*
123** Type for memory-allocation functions
124*/
125typedef void * (*lua_Alloc) (void *ud, void *ptr, size_t osize, size_t nsize);
126
127
128/*
129** Type for warning functions
130*/
131typedef void (*lua_WarnFunction) (void *ud, const char *msg, int tocont);
132
133
134
135
136/*
137** generic extra include file
138*/
139#if defined(LUA_USER_H)
140#include LUA_USER_H
141#endif
142
143
144/*
145** RCS ident string
146*/
147extern const char lua_ident[];
148
149
150/*
151** state manipulation
152*/
153LUA_API lua_State *(lua_newstate) (lua_Alloc f, void *ud);
154LUA_API void (lua_close) (lua_State *L);
155LUA_API lua_State *(lua_newthread) (lua_State *L);
156LUA_API int (lua_resetthread) (lua_State *L);
157
158LUA_API lua_CFunction (lua_atpanic) (lua_State *L, lua_CFunction panicf);
159
160
161LUA_API lua_Number (lua_version) (lua_State *L);
162
163
164/*
165** basic stack manipulation
166*/
167LUA_API int (lua_absindex) (lua_State *L, int idx);
168LUA_API int (lua_gettop) (lua_State *L);
169LUA_API void (lua_settop) (lua_State *L, int idx);
170LUA_API void (lua_pushvalue) (lua_State *L, int idx);
171LUA_API void (lua_rotate) (lua_State *L, int idx, int n);
172LUA_API void (lua_copy) (lua_State *L, int fromidx, int toidx);
173LUA_API int (lua_checkstack) (lua_State *L, int n);
174
175LUA_API void (lua_xmove) (lua_State *from, lua_State *to, int n);
176
177
178/*
179** access functions (stack -> C)
180*/
181
182LUA_API int (lua_isnumber) (lua_State *L, int idx);
183LUA_API int (lua_isstring) (lua_State *L, int idx);
184LUA_API int (lua_iscfunction) (lua_State *L, int idx);
185LUA_API int (lua_isinteger) (lua_State *L, int idx);
186LUA_API int (lua_isuserdata) (lua_State *L, int idx);
187LUA_API int (lua_type) (lua_State *L, int idx);
188LUA_API const char *(lua_typename) (lua_State *L, int tp);
189
190LUA_API lua_Number (lua_tonumberx) (lua_State *L, int idx, int *isnum);
191LUA_API lua_Integer (lua_tointegerx) (lua_State *L, int idx, int *isnum);
192LUA_API int (lua_toboolean) (lua_State *L, int idx);
193LUA_API const char *(lua_tolstring) (lua_State *L, int idx, size_t *len);
194LUA_API lua_Unsigned (lua_rawlen) (lua_State *L, int idx);
195LUA_API lua_CFunction (lua_tocfunction) (lua_State *L, int idx);
196LUA_API void *(lua_touserdata) (lua_State *L, int idx);
197LUA_API lua_State *(lua_tothread) (lua_State *L, int idx);
198LUA_API const void *(lua_topointer) (lua_State *L, int idx);
199
200
201/*
202** Comparison and arithmetic functions
203*/
204
205#define LUA_OPADD 0 /* ORDER TM, ORDER OP */
206#define LUA_OPSUB 1
207#define LUA_OPMUL 2
208#define LUA_OPMOD 3
209#define LUA_OPPOW 4
210#define LUA_OPDIV 5
211#define LUA_OPIDIV 6
212#define LUA_OPBAND 7
213#define LUA_OPBOR 8
214#define LUA_OPBXOR 9
215#define LUA_OPSHL 10
216#define LUA_OPSHR 11
217#define LUA_OPUNM 12
218#define LUA_OPBNOT 13
219
220LUA_API void (lua_arith) (lua_State *L, int op);
221
222#define LUA_OPEQ 0
223#define LUA_OPLT 1
224#define LUA_OPLE 2
225
226LUA_API int (lua_rawequal) (lua_State *L, int idx1, int idx2);
227LUA_API int (lua_compare) (lua_State *L, int idx1, int idx2, int op);
228
229
230/*
231** push functions (C -> stack)
232*/
233LUA_API void (lua_pushnil) (lua_State *L);
234LUA_API void (lua_pushnumber) (lua_State *L, lua_Number n);
235LUA_API void (lua_pushinteger) (lua_State *L, lua_Integer n);
236LUA_API const char *(lua_pushlstring) (lua_State *L, const char *s, size_t len);
237LUA_API const char *(lua_pushstring) (lua_State *L, const char *s);
238LUA_API const char *(lua_pushvfstring) (lua_State *L, const char *fmt,
239 va_list argp);
240LUA_API const char *(lua_pushfstring) (lua_State *L, const char *fmt, ...);
241LUA_API void (lua_pushcclosure) (lua_State *L, lua_CFunction fn, int n);
242LUA_API void (lua_pushboolean) (lua_State *L, int b);
243LUA_API void (lua_pushlightuserdata) (lua_State *L, void *p);
244LUA_API int (lua_pushthread) (lua_State *L);
245
246
247/*
248** get functions (Lua -> stack)
249*/
250LUA_API int (lua_getglobal) (lua_State *L, const char *name);
251LUA_API int (lua_gettable) (lua_State *L, int idx);
252LUA_API int (lua_getfield) (lua_State *L, int idx, const char *k);
253LUA_API int (lua_geti) (lua_State *L, int idx, lua_Integer n);
254LUA_API int (lua_rawget) (lua_State *L, int idx);
255LUA_API int (lua_rawgeti) (lua_State *L, int idx, lua_Integer n);
256LUA_API int (lua_rawgetp) (lua_State *L, int idx, const void *p);
257
258LUA_API void (lua_createtable) (lua_State *L, int narr, int nrec);
259LUA_API void *(lua_newuserdatauv) (lua_State *L, size_t sz, int nuvalue);
260LUA_API int (lua_getmetatable) (lua_State *L, int objindex);
261LUA_API int (lua_getiuservalue) (lua_State *L, int idx, int n);
262
263
264/*
265** set functions (stack -> Lua)
266*/
267LUA_API void (lua_setglobal) (lua_State *L, const char *name);
268LUA_API void (lua_settable) (lua_State *L, int idx);
269LUA_API void (lua_setfield) (lua_State *L, int idx, const char *k);
270LUA_API void (lua_seti) (lua_State *L, int idx, lua_Integer n);
271LUA_API void (lua_rawset) (lua_State *L, int idx);
272LUA_API void (lua_rawseti) (lua_State *L, int idx, lua_Integer n);
273LUA_API void (lua_rawsetp) (lua_State *L, int idx, const void *p);
274LUA_API int (lua_setmetatable) (lua_State *L, int objindex);
275LUA_API int (lua_setiuservalue) (lua_State *L, int idx, int n);
276
277
278/*
279** 'load' and 'call' functions (load and run Lua code)
280*/
281LUA_API void (lua_callk) (lua_State *L, int nargs, int nresults,
282 lua_KContext ctx, lua_KFunction k);
283#define lua_call(L,n,r) lua_callk(L, (n), (r), 0, NULL)
284
285LUA_API int (lua_pcallk) (lua_State *L, int nargs, int nresults, int errfunc,
286 lua_KContext ctx, lua_KFunction k);
287#define lua_pcall(L,n,r,f) lua_pcallk(L, (n), (r), (f), 0, NULL)
288
289LUA_API int (lua_load) (lua_State *L, lua_Reader reader, void *dt,
290 const char *chunkname, const char *mode);
291
292LUA_API int (lua_dump) (lua_State *L, lua_Writer writer, void *data, int strip);
293
294
295/*
296** coroutine functions
297*/
298LUA_API int (lua_yieldk) (lua_State *L, int nresults, lua_KContext ctx,
299 lua_KFunction k);
300LUA_API int (lua_resume) (lua_State *L, lua_State *from, int narg,
301 int *nres);
302LUA_API int (lua_status) (lua_State *L);
303LUA_API int (lua_isyieldable) (lua_State *L);
304
305#define lua_yield(L,n) lua_yieldk(L, (n), 0, NULL)
306
307
308/*
309** Warning-related functions
310*/
311LUA_API void (lua_setwarnf) (lua_State *L, lua_WarnFunction f, void *ud);
312LUA_API void (lua_warning) (lua_State *L, const char *msg, int tocont);
313
314
315/*
316** garbage-collection function and options
317*/
318
319#define LUA_GCSTOP 0
320#define LUA_GCRESTART 1
321#define LUA_GCCOLLECT 2
322#define LUA_GCCOUNT 3
323#define LUA_GCCOUNTB 4
324#define LUA_GCSTEP 5
325#define LUA_GCSETPAUSE 6
326#define LUA_GCSETSTEPMUL 7
327#define LUA_GCISRUNNING 9
328#define LUA_GCGEN 10
329#define LUA_GCINC 11
330
331LUA_API int (lua_gc) (lua_State *L, int what, ...);
332
333
334/*
335** miscellaneous functions
336*/
337
338LUA_API int (lua_error) (lua_State *L);
339
340LUA_API int (lua_next) (lua_State *L, int idx);
341
342LUA_API void (lua_concat) (lua_State *L, int n);
343LUA_API void (lua_len) (lua_State *L, int idx);
344
345LUA_API size_t (lua_stringtonumber) (lua_State *L, const char *s);
346
347LUA_API lua_Alloc (lua_getallocf) (lua_State *L, void **ud);
348LUA_API void (lua_setallocf) (lua_State *L, lua_Alloc f, void *ud);
349
350LUA_API void (lua_toclose) (lua_State *L, int idx);
351
352
353/*
354** {==============================================================
355** some useful macros
356** ===============================================================
357*/
358
359#define lua_getextraspace(L) ((void *)((char *)(L) - LUA_EXTRASPACE))
360
361#define lua_tonumber(L,i) lua_tonumberx(L,(i),NULL)
362#define lua_tointeger(L,i) lua_tointegerx(L,(i),NULL)
363
364#define lua_pop(L,n) lua_settop(L, -(n)-1)
365
366#define lua_newtable(L) lua_createtable(L, 0, 0)
367
368#define lua_register(L,n,f) (lua_pushcfunction(L, (f)), lua_setglobal(L, (n)))
369
370#define lua_pushcfunction(L,f) lua_pushcclosure(L, (f), 0)
371
372#define lua_isfunction(L,n) (lua_type(L, (n)) == LUA_TFUNCTION)
373#define lua_istable(L,n) (lua_type(L, (n)) == LUA_TTABLE)
374#define lua_islightuserdata(L,n) (lua_type(L, (n)) == LUA_TLIGHTUSERDATA)
375#define lua_isnil(L,n) (lua_type(L, (n)) == LUA_TNIL)
376#define lua_isboolean(L,n) (lua_type(L, (n)) == LUA_TBOOLEAN)
377#define lua_isthread(L,n) (lua_type(L, (n)) == LUA_TTHREAD)
378#define lua_isnone(L,n) (lua_type(L, (n)) == LUA_TNONE)
379#define lua_isnoneornil(L, n) (lua_type(L, (n)) <= 0)
380
381#define lua_pushliteral(L, s) lua_pushstring(L, "" s)
382
383#define lua_pushglobaltable(L) \
384 ((void)lua_rawgeti(L, LUA_REGISTRYINDEX, LUA_RIDX_GLOBALS))
385
386#define lua_tostring(L,i) lua_tolstring(L, (i), NULL)
387
388
389#define lua_insert(L,idx) lua_rotate(L, (idx), 1)
390
391#define lua_remove(L,idx) (lua_rotate(L, (idx), -1), lua_pop(L, 1))
392
393#define lua_replace(L,idx) (lua_copy(L, -1, (idx)), lua_pop(L, 1))
394
395/* }============================================================== */
396
397
398/*
399** {==============================================================
400** compatibility macros
401** ===============================================================
402*/
403#if defined(LUA_COMPAT_APIINTCASTS)
404
405#define lua_pushunsigned(L,n) lua_pushinteger(L, (lua_Integer)(n))
406#define lua_tounsignedx(L,i,is) ((lua_Unsigned)lua_tointegerx(L,i,is))
407#define lua_tounsigned(L,i) lua_tounsignedx(L,(i),NULL)
408
409#endif
410
411#define lua_newuserdata(L,s) lua_newuserdatauv(L,s,1)
412#define lua_getuservalue(L,idx) lua_getiuservalue(L,idx,1)
413#define lua_setuservalue(L,idx) lua_setiuservalue(L,idx,1)
414
415#define LUA_NUMTAGS LUA_NUMTYPES
416
417/* }============================================================== */
418
419/*
420** {======================================================================
421** Debug API
422** =======================================================================
423*/
424
425
426/*
427** Event codes
428*/
429#define LUA_HOOKCALL 0
430#define LUA_HOOKRET 1
431#define LUA_HOOKLINE 2
432#define LUA_HOOKCOUNT 3
433#define LUA_HOOKTAILCALL 4
434
435
436/*
437** Event masks
438*/
439#define LUA_MASKCALL (1 << LUA_HOOKCALL)
440#define LUA_MASKRET (1 << LUA_HOOKRET)
441#define LUA_MASKLINE (1 << LUA_HOOKLINE)
442#define LUA_MASKCOUNT (1 << LUA_HOOKCOUNT)
443
444typedef struct lua_Debug lua_Debug; /* activation record */
445
446
447/* Functions to be called by the debugger in specific events */
448typedef void (*lua_Hook) (lua_State *L, lua_Debug *ar);
449
450
451LUA_API int (lua_getstack) (lua_State *L, int level, lua_Debug *ar);
452LUA_API int (lua_getinfo) (lua_State *L, const char *what, lua_Debug *ar);
453LUA_API const char *(lua_getlocal) (lua_State *L, const lua_Debug *ar, int n);
454LUA_API const char *(lua_setlocal) (lua_State *L, const lua_Debug *ar, int n);
455LUA_API const char *(lua_getupvalue) (lua_State *L, int funcindex, int n);
456LUA_API const char *(lua_setupvalue) (lua_State *L, int funcindex, int n);
457
458LUA_API void *(lua_upvalueid) (lua_State *L, int fidx, int n);
459LUA_API void (lua_upvaluejoin) (lua_State *L, int fidx1, int n1,
460 int fidx2, int n2);
461
462LUA_API void (lua_sethook) (lua_State *L, lua_Hook func, int mask, int count);
463LUA_API lua_Hook (lua_gethook) (lua_State *L);
464LUA_API int (lua_gethookmask) (lua_State *L);
465LUA_API int (lua_gethookcount) (lua_State *L);
466
467LUA_API int (lua_setcstacklimit) (lua_State *L, unsigned int limit);
468
469struct lua_Debug {
470 int event;
471 const char *name; /* (n) */
472 const char *namewhat; /* (n) 'global', 'local', 'field', 'method' */
473 const char *what; /* (S) 'Lua', 'C', 'main', 'tail' */
474 const char *source; /* (S) */
475 size_t srclen; /* (S) */
476 int currentline; /* (l) */
477 int linedefined; /* (S) */
478 int lastlinedefined; /* (S) */
479 unsigned char nups; /* (u) number of upvalues */
480 unsigned char nparams;/* (u) number of parameters */
481 char isvararg; /* (u) */
482 char istailcall; /* (t) */
483 unsigned short ftransfer; /* (r) index of first value transferred */
484 unsigned short ntransfer; /* (r) number of transferred values */
485 char short_src[LUA_IDSIZE]; /* (S) */
486 /* private part */
487 struct CallInfo *i_ci; /* active function */
488};
489
490/* }====================================================================== */
491
492
493/******************************************************************************
494* Copyright (C) 1994-2020 Lua.org, PUC-Rio.
495*
496* Permission is hereby granted, free of charge, to any person obtaining
497* a copy of this software and associated documentation files (the
498* "Software"), to deal in the Software without restriction, including
499* without limitation the rights to use, copy, modify, merge, publish,
500* distribute, sublicense, and/or sell copies of the Software, and to
501* permit persons to whom the Software is furnished to do so, subject to
502* the following conditions:
503*
504* The above copyright notice and this permission notice shall be
505* included in all copies or substantial portions of the Software.
506*
507* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
508* EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
509* MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
510* IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
511* CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
512* TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
513* SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
514******************************************************************************/
515
516
517#endif
diff --git a/src/lua/luaconf.h b/src/lua/luaconf.h
new file mode 100644
index 0000000..bdf927e
--- /dev/null
+++ b/src/lua/luaconf.h
@@ -0,0 +1,776 @@
1/*
2** $Id: luaconf.h $
3** Configuration file for Lua
4** See Copyright Notice in lua.h
5*/
6
7
8#ifndef luaconf_h
9#define luaconf_h
10
11#include <limits.h>
12#include <stddef.h>
13
14
15/*
16** ===================================================================
17** General Configuration File for Lua
18**
19** Some definitions here can be changed externally, through the
20** compiler (e.g., with '-D' options). Those are protected by
21** '#if !defined' guards. However, several other definitions should
22** be changed directly here, either because they affect the Lua
23** ABI (by making the changes here, you ensure that all software
24** connected to Lua, such as C libraries, will be compiled with the
25** same configuration); or because they are seldom changed.
26**
27** Search for "@@" to find all configurable definitions.
28** ===================================================================
29*/
30
31
32/*
33** {====================================================================
34** System Configuration: macros to adapt (if needed) Lua to some
35** particular platform, for instance restricting it to C89.
36** =====================================================================
37*/
38
39/*
40@@ LUAI_MAXCSTACK defines the maximum depth for nested calls and
41** also limits the maximum depth of other recursive algorithms in
42** the implementation, such as syntactic analysis. A value too
43** large may allow the interpreter to crash (C-stack overflow).
44** The default value seems ok for regular machines, but may be
45** too high for restricted hardware.
46** The test file 'cstack.lua' may help finding a good limit.
47** (It will crash with a limit too high.)
48*/
49#if !defined(LUAI_MAXCSTACK)
50#define LUAI_MAXCSTACK 2000
51#endif
52
53
54/*
55@@ LUA_USE_C89 controls the use of non-ISO-C89 features.
56** Define it if you want Lua to avoid the use of a few C99 features
57** or Windows-specific features on Windows.
58*/
59/* #define LUA_USE_C89 */
60
61
62/*
63** By default, Lua on Windows use (some) specific Windows features
64*/
65#if !defined(LUA_USE_C89) && defined(_WIN32) && !defined(_WIN32_WCE)
66#define LUA_USE_WINDOWS /* enable goodies for regular Windows */
67#endif
68
69
70#if defined(LUA_USE_WINDOWS)
71#define LUA_DL_DLL /* enable support for DLL */
72#define LUA_USE_C89 /* broadly, Windows is C89 */
73#endif
74
75
76#if defined(LUA_USE_LINUX)
77#define LUA_USE_POSIX
78#define LUA_USE_DLOPEN /* needs an extra library: -ldl */
79#endif
80
81
82#if defined(LUA_USE_MACOSX)
83#define LUA_USE_POSIX
84#define LUA_USE_DLOPEN /* MacOS does not need -ldl */
85#endif
86
87
88/*
89@@ LUAI_IS32INT is true iff 'int' has (at least) 32 bits.
90*/
91#define LUAI_IS32INT ((UINT_MAX >> 30) >= 3)
92
93/* }================================================================== */
94
95
96
97/*
98** {==================================================================
99** Configuration for Number types.
100** ===================================================================
101*/
102
103/*
104@@ LUA_32BITS enables Lua with 32-bit integers and 32-bit floats.
105*/
106/* #define LUA_32BITS */
107
108
109/*
110@@ LUA_C89_NUMBERS ensures that Lua uses the largest types available for
111** C89 ('long' and 'double'); Windows always has '__int64', so it does
112** not need to use this case.
113*/
114#if defined(LUA_USE_C89) && !defined(LUA_USE_WINDOWS)
115#define LUA_C89_NUMBERS
116#endif
117
118
119/*
120@@ LUA_INT_TYPE defines the type for Lua integers.
121@@ LUA_FLOAT_TYPE defines the type for Lua floats.
122** Lua should work fine with any mix of these options supported
123** by your C compiler. The usual configurations are 64-bit integers
124** and 'double' (the default), 32-bit integers and 'float' (for
125** restricted platforms), and 'long'/'double' (for C compilers not
126** compliant with C99, which may not have support for 'long long').
127*/
128
129/* predefined options for LUA_INT_TYPE */
130#define LUA_INT_INT 1
131#define LUA_INT_LONG 2
132#define LUA_INT_LONGLONG 3
133
134/* predefined options for LUA_FLOAT_TYPE */
135#define LUA_FLOAT_FLOAT 1
136#define LUA_FLOAT_DOUBLE 2
137#define LUA_FLOAT_LONGDOUBLE 3
138
139#if defined(LUA_32BITS) /* { */
140/*
141** 32-bit integers and 'float'
142*/
143#if LUAI_IS32INT /* use 'int' if big enough */
144#define LUA_INT_TYPE LUA_INT_INT
145#else /* otherwise use 'long' */
146#define LUA_INT_TYPE LUA_INT_LONG
147#endif
148#define LUA_FLOAT_TYPE LUA_FLOAT_FLOAT
149
150#elif defined(LUA_C89_NUMBERS) /* }{ */
151/*
152** largest types available for C89 ('long' and 'double')
153*/
154#define LUA_INT_TYPE LUA_INT_LONG
155#define LUA_FLOAT_TYPE LUA_FLOAT_DOUBLE
156
157#endif /* } */
158
159
160/*
161** default configuration for 64-bit Lua ('long long' and 'double')
162*/
163#if !defined(LUA_INT_TYPE)
164#define LUA_INT_TYPE LUA_INT_LONGLONG
165#endif
166
167#if !defined(LUA_FLOAT_TYPE)
168#define LUA_FLOAT_TYPE LUA_FLOAT_DOUBLE
169#endif
170
171/* }================================================================== */
172
173
174
175/*
176** {==================================================================
177** Configuration for Paths.
178** ===================================================================
179*/
180
181/*
182** LUA_PATH_SEP is the character that separates templates in a path.
183** LUA_PATH_MARK is the string that marks the substitution points in a
184** template.
185** LUA_EXEC_DIR in a Windows path is replaced by the executable's
186** directory.
187*/
188#define LUA_PATH_SEP ";"
189#define LUA_PATH_MARK "?"
190#define LUA_EXEC_DIR "!"
191
192
193/*
194@@ LUA_PATH_DEFAULT is the default path that Lua uses to look for
195** Lua libraries.
196@@ LUA_CPATH_DEFAULT is the default path that Lua uses to look for
197** C libraries.
198** CHANGE them if your machine has a non-conventional directory
199** hierarchy or if you want to install your libraries in
200** non-conventional directories.
201*/
202
203#define LUA_VDIR LUA_VERSION_MAJOR "." LUA_VERSION_MINOR
204#if defined(_WIN32) /* { */
205/*
206** In Windows, any exclamation mark ('!') in the path is replaced by the
207** path of the directory of the executable file of the current process.
208*/
209#define LUA_LDIR "!\\lua\\"
210#define LUA_CDIR "!\\"
211#define LUA_SHRDIR "!\\..\\share\\lua\\" LUA_VDIR "\\"
212
213#if !defined(LUA_PATH_DEFAULT)
214#define LUA_PATH_DEFAULT \
215 LUA_LDIR"?.lua;" LUA_LDIR"?\\init.lua;" \
216 LUA_CDIR"?.lua;" LUA_CDIR"?\\init.lua;" \
217 LUA_SHRDIR"?.lua;" LUA_SHRDIR"?\\init.lua;" \
218 ".\\?.lua;" ".\\?\\init.lua"
219#endif
220
221#if !defined(LUA_CPATH_DEFAULT)
222#define LUA_CPATH_DEFAULT \
223 LUA_CDIR"?.dll;" \
224 LUA_CDIR"..\\lib\\lua\\" LUA_VDIR "\\?.dll;" \
225 LUA_CDIR"loadall.dll;" ".\\?.dll"
226#endif
227
228#else /* }{ */
229
230#define LUA_ROOT "/usr/local/"
231#define LUA_LDIR LUA_ROOT "share/lua/" LUA_VDIR "/"
232#define LUA_CDIR LUA_ROOT "lib/lua/" LUA_VDIR "/"
233
234#if !defined(LUA_PATH_DEFAULT)
235#define LUA_PATH_DEFAULT \
236 LUA_LDIR"?.lua;" LUA_LDIR"?/init.lua;" \
237 LUA_CDIR"?.lua;" LUA_CDIR"?/init.lua;" \
238 "./?.lua;" "./?/init.lua"
239#endif
240
241#if !defined(LUA_CPATH_DEFAULT)
242#define LUA_CPATH_DEFAULT \
243 LUA_CDIR"?.so;" LUA_CDIR"loadall.so;" "./?.so"
244#endif
245
246#endif /* } */
247
248
249/*
250@@ LUA_DIRSEP is the directory separator (for submodules).
251** CHANGE it if your machine does not use "/" as the directory separator
252** and is not Windows. (On Windows Lua automatically uses "\".)
253*/
254#if !defined(LUA_DIRSEP)
255
256#if defined(_WIN32)
257#define LUA_DIRSEP "\\"
258#else
259#define LUA_DIRSEP "/"
260#endif
261
262#endif
263
264/* }================================================================== */
265
266
267/*
268** {==================================================================
269** Marks for exported symbols in the C code
270** ===================================================================
271*/
272
273/*
274@@ LUA_API is a mark for all core API functions.
275@@ LUALIB_API is a mark for all auxiliary library functions.
276@@ LUAMOD_API is a mark for all standard library opening functions.
277** CHANGE them if you need to define those functions in some special way.
278** For instance, if you want to create one Windows DLL with the core and
279** the libraries, you may want to use the following definition (define
280** LUA_BUILD_AS_DLL to get it).
281*/
282#if defined(LUA_BUILD_AS_DLL) /* { */
283
284#if defined(LUA_CORE) || defined(LUA_LIB) /* { */
285#define LUA_API __declspec(dllexport)
286#else /* }{ */
287#define LUA_API __declspec(dllimport)
288#endif /* } */
289
290#else /* }{ */
291
292#define LUA_API extern
293
294#endif /* } */
295
296
297/*
298** More often than not the libs go together with the core.
299*/
300#define LUALIB_API LUA_API
301#define LUAMOD_API LUA_API
302
303
304/*
305@@ LUAI_FUNC is a mark for all extern functions that are not to be
306** exported to outside modules.
307@@ LUAI_DDEF and LUAI_DDEC are marks for all extern (const) variables,
308** none of which to be exported to outside modules (LUAI_DDEF for
309** definitions and LUAI_DDEC for declarations).
310** CHANGE them if you need to mark them in some special way. Elf/gcc
311** (versions 3.2 and later) mark them as "hidden" to optimize access
312** when Lua is compiled as a shared library. Not all elf targets support
313** this attribute. Unfortunately, gcc does not offer a way to check
314** whether the target offers that support, and those without support
315** give a warning about it. To avoid these warnings, change to the
316** default definition.
317*/
318#if defined(__GNUC__) && ((__GNUC__*100 + __GNUC_MINOR__) >= 302) && \
319 defined(__ELF__) /* { */
320#define LUAI_FUNC __attribute__((visibility("internal"))) extern
321#else /* }{ */
322#define LUAI_FUNC extern
323#endif /* } */
324
325#define LUAI_DDEC(dec) LUAI_FUNC dec
326#define LUAI_DDEF /* empty */
327
328/* }================================================================== */
329
330
331/*
332** {==================================================================
333** Compatibility with previous versions
334** ===================================================================
335*/
336
337/*
338@@ LUA_COMPAT_5_3 controls other macros for compatibility with Lua 5.3.
339** You can define it to get all options, or change specific options
340** to fit your specific needs.
341*/
342#if defined(LUA_COMPAT_5_3) /* { */
343
344/*
345@@ LUA_COMPAT_MATHLIB controls the presence of several deprecated
346** functions in the mathematical library.
347** (These functions were already officially removed in 5.3;
348** nevertheless they are still available here.)
349*/
350#define LUA_COMPAT_MATHLIB
351
352/*
353@@ LUA_COMPAT_APIINTCASTS controls the presence of macros for
354** manipulating other integer types (lua_pushunsigned, lua_tounsigned,
355** luaL_checkint, luaL_checklong, etc.)
356** (These macros were also officially removed in 5.3, but they are still
357** available here.)
358*/
359#define LUA_COMPAT_APIINTCASTS
360
361
362/*
363@@ LUA_COMPAT_LT_LE controls the emulation of the '__le' metamethod
364** using '__lt'.
365*/
366#define LUA_COMPAT_LT_LE
367
368
369/*
370@@ The following macros supply trivial compatibility for some
371** changes in the API. The macros themselves document how to
372** change your code to avoid using them.
373** (Once more, these macros were officially removed in 5.3, but they are
374** still available here.)
375*/
376#define lua_strlen(L,i) lua_rawlen(L, (i))
377
378#define lua_objlen(L,i) lua_rawlen(L, (i))
379
380#define lua_equal(L,idx1,idx2) lua_compare(L,(idx1),(idx2),LUA_OPEQ)
381#define lua_lessthan(L,idx1,idx2) lua_compare(L,(idx1),(idx2),LUA_OPLT)
382
383#endif /* } */
384
385/* }================================================================== */
386
387
388
389/*
390** {==================================================================
391** Configuration for Numbers.
392** Change these definitions if no predefined LUA_FLOAT_* / LUA_INT_*
393** satisfy your needs.
394** ===================================================================
395*/
396
397/*
398@@ LUA_NUMBER is the floating-point type used by Lua.
399@@ LUAI_UACNUMBER is the result of a 'default argument promotion'
400@@ over a floating number.
401@@ l_floatatt(x) corrects float attribute 'x' to the proper float type
402** by prefixing it with one of FLT/DBL/LDBL.
403@@ LUA_NUMBER_FRMLEN is the length modifier for writing floats.
404@@ LUA_NUMBER_FMT is the format for writing floats.
405@@ lua_number2str converts a float to a string.
406@@ l_mathop allows the addition of an 'l' or 'f' to all math operations.
407@@ l_floor takes the floor of a float.
408@@ lua_str2number converts a decimal numeral to a number.
409*/
410
411
412/* The following definitions are good for most cases here */
413
414#define l_floor(x) (l_mathop(floor)(x))
415
416#define lua_number2str(s,sz,n) \
417 l_sprintf((s), sz, LUA_NUMBER_FMT, (LUAI_UACNUMBER)(n))
418
419/*
420@@ lua_numbertointeger converts a float number with an integral value
421** to an integer, or returns 0 if float is not within the range of
422** a lua_Integer. (The range comparisons are tricky because of
423** rounding. The tests here assume a two-complement representation,
424** where MININTEGER always has an exact representation as a float;
425** MAXINTEGER may not have one, and therefore its conversion to float
426** may have an ill-defined value.)
427*/
428#define lua_numbertointeger(n,p) \
429 ((n) >= (LUA_NUMBER)(LUA_MININTEGER) && \
430 (n) < -(LUA_NUMBER)(LUA_MININTEGER) && \
431 (*(p) = (LUA_INTEGER)(n), 1))
432
433
434/* now the variable definitions */
435
436#if LUA_FLOAT_TYPE == LUA_FLOAT_FLOAT /* { single float */
437
438#define LUA_NUMBER float
439
440#define l_floatatt(n) (FLT_##n)
441
442#define LUAI_UACNUMBER double
443
444#define LUA_NUMBER_FRMLEN ""
445#define LUA_NUMBER_FMT "%.7g"
446
447#define l_mathop(op) op##f
448
449#define lua_str2number(s,p) strtof((s), (p))
450
451
452#elif LUA_FLOAT_TYPE == LUA_FLOAT_LONGDOUBLE /* }{ long double */
453
454#define LUA_NUMBER long double
455
456#define l_floatatt(n) (LDBL_##n)
457
458#define LUAI_UACNUMBER long double
459
460#define LUA_NUMBER_FRMLEN "L"
461#define LUA_NUMBER_FMT "%.19Lg"
462
463#define l_mathop(op) op##l
464
465#define lua_str2number(s,p) strtold((s), (p))
466
467#elif LUA_FLOAT_TYPE == LUA_FLOAT_DOUBLE /* }{ double */
468
469#define LUA_NUMBER double
470
471#define l_floatatt(n) (DBL_##n)
472
473#define LUAI_UACNUMBER double
474
475#define LUA_NUMBER_FRMLEN ""
476#define LUA_NUMBER_FMT "%.14g"
477
478#define l_mathop(op) op
479
480#define lua_str2number(s,p) strtod((s), (p))
481
482#else /* }{ */
483
484#error "numeric float type not defined"
485
486#endif /* } */
487
488
489
490/*
491@@ LUA_INTEGER is the integer type used by Lua.
492**
493@@ LUA_UNSIGNED is the unsigned version of LUA_INTEGER.
494**
495@@ LUAI_UACINT is the result of a 'default argument promotion'
496@@ over a LUA_INTEGER.
497@@ LUA_INTEGER_FRMLEN is the length modifier for reading/writing integers.
498@@ LUA_INTEGER_FMT is the format for writing integers.
499@@ LUA_MAXINTEGER is the maximum value for a LUA_INTEGER.
500@@ LUA_MININTEGER is the minimum value for a LUA_INTEGER.
501@@ LUA_MAXUNSIGNED is the maximum value for a LUA_UNSIGNED.
502@@ LUA_UNSIGNEDBITS is the number of bits in a LUA_UNSIGNED.
503@@ lua_integer2str converts an integer to a string.
504*/
505
506
507/* The following definitions are good for most cases here */
508
509#define LUA_INTEGER_FMT "%" LUA_INTEGER_FRMLEN "d"
510
511#define LUAI_UACINT LUA_INTEGER
512
513#define lua_integer2str(s,sz,n) \
514 l_sprintf((s), sz, LUA_INTEGER_FMT, (LUAI_UACINT)(n))
515
516/*
517** use LUAI_UACINT here to avoid problems with promotions (which
518** can turn a comparison between unsigneds into a signed comparison)
519*/
520#define LUA_UNSIGNED unsigned LUAI_UACINT
521
522
523#define LUA_UNSIGNEDBITS (sizeof(LUA_UNSIGNED) * CHAR_BIT)
524
525
526/* now the variable definitions */
527
528#if LUA_INT_TYPE == LUA_INT_INT /* { int */
529
530#define LUA_INTEGER int
531#define LUA_INTEGER_FRMLEN ""
532
533#define LUA_MAXINTEGER INT_MAX
534#define LUA_MININTEGER INT_MIN
535
536#define LUA_MAXUNSIGNED UINT_MAX
537
538#elif LUA_INT_TYPE == LUA_INT_LONG /* }{ long */
539
540#define LUA_INTEGER long
541#define LUA_INTEGER_FRMLEN "l"
542
543#define LUA_MAXINTEGER LONG_MAX
544#define LUA_MININTEGER LONG_MIN
545
546#define LUA_MAXUNSIGNED ULONG_MAX
547
548#elif LUA_INT_TYPE == LUA_INT_LONGLONG /* }{ long long */
549
550/* use presence of macro LLONG_MAX as proxy for C99 compliance */
551#if defined(LLONG_MAX) /* { */
552/* use ISO C99 stuff */
553
554#define LUA_INTEGER long long
555#define LUA_INTEGER_FRMLEN "ll"
556
557#define LUA_MAXINTEGER LLONG_MAX
558#define LUA_MININTEGER LLONG_MIN
559
560#define LUA_MAXUNSIGNED ULLONG_MAX
561
562#elif defined(LUA_USE_WINDOWS) /* }{ */
563/* in Windows, can use specific Windows types */
564
565#define LUA_INTEGER __int64
566#define LUA_INTEGER_FRMLEN "I64"
567
568#define LUA_MAXINTEGER _I64_MAX
569#define LUA_MININTEGER _I64_MIN
570
571#define LUA_MAXUNSIGNED _UI64_MAX
572
573#else /* }{ */
574
575#error "Compiler does not support 'long long'. Use option '-DLUA_32BITS' \
576 or '-DLUA_C89_NUMBERS' (see file 'luaconf.h' for details)"
577
578#endif /* } */
579
580#else /* }{ */
581
582#error "numeric integer type not defined"
583
584#endif /* } */
585
586/* }================================================================== */
587
588
589/*
590** {==================================================================
591** Dependencies with C99 and other C details
592** ===================================================================
593*/
594
595/*
596@@ l_sprintf is equivalent to 'snprintf' or 'sprintf' in C89.
597** (All uses in Lua have only one format item.)
598*/
599#if !defined(LUA_USE_C89)
600#define l_sprintf(s,sz,f,i) snprintf(s,sz,f,i)
601#else
602#define l_sprintf(s,sz,f,i) ((void)(sz), sprintf(s,f,i))
603#endif
604
605
606/*
607@@ lua_strx2number converts a hexadecimal numeral to a number.
608** In C99, 'strtod' does that conversion. Otherwise, you can
609** leave 'lua_strx2number' undefined and Lua will provide its own
610** implementation.
611*/
612#if !defined(LUA_USE_C89)
613#define lua_strx2number(s,p) lua_str2number(s,p)
614#endif
615
616
617/*
618@@ lua_pointer2str converts a pointer to a readable string in a
619** non-specified way.
620*/
621#define lua_pointer2str(buff,sz,p) l_sprintf(buff,sz,"%p",p)
622
623
624/*
625@@ lua_number2strx converts a float to a hexadecimal numeral.
626** In C99, 'sprintf' (with format specifiers '%a'/'%A') does that.
627** Otherwise, you can leave 'lua_number2strx' undefined and Lua will
628** provide its own implementation.
629*/
630#if !defined(LUA_USE_C89)
631#define lua_number2strx(L,b,sz,f,n) \
632 ((void)L, l_sprintf(b,sz,f,(LUAI_UACNUMBER)(n)))
633#endif
634
635
636/*
637** 'strtof' and 'opf' variants for math functions are not valid in
638** C89. Otherwise, the macro 'HUGE_VALF' is a good proxy for testing the
639** availability of these variants. ('math.h' is already included in
640** all files that use these macros.)
641*/
642#if defined(LUA_USE_C89) || (defined(HUGE_VAL) && !defined(HUGE_VALF))
643#undef l_mathop /* variants not available */
644#undef lua_str2number
645#define l_mathop(op) (lua_Number)op /* no variant */
646#define lua_str2number(s,p) ((lua_Number)strtod((s), (p)))
647#endif
648
649
650/*
651@@ LUA_KCONTEXT is the type of the context ('ctx') for continuation
652** functions. It must be a numerical type; Lua will use 'intptr_t' if
653** available, otherwise it will use 'ptrdiff_t' (the nearest thing to
654** 'intptr_t' in C89)
655*/
656#define LUA_KCONTEXT ptrdiff_t
657
658#if !defined(LUA_USE_C89) && defined(__STDC_VERSION__) && \
659 __STDC_VERSION__ >= 199901L
660#include <stdint.h>
661#if defined(INTPTR_MAX) /* even in C99 this type is optional */
662#undef LUA_KCONTEXT
663#define LUA_KCONTEXT intptr_t
664#endif
665#endif
666
667
668/*
669@@ lua_getlocaledecpoint gets the locale "radix character" (decimal point).
670** Change that if you do not want to use C locales. (Code using this
671** macro must include the header 'locale.h'.)
672*/
673#if !defined(lua_getlocaledecpoint)
674#define lua_getlocaledecpoint() (localeconv()->decimal_point[0])
675#endif
676
677/* }================================================================== */
678
679
680/*
681** {==================================================================
682** Language Variations
683** =====================================================================
684*/
685
686/*
687@@ LUA_NOCVTN2S/LUA_NOCVTS2N control how Lua performs some
688** coercions. Define LUA_NOCVTN2S to turn off automatic coercion from
689** numbers to strings. Define LUA_NOCVTS2N to turn off automatic
690** coercion from strings to numbers.
691*/
692/* #define LUA_NOCVTN2S */
693/* #define LUA_NOCVTS2N */
694
695
696/*
697@@ LUA_USE_APICHECK turns on several consistency checks on the C API.
698** Define it as a help when debugging C code.
699*/
700#if defined(LUA_USE_APICHECK)
701#include <assert.h>
702#define luai_apicheck(l,e) assert(e)
703#endif
704
705/* }================================================================== */
706
707
708/*
709** {==================================================================
710** Macros that affect the API and must be stable (that is, must be the
711** same when you compile Lua and when you compile code that links to
712** Lua).
713** =====================================================================
714*/
715
716/*
717@@ LUAI_MAXSTACK limits the size of the Lua stack.
718** CHANGE it if you need a different limit. This limit is arbitrary;
719** its only purpose is to stop Lua from consuming unlimited stack
720** space (and to reserve some numbers for pseudo-indices).
721** (It must fit into max(size_t)/32.)
722*/
723#if LUAI_IS32INT
724#define LUAI_MAXSTACK 1000000
725#else
726#define LUAI_MAXSTACK 15000
727#endif
728
729
730/*
731@@ LUA_EXTRASPACE defines the size of a raw memory area associated with
732** a Lua state with very fast access.
733** CHANGE it if you need a different size.
734*/
735#define LUA_EXTRASPACE (sizeof(void *))
736
737
738/*
739@@ LUA_IDSIZE gives the maximum size for the description of the source
740@@ of a function in debug information.
741** CHANGE it if you want a different size.
742*/
743#define LUA_IDSIZE 60
744
745
746/*
747@@ LUAL_BUFFERSIZE is the buffer size used by the lauxlib buffer system.
748*/
749#define LUAL_BUFFERSIZE ((int)(16 * sizeof(void*) * sizeof(lua_Number)))
750
751
752/*
753@@ LUAI_MAXALIGN defines fields that, when used in a union, ensure
754** maximum alignment for the other items in that union.
755*/
756#define LUAI_MAXALIGN lua_Number n; double u; void *s; lua_Integer i; long l
757
758/* }================================================================== */
759
760
761
762
763
764/* =================================================================== */
765
766/*
767** Local configuration. You can use this space to add your redefinitions
768** without modifying the main part of the file.
769*/
770
771
772
773
774
775#endif
776
diff --git a/src/lua/lualib.h b/src/lua/lualib.h
new file mode 100644
index 0000000..eb08b53
--- /dev/null
+++ b/src/lua/lualib.h
@@ -0,0 +1,58 @@
1/*
2** $Id: lualib.h $
3** Lua standard libraries
4** See Copyright Notice in lua.h
5*/
6
7
8#ifndef lualib_h
9#define lualib_h
10
11#include "lua.h"
12
13
14/* version suffix for environment variable names */
15#define LUA_VERSUFFIX "_" LUA_VERSION_MAJOR "_" LUA_VERSION_MINOR
16
17
18LUAMOD_API int (luaopen_base) (lua_State *L);
19
20#define LUA_COLIBNAME "coroutine"
21LUAMOD_API int (luaopen_coroutine) (lua_State *L);
22
23#define LUA_TABLIBNAME "table"
24LUAMOD_API int (luaopen_table) (lua_State *L);
25
26#define LUA_IOLIBNAME "io"
27LUAMOD_API int (luaopen_io) (lua_State *L);
28
29#define LUA_OSLIBNAME "os"
30LUAMOD_API int (luaopen_os) (lua_State *L);
31
32#define LUA_STRLIBNAME "string"
33LUAMOD_API int (luaopen_string) (lua_State *L);
34
35#define LUA_UTF8LIBNAME "utf8"
36LUAMOD_API int (luaopen_utf8) (lua_State *L);
37
38#define LUA_MATHLIBNAME "math"
39LUAMOD_API int (luaopen_math) (lua_State *L);
40
41#define LUA_DBLIBNAME "debug"
42LUAMOD_API int (luaopen_debug) (lua_State *L);
43
44#define LUA_LOADLIBNAME "package"
45LUAMOD_API int (luaopen_package) (lua_State *L);
46
47
48/* open all previous libraries */
49LUALIB_API void (luaL_openlibs) (lua_State *L);
50
51
52
53#if !defined(lua_assert)
54#define lua_assert(x) ((void)0)
55#endif
56
57
58#endif
diff --git a/src/lua/lundump.c b/src/lua/lundump.c
new file mode 100644
index 0000000..4243678
--- /dev/null
+++ b/src/lua/lundump.c
@@ -0,0 +1,323 @@
1/*
2** $Id: lundump.c $
3** load precompiled Lua chunks
4** See Copyright Notice in lua.h
5*/
6
7#define lundump_c
8#define LUA_CORE
9
10#include "lprefix.h"
11
12
13#include <limits.h>
14#include <string.h>
15
16#include "lua.h"
17
18#include "ldebug.h"
19#include "ldo.h"
20#include "lfunc.h"
21#include "lmem.h"
22#include "lobject.h"
23#include "lstring.h"
24#include "lundump.h"
25#include "lzio.h"
26
27
28#if !defined(luai_verifycode)
29#define luai_verifycode(L,f) /* empty */
30#endif
31
32
33typedef struct {
34 lua_State *L;
35 ZIO *Z;
36 const char *name;
37} LoadState;
38
39
40static l_noret error (LoadState *S, const char *why) {
41 luaO_pushfstring(S->L, "%s: bad binary format (%s)", S->name, why);
42 luaD_throw(S->L, LUA_ERRSYNTAX);
43}
44
45
46/*
47** All high-level loads go through loadVector; you can change it to
48** adapt to the endianness of the input
49*/
50#define loadVector(S,b,n) loadBlock(S,b,(n)*sizeof((b)[0]))
51
52static void loadBlock (LoadState *S, void *b, size_t size) {
53 if (luaZ_read(S->Z, b, size) != 0)
54 error(S, "truncated chunk");
55}
56
57
58#define loadVar(S,x) loadVector(S,&x,1)
59
60
61static lu_byte loadByte (LoadState *S) {
62 int b = zgetc(S->Z);
63 if (b == EOZ)
64 error(S, "truncated chunk");
65 return cast_byte(b);
66}
67
68
69static size_t loadUnsigned (LoadState *S, size_t limit) {
70 size_t x = 0;
71 int b;
72 limit >>= 7;
73 do {
74 b = loadByte(S);
75 if (x >= limit)
76 error(S, "integer overflow");
77 x = (x << 7) | (b & 0x7f);
78 } while ((b & 0x80) == 0);
79 return x;
80}
81
82
83static size_t loadSize (LoadState *S) {
84 return loadUnsigned(S, ~(size_t)0);
85}
86
87
88static int loadInt (LoadState *S) {
89 return cast_int(loadUnsigned(S, INT_MAX));
90}
91
92
93static lua_Number loadNumber (LoadState *S) {
94 lua_Number x;
95 loadVar(S, x);
96 return x;
97}
98
99
100static lua_Integer loadInteger (LoadState *S) {
101 lua_Integer x;
102 loadVar(S, x);
103 return x;
104}
105
106
107/*
108** Load a nullable string into prototype 'p'.
109*/
110static TString *loadStringN (LoadState *S, Proto *p) {
111 lua_State *L = S->L;
112 TString *ts;
113 size_t size = loadSize(S);
114 if (size == 0) /* no string? */
115 return NULL;
116 else if (--size <= LUAI_MAXSHORTLEN) { /* short string? */
117 char buff[LUAI_MAXSHORTLEN];
118 loadVector(S, buff, size); /* load string into buffer */
119 ts = luaS_newlstr(L, buff, size); /* create string */
120 }
121 else { /* long string */
122 ts = luaS_createlngstrobj(L, size); /* create string */
123 loadVector(S, getstr(ts), size); /* load directly in final place */
124 }
125 luaC_objbarrier(L, p, ts);
126 return ts;
127}
128
129
130/*
131** Load a non-nullable string into prototype 'p'.
132*/
133static TString *loadString (LoadState *S, Proto *p) {
134 TString *st = loadStringN(S, p);
135 if (st == NULL)
136 error(S, "bad format for constant string");
137 return st;
138}
139
140
141static void loadCode (LoadState *S, Proto *f) {
142 int n = loadInt(S);
143 f->code = luaM_newvectorchecked(S->L, n, Instruction);
144 f->sizecode = n;
145 loadVector(S, f->code, n);
146}
147
148
149static void loadFunction(LoadState *S, Proto *f, TString *psource);
150
151
152static void loadConstants (LoadState *S, Proto *f) {
153 int i;
154 int n = loadInt(S);
155 f->k = luaM_newvectorchecked(S->L, n, TValue);
156 f->sizek = n;
157 for (i = 0; i < n; i++)
158 setnilvalue(&f->k[i]);
159 for (i = 0; i < n; i++) {
160 TValue *o = &f->k[i];
161 int t = loadByte(S);
162 switch (t) {
163 case LUA_VNIL:
164 setnilvalue(o);
165 break;
166 case LUA_VFALSE:
167 setbfvalue(o);
168 break;
169 case LUA_VTRUE:
170 setbtvalue(o);
171 break;
172 case LUA_VNUMFLT:
173 setfltvalue(o, loadNumber(S));
174 break;
175 case LUA_VNUMINT:
176 setivalue(o, loadInteger(S));
177 break;
178 case LUA_VSHRSTR:
179 case LUA_VLNGSTR:
180 setsvalue2n(S->L, o, loadString(S, f));
181 break;
182 default: lua_assert(0);
183 }
184 }
185}
186
187
188static void loadProtos (LoadState *S, Proto *f) {
189 int i;
190 int n = loadInt(S);
191 f->p = luaM_newvectorchecked(S->L, n, Proto *);
192 f->sizep = n;
193 for (i = 0; i < n; i++)
194 f->p[i] = NULL;
195 for (i = 0; i < n; i++) {
196 f->p[i] = luaF_newproto(S->L);
197 luaC_objbarrier(S->L, f, f->p[i]);
198 loadFunction(S, f->p[i], f->source);
199 }
200}
201
202
203static void loadUpvalues (LoadState *S, Proto *f) {
204 int i, n;
205 n = loadInt(S);
206 f->upvalues = luaM_newvectorchecked(S->L, n, Upvaldesc);
207 f->sizeupvalues = n;
208 for (i = 0; i < n; i++) {
209 f->upvalues[i].name = NULL;
210 f->upvalues[i].instack = loadByte(S);
211 f->upvalues[i].idx = loadByte(S);
212 f->upvalues[i].kind = loadByte(S);
213 }
214}
215
216
217static void loadDebug (LoadState *S, Proto *f) {
218 int i, n;
219 n = loadInt(S);
220 f->lineinfo = luaM_newvectorchecked(S->L, n, ls_byte);
221 f->sizelineinfo = n;
222 loadVector(S, f->lineinfo, n);
223 n = loadInt(S);
224 f->abslineinfo = luaM_newvectorchecked(S->L, n, AbsLineInfo);
225 f->sizeabslineinfo = n;
226 for (i = 0; i < n; i++) {
227 f->abslineinfo[i].pc = loadInt(S);
228 f->abslineinfo[i].line = loadInt(S);
229 }
230 n = loadInt(S);
231 f->locvars = luaM_newvectorchecked(S->L, n, LocVar);
232 f->sizelocvars = n;
233 for (i = 0; i < n; i++)
234 f->locvars[i].varname = NULL;
235 for (i = 0; i < n; i++) {
236 f->locvars[i].varname = loadStringN(S, f);
237 f->locvars[i].startpc = loadInt(S);
238 f->locvars[i].endpc = loadInt(S);
239 }
240 n = loadInt(S);
241 for (i = 0; i < n; i++)
242 f->upvalues[i].name = loadStringN(S, f);
243}
244
245
246static void loadFunction (LoadState *S, Proto *f, TString *psource) {
247 f->source = loadStringN(S, f);
248 if (f->source == NULL) /* no source in dump? */
249 f->source = psource; /* reuse parent's source */
250 f->linedefined = loadInt(S);
251 f->lastlinedefined = loadInt(S);
252 f->numparams = loadByte(S);
253 f->is_vararg = loadByte(S);
254 f->maxstacksize = loadByte(S);
255 loadCode(S, f);
256 loadConstants(S, f);
257 loadUpvalues(S, f);
258 loadProtos(S, f);
259 loadDebug(S, f);
260}
261
262
263static void checkliteral (LoadState *S, const char *s, const char *msg) {
264 char buff[sizeof(LUA_SIGNATURE) + sizeof(LUAC_DATA)]; /* larger than both */
265 size_t len = strlen(s);
266 loadVector(S, buff, len);
267 if (memcmp(s, buff, len) != 0)
268 error(S, msg);
269}
270
271
272static void fchecksize (LoadState *S, size_t size, const char *tname) {
273 if (loadByte(S) != size)
274 error(S, luaO_pushfstring(S->L, "%s size mismatch", tname));
275}
276
277
278#define checksize(S,t) fchecksize(S,sizeof(t),#t)
279
280static void checkHeader (LoadState *S) {
281 /* skip 1st char (already read and checked) */
282 checkliteral(S, &LUA_SIGNATURE[1], "not a binary chunk");
283 if (loadByte(S) != LUAC_VERSION)
284 error(S, "version mismatch");
285 if (loadByte(S) != LUAC_FORMAT)
286 error(S, "format mismatch");
287 checkliteral(S, LUAC_DATA, "corrupted chunk");
288 checksize(S, Instruction);
289 checksize(S, lua_Integer);
290 checksize(S, lua_Number);
291 if (loadInteger(S) != LUAC_INT)
292 error(S, "integer format mismatch");
293 if (loadNumber(S) != LUAC_NUM)
294 error(S, "float format mismatch");
295}
296
297
298/*
299** Load precompiled chunk.
300*/
301LClosure *luaU_undump(lua_State *L, ZIO *Z, const char *name) {
302 LoadState S;
303 LClosure *cl;
304 if (*name == '@' || *name == '=')
305 S.name = name + 1;
306 else if (*name == LUA_SIGNATURE[0])
307 S.name = "binary string";
308 else
309 S.name = name;
310 S.L = L;
311 S.Z = Z;
312 checkHeader(&S);
313 cl = luaF_newLclosure(L, loadByte(&S));
314 setclLvalue2s(L, L->top, cl);
315 luaD_inctop(L);
316 cl->p = luaF_newproto(L);
317 luaC_objbarrier(L, cl, cl->p);
318 loadFunction(&S, cl->p, NULL);
319 lua_assert(cl->nupvalues == cl->p->sizeupvalues);
320 luai_verifycode(L, cl->p);
321 return cl;
322}
323
diff --git a/src/lua/lundump.h b/src/lua/lundump.h
new file mode 100644
index 0000000..f3748a9
--- /dev/null
+++ b/src/lua/lundump.h
@@ -0,0 +1,36 @@
1/*
2** $Id: lundump.h $
3** load precompiled Lua chunks
4** See Copyright Notice in lua.h
5*/
6
7#ifndef lundump_h
8#define lundump_h
9
10#include "llimits.h"
11#include "lobject.h"
12#include "lzio.h"
13
14
15/* data to catch conversion errors */
16#define LUAC_DATA "\x19\x93\r\n\x1a\n"
17
18#define LUAC_INT 0x5678
19#define LUAC_NUM cast_num(370.5)
20
21/*
22** Encode major-minor version in one byte, one nibble for each
23*/
24#define MYINT(s) (s[0]-'0') /* assume one-digit numerals */
25#define LUAC_VERSION (MYINT(LUA_VERSION_MAJOR)*16+MYINT(LUA_VERSION_MINOR))
26
27#define LUAC_FORMAT 0 /* this is the official format */
28
29/* load one chunk; from lundump.c */
30LUAI_FUNC LClosure* luaU_undump (lua_State* L, ZIO* Z, const char* name);
31
32/* dump one chunk; from ldump.c */
33LUAI_FUNC int luaU_dump (lua_State* L, const Proto* f, lua_Writer w,
34 void* data, int strip);
35
36#endif
diff --git a/src/lua/lutf8lib.c b/src/lua/lutf8lib.c
new file mode 100644
index 0000000..901d985
--- /dev/null
+++ b/src/lua/lutf8lib.c
@@ -0,0 +1,289 @@
1/*
2** $Id: lutf8lib.c $
3** Standard library for UTF-8 manipulation
4** See Copyright Notice in lua.h
5*/
6
7#define lutf8lib_c
8#define LUA_LIB
9
10#include "lprefix.h"
11
12
13#include <assert.h>
14#include <limits.h>
15#include <stdlib.h>
16#include <string.h>
17
18#include "lua.h"
19
20#include "lauxlib.h"
21#include "lualib.h"
22
23
24#define MAXUNICODE 0x10FFFFu
25
26#define MAXUTF 0x7FFFFFFFu
27
28/*
29** Integer type for decoded UTF-8 values; MAXUTF needs 31 bits.
30*/
31#if (UINT_MAX >> 30) >= 1
32typedef unsigned int utfint;
33#else
34typedef unsigned long utfint;
35#endif
36
37
38#define iscont(p) ((*(p) & 0xC0) == 0x80)
39
40
41/* from strlib */
42/* translate a relative string position: negative means back from end */
43static lua_Integer u_posrelat (lua_Integer pos, size_t len) {
44 if (pos >= 0) return pos;
45 else if (0u - (size_t)pos > len) return 0;
46 else return (lua_Integer)len + pos + 1;
47}
48
49
50/*
51** Decode one UTF-8 sequence, returning NULL if byte sequence is
52** invalid. The array 'limits' stores the minimum value for each
53** sequence length, to check for overlong representations. Its first
54** entry forces an error for non-ascii bytes with no continuation
55** bytes (count == 0).
56*/
57static const char *utf8_decode (const char *s, utfint *val, int strict) {
58 static const utfint limits[] =
59 {~(utfint)0, 0x80, 0x800, 0x10000u, 0x200000u, 0x4000000u};
60 unsigned int c = (unsigned char)s[0];
61 utfint res = 0; /* final result */
62 if (c < 0x80) /* ascii? */
63 res = c;
64 else {
65 int count = 0; /* to count number of continuation bytes */
66 for (; c & 0x40; c <<= 1) { /* while it needs continuation bytes... */
67 unsigned int cc = (unsigned char)s[++count]; /* read next byte */
68 if ((cc & 0xC0) != 0x80) /* not a continuation byte? */
69 return NULL; /* invalid byte sequence */
70 res = (res << 6) | (cc & 0x3F); /* add lower 6 bits from cont. byte */
71 }
72 res |= ((utfint)(c & 0x7F) << (count * 5)); /* add first byte */
73 if (count > 5 || res > MAXUTF || res < limits[count])
74 return NULL; /* invalid byte sequence */
75 s += count; /* skip continuation bytes read */
76 }
77 if (strict) {
78 /* check for invalid code points; too large or surrogates */
79 if (res > MAXUNICODE || (0xD800u <= res && res <= 0xDFFFu))
80 return NULL;
81 }
82 if (val) *val = res;
83 return s + 1; /* +1 to include first byte */
84}
85
86
87/*
88** utf8len(s [, i [, j [, lax]]]) --> number of characters that
89** start in the range [i,j], or nil + current position if 's' is not
90** well formed in that interval
91*/
92static int utflen (lua_State *L) {
93 lua_Integer n = 0; /* counter for the number of characters */
94 size_t len; /* string length in bytes */
95 const char *s = luaL_checklstring(L, 1, &len);
96 lua_Integer posi = u_posrelat(luaL_optinteger(L, 2, 1), len);
97 lua_Integer posj = u_posrelat(luaL_optinteger(L, 3, -1), len);
98 int lax = lua_toboolean(L, 4);
99 luaL_argcheck(L, 1 <= posi && --posi <= (lua_Integer)len, 2,
100 "initial position out of bounds");
101 luaL_argcheck(L, --posj < (lua_Integer)len, 3,
102 "final position out of bounds");
103 while (posi <= posj) {
104 const char *s1 = utf8_decode(s + posi, NULL, !lax);
105 if (s1 == NULL) { /* conversion error? */
106 luaL_pushfail(L); /* return fail ... */
107 lua_pushinteger(L, posi + 1); /* ... and current position */
108 return 2;
109 }
110 posi = s1 - s;
111 n++;
112 }
113 lua_pushinteger(L, n);
114 return 1;
115}
116
117
118/*
119** codepoint(s, [i, [j [, lax]]]) -> returns codepoints for all
120** characters that start in the range [i,j]
121*/
122static int codepoint (lua_State *L) {
123 size_t len;
124 const char *s = luaL_checklstring(L, 1, &len);
125 lua_Integer posi = u_posrelat(luaL_optinteger(L, 2, 1), len);
126 lua_Integer pose = u_posrelat(luaL_optinteger(L, 3, posi), len);
127 int lax = lua_toboolean(L, 4);
128 int n;
129 const char *se;
130 luaL_argcheck(L, posi >= 1, 2, "out of bounds");
131 luaL_argcheck(L, pose <= (lua_Integer)len, 3, "out of bounds");
132 if (posi > pose) return 0; /* empty interval; return no values */
133 if (pose - posi >= INT_MAX) /* (lua_Integer -> int) overflow? */
134 return luaL_error(L, "string slice too long");
135 n = (int)(pose - posi) + 1; /* upper bound for number of returns */
136 luaL_checkstack(L, n, "string slice too long");
137 n = 0; /* count the number of returns */
138 se = s + pose; /* string end */
139 for (s += posi - 1; s < se;) {
140 utfint code;
141 s = utf8_decode(s, &code, !lax);
142 if (s == NULL)
143 return luaL_error(L, "invalid UTF-8 code");
144 lua_pushinteger(L, code);
145 n++;
146 }
147 return n;
148}
149
150
151static void pushutfchar (lua_State *L, int arg) {
152 lua_Unsigned code = (lua_Unsigned)luaL_checkinteger(L, arg);
153 luaL_argcheck(L, code <= MAXUTF, arg, "value out of range");
154 lua_pushfstring(L, "%U", (long)code);
155}
156
157
158/*
159** utfchar(n1, n2, ...) -> char(n1)..char(n2)...
160*/
161static int utfchar (lua_State *L) {
162 int n = lua_gettop(L); /* number of arguments */
163 if (n == 1) /* optimize common case of single char */
164 pushutfchar(L, 1);
165 else {
166 int i;
167 luaL_Buffer b;
168 luaL_buffinit(L, &b);
169 for (i = 1; i <= n; i++) {
170 pushutfchar(L, i);
171 luaL_addvalue(&b);
172 }
173 luaL_pushresult(&b);
174 }
175 return 1;
176}
177
178
179/*
180** offset(s, n, [i]) -> index where n-th character counting from
181** position 'i' starts; 0 means character at 'i'.
182*/
183static int byteoffset (lua_State *L) {
184 size_t len;
185 const char *s = luaL_checklstring(L, 1, &len);
186 lua_Integer n = luaL_checkinteger(L, 2);
187 lua_Integer posi = (n >= 0) ? 1 : len + 1;
188 posi = u_posrelat(luaL_optinteger(L, 3, posi), len);
189 luaL_argcheck(L, 1 <= posi && --posi <= (lua_Integer)len, 3,
190 "position out of bounds");
191 if (n == 0) {
192 /* find beginning of current byte sequence */
193 while (posi > 0 && iscont(s + posi)) posi--;
194 }
195 else {
196 if (iscont(s + posi))
197 return luaL_error(L, "initial position is a continuation byte");
198 if (n < 0) {
199 while (n < 0 && posi > 0) { /* move back */
200 do { /* find beginning of previous character */
201 posi--;
202 } while (posi > 0 && iscont(s + posi));
203 n++;
204 }
205 }
206 else {
207 n--; /* do not move for 1st character */
208 while (n > 0 && posi < (lua_Integer)len) {
209 do { /* find beginning of next character */
210 posi++;
211 } while (iscont(s + posi)); /* (cannot pass final '\0') */
212 n--;
213 }
214 }
215 }
216 if (n == 0) /* did it find given character? */
217 lua_pushinteger(L, posi + 1);
218 else /* no such character */
219 luaL_pushfail(L);
220 return 1;
221}
222
223
224static int iter_aux (lua_State *L, int strict) {
225 size_t len;
226 const char *s = luaL_checklstring(L, 1, &len);
227 lua_Integer n = lua_tointeger(L, 2) - 1;
228 if (n < 0) /* first iteration? */
229 n = 0; /* start from here */
230 else if (n < (lua_Integer)len) {
231 n++; /* skip current byte */
232 while (iscont(s + n)) n++; /* and its continuations */
233 }
234 if (n >= (lua_Integer)len)
235 return 0; /* no more codepoints */
236 else {
237 utfint code;
238 const char *next = utf8_decode(s + n, &code, strict);
239 if (next == NULL)
240 return luaL_error(L, "invalid UTF-8 code");
241 lua_pushinteger(L, n + 1);
242 lua_pushinteger(L, code);
243 return 2;
244 }
245}
246
247
248static int iter_auxstrict (lua_State *L) {
249 return iter_aux(L, 1);
250}
251
252static int iter_auxlax (lua_State *L) {
253 return iter_aux(L, 0);
254}
255
256
257static int iter_codes (lua_State *L) {
258 int lax = lua_toboolean(L, 2);
259 luaL_checkstring(L, 1);
260 lua_pushcfunction(L, lax ? iter_auxlax : iter_auxstrict);
261 lua_pushvalue(L, 1);
262 lua_pushinteger(L, 0);
263 return 3;
264}
265
266
267/* pattern to match a single UTF-8 character */
268#define UTF8PATT "[\0-\x7F\xC2-\xFD][\x80-\xBF]*"
269
270
271static const luaL_Reg funcs[] = {
272 {"offset", byteoffset},
273 {"codepoint", codepoint},
274 {"char", utfchar},
275 {"len", utflen},
276 {"codes", iter_codes},
277 /* placeholders */
278 {"charpattern", NULL},
279 {NULL, NULL}
280};
281
282
283LUAMOD_API int luaopen_utf8 (lua_State *L) {
284 luaL_newlib(L, funcs);
285 lua_pushlstring(L, UTF8PATT, sizeof(UTF8PATT)/sizeof(char) - 1);
286 lua_setfield(L, -2, "charpattern");
287 return 1;
288}
289
diff --git a/src/lua/lvm.c b/src/lua/lvm.c
new file mode 100644
index 0000000..e7781db
--- /dev/null
+++ b/src/lua/lvm.c
@@ -0,0 +1,1812 @@
1/*
2** $Id: lvm.c $
3** Lua virtual machine
4** See Copyright Notice in lua.h
5*/
6
7#define lvm_c
8#define LUA_CORE
9
10#include "lprefix.h"
11
12#include <float.h>
13#include <limits.h>
14#include <math.h>
15#include <stdio.h>
16#include <stdlib.h>
17#include <string.h>
18
19#include "lua.h"
20
21#include "ldebug.h"
22#include "ldo.h"
23#include "lfunc.h"
24#include "lgc.h"
25#include "lobject.h"
26#include "lopcodes.h"
27#include "lstate.h"
28#include "lstring.h"
29#include "ltable.h"
30#include "ltm.h"
31#include "lvm.h"
32
33
34/*
35** By default, use jump tables in the main interpreter loop on gcc
36** and compatible compilers.
37*/
38#if !defined(LUA_USE_JUMPTABLE)
39#if defined(__GNUC__)
40#define LUA_USE_JUMPTABLE 1
41#else
42#define LUA_USE_JUMPTABLE 0
43#endif
44#endif
45
46
47
48/* limit for table tag-method chains (to avoid infinite loops) */
49#define MAXTAGLOOP 2000
50
51
52/*
53** 'l_intfitsf' checks whether a given integer is in the range that
54** can be converted to a float without rounding. Used in comparisons.
55*/
56
57/* number of bits in the mantissa of a float */
58#define NBM (l_floatatt(MANT_DIG))
59
60/*
61** Check whether some integers may not fit in a float, testing whether
62** (maxinteger >> NBM) > 0. (That implies (1 << NBM) <= maxinteger.)
63** (The shifts are done in parts, to avoid shifting by more than the size
64** of an integer. In a worst case, NBM == 113 for long double and
65** sizeof(long) == 32.)
66*/
67#if ((((LUA_MAXINTEGER >> (NBM / 4)) >> (NBM / 4)) >> (NBM / 4)) \
68 >> (NBM - (3 * (NBM / 4)))) > 0
69
70/* limit for integers that fit in a float */
71#define MAXINTFITSF ((lua_Unsigned)1 << NBM)
72
73/* check whether 'i' is in the interval [-MAXINTFITSF, MAXINTFITSF] */
74#define l_intfitsf(i) ((MAXINTFITSF + l_castS2U(i)) <= (2 * MAXINTFITSF))
75
76#else /* all integers fit in a float precisely */
77
78#define l_intfitsf(i) 1
79
80#endif
81
82
83/*
84** Try to convert a value from string to a number value.
85** If the value is not a string or is a string not representing
86** a valid numeral (or if coercions from strings to numbers
87** are disabled via macro 'cvt2num'), do not modify 'result'
88** and return 0.
89*/
90static int l_strton (const TValue *obj, TValue *result) {
91 lua_assert(obj != result);
92 if (!cvt2num(obj)) /* is object not a string? */
93 return 0;
94 else
95 return (luaO_str2num(svalue(obj), result) == vslen(obj) + 1);
96}
97
98
99/*
100** Try to convert a value to a float. The float case is already handled
101** by the macro 'tonumber'.
102*/
103int luaV_tonumber_ (const TValue *obj, lua_Number *n) {
104 TValue v;
105 if (ttisinteger(obj)) {
106 *n = cast_num(ivalue(obj));
107 return 1;
108 }
109 else if (l_strton(obj, &v)) { /* string coercible to number? */
110 *n = nvalue(&v); /* convert result of 'luaO_str2num' to a float */
111 return 1;
112 }
113 else
114 return 0; /* conversion failed */
115}
116
117
118/*
119** try to convert a float to an integer, rounding according to 'mode'.
120*/
121int luaV_flttointeger (lua_Number n, lua_Integer *p, F2Imod mode) {
122 lua_Number f = l_floor(n);
123 if (n != f) { /* not an integral value? */
124 if (mode == F2Ieq) return 0; /* fails if mode demands integral value */
125 else if (mode == F2Iceil) /* needs ceil? */
126 f += 1; /* convert floor to ceil (remember: n != f) */
127 }
128 return lua_numbertointeger(f, p);
129}
130
131
132/*
133** try to convert a value to an integer, rounding according to 'mode',
134** without string coercion.
135** ("Fast track" handled by macro 'tointegerns'.)
136*/
137int luaV_tointegerns (const TValue *obj, lua_Integer *p, F2Imod mode) {
138 if (ttisfloat(obj))
139 return luaV_flttointeger(fltvalue(obj), p, mode);
140 else if (ttisinteger(obj)) {
141 *p = ivalue(obj);
142 return 1;
143 }
144 else
145 return 0;
146}
147
148
149/*
150** try to convert a value to an integer.
151*/
152int luaV_tointeger (const TValue *obj, lua_Integer *p, F2Imod mode) {
153 TValue v;
154 if (l_strton(obj, &v)) /* does 'obj' point to a numerical string? */
155 obj = &v; /* change it to point to its corresponding number */
156 return luaV_tointegerns(obj, p, mode);
157}
158
159
160/*
161** Try to convert a 'for' limit to an integer, preserving the semantics
162** of the loop. Return true if the loop must not run; otherwise, '*p'
163** gets the integer limit.
164** (The following explanation assumes a positive step; it is valid for
165** negative steps mutatis mutandis.)
166** If the limit is an integer or can be converted to an integer,
167** rounding down, that is the limit.
168** Otherwise, check whether the limit can be converted to a float. If
169** the float is too large, clip it to LUA_MAXINTEGER. If the float
170** is too negative, the loop should not run, because any initial
171** integer value is greater than such limit; so, the function returns
172** true to signal that. (For this latter case, no integer limit would be
173** correct; even a limit of LUA_MININTEGER would run the loop once for
174** an initial value equal to LUA_MININTEGER.)
175*/
176static int forlimit (lua_State *L, lua_Integer init, const TValue *lim,
177 lua_Integer *p, lua_Integer step) {
178 if (!luaV_tointeger(lim, p, (step < 0 ? F2Iceil : F2Ifloor))) {
179 /* not coercible to in integer */
180 lua_Number flim; /* try to convert to float */
181 if (!tonumber(lim, &flim)) /* cannot convert to float? */
182 luaG_forerror(L, lim, "limit");
183 /* else 'flim' is a float out of integer bounds */
184 if (luai_numlt(0, flim)) { /* if it is positive, it is too large */
185 if (step < 0) return 1; /* initial value must be less than it */
186 *p = LUA_MAXINTEGER; /* truncate */
187 }
188 else { /* it is less than min integer */
189 if (step > 0) return 1; /* initial value must be greater than it */
190 *p = LUA_MININTEGER; /* truncate */
191 }
192 }
193 return (step > 0 ? init > *p : init < *p); /* not to run? */
194}
195
196
197/*
198** Prepare a numerical for loop (opcode OP_FORPREP).
199** Return true to skip the loop. Otherwise,
200** after preparation, stack will be as follows:
201** ra : internal index (safe copy of the control variable)
202** ra + 1 : loop counter (integer loops) or limit (float loops)
203** ra + 2 : step
204** ra + 3 : control variable
205*/
206static int forprep (lua_State *L, StkId ra) {
207 TValue *pinit = s2v(ra);
208 TValue *plimit = s2v(ra + 1);
209 TValue *pstep = s2v(ra + 2);
210 if (ttisinteger(pinit) && ttisinteger(pstep)) { /* integer loop? */
211 lua_Integer init = ivalue(pinit);
212 lua_Integer step = ivalue(pstep);
213 lua_Integer limit;
214 if (step == 0)
215 luaG_runerror(L, "'for' step is zero");
216 setivalue(s2v(ra + 3), init); /* control variable */
217 if (forlimit(L, init, plimit, &limit, step))
218 return 1; /* skip the loop */
219 else { /* prepare loop counter */
220 lua_Unsigned count;
221 if (step > 0) { /* ascending loop? */
222 count = l_castS2U(limit) - l_castS2U(init);
223 if (step != 1) /* avoid division in the too common case */
224 count /= l_castS2U(step);
225 }
226 else { /* step < 0; descending loop */
227 count = l_castS2U(init) - l_castS2U(limit);
228 /* 'step+1' avoids negating 'mininteger' */
229 count /= l_castS2U(-(step + 1)) + 1u;
230 }
231 /* store the counter in place of the limit (which won't be
232 needed anymore */
233 setivalue(plimit, l_castU2S(count));
234 }
235 }
236 else { /* try making all values floats */
237 lua_Number init; lua_Number limit; lua_Number step;
238 if (unlikely(!tonumber(plimit, &limit)))
239 luaG_forerror(L, plimit, "limit");
240 if (unlikely(!tonumber(pstep, &step)))
241 luaG_forerror(L, pstep, "step");
242 if (unlikely(!tonumber(pinit, &init)))
243 luaG_forerror(L, pinit, "initial value");
244 if (step == 0)
245 luaG_runerror(L, "'for' step is zero");
246 if (luai_numlt(0, step) ? luai_numlt(limit, init)
247 : luai_numlt(init, limit))
248 return 1; /* skip the loop */
249 else {
250 /* make sure internal values are all floats */
251 setfltvalue(plimit, limit);
252 setfltvalue(pstep, step);
253 setfltvalue(s2v(ra), init); /* internal index */
254 setfltvalue(s2v(ra + 3), init); /* control variable */
255 }
256 }
257 return 0;
258}
259
260
261/*
262** Execute a step of a float numerical for loop, returning
263** true iff the loop must continue. (The integer case is
264** written online with opcode OP_FORLOOP, for performance.)
265*/
266static int floatforloop (StkId ra) {
267 lua_Number step = fltvalue(s2v(ra + 2));
268 lua_Number limit = fltvalue(s2v(ra + 1));
269 lua_Number idx = fltvalue(s2v(ra)); /* internal index */
270 idx = luai_numadd(L, idx, step); /* increment index */
271 if (luai_numlt(0, step) ? luai_numle(idx, limit)
272 : luai_numle(limit, idx)) {
273 chgfltvalue(s2v(ra), idx); /* update internal index */
274 setfltvalue(s2v(ra + 3), idx); /* and control variable */
275 return 1; /* jump back */
276 }
277 else
278 return 0; /* finish the loop */
279}
280
281
282/*
283** Finish the table access 'val = t[key]'.
284** if 'slot' is NULL, 't' is not a table; otherwise, 'slot' points to
285** t[k] entry (which must be empty).
286*/
287void luaV_finishget (lua_State *L, const TValue *t, TValue *key, StkId val,
288 const TValue *slot) {
289 int loop; /* counter to avoid infinite loops */
290 const TValue *tm; /* metamethod */
291 for (loop = 0; loop < MAXTAGLOOP; loop++) {
292 if (slot == NULL) { /* 't' is not a table? */
293 lua_assert(!ttistable(t));
294 tm = luaT_gettmbyobj(L, t, TM_INDEX);
295 if (unlikely(notm(tm)))
296 luaG_typeerror(L, t, "index"); /* no metamethod */
297 /* else will try the metamethod */
298 }
299 else { /* 't' is a table */
300 lua_assert(isempty(slot));
301 tm = fasttm(L, hvalue(t)->metatable, TM_INDEX); /* table's metamethod */
302 if (tm == NULL) { /* no metamethod? */
303 setnilvalue(s2v(val)); /* result is nil */
304 return;
305 }
306 /* else will try the metamethod */
307 }
308 if (ttisfunction(tm)) { /* is metamethod a function? */
309 luaT_callTMres(L, tm, t, key, val); /* call it */
310 return;
311 }
312 t = tm; /* else try to access 'tm[key]' */
313 if (luaV_fastget(L, t, key, slot, luaH_get)) { /* fast track? */
314 setobj2s(L, val, slot); /* done */
315 return;
316 }
317 /* else repeat (tail call 'luaV_finishget') */
318 }
319 luaG_runerror(L, "'__index' chain too long; possible loop");
320}
321
322
323/*
324** Finish a table assignment 't[key] = val'.
325** If 'slot' is NULL, 't' is not a table. Otherwise, 'slot' points
326** to the entry 't[key]', or to a value with an absent key if there
327** is no such entry. (The value at 'slot' must be empty, otherwise
328** 'luaV_fastget' would have done the job.)
329*/
330void luaV_finishset (lua_State *L, const TValue *t, TValue *key,
331 TValue *val, const TValue *slot) {
332 int loop; /* counter to avoid infinite loops */
333 for (loop = 0; loop < MAXTAGLOOP; loop++) {
334 const TValue *tm; /* '__newindex' metamethod */
335 if (slot != NULL) { /* is 't' a table? */
336 Table *h = hvalue(t); /* save 't' table */
337 lua_assert(isempty(slot)); /* slot must be empty */
338 tm = fasttm(L, h->metatable, TM_NEWINDEX); /* get metamethod */
339 if (tm == NULL) { /* no metamethod? */
340 if (isabstkey(slot)) /* no previous entry? */
341 slot = luaH_newkey(L, h, key); /* create one */
342 /* no metamethod and (now) there is an entry with given key */
343 setobj2t(L, cast(TValue *, slot), val); /* set its new value */
344 invalidateTMcache(h);
345 luaC_barrierback(L, obj2gco(h), val);
346 return;
347 }
348 /* else will try the metamethod */
349 }
350 else { /* not a table; check metamethod */
351 tm = luaT_gettmbyobj(L, t, TM_NEWINDEX);
352 if (unlikely(notm(tm)))
353 luaG_typeerror(L, t, "index");
354 }
355 /* try the metamethod */
356 if (ttisfunction(tm)) {
357 luaT_callTM(L, tm, t, key, val);
358 return;
359 }
360 t = tm; /* else repeat assignment over 'tm' */
361 if (luaV_fastget(L, t, key, slot, luaH_get)) {
362 luaV_finishfastset(L, t, slot, val);
363 return; /* done */
364 }
365 /* else 'return luaV_finishset(L, t, key, val, slot)' (loop) */
366 }
367 luaG_runerror(L, "'__newindex' chain too long; possible loop");
368}
369
370
371/*
372** Compare two strings 'ls' x 'rs', returning an integer less-equal-
373** -greater than zero if 'ls' is less-equal-greater than 'rs'.
374** The code is a little tricky because it allows '\0' in the strings
375** and it uses 'strcoll' (to respect locales) for each segments
376** of the strings.
377*/
378static int l_strcmp (const TString *ls, const TString *rs) {
379 const char *l = getstr(ls);
380 size_t ll = tsslen(ls);
381 const char *r = getstr(rs);
382 size_t lr = tsslen(rs);
383 for (;;) { /* for each segment */
384 int temp = strcoll(l, r);
385 if (temp != 0) /* not equal? */
386 return temp; /* done */
387 else { /* strings are equal up to a '\0' */
388 size_t len = strlen(l); /* index of first '\0' in both strings */
389 if (len == lr) /* 'rs' is finished? */
390 return (len == ll) ? 0 : 1; /* check 'ls' */
391 else if (len == ll) /* 'ls' is finished? */
392 return -1; /* 'ls' is less than 'rs' ('rs' is not finished) */
393 /* both strings longer than 'len'; go on comparing after the '\0' */
394 len++;
395 l += len; ll -= len; r += len; lr -= len;
396 }
397 }
398}
399
400
401/*
402** Check whether integer 'i' is less than float 'f'. If 'i' has an
403** exact representation as a float ('l_intfitsf'), compare numbers as
404** floats. Otherwise, use the equivalence 'i < f <=> i < ceil(f)'.
405** If 'ceil(f)' is out of integer range, either 'f' is greater than
406** all integers or less than all integers.
407** (The test with 'l_intfitsf' is only for performance; the else
408** case is correct for all values, but it is slow due to the conversion
409** from float to int.)
410** When 'f' is NaN, comparisons must result in false.
411*/
412static int LTintfloat (lua_Integer i, lua_Number f) {
413 if (l_intfitsf(i))
414 return luai_numlt(cast_num(i), f); /* compare them as floats */
415 else { /* i < f <=> i < ceil(f) */
416 lua_Integer fi;
417 if (luaV_flttointeger(f, &fi, F2Iceil)) /* fi = ceil(f) */
418 return i < fi; /* compare them as integers */
419 else /* 'f' is either greater or less than all integers */
420 return f > 0; /* greater? */
421 }
422}
423
424
425/*
426** Check whether integer 'i' is less than or equal to float 'f'.
427** See comments on previous function.
428*/
429static int LEintfloat (lua_Integer i, lua_Number f) {
430 if (l_intfitsf(i))
431 return luai_numle(cast_num(i), f); /* compare them as floats */
432 else { /* i <= f <=> i <= floor(f) */
433 lua_Integer fi;
434 if (luaV_flttointeger(f, &fi, F2Ifloor)) /* fi = floor(f) */
435 return i <= fi; /* compare them as integers */
436 else /* 'f' is either greater or less than all integers */
437 return f > 0; /* greater? */
438 }
439}
440
441
442/*
443** Check whether float 'f' is less than integer 'i'.
444** See comments on previous function.
445*/
446static int LTfloatint (lua_Number f, lua_Integer i) {
447 if (l_intfitsf(i))
448 return luai_numlt(f, cast_num(i)); /* compare them as floats */
449 else { /* f < i <=> floor(f) < i */
450 lua_Integer fi;
451 if (luaV_flttointeger(f, &fi, F2Ifloor)) /* fi = floor(f) */
452 return fi < i; /* compare them as integers */
453 else /* 'f' is either greater or less than all integers */
454 return f < 0; /* less? */
455 }
456}
457
458
459/*
460** Check whether float 'f' is less than or equal to integer 'i'.
461** See comments on previous function.
462*/
463static int LEfloatint (lua_Number f, lua_Integer i) {
464 if (l_intfitsf(i))
465 return luai_numle(f, cast_num(i)); /* compare them as floats */
466 else { /* f <= i <=> ceil(f) <= i */
467 lua_Integer fi;
468 if (luaV_flttointeger(f, &fi, F2Iceil)) /* fi = ceil(f) */
469 return fi <= i; /* compare them as integers */
470 else /* 'f' is either greater or less than all integers */
471 return f < 0; /* less? */
472 }
473}
474
475
476/*
477** Return 'l < r', for numbers.
478*/
479static int LTnum (const TValue *l, const TValue *r) {
480 lua_assert(ttisnumber(l) && ttisnumber(r));
481 if (ttisinteger(l)) {
482 lua_Integer li = ivalue(l);
483 if (ttisinteger(r))
484 return li < ivalue(r); /* both are integers */
485 else /* 'l' is int and 'r' is float */
486 return LTintfloat(li, fltvalue(r)); /* l < r ? */
487 }
488 else {
489 lua_Number lf = fltvalue(l); /* 'l' must be float */
490 if (ttisfloat(r))
491 return luai_numlt(lf, fltvalue(r)); /* both are float */
492 else /* 'l' is float and 'r' is int */
493 return LTfloatint(lf, ivalue(r));
494 }
495}
496
497
498/*
499** Return 'l <= r', for numbers.
500*/
501static int LEnum (const TValue *l, const TValue *r) {
502 lua_assert(ttisnumber(l) && ttisnumber(r));
503 if (ttisinteger(l)) {
504 lua_Integer li = ivalue(l);
505 if (ttisinteger(r))
506 return li <= ivalue(r); /* both are integers */
507 else /* 'l' is int and 'r' is float */
508 return LEintfloat(li, fltvalue(r)); /* l <= r ? */
509 }
510 else {
511 lua_Number lf = fltvalue(l); /* 'l' must be float */
512 if (ttisfloat(r))
513 return luai_numle(lf, fltvalue(r)); /* both are float */
514 else /* 'l' is float and 'r' is int */
515 return LEfloatint(lf, ivalue(r));
516 }
517}
518
519
520/*
521** return 'l < r' for non-numbers.
522*/
523static int lessthanothers (lua_State *L, const TValue *l, const TValue *r) {
524 lua_assert(!ttisnumber(l) || !ttisnumber(r));
525 if (ttisstring(l) && ttisstring(r)) /* both are strings? */
526 return l_strcmp(tsvalue(l), tsvalue(r)) < 0;
527 else
528 return luaT_callorderTM(L, l, r, TM_LT);
529}
530
531
532/*
533** Main operation less than; return 'l < r'.
534*/
535int luaV_lessthan (lua_State *L, const TValue *l, const TValue *r) {
536 if (ttisnumber(l) && ttisnumber(r)) /* both operands are numbers? */
537 return LTnum(l, r);
538 else return lessthanothers(L, l, r);
539}
540
541
542/*
543** return 'l <= r' for non-numbers.
544*/
545static int lessequalothers (lua_State *L, const TValue *l, const TValue *r) {
546 lua_assert(!ttisnumber(l) || !ttisnumber(r));
547 if (ttisstring(l) && ttisstring(r)) /* both are strings? */
548 return l_strcmp(tsvalue(l), tsvalue(r)) <= 0;
549 else
550 return luaT_callorderTM(L, l, r, TM_LE);
551}
552
553
554/*
555** Main operation less than or equal to; return 'l <= r'.
556*/
557int luaV_lessequal (lua_State *L, const TValue *l, const TValue *r) {
558 if (ttisnumber(l) && ttisnumber(r)) /* both operands are numbers? */
559 return LEnum(l, r);
560 else return lessequalothers(L, l, r);
561}
562
563
564/*
565** Main operation for equality of Lua values; return 't1 == t2'.
566** L == NULL means raw equality (no metamethods)
567*/
568int luaV_equalobj (lua_State *L, const TValue *t1, const TValue *t2) {
569 const TValue *tm;
570 if (ttypetag(t1) != ttypetag(t2)) { /* not the same variant? */
571 if (ttype(t1) != ttype(t2) || ttype(t1) != LUA_TNUMBER)
572 return 0; /* only numbers can be equal with different variants */
573 else { /* two numbers with different variants */
574 lua_Integer i1, i2; /* compare them as integers */
575 return (tointegerns(t1, &i1) && tointegerns(t2, &i2) && i1 == i2);
576 }
577 }
578 /* values have same type and same variant */
579 switch (ttypetag(t1)) {
580 case LUA_VNIL: case LUA_VFALSE: case LUA_VTRUE: return 1;
581 case LUA_VNUMINT: return (ivalue(t1) == ivalue(t2));
582 case LUA_VNUMFLT: return luai_numeq(fltvalue(t1), fltvalue(t2));
583 case LUA_VLIGHTUSERDATA: return pvalue(t1) == pvalue(t2);
584 case LUA_VLCF: return fvalue(t1) == fvalue(t2);
585 case LUA_VSHRSTR: return eqshrstr(tsvalue(t1), tsvalue(t2));
586 case LUA_VLNGSTR: return luaS_eqlngstr(tsvalue(t1), tsvalue(t2));
587 case LUA_VUSERDATA: {
588 if (uvalue(t1) == uvalue(t2)) return 1;
589 else if (L == NULL) return 0;
590 tm = fasttm(L, uvalue(t1)->metatable, TM_EQ);
591 if (tm == NULL)
592 tm = fasttm(L, uvalue(t2)->metatable, TM_EQ);
593 break; /* will try TM */
594 }
595 case LUA_VTABLE: {
596 if (hvalue(t1) == hvalue(t2)) return 1;
597 else if (L == NULL) return 0;
598 tm = fasttm(L, hvalue(t1)->metatable, TM_EQ);
599 if (tm == NULL)
600 tm = fasttm(L, hvalue(t2)->metatable, TM_EQ);
601 break; /* will try TM */
602 }
603 default:
604 return gcvalue(t1) == gcvalue(t2);
605 }
606 if (tm == NULL) /* no TM? */
607 return 0; /* objects are different */
608 else {
609 luaT_callTMres(L, tm, t1, t2, L->top); /* call TM */
610 return !l_isfalse(s2v(L->top));
611 }
612}
613
614
615/* macro used by 'luaV_concat' to ensure that element at 'o' is a string */
616#define tostring(L,o) \
617 (ttisstring(o) || (cvt2str(o) && (luaO_tostring(L, o), 1)))
618
619#define isemptystr(o) (ttisshrstring(o) && tsvalue(o)->shrlen == 0)
620
621/* copy strings in stack from top - n up to top - 1 to buffer */
622static void copy2buff (StkId top, int n, char *buff) {
623 size_t tl = 0; /* size already copied */
624 do {
625 size_t l = vslen(s2v(top - n)); /* length of string being copied */
626 memcpy(buff + tl, svalue(s2v(top - n)), l * sizeof(char));
627 tl += l;
628 } while (--n > 0);
629}
630
631
632/*
633** Main operation for concatenation: concat 'total' values in the stack,
634** from 'L->top - total' up to 'L->top - 1'.
635*/
636void luaV_concat (lua_State *L, int total) {
637 lua_assert(total >= 2);
638 do {
639 StkId top = L->top;
640 int n = 2; /* number of elements handled in this pass (at least 2) */
641 if (!(ttisstring(s2v(top - 2)) || cvt2str(s2v(top - 2))) ||
642 !tostring(L, s2v(top - 1)))
643 luaT_tryconcatTM(L);
644 else if (isemptystr(s2v(top - 1))) /* second operand is empty? */
645 cast_void(tostring(L, s2v(top - 2))); /* result is first operand */
646 else if (isemptystr(s2v(top - 2))) { /* first operand is empty string? */
647 setobjs2s(L, top - 2, top - 1); /* result is second op. */
648 }
649 else {
650 /* at least two non-empty string values; get as many as possible */
651 size_t tl = vslen(s2v(top - 1));
652 TString *ts;
653 /* collect total length and number of strings */
654 for (n = 1; n < total && tostring(L, s2v(top - n - 1)); n++) {
655 size_t l = vslen(s2v(top - n - 1));
656 if (unlikely(l >= (MAX_SIZE/sizeof(char)) - tl))
657 luaG_runerror(L, "string length overflow");
658 tl += l;
659 }
660 if (tl <= LUAI_MAXSHORTLEN) { /* is result a short string? */
661 char buff[LUAI_MAXSHORTLEN];
662 copy2buff(top, n, buff); /* copy strings to buffer */
663 ts = luaS_newlstr(L, buff, tl);
664 }
665 else { /* long string; copy strings directly to final result */
666 ts = luaS_createlngstrobj(L, tl);
667 copy2buff(top, n, getstr(ts));
668 }
669 setsvalue2s(L, top - n, ts); /* create result */
670 }
671 total -= n-1; /* got 'n' strings to create 1 new */
672 L->top -= n-1; /* popped 'n' strings and pushed one */
673 } while (total > 1); /* repeat until only 1 result left */
674}
675
676
677/*
678** Main operation 'ra = #rb'.
679*/
680void luaV_objlen (lua_State *L, StkId ra, const TValue *rb) {
681 const TValue *tm;
682 switch (ttypetag(rb)) {
683 case LUA_VTABLE: {
684 Table *h = hvalue(rb);
685 tm = fasttm(L, h->metatable, TM_LEN);
686 if (tm) break; /* metamethod? break switch to call it */
687 setivalue(s2v(ra), luaH_getn(h)); /* else primitive len */
688 return;
689 }
690 case LUA_VSHRSTR: {
691 setivalue(s2v(ra), tsvalue(rb)->shrlen);
692 return;
693 }
694 case LUA_VLNGSTR: {
695 setivalue(s2v(ra), tsvalue(rb)->u.lnglen);
696 return;
697 }
698 default: { /* try metamethod */
699 tm = luaT_gettmbyobj(L, rb, TM_LEN);
700 if (unlikely(notm(tm))) /* no metamethod? */
701 luaG_typeerror(L, rb, "get length of");
702 break;
703 }
704 }
705 luaT_callTMres(L, tm, rb, rb, ra);
706}
707
708
709/*
710** Integer division; return 'm // n', that is, floor(m/n).
711** C division truncates its result (rounds towards zero).
712** 'floor(q) == trunc(q)' when 'q >= 0' or when 'q' is integer,
713** otherwise 'floor(q) == trunc(q) - 1'.
714*/
715lua_Integer luaV_idiv (lua_State *L, lua_Integer m, lua_Integer n) {
716 if (unlikely(l_castS2U(n) + 1u <= 1u)) { /* special cases: -1 or 0 */
717 if (n == 0)
718 luaG_runerror(L, "attempt to divide by zero");
719 return intop(-, 0, m); /* n==-1; avoid overflow with 0x80000...//-1 */
720 }
721 else {
722 lua_Integer q = m / n; /* perform C division */
723 if ((m ^ n) < 0 && m % n != 0) /* 'm/n' would be negative non-integer? */
724 q -= 1; /* correct result for different rounding */
725 return q;
726 }
727}
728
729
730/*
731** Integer modulus; return 'm % n'. (Assume that C '%' with
732** negative operands follows C99 behavior. See previous comment
733** about luaV_idiv.)
734*/
735lua_Integer luaV_mod (lua_State *L, lua_Integer m, lua_Integer n) {
736 if (unlikely(l_castS2U(n) + 1u <= 1u)) { /* special cases: -1 or 0 */
737 if (n == 0)
738 luaG_runerror(L, "attempt to perform 'n%%0'");
739 return 0; /* m % -1 == 0; avoid overflow with 0x80000...%-1 */
740 }
741 else {
742 lua_Integer r = m % n;
743 if (r != 0 && (r ^ n) < 0) /* 'm/n' would be non-integer negative? */
744 r += n; /* correct result for different rounding */
745 return r;
746 }
747}
748
749
750/*
751** Float modulus
752*/
753lua_Number luaV_modf (lua_State *L, lua_Number m, lua_Number n) {
754 lua_Number r;
755 luai_nummod(L, m, n, r);
756 return r;
757}
758
759
760/* number of bits in an integer */
761#define NBITS cast_int(sizeof(lua_Integer) * CHAR_BIT)
762
763/*
764** Shift left operation. (Shift right just negates 'y'.)
765*/
766#define luaV_shiftr(x,y) luaV_shiftl(x,-(y))
767
768lua_Integer luaV_shiftl (lua_Integer x, lua_Integer y) {
769 if (y < 0) { /* shift right? */
770 if (y <= -NBITS) return 0;
771 else return intop(>>, x, -y);
772 }
773 else { /* shift left */
774 if (y >= NBITS) return 0;
775 else return intop(<<, x, y);
776 }
777}
778
779
780/*
781** create a new Lua closure, push it in the stack, and initialize
782** its upvalues.
783*/
784static void pushclosure (lua_State *L, Proto *p, UpVal **encup, StkId base,
785 StkId ra) {
786 int nup = p->sizeupvalues;
787 Upvaldesc *uv = p->upvalues;
788 int i;
789 LClosure *ncl = luaF_newLclosure(L, nup);
790 ncl->p = p;
791 setclLvalue2s(L, ra, ncl); /* anchor new closure in stack */
792 for (i = 0; i < nup; i++) { /* fill in its upvalues */
793 if (uv[i].instack) /* upvalue refers to local variable? */
794 ncl->upvals[i] = luaF_findupval(L, base + uv[i].idx);
795 else /* get upvalue from enclosing function */
796 ncl->upvals[i] = encup[uv[i].idx];
797 luaC_objbarrier(L, ncl, ncl->upvals[i]);
798 }
799}
800
801
802/*
803** finish execution of an opcode interrupted by a yield
804*/
805void luaV_finishOp (lua_State *L) {
806 CallInfo *ci = L->ci;
807 StkId base = ci->func + 1;
808 Instruction inst = *(ci->u.l.savedpc - 1); /* interrupted instruction */
809 OpCode op = GET_OPCODE(inst);
810 switch (op) { /* finish its execution */
811 case OP_MMBIN: case OP_MMBINI: case OP_MMBINK: {
812 setobjs2s(L, base + GETARG_A(*(ci->u.l.savedpc - 2)), --L->top);
813 break;
814 }
815 case OP_UNM: case OP_BNOT: case OP_LEN:
816 case OP_GETTABUP: case OP_GETTABLE: case OP_GETI:
817 case OP_GETFIELD: case OP_SELF: {
818 setobjs2s(L, base + GETARG_A(inst), --L->top);
819 break;
820 }
821 case OP_LT: case OP_LE:
822 case OP_LTI: case OP_LEI:
823 case OP_GTI: case OP_GEI:
824 case OP_EQ: { /* note that 'OP_EQI'/'OP_EQK' cannot yield */
825 int res = !l_isfalse(s2v(L->top - 1));
826 L->top--;
827#if defined(LUA_COMPAT_LT_LE)
828 if (ci->callstatus & CIST_LEQ) { /* "<=" using "<" instead? */
829 ci->callstatus ^= CIST_LEQ; /* clear mark */
830 res = !res; /* negate result */
831 }
832#endif
833 lua_assert(GET_OPCODE(*ci->u.l.savedpc) == OP_JMP);
834 if (res != GETARG_k(inst)) /* condition failed? */
835 ci->u.l.savedpc++; /* skip jump instruction */
836 break;
837 }
838 case OP_CONCAT: {
839 StkId top = L->top - 1; /* top when 'luaT_tryconcatTM' was called */
840 int a = GETARG_A(inst); /* first element to concatenate */
841 int total = cast_int(top - 1 - (base + a)); /* yet to concatenate */
842 setobjs2s(L, top - 2, top); /* put TM result in proper position */
843 if (total > 1) { /* are there elements to concat? */
844 L->top = top - 1; /* top is one after last element (at top-2) */
845 luaV_concat(L, total); /* concat them (may yield again) */
846 }
847 break;
848 }
849 default: {
850 /* only these other opcodes can yield */
851 lua_assert(op == OP_TFORCALL || op == OP_CALL ||
852 op == OP_TAILCALL || op == OP_SETTABUP || op == OP_SETTABLE ||
853 op == OP_SETI || op == OP_SETFIELD);
854 break;
855 }
856 }
857}
858
859
860
861
862/*
863** {==================================================================
864** Macros for arithmetic/bitwise/comparison opcodes in 'luaV_execute'
865** ===================================================================
866*/
867
868#define l_addi(L,a,b) intop(+, a, b)
869#define l_subi(L,a,b) intop(-, a, b)
870#define l_muli(L,a,b) intop(*, a, b)
871#define l_band(a,b) intop(&, a, b)
872#define l_bor(a,b) intop(|, a, b)
873#define l_bxor(a,b) intop(^, a, b)
874
875#define l_lti(a,b) (a < b)
876#define l_lei(a,b) (a <= b)
877#define l_gti(a,b) (a > b)
878#define l_gei(a,b) (a >= b)
879
880
881/*
882** Arithmetic operations with immediate operands. 'iop' is the integer
883** operation, 'fop' is the float operation.
884*/
885#define op_arithI(L,iop,fop) { \
886 TValue *v1 = vRB(i); \
887 int imm = GETARG_sC(i); \
888 if (ttisinteger(v1)) { \
889 lua_Integer iv1 = ivalue(v1); \
890 pc++; setivalue(s2v(ra), iop(L, iv1, imm)); \
891 } \
892 else if (ttisfloat(v1)) { \
893 lua_Number nb = fltvalue(v1); \
894 lua_Number fimm = cast_num(imm); \
895 pc++; setfltvalue(s2v(ra), fop(L, nb, fimm)); \
896 }}
897
898
899/*
900** Auxiliary function for arithmetic operations over floats and others
901** with two register operands.
902*/
903#define op_arithf_aux(L,v1,v2,fop) { \
904 lua_Number n1; lua_Number n2; \
905 if (tonumberns(v1, n1) && tonumberns(v2, n2)) { \
906 pc++; setfltvalue(s2v(ra), fop(L, n1, n2)); \
907 }}
908
909
910/*
911** Arithmetic operations over floats and others with register operands.
912*/
913#define op_arithf(L,fop) { \
914 TValue *v1 = vRB(i); \
915 TValue *v2 = vRC(i); \
916 op_arithf_aux(L, v1, v2, fop); }
917
918
919/*
920** Arithmetic operations with K operands for floats.
921*/
922#define op_arithfK(L,fop) { \
923 TValue *v1 = vRB(i); \
924 TValue *v2 = KC(i); \
925 op_arithf_aux(L, v1, v2, fop); }
926
927
928/*
929** Arithmetic operations over integers and floats.
930*/
931#define op_arith_aux(L,v1,v2,iop,fop) { \
932 if (ttisinteger(v1) && ttisinteger(v2)) { \
933 lua_Integer i1 = ivalue(v1); lua_Integer i2 = ivalue(v2); \
934 pc++; setivalue(s2v(ra), iop(L, i1, i2)); \
935 } \
936 else op_arithf_aux(L, v1, v2, fop); }
937
938
939/*
940** Arithmetic operations with register operands.
941*/
942#define op_arith(L,iop,fop) { \
943 TValue *v1 = vRB(i); \
944 TValue *v2 = vRC(i); \
945 op_arith_aux(L, v1, v2, iop, fop); }
946
947
948/*
949** Arithmetic operations with K operands.
950*/
951#define op_arithK(L,iop,fop) { \
952 TValue *v1 = vRB(i); \
953 TValue *v2 = KC(i); \
954 op_arith_aux(L, v1, v2, iop, fop); }
955
956
957/*
958** Bitwise operations with constant operand.
959*/
960#define op_bitwiseK(L,op) { \
961 TValue *v1 = vRB(i); \
962 TValue *v2 = KC(i); \
963 lua_Integer i1; \
964 lua_Integer i2 = ivalue(v2); \
965 if (tointegerns(v1, &i1)) { \
966 pc++; setivalue(s2v(ra), op(i1, i2)); \
967 }}
968
969
970/*
971** Bitwise operations with register operands.
972*/
973#define op_bitwise(L,op) { \
974 TValue *v1 = vRB(i); \
975 TValue *v2 = vRC(i); \
976 lua_Integer i1; lua_Integer i2; \
977 if (tointegerns(v1, &i1) && tointegerns(v2, &i2)) { \
978 pc++; setivalue(s2v(ra), op(i1, i2)); \
979 }}
980
981
982/*
983** Order operations with register operands. 'opn' actually works
984** for all numbers, but the fast track improves performance for
985** integers.
986*/
987#define op_order(L,opi,opn,other) { \
988 int cond; \
989 TValue *rb = vRB(i); \
990 if (ttisinteger(s2v(ra)) && ttisinteger(rb)) { \
991 lua_Integer ia = ivalue(s2v(ra)); \
992 lua_Integer ib = ivalue(rb); \
993 cond = opi(ia, ib); \
994 } \
995 else if (ttisnumber(s2v(ra)) && ttisnumber(rb)) \
996 cond = opn(s2v(ra), rb); \
997 else \
998 Protect(cond = other(L, s2v(ra), rb)); \
999 docondjump(); }
1000
1001
1002/*
1003** Order operations with immediate operand. (Immediate operand is
1004** always small enough to have an exact representation as a float.)
1005*/
1006#define op_orderI(L,opi,opf,inv,tm) { \
1007 int cond; \
1008 int im = GETARG_sB(i); \
1009 if (ttisinteger(s2v(ra))) \
1010 cond = opi(ivalue(s2v(ra)), im); \
1011 else if (ttisfloat(s2v(ra))) { \
1012 lua_Number fa = fltvalue(s2v(ra)); \
1013 lua_Number fim = cast_num(im); \
1014 cond = opf(fa, fim); \
1015 } \
1016 else { \
1017 int isf = GETARG_C(i); \
1018 Protect(cond = luaT_callorderiTM(L, s2v(ra), im, inv, isf, tm)); \
1019 } \
1020 docondjump(); }
1021
1022/* }================================================================== */
1023
1024
1025/*
1026** {==================================================================
1027** Function 'luaV_execute': main interpreter loop
1028** ===================================================================
1029*/
1030
1031/*
1032** some macros for common tasks in 'luaV_execute'
1033*/
1034
1035
1036#define RA(i) (base+GETARG_A(i))
1037#define RB(i) (base+GETARG_B(i))
1038#define vRB(i) s2v(RB(i))
1039#define KB(i) (k+GETARG_B(i))
1040#define RC(i) (base+GETARG_C(i))
1041#define vRC(i) s2v(RC(i))
1042#define KC(i) (k+GETARG_C(i))
1043#define RKC(i) ((TESTARG_k(i)) ? k + GETARG_C(i) : s2v(base + GETARG_C(i)))
1044
1045
1046
1047#define updatetrap(ci) (trap = ci->u.l.trap)
1048
1049#define updatebase(ci) (base = ci->func + 1)
1050
1051
1052#define updatestack(ci) { if (trap) { updatebase(ci); ra = RA(i); } }
1053
1054
1055/*
1056** Execute a jump instruction. The 'updatetrap' allows signals to stop
1057** tight loops. (Without it, the local copy of 'trap' could never change.)
1058*/
1059#define dojump(ci,i,e) { pc += GETARG_sJ(i) + e; updatetrap(ci); }
1060
1061
1062/* for test instructions, execute the jump instruction that follows it */
1063#define donextjump(ci) { Instruction ni = *pc; dojump(ci, ni, 1); }
1064
1065/*
1066** do a conditional jump: skip next instruction if 'cond' is not what
1067** was expected (parameter 'k'), else do next instruction, which must
1068** be a jump.
1069*/
1070#define docondjump() if (cond != GETARG_k(i)) pc++; else donextjump(ci);
1071
1072
1073/*
1074** Correct global 'pc'.
1075*/
1076#define savepc(L) (ci->u.l.savedpc = pc)
1077
1078
1079/*
1080** Whenever code can raise errors, the global 'pc' and the global
1081** 'top' must be correct to report occasional errors.
1082*/
1083#define savestate(L,ci) (savepc(L), L->top = ci->top)
1084
1085
1086/*
1087** Protect code that, in general, can raise errors, reallocate the
1088** stack, and change the hooks.
1089*/
1090#define Protect(exp) (savestate(L,ci), (exp), updatetrap(ci))
1091
1092/* special version that does not change the top */
1093#define ProtectNT(exp) (savepc(L), (exp), updatetrap(ci))
1094
1095/*
1096** Protect code that will finish the loop (returns) or can only raise
1097** errors. (That is, it will not return to the interpreter main loop
1098** after changing the stack or hooks.)
1099*/
1100#define halfProtect(exp) (savestate(L,ci), (exp))
1101
1102/* idem, but without changing the stack */
1103#define halfProtectNT(exp) (savepc(L), (exp))
1104
1105
1106#define checkGC(L,c) \
1107 { luaC_condGC(L, L->top = (c), /* limit of live values */ \
1108 updatetrap(ci)); \
1109 luai_threadyield(L); }
1110
1111
1112/* fetch an instruction and prepare its execution */
1113#define vmfetch() { \
1114 if (trap) { /* stack reallocation or hooks? */ \
1115 trap = luaG_traceexec(L, pc); /* handle hooks */ \
1116 updatebase(ci); /* correct stack */ \
1117 } \
1118 i = *(pc++); \
1119 ra = RA(i); /* WARNING: any stack reallocation invalidates 'ra' */ \
1120}
1121
1122#define vmdispatch(o) switch(o)
1123#define vmcase(l) case l:
1124#define vmbreak break
1125
1126
1127void luaV_execute (lua_State *L, CallInfo *ci) {
1128 LClosure *cl;
1129 TValue *k;
1130 StkId base;
1131 const Instruction *pc;
1132 int trap;
1133#if LUA_USE_JUMPTABLE
1134#include "ljumptab.h"
1135#endif
1136 tailcall:
1137 trap = L->hookmask;
1138 cl = clLvalue(s2v(ci->func));
1139 k = cl->p->k;
1140 pc = ci->u.l.savedpc;
1141 if (trap) {
1142 if (cl->p->is_vararg)
1143 trap = 0; /* hooks will start after VARARGPREP instruction */
1144 else if (pc == cl->p->code) /* first instruction (not resuming)? */
1145 luaD_hookcall(L, ci);
1146 ci->u.l.trap = 1; /* there may be other hooks */
1147 }
1148 base = ci->func + 1;
1149 /* main loop of interpreter */
1150 for (;;) {
1151 Instruction i; /* instruction being executed */
1152 StkId ra; /* instruction's A register */
1153 vmfetch();
1154 lua_assert(base == ci->func + 1);
1155 lua_assert(base <= L->top && L->top < L->stack + L->stacksize);
1156 /* invalidate top for instructions not expecting it */
1157 lua_assert(isIT(i) || (cast_void(L->top = base), 1));
1158 vmdispatch (GET_OPCODE(i)) {
1159 vmcase(OP_MOVE) {
1160 setobjs2s(L, ra, RB(i));
1161 vmbreak;
1162 }
1163 vmcase(OP_LOADI) {
1164 lua_Integer b = GETARG_sBx(i);
1165 setivalue(s2v(ra), b);
1166 vmbreak;
1167 }
1168 vmcase(OP_LOADF) {
1169 int b = GETARG_sBx(i);
1170 setfltvalue(s2v(ra), cast_num(b));
1171 vmbreak;
1172 }
1173 vmcase(OP_LOADK) {
1174 TValue *rb = k + GETARG_Bx(i);
1175 setobj2s(L, ra, rb);
1176 vmbreak;
1177 }
1178 vmcase(OP_LOADKX) {
1179 TValue *rb;
1180 rb = k + GETARG_Ax(*pc); pc++;
1181 setobj2s(L, ra, rb);
1182 vmbreak;
1183 }
1184 vmcase(OP_LOADFALSE) {
1185 setbfvalue(s2v(ra));
1186 vmbreak;
1187 }
1188 vmcase(OP_LFALSESKIP) {
1189 setbfvalue(s2v(ra));
1190 pc++; /* skip next instruction */
1191 vmbreak;
1192 }
1193 vmcase(OP_LOADTRUE) {
1194 setbtvalue(s2v(ra));
1195 vmbreak;
1196 }
1197 vmcase(OP_LOADNIL) {
1198 int b = GETARG_B(i);
1199 do {
1200 setnilvalue(s2v(ra++));
1201 } while (b--);
1202 vmbreak;
1203 }
1204 vmcase(OP_GETUPVAL) {
1205 int b = GETARG_B(i);
1206 setobj2s(L, ra, cl->upvals[b]->v);
1207 vmbreak;
1208 }
1209 vmcase(OP_SETUPVAL) {
1210 UpVal *uv = cl->upvals[GETARG_B(i)];
1211 setobj(L, uv->v, s2v(ra));
1212 luaC_barrier(L, uv, s2v(ra));
1213 vmbreak;
1214 }
1215 vmcase(OP_GETTABUP) {
1216 const TValue *slot;
1217 TValue *upval = cl->upvals[GETARG_B(i)]->v;
1218 TValue *rc = KC(i);
1219 TString *key = tsvalue(rc); /* key must be a string */
1220 if (luaV_fastget(L, upval, key, slot, luaH_getshortstr)) {
1221 setobj2s(L, ra, slot);
1222 }
1223 else
1224 Protect(luaV_finishget(L, upval, rc, ra, slot));
1225 vmbreak;
1226 }
1227 vmcase(OP_GETTABLE) {
1228 const TValue *slot;
1229 TValue *rb = vRB(i);
1230 TValue *rc = vRC(i);
1231 lua_Unsigned n;
1232 if (ttisinteger(rc) /* fast track for integers? */
1233 ? (cast_void(n = ivalue(rc)), luaV_fastgeti(L, rb, n, slot))
1234 : luaV_fastget(L, rb, rc, slot, luaH_get)) {
1235 setobj2s(L, ra, slot);
1236 }
1237 else
1238 Protect(luaV_finishget(L, rb, rc, ra, slot));
1239 vmbreak;
1240 }
1241 vmcase(OP_GETI) {
1242 const TValue *slot;
1243 TValue *rb = vRB(i);
1244 int c = GETARG_C(i);
1245 if (luaV_fastgeti(L, rb, c, slot)) {
1246 setobj2s(L, ra, slot);
1247 }
1248 else {
1249 TValue key;
1250 setivalue(&key, c);
1251 Protect(luaV_finishget(L, rb, &key, ra, slot));
1252 }
1253 vmbreak;
1254 }
1255 vmcase(OP_GETFIELD) {
1256 const TValue *slot;
1257 TValue *rb = vRB(i);
1258 TValue *rc = KC(i);
1259 TString *key = tsvalue(rc); /* key must be a string */
1260 if (luaV_fastget(L, rb, key, slot, luaH_getshortstr)) {
1261 setobj2s(L, ra, slot);
1262 }
1263 else
1264 Protect(luaV_finishget(L, rb, rc, ra, slot));
1265 vmbreak;
1266 }
1267 vmcase(OP_SETTABUP) {
1268 const TValue *slot;
1269 TValue *upval = cl->upvals[GETARG_A(i)]->v;
1270 TValue *rb = KB(i);
1271 TValue *rc = RKC(i);
1272 TString *key = tsvalue(rb); /* key must be a string */
1273 if (luaV_fastget(L, upval, key, slot, luaH_getshortstr)) {
1274 luaV_finishfastset(L, upval, slot, rc);
1275 }
1276 else
1277 Protect(luaV_finishset(L, upval, rb, rc, slot));
1278 vmbreak;
1279 }
1280 vmcase(OP_SETTABLE) {
1281 const TValue *slot;
1282 TValue *rb = vRB(i); /* key (table is in 'ra') */
1283 TValue *rc = RKC(i); /* value */
1284 lua_Unsigned n;
1285 if (ttisinteger(rb) /* fast track for integers? */
1286 ? (cast_void(n = ivalue(rb)), luaV_fastgeti(L, s2v(ra), n, slot))
1287 : luaV_fastget(L, s2v(ra), rb, slot, luaH_get)) {
1288 luaV_finishfastset(L, s2v(ra), slot, rc);
1289 }
1290 else
1291 Protect(luaV_finishset(L, s2v(ra), rb, rc, slot));
1292 vmbreak;
1293 }
1294 vmcase(OP_SETI) {
1295 const TValue *slot;
1296 int c = GETARG_B(i);
1297 TValue *rc = RKC(i);
1298 if (luaV_fastgeti(L, s2v(ra), c, slot)) {
1299 luaV_finishfastset(L, s2v(ra), slot, rc);
1300 }
1301 else {
1302 TValue key;
1303 setivalue(&key, c);
1304 Protect(luaV_finishset(L, s2v(ra), &key, rc, slot));
1305 }
1306 vmbreak;
1307 }
1308 vmcase(OP_SETFIELD) {
1309 const TValue *slot;
1310 TValue *rb = KB(i);
1311 TValue *rc = RKC(i);
1312 TString *key = tsvalue(rb); /* key must be a string */
1313 if (luaV_fastget(L, s2v(ra), key, slot, luaH_getshortstr)) {
1314 luaV_finishfastset(L, s2v(ra), slot, rc);
1315 }
1316 else
1317 Protect(luaV_finishset(L, s2v(ra), rb, rc, slot));
1318 vmbreak;
1319 }
1320 vmcase(OP_NEWTABLE) {
1321 int b = GETARG_B(i); /* log2(hash size) + 1 */
1322 int c = GETARG_C(i); /* array size */
1323 Table *t;
1324 if (b > 0)
1325 b = 1 << (b - 1); /* size is 2^(b - 1) */
1326 lua_assert((!TESTARG_k(i)) == (GETARG_Ax(*pc) == 0));
1327 if (TESTARG_k(i)) /* non-zero extra argument? */
1328 c += GETARG_Ax(*pc) * (MAXARG_C + 1); /* add it to size */
1329 pc++; /* skip extra argument */
1330 L->top = ra + 1; /* correct top in case of emergency GC */
1331 t = luaH_new(L); /* memory allocation */
1332 sethvalue2s(L, ra, t);
1333 if (b != 0 || c != 0)
1334 luaH_resize(L, t, c, b); /* idem */
1335 checkGC(L, ra + 1);
1336 vmbreak;
1337 }
1338 vmcase(OP_SELF) {
1339 const TValue *slot;
1340 TValue *rb = vRB(i);
1341 TValue *rc = RKC(i);
1342 TString *key = tsvalue(rc); /* key must be a string */
1343 setobj2s(L, ra + 1, rb);
1344 if (luaV_fastget(L, rb, key, slot, luaH_getstr)) {
1345 setobj2s(L, ra, slot);
1346 }
1347 else
1348 Protect(luaV_finishget(L, rb, rc, ra, slot));
1349 vmbreak;
1350 }
1351 vmcase(OP_ADDI) {
1352 op_arithI(L, l_addi, luai_numadd);
1353 vmbreak;
1354 }
1355 vmcase(OP_ADDK) {
1356 op_arithK(L, l_addi, luai_numadd);
1357 vmbreak;
1358 }
1359 vmcase(OP_SUBK) {
1360 op_arithK(L, l_subi, luai_numsub);
1361 vmbreak;
1362 }
1363 vmcase(OP_MULK) {
1364 op_arithK(L, l_muli, luai_nummul);
1365 vmbreak;
1366 }
1367 vmcase(OP_MODK) {
1368 op_arithK(L, luaV_mod, luaV_modf);
1369 vmbreak;
1370 }
1371 vmcase(OP_POWK) {
1372 op_arithfK(L, luai_numpow);
1373 vmbreak;
1374 }
1375 vmcase(OP_DIVK) {
1376 op_arithfK(L, luai_numdiv);
1377 vmbreak;
1378 }
1379 vmcase(OP_IDIVK) {
1380 op_arithK(L, luaV_idiv, luai_numidiv);
1381 vmbreak;
1382 }
1383 vmcase(OP_BANDK) {
1384 op_bitwiseK(L, l_band);
1385 vmbreak;
1386 }
1387 vmcase(OP_BORK) {
1388 op_bitwiseK(L, l_bor);
1389 vmbreak;
1390 }
1391 vmcase(OP_BXORK) {
1392 op_bitwiseK(L, l_bxor);
1393 vmbreak;
1394 }
1395 vmcase(OP_SHRI) {
1396 TValue *rb = vRB(i);
1397 int ic = GETARG_sC(i);
1398 lua_Integer ib;
1399 if (tointegerns(rb, &ib)) {
1400 pc++; setivalue(s2v(ra), luaV_shiftl(ib, -ic));
1401 }
1402 vmbreak;
1403 }
1404 vmcase(OP_SHLI) {
1405 TValue *rb = vRB(i);
1406 int ic = GETARG_sC(i);
1407 lua_Integer ib;
1408 if (tointegerns(rb, &ib)) {
1409 pc++; setivalue(s2v(ra), luaV_shiftl(ic, ib));
1410 }
1411 vmbreak;
1412 }
1413 vmcase(OP_ADD) {
1414 op_arith(L, l_addi, luai_numadd);
1415 vmbreak;
1416 }
1417 vmcase(OP_SUB) {
1418 op_arith(L, l_subi, luai_numsub);
1419 vmbreak;
1420 }
1421 vmcase(OP_MUL) {
1422 op_arith(L, l_muli, luai_nummul);
1423 vmbreak;
1424 }
1425 vmcase(OP_MOD) {
1426 op_arith(L, luaV_mod, luaV_modf);
1427 vmbreak;
1428 }
1429 vmcase(OP_POW) {
1430 op_arithf(L, luai_numpow);
1431 vmbreak;
1432 }
1433 vmcase(OP_DIV) { /* float division (always with floats) */
1434 op_arithf(L, luai_numdiv);
1435 vmbreak;
1436 }
1437 vmcase(OP_IDIV) { /* floor division */
1438 op_arith(L, luaV_idiv, luai_numidiv);
1439 vmbreak;
1440 }
1441 vmcase(OP_BAND) {
1442 op_bitwise(L, l_band);
1443 vmbreak;
1444 }
1445 vmcase(OP_BOR) {
1446 op_bitwise(L, l_bor);
1447 vmbreak;
1448 }
1449 vmcase(OP_BXOR) {
1450 op_bitwise(L, l_bxor);
1451 vmbreak;
1452 }
1453 vmcase(OP_SHR) {
1454 op_bitwise(L, luaV_shiftr);
1455 vmbreak;
1456 }
1457 vmcase(OP_SHL) {
1458 op_bitwise(L, luaV_shiftl);
1459 vmbreak;
1460 }
1461 vmcase(OP_MMBIN) {
1462 Instruction pi = *(pc - 2); /* original arith. expression */
1463 TValue *rb = vRB(i);
1464 TMS tm = (TMS)GETARG_C(i);
1465 StkId result = RA(pi);
1466 lua_assert(OP_ADD <= GET_OPCODE(pi) && GET_OPCODE(pi) <= OP_SHR);
1467 Protect(luaT_trybinTM(L, s2v(ra), rb, result, tm));
1468 vmbreak;
1469 }
1470 vmcase(OP_MMBINI) {
1471 Instruction pi = *(pc - 2); /* original arith. expression */
1472 int imm = GETARG_sB(i);
1473 TMS tm = (TMS)GETARG_C(i);
1474 int flip = GETARG_k(i);
1475 StkId result = RA(pi);
1476 Protect(luaT_trybiniTM(L, s2v(ra), imm, flip, result, tm));
1477 vmbreak;
1478 }
1479 vmcase(OP_MMBINK) {
1480 Instruction pi = *(pc - 2); /* original arith. expression */
1481 TValue *imm = KB(i);
1482 TMS tm = (TMS)GETARG_C(i);
1483 int flip = GETARG_k(i);
1484 StkId result = RA(pi);
1485 Protect(luaT_trybinassocTM(L, s2v(ra), imm, flip, result, tm));
1486 vmbreak;
1487 }
1488 vmcase(OP_UNM) {
1489 TValue *rb = vRB(i);
1490 lua_Number nb;
1491 if (ttisinteger(rb)) {
1492 lua_Integer ib = ivalue(rb);
1493 setivalue(s2v(ra), intop(-, 0, ib));
1494 }
1495 else if (tonumberns(rb, nb)) {
1496 setfltvalue(s2v(ra), luai_numunm(L, nb));
1497 }
1498 else
1499 Protect(luaT_trybinTM(L, rb, rb, ra, TM_UNM));
1500 vmbreak;
1501 }
1502 vmcase(OP_BNOT) {
1503 TValue *rb = vRB(i);
1504 lua_Integer ib;
1505 if (tointegerns(rb, &ib)) {
1506 setivalue(s2v(ra), intop(^, ~l_castS2U(0), ib));
1507 }
1508 else
1509 Protect(luaT_trybinTM(L, rb, rb, ra, TM_BNOT));
1510 vmbreak;
1511 }
1512 vmcase(OP_NOT) {
1513 TValue *rb = vRB(i);
1514 if (l_isfalse(rb))
1515 setbtvalue(s2v(ra));
1516 else
1517 setbfvalue(s2v(ra));
1518 vmbreak;
1519 }
1520 vmcase(OP_LEN) {
1521 Protect(luaV_objlen(L, ra, vRB(i)));
1522 vmbreak;
1523 }
1524 vmcase(OP_CONCAT) {
1525 int n = GETARG_B(i); /* number of elements to concatenate */
1526 L->top = ra + n; /* mark the end of concat operands */
1527 ProtectNT(luaV_concat(L, n));
1528 checkGC(L, L->top); /* 'luaV_concat' ensures correct top */
1529 vmbreak;
1530 }
1531 vmcase(OP_CLOSE) {
1532 Protect(luaF_close(L, ra, LUA_OK));
1533 vmbreak;
1534 }
1535 vmcase(OP_TBC) {
1536 /* create new to-be-closed upvalue */
1537 halfProtect(luaF_newtbcupval(L, ra));
1538 vmbreak;
1539 }
1540 vmcase(OP_JMP) {
1541 dojump(ci, i, 0);
1542 vmbreak;
1543 }
1544 vmcase(OP_EQ) {
1545 int cond;
1546 TValue *rb = vRB(i);
1547 Protect(cond = luaV_equalobj(L, s2v(ra), rb));
1548 docondjump();
1549 vmbreak;
1550 }
1551 vmcase(OP_LT) {
1552 op_order(L, l_lti, LTnum, lessthanothers);
1553 vmbreak;
1554 }
1555 vmcase(OP_LE) {
1556 op_order(L, l_lei, LEnum, lessequalothers);
1557 vmbreak;
1558 }
1559 vmcase(OP_EQK) {
1560 TValue *rb = KB(i);
1561 /* basic types do not use '__eq'; we can use raw equality */
1562 int cond = luaV_rawequalobj(s2v(ra), rb);
1563 docondjump();
1564 vmbreak;
1565 }
1566 vmcase(OP_EQI) {
1567 int cond;
1568 int im = GETARG_sB(i);
1569 if (ttisinteger(s2v(ra)))
1570 cond = (ivalue(s2v(ra)) == im);
1571 else if (ttisfloat(s2v(ra)))
1572 cond = luai_numeq(fltvalue(s2v(ra)), cast_num(im));
1573 else
1574 cond = 0; /* other types cannot be equal to a number */
1575 docondjump();
1576 vmbreak;
1577 }
1578 vmcase(OP_LTI) {
1579 op_orderI(L, l_lti, luai_numlt, 0, TM_LT);
1580 vmbreak;
1581 }
1582 vmcase(OP_LEI) {
1583 op_orderI(L, l_lei, luai_numle, 0, TM_LE);
1584 vmbreak;
1585 }
1586 vmcase(OP_GTI) {
1587 op_orderI(L, l_gti, luai_numgt, 1, TM_LT);
1588 vmbreak;
1589 }
1590 vmcase(OP_GEI) {
1591 op_orderI(L, l_gei, luai_numge, 1, TM_LE);
1592 vmbreak;
1593 }
1594 vmcase(OP_TEST) {
1595 int cond = !l_isfalse(s2v(ra));
1596 docondjump();
1597 vmbreak;
1598 }
1599 vmcase(OP_TESTSET) {
1600 TValue *rb = vRB(i);
1601 if (l_isfalse(rb) == GETARG_k(i))
1602 pc++;
1603 else {
1604 setobj2s(L, ra, rb);
1605 donextjump(ci);
1606 }
1607 vmbreak;
1608 }
1609 vmcase(OP_CALL) {
1610 int b = GETARG_B(i);
1611 int nresults = GETARG_C(i) - 1;
1612 if (b != 0) /* fixed number of arguments? */
1613 L->top = ra + b; /* top signals number of arguments */
1614 /* else previous instruction set top */
1615 ProtectNT(luaD_call(L, ra, nresults));
1616 vmbreak;
1617 }
1618 vmcase(OP_TAILCALL) {
1619 int b = GETARG_B(i); /* number of arguments + 1 (function) */
1620 int nparams1 = GETARG_C(i);
1621 /* delat is virtual 'func' - real 'func' (vararg functions) */
1622 int delta = (nparams1) ? ci->u.l.nextraargs + nparams1 : 0;
1623 if (b != 0)
1624 L->top = ra + b;
1625 else /* previous instruction set top */
1626 b = cast_int(L->top - ra);
1627 savepc(ci); /* some calls here can raise errors */
1628 if (TESTARG_k(i)) {
1629 /* close upvalues from current call; the compiler ensures
1630 that there are no to-be-closed variables here, so this
1631 call cannot change the stack */
1632 luaF_close(L, base, NOCLOSINGMETH);
1633 lua_assert(base == ci->func + 1);
1634 }
1635 while (!ttisfunction(s2v(ra))) { /* not a function? */
1636 luaD_tryfuncTM(L, ra); /* try '__call' metamethod */
1637 b++; /* there is now one extra argument */
1638 checkstackp(L, 1, ra);
1639 }
1640 if (!ttisLclosure(s2v(ra))) { /* C function? */
1641 luaD_call(L, ra, LUA_MULTRET); /* call it */
1642 updatetrap(ci);
1643 updatestack(ci); /* stack may have been relocated */
1644 ci->func -= delta;
1645 luaD_poscall(L, ci, cast_int(L->top - ra));
1646 return;
1647 }
1648 ci->func -= delta;
1649 luaD_pretailcall(L, ci, ra, b); /* prepare call frame */
1650 goto tailcall;
1651 }
1652 vmcase(OP_RETURN) {
1653 int n = GETARG_B(i) - 1; /* number of results */
1654 int nparams1 = GETARG_C(i);
1655 if (n < 0) /* not fixed? */
1656 n = cast_int(L->top - ra); /* get what is available */
1657 savepc(ci);
1658 if (TESTARG_k(i)) { /* may there be open upvalues? */
1659 if (L->top < ci->top)
1660 L->top = ci->top;
1661 luaF_close(L, base, LUA_OK);
1662 updatetrap(ci);
1663 updatestack(ci);
1664 }
1665 if (nparams1) /* vararg function? */
1666 ci->func -= ci->u.l.nextraargs + nparams1;
1667 L->top = ra + n; /* set call for 'luaD_poscall' */
1668 luaD_poscall(L, ci, n);
1669 return;
1670 }
1671 vmcase(OP_RETURN0) {
1672 if (L->hookmask) {
1673 L->top = ra;
1674 halfProtectNT(luaD_poscall(L, ci, 0)); /* no hurry... */
1675 }
1676 else { /* do the 'poscall' here */
1677 int nres = ci->nresults;
1678 L->ci = ci->previous; /* back to caller */
1679 L->top = base - 1;
1680 while (nres-- > 0)
1681 setnilvalue(s2v(L->top++)); /* all results are nil */
1682 }
1683 return;
1684 }
1685 vmcase(OP_RETURN1) {
1686 if (L->hookmask) {
1687 L->top = ra + 1;
1688 halfProtectNT(luaD_poscall(L, ci, 1)); /* no hurry... */
1689 }
1690 else { /* do the 'poscall' here */
1691 int nres = ci->nresults;
1692 L->ci = ci->previous; /* back to caller */
1693 if (nres == 0)
1694 L->top = base - 1; /* asked for no results */
1695 else {
1696 setobjs2s(L, base - 1, ra); /* at least this result */
1697 L->top = base;
1698 while (--nres > 0) /* complete missing results */
1699 setnilvalue(s2v(L->top++));
1700 }
1701 }
1702 return;
1703 }
1704 vmcase(OP_FORLOOP) {
1705 if (ttisinteger(s2v(ra + 2))) { /* integer loop? */
1706 lua_Unsigned count = l_castS2U(ivalue(s2v(ra + 1)));
1707 if (count > 0) { /* still more iterations? */
1708 lua_Integer step = ivalue(s2v(ra + 2));
1709 lua_Integer idx = ivalue(s2v(ra)); /* internal index */
1710 chgivalue(s2v(ra + 1), count - 1); /* update counter */
1711 idx = intop(+, idx, step); /* add step to index */
1712 chgivalue(s2v(ra), idx); /* update internal index */
1713 setivalue(s2v(ra + 3), idx); /* and control variable */
1714 pc -= GETARG_Bx(i); /* jump back */
1715 }
1716 }
1717 else if (floatforloop(ra)) /* float loop */
1718 pc -= GETARG_Bx(i); /* jump back */
1719 updatetrap(ci); /* allows a signal to break the loop */
1720 vmbreak;
1721 }
1722 vmcase(OP_FORPREP) {
1723 savestate(L, ci); /* in case of errors */
1724 if (forprep(L, ra))
1725 pc += GETARG_Bx(i) + 1; /* skip the loop */
1726 vmbreak;
1727 }
1728 vmcase(OP_TFORPREP) {
1729 /* create to-be-closed upvalue (if needed) */
1730 halfProtect(luaF_newtbcupval(L, ra + 3));
1731 pc += GETARG_Bx(i);
1732 i = *(pc++); /* go to next instruction */
1733 lua_assert(GET_OPCODE(i) == OP_TFORCALL && ra == RA(i));
1734 goto l_tforcall;
1735 }
1736 vmcase(OP_TFORCALL) {
1737 l_tforcall:
1738 /* 'ra' has the iterator function, 'ra + 1' has the state,
1739 'ra + 2' has the control variable, and 'ra + 3' has the
1740 to-be-closed variable. The call will use the stack after
1741 these values (starting at 'ra + 4')
1742 */
1743 /* push function, state, and control variable */
1744 memcpy(ra + 4, ra, 3 * sizeof(*ra));
1745 L->top = ra + 4 + 3;
1746 ProtectNT(luaD_call(L, ra + 4, GETARG_C(i))); /* do the call */
1747 updatestack(ci); /* stack may have changed */
1748 i = *(pc++); /* go to next instruction */
1749 lua_assert(GET_OPCODE(i) == OP_TFORLOOP && ra == RA(i));
1750 goto l_tforloop;
1751 }
1752 vmcase(OP_TFORLOOP) {
1753 l_tforloop:
1754 if (!ttisnil(s2v(ra + 4))) { /* continue loop? */
1755 setobjs2s(L, ra + 2, ra + 4); /* save control variable */
1756 pc -= GETARG_Bx(i); /* jump back */
1757 }
1758 vmbreak;
1759 }
1760 vmcase(OP_SETLIST) {
1761 int n = GETARG_B(i);
1762 unsigned int last = GETARG_C(i);
1763 Table *h = hvalue(s2v(ra));
1764 if (n == 0)
1765 n = cast_int(L->top - ra) - 1; /* get up to the top */
1766 else
1767 L->top = ci->top; /* correct top in case of emergency GC */
1768 last += n;
1769 if (TESTARG_k(i)) {
1770 last += GETARG_Ax(*pc) * (MAXARG_C + 1);
1771 pc++;
1772 }
1773 if (last > luaH_realasize(h)) /* needs more space? */
1774 luaH_resizearray(L, h, last); /* preallocate it at once */
1775 for (; n > 0; n--) {
1776 TValue *val = s2v(ra + n);
1777 setobj2t(L, &h->array[last - 1], val);
1778 last--;
1779 luaC_barrierback(L, obj2gco(h), val);
1780 }
1781 vmbreak;
1782 }
1783 vmcase(OP_CLOSURE) {
1784 Proto *p = cl->p->p[GETARG_Bx(i)];
1785 halfProtect(pushclosure(L, p, cl->upvals, base, ra));
1786 checkGC(L, ra + 1);
1787 vmbreak;
1788 }
1789 vmcase(OP_VARARG) {
1790 int n = GETARG_C(i) - 1; /* required results */
1791 Protect(luaT_getvarargs(L, ci, ra, n));
1792 vmbreak;
1793 }
1794 vmcase(OP_VARARGPREP) {
1795 luaT_adjustvarargs(L, GETARG_A(i), ci, cl->p);
1796 updatetrap(ci);
1797 if (trap) {
1798 luaD_hookcall(L, ci);
1799 L->oldpc = pc + 1; /* next opcode will be seen as a "new" line */
1800 }
1801 updatebase(ci); /* function has new base after adjustment */
1802 vmbreak;
1803 }
1804 vmcase(OP_EXTRAARG) {
1805 lua_assert(0);
1806 vmbreak;
1807 }
1808 }
1809 }
1810}
1811
1812/* }================================================================== */
diff --git a/src/lua/lvm.h b/src/lua/lvm.h
new file mode 100644
index 0000000..2d4ac16
--- /dev/null
+++ b/src/lua/lvm.h
@@ -0,0 +1,134 @@
1/*
2** $Id: lvm.h $
3** Lua virtual machine
4** See Copyright Notice in lua.h
5*/
6
7#ifndef lvm_h
8#define lvm_h
9
10
11#include "ldo.h"
12#include "lobject.h"
13#include "ltm.h"
14
15
16#if !defined(LUA_NOCVTN2S)
17#define cvt2str(o) ttisnumber(o)
18#else
19#define cvt2str(o) 0 /* no conversion from numbers to strings */
20#endif
21
22
23#if !defined(LUA_NOCVTS2N)
24#define cvt2num(o) ttisstring(o)
25#else
26#define cvt2num(o) 0 /* no conversion from strings to numbers */
27#endif
28
29
30/*
31** You can define LUA_FLOORN2I if you want to convert floats to integers
32** by flooring them (instead of raising an error if they are not
33** integral values)
34*/
35#if !defined(LUA_FLOORN2I)
36#define LUA_FLOORN2I F2Ieq
37#endif
38
39
40/*
41** Rounding modes for float->integer coercion
42 */
43typedef enum {
44 F2Ieq, /* no rounding; accepts only integral values */
45 F2Ifloor, /* takes the floor of the number */
46 F2Iceil /* takes the ceil of the number */
47} F2Imod;
48
49
50/* convert an object to a float (including string coercion) */
51#define tonumber(o,n) \
52 (ttisfloat(o) ? (*(n) = fltvalue(o), 1) : luaV_tonumber_(o,n))
53
54
55/* convert an object to a float (without string coercion) */
56#define tonumberns(o,n) \
57 (ttisfloat(o) ? ((n) = fltvalue(o), 1) : \
58 (ttisinteger(o) ? ((n) = cast_num(ivalue(o)), 1) : 0))
59
60
61/* convert an object to an integer (including string coercion) */
62#define tointeger(o,i) \
63 (ttisinteger(o) ? (*(i) = ivalue(o), 1) : luaV_tointeger(o,i,LUA_FLOORN2I))
64
65
66/* convert an object to an integer (without string coercion) */
67#define tointegerns(o,i) \
68 (ttisinteger(o) ? (*(i) = ivalue(o), 1) : luaV_tointegerns(o,i,LUA_FLOORN2I))
69
70
71#define intop(op,v1,v2) l_castU2S(l_castS2U(v1) op l_castS2U(v2))
72
73#define luaV_rawequalobj(t1,t2) luaV_equalobj(NULL,t1,t2)
74
75
76/*
77** fast track for 'gettable': if 't' is a table and 't[k]' is present,
78** return 1 with 'slot' pointing to 't[k]' (position of final result).
79** Otherwise, return 0 (meaning it will have to check metamethod)
80** with 'slot' pointing to an empty 't[k]' (if 't' is a table) or NULL
81** (otherwise). 'f' is the raw get function to use.
82*/
83#define luaV_fastget(L,t,k,slot,f) \
84 (!ttistable(t) \
85 ? (slot = NULL, 0) /* not a table; 'slot' is NULL and result is 0 */ \
86 : (slot = f(hvalue(t), k), /* else, do raw access */ \
87 !isempty(slot))) /* result not empty? */
88
89
90/*
91** Special case of 'luaV_fastget' for integers, inlining the fast case
92** of 'luaH_getint'.
93*/
94#define luaV_fastgeti(L,t,k,slot) \
95 (!ttistable(t) \
96 ? (slot = NULL, 0) /* not a table; 'slot' is NULL and result is 0 */ \
97 : (slot = (l_castS2U(k) - 1u < hvalue(t)->alimit) \
98 ? &hvalue(t)->array[k - 1] : luaH_getint(hvalue(t), k), \
99 !isempty(slot))) /* result not empty? */
100
101
102/*
103** Finish a fast set operation (when fast get succeeds). In that case,
104** 'slot' points to the place to put the value.
105*/
106#define luaV_finishfastset(L,t,slot,v) \
107 { setobj2t(L, cast(TValue *,slot), v); \
108 luaC_barrierback(L, gcvalue(t), v); }
109
110
111
112
113LUAI_FUNC int luaV_equalobj (lua_State *L, const TValue *t1, const TValue *t2);
114LUAI_FUNC int luaV_lessthan (lua_State *L, const TValue *l, const TValue *r);
115LUAI_FUNC int luaV_lessequal (lua_State *L, const TValue *l, const TValue *r);
116LUAI_FUNC int luaV_tonumber_ (const TValue *obj, lua_Number *n);
117LUAI_FUNC int luaV_tointeger (const TValue *obj, lua_Integer *p, F2Imod mode);
118LUAI_FUNC int luaV_tointegerns (const TValue *obj, lua_Integer *p,
119 F2Imod mode);
120LUAI_FUNC int luaV_flttointeger (lua_Number n, lua_Integer *p, F2Imod mode);
121LUAI_FUNC void luaV_finishget (lua_State *L, const TValue *t, TValue *key,
122 StkId val, const TValue *slot);
123LUAI_FUNC void luaV_finishset (lua_State *L, const TValue *t, TValue *key,
124 TValue *val, const TValue *slot);
125LUAI_FUNC void luaV_finishOp (lua_State *L);
126LUAI_FUNC void luaV_execute (lua_State *L, CallInfo *ci);
127LUAI_FUNC void luaV_concat (lua_State *L, int total);
128LUAI_FUNC lua_Integer luaV_idiv (lua_State *L, lua_Integer x, lua_Integer y);
129LUAI_FUNC lua_Integer luaV_mod (lua_State *L, lua_Integer x, lua_Integer y);
130LUAI_FUNC lua_Number luaV_modf (lua_State *L, lua_Number x, lua_Number y);
131LUAI_FUNC lua_Integer luaV_shiftl (lua_Integer x, lua_Integer y);
132LUAI_FUNC void luaV_objlen (lua_State *L, StkId ra, const TValue *rb);
133
134#endif
diff --git a/src/lua/lzio.c b/src/lua/lzio.c
new file mode 100644
index 0000000..cd0a02d
--- /dev/null
+++ b/src/lua/lzio.c
@@ -0,0 +1,68 @@
1/*
2** $Id: lzio.c $
3** Buffered streams
4** See Copyright Notice in lua.h
5*/
6
7#define lzio_c
8#define LUA_CORE
9
10#include "lprefix.h"
11
12
13#include <string.h>
14
15#include "lua.h"
16
17#include "llimits.h"
18#include "lmem.h"
19#include "lstate.h"
20#include "lzio.h"
21
22
23int luaZ_fill (ZIO *z) {
24 size_t size;
25 lua_State *L = z->L;
26 const char *buff;
27 lua_unlock(L);
28 buff = z->reader(L, z->data, &size);
29 lua_lock(L);
30 if (buff == NULL || size == 0)
31 return EOZ;
32 z->n = size - 1; /* discount char being returned */
33 z->p = buff;
34 return cast_uchar(*(z->p++));
35}
36
37
38void luaZ_init (lua_State *L, ZIO *z, lua_Reader reader, void *data) {
39 z->L = L;
40 z->reader = reader;
41 z->data = data;
42 z->n = 0;
43 z->p = NULL;
44}
45
46
47/* --------------------------------------------------------------- read --- */
48size_t luaZ_read (ZIO *z, void *b, size_t n) {
49 while (n) {
50 size_t m;
51 if (z->n == 0) { /* no bytes in buffer? */
52 if (luaZ_fill(z) == EOZ) /* try to read more */
53 return n; /* no more input; return number of missing bytes */
54 else {
55 z->n++; /* luaZ_fill consumed first byte; put it back */
56 z->p--;
57 }
58 }
59 m = (n <= z->n) ? n : z->n; /* min. between n and z->n */
60 memcpy(b, z->p, m);
61 z->n -= m;
62 z->p += m;
63 b = (char *)b + m;
64 n -= m;
65 }
66 return 0;
67}
68
diff --git a/src/lua/lzio.h b/src/lua/lzio.h
new file mode 100644
index 0000000..38f397f
--- /dev/null
+++ b/src/lua/lzio.h
@@ -0,0 +1,66 @@
1/*
2** $Id: lzio.h $
3** Buffered streams
4** See Copyright Notice in lua.h
5*/
6
7
8#ifndef lzio_h
9#define lzio_h
10
11#include "lua.h"
12
13#include "lmem.h"
14
15
16#define EOZ (-1) /* end of stream */
17
18typedef struct Zio ZIO;
19
20#define zgetc(z) (((z)->n--)>0 ? cast_uchar(*(z)->p++) : luaZ_fill(z))
21
22
23typedef struct Mbuffer {
24 char *buffer;
25 size_t n;
26 size_t buffsize;
27} Mbuffer;
28
29#define luaZ_initbuffer(L, buff) ((buff)->buffer = NULL, (buff)->buffsize = 0)
30
31#define luaZ_buffer(buff) ((buff)->buffer)
32#define luaZ_sizebuffer(buff) ((buff)->buffsize)
33#define luaZ_bufflen(buff) ((buff)->n)
34
35#define luaZ_buffremove(buff,i) ((buff)->n -= (i))
36#define luaZ_resetbuffer(buff) ((buff)->n = 0)
37
38
39#define luaZ_resizebuffer(L, buff, size) \
40 ((buff)->buffer = luaM_reallocvchar(L, (buff)->buffer, \
41 (buff)->buffsize, size), \
42 (buff)->buffsize = size)
43
44#define luaZ_freebuffer(L, buff) luaZ_resizebuffer(L, buff, 0)
45
46
47LUAI_FUNC void luaZ_init (lua_State *L, ZIO *z, lua_Reader reader,
48 void *data);
49LUAI_FUNC size_t luaZ_read (ZIO* z, void *b, size_t n); /* read next n bytes */
50
51
52
53/* --------- Private Part ------------------ */
54
55struct Zio {
56 size_t n; /* bytes still unread */
57 const char *p; /* current position in buffer */
58 lua_Reader reader; /* reader function */
59 void *data; /* additional data */
60 lua_State *L; /* Lua state (for reader) */
61};
62
63
64LUAI_FUNC int luaZ_fill (ZIO *z);
65
66#endif
diff --git a/src/lua/makefile b/src/lua/makefile
new file mode 100644
index 0000000..397c817
--- /dev/null
+++ b/src/lua/makefile
@@ -0,0 +1,176 @@
1# makefile for building Lua
2# see INSTALL for installation instructions
3# see ../Makefile and luaconf.h for further customization
4
5# == CHANGE THE SETTINGS BELOW TO SUIT YOUR ENVIRONMENT =======================
6
7# Warnings valid for both C and C++
8CWARNSCPP= \
9 -pedantic \
10 -Wextra \
11 -Wshadow \
12 -Wsign-compare \
13 -Wundef \
14 -Wwrite-strings \
15 -Wredundant-decls \
16 -Wdisabled-optimization \
17 -Waggregate-return \
18 -Wdouble-promotion \
19 #-Wno-aggressive-loop-optimizations # not accepted by clang \
20 #-Wlogical-op # not accepted by clang \
21 # the next warnings generate too much noise, so they are disabled
22 # -Wconversion -Wno-sign-conversion \
23 # -Wsign-conversion \
24 # -Wconversion \
25 # -Wstrict-overflow=2 \
26 # -Wformat=2 \
27 # -Wcast-qual \
28
29# The next warnings are neither valid nor needed for C++
30CWARNSC= -Wdeclaration-after-statement \
31 -Wmissing-prototypes \
32 -Wnested-externs \
33 -Wstrict-prototypes \
34 -Wc++-compat \
35 -Wold-style-definition \
36
37
38CWARNS= $(CWARNSCPP) $(CWARNSC)
39
40# -mtune=native -fomit-frame-pointer
41# -fno-stack-protector
42LOCAL = $(TESTS) $(CWARNS) -g
43
44
45
46# enable Linux goodies
47MYCFLAGS= $(LOCAL) -std=c99
48MYLDFLAGS= $(LOCAL) -Wl
49MYLIBS= -ldl -lreadline
50
51
52CC= gcc
53CFLAGS= -Wall -O2 $(MYCFLAGS)
54AR= ar rc
55RANLIB= ranlib
56RM= rm -f
57
58
59
60# == END OF USER SETTINGS. NO NEED TO CHANGE ANYTHING BELOW THIS LINE =========
61
62
63LIBS = -lm
64
65CORE_T= liblua.a
66CORE_O= lapi.o lcode.o lctype.o ldebug.o ldo.o ldump.o lfunc.o lgc.o llex.o \
67 lmem.o lobject.o lopcodes.o lparser.o lstate.o lstring.o ltable.o \
68 ltm.o lundump.o lvm.o lzio.o
69AUX_O= lauxlib.o
70LIB_O= lbaselib.o ldblib.o liolib.o lmathlib.o loslib.o ltablib.o lstrlib.o \
71 lutf8lib.o loadlib.o lcorolib.o linit.o
72
73ALL_T= $(CORE_T)
74ALL_O= $(CORE_O) $(AUX_O) $(LIB_O)
75ALL_A= $(CORE_T)
76
77all: $(ALL_T)
78
79o: $(ALL_O)
80
81a: $(ALL_A)
82
83$(CORE_T): $(CORE_O) $(AUX_O) $(LIB_O)
84 $(AR) $@ $?
85 $(RANLIB) $@
86
87$(LUA_T): $(LUA_O) $(CORE_T)
88 $(CC) -o $@ $(MYLDFLAGS) $(LUA_O) $(CORE_T) $(LIBS) $(MYLIBS) $(DL)
89
90$(LUAC_T): $(LUAC_O) $(CORE_T)
91 $(CC) -o $@ $(MYLDFLAGS) $(LUAC_O) $(CORE_T) $(LIBS) $(MYLIBS)
92
93clean:
94 $(RM) $(ALL_T) $(ALL_O)
95
96depend:
97 @$(CC) $(CFLAGS) -MM *.c
98
99echo:
100 @echo "CC = $(CC)"
101 @echo "CFLAGS = $(CFLAGS)"
102 @echo "AR = $(AR)"
103 @echo "RANLIB = $(RANLIB)"
104 @echo "RM = $(RM)"
105 @echo "MYCFLAGS = $(MYCFLAGS)"
106 @echo "MYLDFLAGS = $(MYLDFLAGS)"
107 @echo "MYLIBS = $(MYLIBS)"
108 @echo "DL = $(DL)"
109
110$(ALL_O): makefile
111
112# DO NOT EDIT
113# automatically made with 'gcc -MM l*.c'
114
115lapi.o: lapi.c lprefix.h lua.h luaconf.h lapi.h llimits.h lstate.h \
116 lobject.h ltm.h lzio.h lmem.h ldebug.h ldo.h lfunc.h lgc.h lstring.h \
117 ltable.h lundump.h lvm.h
118lauxlib.o: lauxlib.c lprefix.h lua.h luaconf.h lauxlib.h
119lbaselib.o: lbaselib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
120lcode.o: lcode.c lprefix.h lua.h luaconf.h lcode.h llex.h lobject.h \
121 llimits.h lzio.h lmem.h lopcodes.h lparser.h ldebug.h lstate.h ltm.h \
122 ldo.h lgc.h lstring.h ltable.h lvm.h
123lcorolib.o: lcorolib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
124lctype.o: lctype.c lprefix.h lctype.h lua.h luaconf.h llimits.h
125ldblib.o: ldblib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
126ldebug.o: ldebug.c lprefix.h lua.h luaconf.h lapi.h llimits.h lstate.h \
127 lobject.h ltm.h lzio.h lmem.h lcode.h llex.h lopcodes.h lparser.h \
128 ldebug.h ldo.h lfunc.h lstring.h lgc.h ltable.h lvm.h
129ldo.o: ldo.c lprefix.h lua.h luaconf.h lapi.h llimits.h lstate.h \
130 lobject.h ltm.h lzio.h lmem.h ldebug.h ldo.h lfunc.h lgc.h lopcodes.h \
131 lparser.h lstring.h ltable.h lundump.h lvm.h
132ldump.o: ldump.c lprefix.h lua.h luaconf.h lobject.h llimits.h lstate.h \
133 ltm.h lzio.h lmem.h lundump.h
134lfunc.o: lfunc.c lprefix.h lua.h luaconf.h lfunc.h lobject.h llimits.h \
135 lgc.h lstate.h ltm.h lzio.h lmem.h
136lgc.o: lgc.c lprefix.h lua.h luaconf.h ldebug.h lstate.h lobject.h \
137 llimits.h ltm.h lzio.h lmem.h ldo.h lfunc.h lgc.h lstring.h ltable.h
138linit.o: linit.c lprefix.h lua.h luaconf.h lualib.h lauxlib.h
139liolib.o: liolib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
140llex.o: llex.c lprefix.h lua.h luaconf.h lctype.h llimits.h ldebug.h \
141 lstate.h lobject.h ltm.h lzio.h lmem.h ldo.h lgc.h llex.h lparser.h \
142 lstring.h ltable.h
143lmathlib.o: lmathlib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
144lmem.o: lmem.c lprefix.h lua.h luaconf.h ldebug.h lstate.h lobject.h \
145 llimits.h ltm.h lzio.h lmem.h ldo.h lgc.h
146loadlib.o: loadlib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
147lobject.o: lobject.c lprefix.h lua.h luaconf.h lctype.h llimits.h \
148 ldebug.h lstate.h lobject.h ltm.h lzio.h lmem.h ldo.h lstring.h lgc.h \
149 lvm.h
150lopcodes.o: lopcodes.c lprefix.h lopcodes.h llimits.h lua.h luaconf.h
151loslib.o: loslib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
152lparser.o: lparser.c lprefix.h lua.h luaconf.h lcode.h llex.h lobject.h \
153 llimits.h lzio.h lmem.h lopcodes.h lparser.h ldebug.h lstate.h ltm.h \
154 ldo.h lfunc.h lstring.h lgc.h ltable.h
155lstate.o: lstate.c lprefix.h lua.h luaconf.h lapi.h llimits.h lstate.h \
156 lobject.h ltm.h lzio.h lmem.h ldebug.h ldo.h lfunc.h lgc.h llex.h \
157 lstring.h ltable.h
158lstring.o: lstring.c lprefix.h lua.h luaconf.h ldebug.h lstate.h \
159 lobject.h llimits.h ltm.h lzio.h lmem.h ldo.h lstring.h lgc.h
160lstrlib.o: lstrlib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
161ltable.o: ltable.c lprefix.h lua.h luaconf.h ldebug.h lstate.h lobject.h \
162 llimits.h ltm.h lzio.h lmem.h ldo.h lgc.h lstring.h ltable.h lvm.h
163ltablib.o: ltablib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
164ltm.o: ltm.c lprefix.h lua.h luaconf.h ldebug.h lstate.h lobject.h \
165 llimits.h ltm.h lzio.h lmem.h ldo.h lstring.h lgc.h ltable.h lvm.h
166lundump.o: lundump.c lprefix.h lua.h luaconf.h ldebug.h lstate.h \
167 lobject.h llimits.h ltm.h lzio.h lmem.h ldo.h lfunc.h lstring.h lgc.h \
168 lundump.h
169lutf8lib.o: lutf8lib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
170lvm.o: lvm.c lprefix.h lua.h luaconf.h ldebug.h lstate.h lobject.h \
171 llimits.h ltm.h lzio.h lmem.h ldo.h lfunc.h lgc.h lopcodes.h lstring.h \
172 ltable.h lvm.h
173lzio.o: lzio.c lprefix.h lua.h luaconf.h llimits.h lmem.h lstate.h \
174 lobject.h ltm.h lzio.h
175
176# (end of Makefile)