aboutsummaryrefslogtreecommitdiff
path: root/src/lua
diff options
context:
space:
mode:
Diffstat (limited to 'src/lua')
-rw-r--r--src/lua/lapi.c1455
-rw-r--r--src/lua/lapi.h49
-rw-r--r--src/lua/lauxlib.c1105
-rw-r--r--src/lua/lauxlib.h293
-rw-r--r--src/lua/lbaselib.c528
-rw-r--r--src/lua/lcode.c1814
-rw-r--r--src/lua/lcode.h104
-rw-r--r--src/lua/lcorolib.c210
-rw-r--r--src/lua/lctype.c64
-rw-r--r--src/lua/lctype.h101
-rw-r--r--src/lua/ldblib.c483
-rw-r--r--src/lua/ldebug.c877
-rw-r--r--src/lua/ldebug.h63
-rw-r--r--src/lua/ldo.c963
-rw-r--r--src/lua/ldo.h79
-rw-r--r--src/lua/ldump.c226
-rw-r--r--src/lua/lfunc.c294
-rw-r--r--src/lua/lfunc.h64
-rw-r--r--src/lua/lgc.c1728
-rw-r--r--src/lua/lgc.h189
-rw-r--r--src/lua/linit.c65
-rw-r--r--src/lua/liolib.c828
-rw-r--r--src/lua/ljumptab.h112
-rw-r--r--src/lua/llex.c581
-rw-r--r--src/lua/llex.h91
-rw-r--r--src/lua/llimits.h353
-rw-r--r--src/lua/lmathlib.c764
-rw-r--r--src/lua/lmem.c201
-rw-r--r--src/lua/lmem.h93
-rw-r--r--src/lua/loadlib.c762
-rw-r--r--src/lua/lobject.c592
-rw-r--r--src/lua/lobject.h800
-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.c1956
-rw-r--r--src/lua/lparser.h171
-rw-r--r--src/lua/lprefix.h45
-rw-r--r--src/lua/lstate.c439
-rw-r--r--src/lua/lstate.h404
-rw-r--r--src/lua/lstring.c273
-rw-r--r--src/lua/lstring.h57
-rw-r--r--src/lua/lstrlib.c1817
-rw-r--r--src/lua/ltable.c971
-rw-r--r--src/lua/ltable.h66
-rw-r--r--src/lua/ltablib.c429
-rw-r--r--src/lua/ltm.c271
-rw-r--r--src/lua/ltm.h103
-rw-r--r--src/lua/lua.c659
-rw-r--r--src/lua/lua.h518
-rw-r--r--src/lua/lua.hpp9
-rw-r--r--src/lua/luac.c724
-rw-r--r--src/lua/luaconf.h790
-rw-r--r--src/lua/lualib.h52
-rw-r--r--src/lua/lundump.c333
-rw-r--r--src/lua/lundump.h36
-rw-r--r--src/lua/lutf8lib.c289
-rw-r--r--src/lua/lvm.c1836
-rw-r--r--src/lua/lvm.h136
-rw-r--r--src/lua/lzio.c68
-rw-r--r--src/lua/lzio.h66
-rw-r--r--src/lua/makefile222
63 files changed, 0 insertions, 29700 deletions
diff --git a/src/lua/lapi.c b/src/lua/lapi.c
deleted file mode 100644
index f8f70cd..0000000
--- a/src/lua/lapi.c
+++ /dev/null
@@ -1,1455 +0,0 @@
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 (one that is not the 'nilvalue').
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]
78 : &G(L)->nilvalue;
79 }
80 }
81}
82
83
84static StkId index2stack (lua_State *L, int idx) {
85 CallInfo *ci = L->ci;
86 if (idx > 0) {
87 StkId o = ci->func + idx;
88 api_check(L, o < L->top, "unacceptable index");
89 return o;
90 }
91 else { /* non-positive index */
92 api_check(L, idx != 0 && -idx <= L->top - (ci->func + 1), "invalid index");
93 api_check(L, !ispseudo(idx), "invalid index");
94 return L->top + idx;
95 }
96}
97
98
99LUA_API int lua_checkstack (lua_State *L, int n) {
100 int res;
101 CallInfo *ci;
102 lua_lock(L);
103 ci = L->ci;
104 api_check(L, n >= 0, "negative 'n'");
105 if (L->stack_last - L->top > n) /* stack large enough? */
106 res = 1; /* yes; check is OK */
107 else { /* no; need to grow stack */
108 int inuse = cast_int(L->top - L->stack) + EXTRA_STACK;
109 if (inuse > LUAI_MAXSTACK - n) /* can grow without overflow? */
110 res = 0; /* no */
111 else /* try to grow stack */
112 res = luaD_growstack(L, n, 0);
113 }
114 if (res && ci->top < L->top + n)
115 ci->top = L->top + n; /* adjust frame top */
116 lua_unlock(L);
117 return res;
118}
119
120
121LUA_API void lua_xmove (lua_State *from, lua_State *to, int n) {
122 int i;
123 if (from == to) return;
124 lua_lock(to);
125 api_checknelems(from, n);
126 api_check(from, G(from) == G(to), "moving among independent states");
127 api_check(from, to->ci->top - to->top >= n, "stack overflow");
128 from->top -= n;
129 for (i = 0; i < n; i++) {
130 setobjs2s(to, to->top, from->top + i);
131 to->top++; /* stack already checked by previous 'api_check' */
132 }
133 lua_unlock(to);
134}
135
136
137LUA_API lua_CFunction lua_atpanic (lua_State *L, lua_CFunction panicf) {
138 lua_CFunction old;
139 lua_lock(L);
140 old = G(L)->panic;
141 G(L)->panic = panicf;
142 lua_unlock(L);
143 return old;
144}
145
146
147LUA_API lua_Number lua_version (lua_State *L) {
148 UNUSED(L);
149 return LUA_VERSION_NUM;
150}
151
152
153
154/*
155** basic stack manipulation
156*/
157
158
159/*
160** convert an acceptable stack index into an absolute index
161*/
162LUA_API int lua_absindex (lua_State *L, int idx) {
163 return (idx > 0 || ispseudo(idx))
164 ? idx
165 : cast_int(L->top - L->ci->func) + idx;
166}
167
168
169LUA_API int lua_gettop (lua_State *L) {
170 return cast_int(L->top - (L->ci->func + 1));
171}
172
173
174LUA_API void lua_settop (lua_State *L, int idx) {
175 CallInfo *ci;
176 StkId func, newtop;
177 ptrdiff_t diff; /* difference for new top */
178 lua_lock(L);
179 ci = L->ci;
180 func = ci->func;
181 if (idx >= 0) {
182 api_check(L, idx <= ci->top - (func + 1), "new top too large");
183 diff = ((func + 1) + idx) - L->top;
184 for (; diff > 0; diff--)
185 setnilvalue(s2v(L->top++)); /* clear new slots */
186 }
187 else {
188 api_check(L, -(idx+1) <= (L->top - (func + 1)), "invalid new top");
189 diff = idx + 1; /* will "subtract" index (as it is negative) */
190 }
191 api_check(L, L->tbclist < L->top, "previous pop of an unclosed slot");
192 newtop = L->top + diff;
193 if (diff < 0 && L->tbclist >= newtop) {
194 lua_assert(hastocloseCfunc(ci->nresults));
195 luaF_close(L, newtop, CLOSEKTOP, 0);
196 }
197 L->top = newtop; /* correct top only after closing any upvalue */
198 lua_unlock(L);
199}
200
201
202LUA_API void lua_closeslot (lua_State *L, int idx) {
203 StkId level;
204 lua_lock(L);
205 level = index2stack(L, idx);
206 api_check(L, hastocloseCfunc(L->ci->nresults) && L->tbclist == level,
207 "no variable to close at given level");
208 luaF_close(L, level, CLOSEKTOP, 0);
209 level = index2stack(L, idx); /* stack may be moved */
210 setnilvalue(s2v(level));
211 lua_unlock(L);
212}
213
214
215/*
216** Reverse the stack segment from 'from' to 'to'
217** (auxiliary to 'lua_rotate')
218** Note that we move(copy) only the value inside the stack.
219** (We do not move additional fields that may exist.)
220*/
221static void reverse (lua_State *L, StkId from, StkId to) {
222 for (; from < to; from++, to--) {
223 TValue temp;
224 setobj(L, &temp, s2v(from));
225 setobjs2s(L, from, to);
226 setobj2s(L, to, &temp);
227 }
228}
229
230
231/*
232** Let x = AB, where A is a prefix of length 'n'. Then,
233** rotate x n == BA. But BA == (A^r . B^r)^r.
234*/
235LUA_API void lua_rotate (lua_State *L, int idx, int n) {
236 StkId p, t, m;
237 lua_lock(L);
238 t = L->top - 1; /* end of stack segment being rotated */
239 p = index2stack(L, idx); /* start of segment */
240 api_check(L, (n >= 0 ? n : -n) <= (t - p + 1), "invalid 'n'");
241 m = (n >= 0 ? t - n : p - n - 1); /* end of prefix */
242 reverse(L, p, m); /* reverse the prefix with length 'n' */
243 reverse(L, m + 1, t); /* reverse the suffix */
244 reverse(L, p, t); /* reverse the entire segment */
245 lua_unlock(L);
246}
247
248
249LUA_API void lua_copy (lua_State *L, int fromidx, int toidx) {
250 TValue *fr, *to;
251 lua_lock(L);
252 fr = index2value(L, fromidx);
253 to = index2value(L, toidx);
254 api_check(L, isvalid(L, to), "invalid index");
255 setobj(L, to, fr);
256 if (isupvalue(toidx)) /* function upvalue? */
257 luaC_barrier(L, clCvalue(s2v(L->ci->func)), fr);
258 /* LUA_REGISTRYINDEX does not need gc barrier
259 (collector revisits it before finishing collection) */
260 lua_unlock(L);
261}
262
263
264LUA_API void lua_pushvalue (lua_State *L, int idx) {
265 lua_lock(L);
266 setobj2s(L, L->top, index2value(L, idx));
267 api_incr_top(L);
268 lua_unlock(L);
269}
270
271
272
273/*
274** access functions (stack -> C)
275*/
276
277
278LUA_API int lua_type (lua_State *L, int idx) {
279 const TValue *o = index2value(L, idx);
280 return (isvalid(L, o) ? ttype(o) : LUA_TNONE);
281}
282
283
284LUA_API const char *lua_typename (lua_State *L, int t) {
285 UNUSED(L);
286 api_check(L, LUA_TNONE <= t && t < LUA_NUMTYPES, "invalid type");
287 return ttypename(t);
288}
289
290
291LUA_API int lua_iscfunction (lua_State *L, int idx) {
292 const TValue *o = index2value(L, idx);
293 return (ttislcf(o) || (ttisCclosure(o)));
294}
295
296
297LUA_API int lua_isinteger (lua_State *L, int idx) {
298 const TValue *o = index2value(L, idx);
299 return ttisinteger(o);
300}
301
302
303LUA_API int lua_isnumber (lua_State *L, int idx) {
304 lua_Number n;
305 const TValue *o = index2value(L, idx);
306 return tonumber(o, &n);
307}
308
309
310LUA_API int lua_isstring (lua_State *L, int idx) {
311 const TValue *o = index2value(L, idx);
312 return (ttisstring(o) || cvt2str(o));
313}
314
315
316LUA_API int lua_isuserdata (lua_State *L, int idx) {
317 const TValue *o = index2value(L, idx);
318 return (ttisfulluserdata(o) || ttislightuserdata(o));
319}
320
321
322LUA_API int lua_rawequal (lua_State *L, int index1, int index2) {
323 const TValue *o1 = index2value(L, index1);
324 const TValue *o2 = index2value(L, index2);
325 return (isvalid(L, o1) && isvalid(L, o2)) ? luaV_rawequalobj(o1, o2) : 0;
326}
327
328
329LUA_API void lua_arith (lua_State *L, int op) {
330 lua_lock(L);
331 if (op != LUA_OPUNM && op != LUA_OPBNOT)
332 api_checknelems(L, 2); /* all other operations expect two operands */
333 else { /* for unary operations, add fake 2nd operand */
334 api_checknelems(L, 1);
335 setobjs2s(L, L->top, L->top - 1);
336 api_incr_top(L);
337 }
338 /* first operand at top - 2, second at top - 1; result go to top - 2 */
339 luaO_arith(L, op, s2v(L->top - 2), s2v(L->top - 1), L->top - 2);
340 L->top--; /* remove second operand */
341 lua_unlock(L);
342}
343
344
345LUA_API int lua_compare (lua_State *L, int index1, int index2, int op) {
346 const TValue *o1;
347 const TValue *o2;
348 int i = 0;
349 lua_lock(L); /* may call tag method */
350 o1 = index2value(L, index1);
351 o2 = index2value(L, index2);
352 if (isvalid(L, o1) && isvalid(L, o2)) {
353 switch (op) {
354 case LUA_OPEQ: i = luaV_equalobj(L, o1, o2); break;
355 case LUA_OPLT: i = luaV_lessthan(L, o1, o2); break;
356 case LUA_OPLE: i = luaV_lessequal(L, o1, o2); break;
357 default: api_check(L, 0, "invalid option");
358 }
359 }
360 lua_unlock(L);
361 return i;
362}
363
364
365LUA_API size_t lua_stringtonumber (lua_State *L, const char *s) {
366 size_t sz = luaO_str2num(s, s2v(L->top));
367 if (sz != 0)
368 api_incr_top(L);
369 return sz;
370}
371
372
373LUA_API lua_Number lua_tonumberx (lua_State *L, int idx, int *pisnum) {
374 lua_Number n = 0;
375 const TValue *o = index2value(L, idx);
376 int isnum = tonumber(o, &n);
377 if (pisnum)
378 *pisnum = isnum;
379 return n;
380}
381
382
383LUA_API lua_Integer lua_tointegerx (lua_State *L, int idx, int *pisnum) {
384 lua_Integer res = 0;
385 const TValue *o = index2value(L, idx);
386 int isnum = tointeger(o, &res);
387 if (pisnum)
388 *pisnum = isnum;
389 return res;
390}
391
392
393LUA_API int lua_toboolean (lua_State *L, int idx) {
394 const TValue *o = index2value(L, idx);
395 return !l_isfalse(o);
396}
397
398
399LUA_API const char *lua_tolstring (lua_State *L, int idx, size_t *len) {
400 TValue *o;
401 lua_lock(L);
402 o = index2value(L, idx);
403 if (!ttisstring(o)) {
404 if (!cvt2str(o)) { /* not convertible? */
405 if (len != NULL) *len = 0;
406 lua_unlock(L);
407 return NULL;
408 }
409 luaO_tostring(L, o);
410 luaC_checkGC(L);
411 o = index2value(L, idx); /* previous call may reallocate the stack */
412 }
413 if (len != NULL)
414 *len = vslen(o);
415 lua_unlock(L);
416 return svalue(o);
417}
418
419
420LUA_API lua_Unsigned lua_rawlen (lua_State *L, int idx) {
421 const TValue *o = index2value(L, idx);
422 switch (ttypetag(o)) {
423 case LUA_VSHRSTR: return tsvalue(o)->shrlen;
424 case LUA_VLNGSTR: return tsvalue(o)->u.lnglen;
425 case LUA_VUSERDATA: return uvalue(o)->len;
426 case LUA_VTABLE: return luaH_getn(hvalue(o));
427 default: return 0;
428 }
429}
430
431
432LUA_API lua_CFunction lua_tocfunction (lua_State *L, int idx) {
433 const TValue *o = index2value(L, idx);
434 if (ttislcf(o)) return fvalue(o);
435 else if (ttisCclosure(o))
436 return clCvalue(o)->f;
437 else return NULL; /* not a C function */
438}
439
440
441static void *touserdata (const TValue *o) {
442 switch (ttype(o)) {
443 case LUA_TUSERDATA: return getudatamem(uvalue(o));
444 case LUA_TLIGHTUSERDATA: return pvalue(o);
445 default: return NULL;
446 }
447}
448
449
450LUA_API void *lua_touserdata (lua_State *L, int idx) {
451 const TValue *o = index2value(L, idx);
452 return touserdata(o);
453}
454
455
456LUA_API lua_State *lua_tothread (lua_State *L, int idx) {
457 const TValue *o = index2value(L, idx);
458 return (!ttisthread(o)) ? NULL : thvalue(o);
459}
460
461
462/*
463** Returns a pointer to the internal representation of an object.
464** Note that ANSI C does not allow the conversion of a pointer to
465** function to a 'void*', so the conversion here goes through
466** a 'size_t'. (As the returned pointer is only informative, this
467** conversion should not be a problem.)
468*/
469LUA_API const void *lua_topointer (lua_State *L, int idx) {
470 const TValue *o = index2value(L, idx);
471 switch (ttypetag(o)) {
472 case LUA_VLCF: return cast_voidp(cast_sizet(fvalue(o)));
473 case LUA_VUSERDATA: case LUA_VLIGHTUSERDATA:
474 return touserdata(o);
475 default: {
476 if (iscollectable(o))
477 return gcvalue(o);
478 else
479 return NULL;
480 }
481 }
482}
483
484
485
486/*
487** push functions (C -> stack)
488*/
489
490
491LUA_API void lua_pushnil (lua_State *L) {
492 lua_lock(L);
493 setnilvalue(s2v(L->top));
494 api_incr_top(L);
495 lua_unlock(L);
496}
497
498
499LUA_API void lua_pushnumber (lua_State *L, lua_Number n) {
500 lua_lock(L);
501 setfltvalue(s2v(L->top), n);
502 api_incr_top(L);
503 lua_unlock(L);
504}
505
506
507LUA_API void lua_pushinteger (lua_State *L, lua_Integer n) {
508 lua_lock(L);
509 setivalue(s2v(L->top), n);
510 api_incr_top(L);
511 lua_unlock(L);
512}
513
514
515/*
516** Pushes on the stack a string with given length. Avoid using 's' when
517** 'len' == 0 (as 's' can be NULL in that case), due to later use of
518** 'memcmp' and 'memcpy'.
519*/
520LUA_API const char *lua_pushlstring (lua_State *L, const char *s, size_t len) {
521 TString *ts;
522 lua_lock(L);
523 ts = (len == 0) ? luaS_new(L, "") : luaS_newlstr(L, s, len);
524 setsvalue2s(L, L->top, ts);
525 api_incr_top(L);
526 luaC_checkGC(L);
527 lua_unlock(L);
528 return getstr(ts);
529}
530
531
532LUA_API const char *lua_pushstring (lua_State *L, const char *s) {
533 lua_lock(L);
534 if (s == NULL)
535 setnilvalue(s2v(L->top));
536 else {
537 TString *ts;
538 ts = luaS_new(L, s);
539 setsvalue2s(L, L->top, ts);
540 s = getstr(ts); /* internal copy's address */
541 }
542 api_incr_top(L);
543 luaC_checkGC(L);
544 lua_unlock(L);
545 return s;
546}
547
548
549LUA_API const char *lua_pushvfstring (lua_State *L, const char *fmt,
550 va_list argp) {
551 const char *ret;
552 lua_lock(L);
553 ret = luaO_pushvfstring(L, fmt, argp);
554 luaC_checkGC(L);
555 lua_unlock(L);
556 return ret;
557}
558
559
560LUA_API const char *lua_pushfstring (lua_State *L, const char *fmt, ...) {
561 const char *ret;
562 va_list argp;
563 lua_lock(L);
564 va_start(argp, fmt);
565 ret = luaO_pushvfstring(L, fmt, argp);
566 va_end(argp);
567 luaC_checkGC(L);
568 lua_unlock(L);
569 return ret;
570}
571
572
573LUA_API void lua_pushcclosure (lua_State *L, lua_CFunction fn, int n) {
574 lua_lock(L);
575 if (n == 0) {
576 setfvalue(s2v(L->top), fn);
577 api_incr_top(L);
578 }
579 else {
580 CClosure *cl;
581 api_checknelems(L, n);
582 api_check(L, n <= MAXUPVAL, "upvalue index too large");
583 cl = luaF_newCclosure(L, n);
584 cl->f = fn;
585 L->top -= n;
586 while (n--) {
587 setobj2n(L, &cl->upvalue[n], s2v(L->top + n));
588 /* does not need barrier because closure is white */
589 lua_assert(iswhite(cl));
590 }
591 setclCvalue(L, s2v(L->top), cl);
592 api_incr_top(L);
593 luaC_checkGC(L);
594 }
595 lua_unlock(L);
596}
597
598
599LUA_API void lua_pushboolean (lua_State *L, int b) {
600 lua_lock(L);
601 if (b)
602 setbtvalue(s2v(L->top));
603 else
604 setbfvalue(s2v(L->top));
605 api_incr_top(L);
606 lua_unlock(L);
607}
608
609
610LUA_API void lua_pushlightuserdata (lua_State *L, void *p) {
611 lua_lock(L);
612 setpvalue(s2v(L->top), p);
613 api_incr_top(L);
614 lua_unlock(L);
615}
616
617
618LUA_API int lua_pushthread (lua_State *L) {
619 lua_lock(L);
620 setthvalue(L, s2v(L->top), L);
621 api_incr_top(L);
622 lua_unlock(L);
623 return (G(L)->mainthread == L);
624}
625
626
627
628/*
629** get functions (Lua -> stack)
630*/
631
632
633static int auxgetstr (lua_State *L, const TValue *t, const char *k) {
634 const TValue *slot;
635 TString *str = luaS_new(L, k);
636 if (luaV_fastget(L, t, str, slot, luaH_getstr)) {
637 setobj2s(L, L->top, slot);
638 api_incr_top(L);
639 }
640 else {
641 setsvalue2s(L, L->top, str);
642 api_incr_top(L);
643 luaV_finishget(L, t, s2v(L->top - 1), L->top - 1, slot);
644 }
645 lua_unlock(L);
646 return ttype(s2v(L->top - 1));
647}
648
649
650/*
651** Get the global table in the registry. Since all predefined
652** indices in the registry were inserted right when the registry
653** was created and never removed, they must always be in the array
654** part of the registry.
655*/
656#define getGtable(L) \
657 (&hvalue(&G(L)->l_registry)->array[LUA_RIDX_GLOBALS - 1])
658
659
660LUA_API int lua_getglobal (lua_State *L, const char *name) {
661 const TValue *G;
662 lua_lock(L);
663 G = getGtable(L);
664 return auxgetstr(L, G, name);
665}
666
667
668LUA_API int lua_gettable (lua_State *L, int idx) {
669 const TValue *slot;
670 TValue *t;
671 lua_lock(L);
672 t = index2value(L, idx);
673 if (luaV_fastget(L, t, s2v(L->top - 1), slot, luaH_get)) {
674 setobj2s(L, L->top - 1, slot);
675 }
676 else
677 luaV_finishget(L, t, s2v(L->top - 1), L->top - 1, slot);
678 lua_unlock(L);
679 return ttype(s2v(L->top - 1));
680}
681
682
683LUA_API int lua_getfield (lua_State *L, int idx, const char *k) {
684 lua_lock(L);
685 return auxgetstr(L, index2value(L, idx), k);
686}
687
688
689LUA_API int lua_geti (lua_State *L, int idx, lua_Integer n) {
690 TValue *t;
691 const TValue *slot;
692 lua_lock(L);
693 t = index2value(L, idx);
694 if (luaV_fastgeti(L, t, n, slot)) {
695 setobj2s(L, L->top, slot);
696 }
697 else {
698 TValue aux;
699 setivalue(&aux, n);
700 luaV_finishget(L, t, &aux, L->top, slot);
701 }
702 api_incr_top(L);
703 lua_unlock(L);
704 return ttype(s2v(L->top - 1));
705}
706
707
708static int finishrawget (lua_State *L, const TValue *val) {
709 if (isempty(val)) /* avoid copying empty items to the stack */
710 setnilvalue(s2v(L->top));
711 else
712 setobj2s(L, L->top, val);
713 api_incr_top(L);
714 lua_unlock(L);
715 return ttype(s2v(L->top - 1));
716}
717
718
719static Table *gettable (lua_State *L, int idx) {
720 TValue *t = index2value(L, idx);
721 api_check(L, ttistable(t), "table expected");
722 return hvalue(t);
723}
724
725
726LUA_API int lua_rawget (lua_State *L, int idx) {
727 Table *t;
728 const TValue *val;
729 lua_lock(L);
730 api_checknelems(L, 1);
731 t = gettable(L, idx);
732 val = luaH_get(t, s2v(L->top - 1));
733 L->top--; /* remove key */
734 return finishrawget(L, val);
735}
736
737
738LUA_API int lua_rawgeti (lua_State *L, int idx, lua_Integer n) {
739 Table *t;
740 lua_lock(L);
741 t = gettable(L, idx);
742 return finishrawget(L, luaH_getint(t, n));
743}
744
745
746LUA_API int lua_rawgetp (lua_State *L, int idx, const void *p) {
747 Table *t;
748 TValue k;
749 lua_lock(L);
750 t = gettable(L, idx);
751 setpvalue(&k, cast_voidp(p));
752 return finishrawget(L, luaH_get(t, &k));
753}
754
755
756LUA_API void lua_createtable (lua_State *L, int narray, int nrec) {
757 Table *t;
758 lua_lock(L);
759 t = luaH_new(L);
760 sethvalue2s(L, L->top, t);
761 api_incr_top(L);
762 if (narray > 0 || nrec > 0)
763 luaH_resize(L, t, narray, nrec);
764 luaC_checkGC(L);
765 lua_unlock(L);
766}
767
768
769LUA_API int lua_getmetatable (lua_State *L, int objindex) {
770 const TValue *obj;
771 Table *mt;
772 int res = 0;
773 lua_lock(L);
774 obj = index2value(L, objindex);
775 switch (ttype(obj)) {
776 case LUA_TTABLE:
777 mt = hvalue(obj)->metatable;
778 break;
779 case LUA_TUSERDATA:
780 mt = uvalue(obj)->metatable;
781 break;
782 default:
783 mt = G(L)->mt[ttype(obj)];
784 break;
785 }
786 if (mt != NULL) {
787 sethvalue2s(L, L->top, mt);
788 api_incr_top(L);
789 res = 1;
790 }
791 lua_unlock(L);
792 return res;
793}
794
795
796LUA_API int lua_getiuservalue (lua_State *L, int idx, int n) {
797 TValue *o;
798 int t;
799 lua_lock(L);
800 o = index2value(L, idx);
801 api_check(L, ttisfulluserdata(o), "full userdata expected");
802 if (n <= 0 || n > uvalue(o)->nuvalue) {
803 setnilvalue(s2v(L->top));
804 t = LUA_TNONE;
805 }
806 else {
807 setobj2s(L, L->top, &uvalue(o)->uv[n - 1].uv);
808 t = ttype(s2v(L->top));
809 }
810 api_incr_top(L);
811 lua_unlock(L);
812 return t;
813}
814
815
816/*
817** set functions (stack -> Lua)
818*/
819
820/*
821** t[k] = value at the top of the stack (where 'k' is a string)
822*/
823static void auxsetstr (lua_State *L, const TValue *t, const char *k) {
824 const TValue *slot;
825 TString *str = luaS_new(L, k);
826 api_checknelems(L, 1);
827 if (luaV_fastget(L, t, str, slot, luaH_getstr)) {
828 luaV_finishfastset(L, t, slot, s2v(L->top - 1));
829 L->top--; /* pop value */
830 }
831 else {
832 setsvalue2s(L, L->top, str); /* push 'str' (to make it a TValue) */
833 api_incr_top(L);
834 luaV_finishset(L, t, s2v(L->top - 1), s2v(L->top - 2), slot);
835 L->top -= 2; /* pop value and key */
836 }
837 lua_unlock(L); /* lock done by caller */
838}
839
840
841LUA_API void lua_setglobal (lua_State *L, const char *name) {
842 const TValue *G;
843 lua_lock(L); /* unlock done in 'auxsetstr' */
844 G = getGtable(L);
845 auxsetstr(L, G, name);
846}
847
848
849LUA_API void lua_settable (lua_State *L, int idx) {
850 TValue *t;
851 const TValue *slot;
852 lua_lock(L);
853 api_checknelems(L, 2);
854 t = index2value(L, idx);
855 if (luaV_fastget(L, t, s2v(L->top - 2), slot, luaH_get)) {
856 luaV_finishfastset(L, t, slot, s2v(L->top - 1));
857 }
858 else
859 luaV_finishset(L, t, s2v(L->top - 2), s2v(L->top - 1), slot);
860 L->top -= 2; /* pop index and value */
861 lua_unlock(L);
862}
863
864
865LUA_API void lua_setfield (lua_State *L, int idx, const char *k) {
866 lua_lock(L); /* unlock done in 'auxsetstr' */
867 auxsetstr(L, index2value(L, idx), k);
868}
869
870
871LUA_API void lua_seti (lua_State *L, int idx, lua_Integer n) {
872 TValue *t;
873 const TValue *slot;
874 lua_lock(L);
875 api_checknelems(L, 1);
876 t = index2value(L, idx);
877 if (luaV_fastgeti(L, t, n, slot)) {
878 luaV_finishfastset(L, t, slot, s2v(L->top - 1));
879 }
880 else {
881 TValue aux;
882 setivalue(&aux, n);
883 luaV_finishset(L, t, &aux, s2v(L->top - 1), slot);
884 }
885 L->top--; /* pop value */
886 lua_unlock(L);
887}
888
889
890static void aux_rawset (lua_State *L, int idx, TValue *key, int n) {
891 Table *t;
892 lua_lock(L);
893 api_checknelems(L, n);
894 t = gettable(L, idx);
895 luaH_set(L, t, key, s2v(L->top - 1));
896 invalidateTMcache(t);
897 luaC_barrierback(L, obj2gco(t), s2v(L->top - 1));
898 L->top -= n;
899 lua_unlock(L);
900}
901
902
903LUA_API void lua_rawset (lua_State *L, int idx) {
904 aux_rawset(L, idx, s2v(L->top - 2), 2);
905}
906
907
908LUA_API void lua_rawsetp (lua_State *L, int idx, const void *p) {
909 TValue k;
910 setpvalue(&k, cast_voidp(p));
911 aux_rawset(L, idx, &k, 1);
912}
913
914
915LUA_API void lua_rawseti (lua_State *L, int idx, lua_Integer n) {
916 Table *t;
917 lua_lock(L);
918 api_checknelems(L, 1);
919 t = gettable(L, idx);
920 luaH_setint(L, t, n, s2v(L->top - 1));
921 luaC_barrierback(L, obj2gco(t), s2v(L->top - 1));
922 L->top--;
923 lua_unlock(L);
924}
925
926
927LUA_API int lua_setmetatable (lua_State *L, int objindex) {
928 TValue *obj;
929 Table *mt;
930 lua_lock(L);
931 api_checknelems(L, 1);
932 obj = index2value(L, objindex);
933 if (ttisnil(s2v(L->top - 1)))
934 mt = NULL;
935 else {
936 api_check(L, ttistable(s2v(L->top - 1)), "table expected");
937 mt = hvalue(s2v(L->top - 1));
938 }
939 switch (ttype(obj)) {
940 case LUA_TTABLE: {
941 hvalue(obj)->metatable = mt;
942 if (mt) {
943 luaC_objbarrier(L, gcvalue(obj), mt);
944 luaC_checkfinalizer(L, gcvalue(obj), mt);
945 }
946 break;
947 }
948 case LUA_TUSERDATA: {
949 uvalue(obj)->metatable = mt;
950 if (mt) {
951 luaC_objbarrier(L, uvalue(obj), mt);
952 luaC_checkfinalizer(L, gcvalue(obj), mt);
953 }
954 break;
955 }
956 default: {
957 G(L)->mt[ttype(obj)] = mt;
958 break;
959 }
960 }
961 L->top--;
962 lua_unlock(L);
963 return 1;
964}
965
966
967LUA_API int lua_setiuservalue (lua_State *L, int idx, int n) {
968 TValue *o;
969 int res;
970 lua_lock(L);
971 api_checknelems(L, 1);
972 o = index2value(L, idx);
973 api_check(L, ttisfulluserdata(o), "full userdata expected");
974 if (!(cast_uint(n) - 1u < cast_uint(uvalue(o)->nuvalue)))
975 res = 0; /* 'n' not in [1, uvalue(o)->nuvalue] */
976 else {
977 setobj(L, &uvalue(o)->uv[n - 1].uv, s2v(L->top - 1));
978 luaC_barrierback(L, gcvalue(o), s2v(L->top - 1));
979 res = 1;
980 }
981 L->top--;
982 lua_unlock(L);
983 return res;
984}
985
986
987/*
988** 'load' and 'call' functions (run Lua code)
989*/
990
991
992#define checkresults(L,na,nr) \
993 api_check(L, (nr) == LUA_MULTRET || (L->ci->top - L->top >= (nr) - (na)), \
994 "results from function overflow current stack size")
995
996
997LUA_API void lua_callk (lua_State *L, int nargs, int nresults,
998 lua_KContext ctx, lua_KFunction k) {
999 StkId func;
1000 lua_lock(L);
1001 api_check(L, k == NULL || !isLua(L->ci),
1002 "cannot use continuations inside hooks");
1003 api_checknelems(L, nargs+1);
1004 api_check(L, L->status == LUA_OK, "cannot do calls on non-normal thread");
1005 checkresults(L, nargs, nresults);
1006 func = L->top - (nargs+1);
1007 if (k != NULL && yieldable(L)) { /* need to prepare continuation? */
1008 L->ci->u.c.k = k; /* save continuation */
1009 L->ci->u.c.ctx = ctx; /* save context */
1010 luaD_call(L, func, nresults); /* do the call */
1011 }
1012 else /* no continuation or no yieldable */
1013 luaD_callnoyield(L, func, nresults); /* just do the call */
1014 adjustresults(L, nresults);
1015 lua_unlock(L);
1016}
1017
1018
1019
1020/*
1021** Execute a protected call.
1022*/
1023struct CallS { /* data to 'f_call' */
1024 StkId func;
1025 int nresults;
1026};
1027
1028
1029static void f_call (lua_State *L, void *ud) {
1030 struct CallS *c = cast(struct CallS *, ud);
1031 luaD_callnoyield(L, c->func, c->nresults);
1032}
1033
1034
1035
1036LUA_API int lua_pcallk (lua_State *L, int nargs, int nresults, int errfunc,
1037 lua_KContext ctx, lua_KFunction k) {
1038 struct CallS c;
1039 int status;
1040 ptrdiff_t func;
1041 lua_lock(L);
1042 api_check(L, k == NULL || !isLua(L->ci),
1043 "cannot use continuations inside hooks");
1044 api_checknelems(L, nargs+1);
1045 api_check(L, L->status == LUA_OK, "cannot do calls on non-normal thread");
1046 checkresults(L, nargs, nresults);
1047 if (errfunc == 0)
1048 func = 0;
1049 else {
1050 StkId o = index2stack(L, errfunc);
1051 api_check(L, ttisfunction(s2v(o)), "error handler must be a function");
1052 func = savestack(L, o);
1053 }
1054 c.func = L->top - (nargs+1); /* function to be called */
1055 if (k == NULL || !yieldable(L)) { /* no continuation or no yieldable? */
1056 c.nresults = nresults; /* do a 'conventional' protected call */
1057 status = luaD_pcall(L, f_call, &c, savestack(L, c.func), func);
1058 }
1059 else { /* prepare continuation (call is already protected by 'resume') */
1060 CallInfo *ci = L->ci;
1061 ci->u.c.k = k; /* save continuation */
1062 ci->u.c.ctx = ctx; /* save context */
1063 /* save information for error recovery */
1064 ci->u2.funcidx = cast_int(savestack(L, c.func));
1065 ci->u.c.old_errfunc = L->errfunc;
1066 L->errfunc = func;
1067 setoah(ci->callstatus, L->allowhook); /* save value of 'allowhook' */
1068 ci->callstatus |= CIST_YPCALL; /* function can do error recovery */
1069 luaD_call(L, c.func, nresults); /* do the call */
1070 ci->callstatus &= ~CIST_YPCALL;
1071 L->errfunc = ci->u.c.old_errfunc;
1072 status = LUA_OK; /* if it is here, there were no errors */
1073 }
1074 adjustresults(L, nresults);
1075 lua_unlock(L);
1076 return status;
1077}
1078
1079
1080LUA_API int lua_load (lua_State *L, lua_Reader reader, void *data,
1081 const char *chunkname, const char *mode) {
1082 ZIO z;
1083 int status;
1084 lua_lock(L);
1085 if (!chunkname) chunkname = "?";
1086 luaZ_init(L, &z, reader, data);
1087 status = luaD_protectedparser(L, &z, chunkname, mode);
1088 if (status == LUA_OK) { /* no errors? */
1089 LClosure *f = clLvalue(s2v(L->top - 1)); /* get newly created function */
1090 if (f->nupvalues >= 1) { /* does it have an upvalue? */
1091 /* get global table from registry */
1092 const TValue *gt = getGtable(L);
1093 /* set global table as 1st upvalue of 'f' (may be LUA_ENV) */
1094 setobj(L, f->upvals[0]->v, gt);
1095 luaC_barrier(L, f->upvals[0], gt);
1096 }
1097 }
1098 lua_unlock(L);
1099 return status;
1100}
1101
1102
1103LUA_API int lua_dump (lua_State *L, lua_Writer writer, void *data, int strip) {
1104 int status;
1105 TValue *o;
1106 lua_lock(L);
1107 api_checknelems(L, 1);
1108 o = s2v(L->top - 1);
1109 if (isLfunction(o))
1110 status = luaU_dump(L, getproto(o), writer, data, strip);
1111 else
1112 status = 1;
1113 lua_unlock(L);
1114 return status;
1115}
1116
1117
1118LUA_API int lua_status (lua_State *L) {
1119 return L->status;
1120}
1121
1122
1123/*
1124** Garbage-collection function
1125*/
1126LUA_API int lua_gc (lua_State *L, int what, ...) {
1127 va_list argp;
1128 int res = 0;
1129 global_State *g;
1130 lua_lock(L);
1131 g = G(L);
1132 va_start(argp, what);
1133 switch (what) {
1134 case LUA_GCSTOP: {
1135 g->gcrunning = 0;
1136 break;
1137 }
1138 case LUA_GCRESTART: {
1139 luaE_setdebt(g, 0);
1140 g->gcrunning = 1;
1141 break;
1142 }
1143 case LUA_GCCOLLECT: {
1144 luaC_fullgc(L, 0);
1145 break;
1146 }
1147 case LUA_GCCOUNT: {
1148 /* GC values are expressed in Kbytes: #bytes/2^10 */
1149 res = cast_int(gettotalbytes(g) >> 10);
1150 break;
1151 }
1152 case LUA_GCCOUNTB: {
1153 res = cast_int(gettotalbytes(g) & 0x3ff);
1154 break;
1155 }
1156 case LUA_GCSTEP: {
1157 int data = va_arg(argp, int);
1158 l_mem debt = 1; /* =1 to signal that it did an actual step */
1159 lu_byte oldrunning = g->gcrunning;
1160 g->gcrunning = 1; /* allow GC to run */
1161 if (data == 0) {
1162 luaE_setdebt(g, 0); /* do a basic step */
1163 luaC_step(L);
1164 }
1165 else { /* add 'data' to total debt */
1166 debt = cast(l_mem, data) * 1024 + g->GCdebt;
1167 luaE_setdebt(g, debt);
1168 luaC_checkGC(L);
1169 }
1170 g->gcrunning = oldrunning; /* restore previous state */
1171 if (debt > 0 && g->gcstate == GCSpause) /* end of cycle? */
1172 res = 1; /* signal it */
1173 break;
1174 }
1175 case LUA_GCSETPAUSE: {
1176 int data = va_arg(argp, int);
1177 res = getgcparam(g->gcpause);
1178 setgcparam(g->gcpause, data);
1179 break;
1180 }
1181 case LUA_GCSETSTEPMUL: {
1182 int data = va_arg(argp, int);
1183 res = getgcparam(g->gcstepmul);
1184 setgcparam(g->gcstepmul, data);
1185 break;
1186 }
1187 case LUA_GCISRUNNING: {
1188 res = g->gcrunning;
1189 break;
1190 }
1191 case LUA_GCGEN: {
1192 int minormul = va_arg(argp, int);
1193 int majormul = va_arg(argp, int);
1194 res = isdecGCmodegen(g) ? LUA_GCGEN : LUA_GCINC;
1195 if (minormul != 0)
1196 g->genminormul = minormul;
1197 if (majormul != 0)
1198 setgcparam(g->genmajormul, majormul);
1199 luaC_changemode(L, KGC_GEN);
1200 break;
1201 }
1202 case LUA_GCINC: {
1203 int pause = va_arg(argp, int);
1204 int stepmul = va_arg(argp, int);
1205 int stepsize = va_arg(argp, int);
1206 res = isdecGCmodegen(g) ? LUA_GCGEN : LUA_GCINC;
1207 if (pause != 0)
1208 setgcparam(g->gcpause, pause);
1209 if (stepmul != 0)
1210 setgcparam(g->gcstepmul, stepmul);
1211 if (stepsize != 0)
1212 g->gcstepsize = stepsize;
1213 luaC_changemode(L, KGC_INC);
1214 break;
1215 }
1216 default: res = -1; /* invalid option */
1217 }
1218 va_end(argp);
1219 lua_unlock(L);
1220 return res;
1221}
1222
1223
1224
1225/*
1226** miscellaneous functions
1227*/
1228
1229
1230LUA_API int lua_error (lua_State *L) {
1231 TValue *errobj;
1232 lua_lock(L);
1233 errobj = s2v(L->top - 1);
1234 api_checknelems(L, 1);
1235 /* error object is the memory error message? */
1236 if (ttisshrstring(errobj) && eqshrstr(tsvalue(errobj), G(L)->memerrmsg))
1237 luaM_error(L); /* raise a memory error */
1238 else
1239 luaG_errormsg(L); /* raise a regular error */
1240 /* code unreachable; will unlock when control actually leaves the kernel */
1241 return 0; /* to avoid warnings */
1242}
1243
1244
1245LUA_API int lua_next (lua_State *L, int idx) {
1246 Table *t;
1247 int more;
1248 lua_lock(L);
1249 api_checknelems(L, 1);
1250 t = gettable(L, idx);
1251 more = luaH_next(L, t, L->top - 1);
1252 if (more) {
1253 api_incr_top(L);
1254 }
1255 else /* no more elements */
1256 L->top -= 1; /* remove key */
1257 lua_unlock(L);
1258 return more;
1259}
1260
1261
1262LUA_API void lua_toclose (lua_State *L, int idx) {
1263 int nresults;
1264 StkId o;
1265 lua_lock(L);
1266 o = index2stack(L, idx);
1267 nresults = L->ci->nresults;
1268 api_check(L, L->tbclist < o, "given index below or equal a marked one");
1269 luaF_newtbcupval(L, o); /* create new to-be-closed upvalue */
1270 if (!hastocloseCfunc(nresults)) /* function not marked yet? */
1271 L->ci->nresults = codeNresults(nresults); /* mark it */
1272 lua_assert(hastocloseCfunc(L->ci->nresults));
1273 lua_unlock(L);
1274}
1275
1276
1277LUA_API void lua_concat (lua_State *L, int n) {
1278 lua_lock(L);
1279 api_checknelems(L, n);
1280 if (n > 0)
1281 luaV_concat(L, n);
1282 else { /* nothing to concatenate */
1283 setsvalue2s(L, L->top, luaS_newlstr(L, "", 0)); /* push empty string */
1284 api_incr_top(L);
1285 }
1286 luaC_checkGC(L);
1287 lua_unlock(L);
1288}
1289
1290
1291LUA_API void lua_len (lua_State *L, int idx) {
1292 TValue *t;
1293 lua_lock(L);
1294 t = index2value(L, idx);
1295 luaV_objlen(L, L->top, t);
1296 api_incr_top(L);
1297 lua_unlock(L);
1298}
1299
1300
1301LUA_API lua_Alloc lua_getallocf (lua_State *L, void **ud) {
1302 lua_Alloc f;
1303 lua_lock(L);
1304 if (ud) *ud = G(L)->ud;
1305 f = G(L)->frealloc;
1306 lua_unlock(L);
1307 return f;
1308}
1309
1310
1311LUA_API void lua_setallocf (lua_State *L, lua_Alloc f, void *ud) {
1312 lua_lock(L);
1313 G(L)->ud = ud;
1314 G(L)->frealloc = f;
1315 lua_unlock(L);
1316}
1317
1318
1319void lua_setwarnf (lua_State *L, lua_WarnFunction f, void *ud) {
1320 lua_lock(L);
1321 G(L)->ud_warn = ud;
1322 G(L)->warnf = f;
1323 lua_unlock(L);
1324}
1325
1326
1327void lua_warning (lua_State *L, const char *msg, int tocont) {
1328 lua_lock(L);
1329 luaE_warning(L, msg, tocont);
1330 lua_unlock(L);
1331}
1332
1333
1334
1335LUA_API void *lua_newuserdatauv (lua_State *L, size_t size, int nuvalue) {
1336 Udata *u;
1337 lua_lock(L);
1338 api_check(L, 0 <= nuvalue && nuvalue < USHRT_MAX, "invalid value");
1339 u = luaS_newudata(L, size, nuvalue);
1340 setuvalue(L, s2v(L->top), u);
1341 api_incr_top(L);
1342 luaC_checkGC(L);
1343 lua_unlock(L);
1344 return getudatamem(u);
1345}
1346
1347
1348
1349static const char *aux_upvalue (TValue *fi, int n, TValue **val,
1350 GCObject **owner) {
1351 switch (ttypetag(fi)) {
1352 case LUA_VCCL: { /* C closure */
1353 CClosure *f = clCvalue(fi);
1354 if (!(cast_uint(n) - 1u < cast_uint(f->nupvalues)))
1355 return NULL; /* 'n' not in [1, f->nupvalues] */
1356 *val = &f->upvalue[n-1];
1357 if (owner) *owner = obj2gco(f);
1358 return "";
1359 }
1360 case LUA_VLCL: { /* Lua closure */
1361 LClosure *f = clLvalue(fi);
1362 TString *name;
1363 Proto *p = f->p;
1364 if (!(cast_uint(n) - 1u < cast_uint(p->sizeupvalues)))
1365 return NULL; /* 'n' not in [1, p->sizeupvalues] */
1366 *val = f->upvals[n-1]->v;
1367 if (owner) *owner = obj2gco(f->upvals[n - 1]);
1368 name = p->upvalues[n-1].name;
1369 return (name == NULL) ? "(no name)" : getstr(name);
1370 }
1371 default: return NULL; /* not a closure */
1372 }
1373}
1374
1375
1376LUA_API const char *lua_getupvalue (lua_State *L, int funcindex, int n) {
1377 const char *name;
1378 TValue *val = NULL; /* to avoid warnings */
1379 lua_lock(L);
1380 name = aux_upvalue(index2value(L, funcindex), n, &val, NULL);
1381 if (name) {
1382 setobj2s(L, L->top, val);
1383 api_incr_top(L);
1384 }
1385 lua_unlock(L);
1386 return name;
1387}
1388
1389
1390LUA_API const char *lua_setupvalue (lua_State *L, int funcindex, int n) {
1391 const char *name;
1392 TValue *val = NULL; /* to avoid warnings */
1393 GCObject *owner = NULL; /* to avoid warnings */
1394 TValue *fi;
1395 lua_lock(L);
1396 fi = index2value(L, funcindex);
1397 api_checknelems(L, 1);
1398 name = aux_upvalue(fi, n, &val, &owner);
1399 if (name) {
1400 L->top--;
1401 setobj(L, val, s2v(L->top));
1402 luaC_barrier(L, owner, val);
1403 }
1404 lua_unlock(L);
1405 return name;
1406}
1407
1408
1409static UpVal **getupvalref (lua_State *L, int fidx, int n, LClosure **pf) {
1410 static const UpVal *const nullup = NULL;
1411 LClosure *f;
1412 TValue *fi = index2value(L, fidx);
1413 api_check(L, ttisLclosure(fi), "Lua function expected");
1414 f = clLvalue(fi);
1415 if (pf) *pf = f;
1416 if (1 <= n && n <= f->p->sizeupvalues)
1417 return &f->upvals[n - 1]; /* get its upvalue pointer */
1418 else
1419 return (UpVal**)&nullup;
1420}
1421
1422
1423LUA_API void *lua_upvalueid (lua_State *L, int fidx, int n) {
1424 TValue *fi = index2value(L, fidx);
1425 switch (ttypetag(fi)) {
1426 case LUA_VLCL: { /* lua closure */
1427 return *getupvalref(L, fidx, n, NULL);
1428 }
1429 case LUA_VCCL: { /* C closure */
1430 CClosure *f = clCvalue(fi);
1431 if (1 <= n && n <= f->nupvalues)
1432 return &f->upvalue[n - 1];
1433 /* else */
1434 } /* FALLTHROUGH */
1435 case LUA_VLCF:
1436 return NULL; /* light C functions have no upvalues */
1437 default: {
1438 api_check(L, 0, "function expected");
1439 return NULL;
1440 }
1441 }
1442}
1443
1444
1445LUA_API void lua_upvaluejoin (lua_State *L, int fidx1, int n1,
1446 int fidx2, int n2) {
1447 LClosure *f1;
1448 UpVal **up1 = getupvalref(L, fidx1, n1, &f1);
1449 UpVal **up2 = getupvalref(L, fidx2, n2, NULL);
1450 api_check(L, *up1 != NULL && *up2 != NULL, "invalid upvalue index");
1451 *up1 = *up2;
1452 luaC_objbarrier(L, f1, *up1);
1453}
1454
1455
diff --git a/src/lua/lapi.h b/src/lua/lapi.h
deleted file mode 100644
index 9e99cc4..0000000
--- a/src/lua/lapi.h
+++ /dev/null
@@ -1,49 +0,0 @@
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/* Map [-1, inf) (range of 'nresults') into (-inf, -2] */
46#define codeNresults(n) (-(n) - 3)
47#define decodeNresults(n) (-(n) - 3)
48
49#endif
diff --git a/src/lua/lauxlib.c b/src/lua/lauxlib.c
deleted file mode 100644
index 94835ef..0000000
--- a/src/lua/lauxlib.c
+++ /dev/null
@@ -1,1105 +0,0 @@
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
193LUALIB_API int 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 if (stat != 0 && errno != 0) /* error with an 'errno'? */
287 return luaL_fileresult(L, 0, NULL);
288 else {
289 const char *what = "exit"; /* type of termination */
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 (l_unlikely(!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 (l_unlikely(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 (l_unlikely(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 (l_unlikely(!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 (l_unlikely(!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 (l_unlikely(!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 (l_unlikely(temp == NULL && newsize > 0)) { /* allocation error? */
479 lua_pushliteral(L, "not enough memory");
480 lua_error(L); /* raise a memory error */
481 }
482 box->box = temp;
483 box->bsize = newsize;
484 return temp;
485}
486
487
488static int boxgc (lua_State *L) {
489 resizebox(L, 1, 0);
490 return 0;
491}
492
493
494static const luaL_Reg boxmt[] = { /* box metamethods */
495 {"__gc", boxgc},
496 {"__close", boxgc},
497 {NULL, NULL}
498};
499
500
501static void newbox (lua_State *L) {
502 UBox *box = (UBox *)lua_newuserdatauv(L, sizeof(UBox), 0);
503 box->box = NULL;
504 box->bsize = 0;
505 if (luaL_newmetatable(L, "_UBOX*")) /* creating metatable? */
506 luaL_setfuncs(L, boxmt, 0); /* set its metamethods */
507 lua_setmetatable(L, -2);
508}
509
510
511/*
512** check whether buffer is using a userdata on the stack as a temporary
513** buffer
514*/
515#define buffonstack(B) ((B)->b != (B)->init.b)
516
517
518/*
519** Whenever buffer is accessed, slot 'idx' must either be a box (which
520** cannot be NULL) or it is a placeholder for the buffer.
521*/
522#define checkbufferlevel(B,idx) \
523 lua_assert(buffonstack(B) ? lua_touserdata(B->L, idx) != NULL \
524 : lua_touserdata(B->L, idx) == (void*)B)
525
526
527/*
528** Compute new size for buffer 'B', enough to accommodate extra 'sz'
529** bytes.
530*/
531static size_t newbuffsize (luaL_Buffer *B, size_t sz) {
532 size_t newsize = B->size * 2; /* double buffer size */
533 if (l_unlikely(MAX_SIZET - sz < B->n)) /* overflow in (B->n + sz)? */
534 return luaL_error(B->L, "buffer too large");
535 if (newsize < B->n + sz) /* double is not big enough? */
536 newsize = B->n + sz;
537 return newsize;
538}
539
540
541/*
542** Returns a pointer to a free area with at least 'sz' bytes in buffer
543** 'B'. 'boxidx' is the relative position in the stack where is the
544** buffer's box or its placeholder.
545*/
546static char *prepbuffsize (luaL_Buffer *B, size_t sz, int boxidx) {
547 checkbufferlevel(B, boxidx);
548 if (B->size - B->n >= sz) /* enough space? */
549 return B->b + B->n;
550 else {
551 lua_State *L = B->L;
552 char *newbuff;
553 size_t newsize = newbuffsize(B, sz);
554 /* create larger buffer */
555 if (buffonstack(B)) /* buffer already has a box? */
556 newbuff = (char *)resizebox(L, boxidx, newsize); /* resize it */
557 else { /* no box yet */
558 lua_remove(L, boxidx); /* remove placeholder */
559 newbox(L); /* create a new box */
560 lua_insert(L, boxidx); /* move box to its intended position */
561 lua_toclose(L, boxidx);
562 newbuff = (char *)resizebox(L, boxidx, newsize);
563 memcpy(newbuff, B->b, B->n * sizeof(char)); /* copy original content */
564 }
565 B->b = newbuff;
566 B->size = newsize;
567 return newbuff + B->n;
568 }
569}
570
571/*
572** returns a pointer to a free area with at least 'sz' bytes
573*/
574LUALIB_API char *luaL_prepbuffsize (luaL_Buffer *B, size_t sz) {
575 return prepbuffsize(B, sz, -1);
576}
577
578
579LUALIB_API void luaL_addlstring (luaL_Buffer *B, const char *s, size_t l) {
580 if (l > 0) { /* avoid 'memcpy' when 's' can be NULL */
581 char *b = prepbuffsize(B, l, -1);
582 memcpy(b, s, l * sizeof(char));
583 luaL_addsize(B, l);
584 }
585}
586
587
588LUALIB_API void luaL_addstring (luaL_Buffer *B, const char *s) {
589 luaL_addlstring(B, s, strlen(s));
590}
591
592
593LUALIB_API void luaL_pushresult (luaL_Buffer *B) {
594 lua_State *L = B->L;
595 checkbufferlevel(B, -1);
596 lua_pushlstring(L, B->b, B->n);
597 if (buffonstack(B))
598 lua_closeslot(L, -2); /* close the box */
599 lua_remove(L, -2); /* remove box or placeholder from the stack */
600}
601
602
603LUALIB_API void luaL_pushresultsize (luaL_Buffer *B, size_t sz) {
604 luaL_addsize(B, sz);
605 luaL_pushresult(B);
606}
607
608
609/*
610** 'luaL_addvalue' is the only function in the Buffer system where the
611** box (if existent) is not on the top of the stack. So, instead of
612** calling 'luaL_addlstring', it replicates the code using -2 as the
613** last argument to 'prepbuffsize', signaling that the box is (or will
614** be) bellow the string being added to the buffer. (Box creation can
615** trigger an emergency GC, so we should not remove the string from the
616** stack before we have the space guaranteed.)
617*/
618LUALIB_API void luaL_addvalue (luaL_Buffer *B) {
619 lua_State *L = B->L;
620 size_t len;
621 const char *s = lua_tolstring(L, -1, &len);
622 char *b = prepbuffsize(B, len, -2);
623 memcpy(b, s, len * sizeof(char));
624 luaL_addsize(B, len);
625 lua_pop(L, 1); /* pop string */
626}
627
628
629LUALIB_API void luaL_buffinit (lua_State *L, luaL_Buffer *B) {
630 B->L = L;
631 B->b = B->init.b;
632 B->n = 0;
633 B->size = LUAL_BUFFERSIZE;
634 lua_pushlightuserdata(L, (void*)B); /* push placeholder */
635}
636
637
638LUALIB_API char *luaL_buffinitsize (lua_State *L, luaL_Buffer *B, size_t sz) {
639 luaL_buffinit(L, B);
640 return prepbuffsize(B, sz, -1);
641}
642
643/* }====================================================== */
644
645
646/*
647** {======================================================
648** Reference system
649** =======================================================
650*/
651
652/* index of free-list header (after the predefined values) */
653#define freelist (LUA_RIDX_LAST + 1)
654
655/*
656** The previously freed references form a linked list:
657** t[freelist] is the index of a first free index, or zero if list is
658** empty; t[t[freelist]] is the index of the second element; etc.
659*/
660LUALIB_API int luaL_ref (lua_State *L, int t) {
661 int ref;
662 if (lua_isnil(L, -1)) {
663 lua_pop(L, 1); /* remove from stack */
664 return LUA_REFNIL; /* 'nil' has a unique fixed reference */
665 }
666 t = lua_absindex(L, t);
667 if (lua_rawgeti(L, t, freelist) == LUA_TNIL) { /* first access? */
668 ref = 0; /* list is empty */
669 lua_pushinteger(L, 0); /* initialize as an empty list */
670 lua_rawseti(L, t, freelist); /* ref = t[freelist] = 0 */
671 }
672 else { /* already initialized */
673 lua_assert(lua_isinteger(L, -1));
674 ref = (int)lua_tointeger(L, -1); /* ref = t[freelist] */
675 }
676 lua_pop(L, 1); /* remove element from stack */
677 if (ref != 0) { /* any free element? */
678 lua_rawgeti(L, t, ref); /* remove it from list */
679 lua_rawseti(L, t, freelist); /* (t[freelist] = t[ref]) */
680 }
681 else /* no free elements */
682 ref = (int)lua_rawlen(L, t) + 1; /* get a new reference */
683 lua_rawseti(L, t, ref);
684 return ref;
685}
686
687
688LUALIB_API void luaL_unref (lua_State *L, int t, int ref) {
689 if (ref >= 0) {
690 t = lua_absindex(L, t);
691 lua_rawgeti(L, t, freelist);
692 lua_assert(lua_isinteger(L, -1));
693 lua_rawseti(L, t, ref); /* t[ref] = t[freelist] */
694 lua_pushinteger(L, ref);
695 lua_rawseti(L, t, freelist); /* t[freelist] = ref */
696 }
697}
698
699/* }====================================================== */
700
701
702/*
703** {======================================================
704** Load functions
705** =======================================================
706*/
707
708typedef struct LoadF {
709 int n; /* number of pre-read characters */
710 FILE *f; /* file being read */
711 char buff[BUFSIZ]; /* area for reading file */
712} LoadF;
713
714
715static const char *getF (lua_State *L, void *ud, size_t *size) {
716 LoadF *lf = (LoadF *)ud;
717 (void)L; /* not used */
718 if (lf->n > 0) { /* are there pre-read characters to be read? */
719 *size = lf->n; /* return them (chars already in buffer) */
720 lf->n = 0; /* no more pre-read characters */
721 }
722 else { /* read a block from file */
723 /* 'fread' can return > 0 *and* set the EOF flag. If next call to
724 'getF' called 'fread', it might still wait for user input.
725 The next check avoids this problem. */
726 if (feof(lf->f)) return NULL;
727 *size = fread(lf->buff, 1, sizeof(lf->buff), lf->f); /* read block */
728 }
729 return lf->buff;
730}
731
732
733static int errfile (lua_State *L, const char *what, int fnameindex) {
734 const char *serr = strerror(errno);
735 const char *filename = lua_tostring(L, fnameindex) + 1;
736 lua_pushfstring(L, "cannot %s %s: %s", what, filename, serr);
737 lua_remove(L, fnameindex);
738 return LUA_ERRFILE;
739}
740
741
742static int skipBOM (LoadF *lf) {
743 const char *p = "\xEF\xBB\xBF"; /* UTF-8 BOM mark */
744 int c;
745 lf->n = 0;
746 do {
747 c = getc(lf->f);
748 if (c == EOF || c != *(const unsigned char *)p++) return c;
749 lf->buff[lf->n++] = c; /* to be read by the parser */
750 } while (*p != '\0');
751 lf->n = 0; /* prefix matched; discard it */
752 return getc(lf->f); /* return next character */
753}
754
755
756/*
757** reads the first character of file 'f' and skips an optional BOM mark
758** in its beginning plus its first line if it starts with '#'. Returns
759** true if it skipped the first line. In any case, '*cp' has the
760** first "valid" character of the file (after the optional BOM and
761** a first-line comment).
762*/
763static int skipcomment (LoadF *lf, int *cp) {
764 int c = *cp = skipBOM(lf);
765 if (c == '#') { /* first line is a comment (Unix exec. file)? */
766 do { /* skip first line */
767 c = getc(lf->f);
768 } while (c != EOF && c != '\n');
769 *cp = getc(lf->f); /* skip end-of-line, if present */
770 return 1; /* there was a comment */
771 }
772 else return 0; /* no comment */
773}
774
775
776LUALIB_API int luaL_loadfilex (lua_State *L, const char *filename,
777 const char *mode) {
778 LoadF lf;
779 int status, readstatus;
780 int c;
781 int fnameindex = lua_gettop(L) + 1; /* index of filename on the stack */
782 if (filename == NULL) {
783 lua_pushliteral(L, "=stdin");
784 lf.f = stdin;
785 }
786 else {
787 lua_pushfstring(L, "@%s", filename);
788 lf.f = fopen(filename, "r");
789 if (lf.f == NULL) return errfile(L, "open", fnameindex);
790 }
791 if (skipcomment(&lf, &c)) /* read initial portion */
792 lf.buff[lf.n++] = '\n'; /* add line to correct line numbers */
793 if (c == LUA_SIGNATURE[0] && filename) { /* binary file? */
794 lf.f = freopen(filename, "rb", lf.f); /* reopen in binary mode */
795 if (lf.f == NULL) return errfile(L, "reopen", fnameindex);
796 skipcomment(&lf, &c); /* re-read initial portion */
797 }
798 if (c != EOF)
799 lf.buff[lf.n++] = c; /* 'c' is the first character of the stream */
800 status = lua_load(L, getF, &lf, lua_tostring(L, -1), mode);
801 readstatus = ferror(lf.f);
802 if (filename) fclose(lf.f); /* close file (even in case of errors) */
803 if (readstatus) {
804 lua_settop(L, fnameindex); /* ignore results from 'lua_load' */
805 return errfile(L, "read", fnameindex);
806 }
807 lua_remove(L, fnameindex);
808 return status;
809}
810
811
812typedef struct LoadS {
813 const char *s;
814 size_t size;
815} LoadS;
816
817
818static const char *getS (lua_State *L, void *ud, size_t *size) {
819 LoadS *ls = (LoadS *)ud;
820 (void)L; /* not used */
821 if (ls->size == 0) return NULL;
822 *size = ls->size;
823 ls->size = 0;
824 return ls->s;
825}
826
827
828LUALIB_API int luaL_loadbufferx (lua_State *L, const char *buff, size_t size,
829 const char *name, const char *mode) {
830 LoadS ls;
831 ls.s = buff;
832 ls.size = size;
833 return lua_load(L, getS, &ls, name, mode);
834}
835
836
837LUALIB_API int luaL_loadstring (lua_State *L, const char *s) {
838 return luaL_loadbuffer(L, s, strlen(s), s);
839}
840
841/* }====================================================== */
842
843
844
845LUALIB_API int luaL_getmetafield (lua_State *L, int obj, const char *event) {
846 if (!lua_getmetatable(L, obj)) /* no metatable? */
847 return LUA_TNIL;
848 else {
849 int tt;
850 lua_pushstring(L, event);
851 tt = lua_rawget(L, -2);
852 if (tt == LUA_TNIL) /* is metafield nil? */
853 lua_pop(L, 2); /* remove metatable and metafield */
854 else
855 lua_remove(L, -2); /* remove only metatable */
856 return tt; /* return metafield type */
857 }
858}
859
860
861LUALIB_API int luaL_callmeta (lua_State *L, int obj, const char *event) {
862 obj = lua_absindex(L, obj);
863 if (luaL_getmetafield(L, obj, event) == LUA_TNIL) /* no metafield? */
864 return 0;
865 lua_pushvalue(L, obj);
866 lua_call(L, 1, 1);
867 return 1;
868}
869
870
871LUALIB_API lua_Integer luaL_len (lua_State *L, int idx) {
872 lua_Integer l;
873 int isnum;
874 lua_len(L, idx);
875 l = lua_tointegerx(L, -1, &isnum);
876 if (l_unlikely(!isnum))
877 luaL_error(L, "object length is not an integer");
878 lua_pop(L, 1); /* remove object */
879 return l;
880}
881
882
883LUALIB_API const char *luaL_tolstring (lua_State *L, int idx, size_t *len) {
884 if (luaL_callmeta(L, idx, "__tostring")) { /* metafield? */
885 if (!lua_isstring(L, -1))
886 luaL_error(L, "'__tostring' must return a string");
887 }
888 else {
889 switch (lua_type(L, idx)) {
890 case LUA_TNUMBER: {
891 if (lua_isinteger(L, idx))
892 lua_pushfstring(L, "%I", (LUAI_UACINT)lua_tointeger(L, idx));
893 else
894 lua_pushfstring(L, "%f", (LUAI_UACNUMBER)lua_tonumber(L, idx));
895 break;
896 }
897 case LUA_TSTRING:
898 lua_pushvalue(L, idx);
899 break;
900 case LUA_TBOOLEAN:
901 lua_pushstring(L, (lua_toboolean(L, idx) ? "true" : "false"));
902 break;
903 case LUA_TNIL:
904 lua_pushliteral(L, "nil");
905 break;
906 default: {
907 int tt = luaL_getmetafield(L, idx, "__name"); /* try name */
908 const char *kind = (tt == LUA_TSTRING) ? lua_tostring(L, -1) :
909 luaL_typename(L, idx);
910 lua_pushfstring(L, "%s: %p", kind, lua_topointer(L, idx));
911 if (tt != LUA_TNIL)
912 lua_remove(L, -2); /* remove '__name' */
913 break;
914 }
915 }
916 }
917 return lua_tolstring(L, -1, len);
918}
919
920
921/*
922** set functions from list 'l' into table at top - 'nup'; each
923** function gets the 'nup' elements at the top as upvalues.
924** Returns with only the table at the stack.
925*/
926LUALIB_API void luaL_setfuncs (lua_State *L, const luaL_Reg *l, int nup) {
927 luaL_checkstack(L, nup, "too many upvalues");
928 for (; l->name != NULL; l++) { /* fill the table with given functions */
929 if (l->func == NULL) /* place holder? */
930 lua_pushboolean(L, 0);
931 else {
932 int i;
933 for (i = 0; i < nup; i++) /* copy upvalues to the top */
934 lua_pushvalue(L, -nup);
935 lua_pushcclosure(L, l->func, nup); /* closure with those upvalues */
936 }
937 lua_setfield(L, -(nup + 2), l->name);
938 }
939 lua_pop(L, nup); /* remove upvalues */
940}
941
942
943/*
944** ensure that stack[idx][fname] has a table and push that table
945** into the stack
946*/
947LUALIB_API int luaL_getsubtable (lua_State *L, int idx, const char *fname) {
948 if (lua_getfield(L, idx, fname) == LUA_TTABLE)
949 return 1; /* table already there */
950 else {
951 lua_pop(L, 1); /* remove previous result */
952 idx = lua_absindex(L, idx);
953 lua_newtable(L);
954 lua_pushvalue(L, -1); /* copy to be left at top */
955 lua_setfield(L, idx, fname); /* assign new table to field */
956 return 0; /* false, because did not find table there */
957 }
958}
959
960
961/*
962** Stripped-down 'require': After checking "loaded" table, calls 'openf'
963** to open a module, registers the result in 'package.loaded' table and,
964** if 'glb' is true, also registers the result in the global table.
965** Leaves resulting module on the top.
966*/
967LUALIB_API void luaL_requiref (lua_State *L, const char *modname,
968 lua_CFunction openf, int glb) {
969 luaL_getsubtable(L, LUA_REGISTRYINDEX, LUA_LOADED_TABLE);
970 lua_getfield(L, -1, modname); /* LOADED[modname] */
971 if (!lua_toboolean(L, -1)) { /* package not already loaded? */
972 lua_pop(L, 1); /* remove field */
973 lua_pushcfunction(L, openf);
974 lua_pushstring(L, modname); /* argument to open function */
975 lua_call(L, 1, 1); /* call 'openf' to open module */
976 lua_pushvalue(L, -1); /* make copy of module (call result) */
977 lua_setfield(L, -3, modname); /* LOADED[modname] = module */
978 }
979 lua_remove(L, -2); /* remove LOADED table */
980 if (glb) {
981 lua_pushvalue(L, -1); /* copy of module */
982 lua_setglobal(L, modname); /* _G[modname] = module */
983 }
984}
985
986
987LUALIB_API void luaL_addgsub (luaL_Buffer *b, const char *s,
988 const char *p, const char *r) {
989 const char *wild;
990 size_t l = strlen(p);
991 while ((wild = strstr(s, p)) != NULL) {
992 luaL_addlstring(b, s, wild - s); /* push prefix */
993 luaL_addstring(b, r); /* push replacement in place of pattern */
994 s = wild + l; /* continue after 'p' */
995 }
996 luaL_addstring(b, s); /* push last suffix */
997}
998
999
1000LUALIB_API const char *luaL_gsub (lua_State *L, const char *s,
1001 const char *p, const char *r) {
1002 luaL_Buffer b;
1003 luaL_buffinit(L, &b);
1004 luaL_addgsub(&b, s, p, r);
1005 luaL_pushresult(&b);
1006 return lua_tostring(L, -1);
1007}
1008
1009
1010static void *l_alloc (void *ud, void *ptr, size_t osize, size_t nsize) {
1011 (void)ud; (void)osize; /* not used */
1012 if (nsize == 0) {
1013 free(ptr);
1014 return NULL;
1015 }
1016 else
1017 return realloc(ptr, nsize);
1018}
1019
1020
1021static int panic (lua_State *L) {
1022 const char *msg = lua_tostring(L, -1);
1023 if (msg == NULL) msg = "error object is not a string";
1024 lua_writestringerror("PANIC: unprotected error in call to Lua API (%s)\n",
1025 msg);
1026 return 0; /* return to Lua to abort */
1027}
1028
1029
1030/*
1031** Warning functions:
1032** warnfoff: warning system is off
1033** warnfon: ready to start a new message
1034** warnfcont: previous message is to be continued
1035*/
1036static void warnfoff (void *ud, const char *message, int tocont);
1037static void warnfon (void *ud, const char *message, int tocont);
1038static void warnfcont (void *ud, const char *message, int tocont);
1039
1040
1041/*
1042** Check whether message is a control message. If so, execute the
1043** control or ignore it if unknown.
1044*/
1045static int checkcontrol (lua_State *L, const char *message, int tocont) {
1046 if (tocont || *(message++) != '@') /* not a control message? */
1047 return 0;
1048 else {
1049 if (strcmp(message, "off") == 0)
1050 lua_setwarnf(L, warnfoff, L); /* turn warnings off */
1051 else if (strcmp(message, "on") == 0)
1052 lua_setwarnf(L, warnfon, L); /* turn warnings on */
1053 return 1; /* it was a control message */
1054 }
1055}
1056
1057
1058static void warnfoff (void *ud, const char *message, int tocont) {
1059 checkcontrol((lua_State *)ud, message, tocont);
1060}
1061
1062
1063/*
1064** Writes the message and handle 'tocont', finishing the message
1065** if needed and setting the next warn function.
1066*/
1067static void warnfcont (void *ud, const char *message, int tocont) {
1068 lua_State *L = (lua_State *)ud;
1069 lua_writestringerror("%s", message); /* write message */
1070 if (tocont) /* not the last part? */
1071 lua_setwarnf(L, warnfcont, L); /* to be continued */
1072 else { /* last part */
1073 lua_writestringerror("%s", "\n"); /* finish message with end-of-line */
1074 lua_setwarnf(L, warnfon, L); /* next call is a new message */
1075 }
1076}
1077
1078
1079static void warnfon (void *ud, const char *message, int tocont) {
1080 if (checkcontrol((lua_State *)ud, message, tocont)) /* control message? */
1081 return; /* nothing else to be done */
1082 lua_writestringerror("%s", "Lua warning: "); /* start a new warning */
1083 warnfcont(ud, message, tocont); /* finish processing */
1084}
1085
1086
1087LUALIB_API lua_State *luaL_newstate (void) {
1088 lua_State *L = lua_newstate(l_alloc, NULL);
1089 if (l_likely(L)) {
1090 lua_atpanic(L, &panic);
1091 lua_setwarnf(L, warnfoff, L); /* default is warnings off */
1092 }
1093 return L;
1094}
1095
1096
1097LUALIB_API void luaL_checkversion_ (lua_State *L, lua_Number ver, size_t sz) {
1098 lua_Number v = lua_version(L);
1099 if (sz != LUAL_NUMSIZES) /* check numeric types */
1100 luaL_error(L, "core and library have incompatible numeric types");
1101 else if (v != ver)
1102 luaL_error(L, "version mismatch: app. needs %f, Lua core provides %f",
1103 (LUAI_UACNUMBER)ver, (LUAI_UACNUMBER)v);
1104}
1105
diff --git a/src/lua/lauxlib.h b/src/lua/lauxlib.h
deleted file mode 100644
index 72f70e7..0000000
--- a/src/lua/lauxlib.h
+++ /dev/null
@@ -1,293 +0,0 @@
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 "luaconf.h"
16#include "lua.h"
17
18
19/* global table */
20#define LUA_GNAME "_G"
21
22
23typedef struct luaL_Buffer luaL_Buffer;
24
25
26/* extra error code for 'luaL_loadfilex' */
27#define LUA_ERRFILE (LUA_ERRERR+1)
28
29
30/* key, in the registry, for table of loaded modules */
31#define LUA_LOADED_TABLE "_LOADED"
32
33
34/* key, in the registry, for table of preloaded loaders */
35#define LUA_PRELOAD_TABLE "_PRELOAD"
36
37
38typedef struct luaL_Reg {
39 const char *name;
40 lua_CFunction func;
41} luaL_Reg;
42
43
44#define LUAL_NUMSIZES (sizeof(lua_Integer)*16 + sizeof(lua_Number))
45
46LUALIB_API void (luaL_checkversion_) (lua_State *L, lua_Number ver, size_t sz);
47#define luaL_checkversion(L) \
48 luaL_checkversion_(L, LUA_VERSION_NUM, LUAL_NUMSIZES)
49
50LUALIB_API int (luaL_getmetafield) (lua_State *L, int obj, const char *e);
51LUALIB_API int (luaL_callmeta) (lua_State *L, int obj, const char *e);
52LUALIB_API const char *(luaL_tolstring) (lua_State *L, int idx, size_t *len);
53LUALIB_API int (luaL_argerror) (lua_State *L, int arg, const char *extramsg);
54LUALIB_API int (luaL_typeerror) (lua_State *L, int arg, const char *tname);
55LUALIB_API const char *(luaL_checklstring) (lua_State *L, int arg,
56 size_t *l);
57LUALIB_API const char *(luaL_optlstring) (lua_State *L, int arg,
58 const char *def, size_t *l);
59LUALIB_API lua_Number (luaL_checknumber) (lua_State *L, int arg);
60LUALIB_API lua_Number (luaL_optnumber) (lua_State *L, int arg, lua_Number def);
61
62LUALIB_API lua_Integer (luaL_checkinteger) (lua_State *L, int arg);
63LUALIB_API lua_Integer (luaL_optinteger) (lua_State *L, int arg,
64 lua_Integer def);
65
66LUALIB_API void (luaL_checkstack) (lua_State *L, int sz, const char *msg);
67LUALIB_API void (luaL_checktype) (lua_State *L, int arg, int t);
68LUALIB_API void (luaL_checkany) (lua_State *L, int arg);
69
70LUALIB_API int (luaL_newmetatable) (lua_State *L, const char *tname);
71LUALIB_API void (luaL_setmetatable) (lua_State *L, const char *tname);
72LUALIB_API void *(luaL_testudata) (lua_State *L, int ud, const char *tname);
73LUALIB_API void *(luaL_checkudata) (lua_State *L, int ud, const char *tname);
74
75LUALIB_API void (luaL_where) (lua_State *L, int lvl);
76LUALIB_API int (luaL_error) (lua_State *L, const char *fmt, ...);
77
78LUALIB_API int (luaL_checkoption) (lua_State *L, int arg, const char *def,
79 const char *const lst[]);
80
81LUALIB_API int (luaL_fileresult) (lua_State *L, int stat, const char *fname);
82LUALIB_API int (luaL_execresult) (lua_State *L, int stat);
83
84
85/* predefined references */
86#define LUA_NOREF (-2)
87#define LUA_REFNIL (-1)
88
89LUALIB_API int (luaL_ref) (lua_State *L, int t);
90LUALIB_API void (luaL_unref) (lua_State *L, int t, int ref);
91
92LUALIB_API int (luaL_loadfilex) (lua_State *L, const char *filename,
93 const char *mode);
94
95#define luaL_loadfile(L,f) luaL_loadfilex(L,f,NULL)
96
97LUALIB_API int (luaL_loadbufferx) (lua_State *L, const char *buff, size_t sz,
98 const char *name, const char *mode);
99LUALIB_API int (luaL_loadstring) (lua_State *L, const char *s);
100
101LUALIB_API lua_State *(luaL_newstate) (void);
102
103LUALIB_API lua_Integer (luaL_len) (lua_State *L, int idx);
104
105LUALIB_API void luaL_addgsub (luaL_Buffer *b, const char *s,
106 const char *p, const char *r);
107LUALIB_API const char *(luaL_gsub) (lua_State *L, const char *s,
108 const char *p, const char *r);
109
110LUALIB_API void (luaL_setfuncs) (lua_State *L, const luaL_Reg *l, int nup);
111
112LUALIB_API int (luaL_getsubtable) (lua_State *L, int idx, const char *fname);
113
114LUALIB_API void (luaL_traceback) (lua_State *L, lua_State *L1,
115 const char *msg, int level);
116
117LUALIB_API void (luaL_requiref) (lua_State *L, const char *modname,
118 lua_CFunction openf, int glb);
119
120/*
121** ===============================================================
122** some useful macros
123** ===============================================================
124*/
125
126
127#define luaL_newlibtable(L,l) \
128 lua_createtable(L, 0, sizeof(l)/sizeof((l)[0]) - 1)
129
130#define luaL_newlib(L,l) \
131 (luaL_checkversion(L), luaL_newlibtable(L,l), luaL_setfuncs(L,l,0))
132
133#define luaL_argcheck(L, cond,arg,extramsg) \
134 ((void)(luai_likely(cond) || luaL_argerror(L, (arg), (extramsg))))
135
136#define luaL_argexpected(L,cond,arg,tname) \
137 ((void)(luai_likely(cond) || luaL_typeerror(L, (arg), (tname))))
138
139#define luaL_checkstring(L,n) (luaL_checklstring(L, (n), NULL))
140#define luaL_optstring(L,n,d) (luaL_optlstring(L, (n), (d), NULL))
141
142#define luaL_typename(L,i) lua_typename(L, lua_type(L,(i)))
143
144#define luaL_dofile(L, fn) \
145 (luaL_loadfile(L, fn) || lua_pcall(L, 0, LUA_MULTRET, 0))
146
147#define luaL_dostring(L, s) \
148 (luaL_loadstring(L, s) || lua_pcall(L, 0, LUA_MULTRET, 0))
149
150#define luaL_getmetatable(L,n) (lua_getfield(L, LUA_REGISTRYINDEX, (n)))
151
152#define luaL_opt(L,f,n,d) (lua_isnoneornil(L,(n)) ? (d) : f(L,(n)))
153
154#define luaL_loadbuffer(L,s,sz,n) luaL_loadbufferx(L,s,sz,n,NULL)
155
156
157/* push the value used to represent failure/error */
158#define luaL_pushfail(L) lua_pushnil(L)
159
160
161/*
162** Internal assertions for in-house debugging
163*/
164#if !defined(lua_assert)
165
166#if defined LUAI_ASSERT
167 #include <assert.h>
168 #define lua_assert(c) assert(c)
169#else
170 #define lua_assert(c) ((void)0)
171#endif
172
173#endif
174
175
176
177/*
178** {======================================================
179** Generic Buffer manipulation
180** =======================================================
181*/
182
183struct luaL_Buffer {
184 char *b; /* buffer address */
185 size_t size; /* buffer size */
186 size_t n; /* number of characters in buffer */
187 lua_State *L;
188 union {
189 LUAI_MAXALIGN; /* ensure maximum alignment for buffer */
190 char b[LUAL_BUFFERSIZE]; /* initial buffer */
191 } init;
192};
193
194
195#define luaL_bufflen(bf) ((bf)->n)
196#define luaL_buffaddr(bf) ((bf)->b)
197
198
199#define luaL_addchar(B,c) \
200 ((void)((B)->n < (B)->size || luaL_prepbuffsize((B), 1)), \
201 ((B)->b[(B)->n++] = (c)))
202
203#define luaL_addsize(B,s) ((B)->n += (s))
204
205#define luaL_buffsub(B,s) ((B)->n -= (s))
206
207LUALIB_API void (luaL_buffinit) (lua_State *L, luaL_Buffer *B);
208LUALIB_API char *(luaL_prepbuffsize) (luaL_Buffer *B, size_t sz);
209LUALIB_API void (luaL_addlstring) (luaL_Buffer *B, const char *s, size_t l);
210LUALIB_API void (luaL_addstring) (luaL_Buffer *B, const char *s);
211LUALIB_API void (luaL_addvalue) (luaL_Buffer *B);
212LUALIB_API void (luaL_pushresult) (luaL_Buffer *B);
213LUALIB_API void (luaL_pushresultsize) (luaL_Buffer *B, size_t sz);
214LUALIB_API char *(luaL_buffinitsize) (lua_State *L, luaL_Buffer *B, size_t sz);
215
216#define luaL_prepbuffer(B) luaL_prepbuffsize(B, LUAL_BUFFERSIZE)
217
218/* }====================================================== */
219
220
221
222/*
223** {======================================================
224** File handles for IO library
225** =======================================================
226*/
227
228/*
229** A file handle is a userdata with metatable 'LUA_FILEHANDLE' and
230** initial structure 'luaL_Stream' (it may contain other fields
231** after that initial structure).
232*/
233
234#define LUA_FILEHANDLE "FILE*"
235
236
237typedef struct luaL_Stream {
238 FILE *f; /* stream (NULL for incompletely created streams) */
239 lua_CFunction closef; /* to close stream (NULL for closed streams) */
240} luaL_Stream;
241
242/* }====================================================== */
243
244/*
245** {==================================================================
246** "Abstraction Layer" for basic report of messages and errors
247** ===================================================================
248*/
249
250/* print a string */
251#if !defined(lua_writestring)
252#define lua_writestring(s,l) fwrite((s), sizeof(char), (l), stdout)
253#endif
254
255/* print a newline and flush the output */
256#if !defined(lua_writeline)
257#define lua_writeline() (lua_writestring("\n", 1), fflush(stdout))
258#endif
259
260/* print an error message */
261#if !defined(lua_writestringerror)
262#define lua_writestringerror(s,p) \
263 (fprintf(stderr, (s), (p)), fflush(stderr))
264#endif
265
266/* }================================================================== */
267
268
269/*
270** {============================================================
271** Compatibility with deprecated conversions
272** =============================================================
273*/
274#if defined(LUA_COMPAT_APIINTCASTS)
275
276#define luaL_checkunsigned(L,a) ((lua_Unsigned)luaL_checkinteger(L,a))
277#define luaL_optunsigned(L,a,d) \
278 ((lua_Unsigned)luaL_optinteger(L,a,(lua_Integer)(d)))
279
280#define luaL_checkint(L,n) ((int)luaL_checkinteger(L, (n)))
281#define luaL_optint(L,n,d) ((int)luaL_optinteger(L, (n), (d)))
282
283#define luaL_checklong(L,n) ((long)luaL_checkinteger(L, (n)))
284#define luaL_optlong(L,n,d) ((long)luaL_optinteger(L, (n), (d)))
285
286#endif
287/* }============================================================ */
288
289
290
291#endif
292
293
diff --git a/src/lua/lbaselib.c b/src/lua/lbaselib.c
deleted file mode 100644
index 83ad306..0000000
--- a/src/lua/lbaselib.c
+++ /dev/null
@@ -1,528 +0,0 @@
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 (l_unlikely(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"
186 : "generational");
187 return 1;
188}
189
190
191static int luaB_collectgarbage (lua_State *L) {
192 static const char *const opts[] = {"stop", "restart", "collect",
193 "count", "step", "setpause", "setstepmul",
194 "isrunning", "generational", "incremental", NULL};
195 static const int optsnum[] = {LUA_GCSTOP, LUA_GCRESTART, LUA_GCCOLLECT,
196 LUA_GCCOUNT, LUA_GCSTEP, LUA_GCSETPAUSE, LUA_GCSETSTEPMUL,
197 LUA_GCISRUNNING, LUA_GCGEN, LUA_GCINC};
198 int o = optsnum[luaL_checkoption(L, 1, "collect", opts)];
199 switch (o) {
200 case LUA_GCCOUNT: {
201 int k = lua_gc(L, o);
202 int b = lua_gc(L, LUA_GCCOUNTB);
203 lua_pushnumber(L, (lua_Number)k + ((lua_Number)b/1024));
204 return 1;
205 }
206 case LUA_GCSTEP: {
207 int step = (int)luaL_optinteger(L, 2, 0);
208 int res = lua_gc(L, o, step);
209 lua_pushboolean(L, res);
210 return 1;
211 }
212 case LUA_GCSETPAUSE:
213 case LUA_GCSETSTEPMUL: {
214 int p = (int)luaL_optinteger(L, 2, 0);
215 int previous = lua_gc(L, o, p);
216 lua_pushinteger(L, previous);
217 return 1;
218 }
219 case LUA_GCISRUNNING: {
220 int res = lua_gc(L, o);
221 lua_pushboolean(L, res);
222 return 1;
223 }
224 case LUA_GCGEN: {
225 int minormul = (int)luaL_optinteger(L, 2, 0);
226 int majormul = (int)luaL_optinteger(L, 3, 0);
227 return pushmode(L, lua_gc(L, o, minormul, majormul));
228 }
229 case LUA_GCINC: {
230 int pause = (int)luaL_optinteger(L, 2, 0);
231 int stepmul = (int)luaL_optinteger(L, 3, 0);
232 int stepsize = (int)luaL_optinteger(L, 4, 0);
233 return pushmode(L, lua_gc(L, o, pause, stepmul, stepsize));
234 }
235 default: {
236 int res = lua_gc(L, o);
237 lua_pushinteger(L, res);
238 return 1;
239 }
240 }
241}
242
243
244static int luaB_type (lua_State *L) {
245 int t = lua_type(L, 1);
246 luaL_argcheck(L, t != LUA_TNONE, 1, "value expected");
247 lua_pushstring(L, lua_typename(L, t));
248 return 1;
249}
250
251
252static int luaB_next (lua_State *L) {
253 luaL_checktype(L, 1, LUA_TTABLE);
254 lua_settop(L, 2); /* create a 2nd argument if there isn't one */
255 if (lua_next(L, 1))
256 return 2;
257 else {
258 lua_pushnil(L);
259 return 1;
260 }
261}
262
263
264static int luaB_pairs (lua_State *L) {
265 luaL_checkany(L, 1);
266 if (luaL_getmetafield(L, 1, "__pairs") == LUA_TNIL) { /* no metamethod? */
267 lua_pushcfunction(L, luaB_next); /* will return generator, */
268 lua_pushvalue(L, 1); /* state, */
269 lua_pushnil(L); /* and initial value */
270 }
271 else {
272 lua_pushvalue(L, 1); /* argument 'self' to metamethod */
273 lua_call(L, 1, 3); /* get 3 values from metamethod */
274 }
275 return 3;
276}
277
278
279/*
280** Traversal function for 'ipairs'
281*/
282static int ipairsaux (lua_State *L) {
283 lua_Integer i = luaL_checkinteger(L, 2) + 1;
284 lua_pushinteger(L, i);
285 return (lua_geti(L, 1, i) == LUA_TNIL) ? 1 : 2;
286}
287
288
289/*
290** 'ipairs' function. Returns 'ipairsaux', given "table", 0.
291** (The given "table" may not be a table.)
292*/
293static int luaB_ipairs (lua_State *L) {
294 luaL_checkany(L, 1);
295 lua_pushcfunction(L, ipairsaux); /* iteration function */
296 lua_pushvalue(L, 1); /* state */
297 lua_pushinteger(L, 0); /* initial value */
298 return 3;
299}
300
301
302static int load_aux (lua_State *L, int status, int envidx) {
303 if (l_likely(status == LUA_OK)) {
304 if (envidx != 0) { /* 'env' parameter? */
305 lua_pushvalue(L, envidx); /* environment for loaded function */
306 if (!lua_setupvalue(L, -2, 1)) /* set it as 1st upvalue */
307 lua_pop(L, 1); /* remove 'env' if not used by previous call */
308 }
309 return 1;
310 }
311 else { /* error (message is on top of the stack) */
312 luaL_pushfail(L);
313 lua_insert(L, -2); /* put before error message */
314 return 2; /* return fail plus error message */
315 }
316}
317
318
319static int luaB_loadfile (lua_State *L) {
320 const char *fname = luaL_optstring(L, 1, NULL);
321 const char *mode = luaL_optstring(L, 2, NULL);
322 int env = (!lua_isnone(L, 3) ? 3 : 0); /* 'env' index or 0 if no 'env' */
323 int status = luaL_loadfilex(L, fname, mode);
324 return load_aux(L, status, env);
325}
326
327
328/*
329** {======================================================
330** Generic Read function
331** =======================================================
332*/
333
334
335/*
336** reserved slot, above all arguments, to hold a copy of the returned
337** string to avoid it being collected while parsed. 'load' has four
338** optional arguments (chunk, source name, mode, and environment).
339*/
340#define RESERVEDSLOT 5
341
342
343/*
344** Reader for generic 'load' function: 'lua_load' uses the
345** stack for internal stuff, so the reader cannot change the
346** stack top. Instead, it keeps its resulting string in a
347** reserved slot inside the stack.
348*/
349static const char *generic_reader (lua_State *L, void *ud, size_t *size) {
350 (void)(ud); /* not used */
351 luaL_checkstack(L, 2, "too many nested functions");
352 lua_pushvalue(L, 1); /* get function */
353 lua_call(L, 0, 1); /* call it */
354 if (lua_isnil(L, -1)) {
355 lua_pop(L, 1); /* pop result */
356 *size = 0;
357 return NULL;
358 }
359 else if (l_unlikely(!lua_isstring(L, -1)))
360 luaL_error(L, "reader function must return a string");
361 lua_replace(L, RESERVEDSLOT); /* save string in reserved slot */
362 return lua_tolstring(L, RESERVEDSLOT, size);
363}
364
365
366static int luaB_load (lua_State *L) {
367 int status;
368 size_t l;
369 const char *s = lua_tolstring(L, 1, &l);
370 const char *mode = luaL_optstring(L, 3, "bt");
371 int env = (!lua_isnone(L, 4) ? 4 : 0); /* 'env' index or 0 if no 'env' */
372 if (s != NULL) { /* loading a string? */
373 const char *chunkname = luaL_optstring(L, 2, s);
374 status = luaL_loadbufferx(L, s, l, chunkname, mode);
375 }
376 else { /* loading from a reader function */
377 const char *chunkname = luaL_optstring(L, 2, "=(load)");
378 luaL_checktype(L, 1, LUA_TFUNCTION);
379 lua_settop(L, RESERVEDSLOT); /* create reserved slot */
380 status = lua_load(L, generic_reader, NULL, chunkname, mode);
381 }
382 return load_aux(L, status, env);
383}
384
385/* }====================================================== */
386
387
388static int dofilecont (lua_State *L, int d1, lua_KContext d2) {
389 (void)d1; (void)d2; /* only to match 'lua_Kfunction' prototype */
390 return lua_gettop(L) - 1;
391}
392
393
394static int luaB_dofile (lua_State *L) {
395 const char *fname = luaL_optstring(L, 1, NULL);
396 lua_settop(L, 1);
397 if (l_unlikely(luaL_loadfile(L, fname) != LUA_OK))
398 return lua_error(L);
399 lua_callk(L, 0, LUA_MULTRET, 0, dofilecont);
400 return dofilecont(L, 0, 0);
401}
402
403
404static int luaB_assert (lua_State *L) {
405 if (l_likely(lua_toboolean(L, 1))) /* condition is true? */
406 return lua_gettop(L); /* return all arguments */
407 else { /* error */
408 luaL_checkany(L, 1); /* there must be a condition */
409 lua_remove(L, 1); /* remove it */
410 lua_pushliteral(L, "assertion failed!"); /* default message */
411 lua_settop(L, 1); /* leave only message (default if no other one) */
412 return luaB_error(L); /* call 'error' */
413 }
414}
415
416
417static int luaB_select (lua_State *L) {
418 int n = lua_gettop(L);
419 if (lua_type(L, 1) == LUA_TSTRING && *lua_tostring(L, 1) == '#') {
420 lua_pushinteger(L, n-1);
421 return 1;
422 }
423 else {
424 lua_Integer i = luaL_checkinteger(L, 1);
425 if (i < 0) i = n + i;
426 else if (i > n) i = n;
427 luaL_argcheck(L, 1 <= i, 1, "index out of range");
428 return n - (int)i;
429 }
430}
431
432
433/*
434** Continuation function for 'pcall' and 'xpcall'. Both functions
435** already pushed a 'true' before doing the call, so in case of success
436** 'finishpcall' only has to return everything in the stack minus
437** 'extra' values (where 'extra' is exactly the number of items to be
438** ignored).
439*/
440static int finishpcall (lua_State *L, int status, lua_KContext extra) {
441 if (l_unlikely(status != LUA_OK && status != LUA_YIELD)) { /* error? */
442 lua_pushboolean(L, 0); /* first result (false) */
443 lua_pushvalue(L, -2); /* error message */
444 return 2; /* return false, msg */
445 }
446 else
447 return lua_gettop(L) - (int)extra; /* return all results */
448}
449
450
451static int luaB_pcall (lua_State *L) {
452 int status;
453 luaL_checkany(L, 1);
454 lua_pushboolean(L, 1); /* first result if no errors */
455 lua_insert(L, 1); /* put it in place */
456 status = lua_pcallk(L, lua_gettop(L) - 2, LUA_MULTRET, 0, 0, finishpcall);
457 return finishpcall(L, status, 0);
458}
459
460
461/*
462** Do a protected call with error handling. After 'lua_rotate', the
463** stack will have <f, err, true, f, [args...]>; so, the function passes
464** 2 to 'finishpcall' to skip the 2 first values when returning results.
465*/
466static int luaB_xpcall (lua_State *L) {
467 int status;
468 int n = lua_gettop(L);
469 luaL_checktype(L, 2, LUA_TFUNCTION); /* check error function */
470 lua_pushboolean(L, 1); /* first result */
471 lua_pushvalue(L, 1); /* function */
472 lua_rotate(L, 3, 2); /* move them below function's arguments */
473 status = lua_pcallk(L, n - 2, LUA_MULTRET, 2, 2, finishpcall);
474 return finishpcall(L, status, 2);
475}
476
477
478static int luaB_tostring (lua_State *L) {
479 luaL_checkany(L, 1);
480 luaL_tolstring(L, 1, NULL);
481 return 1;
482}
483
484
485static const luaL_Reg base_funcs[] = {
486 {"assert", luaB_assert},
487 {"collectgarbage", luaB_collectgarbage},
488 {"dofile", luaB_dofile},
489 {"error", luaB_error},
490 {"getmetatable", luaB_getmetatable},
491 {"ipairs", luaB_ipairs},
492 {"loadfile", luaB_loadfile},
493 {"load", luaB_load},
494 {"next", luaB_next},
495 {"pairs", luaB_pairs},
496 {"pcall", luaB_pcall},
497 {"print", luaB_print},
498 {"warn", luaB_warn},
499 {"rawequal", luaB_rawequal},
500 {"rawlen", luaB_rawlen},
501 {"rawget", luaB_rawget},
502 {"rawset", luaB_rawset},
503 {"select", luaB_select},
504 {"setmetatable", luaB_setmetatable},
505 {"tonumber", luaB_tonumber},
506 {"tostring", luaB_tostring},
507 {"type", luaB_type},
508 {"xpcall", luaB_xpcall},
509 /* placeholders */
510 {LUA_GNAME, NULL},
511 {"_VERSION", NULL},
512 {NULL, NULL}
513};
514
515
516LUAMOD_API int luaopen_base (lua_State *L) {
517 /* open lib into global table */
518 lua_pushglobaltable(L);
519 luaL_setfuncs(L, base_funcs, 0);
520 /* set global _G */
521 lua_pushvalue(L, -1);
522 lua_setfield(L, -2, LUA_GNAME);
523 /* set global _VERSION */
524 lua_pushliteral(L, LUA_VERSION);
525 lua_setfield(L, -2, "_VERSION");
526 return 1;
527}
528
diff --git a/src/lua/lcode.c b/src/lua/lcode.c
deleted file mode 100644
index 80d975c..0000000
--- a/src/lua/lcode.c
+++ /dev/null
@@ -1,1814 +0,0 @@
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/* limit for difference between lines in relative line info. */
318#define LIMLINEDIFF 0x80
319
320
321/*
322** Save line info for a new instruction. If difference from last line
323** does not fit in a byte, of after that many instructions, save a new
324** absolute line info; (in that case, the special value 'ABSLINEINFO'
325** in 'lineinfo' signals the existence of this absolute information.)
326** Otherwise, store the difference from last line in 'lineinfo'.
327*/
328static void savelineinfo (FuncState *fs, Proto *f, int line) {
329 int linedif = line - fs->previousline;
330 int pc = fs->pc - 1; /* last instruction coded */
331 if (abs(linedif) >= LIMLINEDIFF || fs->iwthabs++ >= MAXIWTHABS) {
332 luaM_growvector(fs->ls->L, f->abslineinfo, fs->nabslineinfo,
333 f->sizeabslineinfo, AbsLineInfo, MAX_INT, "lines");
334 f->abslineinfo[fs->nabslineinfo].pc = pc;
335 f->abslineinfo[fs->nabslineinfo++].line = line;
336 linedif = ABSLINEINFO; /* signal that there is absolute information */
337 fs->iwthabs = 1; /* restart counter */
338 }
339 luaM_growvector(fs->ls->L, f->lineinfo, pc, f->sizelineinfo, ls_byte,
340 MAX_INT, "opcodes");
341 f->lineinfo[pc] = linedif;
342 fs->previousline = line; /* last line saved */
343}
344
345
346/*
347** Remove line information from the last instruction.
348** If line information for that instruction is absolute, set 'iwthabs'
349** above its max to force the new (replacing) instruction to have
350** absolute line info, too.
351*/
352static void removelastlineinfo (FuncState *fs) {
353 Proto *f = fs->f;
354 int pc = fs->pc - 1; /* last instruction coded */
355 if (f->lineinfo[pc] != ABSLINEINFO) { /* relative line info? */
356 fs->previousline -= f->lineinfo[pc]; /* correct last line saved */
357 fs->iwthabs--; /* undo previous increment */
358 }
359 else { /* absolute line information */
360 lua_assert(f->abslineinfo[fs->nabslineinfo - 1].pc == pc);
361 fs->nabslineinfo--; /* remove it */
362 fs->iwthabs = MAXIWTHABS + 1; /* force next line info to be absolute */
363 }
364}
365
366
367/*
368** Remove the last instruction created, correcting line information
369** accordingly.
370*/
371static void removelastinstruction (FuncState *fs) {
372 removelastlineinfo(fs);
373 fs->pc--;
374}
375
376
377/*
378** Emit instruction 'i', checking for array sizes and saving also its
379** line information. Return 'i' position.
380*/
381int luaK_code (FuncState *fs, Instruction i) {
382 Proto *f = fs->f;
383 /* put new instruction in code array */
384 luaM_growvector(fs->ls->L, f->code, fs->pc, f->sizecode, Instruction,
385 MAX_INT, "opcodes");
386 f->code[fs->pc++] = i;
387 savelineinfo(fs, f, fs->ls->lastline);
388 return fs->pc - 1; /* index of new instruction */
389}
390
391
392/*
393** Format and emit an 'iABC' instruction. (Assertions check consistency
394** of parameters versus opcode.)
395*/
396int luaK_codeABCk (FuncState *fs, OpCode o, int a, int b, int c, int k) {
397 lua_assert(getOpMode(o) == iABC);
398 lua_assert(a <= MAXARG_A && b <= MAXARG_B &&
399 c <= MAXARG_C && (k & ~1) == 0);
400 return luaK_code(fs, CREATE_ABCk(o, a, b, c, k));
401}
402
403
404/*
405** Format and emit an 'iABx' instruction.
406*/
407int luaK_codeABx (FuncState *fs, OpCode o, int a, unsigned int bc) {
408 lua_assert(getOpMode(o) == iABx);
409 lua_assert(a <= MAXARG_A && bc <= MAXARG_Bx);
410 return luaK_code(fs, CREATE_ABx(o, a, bc));
411}
412
413
414/*
415** Format and emit an 'iAsBx' instruction.
416*/
417int luaK_codeAsBx (FuncState *fs, OpCode o, int a, int bc) {
418 unsigned int b = bc + OFFSET_sBx;
419 lua_assert(getOpMode(o) == iAsBx);
420 lua_assert(a <= MAXARG_A && b <= MAXARG_Bx);
421 return luaK_code(fs, CREATE_ABx(o, a, b));
422}
423
424
425/*
426** Format and emit an 'isJ' instruction.
427*/
428static int codesJ (FuncState *fs, OpCode o, int sj, int k) {
429 unsigned int j = sj + OFFSET_sJ;
430 lua_assert(getOpMode(o) == isJ);
431 lua_assert(j <= MAXARG_sJ && (k & ~1) == 0);
432 return luaK_code(fs, CREATE_sJ(o, j, k));
433}
434
435
436/*
437** Emit an "extra argument" instruction (format 'iAx')
438*/
439static int codeextraarg (FuncState *fs, int a) {
440 lua_assert(a <= MAXARG_Ax);
441 return luaK_code(fs, CREATE_Ax(OP_EXTRAARG, a));
442}
443
444
445/*
446** Emit a "load constant" instruction, using either 'OP_LOADK'
447** (if constant index 'k' fits in 18 bits) or an 'OP_LOADKX'
448** instruction with "extra argument".
449*/
450static int luaK_codek (FuncState *fs, int reg, int k) {
451 if (k <= MAXARG_Bx)
452 return luaK_codeABx(fs, OP_LOADK, reg, k);
453 else {
454 int p = luaK_codeABx(fs, OP_LOADKX, reg, 0);
455 codeextraarg(fs, k);
456 return p;
457 }
458}
459
460
461/*
462** Check register-stack level, keeping track of its maximum size
463** in field 'maxstacksize'
464*/
465void luaK_checkstack (FuncState *fs, int n) {
466 int newstack = fs->freereg + n;
467 if (newstack > fs->f->maxstacksize) {
468 if (newstack >= MAXREGS)
469 luaX_syntaxerror(fs->ls,
470 "function or expression needs too many registers");
471 fs->f->maxstacksize = cast_byte(newstack);
472 }
473}
474
475
476/*
477** Reserve 'n' registers in register stack
478*/
479void luaK_reserveregs (FuncState *fs, int n) {
480 luaK_checkstack(fs, n);
481 fs->freereg += n;
482}
483
484
485/*
486** Free register 'reg', if it is neither a constant index nor
487** a local variable.
488)
489*/
490static void freereg (FuncState *fs, int reg) {
491 if (reg >= luaY_nvarstack(fs)) {
492 fs->freereg--;
493 lua_assert(reg == fs->freereg);
494 }
495}
496
497
498/*
499** Free two registers in proper order
500*/
501static void freeregs (FuncState *fs, int r1, int r2) {
502 if (r1 > r2) {
503 freereg(fs, r1);
504 freereg(fs, r2);
505 }
506 else {
507 freereg(fs, r2);
508 freereg(fs, r1);
509 }
510}
511
512
513/*
514** Free register used by expression 'e' (if any)
515*/
516static void freeexp (FuncState *fs, expdesc *e) {
517 if (e->k == VNONRELOC)
518 freereg(fs, e->u.info);
519}
520
521
522/*
523** Free registers used by expressions 'e1' and 'e2' (if any) in proper
524** order.
525*/
526static void freeexps (FuncState *fs, expdesc *e1, expdesc *e2) {
527 int r1 = (e1->k == VNONRELOC) ? e1->u.info : -1;
528 int r2 = (e2->k == VNONRELOC) ? e2->u.info : -1;
529 freeregs(fs, r1, r2);
530}
531
532
533/*
534** Add constant 'v' to prototype's list of constants (field 'k').
535** Use scanner's table to cache position of constants in constant list
536** and try to reuse constants. Because some values should not be used
537** as keys (nil cannot be a key, integer keys can collapse with float
538** keys), the caller must provide a useful 'key' for indexing the cache.
539** Note that all functions share the same table, so entering or exiting
540** a function can make some indices wrong.
541*/
542static int addk (FuncState *fs, TValue *key, TValue *v) {
543 TValue val;
544 lua_State *L = fs->ls->L;
545 Proto *f = fs->f;
546 const TValue *idx = luaH_get(fs->ls->h, key); /* query scanner table */
547 int k, oldsize;
548 if (ttisinteger(idx)) { /* is there an index there? */
549 k = cast_int(ivalue(idx));
550 /* correct value? (warning: must distinguish floats from integers!) */
551 if (k < fs->nk && ttypetag(&f->k[k]) == ttypetag(v) &&
552 luaV_rawequalobj(&f->k[k], v))
553 return k; /* reuse index */
554 }
555 /* constant not found; create a new entry */
556 oldsize = f->sizek;
557 k = fs->nk;
558 /* numerical value does not need GC barrier;
559 table has no metatable, so it does not need to invalidate cache */
560 setivalue(&val, k);
561 luaH_finishset(L, fs->ls->h, key, idx, &val);
562 luaM_growvector(L, f->k, k, f->sizek, TValue, MAXARG_Ax, "constants");
563 while (oldsize < f->sizek) setnilvalue(&f->k[oldsize++]);
564 setobj(L, &f->k[k], v);
565 fs->nk++;
566 luaC_barrier(L, f, v);
567 return k;
568}
569
570
571/*
572** Add a string to list of constants and return its index.
573*/
574static int stringK (FuncState *fs, TString *s) {
575 TValue o;
576 setsvalue(fs->ls->L, &o, s);
577 return addk(fs, &o, &o); /* use string itself as key */
578}
579
580
581/*
582** Add an integer to list of constants and return its index.
583** Integers use userdata as keys to avoid collision with floats with
584** same value; conversion to 'void*' is used only for hashing, so there
585** are no "precision" problems.
586*/
587static int luaK_intK (FuncState *fs, lua_Integer n) {
588 TValue k, o;
589 setpvalue(&k, cast_voidp(cast_sizet(n)));
590 setivalue(&o, n);
591 return addk(fs, &k, &o);
592}
593
594/*
595** Add a float to list of constants and return its index.
596*/
597static int luaK_numberK (FuncState *fs, lua_Number r) {
598 TValue o;
599 setfltvalue(&o, r);
600 return addk(fs, &o, &o); /* use number itself as key */
601}
602
603
604/*
605** Add a false to list of constants and return its index.
606*/
607static int boolF (FuncState *fs) {
608 TValue o;
609 setbfvalue(&o);
610 return addk(fs, &o, &o); /* use boolean itself as key */
611}
612
613
614/*
615** Add a true to list of constants and return its index.
616*/
617static int boolT (FuncState *fs) {
618 TValue o;
619 setbtvalue(&o);
620 return addk(fs, &o, &o); /* use boolean itself as key */
621}
622
623
624/*
625** Add nil to list of constants and return its index.
626*/
627static int nilK (FuncState *fs) {
628 TValue k, v;
629 setnilvalue(&v);
630 /* cannot use nil as key; instead use table itself to represent nil */
631 sethvalue(fs->ls->L, &k, fs->ls->h);
632 return addk(fs, &k, &v);
633}
634
635
636/*
637** Check whether 'i' can be stored in an 'sC' operand. Equivalent to
638** (0 <= int2sC(i) && int2sC(i) <= MAXARG_C) but without risk of
639** overflows in the hidden addition inside 'int2sC'.
640*/
641static int fitsC (lua_Integer i) {
642 return (l_castS2U(i) + OFFSET_sC <= cast_uint(MAXARG_C));
643}
644
645
646/*
647** Check whether 'i' can be stored in an 'sBx' operand.
648*/
649static int fitsBx (lua_Integer i) {
650 return (-OFFSET_sBx <= i && i <= MAXARG_Bx - OFFSET_sBx);
651}
652
653
654void luaK_int (FuncState *fs, int reg, lua_Integer i) {
655 if (fitsBx(i))
656 luaK_codeAsBx(fs, OP_LOADI, reg, cast_int(i));
657 else
658 luaK_codek(fs, reg, luaK_intK(fs, i));
659}
660
661
662static void luaK_float (FuncState *fs, int reg, lua_Number f) {
663 lua_Integer fi;
664 if (luaV_flttointeger(f, &fi, F2Ieq) && fitsBx(fi))
665 luaK_codeAsBx(fs, OP_LOADF, reg, cast_int(fi));
666 else
667 luaK_codek(fs, reg, luaK_numberK(fs, f));
668}
669
670
671/*
672** Convert a constant in 'v' into an expression description 'e'
673*/
674static void const2exp (TValue *v, expdesc *e) {
675 switch (ttypetag(v)) {
676 case LUA_VNUMINT:
677 e->k = VKINT; e->u.ival = ivalue(v);
678 break;
679 case LUA_VNUMFLT:
680 e->k = VKFLT; e->u.nval = fltvalue(v);
681 break;
682 case LUA_VFALSE:
683 e->k = VFALSE;
684 break;
685 case LUA_VTRUE:
686 e->k = VTRUE;
687 break;
688 case LUA_VNIL:
689 e->k = VNIL;
690 break;
691 case LUA_VSHRSTR: case LUA_VLNGSTR:
692 e->k = VKSTR; e->u.strval = tsvalue(v);
693 break;
694 default: lua_assert(0);
695 }
696}
697
698
699/*
700** Fix an expression to return the number of results 'nresults'.
701** 'e' must be a multi-ret expression (function call or vararg).
702*/
703void luaK_setreturns (FuncState *fs, expdesc *e, int nresults) {
704 Instruction *pc = &getinstruction(fs, e);
705 if (e->k == VCALL) /* expression is an open function call? */
706 SETARG_C(*pc, nresults + 1);
707 else {
708 lua_assert(e->k == VVARARG);
709 SETARG_C(*pc, nresults + 1);
710 SETARG_A(*pc, fs->freereg);
711 luaK_reserveregs(fs, 1);
712 }
713}
714
715
716/*
717** Convert a VKSTR to a VK
718*/
719static void str2K (FuncState *fs, expdesc *e) {
720 lua_assert(e->k == VKSTR);
721 e->u.info = stringK(fs, e->u.strval);
722 e->k = VK;
723}
724
725
726/*
727** Fix an expression to return one result.
728** If expression is not a multi-ret expression (function call or
729** vararg), it already returns one result, so nothing needs to be done.
730** Function calls become VNONRELOC expressions (as its result comes
731** fixed in the base register of the call), while vararg expressions
732** become VRELOC (as OP_VARARG puts its results where it wants).
733** (Calls are created returning one result, so that does not need
734** to be fixed.)
735*/
736void luaK_setoneret (FuncState *fs, expdesc *e) {
737 if (e->k == VCALL) { /* expression is an open function call? */
738 /* already returns 1 value */
739 lua_assert(GETARG_C(getinstruction(fs, e)) == 2);
740 e->k = VNONRELOC; /* result has fixed position */
741 e->u.info = GETARG_A(getinstruction(fs, e));
742 }
743 else if (e->k == VVARARG) {
744 SETARG_C(getinstruction(fs, e), 2);
745 e->k = VRELOC; /* can relocate its simple result */
746 }
747}
748
749
750/*
751** Ensure that expression 'e' is not a variable (nor a <const>).
752** (Expression still may have jump lists.)
753*/
754void luaK_dischargevars (FuncState *fs, expdesc *e) {
755 switch (e->k) {
756 case VCONST: {
757 const2exp(const2val(fs, e), e);
758 break;
759 }
760 case VLOCAL: { /* already in a register */
761 e->u.info = e->u.var.ridx;
762 e->k = VNONRELOC; /* becomes a non-relocatable value */
763 break;
764 }
765 case VUPVAL: { /* move value to some (pending) register */
766 e->u.info = luaK_codeABC(fs, OP_GETUPVAL, 0, e->u.info, 0);
767 e->k = VRELOC;
768 break;
769 }
770 case VINDEXUP: {
771 e->u.info = luaK_codeABC(fs, OP_GETTABUP, 0, e->u.ind.t, e->u.ind.idx);
772 e->k = VRELOC;
773 break;
774 }
775 case VINDEXI: {
776 freereg(fs, e->u.ind.t);
777 e->u.info = luaK_codeABC(fs, OP_GETI, 0, e->u.ind.t, e->u.ind.idx);
778 e->k = VRELOC;
779 break;
780 }
781 case VINDEXSTR: {
782 freereg(fs, e->u.ind.t);
783 e->u.info = luaK_codeABC(fs, OP_GETFIELD, 0, e->u.ind.t, e->u.ind.idx);
784 e->k = VRELOC;
785 break;
786 }
787 case VINDEXED: {
788 freeregs(fs, e->u.ind.t, e->u.ind.idx);
789 e->u.info = luaK_codeABC(fs, OP_GETTABLE, 0, e->u.ind.t, e->u.ind.idx);
790 e->k = VRELOC;
791 break;
792 }
793 case VVARARG: case VCALL: {
794 luaK_setoneret(fs, e);
795 break;
796 }
797 default: break; /* there is one value available (somewhere) */
798 }
799}
800
801
802/*
803** Ensure expression value is in register 'reg', making 'e' a
804** non-relocatable expression.
805** (Expression still may have jump lists.)
806*/
807static void discharge2reg (FuncState *fs, expdesc *e, int reg) {
808 luaK_dischargevars(fs, e);
809 switch (e->k) {
810 case VNIL: {
811 luaK_nil(fs, reg, 1);
812 break;
813 }
814 case VFALSE: {
815 luaK_codeABC(fs, OP_LOADFALSE, reg, 0, 0);
816 break;
817 }
818 case VTRUE: {
819 luaK_codeABC(fs, OP_LOADTRUE, reg, 0, 0);
820 break;
821 }
822 case VKSTR: {
823 str2K(fs, e);
824 } /* FALLTHROUGH */
825 case VK: {
826 luaK_codek(fs, reg, e->u.info);
827 break;
828 }
829 case VKFLT: {
830 luaK_float(fs, reg, e->u.nval);
831 break;
832 }
833 case VKINT: {
834 luaK_int(fs, reg, e->u.ival);
835 break;
836 }
837 case VRELOC: {
838 Instruction *pc = &getinstruction(fs, e);
839 SETARG_A(*pc, reg); /* instruction will put result in 'reg' */
840 break;
841 }
842 case VNONRELOC: {
843 if (reg != e->u.info)
844 luaK_codeABC(fs, OP_MOVE, reg, e->u.info, 0);
845 break;
846 }
847 default: {
848 lua_assert(e->k == VJMP);
849 return; /* nothing to do... */
850 }
851 }
852 e->u.info = reg;
853 e->k = VNONRELOC;
854}
855
856
857/*
858** Ensure expression value is in a register, making 'e' a
859** non-relocatable expression.
860** (Expression still may have jump lists.)
861*/
862static void discharge2anyreg (FuncState *fs, expdesc *e) {
863 if (e->k != VNONRELOC) { /* no fixed register yet? */
864 luaK_reserveregs(fs, 1); /* get a register */
865 discharge2reg(fs, e, fs->freereg-1); /* put value there */
866 }
867}
868
869
870static int code_loadbool (FuncState *fs, int A, OpCode op) {
871 luaK_getlabel(fs); /* those instructions may be jump targets */
872 return luaK_codeABC(fs, op, A, 0, 0);
873}
874
875
876/*
877** check whether list has any jump that do not produce a value
878** or produce an inverted value
879*/
880static int need_value (FuncState *fs, int list) {
881 for (; list != NO_JUMP; list = getjump(fs, list)) {
882 Instruction i = *getjumpcontrol(fs, list);
883 if (GET_OPCODE(i) != OP_TESTSET) return 1;
884 }
885 return 0; /* not found */
886}
887
888
889/*
890** Ensures final expression result (which includes results from its
891** jump lists) is in register 'reg'.
892** If expression has jumps, need to patch these jumps either to
893** its final position or to "load" instructions (for those tests
894** that do not produce values).
895*/
896static void exp2reg (FuncState *fs, expdesc *e, int reg) {
897 discharge2reg(fs, e, reg);
898 if (e->k == VJMP) /* expression itself is a test? */
899 luaK_concat(fs, &e->t, e->u.info); /* put this jump in 't' list */
900 if (hasjumps(e)) {
901 int final; /* position after whole expression */
902 int p_f = NO_JUMP; /* position of an eventual LOAD false */
903 int p_t = NO_JUMP; /* position of an eventual LOAD true */
904 if (need_value(fs, e->t) || need_value(fs, e->f)) {
905 int fj = (e->k == VJMP) ? NO_JUMP : luaK_jump(fs);
906 p_f = code_loadbool(fs, reg, OP_LFALSESKIP); /* skip next inst. */
907 p_t = code_loadbool(fs, reg, OP_LOADTRUE);
908 /* jump around these booleans if 'e' is not a test */
909 luaK_patchtohere(fs, fj);
910 }
911 final = luaK_getlabel(fs);
912 patchlistaux(fs, e->f, final, reg, p_f);
913 patchlistaux(fs, e->t, final, reg, p_t);
914 }
915 e->f = e->t = NO_JUMP;
916 e->u.info = reg;
917 e->k = VNONRELOC;
918}
919
920
921/*
922** Ensures final expression result is in next available register.
923*/
924void luaK_exp2nextreg (FuncState *fs, expdesc *e) {
925 luaK_dischargevars(fs, e);
926 freeexp(fs, e);
927 luaK_reserveregs(fs, 1);
928 exp2reg(fs, e, fs->freereg - 1);
929}
930
931
932/*
933** Ensures final expression result is in some (any) register
934** and return that register.
935*/
936int luaK_exp2anyreg (FuncState *fs, expdesc *e) {
937 luaK_dischargevars(fs, e);
938 if (e->k == VNONRELOC) { /* expression already has a register? */
939 if (!hasjumps(e)) /* no jumps? */
940 return e->u.info; /* result is already in a register */
941 if (e->u.info >= luaY_nvarstack(fs)) { /* reg. is not a local? */
942 exp2reg(fs, e, e->u.info); /* put final result in it */
943 return e->u.info;
944 }
945 /* else expression has jumps and cannot change its register
946 to hold the jump values, because it is a local variable.
947 Go through to the default case. */
948 }
949 luaK_exp2nextreg(fs, e); /* default: use next available register */
950 return e->u.info;
951}
952
953
954/*
955** Ensures final expression result is either in a register
956** or in an upvalue.
957*/
958void luaK_exp2anyregup (FuncState *fs, expdesc *e) {
959 if (e->k != VUPVAL || hasjumps(e))
960 luaK_exp2anyreg(fs, e);
961}
962
963
964/*
965** Ensures final expression result is either in a register
966** or it is a constant.
967*/
968void luaK_exp2val (FuncState *fs, expdesc *e) {
969 if (hasjumps(e))
970 luaK_exp2anyreg(fs, e);
971 else
972 luaK_dischargevars(fs, e);
973}
974
975
976/*
977** Try to make 'e' a K expression with an index in the range of R/K
978** indices. Return true iff succeeded.
979*/
980static int luaK_exp2K (FuncState *fs, expdesc *e) {
981 if (!hasjumps(e)) {
982 int info;
983 switch (e->k) { /* move constants to 'k' */
984 case VTRUE: info = boolT(fs); break;
985 case VFALSE: info = boolF(fs); break;
986 case VNIL: info = nilK(fs); break;
987 case VKINT: info = luaK_intK(fs, e->u.ival); break;
988 case VKFLT: info = luaK_numberK(fs, e->u.nval); break;
989 case VKSTR: info = stringK(fs, e->u.strval); break;
990 case VK: info = e->u.info; break;
991 default: return 0; /* not a constant */
992 }
993 if (info <= MAXINDEXRK) { /* does constant fit in 'argC'? */
994 e->k = VK; /* make expression a 'K' expression */
995 e->u.info = info;
996 return 1;
997 }
998 }
999 /* else, expression doesn't fit; leave it unchanged */
1000 return 0;
1001}
1002
1003
1004/*
1005** Ensures final expression result is in a valid R/K index
1006** (that is, it is either in a register or in 'k' with an index
1007** in the range of R/K indices).
1008** Returns 1 iff expression is K.
1009*/
1010int luaK_exp2RK (FuncState *fs, expdesc *e) {
1011 if (luaK_exp2K(fs, e))
1012 return 1;
1013 else { /* not a constant in the right range: put it in a register */
1014 luaK_exp2anyreg(fs, e);
1015 return 0;
1016 }
1017}
1018
1019
1020static void codeABRK (FuncState *fs, OpCode o, int a, int b,
1021 expdesc *ec) {
1022 int k = luaK_exp2RK(fs, ec);
1023 luaK_codeABCk(fs, o, a, b, ec->u.info, k);
1024}
1025
1026
1027/*
1028** Generate code to store result of expression 'ex' into variable 'var'.
1029*/
1030void luaK_storevar (FuncState *fs, expdesc *var, expdesc *ex) {
1031 switch (var->k) {
1032 case VLOCAL: {
1033 freeexp(fs, ex);
1034 exp2reg(fs, ex, var->u.var.ridx); /* compute 'ex' into proper place */
1035 return;
1036 }
1037 case VUPVAL: {
1038 int e = luaK_exp2anyreg(fs, ex);
1039 luaK_codeABC(fs, OP_SETUPVAL, e, var->u.info, 0);
1040 break;
1041 }
1042 case VINDEXUP: {
1043 codeABRK(fs, OP_SETTABUP, var->u.ind.t, var->u.ind.idx, ex);
1044 break;
1045 }
1046 case VINDEXI: {
1047 codeABRK(fs, OP_SETI, var->u.ind.t, var->u.ind.idx, ex);
1048 break;
1049 }
1050 case VINDEXSTR: {
1051 codeABRK(fs, OP_SETFIELD, var->u.ind.t, var->u.ind.idx, ex);
1052 break;
1053 }
1054 case VINDEXED: {
1055 codeABRK(fs, OP_SETTABLE, var->u.ind.t, var->u.ind.idx, ex);
1056 break;
1057 }
1058 default: lua_assert(0); /* invalid var kind to store */
1059 }
1060 freeexp(fs, ex);
1061}
1062
1063
1064/*
1065** Emit SELF instruction (convert expression 'e' into 'e:key(e,').
1066*/
1067void luaK_self (FuncState *fs, expdesc *e, expdesc *key) {
1068 int ereg;
1069 luaK_exp2anyreg(fs, e);
1070 ereg = e->u.info; /* register where 'e' was placed */
1071 freeexp(fs, e);
1072 e->u.info = fs->freereg; /* base register for op_self */
1073 e->k = VNONRELOC; /* self expression has a fixed register */
1074 luaK_reserveregs(fs, 2); /* function and 'self' produced by op_self */
1075 codeABRK(fs, OP_SELF, e->u.info, ereg, key);
1076 freeexp(fs, key);
1077}
1078
1079
1080/*
1081** Negate condition 'e' (where 'e' is a comparison).
1082*/
1083static void negatecondition (FuncState *fs, expdesc *e) {
1084 Instruction *pc = getjumpcontrol(fs, e->u.info);
1085 lua_assert(testTMode(GET_OPCODE(*pc)) && GET_OPCODE(*pc) != OP_TESTSET &&
1086 GET_OPCODE(*pc) != OP_TEST);
1087 SETARG_k(*pc, (GETARG_k(*pc) ^ 1));
1088}
1089
1090
1091/*
1092** Emit instruction to jump if 'e' is 'cond' (that is, if 'cond'
1093** is true, code will jump if 'e' is true.) Return jump position.
1094** Optimize when 'e' is 'not' something, inverting the condition
1095** and removing the 'not'.
1096*/
1097static int jumponcond (FuncState *fs, expdesc *e, int cond) {
1098 if (e->k == VRELOC) {
1099 Instruction ie = getinstruction(fs, e);
1100 if (GET_OPCODE(ie) == OP_NOT) {
1101 removelastinstruction(fs); /* remove previous OP_NOT */
1102 return condjump(fs, OP_TEST, GETARG_B(ie), 0, 0, !cond);
1103 }
1104 /* else go through */
1105 }
1106 discharge2anyreg(fs, e);
1107 freeexp(fs, e);
1108 return condjump(fs, OP_TESTSET, NO_REG, e->u.info, 0, cond);
1109}
1110
1111
1112/*
1113** Emit code to go through if 'e' is true, jump otherwise.
1114*/
1115void luaK_goiftrue (FuncState *fs, expdesc *e) {
1116 int pc; /* pc of new jump */
1117 luaK_dischargevars(fs, e);
1118 switch (e->k) {
1119 case VJMP: { /* condition? */
1120 negatecondition(fs, e); /* jump when it is false */
1121 pc = e->u.info; /* save jump position */
1122 break;
1123 }
1124 case VK: case VKFLT: case VKINT: case VKSTR: case VTRUE: {
1125 pc = NO_JUMP; /* always true; do nothing */
1126 break;
1127 }
1128 default: {
1129 pc = jumponcond(fs, e, 0); /* jump when false */
1130 break;
1131 }
1132 }
1133 luaK_concat(fs, &e->f, pc); /* insert new jump in false list */
1134 luaK_patchtohere(fs, e->t); /* true list jumps to here (to go through) */
1135 e->t = NO_JUMP;
1136}
1137
1138
1139/*
1140** Emit code to go through if 'e' is false, jump otherwise.
1141*/
1142void luaK_goiffalse (FuncState *fs, expdesc *e) {
1143 int pc; /* pc of new jump */
1144 luaK_dischargevars(fs, e);
1145 switch (e->k) {
1146 case VJMP: {
1147 pc = e->u.info; /* already jump if true */
1148 break;
1149 }
1150 case VNIL: case VFALSE: {
1151 pc = NO_JUMP; /* always false; do nothing */
1152 break;
1153 }
1154 default: {
1155 pc = jumponcond(fs, e, 1); /* jump if true */
1156 break;
1157 }
1158 }
1159 luaK_concat(fs, &e->t, pc); /* insert new jump in 't' list */
1160 luaK_patchtohere(fs, e->f); /* false list jumps to here (to go through) */
1161 e->f = NO_JUMP;
1162}
1163
1164
1165/*
1166** Code 'not e', doing constant folding.
1167*/
1168static void codenot (FuncState *fs, expdesc *e) {
1169 switch (e->k) {
1170 case VNIL: case VFALSE: {
1171 e->k = VTRUE; /* true == not nil == not false */
1172 break;
1173 }
1174 case VK: case VKFLT: case VKINT: case VKSTR: case VTRUE: {
1175 e->k = VFALSE; /* false == not "x" == not 0.5 == not 1 == not true */
1176 break;
1177 }
1178 case VJMP: {
1179 negatecondition(fs, e);
1180 break;
1181 }
1182 case VRELOC:
1183 case VNONRELOC: {
1184 discharge2anyreg(fs, e);
1185 freeexp(fs, e);
1186 e->u.info = luaK_codeABC(fs, OP_NOT, 0, e->u.info, 0);
1187 e->k = VRELOC;
1188 break;
1189 }
1190 default: lua_assert(0); /* cannot happen */
1191 }
1192 /* interchange true and false lists */
1193 { int temp = e->f; e->f = e->t; e->t = temp; }
1194 removevalues(fs, e->f); /* values are useless when negated */
1195 removevalues(fs, e->t);
1196}
1197
1198
1199/*
1200** Check whether expression 'e' is a small literal string
1201*/
1202static int isKstr (FuncState *fs, expdesc *e) {
1203 return (e->k == VK && !hasjumps(e) && e->u.info <= MAXARG_B &&
1204 ttisshrstring(&fs->f->k[e->u.info]));
1205}
1206
1207/*
1208** Check whether expression 'e' is a literal integer.
1209*/
1210int luaK_isKint (expdesc *e) {
1211 return (e->k == VKINT && !hasjumps(e));
1212}
1213
1214
1215/*
1216** Check whether expression 'e' is a literal integer in
1217** proper range to fit in register C
1218*/
1219static int isCint (expdesc *e) {
1220 return luaK_isKint(e) && (l_castS2U(e->u.ival) <= l_castS2U(MAXARG_C));
1221}
1222
1223
1224/*
1225** Check whether expression 'e' is a literal integer in
1226** proper range to fit in register sC
1227*/
1228static int isSCint (expdesc *e) {
1229 return luaK_isKint(e) && fitsC(e->u.ival);
1230}
1231
1232
1233/*
1234** Check whether expression 'e' is a literal integer or float in
1235** proper range to fit in a register (sB or sC).
1236*/
1237static int isSCnumber (expdesc *e, int *pi, int *isfloat) {
1238 lua_Integer i;
1239 if (e->k == VKINT)
1240 i = e->u.ival;
1241 else if (e->k == VKFLT && luaV_flttointeger(e->u.nval, &i, F2Ieq))
1242 *isfloat = 1;
1243 else
1244 return 0; /* not a number */
1245 if (!hasjumps(e) && fitsC(i)) {
1246 *pi = int2sC(cast_int(i));
1247 return 1;
1248 }
1249 else
1250 return 0;
1251}
1252
1253
1254/*
1255** Create expression 't[k]'. 't' must have its final result already in a
1256** register or upvalue. Upvalues can only be indexed by literal strings.
1257** Keys can be literal strings in the constant table or arbitrary
1258** values in registers.
1259*/
1260void luaK_indexed (FuncState *fs, expdesc *t, expdesc *k) {
1261 if (k->k == VKSTR)
1262 str2K(fs, k);
1263 lua_assert(!hasjumps(t) &&
1264 (t->k == VLOCAL || t->k == VNONRELOC || t->k == VUPVAL));
1265 if (t->k == VUPVAL && !isKstr(fs, k)) /* upvalue indexed by non 'Kstr'? */
1266 luaK_exp2anyreg(fs, t); /* put it in a register */
1267 if (t->k == VUPVAL) {
1268 t->u.ind.t = t->u.info; /* upvalue index */
1269 t->u.ind.idx = k->u.info; /* literal string */
1270 t->k = VINDEXUP;
1271 }
1272 else {
1273 /* register index of the table */
1274 t->u.ind.t = (t->k == VLOCAL) ? t->u.var.ridx: t->u.info;
1275 if (isKstr(fs, k)) {
1276 t->u.ind.idx = k->u.info; /* literal string */
1277 t->k = VINDEXSTR;
1278 }
1279 else if (isCint(k)) {
1280 t->u.ind.idx = cast_int(k->u.ival); /* int. constant in proper range */
1281 t->k = VINDEXI;
1282 }
1283 else {
1284 t->u.ind.idx = luaK_exp2anyreg(fs, k); /* register */
1285 t->k = VINDEXED;
1286 }
1287 }
1288}
1289
1290
1291/*
1292** Return false if folding can raise an error.
1293** Bitwise operations need operands convertible to integers; division
1294** operations cannot have 0 as divisor.
1295*/
1296static int validop (int op, TValue *v1, TValue *v2) {
1297 switch (op) {
1298 case LUA_OPBAND: case LUA_OPBOR: case LUA_OPBXOR:
1299 case LUA_OPSHL: case LUA_OPSHR: case LUA_OPBNOT: { /* conversion errors */
1300 lua_Integer i;
1301 return (luaV_tointegerns(v1, &i, LUA_FLOORN2I) &&
1302 luaV_tointegerns(v2, &i, LUA_FLOORN2I));
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
deleted file mode 100644
index 3265824..0000000
--- a/src/lua/lcode.h
+++ /dev/null
@@ -1,104 +0,0 @@
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
deleted file mode 100644
index fedbebe..0000000
--- a/src/lua/lcorolib.c
+++ /dev/null
@@ -1,210 +0,0 @@
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 (l_unlikely(!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 (l_likely(status == LUA_OK || status == LUA_YIELD)) {
41 if (l_unlikely(!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 (l_unlikely(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 (l_unlikely(r < 0)) { /* error? */
77 int stat = lua_status(co);
78 if (stat != LUA_OK && stat != LUA_YIELD) { /* error in the coroutine? */
79 stat = lua_resetthread(co); /* close its tbc variables */
80 lua_assert(stat != LUA_OK);
81 lua_xmove(co, L, 1); /* copy error message */
82 }
83 if (stat != LUA_ERRMEM && /* not a memory error and ... */
84 lua_type(L, -1) == LUA_TSTRING) { /* ... error object is a string? */
85 luaL_where(L, 1); /* add extra info, if available */
86 lua_insert(L, -2);
87 lua_concat(L, 2);
88 }
89 return lua_error(L); /* propagate error */
90 }
91 return r;
92}
93
94
95static int luaB_cocreate (lua_State *L) {
96 lua_State *NL;
97 luaL_checktype(L, 1, LUA_TFUNCTION);
98 NL = lua_newthread(L);
99 lua_pushvalue(L, 1); /* move function to top */
100 lua_xmove(L, NL, 1); /* move function from L to NL */
101 return 1;
102}
103
104
105static int luaB_cowrap (lua_State *L) {
106 luaB_cocreate(L);
107 lua_pushcclosure(L, luaB_auxwrap, 1);
108 return 1;
109}
110
111
112static int luaB_yield (lua_State *L) {
113 return lua_yield(L, lua_gettop(L));
114}
115
116
117#define COS_RUN 0
118#define COS_DEAD 1
119#define COS_YIELD 2
120#define COS_NORM 3
121
122
123static const char *const statname[] =
124 {"running", "dead", "suspended", "normal"};
125
126
127static int auxstatus (lua_State *L, lua_State *co) {
128 if (L == co) return COS_RUN;
129 else {
130 switch (lua_status(co)) {
131 case LUA_YIELD:
132 return COS_YIELD;
133 case LUA_OK: {
134 lua_Debug ar;
135 if (lua_getstack(co, 0, &ar)) /* does it have frames? */
136 return COS_NORM; /* it is running */
137 else if (lua_gettop(co) == 0)
138 return COS_DEAD;
139 else
140 return COS_YIELD; /* initial state */
141 }
142 default: /* some error occurred */
143 return COS_DEAD;
144 }
145 }
146}
147
148
149static int luaB_costatus (lua_State *L) {
150 lua_State *co = getco(L);
151 lua_pushstring(L, statname[auxstatus(L, co)]);
152 return 1;
153}
154
155
156static int luaB_yieldable (lua_State *L) {
157 lua_State *co = lua_isnone(L, 1) ? L : getco(L);
158 lua_pushboolean(L, lua_isyieldable(co));
159 return 1;
160}
161
162
163static int luaB_corunning (lua_State *L) {
164 int ismain = lua_pushthread(L);
165 lua_pushboolean(L, ismain);
166 return 2;
167}
168
169
170static int luaB_close (lua_State *L) {
171 lua_State *co = getco(L);
172 int status = auxstatus(L, co);
173 switch (status) {
174 case COS_DEAD: case COS_YIELD: {
175 status = lua_resetthread(co);
176 if (status == LUA_OK) {
177 lua_pushboolean(L, 1);
178 return 1;
179 }
180 else {
181 lua_pushboolean(L, 0);
182 lua_xmove(co, L, 1); /* copy error message */
183 return 2;
184 }
185 }
186 default: /* normal or running coroutine */
187 return luaL_error(L, "cannot close a %s coroutine", statname[status]);
188 }
189}
190
191
192static const luaL_Reg co_funcs[] = {
193 {"create", luaB_cocreate},
194 {"resume", luaB_coresume},
195 {"running", luaB_corunning},
196 {"status", luaB_costatus},
197 {"wrap", luaB_cowrap},
198 {"yield", luaB_yield},
199 {"isyieldable", luaB_yieldable},
200 {"close", luaB_close},
201 {NULL, NULL}
202};
203
204
205
206LUAMOD_API int luaopen_coroutine (lua_State *L) {
207 luaL_newlib(L, co_funcs);
208 return 1;
209}
210
diff --git a/src/lua/lctype.c b/src/lua/lctype.c
deleted file mode 100644
index 9542280..0000000
--- a/src/lua/lctype.c
+++ /dev/null
@@ -1,64 +0,0 @@
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
deleted file mode 100644
index 864e190..0000000
--- a/src/lua/lctype.h
+++ /dev/null
@@ -1,101 +0,0 @@
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/*
66** In ASCII, this 'ltolower' is correct for alphabetic characters and
67** for '.'. That is enough for Lua needs. ('check_exp' ensures that
68** the character either is an upper-case letter or is unchanged by
69** the transformation, which holds for lower-case letters and '.'.)
70*/
71#define ltolower(c) \
72 check_exp(('A' <= (c) && (c) <= 'Z') || (c) == ((c) | ('A' ^ 'a')), \
73 (c) | ('A' ^ 'a'))
74
75
76/* one entry for each character and for -1 (EOZ) */
77LUAI_DDEC(const lu_byte luai_ctype_[UCHAR_MAX + 2];)
78
79
80#else /* }{ */
81
82/*
83** use standard C ctypes
84*/
85
86#include <ctype.h>
87
88
89#define lislalpha(c) (isalpha(c) || (c) == '_')
90#define lislalnum(c) (isalnum(c) || (c) == '_')
91#define lisdigit(c) (isdigit(c))
92#define lisspace(c) (isspace(c))
93#define lisprint(c) (isprint(c))
94#define lisxdigit(c) (isxdigit(c))
95
96#define ltolower(c) (tolower(c))
97
98#endif /* } */
99
100#endif
101
diff --git a/src/lua/ldblib.c b/src/lua/ldblib.c
deleted file mode 100644
index 6dcbaa9..0000000
--- a/src/lua/ldblib.c
+++ /dev/null
@@ -1,483 +0,0 @@
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_unlikely(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 luaL_argcheck(L, options[0] != '>', arg + 2, "invalid option '>'");
156 if (lua_isfunction(L, arg + 1)) { /* info about a function? */
157 options = lua_pushfstring(L, ">%s", options); /* add '>' to 'options' */
158 lua_pushvalue(L, arg + 1); /* move function to 'L1' stack */
159 lua_xmove(L, L1, 1);
160 }
161 else { /* stack level */
162 if (!lua_getstack(L1, (int)luaL_checkinteger(L, arg + 1), &ar)) {
163 luaL_pushfail(L); /* level out of range */
164 return 1;
165 }
166 }
167 if (!lua_getinfo(L1, options, &ar))
168 return luaL_argerror(L, arg+2, "invalid option");
169 lua_newtable(L); /* table to collect results */
170 if (strchr(options, 'S')) {
171 lua_pushlstring(L, ar.source, ar.srclen);
172 lua_setfield(L, -2, "source");
173 settabss(L, "short_src", ar.short_src);
174 settabsi(L, "linedefined", ar.linedefined);
175 settabsi(L, "lastlinedefined", ar.lastlinedefined);
176 settabss(L, "what", ar.what);
177 }
178 if (strchr(options, 'l'))
179 settabsi(L, "currentline", ar.currentline);
180 if (strchr(options, 'u')) {
181 settabsi(L, "nups", ar.nups);
182 settabsi(L, "nparams", ar.nparams);
183 settabsb(L, "isvararg", ar.isvararg);
184 }
185 if (strchr(options, 'n')) {
186 settabss(L, "name", ar.name);
187 settabss(L, "namewhat", ar.namewhat);
188 }
189 if (strchr(options, 'r')) {
190 settabsi(L, "ftransfer", ar.ftransfer);
191 settabsi(L, "ntransfer", ar.ntransfer);
192 }
193 if (strchr(options, 't'))
194 settabsb(L, "istailcall", ar.istailcall);
195 if (strchr(options, 'L'))
196 treatstackoption(L, L1, "activelines");
197 if (strchr(options, 'f'))
198 treatstackoption(L, L1, "func");
199 return 1; /* return table */
200}
201
202
203static int db_getlocal (lua_State *L) {
204 int arg;
205 lua_State *L1 = getthread(L, &arg);
206 int nvar = (int)luaL_checkinteger(L, arg + 2); /* local-variable index */
207 if (lua_isfunction(L, arg + 1)) { /* function argument? */
208 lua_pushvalue(L, arg + 1); /* push function */
209 lua_pushstring(L, lua_getlocal(L, NULL, nvar)); /* push local name */
210 return 1; /* return only name (there is no value) */
211 }
212 else { /* stack-level argument */
213 lua_Debug ar;
214 const char *name;
215 int level = (int)luaL_checkinteger(L, arg + 1);
216 if (l_unlikely(!lua_getstack(L1, level, &ar))) /* out of range? */
217 return luaL_argerror(L, arg+1, "level out of range");
218 checkstack(L, L1, 1);
219 name = lua_getlocal(L1, &ar, nvar);
220 if (name) {
221 lua_xmove(L1, L, 1); /* move local value */
222 lua_pushstring(L, name); /* push name */
223 lua_rotate(L, -2, 1); /* re-order */
224 return 2;
225 }
226 else {
227 luaL_pushfail(L); /* no name (nor value) */
228 return 1;
229 }
230 }
231}
232
233
234static int db_setlocal (lua_State *L) {
235 int arg;
236 const char *name;
237 lua_State *L1 = getthread(L, &arg);
238 lua_Debug ar;
239 int level = (int)luaL_checkinteger(L, arg + 1);
240 int nvar = (int)luaL_checkinteger(L, arg + 2);
241 if (l_unlikely(!lua_getstack(L1, level, &ar))) /* out of range? */
242 return luaL_argerror(L, arg+1, "level out of range");
243 luaL_checkany(L, arg+3);
244 lua_settop(L, arg+3);
245 checkstack(L, L1, 1);
246 lua_xmove(L, L1, 1);
247 name = lua_setlocal(L1, &ar, nvar);
248 if (name == NULL)
249 lua_pop(L1, 1); /* pop value (if not popped by 'lua_setlocal') */
250 lua_pushstring(L, name);
251 return 1;
252}
253
254
255/*
256** get (if 'get' is true) or set an upvalue from a closure
257*/
258static int auxupvalue (lua_State *L, int get) {
259 const char *name;
260 int n = (int)luaL_checkinteger(L, 2); /* upvalue index */
261 luaL_checktype(L, 1, LUA_TFUNCTION); /* closure */
262 name = get ? lua_getupvalue(L, 1, n) : lua_setupvalue(L, 1, n);
263 if (name == NULL) return 0;
264 lua_pushstring(L, name);
265 lua_insert(L, -(get+1)); /* no-op if get is false */
266 return get + 1;
267}
268
269
270static int db_getupvalue (lua_State *L) {
271 return auxupvalue(L, 1);
272}
273
274
275static int db_setupvalue (lua_State *L) {
276 luaL_checkany(L, 3);
277 return auxupvalue(L, 0);
278}
279
280
281/*
282** Check whether a given upvalue from a given closure exists and
283** returns its index
284*/
285static void *checkupval (lua_State *L, int argf, int argnup, int *pnup) {
286 void *id;
287 int nup = (int)luaL_checkinteger(L, argnup); /* upvalue index */
288 luaL_checktype(L, argf, LUA_TFUNCTION); /* closure */
289 id = lua_upvalueid(L, argf, nup);
290 if (pnup) {
291 luaL_argcheck(L, id != NULL, argnup, "invalid upvalue index");
292 *pnup = nup;
293 }
294 return id;
295}
296
297
298static int db_upvalueid (lua_State *L) {
299 void *id = checkupval(L, 1, 2, NULL);
300 if (id != NULL)
301 lua_pushlightuserdata(L, id);
302 else
303 luaL_pushfail(L);
304 return 1;
305}
306
307
308static int db_upvaluejoin (lua_State *L) {
309 int n1, n2;
310 checkupval(L, 1, 2, &n1);
311 checkupval(L, 3, 4, &n2);
312 luaL_argcheck(L, !lua_iscfunction(L, 1), 1, "Lua function expected");
313 luaL_argcheck(L, !lua_iscfunction(L, 3), 3, "Lua function expected");
314 lua_upvaluejoin(L, 1, n1, 3, n2);
315 return 0;
316}
317
318
319/*
320** Call hook function registered at hook table for the current
321** thread (if there is one)
322*/
323static void hookf (lua_State *L, lua_Debug *ar) {
324 static const char *const hooknames[] =
325 {"call", "return", "line", "count", "tail call"};
326 lua_getfield(L, LUA_REGISTRYINDEX, HOOKKEY);
327 lua_pushthread(L);
328 if (lua_rawget(L, -2) == LUA_TFUNCTION) { /* is there a hook function? */
329 lua_pushstring(L, hooknames[(int)ar->event]); /* push event name */
330 if (ar->currentline >= 0)
331 lua_pushinteger(L, ar->currentline); /* push current line */
332 else lua_pushnil(L);
333 lua_assert(lua_getinfo(L, "lS", ar));
334 lua_call(L, 2, 0); /* call hook function */
335 }
336}
337
338
339/*
340** Convert a string mask (for 'sethook') into a bit mask
341*/
342static int makemask (const char *smask, int count) {
343 int mask = 0;
344 if (strchr(smask, 'c')) mask |= LUA_MASKCALL;
345 if (strchr(smask, 'r')) mask |= LUA_MASKRET;
346 if (strchr(smask, 'l')) mask |= LUA_MASKLINE;
347 if (count > 0) mask |= LUA_MASKCOUNT;
348 return mask;
349}
350
351
352/*
353** Convert a bit mask (for 'gethook') into a string mask
354*/
355static char *unmakemask (int mask, char *smask) {
356 int i = 0;
357 if (mask & LUA_MASKCALL) smask[i++] = 'c';
358 if (mask & LUA_MASKRET) smask[i++] = 'r';
359 if (mask & LUA_MASKLINE) smask[i++] = 'l';
360 smask[i] = '\0';
361 return smask;
362}
363
364
365static int db_sethook (lua_State *L) {
366 int arg, mask, count;
367 lua_Hook func;
368 lua_State *L1 = getthread(L, &arg);
369 if (lua_isnoneornil(L, arg+1)) { /* no hook? */
370 lua_settop(L, arg+1);
371 func = NULL; mask = 0; count = 0; /* turn off hooks */
372 }
373 else {
374 const char *smask = luaL_checkstring(L, arg+2);
375 luaL_checktype(L, arg+1, LUA_TFUNCTION);
376 count = (int)luaL_optinteger(L, arg + 3, 0);
377 func = hookf; mask = makemask(smask, count);
378 }
379 if (!luaL_getsubtable(L, LUA_REGISTRYINDEX, HOOKKEY)) {
380 /* table just created; initialize it */
381 lua_pushliteral(L, "k");
382 lua_setfield(L, -2, "__mode"); /** hooktable.__mode = "k" */
383 lua_pushvalue(L, -1);
384 lua_setmetatable(L, -2); /* metatable(hooktable) = hooktable */
385 }
386 checkstack(L, L1, 1);
387 lua_pushthread(L1); lua_xmove(L1, L, 1); /* key (thread) */
388 lua_pushvalue(L, arg + 1); /* value (hook function) */
389 lua_rawset(L, -3); /* hooktable[L1] = new Lua hook */
390 lua_sethook(L1, func, mask, count);
391 return 0;
392}
393
394
395static int db_gethook (lua_State *L) {
396 int arg;
397 lua_State *L1 = getthread(L, &arg);
398 char buff[5];
399 int mask = lua_gethookmask(L1);
400 lua_Hook hook = lua_gethook(L1);
401 if (hook == NULL) { /* no hook? */
402 luaL_pushfail(L);
403 return 1;
404 }
405 else if (hook != hookf) /* external hook? */
406 lua_pushliteral(L, "external hook");
407 else { /* hook table must exist */
408 lua_getfield(L, LUA_REGISTRYINDEX, HOOKKEY);
409 checkstack(L, L1, 1);
410 lua_pushthread(L1); lua_xmove(L1, L, 1);
411 lua_rawget(L, -2); /* 1st result = hooktable[L1] */
412 lua_remove(L, -2); /* remove hook table */
413 }
414 lua_pushstring(L, unmakemask(mask, buff)); /* 2nd result = mask */
415 lua_pushinteger(L, lua_gethookcount(L1)); /* 3rd result = count */
416 return 3;
417}
418
419
420static int db_debug (lua_State *L) {
421 for (;;) {
422 char buffer[250];
423 lua_writestringerror("%s", "lua_debug> ");
424 if (fgets(buffer, sizeof(buffer), stdin) == NULL ||
425 strcmp(buffer, "cont\n") == 0)
426 return 0;
427 if (luaL_loadbuffer(L, buffer, strlen(buffer), "=(debug command)") ||
428 lua_pcall(L, 0, 0, 0))
429 lua_writestringerror("%s\n", luaL_tolstring(L, -1, NULL));
430 lua_settop(L, 0); /* remove eventual returns */
431 }
432}
433
434
435static int db_traceback (lua_State *L) {
436 int arg;
437 lua_State *L1 = getthread(L, &arg);
438 const char *msg = lua_tostring(L, arg + 1);
439 if (msg == NULL && !lua_isnoneornil(L, arg + 1)) /* non-string 'msg'? */
440 lua_pushvalue(L, arg + 1); /* return it untouched */
441 else {
442 int level = (int)luaL_optinteger(L, arg + 2, (L == L1) ? 1 : 0);
443 luaL_traceback(L, L1, msg, level);
444 }
445 return 1;
446}
447
448
449static int db_setcstacklimit (lua_State *L) {
450 int limit = (int)luaL_checkinteger(L, 1);
451 int res = lua_setcstacklimit(L, limit);
452 lua_pushinteger(L, res);
453 return 1;
454}
455
456
457static const luaL_Reg dblib[] = {
458 {"debug", db_debug},
459 {"getuservalue", db_getuservalue},
460 {"gethook", db_gethook},
461 {"getinfo", db_getinfo},
462 {"getlocal", db_getlocal},
463 {"getregistry", db_getregistry},
464 {"getmetatable", db_getmetatable},
465 {"getupvalue", db_getupvalue},
466 {"upvaluejoin", db_upvaluejoin},
467 {"upvalueid", db_upvalueid},
468 {"setuservalue", db_setuservalue},
469 {"sethook", db_sethook},
470 {"setlocal", db_setlocal},
471 {"setmetatable", db_setmetatable},
472 {"setupvalue", db_setupvalue},
473 {"traceback", db_traceback},
474 {"setcstacklimit", db_setcstacklimit},
475 {NULL, NULL}
476};
477
478
479LUAMOD_API int luaopen_debug (lua_State *L) {
480 luaL_newlib(L, dblib);
481 return 1;
482}
483
diff --git a/src/lua/ldebug.c b/src/lua/ldebug.c
deleted file mode 100644
index 1feaab2..0000000
--- a/src/lua/ldebug.c
+++ /dev/null
@@ -1,877 +0,0 @@
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
37static const char *funcnamefromcode (lua_State *L, CallInfo *ci,
38 const char **name);
39
40
41static int currentpc (CallInfo *ci) {
42 lua_assert(isLua(ci));
43 return pcRel(ci->u.l.savedpc, ci_func(ci)->p);
44}
45
46
47/*
48** Get a "base line" to find the line corresponding to an instruction.
49** Base lines are regularly placed at MAXIWTHABS intervals, so usually
50** an integer division gets the right place. When the source file has
51** large sequences of empty/comment lines, it may need extra entries,
52** so the original estimate needs a correction.
53** If the original estimate is -1, the initial 'if' ensures that the
54** 'while' will run at least once.
55** The assertion that the estimate is a lower bound for the correct base
56** is valid as long as the debug info has been generated with the same
57** value for MAXIWTHABS or smaller. (Previous releases use a little
58** smaller value.)
59*/
60static int getbaseline (const Proto *f, int pc, int *basepc) {
61 if (f->sizeabslineinfo == 0 || pc < f->abslineinfo[0].pc) {
62 *basepc = -1; /* start from the beginning */
63 return f->linedefined;
64 }
65 else {
66 int i = cast_uint(pc) / MAXIWTHABS - 1; /* get an estimate */
67 /* estimate must be a lower bond of the correct base */
68 lua_assert(i < 0 ||
69 (i < f->sizeabslineinfo && f->abslineinfo[i].pc <= pc));
70 while (i + 1 < f->sizeabslineinfo && pc >= f->abslineinfo[i + 1].pc)
71 i++; /* low estimate; adjust it */
72 *basepc = f->abslineinfo[i].pc;
73 return f->abslineinfo[i].line;
74 }
75}
76
77
78/*
79** Get the line corresponding to instruction 'pc' in function 'f';
80** first gets a base line and from there does the increments until
81** the desired instruction.
82*/
83int luaG_getfuncline (const Proto *f, int pc) {
84 if (f->lineinfo == NULL) /* no debug information? */
85 return -1;
86 else {
87 int basepc;
88 int baseline = getbaseline(f, pc, &basepc);
89 while (basepc++ < pc) { /* walk until given instruction */
90 lua_assert(f->lineinfo[basepc] != ABSLINEINFO);
91 baseline += f->lineinfo[basepc]; /* correct line */
92 }
93 return baseline;
94 }
95}
96
97
98static int getcurrentline (CallInfo *ci) {
99 return luaG_getfuncline(ci_func(ci)->p, currentpc(ci));
100}
101
102
103/*
104** Set 'trap' for all active Lua frames.
105** This function can be called during a signal, under "reasonable"
106** assumptions. A new 'ci' is completely linked in the list before it
107** becomes part of the "active" list, and we assume that pointers are
108** atomic; see comment in next function.
109** (A compiler doing interprocedural optimizations could, theoretically,
110** reorder memory writes in such a way that the list could be
111** temporarily broken while inserting a new element. We simply assume it
112** has no good reasons to do that.)
113*/
114static void settraps (CallInfo *ci) {
115 for (; ci != NULL; ci = ci->previous)
116 if (isLua(ci))
117 ci->u.l.trap = 1;
118}
119
120
121/*
122** This function can be called during a signal, under "reasonable"
123** assumptions.
124** Fields 'basehookcount' and 'hookcount' (set by 'resethookcount')
125** are for debug only, and it is no problem if they get arbitrary
126** values (causes at most one wrong hook call). 'hookmask' is an atomic
127** value. We assume that pointers are atomic too (e.g., gcc ensures that
128** for all platforms where it runs). Moreover, 'hook' is always checked
129** before being called (see 'luaD_hook').
130*/
131LUA_API void lua_sethook (lua_State *L, lua_Hook func, int mask, int count) {
132 if (func == NULL || mask == 0) { /* turn off hooks? */
133 mask = 0;
134 func = NULL;
135 }
136 L->hook = func;
137 L->basehookcount = count;
138 resethookcount(L);
139 L->hookmask = cast_byte(mask);
140 if (mask)
141 settraps(L->ci); /* to trace inside 'luaV_execute' */
142}
143
144
145LUA_API lua_Hook lua_gethook (lua_State *L) {
146 return L->hook;
147}
148
149
150LUA_API int lua_gethookmask (lua_State *L) {
151 return L->hookmask;
152}
153
154
155LUA_API int lua_gethookcount (lua_State *L) {
156 return L->basehookcount;
157}
158
159
160LUA_API int lua_getstack (lua_State *L, int level, lua_Debug *ar) {
161 int status;
162 CallInfo *ci;
163 if (level < 0) return 0; /* invalid (negative) level */
164 lua_lock(L);
165 for (ci = L->ci; level > 0 && ci != &L->base_ci; ci = ci->previous)
166 level--;
167 if (level == 0 && ci != &L->base_ci) { /* level found? */
168 status = 1;
169 ar->i_ci = ci;
170 }
171 else status = 0; /* no such level */
172 lua_unlock(L);
173 return status;
174}
175
176
177static const char *upvalname (const Proto *p, int uv) {
178 TString *s = check_exp(uv < p->sizeupvalues, p->upvalues[uv].name);
179 if (s == NULL) return "?";
180 else return getstr(s);
181}
182
183
184static const char *findvararg (CallInfo *ci, int n, StkId *pos) {
185 if (clLvalue(s2v(ci->func))->p->is_vararg) {
186 int nextra = ci->u.l.nextraargs;
187 if (n >= -nextra) { /* 'n' is negative */
188 *pos = ci->func - nextra - (n + 1);
189 return "(vararg)"; /* generic name for any vararg */
190 }
191 }
192 return NULL; /* no such vararg */
193}
194
195
196const char *luaG_findlocal (lua_State *L, CallInfo *ci, int n, StkId *pos) {
197 StkId base = ci->func + 1;
198 const char *name = NULL;
199 if (isLua(ci)) {
200 if (n < 0) /* access to vararg values? */
201 return findvararg(ci, n, pos);
202 else
203 name = luaF_getlocalname(ci_func(ci)->p, n, currentpc(ci));
204 }
205 if (name == NULL) { /* no 'standard' name? */
206 StkId limit = (ci == L->ci) ? L->top : ci->next->func;
207 if (limit - base >= n && n > 0) { /* is 'n' inside 'ci' stack? */
208 /* generic name for any valid slot */
209 name = isLua(ci) ? "(temporary)" : "(C temporary)";
210 }
211 else
212 return NULL; /* no name */
213 }
214 if (pos)
215 *pos = base + (n - 1);
216 return name;
217}
218
219
220LUA_API const char *lua_getlocal (lua_State *L, const lua_Debug *ar, int n) {
221 const char *name;
222 lua_lock(L);
223 if (ar == NULL) { /* information about non-active function? */
224 if (!isLfunction(s2v(L->top - 1))) /* not a Lua function? */
225 name = NULL;
226 else /* consider live variables at function start (parameters) */
227 name = luaF_getlocalname(clLvalue(s2v(L->top - 1))->p, n, 0);
228 }
229 else { /* active function; get information through 'ar' */
230 StkId pos = NULL; /* to avoid warnings */
231 name = luaG_findlocal(L, ar->i_ci, n, &pos);
232 if (name) {
233 setobjs2s(L, L->top, pos);
234 api_incr_top(L);
235 }
236 }
237 lua_unlock(L);
238 return name;
239}
240
241
242LUA_API const char *lua_setlocal (lua_State *L, const lua_Debug *ar, int n) {
243 StkId pos = NULL; /* to avoid warnings */
244 const char *name;
245 lua_lock(L);
246 name = luaG_findlocal(L, ar->i_ci, n, &pos);
247 if (name) {
248 setobjs2s(L, pos, L->top - 1);
249 L->top--; /* pop value */
250 }
251 lua_unlock(L);
252 return name;
253}
254
255
256static void funcinfo (lua_Debug *ar, Closure *cl) {
257 if (noLuaClosure(cl)) {
258 ar->source = "=[C]";
259 ar->srclen = LL("=[C]");
260 ar->linedefined = -1;
261 ar->lastlinedefined = -1;
262 ar->what = "C";
263 }
264 else {
265 const Proto *p = cl->l.p;
266 if (p->source) {
267 ar->source = getstr(p->source);
268 ar->srclen = tsslen(p->source);
269 }
270 else {
271 ar->source = "=?";
272 ar->srclen = LL("=?");
273 }
274 ar->linedefined = p->linedefined;
275 ar->lastlinedefined = p->lastlinedefined;
276 ar->what = (ar->linedefined == 0) ? "main" : "Lua";
277 }
278 luaO_chunkid(ar->short_src, ar->source, ar->srclen);
279}
280
281
282static int nextline (const Proto *p, int currentline, int pc) {
283 if (p->lineinfo[pc] != ABSLINEINFO)
284 return currentline + p->lineinfo[pc];
285 else
286 return luaG_getfuncline(p, pc);
287}
288
289
290static void collectvalidlines (lua_State *L, Closure *f) {
291 if (noLuaClosure(f)) {
292 setnilvalue(s2v(L->top));
293 api_incr_top(L);
294 }
295 else {
296 int i;
297 TValue v;
298 const Proto *p = f->l.p;
299 int currentline = p->linedefined;
300 Table *t = luaH_new(L); /* new table to store active lines */
301 sethvalue2s(L, L->top, t); /* push it on stack */
302 api_incr_top(L);
303 setbtvalue(&v); /* boolean 'true' to be the value of all indices */
304 for (i = 0; i < p->sizelineinfo; i++) { /* for all instructions */
305 currentline = nextline(p, currentline, i); /* get its line */
306 luaH_setint(L, t, currentline, &v); /* table[line] = true */
307 }
308 }
309}
310
311
312static const char *getfuncname (lua_State *L, CallInfo *ci, const char **name) {
313 if (ci == NULL) /* no 'ci'? */
314 return NULL; /* no info */
315 else if (ci->callstatus & CIST_FIN) { /* is this a finalizer? */
316 *name = "__gc";
317 return "metamethod"; /* report it as such */
318 }
319 /* calling function is a known Lua function? */
320 else if (!(ci->callstatus & CIST_TAIL) && isLua(ci->previous))
321 return funcnamefromcode(L, ci->previous, name);
322 else return NULL; /* no way to find a name */
323}
324
325
326static int auxgetinfo (lua_State *L, const char *what, lua_Debug *ar,
327 Closure *f, CallInfo *ci) {
328 int status = 1;
329 for (; *what; what++) {
330 switch (*what) {
331 case 'S': {
332 funcinfo(ar, f);
333 break;
334 }
335 case 'l': {
336 ar->currentline = (ci && isLua(ci)) ? getcurrentline(ci) : -1;
337 break;
338 }
339 case 'u': {
340 ar->nups = (f == NULL) ? 0 : f->c.nupvalues;
341 if (noLuaClosure(f)) {
342 ar->isvararg = 1;
343 ar->nparams = 0;
344 }
345 else {
346 ar->isvararg = f->l.p->is_vararg;
347 ar->nparams = f->l.p->numparams;
348 }
349 break;
350 }
351 case 't': {
352 ar->istailcall = (ci) ? ci->callstatus & CIST_TAIL : 0;
353 break;
354 }
355 case 'n': {
356 ar->namewhat = getfuncname(L, ci, &ar->name);
357 if (ar->namewhat == NULL) {
358 ar->namewhat = ""; /* not found */
359 ar->name = NULL;
360 }
361 break;
362 }
363 case 'r': {
364 if (ci == NULL || !(ci->callstatus & CIST_TRAN))
365 ar->ftransfer = ar->ntransfer = 0;
366 else {
367 ar->ftransfer = ci->u2.transferinfo.ftransfer;
368 ar->ntransfer = ci->u2.transferinfo.ntransfer;
369 }
370 break;
371 }
372 case 'L':
373 case 'f': /* handled by lua_getinfo */
374 break;
375 default: status = 0; /* invalid option */
376 }
377 }
378 return status;
379}
380
381
382LUA_API int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar) {
383 int status;
384 Closure *cl;
385 CallInfo *ci;
386 TValue *func;
387 lua_lock(L);
388 if (*what == '>') {
389 ci = NULL;
390 func = s2v(L->top - 1);
391 api_check(L, ttisfunction(func), "function expected");
392 what++; /* skip the '>' */
393 L->top--; /* pop function */
394 }
395 else {
396 ci = ar->i_ci;
397 func = s2v(ci->func);
398 lua_assert(ttisfunction(func));
399 }
400 cl = ttisclosure(func) ? clvalue(func) : NULL;
401 status = auxgetinfo(L, what, ar, cl, ci);
402 if (strchr(what, 'f')) {
403 setobj2s(L, L->top, func);
404 api_incr_top(L);
405 }
406 if (strchr(what, 'L'))
407 collectvalidlines(L, cl);
408 lua_unlock(L);
409 return status;
410}
411
412
413/*
414** {======================================================
415** Symbolic Execution
416** =======================================================
417*/
418
419static const char *getobjname (const Proto *p, int lastpc, int reg,
420 const char **name);
421
422
423/*
424** Find a "name" for the constant 'c'.
425*/
426static void kname (const Proto *p, int c, const char **name) {
427 TValue *kvalue = &p->k[c];
428 *name = (ttisstring(kvalue)) ? svalue(kvalue) : "?";
429}
430
431
432/*
433** Find a "name" for the register 'c'.
434*/
435static void rname (const Proto *p, int pc, int c, const char **name) {
436 const char *what = getobjname(p, pc, c, name); /* search for 'c' */
437 if (!(what && *what == 'c')) /* did not find a constant name? */
438 *name = "?";
439}
440
441
442/*
443** Find a "name" for a 'C' value in an RK instruction.
444*/
445static void rkname (const Proto *p, int pc, Instruction i, const char **name) {
446 int c = GETARG_C(i); /* key index */
447 if (GETARG_k(i)) /* is 'c' a constant? */
448 kname(p, c, name);
449 else /* 'c' is a register */
450 rname(p, pc, c, name);
451}
452
453
454static int filterpc (int pc, int jmptarget) {
455 if (pc < jmptarget) /* is code conditional (inside a jump)? */
456 return -1; /* cannot know who sets that register */
457 else return pc; /* current position sets that register */
458}
459
460
461/*
462** Try to find last instruction before 'lastpc' that modified register 'reg'.
463*/
464static int findsetreg (const Proto *p, int lastpc, int reg) {
465 int pc;
466 int setreg = -1; /* keep last instruction that changed 'reg' */
467 int jmptarget = 0; /* any code before this address is conditional */
468 if (testMMMode(GET_OPCODE(p->code[lastpc])))
469 lastpc--; /* previous instruction was not actually executed */
470 for (pc = 0; pc < lastpc; pc++) {
471 Instruction i = p->code[pc];
472 OpCode op = GET_OPCODE(i);
473 int a = GETARG_A(i);
474 int change; /* true if current instruction changed 'reg' */
475 switch (op) {
476 case OP_LOADNIL: { /* set registers from 'a' to 'a+b' */
477 int b = GETARG_B(i);
478 change = (a <= reg && reg <= a + b);
479 break;
480 }
481 case OP_TFORCALL: { /* affect all regs above its base */
482 change = (reg >= a + 2);
483 break;
484 }
485 case OP_CALL:
486 case OP_TAILCALL: { /* affect all registers above base */
487 change = (reg >= a);
488 break;
489 }
490 case OP_JMP: { /* doesn't change registers, but changes 'jmptarget' */
491 int b = GETARG_sJ(i);
492 int dest = pc + 1 + b;
493 /* jump does not skip 'lastpc' and is larger than current one? */
494 if (dest <= lastpc && dest > jmptarget)
495 jmptarget = dest; /* update 'jmptarget' */
496 change = 0;
497 break;
498 }
499 default: /* any instruction that sets A */
500 change = (testAMode(op) && reg == a);
501 break;
502 }
503 if (change)
504 setreg = filterpc(pc, jmptarget);
505 }
506 return setreg;
507}
508
509
510/*
511** Check whether table being indexed by instruction 'i' is the
512** environment '_ENV'
513*/
514static const char *gxf (const Proto *p, int pc, Instruction i, int isup) {
515 int t = GETARG_B(i); /* table index */
516 const char *name; /* name of indexed variable */
517 if (isup) /* is an upvalue? */
518 name = upvalname(p, t);
519 else
520 getobjname(p, pc, t, &name);
521 return (name && strcmp(name, LUA_ENV) == 0) ? "global" : "field";
522}
523
524
525static const char *getobjname (const Proto *p, int lastpc, int reg,
526 const char **name) {
527 int pc;
528 *name = luaF_getlocalname(p, reg + 1, lastpc);
529 if (*name) /* is a local? */
530 return "local";
531 /* else try symbolic execution */
532 pc = findsetreg(p, lastpc, reg);
533 if (pc != -1) { /* could find instruction? */
534 Instruction i = p->code[pc];
535 OpCode op = GET_OPCODE(i);
536 switch (op) {
537 case OP_MOVE: {
538 int b = GETARG_B(i); /* move from 'b' to 'a' */
539 if (b < GETARG_A(i))
540 return getobjname(p, pc, b, name); /* get name for 'b' */
541 break;
542 }
543 case OP_GETTABUP: {
544 int k = GETARG_C(i); /* key index */
545 kname(p, k, name);
546 return gxf(p, pc, i, 1);
547 }
548 case OP_GETTABLE: {
549 int k = GETARG_C(i); /* key index */
550 rname(p, pc, k, name);
551 return gxf(p, pc, i, 0);
552 }
553 case OP_GETI: {
554 *name = "integer index";
555 return "field";
556 }
557 case OP_GETFIELD: {
558 int k = GETARG_C(i); /* key index */
559 kname(p, k, name);
560 return gxf(p, pc, i, 0);
561 }
562 case OP_GETUPVAL: {
563 *name = upvalname(p, GETARG_B(i));
564 return "upvalue";
565 }
566 case OP_LOADK:
567 case OP_LOADKX: {
568 int b = (op == OP_LOADK) ? GETARG_Bx(i)
569 : GETARG_Ax(p->code[pc + 1]);
570 if (ttisstring(&p->k[b])) {
571 *name = svalue(&p->k[b]);
572 return "constant";
573 }
574 break;
575 }
576 case OP_SELF: {
577 rkname(p, pc, i, name);
578 return "method";
579 }
580 default: break; /* go through to return NULL */
581 }
582 }
583 return NULL; /* could not find reasonable name */
584}
585
586
587/*
588** Try to find a name for a function based on the code that called it.
589** (Only works when function was called by a Lua function.)
590** Returns what the name is (e.g., "for iterator", "method",
591** "metamethod") and sets '*name' to point to the name.
592*/
593static const char *funcnamefromcode (lua_State *L, CallInfo *ci,
594 const char **name) {
595 TMS tm = (TMS)0; /* (initial value avoids warnings) */
596 const Proto *p = ci_func(ci)->p; /* calling function */
597 int pc = currentpc(ci); /* calling instruction index */
598 Instruction i = p->code[pc]; /* calling instruction */
599 if (ci->callstatus & CIST_HOOKED) { /* was it called inside a hook? */
600 *name = "?";
601 return "hook";
602 }
603 switch (GET_OPCODE(i)) {
604 case OP_CALL:
605 case OP_TAILCALL:
606 return getobjname(p, pc, GETARG_A(i), name); /* get function name */
607 case OP_TFORCALL: { /* for iterator */
608 *name = "for iterator";
609 return "for iterator";
610 }
611 /* other instructions can do calls through metamethods */
612 case OP_SELF: case OP_GETTABUP: case OP_GETTABLE:
613 case OP_GETI: case OP_GETFIELD:
614 tm = TM_INDEX;
615 break;
616 case OP_SETTABUP: case OP_SETTABLE: case OP_SETI: case OP_SETFIELD:
617 tm = TM_NEWINDEX;
618 break;
619 case OP_MMBIN: case OP_MMBINI: case OP_MMBINK: {
620 tm = cast(TMS, GETARG_C(i));
621 break;
622 }
623 case OP_UNM: tm = TM_UNM; break;
624 case OP_BNOT: tm = TM_BNOT; break;
625 case OP_LEN: tm = TM_LEN; break;
626 case OP_CONCAT: tm = TM_CONCAT; break;
627 case OP_EQ: tm = TM_EQ; break;
628 /* no cases for OP_EQI and OP_EQK, as they don't call metamethods */
629 case OP_LT: case OP_LTI: case OP_GTI: tm = TM_LT; break;
630 case OP_LE: case OP_LEI: case OP_GEI: tm = TM_LE; break;
631 case OP_CLOSE: case OP_RETURN: tm = TM_CLOSE; break;
632 default:
633 return NULL; /* cannot find a reasonable name */
634 }
635 *name = getstr(G(L)->tmname[tm]) + 2;
636 return "metamethod";
637}
638
639/* }====================================================== */
640
641
642
643/*
644** Check whether pointer 'o' points to some value in the stack
645** frame of the current function. Because 'o' may not point to a
646** value in this stack, we cannot compare it with the region
647** boundaries (undefined behaviour in ISO C).
648*/
649static int isinstack (CallInfo *ci, const TValue *o) {
650 StkId pos;
651 for (pos = ci->func + 1; pos < ci->top; pos++) {
652 if (o == s2v(pos))
653 return 1;
654 }
655 return 0; /* not found */
656}
657
658
659/*
660** Checks whether value 'o' came from an upvalue. (That can only happen
661** with instructions OP_GETTABUP/OP_SETTABUP, which operate directly on
662** upvalues.)
663*/
664static const char *getupvalname (CallInfo *ci, const TValue *o,
665 const char **name) {
666 LClosure *c = ci_func(ci);
667 int i;
668 for (i = 0; i < c->nupvalues; i++) {
669 if (c->upvals[i]->v == o) {
670 *name = upvalname(c->p, i);
671 return "upvalue";
672 }
673 }
674 return NULL;
675}
676
677
678static const char *varinfo (lua_State *L, const TValue *o) {
679 const char *name = NULL; /* to avoid warnings */
680 CallInfo *ci = L->ci;
681 const char *kind = NULL;
682 if (isLua(ci)) {
683 kind = getupvalname(ci, o, &name); /* check whether 'o' is an upvalue */
684 if (!kind && isinstack(ci, o)) /* no? try a register */
685 kind = getobjname(ci_func(ci)->p, currentpc(ci),
686 cast_int(cast(StkId, o) - (ci->func + 1)), &name);
687 }
688 return (kind) ? luaO_pushfstring(L, " (%s '%s')", kind, name) : "";
689}
690
691
692l_noret luaG_typeerror (lua_State *L, const TValue *o, const char *op) {
693 const char *t = luaT_objtypename(L, o);
694 luaG_runerror(L, "attempt to %s a %s value%s", op, t, varinfo(L, o));
695}
696
697
698l_noret luaG_callerror (lua_State *L, const TValue *o) {
699 CallInfo *ci = L->ci;
700 const char *name = NULL; /* to avoid warnings */
701 const char *what = (isLua(ci)) ? funcnamefromcode(L, ci, &name) : NULL;
702 if (what != NULL) {
703 const char *t = luaT_objtypename(L, o);
704 luaG_runerror(L, "%s '%s' is not callable (a %s value)", what, name, t);
705 }
706 else
707 luaG_typeerror(L, o, "call");
708}
709
710
711l_noret luaG_forerror (lua_State *L, const TValue *o, const char *what) {
712 luaG_runerror(L, "bad 'for' %s (number expected, got %s)",
713 what, luaT_objtypename(L, o));
714}
715
716
717l_noret luaG_concaterror (lua_State *L, const TValue *p1, const TValue *p2) {
718 if (ttisstring(p1) || cvt2str(p1)) p1 = p2;
719 luaG_typeerror(L, p1, "concatenate");
720}
721
722
723l_noret luaG_opinterror (lua_State *L, const TValue *p1,
724 const TValue *p2, const char *msg) {
725 if (!ttisnumber(p1)) /* first operand is wrong? */
726 p2 = p1; /* now second is wrong */
727 luaG_typeerror(L, p2, msg);
728}
729
730
731/*
732** Error when both values are convertible to numbers, but not to integers
733*/
734l_noret luaG_tointerror (lua_State *L, const TValue *p1, const TValue *p2) {
735 lua_Integer temp;
736 if (!luaV_tointegerns(p1, &temp, LUA_FLOORN2I))
737 p2 = p1;
738 luaG_runerror(L, "number%s has no integer representation", varinfo(L, p2));
739}
740
741
742l_noret luaG_ordererror (lua_State *L, const TValue *p1, const TValue *p2) {
743 const char *t1 = luaT_objtypename(L, p1);
744 const char *t2 = luaT_objtypename(L, p2);
745 if (strcmp(t1, t2) == 0)
746 luaG_runerror(L, "attempt to compare two %s values", t1);
747 else
748 luaG_runerror(L, "attempt to compare %s with %s", t1, t2);
749}
750
751
752/* add src:line information to 'msg' */
753const char *luaG_addinfo (lua_State *L, const char *msg, TString *src,
754 int line) {
755 char buff[LUA_IDSIZE];
756 if (src)
757 luaO_chunkid(buff, getstr(src), tsslen(src));
758 else { /* no source available; use "?" instead */
759 buff[0] = '?'; buff[1] = '\0';
760 }
761 return luaO_pushfstring(L, "%s:%d: %s", buff, line, msg);
762}
763
764
765l_noret luaG_errormsg (lua_State *L) {
766 if (L->errfunc != 0) { /* is there an error handling function? */
767 StkId errfunc = restorestack(L, L->errfunc);
768 lua_assert(ttisfunction(s2v(errfunc)));
769 setobjs2s(L, L->top, L->top - 1); /* move argument */
770 setobjs2s(L, L->top - 1, errfunc); /* push function */
771 L->top++; /* assume EXTRA_STACK */
772 luaD_callnoyield(L, L->top - 2, 1); /* call it */
773 }
774 luaD_throw(L, LUA_ERRRUN);
775}
776
777
778l_noret luaG_runerror (lua_State *L, const char *fmt, ...) {
779 CallInfo *ci = L->ci;
780 const char *msg;
781 va_list argp;
782 luaC_checkGC(L); /* error message uses memory */
783 va_start(argp, fmt);
784 msg = luaO_pushvfstring(L, fmt, argp); /* format message */
785 va_end(argp);
786 if (isLua(ci)) /* if Lua function, add source:line information */
787 luaG_addinfo(L, msg, ci_func(ci)->p->source, getcurrentline(ci));
788 luaG_errormsg(L);
789}
790
791
792/*
793** Check whether new instruction 'newpc' is in a different line from
794** previous instruction 'oldpc'. More often than not, 'newpc' is only
795** one or a few instructions after 'oldpc' (it must be after, see
796** caller), so try to avoid calling 'luaG_getfuncline'. If they are
797** too far apart, there is a good chance of a ABSLINEINFO in the way,
798** so it goes directly to 'luaG_getfuncline'.
799*/
800static int changedline (const Proto *p, int oldpc, int newpc) {
801 if (p->lineinfo == NULL) /* no debug information? */
802 return 0;
803 if (newpc - oldpc < MAXIWTHABS / 2) { /* not too far apart? */
804 int delta = 0; /* line diference */
805 int pc = oldpc;
806 for (;;) {
807 int lineinfo = p->lineinfo[++pc];
808 if (lineinfo == ABSLINEINFO)
809 break; /* cannot compute delta; fall through */
810 delta += lineinfo;
811 if (pc == newpc)
812 return (delta != 0); /* delta computed successfully */
813 }
814 }
815 /* either instructions are too far apart or there is an absolute line
816 info in the way; compute line difference explicitly */
817 return (luaG_getfuncline(p, oldpc) != luaG_getfuncline(p, newpc));
818}
819
820
821/*
822** Traces the execution of a Lua function. Called before the execution
823** of each opcode, when debug is on. 'L->oldpc' stores the last
824** instruction traced, to detect line changes. When entering a new
825** function, 'npci' will be zero and will test as a new line whatever
826** the value of 'oldpc'. Some exceptional conditions may return to
827** a function without setting 'oldpc'. In that case, 'oldpc' may be
828** invalid; if so, use zero as a valid value. (A wrong but valid 'oldpc'
829** at most causes an extra call to a line hook.)
830** This function is not "Protected" when called, so it should correct
831** 'L->top' before calling anything that can run the GC.
832*/
833int luaG_traceexec (lua_State *L, const Instruction *pc) {
834 CallInfo *ci = L->ci;
835 lu_byte mask = L->hookmask;
836 const Proto *p = ci_func(ci)->p;
837 int counthook;
838 if (!(mask & (LUA_MASKLINE | LUA_MASKCOUNT))) { /* no hooks? */
839 ci->u.l.trap = 0; /* don't need to stop again */
840 return 0; /* turn off 'trap' */
841 }
842 pc++; /* reference is always next instruction */
843 ci->u.l.savedpc = pc; /* save 'pc' */
844 counthook = (--L->hookcount == 0 && (mask & LUA_MASKCOUNT));
845 if (counthook)
846 resethookcount(L); /* reset count */
847 else if (!(mask & LUA_MASKLINE))
848 return 1; /* no line hook and count != 0; nothing to be done now */
849 if (ci->callstatus & CIST_HOOKYIELD) { /* called hook last time? */
850 ci->callstatus &= ~CIST_HOOKYIELD; /* erase mark */
851 return 1; /* do not call hook again (VM yielded, so it did not move) */
852 }
853 if (!isIT(*(ci->u.l.savedpc - 1))) /* top not being used? */
854 L->top = ci->top; /* correct top */
855 if (counthook)
856 luaD_hook(L, LUA_HOOKCOUNT, -1, 0, 0); /* call count hook */
857 if (mask & LUA_MASKLINE) {
858 /* 'L->oldpc' may be invalid; use zero in this case */
859 int oldpc = (L->oldpc < p->sizecode) ? L->oldpc : 0;
860 int npci = pcRel(pc, p);
861 if (npci <= oldpc || /* call hook when jump back (loop), */
862 changedline(p, oldpc, npci)) { /* or when enter new line */
863 int newline = luaG_getfuncline(p, npci);
864 luaD_hook(L, LUA_HOOKLINE, newline, 0, 0); /* call line hook */
865 }
866 L->oldpc = npci; /* 'pc' of last call to line hook */
867 }
868 if (L->status == LUA_YIELD) { /* did hook yield? */
869 if (counthook)
870 L->hookcount = 1; /* undo decrement to zero */
871 ci->u.l.savedpc--; /* undo increment (resume will increment it again) */
872 ci->callstatus |= CIST_HOOKYIELD; /* mark that it yielded */
873 luaD_throw(L, LUA_YIELD);
874 }
875 return 1; /* keep 'trap' on */
876}
877
diff --git a/src/lua/ldebug.h b/src/lua/ldebug.h
deleted file mode 100644
index 974960e..0000000
--- a/src/lua/ldebug.h
+++ /dev/null
@@ -1,63 +0,0 @@
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
17/* Active Lua function (given call info) */
18#define ci_func(ci) (clLvalue(s2v((ci)->func)))
19
20
21#define resethookcount(L) (L->hookcount = L->basehookcount)
22
23/*
24** mark for entries in 'lineinfo' array that has absolute information in
25** 'abslineinfo' array
26*/
27#define ABSLINEINFO (-0x80)
28
29
30/*
31** MAXimum number of successive Instructions WiTHout ABSolute line
32** information. (A power of two allows fast divisions.)
33*/
34#if !defined(MAXIWTHABS)
35#define MAXIWTHABS 128
36#endif
37
38
39LUAI_FUNC int luaG_getfuncline (const Proto *f, int pc);
40LUAI_FUNC const char *luaG_findlocal (lua_State *L, CallInfo *ci, int n,
41 StkId *pos);
42LUAI_FUNC l_noret luaG_typeerror (lua_State *L, const TValue *o,
43 const char *opname);
44LUAI_FUNC l_noret luaG_callerror (lua_State *L, const TValue *o);
45LUAI_FUNC l_noret luaG_forerror (lua_State *L, const TValue *o,
46 const char *what);
47LUAI_FUNC l_noret luaG_concaterror (lua_State *L, const TValue *p1,
48 const TValue *p2);
49LUAI_FUNC l_noret luaG_opinterror (lua_State *L, const TValue *p1,
50 const TValue *p2,
51 const char *msg);
52LUAI_FUNC l_noret luaG_tointerror (lua_State *L, const TValue *p1,
53 const TValue *p2);
54LUAI_FUNC l_noret luaG_ordererror (lua_State *L, const TValue *p1,
55 const TValue *p2);
56LUAI_FUNC l_noret luaG_runerror (lua_State *L, const char *fmt, ...);
57LUAI_FUNC const char *luaG_addinfo (lua_State *L, const char *msg,
58 TString *src, int line);
59LUAI_FUNC l_noret luaG_errormsg (lua_State *L);
60LUAI_FUNC int luaG_traceexec (lua_State *L, const Instruction *pc);
61
62
63#endif
diff --git a/src/lua/ldo.c b/src/lua/ldo.c
deleted file mode 100644
index 7135079..0000000
--- a/src/lua/ldo.c
+++ /dev/null
@@ -1,963 +0,0 @@
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 LUA_OK: { /* special case only for closing upvalues */
102 setnilvalue(s2v(oldtop)); /* no error message */
103 break;
104 }
105 default: {
106 lua_assert(errorstatus(errcode)); /* real error */
107 setobjs2s(L, oldtop, L->top - 1); /* error message on current top */
108 break;
109 }
110 }
111 L->top = oldtop + 1;
112}
113
114
115l_noret luaD_throw (lua_State *L, int errcode) {
116 if (L->errorJmp) { /* thread has an error handler? */
117 L->errorJmp->status = errcode; /* set status */
118 LUAI_THROW(L, L->errorJmp); /* jump to it */
119 }
120 else { /* thread has no error handler */
121 global_State *g = G(L);
122 errcode = luaE_resetthread(L, errcode); /* close all upvalues */
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 lua_unlock(L);
130 g->panic(L); /* call panic function (last chance to jump out) */
131 }
132 abort();
133 }
134 }
135}
136
137
138int luaD_rawrunprotected (lua_State *L, Pfunc f, void *ud) {
139 l_uint32 oldnCcalls = L->nCcalls;
140 struct lua_longjmp lj;
141 lj.status = LUA_OK;
142 lj.previous = L->errorJmp; /* chain new error handler */
143 L->errorJmp = &lj;
144 LUAI_TRY(L, &lj,
145 (*f)(L, ud);
146 );
147 L->errorJmp = lj.previous; /* restore old error handler */
148 L->nCcalls = oldnCcalls;
149 return lj.status;
150}
151
152/* }====================================================== */
153
154
155/*
156** {==================================================================
157** Stack reallocation
158** ===================================================================
159*/
160static void correctstack (lua_State *L, StkId oldstack, StkId newstack) {
161 CallInfo *ci;
162 UpVal *up;
163 L->top = (L->top - oldstack) + newstack;
164 L->tbclist = (L->tbclist - oldstack) + newstack;
165 for (up = L->openupval; up != NULL; up = up->u.open.next)
166 up->v = s2v((uplevel(up) - oldstack) + newstack);
167 for (ci = L->ci; ci != NULL; ci = ci->previous) {
168 ci->top = (ci->top - oldstack) + newstack;
169 ci->func = (ci->func - oldstack) + newstack;
170 if (isLua(ci))
171 ci->u.l.trap = 1; /* signal to update 'trap' in 'luaV_execute' */
172 }
173}
174
175
176/* some space for error handling */
177#define ERRORSTACKSIZE (LUAI_MAXSTACK + 200)
178
179
180/*
181** Reallocate the stack to a new size, correcting all pointers into
182** it. (There are pointers to a stack from its upvalues, from its list
183** of call infos, plus a few individual pointers.) The reallocation is
184** done in two steps (allocation + free) because the correction must be
185** done while both addresses (the old stack and the new one) are valid.
186** (In ISO C, any pointer use after the pointer has been deallocated is
187** undefined behavior.)
188** In case of allocation error, raise an error or return false according
189** to 'raiseerror'.
190*/
191int luaD_reallocstack (lua_State *L, int newsize, int raiseerror) {
192 int oldsize = stacksize(L);
193 int i;
194 StkId newstack = luaM_reallocvector(L, NULL, 0,
195 newsize + EXTRA_STACK, StackValue);
196 lua_assert(newsize <= LUAI_MAXSTACK || newsize == ERRORSTACKSIZE);
197 if (l_unlikely(newstack == NULL)) { /* reallocation failed? */
198 if (raiseerror)
199 luaM_error(L);
200 else return 0; /* do not raise an error */
201 }
202 /* number of elements to be copied to the new stack */
203 i = ((oldsize <= newsize) ? oldsize : newsize) + EXTRA_STACK;
204 memcpy(newstack, L->stack, i * sizeof(StackValue));
205 for (; i < newsize + EXTRA_STACK; i++)
206 setnilvalue(s2v(newstack + i)); /* erase new segment */
207 correctstack(L, L->stack, newstack);
208 luaM_freearray(L, L->stack, oldsize + EXTRA_STACK);
209 L->stack = newstack;
210 L->stack_last = L->stack + newsize;
211 return 1;
212}
213
214
215/*
216** Try to grow the stack by at least 'n' elements. when 'raiseerror'
217** is true, raises any error; otherwise, return 0 in case of errors.
218*/
219int luaD_growstack (lua_State *L, int n, int raiseerror) {
220 int size = stacksize(L);
221 if (l_unlikely(size > LUAI_MAXSTACK)) {
222 /* if stack is larger than maximum, thread is already using the
223 extra space reserved for errors, that is, thread is handling
224 a stack error; cannot grow further than that. */
225 lua_assert(stacksize(L) == ERRORSTACKSIZE);
226 if (raiseerror)
227 luaD_throw(L, LUA_ERRERR); /* error inside message handler */
228 return 0; /* if not 'raiseerror', just signal it */
229 }
230 else {
231 int newsize = 2 * size; /* tentative new size */
232 int needed = cast_int(L->top - L->stack) + n;
233 if (newsize > LUAI_MAXSTACK) /* cannot cross the limit */
234 newsize = LUAI_MAXSTACK;
235 if (newsize < needed) /* but must respect what was asked for */
236 newsize = needed;
237 if (l_likely(newsize <= LUAI_MAXSTACK))
238 return luaD_reallocstack(L, newsize, raiseerror);
239 else { /* stack overflow */
240 /* add extra size to be able to handle the error message */
241 luaD_reallocstack(L, ERRORSTACKSIZE, raiseerror);
242 if (raiseerror)
243 luaG_runerror(L, "stack overflow");
244 return 0;
245 }
246 }
247}
248
249
250static int stackinuse (lua_State *L) {
251 CallInfo *ci;
252 int res;
253 StkId lim = L->top;
254 for (ci = L->ci; ci != NULL; ci = ci->previous) {
255 if (lim < ci->top) lim = ci->top;
256 }
257 lua_assert(lim <= L->stack_last);
258 res = cast_int(lim - L->stack) + 1; /* part of stack in use */
259 if (res < LUA_MINSTACK)
260 res = LUA_MINSTACK; /* ensure a minimum size */
261 return res;
262}
263
264
265/*
266** If stack size is more than 3 times the current use, reduce that size
267** to twice the current use. (So, the final stack size is at most 2/3 the
268** previous size, and half of its entries are empty.)
269** As a particular case, if stack was handling a stack overflow and now
270** it is not, 'max' (limited by LUAI_MAXSTACK) will be smaller than
271** stacksize (equal to ERRORSTACKSIZE in this case), and so the stack
272** will be reduced to a "regular" size.
273*/
274void luaD_shrinkstack (lua_State *L) {
275 int inuse = stackinuse(L);
276 int nsize = inuse * 2; /* proposed new size */
277 int max = inuse * 3; /* maximum "reasonable" size */
278 if (max > LUAI_MAXSTACK) {
279 max = LUAI_MAXSTACK; /* respect stack limit */
280 if (nsize > LUAI_MAXSTACK)
281 nsize = LUAI_MAXSTACK;
282 }
283 /* if thread is currently not handling a stack overflow and its
284 size is larger than maximum "reasonable" size, shrink it */
285 if (inuse <= LUAI_MAXSTACK && stacksize(L) > max)
286 luaD_reallocstack(L, nsize, 0); /* ok if that fails */
287 else /* don't change stack */
288 condmovestack(L,{},{}); /* (change only for debugging) */
289 luaE_shrinkCI(L); /* shrink CI list */
290}
291
292
293void luaD_inctop (lua_State *L) {
294 luaD_checkstack(L, 1);
295 L->top++;
296}
297
298/* }================================================================== */
299
300
301/*
302** Call a hook for the given event. Make sure there is a hook to be
303** called. (Both 'L->hook' and 'L->hookmask', which trigger this
304** function, can be changed asynchronously by signals.)
305*/
306void luaD_hook (lua_State *L, int event, int line,
307 int ftransfer, int ntransfer) {
308 lua_Hook hook = L->hook;
309 if (hook && L->allowhook) { /* make sure there is a hook */
310 int mask = CIST_HOOKED;
311 CallInfo *ci = L->ci;
312 ptrdiff_t top = savestack(L, L->top); /* preserve original 'top' */
313 ptrdiff_t ci_top = savestack(L, ci->top); /* idem for 'ci->top' */
314 lua_Debug ar;
315 ar.event = event;
316 ar.currentline = line;
317 ar.i_ci = ci;
318 if (ntransfer != 0) {
319 mask |= CIST_TRAN; /* 'ci' has transfer information */
320 ci->u2.transferinfo.ftransfer = ftransfer;
321 ci->u2.transferinfo.ntransfer = ntransfer;
322 }
323 if (isLua(ci) && L->top < ci->top)
324 L->top = ci->top; /* protect entire activation register */
325 luaD_checkstack(L, LUA_MINSTACK); /* ensure minimum stack size */
326 if (ci->top < L->top + LUA_MINSTACK)
327 ci->top = L->top + LUA_MINSTACK;
328 L->allowhook = 0; /* cannot call hooks inside a hook */
329 ci->callstatus |= mask;
330 lua_unlock(L);
331 (*hook)(L, &ar);
332 lua_lock(L);
333 lua_assert(!L->allowhook);
334 L->allowhook = 1;
335 ci->top = restorestack(L, ci_top);
336 L->top = restorestack(L, top);
337 ci->callstatus &= ~mask;
338 }
339}
340
341
342/*
343** Executes a call hook for Lua functions. This function is called
344** whenever 'hookmask' is not zero, so it checks whether call hooks are
345** active.
346*/
347void luaD_hookcall (lua_State *L, CallInfo *ci) {
348 L->oldpc = 0; /* set 'oldpc' for new function */
349 if (L->hookmask & LUA_MASKCALL) { /* is call hook on? */
350 int event = (ci->callstatus & CIST_TAIL) ? LUA_HOOKTAILCALL
351 : LUA_HOOKCALL;
352 Proto *p = ci_func(ci)->p;
353 ci->u.l.savedpc++; /* hooks assume 'pc' is already incremented */
354 luaD_hook(L, event, -1, 1, p->numparams);
355 ci->u.l.savedpc--; /* correct 'pc' */
356 }
357}
358
359
360/*
361** Executes a return hook for Lua and C functions and sets/corrects
362** 'oldpc'. (Note that this correction is needed by the line hook, so it
363** is done even when return hooks are off.)
364*/
365static void rethook (lua_State *L, CallInfo *ci, int nres) {
366 if (L->hookmask & LUA_MASKRET) { /* is return hook on? */
367 StkId firstres = L->top - nres; /* index of first result */
368 int delta = 0; /* correction for vararg functions */
369 int ftransfer;
370 if (isLua(ci)) {
371 Proto *p = ci_func(ci)->p;
372 if (p->is_vararg)
373 delta = ci->u.l.nextraargs + p->numparams + 1;
374 }
375 ci->func += delta; /* if vararg, back to virtual 'func' */
376 ftransfer = cast(unsigned short, firstres - ci->func);
377 luaD_hook(L, LUA_HOOKRET, -1, ftransfer, nres); /* call it */
378 ci->func -= delta;
379 }
380 if (isLua(ci = ci->previous))
381 L->oldpc = pcRel(ci->u.l.savedpc, ci_func(ci)->p); /* set 'oldpc' */
382}
383
384
385/*
386** Check whether 'func' has a '__call' metafield. If so, put it in the
387** stack, below original 'func', so that 'luaD_precall' can call it. Raise
388** an error if there is no '__call' metafield.
389*/
390void luaD_tryfuncTM (lua_State *L, StkId func) {
391 const TValue *tm = luaT_gettmbyobj(L, s2v(func), TM_CALL);
392 StkId p;
393 if (l_unlikely(ttisnil(tm)))
394 luaG_callerror(L, s2v(func)); /* nothing to call */
395 for (p = L->top; p > func; p--) /* open space for metamethod */
396 setobjs2s(L, p, p-1);
397 L->top++; /* stack space pre-allocated by the caller */
398 setobj2s(L, func, tm); /* metamethod is the new function to be called */
399}
400
401
402/*
403** Given 'nres' results at 'firstResult', move 'wanted' of them to 'res'.
404** Handle most typical cases (zero results for commands, one result for
405** expressions, multiple results for tail calls/single parameters)
406** separated.
407*/
408static void moveresults (lua_State *L, StkId res, int nres, int wanted) {
409 StkId firstresult;
410 int i;
411 switch (wanted) { /* handle typical cases separately */
412 case 0: /* no values needed */
413 L->top = res;
414 return;
415 case 1: /* one value needed */
416 if (nres == 0) /* no results? */
417 setnilvalue(s2v(res)); /* adjust with nil */
418 else /* at least one result */
419 setobjs2s(L, res, L->top - nres); /* move it to proper place */
420 L->top = res + 1;
421 return;
422 case LUA_MULTRET:
423 wanted = nres; /* we want all results */
424 break;
425 default: /* two/more results and/or to-be-closed variables */
426 if (hastocloseCfunc(wanted)) { /* to-be-closed variables? */
427 ptrdiff_t savedres = savestack(L, res);
428 L->ci->callstatus |= CIST_CLSRET; /* in case of yields */
429 L->ci->u2.nres = nres;
430 luaF_close(L, res, CLOSEKTOP, 1);
431 L->ci->callstatus &= ~CIST_CLSRET;
432 if (L->hookmask) /* if needed, call hook after '__close's */
433 rethook(L, L->ci, nres);
434 res = restorestack(L, savedres); /* close and hook can move stack */
435 wanted = decodeNresults(wanted);
436 if (wanted == LUA_MULTRET)
437 wanted = nres; /* we want all results */
438 }
439 break;
440 }
441 /* generic case */
442 firstresult = L->top - nres; /* index of first result */
443 if (nres > wanted) /* extra results? */
444 nres = wanted; /* don't need them */
445 for (i = 0; i < nres; i++) /* move all results to correct place */
446 setobjs2s(L, res + i, firstresult + i);
447 for (; i < wanted; i++) /* complete wanted number of results */
448 setnilvalue(s2v(res + i));
449 L->top = res + wanted; /* top points after the last result */
450}
451
452
453/*
454** Finishes a function call: calls hook if necessary, moves current
455** number of results to proper place, and returns to previous call
456** info. If function has to close variables, hook must be called after
457** that.
458*/
459void luaD_poscall (lua_State *L, CallInfo *ci, int nres) {
460 int wanted = ci->nresults;
461 if (l_unlikely(L->hookmask && !hastocloseCfunc(wanted)))
462 rethook(L, ci, nres);
463 /* move results to proper place */
464 moveresults(L, ci->func, nres, wanted);
465 /* function cannot be in any of these cases when returning */
466 lua_assert(!(ci->callstatus &
467 (CIST_HOOKED | CIST_YPCALL | CIST_FIN | CIST_TRAN | CIST_CLSRET)));
468 L->ci = ci->previous; /* back to caller (after closing variables) */
469}
470
471
472
473#define next_ci(L) (L->ci->next ? L->ci->next : luaE_extendCI(L))
474
475
476/*
477** Prepare a function for a tail call, building its call info on top
478** of the current call info. 'narg1' is the number of arguments plus 1
479** (so that it includes the function itself).
480*/
481void luaD_pretailcall (lua_State *L, CallInfo *ci, StkId func, int narg1) {
482 Proto *p = clLvalue(s2v(func))->p;
483 int fsize = p->maxstacksize; /* frame size */
484 int nfixparams = p->numparams;
485 int i;
486 for (i = 0; i < narg1; i++) /* move down function and arguments */
487 setobjs2s(L, ci->func + i, func + i);
488 checkstackGC(L, fsize);
489 func = ci->func; /* moved-down function */
490 for (; narg1 <= nfixparams; narg1++)
491 setnilvalue(s2v(func + narg1)); /* complete missing arguments */
492 ci->top = func + 1 + fsize; /* top for new function */
493 lua_assert(ci->top <= L->stack_last);
494 ci->u.l.savedpc = p->code; /* starting point */
495 ci->callstatus |= CIST_TAIL;
496 L->top = func + narg1; /* set top */
497}
498
499
500/*
501** Prepares the call to a function (C or Lua). For C functions, also do
502** the call. The function to be called is at '*func'. The arguments
503** are on the stack, right after the function. Returns the CallInfo
504** to be executed, if it was a Lua function. Otherwise (a C function)
505** returns NULL, with all the results on the stack, starting at the
506** original function position.
507*/
508CallInfo *luaD_precall (lua_State *L, StkId func, int nresults) {
509 lua_CFunction f;
510 retry:
511 switch (ttypetag(s2v(func))) {
512 case LUA_VCCL: /* C closure */
513 f = clCvalue(s2v(func))->f;
514 goto Cfunc;
515 case LUA_VLCF: /* light C function */
516 f = fvalue(s2v(func));
517 Cfunc: {
518 int n; /* number of returns */
519 CallInfo *ci;
520 checkstackGCp(L, LUA_MINSTACK, func); /* ensure minimum stack size */
521 L->ci = ci = next_ci(L);
522 ci->nresults = nresults;
523 ci->callstatus = CIST_C;
524 ci->top = L->top + LUA_MINSTACK;
525 ci->func = func;
526 lua_assert(ci->top <= L->stack_last);
527 if (l_unlikely(L->hookmask & LUA_MASKCALL)) {
528 int narg = cast_int(L->top - func) - 1;
529 luaD_hook(L, LUA_HOOKCALL, -1, 1, narg);
530 }
531 lua_unlock(L);
532 n = (*f)(L); /* do the actual call */
533 lua_lock(L);
534 api_checknelems(L, n);
535 luaD_poscall(L, ci, n);
536 return NULL;
537 }
538 case LUA_VLCL: { /* Lua function */
539 CallInfo *ci;
540 Proto *p = clLvalue(s2v(func))->p;
541 int narg = cast_int(L->top - func) - 1; /* number of real arguments */
542 int nfixparams = p->numparams;
543 int fsize = p->maxstacksize; /* frame size */
544 checkstackGCp(L, fsize, func);
545 L->ci = ci = next_ci(L);
546 ci->nresults = nresults;
547 ci->u.l.savedpc = p->code; /* starting point */
548 ci->top = func + 1 + fsize;
549 ci->func = func;
550 L->ci = ci;
551 for (; narg < nfixparams; narg++)
552 setnilvalue(s2v(L->top++)); /* complete missing arguments */
553 lua_assert(ci->top <= L->stack_last);
554 return ci;
555 }
556 default: { /* not a function */
557 checkstackGCp(L, 1, func); /* space for metamethod */
558 luaD_tryfuncTM(L, func); /* try to get '__call' metamethod */
559 goto retry; /* try again with metamethod */
560 }
561 }
562}
563
564
565/*
566** Call a function (C or Lua) through C. 'inc' can be 1 (increment
567** number of recursive invocations in the C stack) or nyci (the same
568** plus increment number of non-yieldable calls).
569*/
570static void ccall (lua_State *L, StkId func, int nResults, int inc) {
571 CallInfo *ci;
572 L->nCcalls += inc;
573 if (l_unlikely(getCcalls(L) >= LUAI_MAXCCALLS))
574 luaE_checkcstack(L);
575 if ((ci = luaD_precall(L, func, nResults)) != NULL) { /* Lua function? */
576 ci->callstatus = CIST_FRESH; /* mark that it is a "fresh" execute */
577 luaV_execute(L, ci); /* call it */
578 }
579 L->nCcalls -= inc;
580}
581
582
583/*
584** External interface for 'ccall'
585*/
586void luaD_call (lua_State *L, StkId func, int nResults) {
587 ccall(L, func, nResults, 1);
588}
589
590
591/*
592** Similar to 'luaD_call', but does not allow yields during the call.
593*/
594void luaD_callnoyield (lua_State *L, StkId func, int nResults) {
595 ccall(L, func, nResults, nyci);
596}
597
598
599/*
600** Finish the job of 'lua_pcallk' after it was interrupted by an yield.
601** (The caller, 'finishCcall', does the final call to 'adjustresults'.)
602** The main job is to complete the 'luaD_pcall' called by 'lua_pcallk'.
603** If a '__close' method yields here, eventually control will be back
604** to 'finishCcall' (when that '__close' method finally returns) and
605** 'finishpcallk' will run again and close any still pending '__close'
606** methods. Similarly, if a '__close' method errs, 'precover' calls
607** 'unroll' which calls ''finishCcall' and we are back here again, to
608** close any pending '__close' methods.
609** Note that, up to the call to 'luaF_close', the corresponding
610** 'CallInfo' is not modified, so that this repeated run works like the
611** first one (except that it has at least one less '__close' to do). In
612** particular, field CIST_RECST preserves the error status across these
613** multiple runs, changing only if there is a new error.
614*/
615static int finishpcallk (lua_State *L, CallInfo *ci) {
616 int status = getcistrecst(ci); /* get original status */
617 if (l_likely(status == LUA_OK)) /* no error? */
618 status = LUA_YIELD; /* was interrupted by an yield */
619 else { /* error */
620 StkId func = restorestack(L, ci->u2.funcidx);
621 L->allowhook = getoah(ci->callstatus); /* restore 'allowhook' */
622 luaF_close(L, func, status, 1); /* can yield or raise an error */
623 func = restorestack(L, ci->u2.funcidx); /* stack may be moved */
624 luaD_seterrorobj(L, status, func);
625 luaD_shrinkstack(L); /* restore stack size in case of overflow */
626 setcistrecst(ci, LUA_OK); /* clear original status */
627 }
628 ci->callstatus &= ~CIST_YPCALL;
629 L->errfunc = ci->u.c.old_errfunc;
630 /* if it is here, there were errors or yields; unlike 'lua_pcallk',
631 do not change status */
632 return status;
633}
634
635
636/*
637** Completes the execution of a C function interrupted by an yield.
638** The interruption must have happened while the function was either
639** closing its tbc variables in 'moveresults' or executing
640** 'lua_callk'/'lua_pcallk'. In the first case, it just redoes
641** 'luaD_poscall'. In the second case, the call to 'finishpcallk'
642** finishes the interrupted execution of 'lua_pcallk'. After that, it
643** calls the continuation of the interrupted function and finally it
644** completes the job of the 'luaD_call' that called the function. In
645** the call to 'adjustresults', we do not know the number of results
646** of the function called by 'lua_callk'/'lua_pcallk', so we are
647** conservative and use LUA_MULTRET (always adjust).
648*/
649static void finishCcall (lua_State *L, CallInfo *ci) {
650 int n; /* actual number of results from C function */
651 if (ci->callstatus & CIST_CLSRET) { /* was returning? */
652 lua_assert(hastocloseCfunc(ci->nresults));
653 n = ci->u2.nres; /* just redo 'luaD_poscall' */
654 /* don't need to reset CIST_CLSRET, as it will be set again anyway */
655 }
656 else {
657 int status = LUA_YIELD; /* default if there were no errors */
658 /* must have a continuation and must be able to call it */
659 lua_assert(ci->u.c.k != NULL && yieldable(L));
660 if (ci->callstatus & CIST_YPCALL) /* was inside a 'lua_pcallk'? */
661 status = finishpcallk(L, ci); /* finish it */
662 adjustresults(L, LUA_MULTRET); /* finish 'lua_callk' */
663 lua_unlock(L);
664 n = (*ci->u.c.k)(L, status, ci->u.c.ctx); /* call continuation */
665 lua_lock(L);
666 api_checknelems(L, n);
667 }
668 luaD_poscall(L, ci, n); /* finish 'luaD_call' */
669}
670
671
672/*
673** Executes "full continuation" (everything in the stack) of a
674** previously interrupted coroutine until the stack is empty (or another
675** interruption long-jumps out of the loop).
676*/
677static void unroll (lua_State *L, void *ud) {
678 CallInfo *ci;
679 UNUSED(ud);
680 while ((ci = L->ci) != &L->base_ci) { /* something in the stack */
681 if (!isLua(ci)) /* C function? */
682 finishCcall(L, ci); /* complete its execution */
683 else { /* Lua function */
684 luaV_finishOp(L); /* finish interrupted instruction */
685 luaV_execute(L, ci); /* execute down to higher C 'boundary' */
686 }
687 }
688}
689
690
691/*
692** Try to find a suspended protected call (a "recover point") for the
693** given thread.
694*/
695static CallInfo *findpcall (lua_State *L) {
696 CallInfo *ci;
697 for (ci = L->ci; ci != NULL; ci = ci->previous) { /* search for a pcall */
698 if (ci->callstatus & CIST_YPCALL)
699 return ci;
700 }
701 return NULL; /* no pending pcall */
702}
703
704
705/*
706** Signal an error in the call to 'lua_resume', not in the execution
707** of the coroutine itself. (Such errors should not be handled by any
708** coroutine error handler and should not kill the coroutine.)
709*/
710static int resume_error (lua_State *L, const char *msg, int narg) {
711 L->top -= narg; /* remove args from the stack */
712 setsvalue2s(L, L->top, luaS_new(L, msg)); /* push error message */
713 api_incr_top(L);
714 lua_unlock(L);
715 return LUA_ERRRUN;
716}
717
718
719/*
720** Do the work for 'lua_resume' in protected mode. Most of the work
721** depends on the status of the coroutine: initial state, suspended
722** inside a hook, or regularly suspended (optionally with a continuation
723** function), plus erroneous cases: non-suspended coroutine or dead
724** coroutine.
725*/
726static void resume (lua_State *L, void *ud) {
727 int n = *(cast(int*, ud)); /* number of arguments */
728 StkId firstArg = L->top - n; /* first argument */
729 CallInfo *ci = L->ci;
730 if (L->status == LUA_OK) /* starting a coroutine? */
731 ccall(L, firstArg - 1, LUA_MULTRET, 1); /* just call its body */
732 else { /* resuming from previous yield */
733 lua_assert(L->status == LUA_YIELD);
734 L->status = LUA_OK; /* mark that it is running (again) */
735 luaE_incCstack(L); /* control the C stack */
736 if (isLua(ci)) { /* yielded inside a hook? */
737 L->top = firstArg; /* discard arguments */
738 luaV_execute(L, ci); /* just continue running Lua code */
739 }
740 else { /* 'common' yield */
741 if (ci->u.c.k != NULL) { /* does it have a continuation function? */
742 lua_unlock(L);
743 n = (*ci->u.c.k)(L, LUA_YIELD, ci->u.c.ctx); /* call continuation */
744 lua_lock(L);
745 api_checknelems(L, n);
746 }
747 luaD_poscall(L, ci, n); /* finish 'luaD_call' */
748 }
749 unroll(L, NULL); /* run continuation */
750 }
751}
752
753
754/*
755** Unrolls a coroutine in protected mode while there are recoverable
756** errors, that is, errors inside a protected call. (Any error
757** interrupts 'unroll', and this loop protects it again so it can
758** continue.) Stops with a normal end (status == LUA_OK), an yield
759** (status == LUA_YIELD), or an unprotected error ('findpcall' doesn't
760** find a recover point).
761*/
762static int precover (lua_State *L, int status) {
763 CallInfo *ci;
764 while (errorstatus(status) && (ci = findpcall(L)) != NULL) {
765 L->ci = ci; /* go down to recovery functions */
766 setcistrecst(ci, status); /* status to finish 'pcall' */
767 status = luaD_rawrunprotected(L, unroll, NULL);
768 }
769 return status;
770}
771
772
773LUA_API int lua_resume (lua_State *L, lua_State *from, int nargs,
774 int *nresults) {
775 int status;
776 lua_lock(L);
777 if (L->status == LUA_OK) { /* may be starting a coroutine */
778 if (L->ci != &L->base_ci) /* not in base level? */
779 return resume_error(L, "cannot resume non-suspended coroutine", nargs);
780 else if (L->top - (L->ci->func + 1) == nargs) /* no function? */
781 return resume_error(L, "cannot resume dead coroutine", nargs);
782 }
783 else if (L->status != LUA_YIELD) /* ended with errors? */
784 return resume_error(L, "cannot resume dead coroutine", nargs);
785 L->nCcalls = (from) ? getCcalls(from) : 0;
786 luai_userstateresume(L, nargs);
787 api_checknelems(L, (L->status == LUA_OK) ? nargs + 1 : nargs);
788 status = luaD_rawrunprotected(L, resume, &nargs);
789 /* continue running after recoverable errors */
790 status = precover(L, status);
791 if (l_likely(!errorstatus(status)))
792 lua_assert(status == L->status); /* normal end or yield */
793 else { /* unrecoverable error */
794 L->status = cast_byte(status); /* mark thread as 'dead' */
795 luaD_seterrorobj(L, status, L->top); /* push error message */
796 L->ci->top = L->top;
797 }
798 *nresults = (status == LUA_YIELD) ? L->ci->u2.nyield
799 : cast_int(L->top - (L->ci->func + 1));
800 lua_unlock(L);
801 return status;
802}
803
804
805LUA_API int lua_isyieldable (lua_State *L) {
806 return yieldable(L);
807}
808
809
810LUA_API int lua_yieldk (lua_State *L, int nresults, lua_KContext ctx,
811 lua_KFunction k) {
812 CallInfo *ci;
813 luai_userstateyield(L, nresults);
814 lua_lock(L);
815 ci = L->ci;
816 api_checknelems(L, nresults);
817 if (l_unlikely(!yieldable(L))) {
818 if (L != G(L)->mainthread)
819 luaG_runerror(L, "attempt to yield across a C-call boundary");
820 else
821 luaG_runerror(L, "attempt to yield from outside a coroutine");
822 }
823 L->status = LUA_YIELD;
824 ci->u2.nyield = nresults; /* save number of results */
825 if (isLua(ci)) { /* inside a hook? */
826 lua_assert(!isLuacode(ci));
827 api_check(L, nresults == 0, "hooks cannot yield values");
828 api_check(L, k == NULL, "hooks cannot continue after yielding");
829 }
830 else {
831 if ((ci->u.c.k = k) != NULL) /* is there a continuation? */
832 ci->u.c.ctx = ctx; /* save context */
833 luaD_throw(L, LUA_YIELD);
834 }
835 lua_assert(ci->callstatus & CIST_HOOKED); /* must be inside a hook */
836 lua_unlock(L);
837 return 0; /* return to 'luaD_hook' */
838}
839
840
841/*
842** Auxiliary structure to call 'luaF_close' in protected mode.
843*/
844struct CloseP {
845 StkId level;
846 int status;
847};
848
849
850/*
851** Auxiliary function to call 'luaF_close' in protected mode.
852*/
853static void closepaux (lua_State *L, void *ud) {
854 struct CloseP *pcl = cast(struct CloseP *, ud);
855 luaF_close(L, pcl->level, pcl->status, 0);
856}
857
858
859/*
860** Calls 'luaF_close' in protected mode. Return the original status
861** or, in case of errors, the new status.
862*/
863int luaD_closeprotected (lua_State *L, ptrdiff_t level, int status) {
864 CallInfo *old_ci = L->ci;
865 lu_byte old_allowhooks = L->allowhook;
866 for (;;) { /* keep closing upvalues until no more errors */
867 struct CloseP pcl;
868 pcl.level = restorestack(L, level); pcl.status = status;
869 status = luaD_rawrunprotected(L, &closepaux, &pcl);
870 if (l_likely(status == LUA_OK)) /* no more errors? */
871 return pcl.status;
872 else { /* an error occurred; restore saved state and repeat */
873 L->ci = old_ci;
874 L->allowhook = old_allowhooks;
875 }
876 }
877}
878
879
880/*
881** Call the C function 'func' in protected mode, restoring basic
882** thread information ('allowhook', etc.) and in particular
883** its stack level in case of errors.
884*/
885int luaD_pcall (lua_State *L, Pfunc func, void *u,
886 ptrdiff_t old_top, ptrdiff_t ef) {
887 int status;
888 CallInfo *old_ci = L->ci;
889 lu_byte old_allowhooks = L->allowhook;
890 ptrdiff_t old_errfunc = L->errfunc;
891 L->errfunc = ef;
892 status = luaD_rawrunprotected(L, func, u);
893 if (l_unlikely(status != LUA_OK)) { /* an error occurred? */
894 L->ci = old_ci;
895 L->allowhook = old_allowhooks;
896 status = luaD_closeprotected(L, old_top, status);
897 luaD_seterrorobj(L, status, restorestack(L, old_top));
898 luaD_shrinkstack(L); /* restore stack size in case of overflow */
899 }
900 L->errfunc = old_errfunc;
901 return status;
902}
903
904
905
906/*
907** Execute a protected parser.
908*/
909struct SParser { /* data to 'f_parser' */
910 ZIO *z;
911 Mbuffer buff; /* dynamic structure used by the scanner */
912 Dyndata dyd; /* dynamic structures used by the parser */
913 const char *mode;
914 const char *name;
915};
916
917
918static void checkmode (lua_State *L, const char *mode, const char *x) {
919 if (mode && strchr(mode, x[0]) == NULL) {
920 luaO_pushfstring(L,
921 "attempt to load a %s chunk (mode is '%s')", x, mode);
922 luaD_throw(L, LUA_ERRSYNTAX);
923 }
924}
925
926
927static void f_parser (lua_State *L, void *ud) {
928 LClosure *cl;
929 struct SParser *p = cast(struct SParser *, ud);
930 int c = zgetc(p->z); /* read first character */
931 if (c == LUA_SIGNATURE[0]) {
932 checkmode(L, p->mode, "binary");
933 cl = luaU_undump(L, p->z, p->name);
934 }
935 else {
936 checkmode(L, p->mode, "text");
937 cl = luaY_parser(L, p->z, &p->buff, &p->dyd, p->name, c);
938 }
939 lua_assert(cl->nupvalues == cl->p->sizeupvalues);
940 luaF_initupvals(L, cl);
941}
942
943
944int luaD_protectedparser (lua_State *L, ZIO *z, const char *name,
945 const char *mode) {
946 struct SParser p;
947 int status;
948 incnny(L); /* cannot yield during parsing */
949 p.z = z; p.name = name; p.mode = mode;
950 p.dyd.actvar.arr = NULL; p.dyd.actvar.size = 0;
951 p.dyd.gt.arr = NULL; p.dyd.gt.size = 0;
952 p.dyd.label.arr = NULL; p.dyd.label.size = 0;
953 luaZ_initbuffer(L, &p.buff);
954 status = luaD_pcall(L, f_parser, &p, savestack(L, L->top), L->errfunc);
955 luaZ_freebuffer(L, &p.buff);
956 luaM_freearray(L, p.dyd.actvar.arr, p.dyd.actvar.size);
957 luaM_freearray(L, p.dyd.gt.arr, p.dyd.gt.size);
958 luaM_freearray(L, p.dyd.label.arr, p.dyd.label.size);
959 decnny(L);
960 return status;
961}
962
963
diff --git a/src/lua/ldo.h b/src/lua/ldo.h
deleted file mode 100644
index 6bf0ed8..0000000
--- a/src/lua/ldo.h
+++ /dev/null
@@ -1,79 +0,0 @@
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** It also allows the running of one GC step when the stack is
21** reallocated.
22** 'condmovestack' is used in heavy tests to force a stack reallocation
23** at every check.
24*/
25#define luaD_checkstackaux(L,n,pre,pos) \
26 if (l_unlikely(L->stack_last - L->top <= (n))) \
27 { pre; luaD_growstack(L, n, 1); pos; } \
28 else { condmovestack(L,pre,pos); }
29
30/* In general, 'pre'/'pos' are empty (nothing to save) */
31#define luaD_checkstack(L,n) luaD_checkstackaux(L,n,(void)0,(void)0)
32
33
34
35#define savestack(L,p) ((char *)(p) - (char *)L->stack)
36#define restorestack(L,n) ((StkId)((char *)L->stack + (n)))
37
38
39/* macro to check stack size, preserving 'p' */
40#define checkstackGCp(L,n,p) \
41 luaD_checkstackaux(L, n, \
42 ptrdiff_t t__ = savestack(L, p); /* save 'p' */ \
43 luaC_checkGC(L), /* stack grow uses memory */ \
44 p = restorestack(L, t__)) /* 'pos' part: restore 'p' */
45
46
47/* macro to check stack size and GC */
48#define checkstackGC(L,fsize) \
49 luaD_checkstackaux(L, (fsize), luaC_checkGC(L), (void)0)
50
51
52/* type of protected functions, to be ran by 'runprotected' */
53typedef void (*Pfunc) (lua_State *L, void *ud);
54
55LUAI_FUNC void luaD_seterrorobj (lua_State *L, int errcode, StkId oldtop);
56LUAI_FUNC int luaD_protectedparser (lua_State *L, ZIO *z, const char *name,
57 const char *mode);
58LUAI_FUNC void luaD_hook (lua_State *L, int event, int line,
59 int fTransfer, int nTransfer);
60LUAI_FUNC void luaD_hookcall (lua_State *L, CallInfo *ci);
61LUAI_FUNC void luaD_pretailcall (lua_State *L, CallInfo *ci, StkId func, int n);
62LUAI_FUNC CallInfo *luaD_precall (lua_State *L, StkId func, int nResults);
63LUAI_FUNC void luaD_call (lua_State *L, StkId func, int nResults);
64LUAI_FUNC void luaD_callnoyield (lua_State *L, StkId func, int nResults);
65LUAI_FUNC void luaD_tryfuncTM (lua_State *L, StkId func);
66LUAI_FUNC int luaD_closeprotected (lua_State *L, ptrdiff_t level, int status);
67LUAI_FUNC int luaD_pcall (lua_State *L, Pfunc func, void *u,
68 ptrdiff_t oldtop, ptrdiff_t ef);
69LUAI_FUNC void luaD_poscall (lua_State *L, CallInfo *ci, int nres);
70LUAI_FUNC int luaD_reallocstack (lua_State *L, int newsize, int raiseerror);
71LUAI_FUNC int luaD_growstack (lua_State *L, int n, int raiseerror);
72LUAI_FUNC void luaD_shrinkstack (lua_State *L);
73LUAI_FUNC void luaD_inctop (lua_State *L);
74
75LUAI_FUNC l_noret luaD_throw (lua_State *L, int errcode);
76LUAI_FUNC int luaD_rawrunprotected (lua_State *L, Pfunc f, void *ud);
77
78#endif
79
diff --git a/src/lua/ldump.c b/src/lua/ldump.c
deleted file mode 100644
index f848b66..0000000
--- a/src/lua/ldump.c
+++ /dev/null
@@ -1,226 +0,0 @@
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
deleted file mode 100644
index f5889a2..0000000
--- a/src/lua/lfunc.c
+++ /dev/null
@@ -1,294 +0,0 @@
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, uv);
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
103/*
104** Call closing method for object 'obj' with error message 'err'. The
105** boolean 'yy' controls whether the call is yieldable.
106** (This function assumes EXTRA_STACK.)
107*/
108static void callclosemethod (lua_State *L, TValue *obj, TValue *err, int yy) {
109 StkId top = L->top;
110 const TValue *tm = luaT_gettmbyobj(L, obj, TM_CLOSE);
111 setobj2s(L, top, tm); /* will call metamethod... */
112 setobj2s(L, top + 1, obj); /* with 'self' as the 1st argument */
113 setobj2s(L, top + 2, err); /* and error msg. as 2nd argument */
114 L->top = top + 3; /* add function and arguments */
115 if (yy)
116 luaD_call(L, top, 0);
117 else
118 luaD_callnoyield(L, top, 0);
119}
120
121
122/*
123** Check whether object at given level has a close metamethod and raise
124** an error if not.
125*/
126static void checkclosemth (lua_State *L, StkId level) {
127 const TValue *tm = luaT_gettmbyobj(L, s2v(level), TM_CLOSE);
128 if (ttisnil(tm)) { /* no metamethod? */
129 int idx = cast_int(level - L->ci->func); /* variable index */
130 const char *vname = luaG_findlocal(L, L->ci, idx, NULL);
131 if (vname == NULL) vname = "?";
132 luaG_runerror(L, "variable '%s' got a non-closable value", vname);
133 }
134}
135
136
137/*
138** Prepare and call a closing method.
139** If status is CLOSEKTOP, the call to the closing method will be pushed
140** at the top of the stack. Otherwise, values can be pushed right after
141** the 'level' of the upvalue being closed, as everything after that
142** won't be used again.
143*/
144static void prepcallclosemth (lua_State *L, StkId level, int status, int yy) {
145 TValue *uv = s2v(level); /* value being closed */
146 TValue *errobj;
147 if (status == CLOSEKTOP)
148 errobj = &G(L)->nilvalue; /* error object is nil */
149 else { /* 'luaD_seterrorobj' will set top to level + 2 */
150 errobj = s2v(level + 1); /* error object goes after 'uv' */
151 luaD_seterrorobj(L, status, level + 1); /* set error object */
152 }
153 callclosemethod(L, uv, errobj, yy);
154}
155
156
157/*
158** Maximum value for deltas in 'tbclist', dependent on the type
159** of delta. (This macro assumes that an 'L' is in scope where it
160** is used.)
161*/
162#define MAXDELTA \
163 ((256ul << ((sizeof(L->stack->tbclist.delta) - 1) * 8)) - 1)
164
165
166/*
167** Insert a variable in the list of to-be-closed variables.
168*/
169void luaF_newtbcupval (lua_State *L, StkId level) {
170 lua_assert(level > L->tbclist);
171 if (l_isfalse(s2v(level)))
172 return; /* false doesn't need to be closed */
173 checkclosemth(L, level); /* value must have a close method */
174 while (cast_uint(level - L->tbclist) > MAXDELTA) {
175 L->tbclist += MAXDELTA; /* create a dummy node at maximum delta */
176 L->tbclist->tbclist.delta = 0;
177 }
178 level->tbclist.delta = cast(unsigned short, level - L->tbclist);
179 L->tbclist = level;
180}
181
182
183void luaF_unlinkupval (UpVal *uv) {
184 lua_assert(upisopen(uv));
185 *uv->u.open.previous = uv->u.open.next;
186 if (uv->u.open.next)
187 uv->u.open.next->u.open.previous = uv->u.open.previous;
188}
189
190
191/*
192** Close all upvalues up to the given stack level.
193*/
194void luaF_closeupval (lua_State *L, StkId level) {
195 UpVal *uv;
196 StkId upl; /* stack index pointed by 'uv' */
197 while ((uv = L->openupval) != NULL && (upl = uplevel(uv)) >= level) {
198 TValue *slot = &uv->u.value; /* new position for value */
199 lua_assert(uplevel(uv) < L->top);
200 luaF_unlinkupval(uv); /* remove upvalue from 'openupval' list */
201 setobj(L, slot, uv->v); /* move value to upvalue slot */
202 uv->v = slot; /* now current value lives here */
203 if (!iswhite(uv)) { /* neither white nor dead? */
204 nw2black(uv); /* closed upvalues cannot be gray */
205 luaC_barrier(L, uv, slot);
206 }
207 }
208}
209
210
211/*
212** Remove firt element from the tbclist plus its dummy nodes.
213*/
214static void poptbclist (lua_State *L) {
215 StkId tbc = L->tbclist;
216 lua_assert(tbc->tbclist.delta > 0); /* first element cannot be dummy */
217 tbc -= tbc->tbclist.delta;
218 while (tbc > L->stack && tbc->tbclist.delta == 0)
219 tbc -= MAXDELTA; /* remove dummy nodes */
220 L->tbclist = tbc;
221}
222
223
224/*
225** Close all upvalues and to-be-closed variables up to the given stack
226** level.
227*/
228void luaF_close (lua_State *L, StkId level, int status, int yy) {
229 ptrdiff_t levelrel = savestack(L, level);
230 luaF_closeupval(L, level); /* first, close the upvalues */
231 while (L->tbclist >= level) { /* traverse tbc's down to that level */
232 StkId tbc = L->tbclist; /* get variable index */
233 poptbclist(L); /* remove it from list */
234 prepcallclosemth(L, tbc, status, yy); /* close variable */
235 level = restorestack(L, levelrel);
236 }
237}
238
239
240Proto *luaF_newproto (lua_State *L) {
241 GCObject *o = luaC_newobj(L, LUA_VPROTO, sizeof(Proto));
242 Proto *f = gco2p(o);
243 f->k = NULL;
244 f->sizek = 0;
245 f->p = NULL;
246 f->sizep = 0;
247 f->code = NULL;
248 f->sizecode = 0;
249 f->lineinfo = NULL;
250 f->sizelineinfo = 0;
251 f->abslineinfo = NULL;
252 f->sizeabslineinfo = 0;
253 f->upvalues = NULL;
254 f->sizeupvalues = 0;
255 f->numparams = 0;
256 f->is_vararg = 0;
257 f->maxstacksize = 0;
258 f->locvars = NULL;
259 f->sizelocvars = 0;
260 f->linedefined = 0;
261 f->lastlinedefined = 0;
262 f->source = NULL;
263 return f;
264}
265
266
267void luaF_freeproto (lua_State *L, Proto *f) {
268 luaM_freearray(L, f->code, f->sizecode);
269 luaM_freearray(L, f->p, f->sizep);
270 luaM_freearray(L, f->k, f->sizek);
271 luaM_freearray(L, f->lineinfo, f->sizelineinfo);
272 luaM_freearray(L, f->abslineinfo, f->sizeabslineinfo);
273 luaM_freearray(L, f->locvars, f->sizelocvars);
274 luaM_freearray(L, f->upvalues, f->sizeupvalues);
275 luaM_free(L, f);
276}
277
278
279/*
280** Look for n-th local variable at line 'line' in function 'func'.
281** Returns NULL if not found.
282*/
283const char *luaF_getlocalname (const Proto *f, int local_number, int pc) {
284 int i;
285 for (i = 0; i<f->sizelocvars && f->locvars[i].startpc <= pc; i++) {
286 if (pc < f->locvars[i].endpc) { /* is variable active? */
287 local_number--;
288 if (local_number == 0)
289 return getstr(f->locvars[i].varname);
290 }
291 }
292 return NULL; /* not found */
293}
294
diff --git a/src/lua/lfunc.h b/src/lua/lfunc.h
deleted file mode 100644
index dc1cebc..0000000
--- a/src/lua/lfunc.h
+++ /dev/null
@@ -1,64 +0,0 @@
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 to close upvalues preserving the top of the stack */
47#define CLOSEKTOP (-1)
48
49
50LUAI_FUNC Proto *luaF_newproto (lua_State *L);
51LUAI_FUNC CClosure *luaF_newCclosure (lua_State *L, int nupvals);
52LUAI_FUNC LClosure *luaF_newLclosure (lua_State *L, int nupvals);
53LUAI_FUNC void luaF_initupvals (lua_State *L, LClosure *cl);
54LUAI_FUNC UpVal *luaF_findupval (lua_State *L, StkId level);
55LUAI_FUNC void luaF_newtbcupval (lua_State *L, StkId level);
56LUAI_FUNC void luaF_closeupval (lua_State *L, StkId level);
57LUAI_FUNC void luaF_close (lua_State *L, StkId level, int status, int yy);
58LUAI_FUNC void luaF_unlinkupval (UpVal *uv);
59LUAI_FUNC void luaF_freeproto (lua_State *L, Proto *f);
60LUAI_FUNC const char *luaF_getlocalname (const Proto *func, int local_number,
61 int pc);
62
63
64#endif
diff --git a/src/lua/lgc.c b/src/lua/lgc.c
deleted file mode 100644
index b360eed..0000000
--- a/src/lua/lgc.c
+++ /dev/null
@@ -1,1728 +0,0 @@
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 with all color bits */
64#define maskcolors (bitmask(BLACKBIT) | WHITEBITS)
65
66/* mask with all GC bits */
67#define maskgcbits (maskcolors | AGEBITS)
68
69
70/* macro to erase all color bits then set only the current white bit */
71#define makewhite(g,x) \
72 (x->marked = cast_byte((x->marked & ~maskcolors) | luaC_white(g)))
73
74/* make an object gray (neither white nor black) */
75#define set2gray(x) resetbits(x->marked, maskcolors)
76
77
78/* make an object black (coming from any color) */
79#define set2black(x) \
80 (x->marked = cast_byte((x->marked & ~WHITEBITS) | bitmask(BLACKBIT)))
81
82
83#define valiswhite(x) (iscollectable(x) && iswhite(gcvalue(x)))
84
85#define keyiswhite(n) (keyiscollectable(n) && iswhite(gckey(n)))
86
87
88/*
89** Protected access to objects in values
90*/
91#define gcvalueN(o) (iscollectable(o) ? gcvalue(o) : NULL)
92
93
94#define markvalue(g,o) { checkliveness(g->mainthread,o); \
95 if (valiswhite(o)) reallymarkobject(g,gcvalue(o)); }
96
97#define markkey(g, n) { if keyiswhite(n) reallymarkobject(g,gckey(n)); }
98
99#define markobject(g,t) { if (iswhite(t)) reallymarkobject(g, obj2gco(t)); }
100
101/*
102** mark an object that can be NULL (either because it is really optional,
103** or it was stripped as debug info, or inside an uncompleted structure)
104*/
105#define markobjectN(g,t) { if (t) markobject(g,t); }
106
107static void reallymarkobject (global_State *g, GCObject *o);
108static lu_mem atomic (lua_State *L);
109static void entersweep (lua_State *L);
110
111
112/*
113** {======================================================
114** Generic functions
115** =======================================================
116*/
117
118
119/*
120** one after last element in a hash array
121*/
122#define gnodelast(h) gnode(h, cast_sizet(sizenode(h)))
123
124
125static GCObject **getgclist (GCObject *o) {
126 switch (o->tt) {
127 case LUA_VTABLE: return &gco2t(o)->gclist;
128 case LUA_VLCL: return &gco2lcl(o)->gclist;
129 case LUA_VCCL: return &gco2ccl(o)->gclist;
130 case LUA_VTHREAD: return &gco2th(o)->gclist;
131 case LUA_VPROTO: return &gco2p(o)->gclist;
132 case LUA_VUSERDATA: {
133 Udata *u = gco2u(o);
134 lua_assert(u->nuvalue > 0);
135 return &u->gclist;
136 }
137 default: lua_assert(0); return 0;
138 }
139}
140
141
142/*
143** Link a collectable object 'o' with a known type into the list 'p'.
144** (Must be a macro to access the 'gclist' field in different types.)
145*/
146#define linkgclist(o,p) linkgclist_(obj2gco(o), &(o)->gclist, &(p))
147
148static void linkgclist_ (GCObject *o, GCObject **pnext, GCObject **list) {
149 lua_assert(!isgray(o)); /* cannot be in a gray list */
150 *pnext = *list;
151 *list = o;
152 set2gray(o); /* now it is */
153}
154
155
156/*
157** Link a generic collectable object 'o' into the list 'p'.
158*/
159#define linkobjgclist(o,p) linkgclist_(obj2gco(o), getgclist(o), &(p))
160
161
162
163/*
164** Clear keys for empty entries in tables. If entry is empty, mark its
165** entry as dead. This allows the collection of the key, but keeps its
166** entry in the table: its removal could break a chain and could break
167** a table traversal. Other places never manipulate dead keys, because
168** its associated empty value is enough to signal that the entry is
169** logically empty.
170*/
171static void clearkey (Node *n) {
172 lua_assert(isempty(gval(n)));
173 if (keyiscollectable(n))
174 setdeadkey(n); /* unused key; remove it */
175}
176
177
178/*
179** tells whether a key or value can be cleared from a weak
180** table. Non-collectable objects are never removed from weak
181** tables. Strings behave as 'values', so are never removed too. for
182** other objects: if really collected, cannot keep them; for objects
183** being finalized, keep them in keys, but not in values
184*/
185static int iscleared (global_State *g, const GCObject *o) {
186 if (o == NULL) return 0; /* non-collectable value */
187 else if (novariant(o->tt) == LUA_TSTRING) {
188 markobject(g, o); /* strings are 'values', so are never weak */
189 return 0;
190 }
191 else return iswhite(o);
192}
193
194
195/*
196** Barrier that moves collector forward, that is, marks the white object
197** 'v' being pointed by the black object 'o'. In the generational
198** mode, 'v' must also become old, if 'o' is old; however, it cannot
199** be changed directly to OLD, because it may still point to non-old
200** objects. So, it is marked as OLD0. In the next cycle it will become
201** OLD1, and in the next it will finally become OLD (regular old). By
202** then, any object it points to will also be old. If called in the
203** incremental sweep phase, it clears the black object to white (sweep
204** it) to avoid other barrier calls for this same object. (That cannot
205** be done is generational mode, as its sweep does not distinguish
206** whites from deads.)
207*/
208void luaC_barrier_ (lua_State *L, GCObject *o, GCObject *v) {
209 global_State *g = G(L);
210 lua_assert(isblack(o) && iswhite(v) && !isdead(g, v) && !isdead(g, o));
211 if (keepinvariant(g)) { /* must keep invariant? */
212 reallymarkobject(g, v); /* restore invariant */
213 if (isold(o)) {
214 lua_assert(!isold(v)); /* white object could not be old */
215 setage(v, G_OLD0); /* restore generational invariant */
216 }
217 }
218 else { /* sweep phase */
219 lua_assert(issweepphase(g));
220 if (g->gckind == KGC_INC) /* incremental mode? */
221 makewhite(g, o); /* mark 'o' as white to avoid other barriers */
222 }
223}
224
225
226/*
227** barrier that moves collector backward, that is, mark the black object
228** pointing to a white object as gray again.
229*/
230void luaC_barrierback_ (lua_State *L, GCObject *o) {
231 global_State *g = G(L);
232 lua_assert(isblack(o) && !isdead(g, o));
233 lua_assert((g->gckind == KGC_GEN) == (isold(o) && getage(o) != G_TOUCHED1));
234 if (getage(o) == G_TOUCHED2) /* already in gray list? */
235 set2gray(o); /* make it gray to become touched1 */
236 else /* link it in 'grayagain' and paint it gray */
237 linkobjgclist(o, g->grayagain);
238 if (isold(o)) /* generational mode? */
239 setage(o, G_TOUCHED1); /* touched in current cycle */
240}
241
242
243void luaC_fix (lua_State *L, GCObject *o) {
244 global_State *g = G(L);
245 lua_assert(g->allgc == o); /* object must be 1st in 'allgc' list! */
246 set2gray(o); /* they will be gray forever */
247 setage(o, G_OLD); /* and old forever */
248 g->allgc = o->next; /* remove object from 'allgc' list */
249 o->next = g->fixedgc; /* link it to 'fixedgc' list */
250 g->fixedgc = o;
251}
252
253
254/*
255** create a new collectable object (with given type and size) and link
256** it to 'allgc' list.
257*/
258GCObject *luaC_newobj (lua_State *L, int tt, size_t sz) {
259 global_State *g = G(L);
260 GCObject *o = cast(GCObject *, luaM_newobject(L, novariant(tt), sz));
261 o->marked = luaC_white(g);
262 o->tt = tt;
263 o->next = g->allgc;
264 g->allgc = o;
265 return o;
266}
267
268/* }====================================================== */
269
270
271
272/*
273** {======================================================
274** Mark functions
275** =======================================================
276*/
277
278
279/*
280** Mark an object. Userdata with no user values, strings, and closed
281** upvalues are visited and turned black here. Open upvalues are
282** already indirectly linked through their respective threads in the
283** 'twups' list, so they don't go to the gray list; nevertheless, they
284** are kept gray to avoid barriers, as their values will be revisited
285** by the thread or by 'remarkupvals'. Other objects are added to the
286** gray list to be visited (and turned black) later. Both userdata and
287** upvalues can call this function recursively, but this recursion goes
288** for at most two levels: An upvalue cannot refer to another upvalue
289** (only closures can), and a userdata's metatable must be a table.
290*/
291static void reallymarkobject (global_State *g, GCObject *o) {
292 switch (o->tt) {
293 case LUA_VSHRSTR:
294 case LUA_VLNGSTR: {
295 set2black(o); /* nothing to visit */
296 break;
297 }
298 case LUA_VUPVAL: {
299 UpVal *uv = gco2upv(o);
300 if (upisopen(uv))
301 set2gray(uv); /* open upvalues are kept gray */
302 else
303 set2black(uv); /* closed upvalues are visited here */
304 markvalue(g, uv->v); /* mark its content */
305 break;
306 }
307 case LUA_VUSERDATA: {
308 Udata *u = gco2u(o);
309 if (u->nuvalue == 0) { /* no user values? */
310 markobjectN(g, u->metatable); /* mark its metatable */
311 set2black(u); /* nothing else to mark */
312 break;
313 }
314 /* else... */
315 } /* FALLTHROUGH */
316 case LUA_VLCL: case LUA_VCCL: case LUA_VTABLE:
317 case LUA_VTHREAD: case LUA_VPROTO: {
318 linkobjgclist(o, g->gray); /* to be visited later */
319 break;
320 }
321 default: lua_assert(0); break;
322 }
323}
324
325
326/*
327** mark metamethods for basic types
328*/
329static void markmt (global_State *g) {
330 int i;
331 for (i=0; i < LUA_NUMTAGS; i++)
332 markobjectN(g, g->mt[i]);
333}
334
335
336/*
337** mark all objects in list of being-finalized
338*/
339static lu_mem markbeingfnz (global_State *g) {
340 GCObject *o;
341 lu_mem count = 0;
342 for (o = g->tobefnz; o != NULL; o = o->next) {
343 count++;
344 markobject(g, o);
345 }
346 return count;
347}
348
349
350/*
351** For each non-marked thread, simulates a barrier between each open
352** upvalue and its value. (If the thread is collected, the value will be
353** assigned to the upvalue, but then it can be too late for the barrier
354** to act. The "barrier" does not need to check colors: A non-marked
355** thread must be young; upvalues cannot be older than their threads; so
356** any visited upvalue must be young too.) Also removes the thread from
357** the list, as it was already visited. Removes also threads with no
358** upvalues, as they have nothing to be checked. (If the thread gets an
359** upvalue later, it will be linked in the list again.)
360*/
361static int remarkupvals (global_State *g) {
362 lua_State *thread;
363 lua_State **p = &g->twups;
364 int work = 0; /* estimate of how much work was done here */
365 while ((thread = *p) != NULL) {
366 work++;
367 if (!iswhite(thread) && thread->openupval != NULL)
368 p = &thread->twups; /* keep marked thread with upvalues in the list */
369 else { /* thread is not marked or without upvalues */
370 UpVal *uv;
371 lua_assert(!isold(thread) || thread->openupval == NULL);
372 *p = thread->twups; /* remove thread from the list */
373 thread->twups = thread; /* mark that it is out of list */
374 for (uv = thread->openupval; uv != NULL; uv = uv->u.open.next) {
375 lua_assert(getage(uv) <= getage(thread));
376 work++;
377 if (!iswhite(uv)) { /* upvalue already visited? */
378 lua_assert(upisopen(uv) && isgray(uv));
379 markvalue(g, uv->v); /* mark its value */
380 }
381 }
382 }
383 }
384 return work;
385}
386
387
388static void cleargraylists (global_State *g) {
389 g->gray = g->grayagain = NULL;
390 g->weak = g->allweak = g->ephemeron = NULL;
391}
392
393
394/*
395** mark root set and reset all gray lists, to start a new collection
396*/
397static void restartcollection (global_State *g) {
398 cleargraylists(g);
399 markobject(g, g->mainthread);
400 markvalue(g, &g->l_registry);
401 markmt(g);
402 markbeingfnz(g); /* mark any finalizing object left from previous cycle */
403}
404
405/* }====================================================== */
406
407
408/*
409** {======================================================
410** Traverse functions
411** =======================================================
412*/
413
414
415/*
416** Check whether object 'o' should be kept in the 'grayagain' list for
417** post-processing by 'correctgraylist'. (It could put all old objects
418** in the list and leave all the work to 'correctgraylist', but it is
419** more efficient to avoid adding elements that will be removed.) Only
420** TOUCHED1 objects need to be in the list. TOUCHED2 doesn't need to go
421** back to a gray list, but then it must become OLD. (That is what
422** 'correctgraylist' does when it finds a TOUCHED2 object.)
423*/
424static void genlink (global_State *g, GCObject *o) {
425 lua_assert(isblack(o));
426 if (getage(o) == G_TOUCHED1) { /* touched in this cycle? */
427 linkobjgclist(o, g->grayagain); /* link it back in 'grayagain' */
428 } /* everything else do not need to be linked back */
429 else if (getage(o) == G_TOUCHED2)
430 changeage(o, G_TOUCHED2, G_OLD); /* advance age */
431}
432
433
434/*
435** Traverse a table with weak values and link it to proper list. During
436** propagate phase, keep it in 'grayagain' list, to be revisited in the
437** atomic phase. In the atomic phase, if table has any white value,
438** put it in 'weak' list, to be cleared.
439*/
440static void traverseweakvalue (global_State *g, Table *h) {
441 Node *n, *limit = gnodelast(h);
442 /* if there is array part, assume it may have white values (it is not
443 worth traversing it now just to check) */
444 int hasclears = (h->alimit > 0);
445 for (n = gnode(h, 0); n < limit; n++) { /* traverse hash part */
446 if (isempty(gval(n))) /* entry is empty? */
447 clearkey(n); /* clear its key */
448 else {
449 lua_assert(!keyisnil(n));
450 markkey(g, n);
451 if (!hasclears && iscleared(g, gcvalueN(gval(n)))) /* a white value? */
452 hasclears = 1; /* table will have to be cleared */
453 }
454 }
455 if (g->gcstate == GCSatomic && hasclears)
456 linkgclist(h, g->weak); /* has to be cleared later */
457 else
458 linkgclist(h, g->grayagain); /* must retraverse it in atomic phase */
459}
460
461
462/*
463** Traverse an ephemeron table and link it to proper list. Returns true
464** iff any object was marked during this traversal (which implies that
465** convergence has to continue). During propagation phase, keep table
466** in 'grayagain' list, to be visited again in the atomic phase. In
467** the atomic phase, if table has any white->white entry, it has to
468** be revisited during ephemeron convergence (as that key may turn
469** black). Otherwise, if it has any white key, table has to be cleared
470** (in the atomic phase). In generational mode, some tables
471** must be kept in some gray list for post-processing; this is done
472** by 'genlink'.
473*/
474static int traverseephemeron (global_State *g, Table *h, int inv) {
475 int marked = 0; /* true if an object is marked in this traversal */
476 int hasclears = 0; /* true if table has white keys */
477 int hasww = 0; /* true if table has entry "white-key -> white-value" */
478 unsigned int i;
479 unsigned int asize = luaH_realasize(h);
480 unsigned int nsize = sizenode(h);
481 /* traverse array part */
482 for (i = 0; i < asize; i++) {
483 if (valiswhite(&h->array[i])) {
484 marked = 1;
485 reallymarkobject(g, gcvalue(&h->array[i]));
486 }
487 }
488 /* traverse hash part; if 'inv', traverse descending
489 (see 'convergeephemerons') */
490 for (i = 0; i < nsize; i++) {
491 Node *n = inv ? gnode(h, nsize - 1 - i) : gnode(h, i);
492 if (isempty(gval(n))) /* entry is empty? */
493 clearkey(n); /* clear its key */
494 else if (iscleared(g, gckeyN(n))) { /* key is not marked (yet)? */
495 hasclears = 1; /* table must be cleared */
496 if (valiswhite(gval(n))) /* value not marked yet? */
497 hasww = 1; /* white-white entry */
498 }
499 else if (valiswhite(gval(n))) { /* value not marked yet? */
500 marked = 1;
501 reallymarkobject(g, gcvalue(gval(n))); /* mark it now */
502 }
503 }
504 /* link table into proper list */
505 if (g->gcstate == GCSpropagate)
506 linkgclist(h, g->grayagain); /* must retraverse it in atomic phase */
507 else if (hasww) /* table has white->white entries? */
508 linkgclist(h, g->ephemeron); /* have to propagate again */
509 else if (hasclears) /* table has white keys? */
510 linkgclist(h, g->allweak); /* may have to clean white keys */
511 else
512 genlink(g, obj2gco(h)); /* check whether collector still needs to see it */
513 return marked;
514}
515
516
517static void traversestrongtable (global_State *g, Table *h) {
518 Node *n, *limit = gnodelast(h);
519 unsigned int i;
520 unsigned int asize = luaH_realasize(h);
521 for (i = 0; i < asize; i++) /* traverse array part */
522 markvalue(g, &h->array[i]);
523 for (n = gnode(h, 0); n < limit; n++) { /* traverse hash part */
524 if (isempty(gval(n))) /* entry is empty? */
525 clearkey(n); /* clear its key */
526 else {
527 lua_assert(!keyisnil(n));
528 markkey(g, n);
529 markvalue(g, gval(n));
530 }
531 }
532 genlink(g, obj2gco(h));
533}
534
535
536static lu_mem traversetable (global_State *g, Table *h) {
537 const char *weakkey, *weakvalue;
538 const TValue *mode = gfasttm(g, h->metatable, TM_MODE);
539 markobjectN(g, h->metatable);
540 if (mode && ttisstring(mode) && /* is there a weak mode? */
541 (cast_void(weakkey = strchr(svalue(mode), 'k')),
542 cast_void(weakvalue = strchr(svalue(mode), 'v')),
543 (weakkey || weakvalue))) { /* is really weak? */
544 if (!weakkey) /* strong keys? */
545 traverseweakvalue(g, h);
546 else if (!weakvalue) /* strong values? */
547 traverseephemeron(g, h, 0);
548 else /* all weak */
549 linkgclist(h, g->allweak); /* nothing to traverse now */
550 }
551 else /* not weak */
552 traversestrongtable(g, h);
553 return 1 + h->alimit + 2 * allocsizenode(h);
554}
555
556
557static int traverseudata (global_State *g, Udata *u) {
558 int i;
559 markobjectN(g, u->metatable); /* mark its metatable */
560 for (i = 0; i < u->nuvalue; i++)
561 markvalue(g, &u->uv[i].uv);
562 genlink(g, obj2gco(u));
563 return 1 + u->nuvalue;
564}
565
566
567/*
568** Traverse a prototype. (While a prototype is being build, its
569** arrays can be larger than needed; the extra slots are filled with
570** NULL, so the use of 'markobjectN')
571*/
572static int traverseproto (global_State *g, Proto *f) {
573 int i;
574 markobjectN(g, f->source);
575 for (i = 0; i < f->sizek; i++) /* mark literals */
576 markvalue(g, &f->k[i]);
577 for (i = 0; i < f->sizeupvalues; i++) /* mark upvalue names */
578 markobjectN(g, f->upvalues[i].name);
579 for (i = 0; i < f->sizep; i++) /* mark nested protos */
580 markobjectN(g, f->p[i]);
581 for (i = 0; i < f->sizelocvars; i++) /* mark local-variable names */
582 markobjectN(g, f->locvars[i].varname);
583 return 1 + f->sizek + f->sizeupvalues + f->sizep + f->sizelocvars;
584}
585
586
587static int traverseCclosure (global_State *g, CClosure *cl) {
588 int i;
589 for (i = 0; i < cl->nupvalues; i++) /* mark its upvalues */
590 markvalue(g, &cl->upvalue[i]);
591 return 1 + cl->nupvalues;
592}
593
594/*
595** Traverse a Lua closure, marking its prototype and its upvalues.
596** (Both can be NULL while closure is being created.)
597*/
598static int traverseLclosure (global_State *g, LClosure *cl) {
599 int i;
600 markobjectN(g, cl->p); /* mark its prototype */
601 for (i = 0; i < cl->nupvalues; i++) { /* visit its upvalues */
602 UpVal *uv = cl->upvals[i];
603 markobjectN(g, uv); /* mark upvalue */
604 }
605 return 1 + cl->nupvalues;
606}
607
608
609/*
610** Traverse a thread, marking the elements in the stack up to its top
611** and cleaning the rest of the stack in the final traversal. That
612** ensures that the entire stack have valid (non-dead) objects.
613** Threads have no barriers. In gen. mode, old threads must be visited
614** at every cycle, because they might point to young objects. In inc.
615** mode, the thread can still be modified before the end of the cycle,
616** and therefore it must be visited again in the atomic phase. To ensure
617** these visits, threads must return to a gray list if they are not new
618** (which can only happen in generational mode) or if the traverse is in
619** the propagate phase (which can only happen in incremental mode).
620*/
621static int traversethread (global_State *g, lua_State *th) {
622 UpVal *uv;
623 StkId o = th->stack;
624 if (isold(th) || g->gcstate == GCSpropagate)
625 linkgclist(th, g->grayagain); /* insert into 'grayagain' list */
626 if (o == NULL)
627 return 1; /* stack not completely built yet */
628 lua_assert(g->gcstate == GCSatomic ||
629 th->openupval == NULL || isintwups(th));
630 for (; o < th->top; o++) /* mark live elements in the stack */
631 markvalue(g, s2v(o));
632 for (uv = th->openupval; uv != NULL; uv = uv->u.open.next)
633 markobject(g, uv); /* open upvalues cannot be collected */
634 if (g->gcstate == GCSatomic) { /* final traversal? */
635 for (; o < th->stack_last + EXTRA_STACK; o++)
636 setnilvalue(s2v(o)); /* clear dead stack slice */
637 /* 'remarkupvals' may have removed thread from 'twups' list */
638 if (!isintwups(th) && th->openupval != NULL) {
639 th->twups = g->twups; /* link it back to the list */
640 g->twups = th;
641 }
642 }
643 else if (!g->gcemergency)
644 luaD_shrinkstack(th); /* do not change stack in emergency cycle */
645 return 1 + stacksize(th);
646}
647
648
649/*
650** traverse one gray object, turning it to black.
651*/
652static lu_mem propagatemark (global_State *g) {
653 GCObject *o = g->gray;
654 nw2black(o);
655 g->gray = *getgclist(o); /* remove from 'gray' list */
656 switch (o->tt) {
657 case LUA_VTABLE: return traversetable(g, gco2t(o));
658 case LUA_VUSERDATA: return traverseudata(g, gco2u(o));
659 case LUA_VLCL: return traverseLclosure(g, gco2lcl(o));
660 case LUA_VCCL: return traverseCclosure(g, gco2ccl(o));
661 case LUA_VPROTO: return traverseproto(g, gco2p(o));
662 case LUA_VTHREAD: return traversethread(g, gco2th(o));
663 default: lua_assert(0); return 0;
664 }
665}
666
667
668static lu_mem propagateall (global_State *g) {
669 lu_mem tot = 0;
670 while (g->gray)
671 tot += propagatemark(g);
672 return tot;
673}
674
675
676/*
677** Traverse all ephemeron tables propagating marks from keys to values.
678** Repeat until it converges, that is, nothing new is marked. 'dir'
679** inverts the direction of the traversals, trying to speed up
680** convergence on chains in the same table.
681**
682*/
683static void convergeephemerons (global_State *g) {
684 int changed;
685 int dir = 0;
686 do {
687 GCObject *w;
688 GCObject *next = g->ephemeron; /* get ephemeron list */
689 g->ephemeron = NULL; /* tables may return to this list when traversed */
690 changed = 0;
691 while ((w = next) != NULL) { /* for each ephemeron table */
692 Table *h = gco2t(w);
693 next = h->gclist; /* list is rebuilt during loop */
694 nw2black(h); /* out of the list (for now) */
695 if (traverseephemeron(g, h, dir)) { /* marked some value? */
696 propagateall(g); /* propagate changes */
697 changed = 1; /* will have to revisit all ephemeron tables */
698 }
699 }
700 dir = !dir; /* invert direction next time */
701 } while (changed); /* repeat until no more changes */
702}
703
704/* }====================================================== */
705
706
707/*
708** {======================================================
709** Sweep Functions
710** =======================================================
711*/
712
713
714/*
715** clear entries with unmarked keys from all weaktables in list 'l'
716*/
717static void clearbykeys (global_State *g, GCObject *l) {
718 for (; l; l = gco2t(l)->gclist) {
719 Table *h = gco2t(l);
720 Node *limit = gnodelast(h);
721 Node *n;
722 for (n = gnode(h, 0); n < limit; n++) {
723 if (iscleared(g, gckeyN(n))) /* unmarked key? */
724 setempty(gval(n)); /* remove entry */
725 if (isempty(gval(n))) /* is entry empty? */
726 clearkey(n); /* clear its key */
727 }
728 }
729}
730
731
732/*
733** clear entries with unmarked values from all weaktables in list 'l' up
734** to element 'f'
735*/
736static void clearbyvalues (global_State *g, GCObject *l, GCObject *f) {
737 for (; l != f; l = gco2t(l)->gclist) {
738 Table *h = gco2t(l);
739 Node *n, *limit = gnodelast(h);
740 unsigned int i;
741 unsigned int asize = luaH_realasize(h);
742 for (i = 0; i < asize; i++) {
743 TValue *o = &h->array[i];
744 if (iscleared(g, gcvalueN(o))) /* value was collected? */
745 setempty(o); /* remove entry */
746 }
747 for (n = gnode(h, 0); n < limit; n++) {
748 if (iscleared(g, gcvalueN(gval(n)))) /* unmarked value? */
749 setempty(gval(n)); /* remove entry */
750 if (isempty(gval(n))) /* is entry empty? */
751 clearkey(n); /* clear its key */
752 }
753 }
754}
755
756
757static void freeupval (lua_State *L, UpVal *uv) {
758 if (upisopen(uv))
759 luaF_unlinkupval(uv);
760 luaM_free(L, uv);
761}
762
763
764static void freeobj (lua_State *L, GCObject *o) {
765 switch (o->tt) {
766 case LUA_VPROTO:
767 luaF_freeproto(L, gco2p(o));
768 break;
769 case LUA_VUPVAL:
770 freeupval(L, gco2upv(o));
771 break;
772 case LUA_VLCL: {
773 LClosure *cl = gco2lcl(o);
774 luaM_freemem(L, cl, sizeLclosure(cl->nupvalues));
775 break;
776 }
777 case LUA_VCCL: {
778 CClosure *cl = gco2ccl(o);
779 luaM_freemem(L, cl, sizeCclosure(cl->nupvalues));
780 break;
781 }
782 case LUA_VTABLE:
783 luaH_free(L, gco2t(o));
784 break;
785 case LUA_VTHREAD:
786 luaE_freethread(L, gco2th(o));
787 break;
788 case LUA_VUSERDATA: {
789 Udata *u = gco2u(o);
790 luaM_freemem(L, o, sizeudata(u->nuvalue, u->len));
791 break;
792 }
793 case LUA_VSHRSTR: {
794 TString *ts = gco2ts(o);
795 luaS_remove(L, ts); /* remove it from hash table */
796 luaM_freemem(L, ts, sizelstring(ts->shrlen));
797 break;
798 }
799 case LUA_VLNGSTR: {
800 TString *ts = gco2ts(o);
801 luaM_freemem(L, ts, sizelstring(ts->u.lnglen));
802 break;
803 }
804 default: lua_assert(0);
805 }
806}
807
808
809/*
810** sweep at most 'countin' elements from a list of GCObjects erasing dead
811** objects, where a dead object is one marked with the old (non current)
812** white; change all non-dead objects back to white, preparing for next
813** collection cycle. Return where to continue the traversal or NULL if
814** list is finished. ('*countout' gets the number of elements traversed.)
815*/
816static GCObject **sweeplist (lua_State *L, GCObject **p, int countin,
817 int *countout) {
818 global_State *g = G(L);
819 int ow = otherwhite(g);
820 int i;
821 int white = luaC_white(g); /* current white */
822 for (i = 0; *p != NULL && i < countin; i++) {
823 GCObject *curr = *p;
824 int marked = curr->marked;
825 if (isdeadm(ow, marked)) { /* is 'curr' dead? */
826 *p = curr->next; /* remove 'curr' from list */
827 freeobj(L, curr); /* erase 'curr' */
828 }
829 else { /* change mark to 'white' */
830 curr->marked = cast_byte((marked & ~maskgcbits) | white);
831 p = &curr->next; /* go to next element */
832 }
833 }
834 if (countout)
835 *countout = i; /* number of elements traversed */
836 return (*p == NULL) ? NULL : p;
837}
838
839
840/*
841** sweep a list until a live object (or end of list)
842*/
843static GCObject **sweeptolive (lua_State *L, GCObject **p) {
844 GCObject **old = p;
845 do {
846 p = sweeplist(L, p, 1, NULL);
847 } while (p == old);
848 return p;
849}
850
851/* }====================================================== */
852
853
854/*
855** {======================================================
856** Finalization
857** =======================================================
858*/
859
860/*
861** If possible, shrink string table.
862*/
863static void checkSizes (lua_State *L, global_State *g) {
864 if (!g->gcemergency) {
865 if (g->strt.nuse < g->strt.size / 4) { /* string table too big? */
866 l_mem olddebt = g->GCdebt;
867 luaS_resize(L, g->strt.size / 2);
868 g->GCestimate += g->GCdebt - olddebt; /* correct estimate */
869 }
870 }
871}
872
873
874/*
875** Get the next udata to be finalized from the 'tobefnz' list, and
876** link it back into the 'allgc' list.
877*/
878static GCObject *udata2finalize (global_State *g) {
879 GCObject *o = g->tobefnz; /* get first element */
880 lua_assert(tofinalize(o));
881 g->tobefnz = o->next; /* remove it from 'tobefnz' list */
882 o->next = g->allgc; /* return it to 'allgc' list */
883 g->allgc = o;
884 resetbit(o->marked, FINALIZEDBIT); /* object is "normal" again */
885 if (issweepphase(g))
886 makewhite(g, o); /* "sweep" object */
887 else if (getage(o) == G_OLD1)
888 g->firstold1 = o; /* it is the first OLD1 object in the list */
889 return o;
890}
891
892
893static void dothecall (lua_State *L, void *ud) {
894 UNUSED(ud);
895 luaD_callnoyield(L, L->top - 2, 0);
896}
897
898
899static void GCTM (lua_State *L) {
900 global_State *g = G(L);
901 const TValue *tm;
902 TValue v;
903 lua_assert(!g->gcemergency);
904 setgcovalue(L, &v, udata2finalize(g));
905 tm = luaT_gettmbyobj(L, &v, TM_GC);
906 if (!notm(tm)) { /* is there a finalizer? */
907 int status;
908 lu_byte oldah = L->allowhook;
909 int running = g->gcrunning;
910 L->allowhook = 0; /* stop debug hooks during GC metamethod */
911 g->gcrunning = 0; /* avoid GC steps */
912 setobj2s(L, L->top++, tm); /* push finalizer... */
913 setobj2s(L, L->top++, &v); /* ... and its argument */
914 L->ci->callstatus |= CIST_FIN; /* will run a finalizer */
915 status = luaD_pcall(L, dothecall, NULL, savestack(L, L->top - 2), 0);
916 L->ci->callstatus &= ~CIST_FIN; /* not running a finalizer anymore */
917 L->allowhook = oldah; /* restore hooks */
918 g->gcrunning = running; /* restore state */
919 if (l_unlikely(status != LUA_OK)) { /* error while running __gc? */
920 luaE_warnerror(L, "__gc metamethod");
921 L->top--; /* pops error object */
922 }
923 }
924}
925
926
927/*
928** Call a few finalizers
929*/
930static int runafewfinalizers (lua_State *L, int n) {
931 global_State *g = G(L);
932 int i;
933 for (i = 0; i < n && g->tobefnz; i++)
934 GCTM(L); /* call one finalizer */
935 return i;
936}
937
938
939/*
940** call all pending finalizers
941*/
942static void callallpendingfinalizers (lua_State *L) {
943 global_State *g = G(L);
944 while (g->tobefnz)
945 GCTM(L);
946}
947
948
949/*
950** find last 'next' field in list 'p' list (to add elements in its end)
951*/
952static GCObject **findlast (GCObject **p) {
953 while (*p != NULL)
954 p = &(*p)->next;
955 return p;
956}
957
958
959/*
960** Move all unreachable objects (or 'all' objects) that need
961** finalization from list 'finobj' to list 'tobefnz' (to be finalized).
962** (Note that objects after 'finobjold1' cannot be white, so they
963** don't need to be traversed. In incremental mode, 'finobjold1' is NULL,
964** so the whole list is traversed.)
965*/
966static void separatetobefnz (global_State *g, int all) {
967 GCObject *curr;
968 GCObject **p = &g->finobj;
969 GCObject **lastnext = findlast(&g->tobefnz);
970 while ((curr = *p) != g->finobjold1) { /* traverse all finalizable objects */
971 lua_assert(tofinalize(curr));
972 if (!(iswhite(curr) || all)) /* not being collected? */
973 p = &curr->next; /* don't bother with it */
974 else {
975 if (curr == g->finobjsur) /* removing 'finobjsur'? */
976 g->finobjsur = curr->next; /* correct it */
977 *p = curr->next; /* remove 'curr' from 'finobj' list */
978 curr->next = *lastnext; /* link at the end of 'tobefnz' list */
979 *lastnext = curr;
980 lastnext = &curr->next;
981 }
982 }
983}
984
985
986/*
987** If pointer 'p' points to 'o', move it to the next element.
988*/
989static void checkpointer (GCObject **p, GCObject *o) {
990 if (o == *p)
991 *p = o->next;
992}
993
994
995/*
996** Correct pointers to objects inside 'allgc' list when
997** object 'o' is being removed from the list.
998*/
999static void correctpointers (global_State *g, GCObject *o) {
1000 checkpointer(&g->survival, o);
1001 checkpointer(&g->old1, o);
1002 checkpointer(&g->reallyold, o);
1003 checkpointer(&g->firstold1, o);
1004}
1005
1006
1007/*
1008** if object 'o' has a finalizer, remove it from 'allgc' list (must
1009** search the list to find it) and link it in 'finobj' list.
1010*/
1011void luaC_checkfinalizer (lua_State *L, GCObject *o, Table *mt) {
1012 global_State *g = G(L);
1013 if (tofinalize(o) || /* obj. is already marked... */
1014 gfasttm(g, mt, TM_GC) == NULL) /* or has no finalizer? */
1015 return; /* nothing to be done */
1016 else { /* move 'o' to 'finobj' list */
1017 GCObject **p;
1018 if (issweepphase(g)) {
1019 makewhite(g, o); /* "sweep" object 'o' */
1020 if (g->sweepgc == &o->next) /* should not remove 'sweepgc' object */
1021 g->sweepgc = sweeptolive(L, g->sweepgc); /* change 'sweepgc' */
1022 }
1023 else
1024 correctpointers(g, o);
1025 /* search for pointer pointing to 'o' */
1026 for (p = &g->allgc; *p != o; p = &(*p)->next) { /* empty */ }
1027 *p = o->next; /* remove 'o' from 'allgc' list */
1028 o->next = g->finobj; /* link it in 'finobj' list */
1029 g->finobj = o;
1030 l_setbit(o->marked, FINALIZEDBIT); /* mark it as such */
1031 }
1032}
1033
1034/* }====================================================== */
1035
1036
1037/*
1038** {======================================================
1039** Generational Collector
1040** =======================================================
1041*/
1042
1043static void setpause (global_State *g);
1044
1045
1046/*
1047** Sweep a list of objects to enter generational mode. Deletes dead
1048** objects and turns the non dead to old. All non-dead threads---which
1049** are now old---must be in a gray list. Everything else is not in a
1050** gray list. Open upvalues are also kept gray.
1051*/
1052static void sweep2old (lua_State *L, GCObject **p) {
1053 GCObject *curr;
1054 global_State *g = G(L);
1055 while ((curr = *p) != NULL) {
1056 if (iswhite(curr)) { /* is 'curr' dead? */
1057 lua_assert(isdead(g, curr));
1058 *p = curr->next; /* remove 'curr' from list */
1059 freeobj(L, curr); /* erase 'curr' */
1060 }
1061 else { /* all surviving objects become old */
1062 setage(curr, G_OLD);
1063 if (curr->tt == LUA_VTHREAD) { /* threads must be watched */
1064 lua_State *th = gco2th(curr);
1065 linkgclist(th, g->grayagain); /* insert into 'grayagain' list */
1066 }
1067 else if (curr->tt == LUA_VUPVAL && upisopen(gco2upv(curr)))
1068 set2gray(curr); /* open upvalues are always gray */
1069 else /* everything else is black */
1070 nw2black(curr);
1071 p = &curr->next; /* go to next element */
1072 }
1073 }
1074}
1075
1076
1077/*
1078** Sweep for generational mode. Delete dead objects. (Because the
1079** collection is not incremental, there are no "new white" objects
1080** during the sweep. So, any white object must be dead.) For
1081** non-dead objects, advance their ages and clear the color of
1082** new objects. (Old objects keep their colors.)
1083** The ages of G_TOUCHED1 and G_TOUCHED2 objects cannot be advanced
1084** here, because these old-generation objects are usually not swept
1085** here. They will all be advanced in 'correctgraylist'. That function
1086** will also remove objects turned white here from any gray list.
1087*/
1088static GCObject **sweepgen (lua_State *L, global_State *g, GCObject **p,
1089 GCObject *limit, GCObject **pfirstold1) {
1090 static const lu_byte nextage[] = {
1091 G_SURVIVAL, /* from G_NEW */
1092 G_OLD1, /* from G_SURVIVAL */
1093 G_OLD1, /* from G_OLD0 */
1094 G_OLD, /* from G_OLD1 */
1095 G_OLD, /* from G_OLD (do not change) */
1096 G_TOUCHED1, /* from G_TOUCHED1 (do not change) */
1097 G_TOUCHED2 /* from G_TOUCHED2 (do not change) */
1098 };
1099 int white = luaC_white(g);
1100 GCObject *curr;
1101 while ((curr = *p) != limit) {
1102 if (iswhite(curr)) { /* is 'curr' dead? */
1103 lua_assert(!isold(curr) && isdead(g, curr));
1104 *p = curr->next; /* remove 'curr' from list */
1105 freeobj(L, curr); /* erase 'curr' */
1106 }
1107 else { /* correct mark and age */
1108 if (getage(curr) == G_NEW) { /* new objects go back to white */
1109 int marked = curr->marked & ~maskgcbits; /* erase GC bits */
1110 curr->marked = cast_byte(marked | G_SURVIVAL | white);
1111 }
1112 else { /* all other objects will be old, and so keep their color */
1113 setage(curr, nextage[getage(curr)]);
1114 if (getage(curr) == G_OLD1 && *pfirstold1 == NULL)
1115 *pfirstold1 = curr; /* first OLD1 object in the list */
1116 }
1117 p = &curr->next; /* go to next element */
1118 }
1119 }
1120 return p;
1121}
1122
1123
1124/*
1125** Traverse a list making all its elements white and clearing their
1126** age. In incremental mode, all objects are 'new' all the time,
1127** except for fixed strings (which are always old).
1128*/
1129static void whitelist (global_State *g, GCObject *p) {
1130 int white = luaC_white(g);
1131 for (; p != NULL; p = p->next)
1132 p->marked = cast_byte((p->marked & ~maskgcbits) | white);
1133}
1134
1135
1136/*
1137** Correct a list of gray objects. Return pointer to where rest of the
1138** list should be linked.
1139** Because this correction is done after sweeping, young objects might
1140** be turned white and still be in the list. They are only removed.
1141** 'TOUCHED1' objects are advanced to 'TOUCHED2' and remain on the list;
1142** Non-white threads also remain on the list; 'TOUCHED2' objects become
1143** regular old; they and anything else are removed from the list.
1144*/
1145static GCObject **correctgraylist (GCObject **p) {
1146 GCObject *curr;
1147 while ((curr = *p) != NULL) {
1148 GCObject **next = getgclist(curr);
1149 if (iswhite(curr))
1150 goto remove; /* remove all white objects */
1151 else if (getage(curr) == G_TOUCHED1) { /* touched in this cycle? */
1152 lua_assert(isgray(curr));
1153 nw2black(curr); /* make it black, for next barrier */
1154 changeage(curr, G_TOUCHED1, G_TOUCHED2);
1155 goto remain; /* keep it in the list and go to next element */
1156 }
1157 else if (curr->tt == LUA_VTHREAD) {
1158 lua_assert(isgray(curr));
1159 goto remain; /* keep non-white threads on the list */
1160 }
1161 else { /* everything else is removed */
1162 lua_assert(isold(curr)); /* young objects should be white here */
1163 if (getage(curr) == G_TOUCHED2) /* advance from TOUCHED2... */
1164 changeage(curr, G_TOUCHED2, G_OLD); /* ... to OLD */
1165 nw2black(curr); /* make object black (to be removed) */
1166 goto remove;
1167 }
1168 remove: *p = *next; continue;
1169 remain: p = next; continue;
1170 }
1171 return p;
1172}
1173
1174
1175/*
1176** Correct all gray lists, coalescing them into 'grayagain'.
1177*/
1178static void correctgraylists (global_State *g) {
1179 GCObject **list = correctgraylist(&g->grayagain);
1180 *list = g->weak; g->weak = NULL;
1181 list = correctgraylist(list);
1182 *list = g->allweak; g->allweak = NULL;
1183 list = correctgraylist(list);
1184 *list = g->ephemeron; g->ephemeron = NULL;
1185 correctgraylist(list);
1186}
1187
1188
1189/*
1190** Mark black 'OLD1' objects when starting a new young collection.
1191** Gray objects are already in some gray list, and so will be visited
1192** in the atomic step.
1193*/
1194static void markold (global_State *g, GCObject *from, GCObject *to) {
1195 GCObject *p;
1196 for (p = from; p != to; p = p->next) {
1197 if (getage(p) == G_OLD1) {
1198 lua_assert(!iswhite(p));
1199 changeage(p, G_OLD1, G_OLD); /* now they are old */
1200 if (isblack(p))
1201 reallymarkobject(g, p);
1202 }
1203 }
1204}
1205
1206
1207/*
1208** Finish a young-generation collection.
1209*/
1210static void finishgencycle (lua_State *L, global_State *g) {
1211 correctgraylists(g);
1212 checkSizes(L, g);
1213 g->gcstate = GCSpropagate; /* skip restart */
1214 if (!g->gcemergency)
1215 callallpendingfinalizers(L);
1216}
1217
1218
1219/*
1220** Does a young collection. First, mark 'OLD1' objects. Then does the
1221** atomic step. Then, sweep all lists and advance pointers. Finally,
1222** finish the collection.
1223*/
1224static void youngcollection (lua_State *L, global_State *g) {
1225 GCObject **psurvival; /* to point to first non-dead survival object */
1226 GCObject *dummy; /* dummy out parameter to 'sweepgen' */
1227 lua_assert(g->gcstate == GCSpropagate);
1228 if (g->firstold1) { /* are there regular OLD1 objects? */
1229 markold(g, g->firstold1, g->reallyold); /* mark them */
1230 g->firstold1 = NULL; /* no more OLD1 objects (for now) */
1231 }
1232 markold(g, g->finobj, g->finobjrold);
1233 markold(g, g->tobefnz, NULL);
1234 atomic(L);
1235
1236 /* sweep nursery and get a pointer to its last live element */
1237 g->gcstate = GCSswpallgc;
1238 psurvival = sweepgen(L, g, &g->allgc, g->survival, &g->firstold1);
1239 /* sweep 'survival' */
1240 sweepgen(L, g, psurvival, g->old1, &g->firstold1);
1241 g->reallyold = g->old1;
1242 g->old1 = *psurvival; /* 'survival' survivals are old now */
1243 g->survival = g->allgc; /* all news are survivals */
1244
1245 /* repeat for 'finobj' lists */
1246 dummy = NULL; /* no 'firstold1' optimization for 'finobj' lists */
1247 psurvival = sweepgen(L, g, &g->finobj, g->finobjsur, &dummy);
1248 /* sweep 'survival' */
1249 sweepgen(L, g, psurvival, g->finobjold1, &dummy);
1250 g->finobjrold = g->finobjold1;
1251 g->finobjold1 = *psurvival; /* 'survival' survivals are old now */
1252 g->finobjsur = g->finobj; /* all news are survivals */
1253
1254 sweepgen(L, g, &g->tobefnz, NULL, &dummy);
1255 finishgencycle(L, g);
1256}
1257
1258
1259/*
1260** Clears all gray lists, sweeps objects, and prepare sublists to enter
1261** generational mode. The sweeps remove dead objects and turn all
1262** surviving objects to old. Threads go back to 'grayagain'; everything
1263** else is turned black (not in any gray list).
1264*/
1265static void atomic2gen (lua_State *L, global_State *g) {
1266 cleargraylists(g);
1267 /* sweep all elements making them old */
1268 g->gcstate = GCSswpallgc;
1269 sweep2old(L, &g->allgc);
1270 /* everything alive now is old */
1271 g->reallyold = g->old1 = g->survival = g->allgc;
1272 g->firstold1 = NULL; /* there are no OLD1 objects anywhere */
1273
1274 /* repeat for 'finobj' lists */
1275 sweep2old(L, &g->finobj);
1276 g->finobjrold = g->finobjold1 = g->finobjsur = g->finobj;
1277
1278 sweep2old(L, &g->tobefnz);
1279
1280 g->gckind = KGC_GEN;
1281 g->lastatomic = 0;
1282 g->GCestimate = gettotalbytes(g); /* base for memory control */
1283 finishgencycle(L, g);
1284}
1285
1286
1287/*
1288** Enter generational mode. Must go until the end of an atomic cycle
1289** to ensure that all objects are correctly marked and weak tables
1290** are cleared. Then, turn all objects into old and finishes the
1291** collection.
1292*/
1293static lu_mem entergen (lua_State *L, global_State *g) {
1294 lu_mem numobjs;
1295 luaC_runtilstate(L, bitmask(GCSpause)); /* prepare to start a new cycle */
1296 luaC_runtilstate(L, bitmask(GCSpropagate)); /* start new cycle */
1297 numobjs = atomic(L); /* propagates all and then do the atomic stuff */
1298 atomic2gen(L, g);
1299 return numobjs;
1300}
1301
1302
1303/*
1304** Enter incremental mode. Turn all objects white, make all
1305** intermediate lists point to NULL (to avoid invalid pointers),
1306** and go to the pause state.
1307*/
1308static void enterinc (global_State *g) {
1309 whitelist(g, g->allgc);
1310 g->reallyold = g->old1 = g->survival = NULL;
1311 whitelist(g, g->finobj);
1312 whitelist(g, g->tobefnz);
1313 g->finobjrold = g->finobjold1 = g->finobjsur = NULL;
1314 g->gcstate = GCSpause;
1315 g->gckind = KGC_INC;
1316 g->lastatomic = 0;
1317}
1318
1319
1320/*
1321** Change collector mode to 'newmode'.
1322*/
1323void luaC_changemode (lua_State *L, int newmode) {
1324 global_State *g = G(L);
1325 if (newmode != g->gckind) {
1326 if (newmode == KGC_GEN) /* entering generational mode? */
1327 entergen(L, g);
1328 else
1329 enterinc(g); /* entering incremental mode */
1330 }
1331 g->lastatomic = 0;
1332}
1333
1334
1335/*
1336** Does a full collection in generational mode.
1337*/
1338static lu_mem fullgen (lua_State *L, global_State *g) {
1339 enterinc(g);
1340 return entergen(L, g);
1341}
1342
1343
1344/*
1345** Set debt for the next minor collection, which will happen when
1346** memory grows 'genminormul'%.
1347*/
1348static void setminordebt (global_State *g) {
1349 luaE_setdebt(g, -(cast(l_mem, (gettotalbytes(g) / 100)) * g->genminormul));
1350}
1351
1352
1353/*
1354** Does a major collection after last collection was a "bad collection".
1355**
1356** When the program is building a big structure, it allocates lots of
1357** memory but generates very little garbage. In those scenarios,
1358** the generational mode just wastes time doing small collections, and
1359** major collections are frequently what we call a "bad collection", a
1360** collection that frees too few objects. To avoid the cost of switching
1361** between generational mode and the incremental mode needed for full
1362** (major) collections, the collector tries to stay in incremental mode
1363** after a bad collection, and to switch back to generational mode only
1364** after a "good" collection (one that traverses less than 9/8 objects
1365** of the previous one).
1366** The collector must choose whether to stay in incremental mode or to
1367** switch back to generational mode before sweeping. At this point, it
1368** does not know the real memory in use, so it cannot use memory to
1369** decide whether to return to generational mode. Instead, it uses the
1370** number of objects traversed (returned by 'atomic') as a proxy. The
1371** field 'g->lastatomic' keeps this count from the last collection.
1372** ('g->lastatomic != 0' also means that the last collection was bad.)
1373*/
1374static void stepgenfull (lua_State *L, global_State *g) {
1375 lu_mem newatomic; /* count of traversed objects */
1376 lu_mem lastatomic = g->lastatomic; /* count from last collection */
1377 if (g->gckind == KGC_GEN) /* still in generational mode? */
1378 enterinc(g); /* enter incremental mode */
1379 luaC_runtilstate(L, bitmask(GCSpropagate)); /* start new cycle */
1380 newatomic = atomic(L); /* mark everybody */
1381 if (newatomic < lastatomic + (lastatomic >> 3)) { /* good collection? */
1382 atomic2gen(L, g); /* return to generational mode */
1383 setminordebt(g);
1384 }
1385 else { /* another bad collection; stay in incremental mode */
1386 g->GCestimate = gettotalbytes(g); /* first estimate */;
1387 entersweep(L);
1388 luaC_runtilstate(L, bitmask(GCSpause)); /* finish collection */
1389 setpause(g);
1390 g->lastatomic = newatomic;
1391 }
1392}
1393
1394
1395/*
1396** Does a generational "step".
1397** Usually, this means doing a minor collection and setting the debt to
1398** make another collection when memory grows 'genminormul'% larger.
1399**
1400** However, there are exceptions. If memory grows 'genmajormul'%
1401** larger than it was at the end of the last major collection (kept
1402** in 'g->GCestimate'), the function does a major collection. At the
1403** end, it checks whether the major collection was able to free a
1404** decent amount of memory (at least half the growth in memory since
1405** previous major collection). If so, the collector keeps its state,
1406** and the next collection will probably be minor again. Otherwise,
1407** we have what we call a "bad collection". In that case, set the field
1408** 'g->lastatomic' to signal that fact, so that the next collection will
1409** go to 'stepgenfull'.
1410**
1411** 'GCdebt <= 0' means an explicit call to GC step with "size" zero;
1412** in that case, do a minor collection.
1413*/
1414static void genstep (lua_State *L, global_State *g) {
1415 if (g->lastatomic != 0) /* last collection was a bad one? */
1416 stepgenfull(L, g); /* do a full step */
1417 else {
1418 lu_mem majorbase = g->GCestimate; /* memory after last major collection */
1419 lu_mem majorinc = (majorbase / 100) * getgcparam(g->genmajormul);
1420 if (g->GCdebt > 0 && gettotalbytes(g) > majorbase + majorinc) {
1421 lu_mem numobjs = fullgen(L, g); /* do a major collection */
1422 if (gettotalbytes(g) < majorbase + (majorinc / 2)) {
1423 /* collected at least half of memory growth since last major
1424 collection; keep doing minor collections */
1425 setminordebt(g);
1426 }
1427 else { /* bad collection */
1428 g->lastatomic = numobjs; /* signal that last collection was bad */
1429 setpause(g); /* do a long wait for next (major) collection */
1430 }
1431 }
1432 else { /* regular case; do a minor collection */
1433 youngcollection(L, g);
1434 setminordebt(g);
1435 g->GCestimate = majorbase; /* preserve base value */
1436 }
1437 }
1438 lua_assert(isdecGCmodegen(g));
1439}
1440
1441/* }====================================================== */
1442
1443
1444/*
1445** {======================================================
1446** GC control
1447** =======================================================
1448*/
1449
1450
1451/*
1452** Set the "time" to wait before starting a new GC cycle; cycle will
1453** start when memory use hits the threshold of ('estimate' * pause /
1454** PAUSEADJ). (Division by 'estimate' should be OK: it cannot be zero,
1455** because Lua cannot even start with less than PAUSEADJ bytes).
1456*/
1457static void setpause (global_State *g) {
1458 l_mem threshold, debt;
1459 int pause = getgcparam(g->gcpause);
1460 l_mem estimate = g->GCestimate / PAUSEADJ; /* adjust 'estimate' */
1461 lua_assert(estimate > 0);
1462 threshold = (pause < MAX_LMEM / estimate) /* overflow? */
1463 ? estimate * pause /* no overflow */
1464 : MAX_LMEM; /* overflow; truncate to maximum */
1465 debt = gettotalbytes(g) - threshold;
1466 if (debt > 0) debt = 0;
1467 luaE_setdebt(g, debt);
1468}
1469
1470
1471/*
1472** Enter first sweep phase.
1473** The call to 'sweeptolive' makes the pointer point to an object
1474** inside the list (instead of to the header), so that the real sweep do
1475** not need to skip objects created between "now" and the start of the
1476** real sweep.
1477*/
1478static void entersweep (lua_State *L) {
1479 global_State *g = G(L);
1480 g->gcstate = GCSswpallgc;
1481 lua_assert(g->sweepgc == NULL);
1482 g->sweepgc = sweeptolive(L, &g->allgc);
1483}
1484
1485
1486/*
1487** Delete all objects in list 'p' until (but not including) object
1488** 'limit'.
1489*/
1490static void deletelist (lua_State *L, GCObject *p, GCObject *limit) {
1491 while (p != limit) {
1492 GCObject *next = p->next;
1493 freeobj(L, p);
1494 p = next;
1495 }
1496}
1497
1498
1499/*
1500** Call all finalizers of the objects in the given Lua state, and
1501** then free all objects, except for the main thread.
1502*/
1503void luaC_freeallobjects (lua_State *L) {
1504 global_State *g = G(L);
1505 luaC_changemode(L, KGC_INC);
1506 separatetobefnz(g, 1); /* separate all objects with finalizers */
1507 lua_assert(g->finobj == NULL);
1508 callallpendingfinalizers(L);
1509 deletelist(L, g->allgc, obj2gco(g->mainthread));
1510 deletelist(L, g->finobj, NULL);
1511 deletelist(L, g->fixedgc, NULL); /* collect fixed objects */
1512 lua_assert(g->strt.nuse == 0);
1513}
1514
1515
1516static lu_mem atomic (lua_State *L) {
1517 global_State *g = G(L);
1518 lu_mem work = 0;
1519 GCObject *origweak, *origall;
1520 GCObject *grayagain = g->grayagain; /* save original list */
1521 g->grayagain = NULL;
1522 lua_assert(g->ephemeron == NULL && g->weak == NULL);
1523 lua_assert(!iswhite(g->mainthread));
1524 g->gcstate = GCSatomic;
1525 markobject(g, L); /* mark running thread */
1526 /* registry and global metatables may be changed by API */
1527 markvalue(g, &g->l_registry);
1528 markmt(g); /* mark global metatables */
1529 work += propagateall(g); /* empties 'gray' list */
1530 /* remark occasional upvalues of (maybe) dead threads */
1531 work += remarkupvals(g);
1532 work += propagateall(g); /* propagate changes */
1533 g->gray = grayagain;
1534 work += propagateall(g); /* traverse 'grayagain' list */
1535 convergeephemerons(g);
1536 /* at this point, all strongly accessible objects are marked. */
1537 /* Clear values from weak tables, before checking finalizers */
1538 clearbyvalues(g, g->weak, NULL);
1539 clearbyvalues(g, g->allweak, NULL);
1540 origweak = g->weak; origall = g->allweak;
1541 separatetobefnz(g, 0); /* separate objects to be finalized */
1542 work += markbeingfnz(g); /* mark objects that will be finalized */
1543 work += propagateall(g); /* remark, to propagate 'resurrection' */
1544 convergeephemerons(g);
1545 /* at this point, all resurrected objects are marked. */
1546 /* remove dead objects from weak tables */
1547 clearbykeys(g, g->ephemeron); /* clear keys from all ephemeron tables */
1548 clearbykeys(g, g->allweak); /* clear keys from all 'allweak' tables */
1549 /* clear values from resurrected weak tables */
1550 clearbyvalues(g, g->weak, origweak);
1551 clearbyvalues(g, g->allweak, origall);
1552 luaS_clearcache(g);
1553 g->currentwhite = cast_byte(otherwhite(g)); /* flip current white */
1554 lua_assert(g->gray == NULL);
1555 return work; /* estimate of slots marked by 'atomic' */
1556}
1557
1558
1559static int sweepstep (lua_State *L, global_State *g,
1560 int nextstate, GCObject **nextlist) {
1561 if (g->sweepgc) {
1562 l_mem olddebt = g->GCdebt;
1563 int count;
1564 g->sweepgc = sweeplist(L, g->sweepgc, GCSWEEPMAX, &count);
1565 g->GCestimate += g->GCdebt - olddebt; /* update estimate */
1566 return count;
1567 }
1568 else { /* enter next state */
1569 g->gcstate = nextstate;
1570 g->sweepgc = nextlist;
1571 return 0; /* no work done */
1572 }
1573}
1574
1575
1576static lu_mem singlestep (lua_State *L) {
1577 global_State *g = G(L);
1578 lu_mem work;
1579 lua_assert(!g->gcstopem); /* collector is not reentrant */
1580 g->gcstopem = 1; /* no emergency collections while collecting */
1581 switch (g->gcstate) {
1582 case GCSpause: {
1583 restartcollection(g);
1584 g->gcstate = GCSpropagate;
1585 work = 1;
1586 break;
1587 }
1588 case GCSpropagate: {
1589 if (g->gray == NULL) { /* no more gray objects? */
1590 g->gcstate = GCSenteratomic; /* finish propagate phase */
1591 work = 0;
1592 }
1593 else
1594 work = propagatemark(g); /* traverse one gray object */
1595 break;
1596 }
1597 case GCSenteratomic: {
1598 work = atomic(L); /* work is what was traversed by 'atomic' */
1599 entersweep(L);
1600 g->GCestimate = gettotalbytes(g); /* first estimate */;
1601 break;
1602 }
1603 case GCSswpallgc: { /* sweep "regular" objects */
1604 work = sweepstep(L, g, GCSswpfinobj, &g->finobj);
1605 break;
1606 }
1607 case GCSswpfinobj: { /* sweep objects with finalizers */
1608 work = sweepstep(L, g, GCSswptobefnz, &g->tobefnz);
1609 break;
1610 }
1611 case GCSswptobefnz: { /* sweep objects to be finalized */
1612 work = sweepstep(L, g, GCSswpend, NULL);
1613 break;
1614 }
1615 case GCSswpend: { /* finish sweeps */
1616 checkSizes(L, g);
1617 g->gcstate = GCScallfin;
1618 work = 0;
1619 break;
1620 }
1621 case GCScallfin: { /* call remaining finalizers */
1622 if (g->tobefnz && !g->gcemergency) {
1623 g->gcstopem = 0; /* ok collections during finalizers */
1624 work = runafewfinalizers(L, GCFINMAX) * GCFINALIZECOST;
1625 }
1626 else { /* emergency mode or no more finalizers */
1627 g->gcstate = GCSpause; /* finish collection */
1628 work = 0;
1629 }
1630 break;
1631 }
1632 default: lua_assert(0); return 0;
1633 }
1634 g->gcstopem = 0;
1635 return work;
1636}
1637
1638
1639/*
1640** advances the garbage collector until it reaches a state allowed
1641** by 'statemask'
1642*/
1643void luaC_runtilstate (lua_State *L, int statesmask) {
1644 global_State *g = G(L);
1645 while (!testbit(statesmask, g->gcstate))
1646 singlestep(L);
1647}
1648
1649
1650/*
1651** Performs a basic incremental step. The debt and step size are
1652** converted from bytes to "units of work"; then the function loops
1653** running single steps until adding that many units of work or
1654** finishing a cycle (pause state). Finally, it sets the debt that
1655** controls when next step will be performed.
1656*/
1657static void incstep (lua_State *L, global_State *g) {
1658 int stepmul = (getgcparam(g->gcstepmul) | 1); /* avoid division by 0 */
1659 l_mem debt = (g->GCdebt / WORK2MEM) * stepmul;
1660 l_mem stepsize = (g->gcstepsize <= log2maxs(l_mem))
1661 ? ((cast(l_mem, 1) << g->gcstepsize) / WORK2MEM) * stepmul
1662 : MAX_LMEM; /* overflow; keep maximum value */
1663 do { /* repeat until pause or enough "credit" (negative debt) */
1664 lu_mem work = singlestep(L); /* perform one single step */
1665 debt -= work;
1666 } while (debt > -stepsize && g->gcstate != GCSpause);
1667 if (g->gcstate == GCSpause)
1668 setpause(g); /* pause until next cycle */
1669 else {
1670 debt = (debt / stepmul) * WORK2MEM; /* convert 'work units' to bytes */
1671 luaE_setdebt(g, debt);
1672 }
1673}
1674
1675/*
1676** performs a basic GC step if collector is running
1677*/
1678void luaC_step (lua_State *L) {
1679 global_State *g = G(L);
1680 lua_assert(!g->gcemergency);
1681 if (g->gcrunning) { /* running? */
1682 if(isdecGCmodegen(g))
1683 genstep(L, g);
1684 else
1685 incstep(L, g);
1686 }
1687}
1688
1689
1690/*
1691** Perform a full collection in incremental mode.
1692** Before running the collection, check 'keepinvariant'; if it is true,
1693** there may be some objects marked as black, so the collector has
1694** to sweep all objects to turn them back to white (as white has not
1695** changed, nothing will be collected).
1696*/
1697static void fullinc (lua_State *L, global_State *g) {
1698 if (keepinvariant(g)) /* black objects? */
1699 entersweep(L); /* sweep everything to turn them back to white */
1700 /* finish any pending sweep phase to start a new cycle */
1701 luaC_runtilstate(L, bitmask(GCSpause));
1702 luaC_runtilstate(L, bitmask(GCScallfin)); /* run up to finalizers */
1703 /* estimate must be correct after a full GC cycle */
1704 lua_assert(g->GCestimate == gettotalbytes(g));
1705 luaC_runtilstate(L, bitmask(GCSpause)); /* finish collection */
1706 setpause(g);
1707}
1708
1709
1710/*
1711** Performs a full GC cycle; if 'isemergency', set a flag to avoid
1712** some operations which could change the interpreter state in some
1713** unexpected ways (running finalizers and shrinking some structures).
1714*/
1715void luaC_fullgc (lua_State *L, int isemergency) {
1716 global_State *g = G(L);
1717 lua_assert(!g->gcemergency);
1718 g->gcemergency = isemergency; /* set flag */
1719 if (g->gckind == KGC_INC)
1720 fullinc(L, g);
1721 else
1722 fullgen(L, g);
1723 g->gcemergency = 0;
1724}
1725
1726/* }====================================================== */
1727
1728
diff --git a/src/lua/lgc.h b/src/lua/lgc.h
deleted file mode 100644
index 073e2a4..0000000
--- a/src/lua/lgc.h
+++ /dev/null
@@ -1,189 +0,0 @@
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 means
16** the object is not marked; gray, which means the object is marked, but
17** its references may be not marked; and black, which means that the
18** object and all its references are marked. The main invariant of the
19** garbage collector, while marking objects, is that a black object can
20** never point to a white one. Moreover, any gray object must be in a
21** "gray list" (gray, grayagain, weak, allweak, ephemeron) so that it
22** can be visited again before finishing the collection cycle. (Open
23** upvalues are an exception to this rule.) These lists have no meaning
24** when the invariant 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 used
73** by tests.
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#define TESTBIT 7
81
82
83
84#define WHITEBITS bit2mask(WHITE0BIT, WHITE1BIT)
85
86
87#define iswhite(x) testbits((x)->marked, WHITEBITS)
88#define isblack(x) testbit((x)->marked, BLACKBIT)
89#define isgray(x) /* neither white nor black */ \
90 (!testbits((x)->marked, WHITEBITS | bitmask(BLACKBIT)))
91
92#define tofinalize(x) testbit((x)->marked, FINALIZEDBIT)
93
94#define otherwhite(g) ((g)->currentwhite ^ WHITEBITS)
95#define isdeadm(ow,m) ((m) & (ow))
96#define isdead(g,v) isdeadm(otherwhite(g), (v)->marked)
97
98#define changewhite(x) ((x)->marked ^= WHITEBITS)
99#define nw2black(x) \
100 check_exp(!iswhite(x), l_setbit((x)->marked, BLACKBIT))
101
102#define luaC_white(g) cast_byte((g)->currentwhite & WHITEBITS)
103
104
105/* object age in generational mode */
106#define G_NEW 0 /* created in current cycle */
107#define G_SURVIVAL 1 /* created in previous cycle */
108#define G_OLD0 2 /* marked old by frw. barrier in this cycle */
109#define G_OLD1 3 /* first full cycle as old */
110#define G_OLD 4 /* really old object (not to be visited) */
111#define G_TOUCHED1 5 /* old object touched this cycle */
112#define G_TOUCHED2 6 /* old object touched in previous cycle */
113
114#define AGEBITS 7 /* all age bits (111) */
115
116#define getage(o) ((o)->marked & AGEBITS)
117#define setage(o,a) ((o)->marked = cast_byte(((o)->marked & (~AGEBITS)) | a))
118#define isold(o) (getage(o) > G_SURVIVAL)
119
120#define changeage(o,f,t) \
121 check_exp(getage(o) == (f), (o)->marked ^= ((f)^(t)))
122
123
124/* Default Values for GC parameters */
125#define LUAI_GENMAJORMUL 100
126#define LUAI_GENMINORMUL 20
127
128/* wait memory to double before starting new cycle */
129#define LUAI_GCPAUSE 200
130
131/*
132** some gc parameters are stored divided by 4 to allow a maximum value
133** up to 1023 in a 'lu_byte'.
134*/
135#define getgcparam(p) ((p) * 4)
136#define setgcparam(p,v) ((p) = (v) / 4)
137
138#define LUAI_GCMUL 100
139
140/* how much to allocate before next GC step (log2) */
141#define LUAI_GCSTEPSIZE 13 /* 8 KB */
142
143
144/*
145** Check whether the declared GC mode is generational. While in
146** generational mode, the collector can go temporarily to incremental
147** mode to improve performance. This is signaled by 'g->lastatomic != 0'.
148*/
149#define isdecGCmodegen(g) (g->gckind == KGC_GEN || g->lastatomic != 0)
150
151/*
152** Does one step of collection when debt becomes positive. 'pre'/'pos'
153** allows some adjustments to be done only when needed. macro
154** 'condchangemem' is used only for heavy tests (forcing a full
155** GC cycle on every opportunity)
156*/
157#define luaC_condGC(L,pre,pos) \
158 { if (G(L)->GCdebt > 0) { pre; luaC_step(L); pos;}; \
159 condchangemem(L,pre,pos); }
160
161/* more often than not, 'pre'/'pos' are empty */
162#define luaC_checkGC(L) luaC_condGC(L,(void)0,(void)0)
163
164
165#define luaC_barrier(L,p,v) ( \
166 (iscollectable(v) && isblack(p) && iswhite(gcvalue(v))) ? \
167 luaC_barrier_(L,obj2gco(p),gcvalue(v)) : cast_void(0))
168
169#define luaC_barrierback(L,p,v) ( \
170 (iscollectable(v) && isblack(p) && iswhite(gcvalue(v))) ? \
171 luaC_barrierback_(L,p) : cast_void(0))
172
173#define luaC_objbarrier(L,p,o) ( \
174 (isblack(p) && iswhite(o)) ? \
175 luaC_barrier_(L,obj2gco(p),obj2gco(o)) : cast_void(0))
176
177LUAI_FUNC void luaC_fix (lua_State *L, GCObject *o);
178LUAI_FUNC void luaC_freeallobjects (lua_State *L);
179LUAI_FUNC void luaC_step (lua_State *L);
180LUAI_FUNC void luaC_runtilstate (lua_State *L, int statesmask);
181LUAI_FUNC void luaC_fullgc (lua_State *L, int isemergency);
182LUAI_FUNC GCObject *luaC_newobj (lua_State *L, int tt, size_t sz);
183LUAI_FUNC void luaC_barrier_ (lua_State *L, GCObject *o, GCObject *v);
184LUAI_FUNC void luaC_barrierback_ (lua_State *L, GCObject *o);
185LUAI_FUNC void luaC_checkfinalizer (lua_State *L, GCObject *o, Table *mt);
186LUAI_FUNC void luaC_changemode (lua_State *L, int newmode);
187
188
189#endif
diff --git a/src/lua/linit.c b/src/lua/linit.c
deleted file mode 100644
index 69808f8..0000000
--- a/src/lua/linit.c
+++ /dev/null
@@ -1,65 +0,0 @@
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
deleted file mode 100644
index b08397d..0000000
--- a/src/lua/liolib.c
+++ /dev/null
@@ -1,828 +0,0 @@
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#if !defined(l_checkmodep)
68/* Windows accepts "[rw][bt]?" as valid modes */
69#define l_checkmodep(m) ((m[0] == 'r' || m[0] == 'w') && \
70 (m[1] == '\0' || ((m[1] == 'b' || m[1] == 't') && m[2] == '\0')))
71#endif
72
73#else /* }{ */
74
75/* ISO C definitions */
76#define l_popen(L,c,m) \
77 ((void)c, (void)m, \
78 luaL_error(L, "'popen' not supported"), \
79 (FILE*)0)
80#define l_pclose(L,file) ((void)L, (void)file, -1)
81
82#endif /* } */
83
84#endif /* } */
85
86
87#if !defined(l_checkmodep)
88/* By default, Lua accepts only "r" or "w" as valid modes */
89#define l_checkmodep(m) ((m[0] == 'r' || m[0] == 'w') && m[1] == '\0')
90#endif
91
92/* }====================================================== */
93
94
95#if !defined(l_getc) /* { */
96
97#if defined(LUA_USE_POSIX)
98#define l_getc(f) getc_unlocked(f)
99#define l_lockfile(f) flockfile(f)
100#define l_unlockfile(f) funlockfile(f)
101#else
102#define l_getc(f) getc(f)
103#define l_lockfile(f) ((void)0)
104#define l_unlockfile(f) ((void)0)
105#endif
106
107#endif /* } */
108
109
110/*
111** {======================================================
112** l_fseek: configuration for longer offsets
113** =======================================================
114*/
115
116#if !defined(l_fseek) /* { */
117
118#if defined(LUA_USE_POSIX) /* { */
119
120#include <sys/types.h>
121
122#define l_fseek(f,o,w) fseeko(f,o,w)
123#define l_ftell(f) ftello(f)
124#define l_seeknum off_t
125
126#elif defined(LUA_USE_WINDOWS) && !defined(_CRTIMP_TYPEINFO) \
127 && defined(_MSC_VER) && (_MSC_VER >= 1400) /* }{ */
128
129/* Windows (but not DDK) and Visual C++ 2005 or higher */
130#define l_fseek(f,o,w) _fseeki64(f,o,w)
131#define l_ftell(f) _ftelli64(f)
132#define l_seeknum __int64
133
134#else /* }{ */
135
136/* ISO C definitions */
137#define l_fseek(f,o,w) fseek(f,o,w)
138#define l_ftell(f) ftell(f)
139#define l_seeknum long
140
141#endif /* } */
142
143#endif /* } */
144
145/* }====================================================== */
146
147
148
149#define IO_PREFIX "_IO_"
150#define IOPREF_LEN (sizeof(IO_PREFIX)/sizeof(char) - 1)
151#define IO_INPUT (IO_PREFIX "input")
152#define IO_OUTPUT (IO_PREFIX "output")
153
154
155typedef luaL_Stream LStream;
156
157
158#define tolstream(L) ((LStream *)luaL_checkudata(L, 1, LUA_FILEHANDLE))
159
160#define isclosed(p) ((p)->closef == NULL)
161
162
163static int io_type (lua_State *L) {
164 LStream *p;
165 luaL_checkany(L, 1);
166 p = (LStream *)luaL_testudata(L, 1, LUA_FILEHANDLE);
167 if (p == NULL)
168 luaL_pushfail(L); /* not a file */
169 else if (isclosed(p))
170 lua_pushliteral(L, "closed file");
171 else
172 lua_pushliteral(L, "file");
173 return 1;
174}
175
176
177static int f_tostring (lua_State *L) {
178 LStream *p = tolstream(L);
179 if (isclosed(p))
180 lua_pushliteral(L, "file (closed)");
181 else
182 lua_pushfstring(L, "file (%p)", p->f);
183 return 1;
184}
185
186
187static FILE *tofile (lua_State *L) {
188 LStream *p = tolstream(L);
189 if (l_unlikely(isclosed(p)))
190 luaL_error(L, "attempt to use a closed file");
191 lua_assert(p->f);
192 return p->f;
193}
194
195
196/*
197** When creating file handles, always creates a 'closed' file handle
198** before opening the actual file; so, if there is a memory error, the
199** handle is in a consistent state.
200*/
201static LStream *newprefile (lua_State *L) {
202 LStream *p = (LStream *)lua_newuserdatauv(L, sizeof(LStream), 0);
203 p->closef = NULL; /* mark file handle as 'closed' */
204 luaL_setmetatable(L, LUA_FILEHANDLE);
205 return p;
206}
207
208
209/*
210** Calls the 'close' function from a file handle. The 'volatile' avoids
211** a bug in some versions of the Clang compiler (e.g., clang 3.0 for
212** 32 bits).
213*/
214static int aux_close (lua_State *L) {
215 LStream *p = tolstream(L);
216 volatile lua_CFunction cf = p->closef;
217 p->closef = NULL; /* mark stream as closed */
218 return (*cf)(L); /* close it */
219}
220
221
222static int f_close (lua_State *L) {
223 tofile(L); /* make sure argument is an open stream */
224 return aux_close(L);
225}
226
227
228static int io_close (lua_State *L) {
229 if (lua_isnone(L, 1)) /* no argument? */
230 lua_getfield(L, LUA_REGISTRYINDEX, IO_OUTPUT); /* use default output */
231 return f_close(L);
232}
233
234
235static int f_gc (lua_State *L) {
236 LStream *p = tolstream(L);
237 if (!isclosed(p) && p->f != NULL)
238 aux_close(L); /* ignore closed and incompletely open files */
239 return 0;
240}
241
242
243/*
244** function to close regular files
245*/
246static int io_fclose (lua_State *L) {
247 LStream *p = tolstream(L);
248 int res = fclose(p->f);
249 return luaL_fileresult(L, (res == 0), NULL);
250}
251
252
253static LStream *newfile (lua_State *L) {
254 LStream *p = newprefile(L);
255 p->f = NULL;
256 p->closef = &io_fclose;
257 return p;
258}
259
260
261static void opencheck (lua_State *L, const char *fname, const char *mode) {
262 LStream *p = newfile(L);
263 p->f = fopen(fname, mode);
264 if (l_unlikely(p->f == NULL))
265 luaL_error(L, "cannot open file '%s' (%s)", fname, strerror(errno));
266}
267
268
269static int io_open (lua_State *L) {
270 const char *filename = luaL_checkstring(L, 1);
271 const char *mode = luaL_optstring(L, 2, "r");
272 LStream *p = newfile(L);
273 const char *md = mode; /* to traverse/check mode */
274 luaL_argcheck(L, l_checkmode(md), 2, "invalid mode");
275 p->f = fopen(filename, mode);
276 return (p->f == NULL) ? luaL_fileresult(L, 0, filename) : 1;
277}
278
279
280/*
281** function to close 'popen' files
282*/
283static int io_pclose (lua_State *L) {
284 LStream *p = tolstream(L);
285 errno = 0;
286 return luaL_execresult(L, l_pclose(L, p->f));
287}
288
289
290static int io_popen (lua_State *L) {
291 const char *filename = luaL_checkstring(L, 1);
292 const char *mode = luaL_optstring(L, 2, "r");
293 LStream *p = newprefile(L);
294 luaL_argcheck(L, l_checkmodep(mode), 2, "invalid mode");
295 p->f = l_popen(L, filename, mode);
296 p->closef = &io_pclose;
297 return (p->f == NULL) ? luaL_fileresult(L, 0, filename) : 1;
298}
299
300
301static int io_tmpfile (lua_State *L) {
302 LStream *p = newfile(L);
303 p->f = tmpfile();
304 return (p->f == NULL) ? luaL_fileresult(L, 0, NULL) : 1;
305}
306
307
308static FILE *getiofile (lua_State *L, const char *findex) {
309 LStream *p;
310 lua_getfield(L, LUA_REGISTRYINDEX, findex);
311 p = (LStream *)lua_touserdata(L, -1);
312 if (l_unlikely(isclosed(p)))
313 luaL_error(L, "default %s file is closed", findex + IOPREF_LEN);
314 return p->f;
315}
316
317
318static int g_iofile (lua_State *L, const char *f, const char *mode) {
319 if (!lua_isnoneornil(L, 1)) {
320 const char *filename = lua_tostring(L, 1);
321 if (filename)
322 opencheck(L, filename, mode);
323 else {
324 tofile(L); /* check that it's a valid file handle */
325 lua_pushvalue(L, 1);
326 }
327 lua_setfield(L, LUA_REGISTRYINDEX, f);
328 }
329 /* return current value */
330 lua_getfield(L, LUA_REGISTRYINDEX, f);
331 return 1;
332}
333
334
335static int io_input (lua_State *L) {
336 return g_iofile(L, IO_INPUT, "r");
337}
338
339
340static int io_output (lua_State *L) {
341 return g_iofile(L, IO_OUTPUT, "w");
342}
343
344
345static int io_readline (lua_State *L);
346
347
348/*
349** maximum number of arguments to 'f:lines'/'io.lines' (it + 3 must fit
350** in the limit for upvalues of a closure)
351*/
352#define MAXARGLINE 250
353
354/*
355** Auxiliary function to create the iteration function for 'lines'.
356** The iteration function is a closure over 'io_readline', with
357** the following upvalues:
358** 1) The file being read (first value in the stack)
359** 2) the number of arguments to read
360** 3) a boolean, true iff file has to be closed when finished ('toclose')
361** *) a variable number of format arguments (rest of the stack)
362*/
363static void aux_lines (lua_State *L, int toclose) {
364 int n = lua_gettop(L) - 1; /* number of arguments to read */
365 luaL_argcheck(L, n <= MAXARGLINE, MAXARGLINE + 2, "too many arguments");
366 lua_pushvalue(L, 1); /* file */
367 lua_pushinteger(L, n); /* number of arguments to read */
368 lua_pushboolean(L, toclose); /* close/not close file when finished */
369 lua_rotate(L, 2, 3); /* move the three values to their positions */
370 lua_pushcclosure(L, io_readline, 3 + n);
371}
372
373
374static int f_lines (lua_State *L) {
375 tofile(L); /* check that it's a valid file handle */
376 aux_lines(L, 0);
377 return 1;
378}
379
380
381/*
382** Return an iteration function for 'io.lines'. If file has to be
383** closed, also returns the file itself as a second result (to be
384** closed as the state at the exit of a generic for).
385*/
386static int io_lines (lua_State *L) {
387 int toclose;
388 if (lua_isnone(L, 1)) lua_pushnil(L); /* at least one argument */
389 if (lua_isnil(L, 1)) { /* no file name? */
390 lua_getfield(L, LUA_REGISTRYINDEX, IO_INPUT); /* get default input */
391 lua_replace(L, 1); /* put it at index 1 */
392 tofile(L); /* check that it's a valid file handle */
393 toclose = 0; /* do not close it after iteration */
394 }
395 else { /* open a new file */
396 const char *filename = luaL_checkstring(L, 1);
397 opencheck(L, filename, "r");
398 lua_replace(L, 1); /* put file at index 1 */
399 toclose = 1; /* close it after iteration */
400 }
401 aux_lines(L, toclose); /* push iteration function */
402 if (toclose) {
403 lua_pushnil(L); /* state */
404 lua_pushnil(L); /* control */
405 lua_pushvalue(L, 1); /* file is the to-be-closed variable (4th result) */
406 return 4;
407 }
408 else
409 return 1;
410}
411
412
413/*
414** {======================================================
415** READ
416** =======================================================
417*/
418
419
420/* maximum length of a numeral */
421#if !defined (L_MAXLENNUM)
422#define L_MAXLENNUM 200
423#endif
424
425
426/* auxiliary structure used by 'read_number' */
427typedef struct {
428 FILE *f; /* file being read */
429 int c; /* current character (look ahead) */
430 int n; /* number of elements in buffer 'buff' */
431 char buff[L_MAXLENNUM + 1]; /* +1 for ending '\0' */
432} RN;
433
434
435/*
436** Add current char to buffer (if not out of space) and read next one
437*/
438static int nextc (RN *rn) {
439 if (l_unlikely(rn->n >= L_MAXLENNUM)) { /* buffer overflow? */
440 rn->buff[0] = '\0'; /* invalidate result */
441 return 0; /* fail */
442 }
443 else {
444 rn->buff[rn->n++] = rn->c; /* save current char */
445 rn->c = l_getc(rn->f); /* read next one */
446 return 1;
447 }
448}
449
450
451/*
452** Accept current char if it is in 'set' (of size 2)
453*/
454static int test2 (RN *rn, const char *set) {
455 if (rn->c == set[0] || rn->c == set[1])
456 return nextc(rn);
457 else return 0;
458}
459
460
461/*
462** Read a sequence of (hex)digits
463*/
464static int readdigits (RN *rn, int hex) {
465 int count = 0;
466 while ((hex ? isxdigit(rn->c) : isdigit(rn->c)) && nextc(rn))
467 count++;
468 return count;
469}
470
471
472/*
473** Read a number: first reads a valid prefix of a numeral into a buffer.
474** Then it calls 'lua_stringtonumber' to check whether the format is
475** correct and to convert it to a Lua number.
476*/
477static int read_number (lua_State *L, FILE *f) {
478 RN rn;
479 int count = 0;
480 int hex = 0;
481 char decp[2];
482 rn.f = f; rn.n = 0;
483 decp[0] = lua_getlocaledecpoint(); /* get decimal point from locale */
484 decp[1] = '.'; /* always accept a dot */
485 l_lockfile(rn.f);
486 do { rn.c = l_getc(rn.f); } while (isspace(rn.c)); /* skip spaces */
487 test2(&rn, "-+"); /* optional sign */
488 if (test2(&rn, "00")) {
489 if (test2(&rn, "xX")) hex = 1; /* numeral is hexadecimal */
490 else count = 1; /* count initial '0' as a valid digit */
491 }
492 count += readdigits(&rn, hex); /* integral part */
493 if (test2(&rn, decp)) /* decimal point? */
494 count += readdigits(&rn, hex); /* fractional part */
495 if (count > 0 && test2(&rn, (hex ? "pP" : "eE"))) { /* exponent mark? */
496 test2(&rn, "-+"); /* exponent sign */
497 readdigits(&rn, 0); /* exponent digits */
498 }
499 ungetc(rn.c, rn.f); /* unread look-ahead char */
500 l_unlockfile(rn.f);
501 rn.buff[rn.n] = '\0'; /* finish string */
502 if (l_likely(lua_stringtonumber(L, rn.buff)))
503 return 1; /* ok, it is a valid number */
504 else { /* invalid format */
505 lua_pushnil(L); /* "result" to be removed */
506 return 0; /* read fails */
507 }
508}
509
510
511static int test_eof (lua_State *L, FILE *f) {
512 int c = getc(f);
513 ungetc(c, f); /* no-op when c == EOF */
514 lua_pushliteral(L, "");
515 return (c != EOF);
516}
517
518
519static int read_line (lua_State *L, FILE *f, int chop) {
520 luaL_Buffer b;
521 int c;
522 luaL_buffinit(L, &b);
523 do { /* may need to read several chunks to get whole line */
524 char *buff = luaL_prepbuffer(&b); /* preallocate buffer space */
525 int i = 0;
526 l_lockfile(f); /* no memory errors can happen inside the lock */
527 while (i < LUAL_BUFFERSIZE && (c = l_getc(f)) != EOF && c != '\n')
528 buff[i++] = c; /* read up to end of line or buffer limit */
529 l_unlockfile(f);
530 luaL_addsize(&b, i);
531 } while (c != EOF && c != '\n'); /* repeat until end of line */
532 if (!chop && c == '\n') /* want a newline and have one? */
533 luaL_addchar(&b, c); /* add ending newline to result */
534 luaL_pushresult(&b); /* close buffer */
535 /* return ok if read something (either a newline or something else) */
536 return (c == '\n' || lua_rawlen(L, -1) > 0);
537}
538
539
540static void read_all (lua_State *L, FILE *f) {
541 size_t nr;
542 luaL_Buffer b;
543 luaL_buffinit(L, &b);
544 do { /* read file in chunks of LUAL_BUFFERSIZE bytes */
545 char *p = luaL_prepbuffer(&b);
546 nr = fread(p, sizeof(char), LUAL_BUFFERSIZE, f);
547 luaL_addsize(&b, nr);
548 } while (nr == LUAL_BUFFERSIZE);
549 luaL_pushresult(&b); /* close buffer */
550}
551
552
553static int read_chars (lua_State *L, FILE *f, size_t n) {
554 size_t nr; /* number of chars actually read */
555 char *p;
556 luaL_Buffer b;
557 luaL_buffinit(L, &b);
558 p = luaL_prepbuffsize(&b, n); /* prepare buffer to read whole block */
559 nr = fread(p, sizeof(char), n, f); /* try to read 'n' chars */
560 luaL_addsize(&b, nr);
561 luaL_pushresult(&b); /* close buffer */
562 return (nr > 0); /* true iff read something */
563}
564
565
566static int g_read (lua_State *L, FILE *f, int first) {
567 int nargs = lua_gettop(L) - 1;
568 int n, success;
569 clearerr(f);
570 if (nargs == 0) { /* no arguments? */
571 success = read_line(L, f, 1);
572 n = first + 1; /* to return 1 result */
573 }
574 else {
575 /* ensure stack space for all results and for auxlib's buffer */
576 luaL_checkstack(L, nargs+LUA_MINSTACK, "too many arguments");
577 success = 1;
578 for (n = first; nargs-- && success; n++) {
579 if (lua_type(L, n) == LUA_TNUMBER) {
580 size_t l = (size_t)luaL_checkinteger(L, n);
581 success = (l == 0) ? test_eof(L, f) : read_chars(L, f, l);
582 }
583 else {
584 const char *p = luaL_checkstring(L, n);
585 if (*p == '*') p++; /* skip optional '*' (for compatibility) */
586 switch (*p) {
587 case 'n': /* number */
588 success = read_number(L, f);
589 break;
590 case 'l': /* line */
591 success = read_line(L, f, 1);
592 break;
593 case 'L': /* line with end-of-line */
594 success = read_line(L, f, 0);
595 break;
596 case 'a': /* file */
597 read_all(L, f); /* read entire file */
598 success = 1; /* always success */
599 break;
600 default:
601 return luaL_argerror(L, n, "invalid format");
602 }
603 }
604 }
605 }
606 if (ferror(f))
607 return luaL_fileresult(L, 0, NULL);
608 if (!success) {
609 lua_pop(L, 1); /* remove last result */
610 luaL_pushfail(L); /* push nil instead */
611 }
612 return n - first;
613}
614
615
616static int io_read (lua_State *L) {
617 return g_read(L, getiofile(L, IO_INPUT), 1);
618}
619
620
621static int f_read (lua_State *L) {
622 return g_read(L, tofile(L), 2);
623}
624
625
626/*
627** Iteration function for 'lines'.
628*/
629static int io_readline (lua_State *L) {
630 LStream *p = (LStream *)lua_touserdata(L, lua_upvalueindex(1));
631 int i;
632 int n = (int)lua_tointeger(L, lua_upvalueindex(2));
633 if (isclosed(p)) /* file is already closed? */
634 return luaL_error(L, "file is already closed");
635 lua_settop(L , 1);
636 luaL_checkstack(L, n, "too many arguments");
637 for (i = 1; i <= n; i++) /* push arguments to 'g_read' */
638 lua_pushvalue(L, lua_upvalueindex(3 + i));
639 n = g_read(L, p->f, 2); /* 'n' is number of results */
640 lua_assert(n > 0); /* should return at least a nil */
641 if (lua_toboolean(L, -n)) /* read at least one value? */
642 return n; /* return them */
643 else { /* first result is false: EOF or error */
644 if (n > 1) { /* is there error information? */
645 /* 2nd result is error message */
646 return luaL_error(L, "%s", lua_tostring(L, -n + 1));
647 }
648 if (lua_toboolean(L, lua_upvalueindex(3))) { /* generator created file? */
649 lua_settop(L, 0); /* clear stack */
650 lua_pushvalue(L, lua_upvalueindex(1)); /* push file at index 1 */
651 aux_close(L); /* close it */
652 }
653 return 0;
654 }
655}
656
657/* }====================================================== */
658
659
660static int g_write (lua_State *L, FILE *f, int arg) {
661 int nargs = lua_gettop(L) - arg;
662 int status = 1;
663 for (; nargs--; arg++) {
664 if (lua_type(L, arg) == LUA_TNUMBER) {
665 /* optimization: could be done exactly as for strings */
666 int len = lua_isinteger(L, arg)
667 ? fprintf(f, LUA_INTEGER_FMT,
668 (LUAI_UACINT)lua_tointeger(L, arg))
669 : fprintf(f, LUA_NUMBER_FMT,
670 (LUAI_UACNUMBER)lua_tonumber(L, arg));
671 status = status && (len > 0);
672 }
673 else {
674 size_t l;
675 const char *s = luaL_checklstring(L, arg, &l);
676 status = status && (fwrite(s, sizeof(char), l, f) == l);
677 }
678 }
679 if (l_likely(status))
680 return 1; /* file handle already on stack top */
681 else return luaL_fileresult(L, status, NULL);
682}
683
684
685static int io_write (lua_State *L) {
686 return g_write(L, getiofile(L, IO_OUTPUT), 1);
687}
688
689
690static int f_write (lua_State *L) {
691 FILE *f = tofile(L);
692 lua_pushvalue(L, 1); /* push file at the stack top (to be returned) */
693 return g_write(L, f, 2);
694}
695
696
697static int f_seek (lua_State *L) {
698 static const int mode[] = {SEEK_SET, SEEK_CUR, SEEK_END};
699 static const char *const modenames[] = {"set", "cur", "end", NULL};
700 FILE *f = tofile(L);
701 int op = luaL_checkoption(L, 2, "cur", modenames);
702 lua_Integer p3 = luaL_optinteger(L, 3, 0);
703 l_seeknum offset = (l_seeknum)p3;
704 luaL_argcheck(L, (lua_Integer)offset == p3, 3,
705 "not an integer in proper range");
706 op = l_fseek(f, offset, mode[op]);
707 if (l_unlikely(op))
708 return luaL_fileresult(L, 0, NULL); /* error */
709 else {
710 lua_pushinteger(L, (lua_Integer)l_ftell(f));
711 return 1;
712 }
713}
714
715
716static int f_setvbuf (lua_State *L) {
717 static const int mode[] = {_IONBF, _IOFBF, _IOLBF};
718 static const char *const modenames[] = {"no", "full", "line", NULL};
719 FILE *f = tofile(L);
720 int op = luaL_checkoption(L, 2, NULL, modenames);
721 lua_Integer sz = luaL_optinteger(L, 3, LUAL_BUFFERSIZE);
722 int res = setvbuf(f, NULL, mode[op], (size_t)sz);
723 return luaL_fileresult(L, res == 0, NULL);
724}
725
726
727
728static int io_flush (lua_State *L) {
729 return luaL_fileresult(L, fflush(getiofile(L, IO_OUTPUT)) == 0, NULL);
730}
731
732
733static int f_flush (lua_State *L) {
734 return luaL_fileresult(L, fflush(tofile(L)) == 0, NULL);
735}
736
737
738/*
739** functions for 'io' library
740*/
741static const luaL_Reg iolib[] = {
742 {"close", io_close},
743 {"flush", io_flush},
744 {"input", io_input},
745 {"lines", io_lines},
746 {"open", io_open},
747 {"output", io_output},
748 {"popen", io_popen},
749 {"read", io_read},
750 {"tmpfile", io_tmpfile},
751 {"type", io_type},
752 {"write", io_write},
753 {NULL, NULL}
754};
755
756
757/*
758** methods for file handles
759*/
760static const luaL_Reg meth[] = {
761 {"read", f_read},
762 {"write", f_write},
763 {"lines", f_lines},
764 {"flush", f_flush},
765 {"seek", f_seek},
766 {"close", f_close},
767 {"setvbuf", f_setvbuf},
768 {NULL, NULL}
769};
770
771
772/*
773** metamethods for file handles
774*/
775static const luaL_Reg metameth[] = {
776 {"__index", NULL}, /* place holder */
777 {"__gc", f_gc},
778 {"__close", f_gc},
779 {"__tostring", f_tostring},
780 {NULL, NULL}
781};
782
783
784static void createmeta (lua_State *L) {
785 luaL_newmetatable(L, LUA_FILEHANDLE); /* metatable for file handles */
786 luaL_setfuncs(L, metameth, 0); /* add metamethods to new metatable */
787 luaL_newlibtable(L, meth); /* create method table */
788 luaL_setfuncs(L, meth, 0); /* add file methods to method table */
789 lua_setfield(L, -2, "__index"); /* metatable.__index = method table */
790 lua_pop(L, 1); /* pop metatable */
791}
792
793
794/*
795** function to (not) close the standard files stdin, stdout, and stderr
796*/
797static int io_noclose (lua_State *L) {
798 LStream *p = tolstream(L);
799 p->closef = &io_noclose; /* keep file opened */
800 luaL_pushfail(L);
801 lua_pushliteral(L, "cannot close standard file");
802 return 2;
803}
804
805
806static void createstdfile (lua_State *L, FILE *f, const char *k,
807 const char *fname) {
808 LStream *p = newprefile(L);
809 p->f = f;
810 p->closef = &io_noclose;
811 if (k != NULL) {
812 lua_pushvalue(L, -1);
813 lua_setfield(L, LUA_REGISTRYINDEX, k); /* add file to registry */
814 }
815 lua_setfield(L, -2, fname); /* add file to module */
816}
817
818
819LUAMOD_API int luaopen_io (lua_State *L) {
820 luaL_newlib(L, iolib); /* new module */
821 createmeta(L);
822 /* create (and set) default files */
823 createstdfile(L, stdin, IO_INPUT, "stdin");
824 createstdfile(L, stdout, IO_OUTPUT, "stdout");
825 createstdfile(L, stderr, NULL, "stderr");
826 return 1;
827}
828
diff --git a/src/lua/ljumptab.h b/src/lua/ljumptab.h
deleted file mode 100644
index 8306f25..0000000
--- a/src/lua/ljumptab.h
+++ /dev/null
@@ -1,112 +0,0 @@
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
deleted file mode 100644
index e991517..0000000
--- a/src/lua/llex.c
+++ /dev/null
@@ -1,581 +0,0 @@
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 if (lisprint(token))
85 return luaO_pushfstring(ls->L, "'%c'", token);
86 else /* control character */
87 return luaO_pushfstring(ls->L, "'<\\%d>'", token);
88 }
89 else {
90 const char *s = luaX_tokens[token - FIRST_RESERVED];
91 if (token < TK_EOS) /* fixed format (symbols and reserved words)? */
92 return luaO_pushfstring(ls->L, "'%s'", s);
93 else /* names, strings, and numerals */
94 return s;
95 }
96}
97
98
99static const char *txtToken (LexState *ls, int token) {
100 switch (token) {
101 case TK_NAME: case TK_STRING:
102 case TK_FLT: case TK_INT:
103 save(ls, '\0');
104 return luaO_pushfstring(ls->L, "'%s'", luaZ_buffer(ls->buff));
105 default:
106 return luaX_token2str(ls, token);
107 }
108}
109
110
111static l_noret lexerror (LexState *ls, const char *msg, int token) {
112 msg = luaG_addinfo(ls->L, msg, ls->source, ls->linenumber);
113 if (token)
114 luaO_pushfstring(ls->L, "%s near %s", msg, txtToken(ls, token));
115 luaD_throw(ls->L, LUA_ERRSYNTAX);
116}
117
118
119l_noret luaX_syntaxerror (LexState *ls, const char *msg) {
120 lexerror(ls, msg, ls->t.token);
121}
122
123
124/*
125** Creates a new string and anchors it in scanner's table so that it
126** will not be collected until the end of the compilation; by that time
127** it should be anchored somewhere. It also internalizes long strings,
128** ensuring there is only one copy of each unique string. The table
129** here is used as a set: the string enters as the key, while its value
130** is irrelevant. We use the string itself as the value only because it
131** is a TValue readly available. Later, the code generation can change
132** this value.
133*/
134TString *luaX_newstring (LexState *ls, const char *str, size_t l) {
135 lua_State *L = ls->L;
136 TString *ts = luaS_newlstr(L, str, l); /* create new string */
137 const TValue *o = luaH_getstr(ls->h, ts);
138 if (!ttisnil(o)) /* string already present? */
139 ts = keystrval(nodefromval(o)); /* get saved copy */
140 else { /* not in use yet */
141 TValue *stv = s2v(L->top++); /* reserve stack space for string */
142 setsvalue(L, stv, ts); /* temporarily anchor the string */
143 luaH_finishset(L, ls->h, stv, o, stv); /* t[string] = string */
144 /* table is not a metatable, so it does not need to invalidate cache */
145 luaC_checkGC(L);
146 L->top--; /* remove string from stack */
147 }
148 return ts;
149}
150
151
152/*
153** increment line number and skips newline sequence (any of
154** \n, \r, \n\r, or \r\n)
155*/
156static void inclinenumber (LexState *ls) {
157 int old = ls->current;
158 lua_assert(currIsNewline(ls));
159 next(ls); /* skip '\n' or '\r' */
160 if (currIsNewline(ls) && ls->current != old)
161 next(ls); /* skip '\n\r' or '\r\n' */
162 if (++ls->linenumber >= MAX_INT)
163 lexerror(ls, "chunk has too many lines", 0);
164}
165
166
167void luaX_setinput (lua_State *L, LexState *ls, ZIO *z, TString *source,
168 int firstchar) {
169 ls->t.token = 0;
170 ls->L = L;
171 ls->current = firstchar;
172 ls->lookahead.token = TK_EOS; /* no look-ahead token */
173 ls->z = z;
174 ls->fs = NULL;
175 ls->linenumber = 1;
176 ls->lastline = 1;
177 ls->source = source;
178 ls->envn = luaS_newliteral(L, LUA_ENV); /* get env name */
179 luaZ_resizebuffer(ls->L, ls->buff, LUA_MINBUFFER); /* initialize buffer */
180}
181
182
183
184/*
185** =======================================================
186** LEXICAL ANALYZER
187** =======================================================
188*/
189
190
191static int check_next1 (LexState *ls, int c) {
192 if (ls->current == c) {
193 next(ls);
194 return 1;
195 }
196 else return 0;
197}
198
199
200/*
201** Check whether current char is in set 'set' (with two chars) and
202** saves it
203*/
204static int check_next2 (LexState *ls, const char *set) {
205 lua_assert(set[2] == '\0');
206 if (ls->current == set[0] || ls->current == set[1]) {
207 save_and_next(ls);
208 return 1;
209 }
210 else return 0;
211}
212
213
214/* LUA_NUMBER */
215/*
216** This function is quite liberal in what it accepts, as 'luaO_str2num'
217** will reject ill-formed numerals. Roughly, it accepts the following
218** pattern:
219**
220** %d(%x|%.|([Ee][+-]?))* | 0[Xx](%x|%.|([Pp][+-]?))*
221**
222** The only tricky part is to accept [+-] only after a valid exponent
223** mark, to avoid reading '3-4' or '0xe+1' as a single number.
224**
225** The caller might have already read an initial dot.
226*/
227static int read_numeral (LexState *ls, SemInfo *seminfo) {
228 TValue obj;
229 const char *expo = "Ee";
230 int first = ls->current;
231 lua_assert(lisdigit(ls->current));
232 save_and_next(ls);
233 if (first == '0' && check_next2(ls, "xX")) /* hexadecimal? */
234 expo = "Pp";
235 for (;;) {
236 if (check_next2(ls, expo)) /* exponent mark? */
237 check_next2(ls, "-+"); /* optional exponent sign */
238 else if (lisxdigit(ls->current) || ls->current == '.') /* '%x|%.' */
239 save_and_next(ls);
240 else break;
241 }
242 if (lislalpha(ls->current)) /* is numeral touching a letter? */
243 save_and_next(ls); /* force an error */
244 save(ls, '\0');
245 if (luaO_str2num(luaZ_buffer(ls->buff), &obj) == 0) /* format error? */
246 lexerror(ls, "malformed number", TK_FLT);
247 if (ttisinteger(&obj)) {
248 seminfo->i = ivalue(&obj);
249 return TK_INT;
250 }
251 else {
252 lua_assert(ttisfloat(&obj));
253 seminfo->r = fltvalue(&obj);
254 return TK_FLT;
255 }
256}
257
258
259/*
260** read a sequence '[=*[' or ']=*]', leaving the last bracket. If
261** sequence is well formed, return its number of '='s + 2; otherwise,
262** return 1 if it is a single bracket (no '='s and no 2nd bracket);
263** otherwise (an unfinished '[==...') return 0.
264*/
265static size_t skip_sep (LexState *ls) {
266 size_t count = 0;
267 int s = ls->current;
268 lua_assert(s == '[' || s == ']');
269 save_and_next(ls);
270 while (ls->current == '=') {
271 save_and_next(ls);
272 count++;
273 }
274 return (ls->current == s) ? count + 2
275 : (count == 0) ? 1
276 : 0;
277}
278
279
280static void read_long_string (LexState *ls, SemInfo *seminfo, size_t sep) {
281 int line = ls->linenumber; /* initial line (for error message) */
282 save_and_next(ls); /* skip 2nd '[' */
283 if (currIsNewline(ls)) /* string starts with a newline? */
284 inclinenumber(ls); /* skip it */
285 for (;;) {
286 switch (ls->current) {
287 case EOZ: { /* error */
288 const char *what = (seminfo ? "string" : "comment");
289 const char *msg = luaO_pushfstring(ls->L,
290 "unfinished long %s (starting at line %d)", what, line);
291 lexerror(ls, msg, TK_EOS);
292 break; /* to avoid warnings */
293 }
294 case ']': {
295 if (skip_sep(ls) == sep) {
296 save_and_next(ls); /* skip 2nd ']' */
297 goto endloop;
298 }
299 break;
300 }
301 case '\n': case '\r': {
302 save(ls, '\n');
303 inclinenumber(ls);
304 if (!seminfo) luaZ_resetbuffer(ls->buff); /* avoid wasting space */
305 break;
306 }
307 default: {
308 if (seminfo) save_and_next(ls);
309 else next(ls);
310 }
311 }
312 } endloop:
313 if (seminfo)
314 seminfo->ts = luaX_newstring(ls, luaZ_buffer(ls->buff) + sep,
315 luaZ_bufflen(ls->buff) - 2 * sep);
316}
317
318
319static void esccheck (LexState *ls, int c, const char *msg) {
320 if (!c) {
321 if (ls->current != EOZ)
322 save_and_next(ls); /* add current to buffer for error message */
323 lexerror(ls, msg, TK_STRING);
324 }
325}
326
327
328static int gethexa (LexState *ls) {
329 save_and_next(ls);
330 esccheck (ls, lisxdigit(ls->current), "hexadecimal digit expected");
331 return luaO_hexavalue(ls->current);
332}
333
334
335static int readhexaesc (LexState *ls) {
336 int r = gethexa(ls);
337 r = (r << 4) + gethexa(ls);
338 luaZ_buffremove(ls->buff, 2); /* remove saved chars from buffer */
339 return r;
340}
341
342
343static unsigned long readutf8esc (LexState *ls) {
344 unsigned long r;
345 int i = 4; /* chars to be removed: '\', 'u', '{', and first digit */
346 save_and_next(ls); /* skip 'u' */
347 esccheck(ls, ls->current == '{', "missing '{'");
348 r = gethexa(ls); /* must have at least one digit */
349 while (cast_void(save_and_next(ls)), lisxdigit(ls->current)) {
350 i++;
351 esccheck(ls, r <= (0x7FFFFFFFu >> 4), "UTF-8 value too large");
352 r = (r << 4) + luaO_hexavalue(ls->current);
353 }
354 esccheck(ls, ls->current == '}', "missing '}'");
355 next(ls); /* skip '}' */
356 luaZ_buffremove(ls->buff, i); /* remove saved chars from buffer */
357 return r;
358}
359
360
361static void utf8esc (LexState *ls) {
362 char buff[UTF8BUFFSZ];
363 int n = luaO_utf8esc(buff, readutf8esc(ls));
364 for (; n > 0; n--) /* add 'buff' to string */
365 save(ls, buff[UTF8BUFFSZ - n]);
366}
367
368
369static int readdecesc (LexState *ls) {
370 int i;
371 int r = 0; /* result accumulator */
372 for (i = 0; i < 3 && lisdigit(ls->current); i++) { /* read up to 3 digits */
373 r = 10*r + ls->current - '0';
374 save_and_next(ls);
375 }
376 esccheck(ls, r <= UCHAR_MAX, "decimal escape too large");
377 luaZ_buffremove(ls->buff, i); /* remove read digits from buffer */
378 return r;
379}
380
381
382static void read_string (LexState *ls, int del, SemInfo *seminfo) {
383 save_and_next(ls); /* keep delimiter (for error messages) */
384 while (ls->current != del) {
385 switch (ls->current) {
386 case EOZ:
387 lexerror(ls, "unfinished string", TK_EOS);
388 break; /* to avoid warnings */
389 case '\n':
390 case '\r':
391 lexerror(ls, "unfinished string", TK_STRING);
392 break; /* to avoid warnings */
393 case '\\': { /* escape sequences */
394 int c; /* final character to be saved */
395 save_and_next(ls); /* keep '\\' for error messages */
396 switch (ls->current) {
397 case 'a': c = '\a'; goto read_save;
398 case 'b': c = '\b'; goto read_save;
399 case 'f': c = '\f'; goto read_save;
400 case 'n': c = '\n'; goto read_save;
401 case 'r': c = '\r'; goto read_save;
402 case 't': c = '\t'; goto read_save;
403 case 'v': c = '\v'; goto read_save;
404 case 'x': c = readhexaesc(ls); goto read_save;
405 case 'u': utf8esc(ls); goto no_save;
406 case '\n': case '\r':
407 inclinenumber(ls); c = '\n'; goto only_save;
408 case '\\': case '\"': case '\'':
409 c = ls->current; goto read_save;
410 case EOZ: goto no_save; /* will raise an error next loop */
411 case 'z': { /* zap following span of spaces */
412 luaZ_buffremove(ls->buff, 1); /* remove '\\' */
413 next(ls); /* skip the 'z' */
414 while (lisspace(ls->current)) {
415 if (currIsNewline(ls)) inclinenumber(ls);
416 else next(ls);
417 }
418 goto no_save;
419 }
420 default: {
421 esccheck(ls, lisdigit(ls->current), "invalid escape sequence");
422 c = readdecesc(ls); /* digital escape '\ddd' */
423 goto only_save;
424 }
425 }
426 read_save:
427 next(ls);
428 /* go through */
429 only_save:
430 luaZ_buffremove(ls->buff, 1); /* remove '\\' */
431 save(ls, c);
432 /* go through */
433 no_save: break;
434 }
435 default:
436 save_and_next(ls);
437 }
438 }
439 save_and_next(ls); /* skip delimiter */
440 seminfo->ts = luaX_newstring(ls, luaZ_buffer(ls->buff) + 1,
441 luaZ_bufflen(ls->buff) - 2);
442}
443
444
445static int llex (LexState *ls, SemInfo *seminfo) {
446 luaZ_resetbuffer(ls->buff);
447 for (;;) {
448 switch (ls->current) {
449 case '\n': case '\r': { /* line breaks */
450 inclinenumber(ls);
451 break;
452 }
453 case ' ': case '\f': case '\t': case '\v': { /* spaces */
454 next(ls);
455 break;
456 }
457 case '-': { /* '-' or '--' (comment) */
458 next(ls);
459 if (ls->current != '-') return '-';
460 /* else is a comment */
461 next(ls);
462 if (ls->current == '[') { /* long comment? */
463 size_t sep = skip_sep(ls);
464 luaZ_resetbuffer(ls->buff); /* 'skip_sep' may dirty the buffer */
465 if (sep >= 2) {
466 read_long_string(ls, NULL, sep); /* skip long comment */
467 luaZ_resetbuffer(ls->buff); /* previous call may dirty the buff. */
468 break;
469 }
470 }
471 /* else short comment */
472 while (!currIsNewline(ls) && ls->current != EOZ)
473 next(ls); /* skip until end of line (or end of file) */
474 break;
475 }
476 case '[': { /* long string or simply '[' */
477 size_t sep = skip_sep(ls);
478 if (sep >= 2) {
479 read_long_string(ls, seminfo, sep);
480 return TK_STRING;
481 }
482 else if (sep == 0) /* '[=...' missing second bracket? */
483 lexerror(ls, "invalid long string delimiter", TK_STRING);
484 return '[';
485 }
486 case '=': {
487 next(ls);
488 if (check_next1(ls, '=')) return TK_EQ; /* '==' */
489 else return '=';
490 }
491 case '<': {
492 next(ls);
493 if (check_next1(ls, '=')) return TK_LE; /* '<=' */
494 else if (check_next1(ls, '<')) return TK_SHL; /* '<<' */
495 else return '<';
496 }
497 case '>': {
498 next(ls);
499 if (check_next1(ls, '=')) return TK_GE; /* '>=' */
500 else if (check_next1(ls, '>')) return TK_SHR; /* '>>' */
501 else return '>';
502 }
503 case '/': {
504 next(ls);
505 if (check_next1(ls, '/')) return TK_IDIV; /* '//' */
506 else return '/';
507 }
508 case '~': {
509 next(ls);
510 if (check_next1(ls, '=')) return TK_NE; /* '~=' */
511 else return '~';
512 }
513 case ':': {
514 next(ls);
515 if (check_next1(ls, ':')) return TK_DBCOLON; /* '::' */
516 else return ':';
517 }
518 case '"': case '\'': { /* short literal strings */
519 read_string(ls, ls->current, seminfo);
520 return TK_STRING;
521 }
522 case '.': { /* '.', '..', '...', or number */
523 save_and_next(ls);
524 if (check_next1(ls, '.')) {
525 if (check_next1(ls, '.'))
526 return TK_DOTS; /* '...' */
527 else return TK_CONCAT; /* '..' */
528 }
529 else if (!lisdigit(ls->current)) return '.';
530 else return read_numeral(ls, seminfo);
531 }
532 case '0': case '1': case '2': case '3': case '4':
533 case '5': case '6': case '7': case '8': case '9': {
534 return read_numeral(ls, seminfo);
535 }
536 case EOZ: {
537 return TK_EOS;
538 }
539 default: {
540 if (lislalpha(ls->current)) { /* identifier or reserved word? */
541 TString *ts;
542 do {
543 save_and_next(ls);
544 } while (lislalnum(ls->current));
545 ts = luaX_newstring(ls, luaZ_buffer(ls->buff),
546 luaZ_bufflen(ls->buff));
547 seminfo->ts = ts;
548 if (isreserved(ts)) /* reserved word? */
549 return ts->extra - 1 + FIRST_RESERVED;
550 else {
551 return TK_NAME;
552 }
553 }
554 else { /* single-char tokens ('+', '*', '%', '{', '}', ...) */
555 int c = ls->current;
556 next(ls);
557 return c;
558 }
559 }
560 }
561 }
562}
563
564
565void luaX_next (LexState *ls) {
566 ls->lastline = ls->linenumber;
567 if (ls->lookahead.token != TK_EOS) { /* is there a look-ahead token? */
568 ls->t = ls->lookahead; /* use this one */
569 ls->lookahead.token = TK_EOS; /* and discharge it */
570 }
571 else
572 ls->t.token = llex(ls, &ls->t.seminfo); /* read next token */
573}
574
575
576int luaX_lookahead (LexState *ls) {
577 lua_assert(ls->lookahead.token == TK_EOS);
578 ls->lookahead.token = llex(ls, &ls->lookahead.seminfo);
579 return ls->lookahead.token;
580}
581
diff --git a/src/lua/llex.h b/src/lua/llex.h
deleted file mode 100644
index 389d2f8..0000000
--- a/src/lua/llex.h
+++ /dev/null
@@ -1,91 +0,0 @@
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 <limits.h>
11
12#include "lobject.h"
13#include "lzio.h"
14
15
16/*
17** Single-char tokens (terminal symbols) are represented by their own
18** numeric code. Other tokens start at the following value.
19*/
20#define FIRST_RESERVED (UCHAR_MAX + 1)
21
22
23#if !defined(LUA_ENV)
24#define LUA_ENV "_ENV"
25#endif
26
27
28/*
29* WARNING: if you change the order of this enumeration,
30* grep "ORDER RESERVED"
31*/
32enum RESERVED {
33 /* terminal symbols denoted by reserved words */
34 TK_AND = FIRST_RESERVED, TK_BREAK,
35 TK_DO, TK_ELSE, TK_ELSEIF, TK_END, TK_FALSE, TK_FOR, TK_FUNCTION,
36 TK_GOTO, TK_IF, TK_IN, TK_LOCAL, TK_NIL, TK_NOT, TK_OR, TK_REPEAT,
37 TK_RETURN, TK_THEN, TK_TRUE, TK_UNTIL, TK_WHILE,
38 /* other terminal symbols */
39 TK_IDIV, TK_CONCAT, TK_DOTS, TK_EQ, TK_GE, TK_LE, TK_NE,
40 TK_SHL, TK_SHR,
41 TK_DBCOLON, TK_EOS,
42 TK_FLT, TK_INT, TK_NAME, TK_STRING
43};
44
45/* number of reserved words */
46#define NUM_RESERVED (cast_int(TK_WHILE-FIRST_RESERVED + 1))
47
48
49typedef union {
50 lua_Number r;
51 lua_Integer i;
52 TString *ts;
53} SemInfo; /* semantics information */
54
55
56typedef struct Token {
57 int token;
58 SemInfo seminfo;
59} Token;
60
61
62/* state of the lexer plus state of the parser when shared by all
63 functions */
64typedef struct LexState {
65 int current; /* current character (charint) */
66 int linenumber; /* input line counter */
67 int lastline; /* line of last token 'consumed' */
68 Token t; /* current token */
69 Token lookahead; /* look ahead token */
70 struct FuncState *fs; /* current function (parser) */
71 struct lua_State *L;
72 ZIO *z; /* input stream */
73 Mbuffer *buff; /* buffer for tokens */
74 Table *h; /* to avoid collection/reuse strings */
75 struct Dyndata *dyd; /* dynamic structures used by the parser */
76 TString *source; /* current source name */
77 TString *envn; /* environment variable name */
78} LexState;
79
80
81LUAI_FUNC void luaX_init (lua_State *L);
82LUAI_FUNC void luaX_setinput (lua_State *L, LexState *ls, ZIO *z,
83 TString *source, int firstchar);
84LUAI_FUNC TString *luaX_newstring (LexState *ls, const char *str, size_t l);
85LUAI_FUNC void luaX_next (LexState *ls);
86LUAI_FUNC int luaX_lookahead (LexState *ls);
87LUAI_FUNC l_noret luaX_syntaxerror (LexState *ls, const char *s);
88LUAI_FUNC const char *luaX_token2str (LexState *ls, int token);
89
90
91#endif
diff --git a/src/lua/llimits.h b/src/lua/llimits.h
deleted file mode 100644
index 025f1c8..0000000
--- a/src/lua/llimits.h
+++ /dev/null
@@ -1,353 +0,0 @@
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/*
88** Internal assertions for in-house debugging
89*/
90#if defined LUAI_ASSERT
91#undef NDEBUG
92#include <assert.h>
93#define lua_assert(c) assert(c)
94#endif
95
96#if defined(lua_assert)
97#define check_exp(c,e) (lua_assert(c), (e))
98/* to avoid problems with conditions too long */
99#define lua_longassert(c) ((c) ? (void)0 : lua_assert(0))
100#else
101#define lua_assert(c) ((void)0)
102#define check_exp(c,e) (e)
103#define lua_longassert(c) ((void)0)
104#endif
105
106/*
107** assertion for checking API calls
108*/
109#if !defined(luai_apicheck)
110#define luai_apicheck(l,e) ((void)l, lua_assert(e))
111#endif
112
113#define api_check(l,e,msg) luai_apicheck(l,(e) && msg)
114
115
116/* macro to avoid warnings about unused variables */
117#if !defined(UNUSED)
118#define UNUSED(x) ((void)(x))
119#endif
120
121
122/* type casts (a macro highlights casts in the code) */
123#define cast(t, exp) ((t)(exp))
124
125#define cast_void(i) cast(void, (i))
126#define cast_voidp(i) cast(void *, (i))
127#define cast_num(i) cast(lua_Number, (i))
128#define cast_int(i) cast(int, (i))
129#define cast_uint(i) cast(unsigned int, (i))
130#define cast_byte(i) cast(lu_byte, (i))
131#define cast_uchar(i) cast(unsigned char, (i))
132#define cast_char(i) cast(char, (i))
133#define cast_charp(i) cast(char *, (i))
134#define cast_sizet(i) cast(size_t, (i))
135
136
137/* cast a signed lua_Integer to lua_Unsigned */
138#if !defined(l_castS2U)
139#define l_castS2U(i) ((lua_Unsigned)(i))
140#endif
141
142/*
143** cast a lua_Unsigned to a signed lua_Integer; this cast is
144** not strict ISO C, but two-complement architectures should
145** work fine.
146*/
147#if !defined(l_castU2S)
148#define l_castU2S(i) ((lua_Integer)(i))
149#endif
150
151
152/*
153** non-return type
154*/
155#if !defined(l_noret)
156
157#if defined(__GNUC__)
158#define l_noret void __attribute__((noreturn))
159#elif defined(_MSC_VER) && _MSC_VER >= 1200
160#define l_noret void __declspec(noreturn)
161#else
162#define l_noret void
163#endif
164
165#endif
166
167
168/*
169** type for virtual-machine instructions;
170** must be an unsigned with (at least) 4 bytes (see details in lopcodes.h)
171*/
172#if LUAI_IS32INT
173typedef unsigned int l_uint32;
174#else
175typedef unsigned long l_uint32;
176#endif
177
178typedef l_uint32 Instruction;
179
180
181
182/*
183** Maximum length for short strings, that is, strings that are
184** internalized. (Cannot be smaller than reserved words or tags for
185** metamethods, as these strings must be internalized;
186** #("function") = 8, #("__newindex") = 10.)
187*/
188#if !defined(LUAI_MAXSHORTLEN)
189#define LUAI_MAXSHORTLEN 40
190#endif
191
192
193/*
194** Initial size for the string table (must be power of 2).
195** The Lua core alone registers ~50 strings (reserved words +
196** metaevent keys + a few others). Libraries would typically add
197** a few dozens more.
198*/
199#if !defined(MINSTRTABSIZE)
200#define MINSTRTABSIZE 128
201#endif
202
203
204/*
205** Size of cache for strings in the API. 'N' is the number of
206** sets (better be a prime) and "M" is the size of each set (M == 1
207** makes a direct cache.)
208*/
209#if !defined(STRCACHE_N)
210#define STRCACHE_N 53
211#define STRCACHE_M 2
212#endif
213
214
215/* minimum size for string buffer */
216#if !defined(LUA_MINBUFFER)
217#define LUA_MINBUFFER 32
218#endif
219
220
221/*
222** Maximum depth for nested C calls, syntactical nested non-terminals,
223** and other features implemented through recursion in C. (Value must
224** fit in a 16-bit unsigned integer. It must also be compatible with
225** the size of the C stack.)
226*/
227#if !defined(LUAI_MAXCCALLS)
228#define LUAI_MAXCCALLS 200
229#endif
230
231
232/*
233** macros that are executed whenever program enters the Lua core
234** ('lua_lock') and leaves the core ('lua_unlock')
235*/
236#if !defined(lua_lock)
237#define lua_lock(L) ((void) 0)
238#define lua_unlock(L) ((void) 0)
239#endif
240
241/*
242** macro executed during Lua functions at points where the
243** function can yield.
244*/
245#if !defined(luai_threadyield)
246#define luai_threadyield(L) {lua_unlock(L); lua_lock(L);}
247#endif
248
249
250/*
251** these macros allow user-specific actions when a thread is
252** created/deleted/resumed/yielded.
253*/
254#if !defined(luai_userstateopen)
255#define luai_userstateopen(L) ((void)L)
256#endif
257
258#if !defined(luai_userstateclose)
259#define luai_userstateclose(L) ((void)L)
260#endif
261
262#if !defined(luai_userstatethread)
263#define luai_userstatethread(L,L1) ((void)L)
264#endif
265
266#if !defined(luai_userstatefree)
267#define luai_userstatefree(L,L1) ((void)L)
268#endif
269
270#if !defined(luai_userstateresume)
271#define luai_userstateresume(L,n) ((void)L)
272#endif
273
274#if !defined(luai_userstateyield)
275#define luai_userstateyield(L,n) ((void)L)
276#endif
277
278
279
280/*
281** The luai_num* macros define the primitive operations over numbers.
282*/
283
284/* floor division (defined as 'floor(a/b)') */
285#if !defined(luai_numidiv)
286#define luai_numidiv(L,a,b) ((void)L, l_floor(luai_numdiv(L,a,b)))
287#endif
288
289/* float division */
290#if !defined(luai_numdiv)
291#define luai_numdiv(L,a,b) ((a)/(b))
292#endif
293
294/*
295** modulo: defined as 'a - floor(a/b)*b'; the direct computation
296** using this definition has several problems with rounding errors,
297** so it is better to use 'fmod'. 'fmod' gives the result of
298** 'a - trunc(a/b)*b', and therefore must be corrected when
299** 'trunc(a/b) ~= floor(a/b)'. That happens when the division has a
300** non-integer negative result: non-integer result is equivalent to
301** a non-zero remainder 'm'; negative result is equivalent to 'a' and
302** 'b' with different signs, or 'm' and 'b' with different signs
303** (as the result 'm' of 'fmod' has the same sign of 'a').
304*/
305#if !defined(luai_nummod)
306#define luai_nummod(L,a,b,m) \
307 { (void)L; (m) = l_mathop(fmod)(a,b); \
308 if (((m) > 0) ? (b) < 0 : ((m) < 0 && (b) > 0)) (m) += (b); }
309#endif
310
311/* exponentiation */
312#if !defined(luai_numpow)
313#define luai_numpow(L,a,b) \
314 ((void)L, (b == 2) ? (a)*(a) : l_mathop(pow)(a,b))
315#endif
316
317/* the others are quite standard operations */
318#if !defined(luai_numadd)
319#define luai_numadd(L,a,b) ((a)+(b))
320#define luai_numsub(L,a,b) ((a)-(b))
321#define luai_nummul(L,a,b) ((a)*(b))
322#define luai_numunm(L,a) (-(a))
323#define luai_numeq(a,b) ((a)==(b))
324#define luai_numlt(a,b) ((a)<(b))
325#define luai_numle(a,b) ((a)<=(b))
326#define luai_numgt(a,b) ((a)>(b))
327#define luai_numge(a,b) ((a)>=(b))
328#define luai_numisnan(a) (!luai_numeq((a), (a)))
329#endif
330
331
332
333
334
335/*
336** macro to control inclusion of some hard tests on stack reallocation
337*/
338#if !defined(HARDSTACKTESTS)
339#define condmovestack(L,pre,pos) ((void)0)
340#else
341/* realloc stack keeping its size */
342#define condmovestack(L,pre,pos) \
343 { int sz_ = stacksize(L); pre; luaD_reallocstack((L), sz_, 0); pos; }
344#endif
345
346#if !defined(HARDMEMTESTS)
347#define condchangemem(L,pre,pos) ((void)0)
348#else
349#define condchangemem(L,pre,pos) \
350 { if (G(L)->gcrunning) { pre; luaC_fullgc(L, 0); pos; } }
351#endif
352
353#endif
diff --git a/src/lua/lmathlib.c b/src/lua/lmathlib.c
deleted file mode 100644
index 5f5983a..0000000
--- a/src/lua/lmathlib.c
+++ /dev/null
@@ -1,764 +0,0 @@
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 (l_likely(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);
179 else
180#endif
181 if (base == l_mathop(10.0))
182 res = l_mathop(log10)(x);
183 else
184 res = l_mathop(log)(x)/l_mathop(log)(base);
185 }
186 lua_pushnumber(L, res);
187 return 1;
188}
189
190static int math_exp (lua_State *L) {
191 lua_pushnumber(L, l_mathop(exp)(luaL_checknumber(L, 1)));
192 return 1;
193}
194
195static int math_deg (lua_State *L) {
196 lua_pushnumber(L, luaL_checknumber(L, 1) * (l_mathop(180.0) / PI));
197 return 1;
198}
199
200static int math_rad (lua_State *L) {
201 lua_pushnumber(L, luaL_checknumber(L, 1) * (PI / l_mathop(180.0)));
202 return 1;
203}
204
205
206static int math_min (lua_State *L) {
207 int n = lua_gettop(L); /* number of arguments */
208 int imin = 1; /* index of current minimum value */
209 int i;
210 luaL_argcheck(L, n >= 1, 1, "value expected");
211 for (i = 2; i <= n; i++) {
212 if (lua_compare(L, i, imin, LUA_OPLT))
213 imin = i;
214 }
215 lua_pushvalue(L, imin);
216 return 1;
217}
218
219
220static int math_max (lua_State *L) {
221 int n = lua_gettop(L); /* number of arguments */
222 int imax = 1; /* index of current maximum value */
223 int i;
224 luaL_argcheck(L, n >= 1, 1, "value expected");
225 for (i = 2; i <= n; i++) {
226 if (lua_compare(L, imax, i, LUA_OPLT))
227 imax = i;
228 }
229 lua_pushvalue(L, imax);
230 return 1;
231}
232
233
234static int math_type (lua_State *L) {
235 if (lua_type(L, 1) == LUA_TNUMBER)
236 lua_pushstring(L, (lua_isinteger(L, 1)) ? "integer" : "float");
237 else {
238 luaL_checkany(L, 1);
239 luaL_pushfail(L);
240 }
241 return 1;
242}
243
244
245
246/*
247** {==================================================================
248** Pseudo-Random Number Generator based on 'xoshiro256**'.
249** ===================================================================
250*/
251
252/* number of binary digits in the mantissa of a float */
253#define FIGS l_floatatt(MANT_DIG)
254
255#if FIGS > 64
256/* there are only 64 random bits; use them all */
257#undef FIGS
258#define FIGS 64
259#endif
260
261
262/*
263** LUA_RAND32 forces the use of 32-bit integers in the implementation
264** of the PRN generator (mainly for testing).
265*/
266#if !defined(LUA_RAND32) && !defined(Rand64)
267
268/* try to find an integer type with at least 64 bits */
269
270#if (ULONG_MAX >> 31 >> 31) >= 3
271
272/* 'long' has at least 64 bits */
273#define Rand64 unsigned long
274
275#elif !defined(LUA_USE_C89) && defined(LLONG_MAX)
276
277/* there is a 'long long' type (which must have at least 64 bits) */
278#define Rand64 unsigned long long
279
280#elif (LUA_MAXUNSIGNED >> 31 >> 31) >= 3
281
282/* 'lua_Integer' has at least 64 bits */
283#define Rand64 lua_Unsigned
284
285#endif
286
287#endif
288
289
290#if defined(Rand64) /* { */
291
292/*
293** Standard implementation, using 64-bit integers.
294** If 'Rand64' has more than 64 bits, the extra bits do not interfere
295** with the 64 initial bits, except in a right shift. Moreover, the
296** final result has to discard the extra bits.
297*/
298
299/* avoid using extra bits when needed */
300#define trim64(x) ((x) & 0xffffffffffffffffu)
301
302
303/* rotate left 'x' by 'n' bits */
304static Rand64 rotl (Rand64 x, int n) {
305 return (x << n) | (trim64(x) >> (64 - n));
306}
307
308static Rand64 nextrand (Rand64 *state) {
309 Rand64 state0 = state[0];
310 Rand64 state1 = state[1];
311 Rand64 state2 = state[2] ^ state0;
312 Rand64 state3 = state[3] ^ state1;
313 Rand64 res = rotl(state1 * 5, 7) * 9;
314 state[0] = state0 ^ state3;
315 state[1] = state1 ^ state2;
316 state[2] = state2 ^ (state1 << 17);
317 state[3] = rotl(state3, 45);
318 return res;
319}
320
321
322/* must take care to not shift stuff by more than 63 slots */
323
324
325/*
326** Convert bits from a random integer into a float in the
327** interval [0,1), getting the higher FIG bits from the
328** random unsigned integer and converting that to a float.
329*/
330
331/* must throw out the extra (64 - FIGS) bits */
332#define shift64_FIG (64 - FIGS)
333
334/* to scale to [0, 1), multiply by scaleFIG = 2^(-FIGS) */
335#define scaleFIG (l_mathop(0.5) / ((Rand64)1 << (FIGS - 1)))
336
337static lua_Number I2d (Rand64 x) {
338 return (lua_Number)(trim64(x) >> shift64_FIG) * scaleFIG;
339}
340
341/* convert a 'Rand64' to a 'lua_Unsigned' */
342#define I2UInt(x) ((lua_Unsigned)trim64(x))
343
344/* convert a 'lua_Unsigned' to a 'Rand64' */
345#define Int2I(x) ((Rand64)(x))
346
347
348#else /* no 'Rand64' }{ */
349
350/* get an integer with at least 32 bits */
351#if LUAI_IS32INT
352typedef unsigned int lu_int32;
353#else
354typedef unsigned long lu_int32;
355#endif
356
357
358/*
359** Use two 32-bit integers to represent a 64-bit quantity.
360*/
361typedef struct Rand64 {
362 lu_int32 h; /* higher half */
363 lu_int32 l; /* lower half */
364} Rand64;
365
366
367/*
368** If 'lu_int32' has more than 32 bits, the extra bits do not interfere
369** with the 32 initial bits, except in a right shift and comparisons.
370** Moreover, the final result has to discard the extra bits.
371*/
372
373/* avoid using extra bits when needed */
374#define trim32(x) ((x) & 0xffffffffu)
375
376
377/*
378** basic operations on 'Rand64' values
379*/
380
381/* build a new Rand64 value */
382static Rand64 packI (lu_int32 h, lu_int32 l) {
383 Rand64 result;
384 result.h = h;
385 result.l = l;
386 return result;
387}
388
389/* return i << n */
390static Rand64 Ishl (Rand64 i, int n) {
391 lua_assert(n > 0 && n < 32);
392 return packI((i.h << n) | (trim32(i.l) >> (32 - n)), i.l << n);
393}
394
395/* i1 ^= i2 */
396static void Ixor (Rand64 *i1, Rand64 i2) {
397 i1->h ^= i2.h;
398 i1->l ^= i2.l;
399}
400
401/* return i1 + i2 */
402static Rand64 Iadd (Rand64 i1, Rand64 i2) {
403 Rand64 result = packI(i1.h + i2.h, i1.l + i2.l);
404 if (trim32(result.l) < trim32(i1.l)) /* carry? */
405 result.h++;
406 return result;
407}
408
409/* return i * 5 */
410static Rand64 times5 (Rand64 i) {
411 return Iadd(Ishl(i, 2), i); /* i * 5 == (i << 2) + i */
412}
413
414/* return i * 9 */
415static Rand64 times9 (Rand64 i) {
416 return Iadd(Ishl(i, 3), i); /* i * 9 == (i << 3) + i */
417}
418
419/* return 'i' rotated left 'n' bits */
420static Rand64 rotl (Rand64 i, int n) {
421 lua_assert(n > 0 && n < 32);
422 return packI((i.h << n) | (trim32(i.l) >> (32 - n)),
423 (trim32(i.h) >> (32 - n)) | (i.l << n));
424}
425
426/* for offsets larger than 32, rotate right by 64 - offset */
427static Rand64 rotl1 (Rand64 i, int n) {
428 lua_assert(n > 32 && n < 64);
429 n = 64 - n;
430 return packI((trim32(i.h) >> n) | (i.l << (32 - n)),
431 (i.h << (32 - n)) | (trim32(i.l) >> n));
432}
433
434/*
435** implementation of 'xoshiro256**' algorithm on 'Rand64' values
436*/
437static Rand64 nextrand (Rand64 *state) {
438 Rand64 res = times9(rotl(times5(state[1]), 7));
439 Rand64 t = Ishl(state[1], 17);
440 Ixor(&state[2], state[0]);
441 Ixor(&state[3], state[1]);
442 Ixor(&state[1], state[2]);
443 Ixor(&state[0], state[3]);
444 Ixor(&state[2], t);
445 state[3] = rotl1(state[3], 45);
446 return res;
447}
448
449
450/*
451** Converts a 'Rand64' into a float.
452*/
453
454/* an unsigned 1 with proper type */
455#define UONE ((lu_int32)1)
456
457
458#if FIGS <= 32
459
460/* 2^(-FIGS) */
461#define scaleFIG (l_mathop(0.5) / (UONE << (FIGS - 1)))
462
463/*
464** get up to 32 bits from higher half, shifting right to
465** throw out the extra bits.
466*/
467static lua_Number I2d (Rand64 x) {
468 lua_Number h = (lua_Number)(trim32(x.h) >> (32 - FIGS));
469 return h * scaleFIG;
470}
471
472#else /* 32 < FIGS <= 64 */
473
474/* must take care to not shift stuff by more than 31 slots */
475
476/* 2^(-FIGS) = 1.0 / 2^30 / 2^3 / 2^(FIGS-33) */
477#define scaleFIG \
478 ((lua_Number)1.0 / (UONE << 30) / 8.0 / (UONE << (FIGS - 33)))
479
480/*
481** use FIGS - 32 bits from lower half, throwing out the other
482** (32 - (FIGS - 32)) = (64 - FIGS) bits
483*/
484#define shiftLOW (64 - FIGS)
485
486/*
487** higher 32 bits go after those (FIGS - 32) bits: shiftHI = 2^(FIGS - 32)
488*/
489#define shiftHI ((lua_Number)(UONE << (FIGS - 33)) * 2.0)
490
491
492static lua_Number I2d (Rand64 x) {
493 lua_Number h = (lua_Number)trim32(x.h) * shiftHI;
494 lua_Number l = (lua_Number)(trim32(x.l) >> shiftLOW);
495 return (h + l) * scaleFIG;
496}
497
498#endif
499
500
501/* convert a 'Rand64' to a 'lua_Unsigned' */
502static lua_Unsigned I2UInt (Rand64 x) {
503 return ((lua_Unsigned)trim32(x.h) << 31 << 1) | (lua_Unsigned)trim32(x.l);
504}
505
506/* convert a 'lua_Unsigned' to a 'Rand64' */
507static Rand64 Int2I (lua_Unsigned n) {
508 return packI((lu_int32)(n >> 31 >> 1), (lu_int32)n);
509}
510
511#endif /* } */
512
513
514/*
515** A state uses four 'Rand64' values.
516*/
517typedef struct {
518 Rand64 s[4];
519} RanState;
520
521
522/*
523** Project the random integer 'ran' into the interval [0, n].
524** Because 'ran' has 2^B possible values, the projection can only be
525** uniform when the size of the interval is a power of 2 (exact
526** division). Otherwise, to get a uniform projection into [0, n], we
527** first compute 'lim', the smallest Mersenne number not smaller than
528** 'n'. We then project 'ran' into the interval [0, lim]. If the result
529** is inside [0, n], we are done. Otherwise, we try with another 'ran',
530** until we have a result inside the interval.
531*/
532static lua_Unsigned project (lua_Unsigned ran, lua_Unsigned n,
533 RanState *state) {
534 if ((n & (n + 1)) == 0) /* is 'n + 1' a power of 2? */
535 return ran & n; /* no bias */
536 else {
537 lua_Unsigned lim = n;
538 /* compute the smallest (2^b - 1) not smaller than 'n' */
539 lim |= (lim >> 1);
540 lim |= (lim >> 2);
541 lim |= (lim >> 4);
542 lim |= (lim >> 8);
543 lim |= (lim >> 16);
544#if (LUA_MAXUNSIGNED >> 31) >= 3
545 lim |= (lim >> 32); /* integer type has more than 32 bits */
546#endif
547 lua_assert((lim & (lim + 1)) == 0 /* 'lim + 1' is a power of 2, */
548 && lim >= n /* not smaller than 'n', */
549 && (lim >> 1) < n); /* and it is the smallest one */
550 while ((ran &= lim) > n) /* project 'ran' into [0..lim] */
551 ran = I2UInt(nextrand(state->s)); /* not inside [0..n]? try again */
552 return ran;
553 }
554}
555
556
557static int math_random (lua_State *L) {
558 lua_Integer low, up;
559 lua_Unsigned p;
560 RanState *state = (RanState *)lua_touserdata(L, lua_upvalueindex(1));
561 Rand64 rv = nextrand(state->s); /* next pseudo-random value */
562 switch (lua_gettop(L)) { /* check number of arguments */
563 case 0: { /* no arguments */
564 lua_pushnumber(L, I2d(rv)); /* float between 0 and 1 */
565 return 1;
566 }
567 case 1: { /* only upper limit */
568 low = 1;
569 up = luaL_checkinteger(L, 1);
570 if (up == 0) { /* single 0 as argument? */
571 lua_pushinteger(L, I2UInt(rv)); /* full random integer */
572 return 1;
573 }
574 break;
575 }
576 case 2: { /* lower and upper limits */
577 low = luaL_checkinteger(L, 1);
578 up = luaL_checkinteger(L, 2);
579 break;
580 }
581 default: return luaL_error(L, "wrong number of arguments");
582 }
583 /* random integer in the interval [low, up] */
584 luaL_argcheck(L, low <= up, 1, "interval is empty");
585 /* project random integer into the interval [0, up - low] */
586 p = project(I2UInt(rv), (lua_Unsigned)up - (lua_Unsigned)low, state);
587 lua_pushinteger(L, p + (lua_Unsigned)low);
588 return 1;
589}
590
591
592static void setseed (lua_State *L, Rand64 *state,
593 lua_Unsigned n1, lua_Unsigned n2) {
594 int i;
595 state[0] = Int2I(n1);
596 state[1] = Int2I(0xff); /* avoid a zero state */
597 state[2] = Int2I(n2);
598 state[3] = Int2I(0);
599 for (i = 0; i < 16; i++)
600 nextrand(state); /* discard initial values to "spread" seed */
601 lua_pushinteger(L, n1);
602 lua_pushinteger(L, n2);
603}
604
605
606/*
607** Set a "random" seed. To get some randomness, use the current time
608** and the address of 'L' (in case the machine does address space layout
609** randomization).
610*/
611static void randseed (lua_State *L, RanState *state) {
612 lua_Unsigned seed1 = (lua_Unsigned)time(NULL);
613 lua_Unsigned seed2 = (lua_Unsigned)(size_t)L;
614 setseed(L, state->s, seed1, seed2);
615}
616
617
618static int math_randomseed (lua_State *L) {
619 RanState *state = (RanState *)lua_touserdata(L, lua_upvalueindex(1));
620 if (lua_isnone(L, 1)) {
621 randseed(L, state);
622 }
623 else {
624 lua_Integer n1 = luaL_checkinteger(L, 1);
625 lua_Integer n2 = luaL_optinteger(L, 2, 0);
626 setseed(L, state->s, n1, n2);
627 }
628 return 2; /* return seeds */
629}
630
631
632static const luaL_Reg randfuncs[] = {
633 {"random", math_random},
634 {"randomseed", math_randomseed},
635 {NULL, NULL}
636};
637
638
639/*
640** Register the random functions and initialize their state.
641*/
642static void setrandfunc (lua_State *L) {
643 RanState *state = (RanState *)lua_newuserdatauv(L, sizeof(RanState), 0);
644 randseed(L, state); /* initialize with a "random" seed */
645 lua_pop(L, 2); /* remove pushed seeds */
646 luaL_setfuncs(L, randfuncs, 1);
647}
648
649/* }================================================================== */
650
651
652/*
653** {==================================================================
654** Deprecated functions (for compatibility only)
655** ===================================================================
656*/
657#if defined(LUA_COMPAT_MATHLIB)
658
659static int math_cosh (lua_State *L) {
660 lua_pushnumber(L, l_mathop(cosh)(luaL_checknumber(L, 1)));
661 return 1;
662}
663
664static int math_sinh (lua_State *L) {
665 lua_pushnumber(L, l_mathop(sinh)(luaL_checknumber(L, 1)));
666 return 1;
667}
668
669static int math_tanh (lua_State *L) {
670 lua_pushnumber(L, l_mathop(tanh)(luaL_checknumber(L, 1)));
671 return 1;
672}
673
674static int math_pow (lua_State *L) {
675 lua_Number x = luaL_checknumber(L, 1);
676 lua_Number y = luaL_checknumber(L, 2);
677 lua_pushnumber(L, l_mathop(pow)(x, y));
678 return 1;
679}
680
681static int math_frexp (lua_State *L) {
682 int e;
683 lua_pushnumber(L, l_mathop(frexp)(luaL_checknumber(L, 1), &e));
684 lua_pushinteger(L, e);
685 return 2;
686}
687
688static int math_ldexp (lua_State *L) {
689 lua_Number x = luaL_checknumber(L, 1);
690 int ep = (int)luaL_checkinteger(L, 2);
691 lua_pushnumber(L, l_mathop(ldexp)(x, ep));
692 return 1;
693}
694
695static int math_log10 (lua_State *L) {
696 lua_pushnumber(L, l_mathop(log10)(luaL_checknumber(L, 1)));
697 return 1;
698}
699
700#endif
701/* }================================================================== */
702
703
704
705static const luaL_Reg mathlib[] = {
706 {"abs", math_abs},
707 {"acos", math_acos},
708 {"asin", math_asin},
709 {"atan", math_atan},
710 {"ceil", math_ceil},
711 {"cos", math_cos},
712 {"deg", math_deg},
713 {"exp", math_exp},
714 {"tointeger", math_toint},
715 {"floor", math_floor},
716 {"fmod", math_fmod},
717 {"ult", math_ult},
718 {"log", math_log},
719 {"max", math_max},
720 {"min", math_min},
721 {"modf", math_modf},
722 {"rad", math_rad},
723 {"sin", math_sin},
724 {"sqrt", math_sqrt},
725 {"tan", math_tan},
726 {"type", math_type},
727#if defined(LUA_COMPAT_MATHLIB)
728 {"atan2", math_atan},
729 {"cosh", math_cosh},
730 {"sinh", math_sinh},
731 {"tanh", math_tanh},
732 {"pow", math_pow},
733 {"frexp", math_frexp},
734 {"ldexp", math_ldexp},
735 {"log10", math_log10},
736#endif
737 /* placeholders */
738 {"random", NULL},
739 {"randomseed", NULL},
740 {"pi", NULL},
741 {"huge", NULL},
742 {"maxinteger", NULL},
743 {"mininteger", NULL},
744 {NULL, NULL}
745};
746
747
748/*
749** Open math library
750*/
751LUAMOD_API int luaopen_math (lua_State *L) {
752 luaL_newlib(L, mathlib);
753 lua_pushnumber(L, PI);
754 lua_setfield(L, -2, "pi");
755 lua_pushnumber(L, (lua_Number)HUGE_VAL);
756 lua_setfield(L, -2, "huge");
757 lua_pushinteger(L, LUA_MAXINTEGER);
758 lua_setfield(L, -2, "maxinteger");
759 lua_pushinteger(L, LUA_MININTEGER);
760 lua_setfield(L, -2, "mininteger");
761 setrandfunc(L);
762 return 1;
763}
764
diff --git a/src/lua/lmem.c b/src/lua/lmem.c
deleted file mode 100644
index 9029d58..0000000
--- a/src/lua/lmem.c
+++ /dev/null
@@ -1,201 +0,0 @@
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(EMERGENCYGCTESTS)
26/*
27** First allocation will fail whenever not building initial state.
28** (This fail will trigger 'tryagain' and a full GC cycle at every
29** allocation.)
30*/
31static void *firsttry (global_State *g, void *block, size_t os, size_t ns) {
32 if (completestate(g) && ns > 0) /* frees never fail */
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 (l_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 do an emergency
142** collection to free some memory and then try the allocation again.
143** The GC should not be called while state is not fully built, as the
144** collector is not yet fully initialized. Also, it should not be called
145** when 'gcstopem' is true, because then the interpreter is in the
146** middle of a collection step.
147*/
148static void *tryagain (lua_State *L, void *block,
149 size_t osize, size_t nsize) {
150 global_State *g = G(L);
151 if (completestate(g) && !g->gcstopem) {
152 luaC_fullgc(L, 1); /* try to free some memory... */
153 return (*g->frealloc)(g->ud, block, osize, nsize); /* try again */
154 }
155 else return NULL; /* cannot free any memory without a full state */
156}
157
158
159/*
160** Generic allocation routine.
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 (l_unlikely(newblock == NULL && nsize > 0)) {
168 newblock = tryagain(L, block, osize, nsize);
169 if (newblock == NULL) /* still no memory? */
170 return NULL; /* do not update 'GCdebt' */
171 }
172 lua_assert((nsize == 0) == (newblock == NULL));
173 g->GCdebt = (g->GCdebt + nsize) - osize;
174 return newblock;
175}
176
177
178void *luaM_saferealloc_ (lua_State *L, void *block, size_t osize,
179 size_t nsize) {
180 void *newblock = luaM_realloc_(L, block, osize, nsize);
181 if (l_unlikely(newblock == NULL && nsize > 0)) /* allocation failed? */
182 luaM_error(L);
183 return newblock;
184}
185
186
187void *luaM_malloc_ (lua_State *L, size_t size, int tag) {
188 if (size == 0)
189 return NULL; /* that's all */
190 else {
191 global_State *g = G(L);
192 void *newblock = firsttry(g, NULL, tag, size);
193 if (l_unlikely(newblock == NULL)) {
194 newblock = tryagain(L, NULL, tag, size);
195 if (newblock == NULL)
196 luaM_error(L);
197 }
198 g->GCdebt += size;
199 return newblock;
200 }
201}
diff --git a/src/lua/lmem.h b/src/lua/lmem.h
deleted file mode 100644
index 8c75a44..0000000
--- a/src/lua/lmem.h
+++ /dev/null
@@ -1,93 +0,0 @@
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
deleted file mode 100644
index 6f9fa37..0000000
--- a/src/lua/loadlib.c
+++ /dev/null
@@ -1,762 +0,0 @@
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 (l_unlikely(lib == NULL))
136 lua_pushstring(L, dlerror());
137 return lib;
138}
139
140
141static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym) {
142 lua_CFunction f = cast_func(dlsym(lib, sym));
143 if (l_unlikely(f == NULL))
144 lua_pushstring(L, dlerror());
145 return f;
146}
147
148/* }====================================================== */
149
150
151
152#elif defined(LUA_DL_DLL) /* }{ */
153/*
154** {======================================================================
155** This is an implementation of loadlib for Windows using native functions.
156** =======================================================================
157*/
158
159#include <windows.h>
160
161
162/*
163** optional flags for LoadLibraryEx
164*/
165#if !defined(LUA_LLE_FLAGS)
166#define LUA_LLE_FLAGS 0
167#endif
168
169
170#undef setprogdir
171
172
173/*
174** Replace in the path (on the top of the stack) any occurrence
175** of LUA_EXEC_DIR with the executable's path.
176*/
177static void setprogdir (lua_State *L) {
178 char buff[MAX_PATH + 1];
179 char *lb;
180 DWORD nsize = sizeof(buff)/sizeof(char);
181 DWORD n = GetModuleFileNameA(NULL, buff, nsize); /* get exec. name */
182 if (n == 0 || n == nsize || (lb = strrchr(buff, '\\')) == NULL)
183 luaL_error(L, "unable to get ModuleFileName");
184 else {
185 *lb = '\0'; /* cut name on the last '\\' to get the path */
186 luaL_gsub(L, lua_tostring(L, -1), LUA_EXEC_DIR, buff);
187 lua_remove(L, -2); /* remove original string */
188 }
189}
190
191
192
193
194static void pusherror (lua_State *L) {
195 int error = GetLastError();
196 char buffer[128];
197 if (FormatMessageA(FORMAT_MESSAGE_IGNORE_INSERTS | FORMAT_MESSAGE_FROM_SYSTEM,
198 NULL, error, 0, buffer, sizeof(buffer)/sizeof(char), NULL))
199 lua_pushstring(L, buffer);
200 else
201 lua_pushfstring(L, "system error %d\n", error);
202}
203
204static void lsys_unloadlib (void *lib) {
205 FreeLibrary((HMODULE)lib);
206}
207
208
209static void *lsys_load (lua_State *L, const char *path, int seeglb) {
210 HMODULE lib = LoadLibraryExA(path, NULL, LUA_LLE_FLAGS);
211 (void)(seeglb); /* not used: symbols are 'global' by default */
212 if (lib == NULL) pusherror(L);
213 return lib;
214}
215
216
217static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym) {
218 lua_CFunction f = (lua_CFunction)(voidf)GetProcAddress((HMODULE)lib, sym);
219 if (f == NULL) pusherror(L);
220 return f;
221}
222
223/* }====================================================== */
224
225
226#else /* }{ */
227/*
228** {======================================================
229** Fallback for other systems
230** =======================================================
231*/
232
233#undef LIB_FAIL
234#define LIB_FAIL "absent"
235
236
237#define DLMSG "dynamic libraries not enabled; check your Lua installation"
238
239
240static void lsys_unloadlib (void *lib) {
241 (void)(lib); /* not used */
242}
243
244
245static void *lsys_load (lua_State *L, const char *path, int seeglb) {
246 (void)(path); (void)(seeglb); /* not used */
247 lua_pushliteral(L, DLMSG);
248 return NULL;
249}
250
251
252static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym) {
253 (void)(lib); (void)(sym); /* not used */
254 lua_pushliteral(L, DLMSG);
255 return NULL;
256}
257
258/* }====================================================== */
259#endif /* } */
260
261
262/*
263** {==================================================================
264** Set Paths
265** ===================================================================
266*/
267
268/*
269** LUA_PATH_VAR and LUA_CPATH_VAR are the names of the environment
270** variables that Lua check to set its paths.
271*/
272#if !defined(LUA_PATH_VAR)
273#define LUA_PATH_VAR "LUA_PATH"
274#endif
275
276#if !defined(LUA_CPATH_VAR)
277#define LUA_CPATH_VAR "LUA_CPATH"
278#endif
279
280
281
282/*
283** return registry.LUA_NOENV as a boolean
284*/
285static int noenv (lua_State *L) {
286 int b;
287 lua_getfield(L, LUA_REGISTRYINDEX, "LUA_NOENV");
288 b = lua_toboolean(L, -1);
289 lua_pop(L, 1); /* remove value */
290 return b;
291}
292
293
294/*
295** Set a path
296*/
297static void setpath (lua_State *L, const char *fieldname,
298 const char *envname,
299 const char *dft) {
300 const char *dftmark;
301 const char *nver = lua_pushfstring(L, "%s%s", envname, LUA_VERSUFFIX);
302 const char *path = getenv(nver); /* try versioned name */
303 if (path == NULL) /* no versioned environment variable? */
304 path = getenv(envname); /* try unversioned name */
305 if (path == NULL || noenv(L)) /* no environment variable? */
306 lua_pushstring(L, dft); /* use default */
307 else if ((dftmark = strstr(path, LUA_PATH_SEP LUA_PATH_SEP)) == NULL)
308 lua_pushstring(L, path); /* nothing to change */
309 else { /* path contains a ";;": insert default path in its place */
310 size_t len = strlen(path);
311 luaL_Buffer b;
312 luaL_buffinit(L, &b);
313 if (path < dftmark) { /* is there a prefix before ';;'? */
314 luaL_addlstring(&b, path, dftmark - path); /* add it */
315 luaL_addchar(&b, *LUA_PATH_SEP);
316 }
317 luaL_addstring(&b, dft); /* add default */
318 if (dftmark < path + len - 2) { /* is there a suffix after ';;'? */
319 luaL_addchar(&b, *LUA_PATH_SEP);
320 luaL_addlstring(&b, dftmark + 2, (path + len - 2) - dftmark);
321 }
322 luaL_pushresult(&b);
323 }
324 setprogdir(L);
325 lua_setfield(L, -3, fieldname); /* package[fieldname] = path value */
326 lua_pop(L, 1); /* pop versioned variable name ('nver') */
327}
328
329/* }================================================================== */
330
331
332/*
333** return registry.CLIBS[path]
334*/
335static void *checkclib (lua_State *L, const char *path) {
336 void *plib;
337 lua_getfield(L, LUA_REGISTRYINDEX, CLIBS);
338 lua_getfield(L, -1, path);
339 plib = lua_touserdata(L, -1); /* plib = CLIBS[path] */
340 lua_pop(L, 2); /* pop CLIBS table and 'plib' */
341 return plib;
342}
343
344
345/*
346** registry.CLIBS[path] = plib -- for queries
347** registry.CLIBS[#CLIBS + 1] = plib -- also keep a list of all libraries
348*/
349static void addtoclib (lua_State *L, const char *path, void *plib) {
350 lua_getfield(L, LUA_REGISTRYINDEX, CLIBS);
351 lua_pushlightuserdata(L, plib);
352 lua_pushvalue(L, -1);
353 lua_setfield(L, -3, path); /* CLIBS[path] = plib */
354 lua_rawseti(L, -2, luaL_len(L, -2) + 1); /* CLIBS[#CLIBS + 1] = plib */
355 lua_pop(L, 1); /* pop CLIBS table */
356}
357
358
359/*
360** __gc tag method for CLIBS table: calls 'lsys_unloadlib' for all lib
361** handles in list CLIBS
362*/
363static int gctm (lua_State *L) {
364 lua_Integer n = luaL_len(L, 1);
365 for (; n >= 1; n--) { /* for each handle, in reverse order */
366 lua_rawgeti(L, 1, n); /* get handle CLIBS[n] */
367 lsys_unloadlib(lua_touserdata(L, -1));
368 lua_pop(L, 1); /* pop handle */
369 }
370 return 0;
371}
372
373
374
375/* error codes for 'lookforfunc' */
376#define ERRLIB 1
377#define ERRFUNC 2
378
379/*
380** Look for a C function named 'sym' in a dynamically loaded library
381** 'path'.
382** First, check whether the library is already loaded; if not, try
383** to load it.
384** Then, if 'sym' is '*', return true (as library has been loaded).
385** Otherwise, look for symbol 'sym' in the library and push a
386** C function with that symbol.
387** Return 0 and 'true' or a function in the stack; in case of
388** errors, return an error code and an error message in the stack.
389*/
390static int lookforfunc (lua_State *L, const char *path, const char *sym) {
391 void *reg = checkclib(L, path); /* check loaded C libraries */
392 if (reg == NULL) { /* must load library? */
393 reg = lsys_load(L, path, *sym == '*'); /* global symbols if 'sym'=='*' */
394 if (reg == NULL) return ERRLIB; /* unable to load library */
395 addtoclib(L, path, reg);
396 }
397 if (*sym == '*') { /* loading only library (no function)? */
398 lua_pushboolean(L, 1); /* return 'true' */
399 return 0; /* no errors */
400 }
401 else {
402 lua_CFunction f = lsys_sym(L, reg, sym);
403 if (f == NULL)
404 return ERRFUNC; /* unable to find function */
405 lua_pushcfunction(L, f); /* else create new function */
406 return 0; /* no errors */
407 }
408}
409
410
411static int ll_loadlib (lua_State *L) {
412 const char *path = luaL_checkstring(L, 1);
413 const char *init = luaL_checkstring(L, 2);
414 int stat = lookforfunc(L, path, init);
415 if (l_likely(stat == 0)) /* no errors? */
416 return 1; /* return the loaded function */
417 else { /* error; error message is on stack top */
418 luaL_pushfail(L);
419 lua_insert(L, -2);
420 lua_pushstring(L, (stat == ERRLIB) ? LIB_FAIL : "init");
421 return 3; /* return fail, error message, and where */
422 }
423}
424
425
426
427/*
428** {======================================================
429** 'require' function
430** =======================================================
431*/
432
433
434static int readable (const char *filename) {
435 FILE *f = fopen(filename, "r"); /* try to open file */
436 if (f == NULL) return 0; /* open failed */
437 fclose(f);
438 return 1;
439}
440
441
442/*
443** Get the next name in '*path' = 'name1;name2;name3;...', changing
444** the ending ';' to '\0' to create a zero-terminated string. Return
445** NULL when list ends.
446*/
447static const char *getnextfilename (char **path, char *end) {
448 char *sep;
449 char *name = *path;
450 if (name == end)
451 return NULL; /* no more names */
452 else if (*name == '\0') { /* from previous iteration? */
453 *name = *LUA_PATH_SEP; /* restore separator */
454 name++; /* skip it */
455 }
456 sep = strchr(name, *LUA_PATH_SEP); /* find next separator */
457 if (sep == NULL) /* separator not found? */
458 sep = end; /* name goes until the end */
459 *sep = '\0'; /* finish file name */
460 *path = sep; /* will start next search from here */
461 return name;
462}
463
464
465/*
466** Given a path such as ";blabla.so;blublu.so", pushes the string
467**
468** no file 'blabla.so'
469** no file 'blublu.so'
470*/
471static void pusherrornotfound (lua_State *L, const char *path) {
472 luaL_Buffer b;
473 luaL_buffinit(L, &b);
474 luaL_addstring(&b, "no file '");
475 luaL_addgsub(&b, path, LUA_PATH_SEP, "'\n\tno file '");
476 luaL_addstring(&b, "'");
477 luaL_pushresult(&b);
478}
479
480
481static const char *searchpath (lua_State *L, const char *name,
482 const char *path,
483 const char *sep,
484 const char *dirsep) {
485 luaL_Buffer buff;
486 char *pathname; /* path with name inserted */
487 char *endpathname; /* its end */
488 const char *filename;
489 /* separator is non-empty and appears in 'name'? */
490 if (*sep != '\0' && strchr(name, *sep) != NULL)
491 name = luaL_gsub(L, name, sep, dirsep); /* replace it by 'dirsep' */
492 luaL_buffinit(L, &buff);
493 /* add path to the buffer, replacing marks ('?') with the file name */
494 luaL_addgsub(&buff, path, LUA_PATH_MARK, name);
495 luaL_addchar(&buff, '\0');
496 pathname = luaL_buffaddr(&buff); /* writable list of file names */
497 endpathname = pathname + luaL_bufflen(&buff) - 1;
498 while ((filename = getnextfilename(&pathname, endpathname)) != NULL) {
499 if (readable(filename)) /* does file exist and is readable? */
500 return lua_pushstring(L, filename); /* save and return name */
501 }
502 luaL_pushresult(&buff); /* push path to create error message */
503 pusherrornotfound(L, lua_tostring(L, -1)); /* create error message */
504 return NULL; /* not found */
505}
506
507
508static int ll_searchpath (lua_State *L) {
509 const char *f = searchpath(L, luaL_checkstring(L, 1),
510 luaL_checkstring(L, 2),
511 luaL_optstring(L, 3, "."),
512 luaL_optstring(L, 4, LUA_DIRSEP));
513 if (f != NULL) return 1;
514 else { /* error message is on top of the stack */
515 luaL_pushfail(L);
516 lua_insert(L, -2);
517 return 2; /* return fail + error message */
518 }
519}
520
521
522static const char *findfile (lua_State *L, const char *name,
523 const char *pname,
524 const char *dirsep) {
525 const char *path;
526 lua_getfield(L, lua_upvalueindex(1), pname);
527 path = lua_tostring(L, -1);
528 if (l_unlikely(path == NULL))
529 luaL_error(L, "'package.%s' must be a string", pname);
530 return searchpath(L, name, path, ".", dirsep);
531}
532
533
534static int checkload (lua_State *L, int stat, const char *filename) {
535 if (l_likely(stat)) { /* module loaded successfully? */
536 lua_pushstring(L, filename); /* will be 2nd argument to module */
537 return 2; /* return open function and file name */
538 }
539 else
540 return luaL_error(L, "error loading module '%s' from file '%s':\n\t%s",
541 lua_tostring(L, 1), filename, lua_tostring(L, -1));
542}
543
544
545static int searcher_Lua (lua_State *L) {
546 const char *filename;
547 const char *name = luaL_checkstring(L, 1);
548 filename = findfile(L, name, "path", LUA_LSUBSEP);
549 if (filename == NULL) return 1; /* module not found in this path */
550 return checkload(L, (luaL_loadfile(L, filename) == LUA_OK), filename);
551}
552
553
554/*
555** Try to find a load function for module 'modname' at file 'filename'.
556** First, change '.' to '_' in 'modname'; then, if 'modname' has
557** the form X-Y (that is, it has an "ignore mark"), build a function
558** name "luaopen_X" and look for it. (For compatibility, if that
559** fails, it also tries "luaopen_Y".) If there is no ignore mark,
560** look for a function named "luaopen_modname".
561*/
562static int loadfunc (lua_State *L, const char *filename, const char *modname) {
563 const char *openfunc;
564 const char *mark;
565 modname = luaL_gsub(L, modname, ".", LUA_OFSEP);
566 mark = strchr(modname, *LUA_IGMARK);
567 if (mark) {
568 int stat;
569 openfunc = lua_pushlstring(L, modname, mark - modname);
570 openfunc = lua_pushfstring(L, LUA_POF"%s", openfunc);
571 stat = lookforfunc(L, filename, openfunc);
572 if (stat != ERRFUNC) return stat;
573 modname = mark + 1; /* else go ahead and try old-style name */
574 }
575 openfunc = lua_pushfstring(L, LUA_POF"%s", modname);
576 return lookforfunc(L, filename, openfunc);
577}
578
579
580static int searcher_C (lua_State *L) {
581 const char *name = luaL_checkstring(L, 1);
582 const char *filename = findfile(L, name, "cpath", LUA_CSUBSEP);
583 if (filename == NULL) return 1; /* module not found in this path */
584 return checkload(L, (loadfunc(L, filename, name) == 0), filename);
585}
586
587
588static int searcher_Croot (lua_State *L) {
589 const char *filename;
590 const char *name = luaL_checkstring(L, 1);
591 const char *p = strchr(name, '.');
592 int stat;
593 if (p == NULL) return 0; /* is root */
594 lua_pushlstring(L, name, p - name);
595 filename = findfile(L, lua_tostring(L, -1), "cpath", LUA_CSUBSEP);
596 if (filename == NULL) return 1; /* root not found */
597 if ((stat = loadfunc(L, filename, name)) != 0) {
598 if (stat != ERRFUNC)
599 return checkload(L, 0, filename); /* real error */
600 else { /* open function not found */
601 lua_pushfstring(L, "no module '%s' in file '%s'", name, filename);
602 return 1;
603 }
604 }
605 lua_pushstring(L, filename); /* will be 2nd argument to module */
606 return 2;
607}
608
609
610static int searcher_preload (lua_State *L) {
611 const char *name = luaL_checkstring(L, 1);
612 lua_getfield(L, LUA_REGISTRYINDEX, LUA_PRELOAD_TABLE);
613 if (lua_getfield(L, -1, name) == LUA_TNIL) { /* not found? */
614 lua_pushfstring(L, "no field package.preload['%s']", name);
615 return 1;
616 }
617 else {
618 lua_pushliteral(L, ":preload:");
619 return 2;
620 }
621}
622
623
624static void findloader (lua_State *L, const char *name) {
625 int i;
626 luaL_Buffer msg; /* to build error message */
627 /* push 'package.searchers' to index 3 in the stack */
628 if (l_unlikely(lua_getfield(L, lua_upvalueindex(1), "searchers")
629 != LUA_TTABLE))
630 luaL_error(L, "'package.searchers' must be a table");
631 luaL_buffinit(L, &msg);
632 /* iterate over available searchers to find a loader */
633 for (i = 1; ; i++) {
634 luaL_addstring(&msg, "\n\t"); /* error-message prefix */
635 if (l_unlikely(lua_rawgeti(L, 3, i) == LUA_TNIL)) { /* no more searchers? */
636 lua_pop(L, 1); /* remove nil */
637 luaL_buffsub(&msg, 2); /* remove prefix */
638 luaL_pushresult(&msg); /* create error message */
639 luaL_error(L, "module '%s' not found:%s", name, lua_tostring(L, -1));
640 }
641 lua_pushstring(L, name);
642 lua_call(L, 1, 2); /* call it */
643 if (lua_isfunction(L, -2)) /* did it find a loader? */
644 return; /* module loader found */
645 else if (lua_isstring(L, -2)) { /* searcher returned error message? */
646 lua_pop(L, 1); /* remove extra return */
647 luaL_addvalue(&msg); /* concatenate error message */
648 }
649 else { /* no error message */
650 lua_pop(L, 2); /* remove both returns */
651 luaL_buffsub(&msg, 2); /* remove prefix */
652 }
653 }
654}
655
656
657static int ll_require (lua_State *L) {
658 const char *name = luaL_checkstring(L, 1);
659 lua_settop(L, 1); /* LOADED table will be at index 2 */
660 lua_getfield(L, LUA_REGISTRYINDEX, LUA_LOADED_TABLE);
661 lua_getfield(L, 2, name); /* LOADED[name] */
662 if (lua_toboolean(L, -1)) /* is it there? */
663 return 1; /* package is already loaded */
664 /* else must load package */
665 lua_pop(L, 1); /* remove 'getfield' result */
666 findloader(L, name);
667 lua_rotate(L, -2, 1); /* function <-> loader data */
668 lua_pushvalue(L, 1); /* name is 1st argument to module loader */
669 lua_pushvalue(L, -3); /* loader data is 2nd argument */
670 /* stack: ...; loader data; loader function; mod. name; loader data */
671 lua_call(L, 2, 1); /* run loader to load module */
672 /* stack: ...; loader data; result from loader */
673 if (!lua_isnil(L, -1)) /* non-nil return? */
674 lua_setfield(L, 2, name); /* LOADED[name] = returned value */
675 else
676 lua_pop(L, 1); /* pop nil */
677 if (lua_getfield(L, 2, name) == LUA_TNIL) { /* module set no value? */
678 lua_pushboolean(L, 1); /* use true as result */
679 lua_copy(L, -1, -2); /* replace loader result */
680 lua_setfield(L, 2, name); /* LOADED[name] = true */
681 }
682 lua_rotate(L, -2, 1); /* loader data <-> module result */
683 return 2; /* return module result and loader data */
684}
685
686/* }====================================================== */
687
688
689
690
691static const luaL_Reg pk_funcs[] = {
692 {"loadlib", ll_loadlib},
693 {"searchpath", ll_searchpath},
694 /* placeholders */
695 {"preload", NULL},
696 {"cpath", NULL},
697 {"path", NULL},
698 {"searchers", NULL},
699 {"loaded", NULL},
700 {NULL, NULL}
701};
702
703
704static const luaL_Reg ll_funcs[] = {
705 {"require", ll_require},
706 {NULL, NULL}
707};
708
709
710static void createsearcherstable (lua_State *L) {
711 static const lua_CFunction searchers[] =
712 {searcher_preload, searcher_Lua, searcher_C, searcher_Croot, NULL};
713 int i;
714 /* create 'searchers' table */
715 lua_createtable(L, sizeof(searchers)/sizeof(searchers[0]) - 1, 0);
716 /* fill it with predefined searchers */
717 for (i=0; searchers[i] != NULL; i++) {
718 lua_pushvalue(L, -2); /* set 'package' as upvalue for all searchers */
719 lua_pushcclosure(L, searchers[i], 1);
720 lua_rawseti(L, -2, i+1);
721 }
722 lua_setfield(L, -2, "searchers"); /* put it in field 'searchers' */
723}
724
725
726/*
727** create table CLIBS to keep track of loaded C libraries,
728** setting a finalizer to close all libraries when closing state.
729*/
730static void createclibstable (lua_State *L) {
731 luaL_getsubtable(L, LUA_REGISTRYINDEX, CLIBS); /* create CLIBS table */
732 lua_createtable(L, 0, 1); /* create metatable for CLIBS */
733 lua_pushcfunction(L, gctm);
734 lua_setfield(L, -2, "__gc"); /* set finalizer for CLIBS table */
735 lua_setmetatable(L, -2);
736}
737
738
739LUAMOD_API int luaopen_package (lua_State *L) {
740 createclibstable(L);
741 luaL_newlib(L, pk_funcs); /* create 'package' table */
742 createsearcherstable(L);
743 /* set paths */
744 setpath(L, "path", LUA_PATH_VAR, LUA_PATH_DEFAULT);
745 setpath(L, "cpath", LUA_CPATH_VAR, LUA_CPATH_DEFAULT);
746 /* store config information */
747 lua_pushliteral(L, LUA_DIRSEP "\n" LUA_PATH_SEP "\n" LUA_PATH_MARK "\n"
748 LUA_EXEC_DIR "\n" LUA_IGMARK "\n");
749 lua_setfield(L, -2, "config");
750 /* set field 'loaded' */
751 luaL_getsubtable(L, LUA_REGISTRYINDEX, LUA_LOADED_TABLE);
752 lua_setfield(L, -2, "loaded");
753 /* set field 'preload' */
754 luaL_getsubtable(L, LUA_REGISTRYINDEX, LUA_PRELOAD_TABLE);
755 lua_setfield(L, -2, "preload");
756 lua_pushglobaltable(L);
757 lua_pushvalue(L, -2); /* set 'package' as upvalue for next lib */
758 luaL_setfuncs(L, ll_funcs, 1); /* open lib into global table */
759 lua_pop(L, 1); /* pop global table */
760 return 1; /* return 'package' table */
761}
762
diff --git a/src/lua/lobject.c b/src/lua/lobject.c
deleted file mode 100644
index 0e504be..0000000
--- a/src/lua/lobject.c
+++ /dev/null
@@ -1,592 +0,0 @@
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 to be converted to a number */
219#if !defined (L_MAXLENNUM)
220#define L_MAXLENNUM 200
221#endif
222
223/*
224** Convert string 's' to a Lua number (put in 'result'). Return NULL on
225** fail or the address of the ending '\0' on success. ('mode' == 'x')
226** means a hexadecimal numeral.
227*/
228static const char *l_str2dloc (const char *s, lua_Number *result, int mode) {
229 char *endptr;
230 *result = (mode == 'x') ? lua_strx2number(s, &endptr) /* try to convert */
231 : lua_str2number(s, &endptr);
232 if (endptr == s) return NULL; /* nothing recognized? */
233 while (lisspace(cast_uchar(*endptr))) endptr++; /* skip trailing spaces */
234 return (*endptr == '\0') ? endptr : NULL; /* OK iff no trailing chars */
235}
236
237
238/*
239** Convert string 's' to a Lua number (put in 'result') handling the
240** current locale.
241** This function accepts both the current locale or a dot as the radix
242** mark. If the conversion fails, it may mean number has a dot but
243** locale accepts something else. In that case, the code copies 's'
244** to a buffer (because 's' is read-only), changes the dot to the
245** current locale radix mark, and tries to convert again.
246** The variable 'mode' checks for special characters in the string:
247** - 'n' means 'inf' or 'nan' (which should be rejected)
248** - 'x' means a hexadecimal numeral
249** - '.' just optimizes the search for the common case (no special chars)
250*/
251static const char *l_str2d (const char *s, lua_Number *result) {
252 const char *endptr;
253 const char *pmode = strpbrk(s, ".xXnN"); /* look for special chars */
254 int mode = pmode ? ltolower(cast_uchar(*pmode)) : 0;
255 if (mode == 'n') /* reject 'inf' and 'nan' */
256 return NULL;
257 endptr = l_str2dloc(s, result, mode); /* try to convert */
258 if (endptr == NULL) { /* failed? may be a different locale */
259 char buff[L_MAXLENNUM + 1];
260 const char *pdot = strchr(s, '.');
261 if (pdot == NULL || strlen(s) > L_MAXLENNUM)
262 return NULL; /* string too long or no dot; fail */
263 strcpy(buff, s); /* copy string to buffer */
264 buff[pdot - s] = lua_getlocaledecpoint(); /* correct decimal point */
265 endptr = l_str2dloc(buff, result, mode); /* try again */
266 if (endptr != NULL)
267 endptr = s + (endptr - buff); /* make relative to 's' */
268 }
269 return endptr;
270}
271
272
273#define MAXBY10 cast(lua_Unsigned, LUA_MAXINTEGER / 10)
274#define MAXLASTD cast_int(LUA_MAXINTEGER % 10)
275
276static const char *l_str2int (const char *s, lua_Integer *result) {
277 lua_Unsigned a = 0;
278 int empty = 1;
279 int neg;
280 while (lisspace(cast_uchar(*s))) s++; /* skip initial spaces */
281 neg = isneg(&s);
282 if (s[0] == '0' &&
283 (s[1] == 'x' || s[1] == 'X')) { /* hex? */
284 s += 2; /* skip '0x' */
285 for (; lisxdigit(cast_uchar(*s)); s++) {
286 a = a * 16 + luaO_hexavalue(*s);
287 empty = 0;
288 }
289 }
290 else { /* decimal */
291 for (; lisdigit(cast_uchar(*s)); s++) {
292 int d = *s - '0';
293 if (a >= MAXBY10 && (a > MAXBY10 || d > MAXLASTD + neg)) /* overflow? */
294 return NULL; /* do not accept it (as integer) */
295 a = a * 10 + d;
296 empty = 0;
297 }
298 }
299 while (lisspace(cast_uchar(*s))) s++; /* skip trailing spaces */
300 if (empty || *s != '\0') return NULL; /* something wrong in the numeral */
301 else {
302 *result = l_castU2S((neg) ? 0u - a : a);
303 return s;
304 }
305}
306
307
308size_t luaO_str2num (const char *s, TValue *o) {
309 lua_Integer i; lua_Number n;
310 const char *e;
311 if ((e = l_str2int(s, &i)) != NULL) { /* try as an integer */
312 setivalue(o, i);
313 }
314 else if ((e = l_str2d(s, &n)) != NULL) { /* else try as a float */
315 setfltvalue(o, n);
316 }
317 else
318 return 0; /* conversion failed */
319 return (e - s) + 1; /* success; return string size */
320}
321
322
323int luaO_utf8esc (char *buff, unsigned long x) {
324 int n = 1; /* number of bytes put in buffer (backwards) */
325 lua_assert(x <= 0x7FFFFFFFu);
326 if (x < 0x80) /* ascii? */
327 buff[UTF8BUFFSZ - 1] = cast_char(x);
328 else { /* need continuation bytes */
329 unsigned int mfb = 0x3f; /* maximum that fits in first byte */
330 do { /* add continuation bytes */
331 buff[UTF8BUFFSZ - (n++)] = cast_char(0x80 | (x & 0x3f));
332 x >>= 6; /* remove added bits */
333 mfb >>= 1; /* now there is one less bit available in first byte */
334 } while (x > mfb); /* still needs continuation byte? */
335 buff[UTF8BUFFSZ - n] = cast_char((~mfb << 1) | x); /* add first byte */
336 }
337 return n;
338}
339
340
341/*
342** Maximum length of the conversion of a number to a string. Must be
343** enough to accommodate both LUA_INTEGER_FMT and LUA_NUMBER_FMT.
344** (For a long long int, this is 19 digits plus a sign and a final '\0',
345** adding to 21. For a long double, it can go to a sign, 33 digits,
346** the dot, an exponent letter, an exponent sign, 5 exponent digits,
347** and a final '\0', adding to 43.)
348*/
349#define MAXNUMBER2STR 44
350
351
352/*
353** Convert a number object to a string, adding it to a buffer
354*/
355static int tostringbuff (TValue *obj, char *buff) {
356 int len;
357 lua_assert(ttisnumber(obj));
358 if (ttisinteger(obj))
359 len = lua_integer2str(buff, MAXNUMBER2STR, ivalue(obj));
360 else {
361 len = lua_number2str(buff, MAXNUMBER2STR, fltvalue(obj));
362 if (buff[strspn(buff, "-0123456789")] == '\0') { /* looks like an int? */
363 buff[len++] = lua_getlocaledecpoint();
364 buff[len++] = '0'; /* adds '.0' to result */
365 }
366 }
367 return len;
368}
369
370
371/*
372** Convert a number object to a Lua string, replacing the value at 'obj'
373*/
374void luaO_tostring (lua_State *L, TValue *obj) {
375 char buff[MAXNUMBER2STR];
376 int len = tostringbuff(obj, buff);
377 setsvalue(L, obj, luaS_newlstr(L, buff, len));
378}
379
380
381
382
383/*
384** {==================================================================
385** 'luaO_pushvfstring'
386** ===================================================================
387*/
388
389/* size for buffer space used by 'luaO_pushvfstring' */
390#define BUFVFS 200
391
392/* buffer used by 'luaO_pushvfstring' */
393typedef struct BuffFS {
394 lua_State *L;
395 int pushed; /* number of string pieces already on the stack */
396 int blen; /* length of partial string in 'space' */
397 char space[BUFVFS]; /* holds last part of the result */
398} BuffFS;
399
400
401/*
402** Push given string to the stack, as part of the buffer, and
403** join the partial strings in the stack into one.
404*/
405static void pushstr (BuffFS *buff, const char *str, size_t l) {
406 lua_State *L = buff->L;
407 setsvalue2s(L, L->top, luaS_newlstr(L, str, l));
408 L->top++; /* may use one extra slot */
409 buff->pushed++;
410 luaV_concat(L, buff->pushed); /* join partial results into one */
411 buff->pushed = 1;
412}
413
414
415/*
416** empty the buffer space into the stack
417*/
418static void clearbuff (BuffFS *buff) {
419 pushstr(buff, buff->space, buff->blen); /* push buffer contents */
420 buff->blen = 0; /* space now is empty */
421}
422
423
424/*
425** Get a space of size 'sz' in the buffer. If buffer has not enough
426** space, empty it. 'sz' must fit in an empty buffer.
427*/
428static char *getbuff (BuffFS *buff, int sz) {
429 lua_assert(buff->blen <= BUFVFS); lua_assert(sz <= BUFVFS);
430 if (sz > BUFVFS - buff->blen) /* not enough space? */
431 clearbuff(buff);
432 return buff->space + buff->blen;
433}
434
435
436#define addsize(b,sz) ((b)->blen += (sz))
437
438
439/*
440** Add 'str' to the buffer. If string is larger than the buffer space,
441** push the string directly to the stack.
442*/
443static void addstr2buff (BuffFS *buff, const char *str, size_t slen) {
444 if (slen <= BUFVFS) { /* does string fit into buffer? */
445 char *bf = getbuff(buff, cast_int(slen));
446 memcpy(bf, str, slen); /* add string to buffer */
447 addsize(buff, cast_int(slen));
448 }
449 else { /* string larger than buffer */
450 clearbuff(buff); /* string comes after buffer's content */
451 pushstr(buff, str, slen); /* push string */
452 }
453}
454
455
456/*
457** Add a number to the buffer.
458*/
459static void addnum2buff (BuffFS *buff, TValue *num) {
460 char *numbuff = getbuff(buff, MAXNUMBER2STR);
461 int len = tostringbuff(num, numbuff); /* format number into 'numbuff' */
462 addsize(buff, len);
463}
464
465
466/*
467** this function handles only '%d', '%c', '%f', '%p', '%s', and '%%'
468 conventional formats, plus Lua-specific '%I' and '%U'
469*/
470const char *luaO_pushvfstring (lua_State *L, const char *fmt, va_list argp) {
471 BuffFS buff; /* holds last part of the result */
472 const char *e; /* points to next '%' */
473 buff.pushed = buff.blen = 0;
474 buff.L = L;
475 while ((e = strchr(fmt, '%')) != NULL) {
476 addstr2buff(&buff, fmt, e - fmt); /* add 'fmt' up to '%' */
477 switch (*(e + 1)) { /* conversion specifier */
478 case 's': { /* zero-terminated string */
479 const char *s = va_arg(argp, char *);
480 if (s == NULL) s = "(null)";
481 addstr2buff(&buff, s, strlen(s));
482 break;
483 }
484 case 'c': { /* an 'int' as a character */
485 char c = cast_uchar(va_arg(argp, int));
486 addstr2buff(&buff, &c, sizeof(char));
487 break;
488 }
489 case 'd': { /* an 'int' */
490 TValue num;
491 setivalue(&num, va_arg(argp, int));
492 addnum2buff(&buff, &num);
493 break;
494 }
495 case 'I': { /* a 'lua_Integer' */
496 TValue num;
497 setivalue(&num, cast(lua_Integer, va_arg(argp, l_uacInt)));
498 addnum2buff(&buff, &num);
499 break;
500 }
501 case 'f': { /* a 'lua_Number' */
502 TValue num;
503 setfltvalue(&num, cast_num(va_arg(argp, l_uacNumber)));
504 addnum2buff(&buff, &num);
505 break;
506 }
507 case 'p': { /* a pointer */
508 const int sz = 3 * sizeof(void*) + 8; /* enough space for '%p' */
509 char *bf = getbuff(&buff, sz);
510 void *p = va_arg(argp, void *);
511 int len = lua_pointer2str(bf, sz, p);
512 addsize(&buff, len);
513 break;
514 }
515 case 'U': { /* a 'long' as a UTF-8 sequence */
516 char bf[UTF8BUFFSZ];
517 int len = luaO_utf8esc(bf, va_arg(argp, long));
518 addstr2buff(&buff, bf + UTF8BUFFSZ - len, len);
519 break;
520 }
521 case '%': {
522 addstr2buff(&buff, "%", 1);
523 break;
524 }
525 default: {
526 luaG_runerror(L, "invalid option '%%%c' to 'lua_pushfstring'",
527 *(e + 1));
528 }
529 }
530 fmt = e + 2; /* skip '%' and the specifier */
531 }
532 addstr2buff(&buff, fmt, strlen(fmt)); /* rest of 'fmt' */
533 clearbuff(&buff); /* empty buffer into the stack */
534 lua_assert(buff.pushed == 1);
535 return svalue(s2v(L->top - 1));
536}
537
538
539const char *luaO_pushfstring (lua_State *L, const char *fmt, ...) {
540 const char *msg;
541 va_list argp;
542 va_start(argp, fmt);
543 msg = luaO_pushvfstring(L, fmt, argp);
544 va_end(argp);
545 return msg;
546}
547
548/* }================================================================== */
549
550
551#define RETS "..."
552#define PRE "[string \""
553#define POS "\"]"
554
555#define addstr(a,b,l) ( memcpy(a,b,(l) * sizeof(char)), a += (l) )
556
557void luaO_chunkid (char *out, const char *source, size_t srclen) {
558 size_t bufflen = LUA_IDSIZE; /* free space in buffer */
559 if (*source == '=') { /* 'literal' source */
560 if (srclen <= bufflen) /* small enough? */
561 memcpy(out, source + 1, srclen * sizeof(char));
562 else { /* truncate it */
563 addstr(out, source + 1, bufflen - 1);
564 *out = '\0';
565 }
566 }
567 else if (*source == '@') { /* file name */
568 if (srclen <= bufflen) /* small enough? */
569 memcpy(out, source + 1, srclen * sizeof(char));
570 else { /* add '...' before rest of name */
571 addstr(out, RETS, LL(RETS));
572 bufflen -= LL(RETS);
573 memcpy(out, source + 1 + srclen - bufflen, bufflen * sizeof(char));
574 }
575 }
576 else { /* string; format as [string "source"] */
577 const char *nl = strchr(source, '\n'); /* find first new line (if any) */
578 addstr(out, PRE, LL(PRE)); /* add prefix */
579 bufflen -= LL(PRE RETS POS) + 1; /* save space for prefix+suffix+'\0' */
580 if (srclen < bufflen && nl == NULL) { /* small one-line source? */
581 addstr(out, source, srclen); /* keep it */
582 }
583 else {
584 if (nl != NULL) srclen = nl - source; /* stop at first newline */
585 if (srclen > bufflen) srclen = bufflen;
586 addstr(out, source, srclen);
587 addstr(out, RETS, LL(RETS));
588 }
589 memcpy(out, POS, (LL(POS) + 1) * sizeof(char));
590 }
591}
592
diff --git a/src/lua/lobject.h b/src/lua/lobject.h
deleted file mode 100644
index 950bebb..0000000
--- a/src/lua/lobject.h
+++ /dev/null
@@ -1,800 +0,0 @@
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#define LUA_TDEADKEY (LUA_NUMTYPES+2) /* removed keys in tables */
25
26
27
28/*
29** number of all possible types (including LUA_TNONE but excluding DEADKEY)
30*/
31#define LUA_TOTALTYPES (LUA_TPROTO + 2)
32
33
34/*
35** tags for Tagged Values have the following use of bits:
36** bits 0-3: actual tag (a LUA_T* constant)
37** bits 4-5: variant bits
38** bit 6: whether value is collectable
39*/
40
41/* add variant bits to a type */
42#define makevariant(t,v) ((t) | ((v) << 4))
43
44
45
46/*
47** Union of all Lua values
48*/
49typedef union Value {
50 struct GCObject *gc; /* collectable objects */
51 void *p; /* light userdata */
52 lua_CFunction f; /* light C functions */
53 lua_Integer i; /* integer numbers */
54 lua_Number n; /* float numbers */
55} Value;
56
57
58/*
59** Tagged Values. This is the basic representation of values in Lua:
60** an actual value plus a tag with its type.
61*/
62
63#define TValuefields Value value_; lu_byte tt_
64
65typedef struct TValue {
66 TValuefields;
67} TValue;
68
69
70#define val_(o) ((o)->value_)
71#define valraw(o) (&val_(o))
72
73
74/* raw type tag of a TValue */
75#define rawtt(o) ((o)->tt_)
76
77/* tag with no variants (bits 0-3) */
78#define novariant(t) ((t) & 0x0F)
79
80/* type tag of a TValue (bits 0-3 for tags + variant bits 4-5) */
81#define withvariant(t) ((t) & 0x3F)
82#define ttypetag(o) withvariant(rawtt(o))
83
84/* type of a TValue */
85#define ttype(o) (novariant(rawtt(o)))
86
87
88/* Macros to test type */
89#define checktag(o,t) (rawtt(o) == (t))
90#define checktype(o,t) (ttype(o) == (t))
91
92
93/* Macros for internal tests */
94
95/* collectable object has the same tag as the original value */
96#define righttt(obj) (ttypetag(obj) == gcvalue(obj)->tt)
97
98/*
99** Any value being manipulated by the program either is non
100** collectable, or the collectable object has the right tag
101** and it is not dead. The option 'L == NULL' allows other
102** macros using this one to be used where L is not available.
103*/
104#define checkliveness(L,obj) \
105 ((void)L, lua_longassert(!iscollectable(obj) || \
106 (righttt(obj) && (L == NULL || !isdead(G(L),gcvalue(obj))))))
107
108
109/* Macros to set values */
110
111/* set a value's tag */
112#define settt_(o,t) ((o)->tt_=(t))
113
114
115/* main macro to copy values (from 'obj1' to 'obj2') */
116#define setobj(L,obj1,obj2) \
117 { TValue *io1=(obj1); const TValue *io2=(obj2); \
118 io1->value_ = io2->value_; settt_(io1, io2->tt_); \
119 checkliveness(L,io1); lua_assert(!isnonstrictnil(io1)); }
120
121/*
122** Different types of assignments, according to source and destination.
123** (They are mostly equal now, but may be different in the future.)
124*/
125
126/* from stack to stack */
127#define setobjs2s(L,o1,o2) setobj(L,s2v(o1),s2v(o2))
128/* to stack (not from same stack) */
129#define setobj2s(L,o1,o2) setobj(L,s2v(o1),o2)
130/* from table to same table */
131#define setobjt2t setobj
132/* to new object */
133#define setobj2n setobj
134/* to table */
135#define setobj2t setobj
136
137
138/*
139** Entries in a Lua stack. Field 'tbclist' forms a list of all
140** to-be-closed variables active in this stack. Dummy entries are
141** used when the distance between two tbc variables does not fit
142** in an unsigned short. They are represented by delta==0, and
143** their real delta is always the maximum value that fits in
144** that field.
145*/
146typedef union StackValue {
147 TValue val;
148 struct {
149 TValuefields;
150 unsigned short delta;
151 } tbclist;
152} StackValue;
153
154
155/* index to stack elements */
156typedef StackValue *StkId;
157
158/* convert a 'StackValue' to a 'TValue' */
159#define s2v(o) (&(o)->val)
160
161
162
163/*
164** {==================================================================
165** Nil
166** ===================================================================
167*/
168
169/* Standard nil */
170#define LUA_VNIL makevariant(LUA_TNIL, 0)
171
172/* Empty slot (which might be different from a slot containing nil) */
173#define LUA_VEMPTY makevariant(LUA_TNIL, 1)
174
175/* Value returned for a key not found in a table (absent key) */
176#define LUA_VABSTKEY makevariant(LUA_TNIL, 2)
177
178
179/* macro to test for (any kind of) nil */
180#define ttisnil(v) checktype((v), LUA_TNIL)
181
182
183/* macro to test for a standard nil */
184#define ttisstrictnil(o) checktag((o), LUA_VNIL)
185
186
187#define setnilvalue(obj) settt_(obj, LUA_VNIL)
188
189
190#define isabstkey(v) checktag((v), LUA_VABSTKEY)
191
192
193/*
194** macro to detect non-standard nils (used only in assertions)
195*/
196#define isnonstrictnil(v) (ttisnil(v) && !ttisstrictnil(v))
197
198
199/*
200** By default, entries with any kind of nil are considered empty.
201** (In any definition, values associated with absent keys must also
202** be accepted as empty.)
203*/
204#define isempty(v) ttisnil(v)
205
206
207/* macro defining a value corresponding to an absent key */
208#define ABSTKEYCONSTANT {NULL}, LUA_VABSTKEY
209
210
211/* mark an entry as empty */
212#define setempty(v) settt_(v, LUA_VEMPTY)
213
214
215
216/* }================================================================== */
217
218
219/*
220** {==================================================================
221** Booleans
222** ===================================================================
223*/
224
225
226#define LUA_VFALSE makevariant(LUA_TBOOLEAN, 0)
227#define LUA_VTRUE makevariant(LUA_TBOOLEAN, 1)
228
229#define ttisboolean(o) checktype((o), LUA_TBOOLEAN)
230#define ttisfalse(o) checktag((o), LUA_VFALSE)
231#define ttistrue(o) checktag((o), LUA_VTRUE)
232
233
234#define l_isfalse(o) (ttisfalse(o) || ttisnil(o))
235
236
237#define setbfvalue(obj) settt_(obj, LUA_VFALSE)
238#define setbtvalue(obj) settt_(obj, LUA_VTRUE)
239
240/* }================================================================== */
241
242
243/*
244** {==================================================================
245** Threads
246** ===================================================================
247*/
248
249#define LUA_VTHREAD makevariant(LUA_TTHREAD, 0)
250
251#define ttisthread(o) checktag((o), ctb(LUA_VTHREAD))
252
253#define thvalue(o) check_exp(ttisthread(o), gco2th(val_(o).gc))
254
255#define setthvalue(L,obj,x) \
256 { TValue *io = (obj); lua_State *x_ = (x); \
257 val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_VTHREAD)); \
258 checkliveness(L,io); }
259
260#define setthvalue2s(L,o,t) setthvalue(L,s2v(o),t)
261
262/* }================================================================== */
263
264
265/*
266** {==================================================================
267** Collectable Objects
268** ===================================================================
269*/
270
271/*
272** Common Header for all collectable objects (in macro form, to be
273** included in other objects)
274*/
275#define CommonHeader struct GCObject *next; lu_byte tt; lu_byte marked
276
277
278/* Common type for all collectable objects */
279typedef struct GCObject {
280 CommonHeader;
281} GCObject;
282
283
284/* Bit mark for collectable types */
285#define BIT_ISCOLLECTABLE (1 << 6)
286
287#define iscollectable(o) (rawtt(o) & BIT_ISCOLLECTABLE)
288
289/* mark a tag as collectable */
290#define ctb(t) ((t) | BIT_ISCOLLECTABLE)
291
292#define gcvalue(o) check_exp(iscollectable(o), val_(o).gc)
293
294#define gcvalueraw(v) ((v).gc)
295
296#define setgcovalue(L,obj,x) \
297 { TValue *io = (obj); GCObject *i_g=(x); \
298 val_(io).gc = i_g; settt_(io, ctb(i_g->tt)); }
299
300/* }================================================================== */
301
302
303/*
304** {==================================================================
305** Numbers
306** ===================================================================
307*/
308
309/* Variant tags for numbers */
310#define LUA_VNUMINT makevariant(LUA_TNUMBER, 0) /* integer numbers */
311#define LUA_VNUMFLT makevariant(LUA_TNUMBER, 1) /* float numbers */
312
313#define ttisnumber(o) checktype((o), LUA_TNUMBER)
314#define ttisfloat(o) checktag((o), LUA_VNUMFLT)
315#define ttisinteger(o) checktag((o), LUA_VNUMINT)
316
317#define nvalue(o) check_exp(ttisnumber(o), \
318 (ttisinteger(o) ? cast_num(ivalue(o)) : fltvalue(o)))
319#define fltvalue(o) check_exp(ttisfloat(o), val_(o).n)
320#define ivalue(o) check_exp(ttisinteger(o), val_(o).i)
321
322#define fltvalueraw(v) ((v).n)
323#define ivalueraw(v) ((v).i)
324
325#define setfltvalue(obj,x) \
326 { TValue *io=(obj); val_(io).n=(x); settt_(io, LUA_VNUMFLT); }
327
328#define chgfltvalue(obj,x) \
329 { TValue *io=(obj); lua_assert(ttisfloat(io)); val_(io).n=(x); }
330
331#define setivalue(obj,x) \
332 { TValue *io=(obj); val_(io).i=(x); settt_(io, LUA_VNUMINT); }
333
334#define chgivalue(obj,x) \
335 { TValue *io=(obj); lua_assert(ttisinteger(io)); val_(io).i=(x); }
336
337/* }================================================================== */
338
339
340/*
341** {==================================================================
342** Strings
343** ===================================================================
344*/
345
346/* Variant tags for strings */
347#define LUA_VSHRSTR makevariant(LUA_TSTRING, 0) /* short strings */
348#define LUA_VLNGSTR makevariant(LUA_TSTRING, 1) /* long strings */
349
350#define ttisstring(o) checktype((o), LUA_TSTRING)
351#define ttisshrstring(o) checktag((o), ctb(LUA_VSHRSTR))
352#define ttislngstring(o) checktag((o), ctb(LUA_VLNGSTR))
353
354#define tsvalueraw(v) (gco2ts((v).gc))
355
356#define tsvalue(o) check_exp(ttisstring(o), gco2ts(val_(o).gc))
357
358#define setsvalue(L,obj,x) \
359 { TValue *io = (obj); TString *x_ = (x); \
360 val_(io).gc = obj2gco(x_); settt_(io, ctb(x_->tt)); \
361 checkliveness(L,io); }
362
363/* set a string to the stack */
364#define setsvalue2s(L,o,s) setsvalue(L,s2v(o),s)
365
366/* set a string to a new object */
367#define setsvalue2n setsvalue
368
369
370/*
371** Header for a string value.
372*/
373typedef struct TString {
374 CommonHeader;
375 lu_byte extra; /* reserved words for short strings; "has hash" for longs */
376 lu_byte shrlen; /* length for short strings */
377 unsigned int hash;
378 union {
379 size_t lnglen; /* length for long strings */
380 struct TString *hnext; /* linked list for hash table */
381 } u;
382 char contents[1];
383} TString;
384
385
386
387/*
388** Get the actual string (array of bytes) from a 'TString'.
389*/
390#define getstr(ts) ((ts)->contents)
391
392
393/* get the actual string (array of bytes) from a Lua value */
394#define svalue(o) getstr(tsvalue(o))
395
396/* get string length from 'TString *s' */
397#define tsslen(s) ((s)->tt == LUA_VSHRSTR ? (s)->shrlen : (s)->u.lnglen)
398
399/* get string length from 'TValue *o' */
400#define vslen(o) tsslen(tsvalue(o))
401
402/* }================================================================== */
403
404
405/*
406** {==================================================================
407** Userdata
408** ===================================================================
409*/
410
411
412/*
413** Light userdata should be a variant of userdata, but for compatibility
414** reasons they are also different types.
415*/
416#define LUA_VLIGHTUSERDATA makevariant(LUA_TLIGHTUSERDATA, 0)
417
418#define LUA_VUSERDATA makevariant(LUA_TUSERDATA, 0)
419
420#define ttislightuserdata(o) checktag((o), LUA_VLIGHTUSERDATA)
421#define ttisfulluserdata(o) checktag((o), ctb(LUA_VUSERDATA))
422
423#define pvalue(o) check_exp(ttislightuserdata(o), val_(o).p)
424#define uvalue(o) check_exp(ttisfulluserdata(o), gco2u(val_(o).gc))
425
426#define pvalueraw(v) ((v).p)
427
428#define setpvalue(obj,x) \
429 { TValue *io=(obj); val_(io).p=(x); settt_(io, LUA_VLIGHTUSERDATA); }
430
431#define setuvalue(L,obj,x) \
432 { TValue *io = (obj); Udata *x_ = (x); \
433 val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_VUSERDATA)); \
434 checkliveness(L,io); }
435
436
437/* Ensures that addresses after this type are always fully aligned. */
438typedef union UValue {
439 TValue uv;
440 LUAI_MAXALIGN; /* ensures maximum alignment for udata bytes */
441} UValue;
442
443
444/*
445** Header for userdata with user values;
446** memory area follows the end of this structure.
447*/
448typedef struct Udata {
449 CommonHeader;
450 unsigned short nuvalue; /* number of user values */
451 size_t len; /* number of bytes */
452 struct Table *metatable;
453 GCObject *gclist;
454 UValue uv[1]; /* user values */
455} Udata;
456
457
458/*
459** Header for userdata with no user values. These userdata do not need
460** to be gray during GC, and therefore do not need a 'gclist' field.
461** To simplify, the code always use 'Udata' for both kinds of userdata,
462** making sure it never accesses 'gclist' on userdata with no user values.
463** This structure here is used only to compute the correct size for
464** this representation. (The 'bindata' field in its end ensures correct
465** alignment for binary data following this header.)
466*/
467typedef struct Udata0 {
468 CommonHeader;
469 unsigned short nuvalue; /* number of user values */
470 size_t len; /* number of bytes */
471 struct Table *metatable;
472 union {LUAI_MAXALIGN;} bindata;
473} Udata0;
474
475
476/* compute the offset of the memory area of a userdata */
477#define udatamemoffset(nuv) \
478 ((nuv) == 0 ? offsetof(Udata0, bindata) \
479 : offsetof(Udata, uv) + (sizeof(UValue) * (nuv)))
480
481/* get the address of the memory block inside 'Udata' */
482#define getudatamem(u) (cast_charp(u) + udatamemoffset((u)->nuvalue))
483
484/* compute the size of a userdata */
485#define sizeudata(nuv,nb) (udatamemoffset(nuv) + (nb))
486
487/* }================================================================== */
488
489
490/*
491** {==================================================================
492** Prototypes
493** ===================================================================
494*/
495
496#define LUA_VPROTO makevariant(LUA_TPROTO, 0)
497
498
499/*
500** Description of an upvalue for function prototypes
501*/
502typedef struct Upvaldesc {
503 TString *name; /* upvalue name (for debug information) */
504 lu_byte instack; /* whether it is in stack (register) */
505 lu_byte idx; /* index of upvalue (in stack or in outer function's list) */
506 lu_byte kind; /* kind of corresponding variable */
507} Upvaldesc;
508
509
510/*
511** Description of a local variable for function prototypes
512** (used for debug information)
513*/
514typedef struct LocVar {
515 TString *varname;
516 int startpc; /* first point where variable is active */
517 int endpc; /* first point where variable is dead */
518} LocVar;
519
520
521/*
522** Associates the absolute line source for a given instruction ('pc').
523** The array 'lineinfo' gives, for each instruction, the difference in
524** lines from the previous instruction. When that difference does not
525** fit into a byte, Lua saves the absolute line for that instruction.
526** (Lua also saves the absolute line periodically, to speed up the
527** computation of a line number: we can use binary search in the
528** absolute-line array, but we must traverse the 'lineinfo' array
529** linearly to compute a line.)
530*/
531typedef struct AbsLineInfo {
532 int pc;
533 int line;
534} AbsLineInfo;
535
536/*
537** Function Prototypes
538*/
539typedef struct Proto {
540 CommonHeader;
541 lu_byte numparams; /* number of fixed (named) parameters */
542 lu_byte is_vararg;
543 lu_byte maxstacksize; /* number of registers needed by this function */
544 int sizeupvalues; /* size of 'upvalues' */
545 int sizek; /* size of 'k' */
546 int sizecode;
547 int sizelineinfo;
548 int sizep; /* size of 'p' */
549 int sizelocvars;
550 int sizeabslineinfo; /* size of 'abslineinfo' */
551 int linedefined; /* debug information */
552 int lastlinedefined; /* debug information */
553 TValue *k; /* constants used by the function */
554 Instruction *code; /* opcodes */
555 struct Proto **p; /* functions defined inside the function */
556 Upvaldesc *upvalues; /* upvalue information */
557 ls_byte *lineinfo; /* information about source lines (debug information) */
558 AbsLineInfo *abslineinfo; /* idem */
559 LocVar *locvars; /* information about local variables (debug information) */
560 TString *source; /* used for debug information */
561 GCObject *gclist;
562} Proto;
563
564/* }================================================================== */
565
566
567/*
568** {==================================================================
569** Functions
570** ===================================================================
571*/
572
573#define LUA_VUPVAL makevariant(LUA_TUPVAL, 0)
574
575
576/* Variant tags for functions */
577#define LUA_VLCL makevariant(LUA_TFUNCTION, 0) /* Lua closure */
578#define LUA_VLCF makevariant(LUA_TFUNCTION, 1) /* light C function */
579#define LUA_VCCL makevariant(LUA_TFUNCTION, 2) /* C closure */
580
581#define ttisfunction(o) checktype(o, LUA_TFUNCTION)
582#define ttisLclosure(o) checktag((o), ctb(LUA_VLCL))
583#define ttislcf(o) checktag((o), LUA_VLCF)
584#define ttisCclosure(o) checktag((o), ctb(LUA_VCCL))
585#define ttisclosure(o) (ttisLclosure(o) || ttisCclosure(o))
586
587
588#define isLfunction(o) ttisLclosure(o)
589
590#define clvalue(o) check_exp(ttisclosure(o), gco2cl(val_(o).gc))
591#define clLvalue(o) check_exp(ttisLclosure(o), gco2lcl(val_(o).gc))
592#define fvalue(o) check_exp(ttislcf(o), val_(o).f)
593#define clCvalue(o) check_exp(ttisCclosure(o), gco2ccl(val_(o).gc))
594
595#define fvalueraw(v) ((v).f)
596
597#define setclLvalue(L,obj,x) \
598 { TValue *io = (obj); LClosure *x_ = (x); \
599 val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_VLCL)); \
600 checkliveness(L,io); }
601
602#define setclLvalue2s(L,o,cl) setclLvalue(L,s2v(o),cl)
603
604#define setfvalue(obj,x) \
605 { TValue *io=(obj); val_(io).f=(x); settt_(io, LUA_VLCF); }
606
607#define setclCvalue(L,obj,x) \
608 { TValue *io = (obj); CClosure *x_ = (x); \
609 val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_VCCL)); \
610 checkliveness(L,io); }
611
612
613/*
614** Upvalues for Lua closures
615*/
616typedef struct UpVal {
617 CommonHeader;
618 lu_byte tbc; /* true if it represents a to-be-closed variable */
619 TValue *v; /* points to stack or to its own value */
620 union {
621 struct { /* (when open) */
622 struct UpVal *next; /* linked list */
623 struct UpVal **previous;
624 } open;
625 TValue value; /* the value (when closed) */
626 } u;
627} UpVal;
628
629
630
631#define ClosureHeader \
632 CommonHeader; lu_byte nupvalues; GCObject *gclist
633
634typedef struct CClosure {
635 ClosureHeader;
636 lua_CFunction f;
637 TValue upvalue[1]; /* list of upvalues */
638} CClosure;
639
640
641typedef struct LClosure {
642 ClosureHeader;
643 struct Proto *p;
644 UpVal *upvals[1]; /* list of upvalues */
645} LClosure;
646
647
648typedef union Closure {
649 CClosure c;
650 LClosure l;
651} Closure;
652
653
654#define getproto(o) (clLvalue(o)->p)
655
656/* }================================================================== */
657
658
659/*
660** {==================================================================
661** Tables
662** ===================================================================
663*/
664
665#define LUA_VTABLE makevariant(LUA_TTABLE, 0)
666
667#define ttistable(o) checktag((o), ctb(LUA_VTABLE))
668
669#define hvalue(o) check_exp(ttistable(o), gco2t(val_(o).gc))
670
671#define sethvalue(L,obj,x) \
672 { TValue *io = (obj); Table *x_ = (x); \
673 val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_VTABLE)); \
674 checkliveness(L,io); }
675
676#define sethvalue2s(L,o,h) sethvalue(L,s2v(o),h)
677
678
679/*
680** Nodes for Hash tables: A pack of two TValue's (key-value pairs)
681** plus a 'next' field to link colliding entries. The distribution
682** of the key's fields ('key_tt' and 'key_val') not forming a proper
683** 'TValue' allows for a smaller size for 'Node' both in 4-byte
684** and 8-byte alignments.
685*/
686typedef union Node {
687 struct NodeKey {
688 TValuefields; /* fields for value */
689 lu_byte key_tt; /* key type */
690 int next; /* for chaining */
691 Value key_val; /* key value */
692 } u;
693 TValue i_val; /* direct access to node's value as a proper 'TValue' */
694} Node;
695
696
697/* copy a value into a key */
698#define setnodekey(L,node,obj) \
699 { Node *n_=(node); const TValue *io_=(obj); \
700 n_->u.key_val = io_->value_; n_->u.key_tt = io_->tt_; \
701 checkliveness(L,io_); }
702
703
704/* copy a value from a key */
705#define getnodekey(L,obj,node) \
706 { TValue *io_=(obj); const Node *n_=(node); \
707 io_->value_ = n_->u.key_val; io_->tt_ = n_->u.key_tt; \
708 checkliveness(L,io_); }
709
710
711/*
712** About 'alimit': if 'isrealasize(t)' is true, then 'alimit' is the
713** real size of 'array'. Otherwise, the real size of 'array' is the
714** smallest power of two not smaller than 'alimit' (or zero iff 'alimit'
715** is zero); 'alimit' is then used as a hint for #t.
716*/
717
718#define BITRAS (1 << 7)
719#define isrealasize(t) (!((t)->flags & BITRAS))
720#define setrealasize(t) ((t)->flags &= cast_byte(~BITRAS))
721#define setnorealasize(t) ((t)->flags |= BITRAS)
722
723
724typedef struct Table {
725 CommonHeader;
726 lu_byte flags; /* 1<<p means tagmethod(p) is not present */
727 lu_byte lsizenode; /* log2 of size of 'node' array */
728 unsigned int alimit; /* "limit" of 'array' array */
729 TValue *array; /* array part */
730 Node *node;
731 Node *lastfree; /* any free position is before this position */
732 struct Table *metatable;
733 GCObject *gclist;
734} Table;
735
736
737/*
738** Macros to manipulate keys inserted in nodes
739*/
740#define keytt(node) ((node)->u.key_tt)
741#define keyval(node) ((node)->u.key_val)
742
743#define keyisnil(node) (keytt(node) == LUA_TNIL)
744#define keyisinteger(node) (keytt(node) == LUA_VNUMINT)
745#define keyival(node) (keyval(node).i)
746#define keyisshrstr(node) (keytt(node) == ctb(LUA_VSHRSTR))
747#define keystrval(node) (gco2ts(keyval(node).gc))
748
749#define setnilkey(node) (keytt(node) = LUA_TNIL)
750
751#define keyiscollectable(n) (keytt(n) & BIT_ISCOLLECTABLE)
752
753#define gckey(n) (keyval(n).gc)
754#define gckeyN(n) (keyiscollectable(n) ? gckey(n) : NULL)
755
756
757/*
758** Dead keys in tables have the tag DEADKEY but keep their original
759** gcvalue. This distinguishes them from regular keys but allows them to
760** be found when searched in a special way. ('next' needs that to find
761** keys removed from a table during a traversal.)
762*/
763#define setdeadkey(node) (keytt(node) = LUA_TDEADKEY)
764#define keyisdead(node) (keytt(node) == LUA_TDEADKEY)
765
766/* }================================================================== */
767
768
769
770/*
771** 'module' operation for hashing (size is always a power of 2)
772*/
773#define lmod(s,size) \
774 (check_exp((size&(size-1))==0, (cast_int((s) & ((size)-1)))))
775
776
777#define twoto(x) (1<<(x))
778#define sizenode(t) (twoto((t)->lsizenode))
779
780
781/* size of buffer for 'luaO_utf8esc' function */
782#define UTF8BUFFSZ 8
783
784LUAI_FUNC int luaO_utf8esc (char *buff, unsigned long x);
785LUAI_FUNC int luaO_ceillog2 (unsigned int x);
786LUAI_FUNC int luaO_rawarith (lua_State *L, int op, const TValue *p1,
787 const TValue *p2, TValue *res);
788LUAI_FUNC void luaO_arith (lua_State *L, int op, const TValue *p1,
789 const TValue *p2, StkId res);
790LUAI_FUNC size_t luaO_str2num (const char *s, TValue *o);
791LUAI_FUNC int luaO_hexavalue (int c);
792LUAI_FUNC void luaO_tostring (lua_State *L, TValue *obj);
793LUAI_FUNC const char *luaO_pushvfstring (lua_State *L, const char *fmt,
794 va_list argp);
795LUAI_FUNC const char *luaO_pushfstring (lua_State *L, const char *fmt, ...);
796LUAI_FUNC void luaO_chunkid (char *out, const char *source, size_t srclen);
797
798
799#endif
800
diff --git a/src/lua/lopcodes.c b/src/lua/lopcodes.c
deleted file mode 100644
index c67aa22..0000000
--- a/src/lua/lopcodes.c
+++ /dev/null
@@ -1,104 +0,0 @@
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
deleted file mode 100644
index d6a47e5..0000000
--- a/src/lua/lopcodes.h
+++ /dev/null
@@ -1,392 +0,0 @@
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]:number */
229OP_SUBK,/* A B C R[A] := R[B] - K[C]:number */
230OP_MULK,/* A B C R[A] := R[B] * K[C]:number */
231OP_MODK,/* A B C R[A] := R[B] % K[C]:number */
232OP_POWK,/* A B C R[A] := R[B] ^ K[C]:number */
233OP_DIVK,/* A B C R[A] := R[B] / K[C]:number */
234OP_IDIVK,/* A B C R[A] := R[B] // K[C]:number */
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] := #R[B] (length operator) */
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+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
deleted file mode 100644
index 965cec9..0000000
--- a/src/lua/lopnames.h
+++ /dev/null
@@ -1,103 +0,0 @@
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
deleted file mode 100644
index 3e20d62..0000000
--- a/src/lua/loslib.c
+++ /dev/null
@@ -1,430 +0,0 @@
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 (l_unlikely(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 (l_unlikely(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 (l_unlikely(t != LUA_TNIL)) /* some other value? */
257 return luaL_error(L, "field '%s' is not an integer", key);
258 else if (l_unlikely(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
deleted file mode 100644
index 284ef1f..0000000
--- a/src/lua/lparser.c
+++ /dev/null
@@ -1,1956 +0,0 @@
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 (l_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 its corresponding
226** register. For that, search for the highest variable below that level
227** that is in a register and uses its register index ('ridx') plus one.
228*/
229static int reglevel (FuncState *fs, int nvar) {
230 while (nvar-- > 0) {
231 Vardesc *vd = getlocalvardesc(fs, nvar); /* get previous variable */
232 if (vd->vd.kind != RDKCTC) /* is in a register? */
233 return vd->vd.ridx + 1;
234 }
235 return 0; /* no variables in registers */
236}
237
238
239/*
240** Return the number of variables in the register stack for the given
241** function.
242*/
243int luaY_nvarstack (FuncState *fs) {
244 return reglevel(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.ridx = getlocalvardesc(fs, vidx)->vd.ridx;
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 reglevel = 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.ridx = reglevel++;
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.ridx;
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#define enterlevel(ls) luaE_incCstack(ls->L)
493
494
495#define leavelevel(ls) ((ls)->L->nCcalls--)
496
497
498/*
499** Generates an error that a goto jumps into the scope of some
500** local variable.
501*/
502static l_noret jumpscopeerror (LexState *ls, Labeldesc *gt) {
503 const char *varname = getstr(getlocalvardesc(ls->fs, gt->nactvar)->vd.name);
504 const char *msg = "<goto %s> at line %d jumps into the scope of local '%s'";
505 msg = luaO_pushfstring(ls->L, msg, getstr(gt->name), gt->line, varname);
506 luaK_semerror(ls, msg); /* raise the error */
507}
508
509
510/*
511** Solves the goto at index 'g' to given 'label' and removes it
512** from the list of pending goto's.
513** If it jumps into the scope of some variable, raises an error.
514*/
515static void solvegoto (LexState *ls, int g, Labeldesc *label) {
516 int i;
517 Labellist *gl = &ls->dyd->gt; /* list of goto's */
518 Labeldesc *gt = &gl->arr[g]; /* goto to be resolved */
519 lua_assert(eqstr(gt->name, label->name));
520 if (l_unlikely(gt->nactvar < label->nactvar)) /* enter some scope? */
521 jumpscopeerror(ls, gt);
522 luaK_patchlist(ls->fs, gt->pc, label->pc);
523 for (i = g; i < gl->n - 1; i++) /* remove goto from pending list */
524 gl->arr[i] = gl->arr[i + 1];
525 gl->n--;
526}
527
528
529/*
530** Search for an active label with the given name.
531*/
532static Labeldesc *findlabel (LexState *ls, TString *name) {
533 int i;
534 Dyndata *dyd = ls->dyd;
535 /* check labels in current function for a match */
536 for (i = ls->fs->firstlabel; i < dyd->label.n; i++) {
537 Labeldesc *lb = &dyd->label.arr[i];
538 if (eqstr(lb->name, name)) /* correct label? */
539 return lb;
540 }
541 return NULL; /* label not found */
542}
543
544
545/*
546** Adds a new label/goto in the corresponding list.
547*/
548static int newlabelentry (LexState *ls, Labellist *l, TString *name,
549 int line, int pc) {
550 int n = l->n;
551 luaM_growvector(ls->L, l->arr, n, l->size,
552 Labeldesc, SHRT_MAX, "labels/gotos");
553 l->arr[n].name = name;
554 l->arr[n].line = line;
555 l->arr[n].nactvar = ls->fs->nactvar;
556 l->arr[n].close = 0;
557 l->arr[n].pc = pc;
558 l->n = n + 1;
559 return n;
560}
561
562
563static int newgotoentry (LexState *ls, TString *name, int line, int pc) {
564 return newlabelentry(ls, &ls->dyd->gt, name, line, pc);
565}
566
567
568/*
569** Solves forward jumps. Check whether new label 'lb' matches any
570** pending gotos in current block and solves them. Return true
571** if any of the goto's need to close upvalues.
572*/
573static int solvegotos (LexState *ls, Labeldesc *lb) {
574 Labellist *gl = &ls->dyd->gt;
575 int i = ls->fs->bl->firstgoto;
576 int needsclose = 0;
577 while (i < gl->n) {
578 if (eqstr(gl->arr[i].name, lb->name)) {
579 needsclose |= gl->arr[i].close;
580 solvegoto(ls, i, lb); /* will remove 'i' from the list */
581 }
582 else
583 i++;
584 }
585 return needsclose;
586}
587
588
589/*
590** Create a new label with the given 'name' at the given 'line'.
591** 'last' tells whether label is the last non-op statement in its
592** block. Solves all pending goto's to this new label and adds
593** a close instruction if necessary.
594** Returns true iff it added a close instruction.
595*/
596static int createlabel (LexState *ls, TString *name, int line,
597 int last) {
598 FuncState *fs = ls->fs;
599 Labellist *ll = &ls->dyd->label;
600 int l = newlabelentry(ls, ll, name, line, luaK_getlabel(fs));
601 if (last) { /* label is last no-op statement in the block? */
602 /* assume that locals are already out of scope */
603 ll->arr[l].nactvar = fs->bl->nactvar;
604 }
605 if (solvegotos(ls, &ll->arr[l])) { /* need close? */
606 luaK_codeABC(fs, OP_CLOSE, luaY_nvarstack(fs), 0, 0);
607 return 1;
608 }
609 return 0;
610}
611
612
613/*
614** Adjust pending gotos to outer level of a block.
615*/
616static void movegotosout (FuncState *fs, BlockCnt *bl) {
617 int i;
618 Labellist *gl = &fs->ls->dyd->gt;
619 /* correct pending gotos to current block */
620 for (i = bl->firstgoto; i < gl->n; i++) { /* for each pending goto */
621 Labeldesc *gt = &gl->arr[i];
622 /* leaving a variable scope? */
623 if (reglevel(fs, gt->nactvar) > reglevel(fs, bl->nactvar))
624 gt->close |= bl->upval; /* jump may need a close */
625 gt->nactvar = bl->nactvar; /* update goto level */
626 }
627}
628
629
630static void enterblock (FuncState *fs, BlockCnt *bl, lu_byte isloop) {
631 bl->isloop = isloop;
632 bl->nactvar = fs->nactvar;
633 bl->firstlabel = fs->ls->dyd->label.n;
634 bl->firstgoto = fs->ls->dyd->gt.n;
635 bl->upval = 0;
636 bl->insidetbc = (fs->bl != NULL && fs->bl->insidetbc);
637 bl->previous = fs->bl;
638 fs->bl = bl;
639 lua_assert(fs->freereg == luaY_nvarstack(fs));
640}
641
642
643/*
644** generates an error for an undefined 'goto'.
645*/
646static l_noret undefgoto (LexState *ls, Labeldesc *gt) {
647 const char *msg;
648 if (eqstr(gt->name, luaS_newliteral(ls->L, "break"))) {
649 msg = "break outside loop at line %d";
650 msg = luaO_pushfstring(ls->L, msg, gt->line);
651 }
652 else {
653 msg = "no visible label '%s' for <goto> at line %d";
654 msg = luaO_pushfstring(ls->L, msg, getstr(gt->name), gt->line);
655 }
656 luaK_semerror(ls, msg);
657}
658
659
660static void leaveblock (FuncState *fs) {
661 BlockCnt *bl = fs->bl;
662 LexState *ls = fs->ls;
663 int hasclose = 0;
664 int stklevel = reglevel(fs, bl->nactvar); /* level outside the block */
665 if (bl->isloop) /* fix pending breaks? */
666 hasclose = createlabel(ls, luaS_newliteral(ls->L, "break"), 0, 0);
667 if (!hasclose && bl->previous && bl->upval)
668 luaK_codeABC(fs, OP_CLOSE, stklevel, 0, 0);
669 fs->bl = bl->previous;
670 removevars(fs, bl->nactvar);
671 lua_assert(bl->nactvar == fs->nactvar);
672 fs->freereg = stklevel; /* free registers */
673 ls->dyd->label.n = bl->firstlabel; /* remove local labels */
674 if (bl->previous) /* inner block? */
675 movegotosout(fs, bl); /* update pending gotos to outer block */
676 else {
677 if (bl->firstgoto < ls->dyd->gt.n) /* pending gotos in outer block? */
678 undefgoto(ls, &ls->dyd->gt.arr[bl->firstgoto]); /* error */
679 }
680}
681
682
683/*
684** adds a new prototype into list of prototypes
685*/
686static Proto *addprototype (LexState *ls) {
687 Proto *clp;
688 lua_State *L = ls->L;
689 FuncState *fs = ls->fs;
690 Proto *f = fs->f; /* prototype of current function */
691 if (fs->np >= f->sizep) {
692 int oldsize = f->sizep;
693 luaM_growvector(L, f->p, fs->np, f->sizep, Proto *, MAXARG_Bx, "functions");
694 while (oldsize < f->sizep)
695 f->p[oldsize++] = NULL;
696 }
697 f->p[fs->np++] = clp = luaF_newproto(L);
698 luaC_objbarrier(L, f, clp);
699 return clp;
700}
701
702
703/*
704** codes instruction to create new closure in parent function.
705** The OP_CLOSURE instruction uses the last available register,
706** so that, if it invokes the GC, the GC knows which registers
707** are in use at that time.
708
709*/
710static void codeclosure (LexState *ls, expdesc *v) {
711 FuncState *fs = ls->fs->prev;
712 init_exp(v, VRELOC, luaK_codeABx(fs, OP_CLOSURE, 0, fs->np - 1));
713 luaK_exp2nextreg(fs, v); /* fix it at the last register */
714}
715
716
717static void open_func (LexState *ls, FuncState *fs, BlockCnt *bl) {
718 Proto *f = fs->f;
719 fs->prev = ls->fs; /* linked list of funcstates */
720 fs->ls = ls;
721 ls->fs = fs;
722 fs->pc = 0;
723 fs->previousline = f->linedefined;
724 fs->iwthabs = 0;
725 fs->lasttarget = 0;
726 fs->freereg = 0;
727 fs->nk = 0;
728 fs->nabslineinfo = 0;
729 fs->np = 0;
730 fs->nups = 0;
731 fs->ndebugvars = 0;
732 fs->nactvar = 0;
733 fs->needclose = 0;
734 fs->firstlocal = ls->dyd->actvar.n;
735 fs->firstlabel = ls->dyd->label.n;
736 fs->bl = NULL;
737 f->source = ls->source;
738 luaC_objbarrier(ls->L, f, f->source);
739 f->maxstacksize = 2; /* registers 0/1 are always valid */
740 enterblock(fs, bl, 0);
741}
742
743
744static void close_func (LexState *ls) {
745 lua_State *L = ls->L;
746 FuncState *fs = ls->fs;
747 Proto *f = fs->f;
748 luaK_ret(fs, luaY_nvarstack(fs), 0); /* final return */
749 leaveblock(fs);
750 lua_assert(fs->bl == NULL);
751 luaK_finish(fs);
752 luaM_shrinkvector(L, f->code, f->sizecode, fs->pc, Instruction);
753 luaM_shrinkvector(L, f->lineinfo, f->sizelineinfo, fs->pc, ls_byte);
754 luaM_shrinkvector(L, f->abslineinfo, f->sizeabslineinfo,
755 fs->nabslineinfo, AbsLineInfo);
756 luaM_shrinkvector(L, f->k, f->sizek, fs->nk, TValue);
757 luaM_shrinkvector(L, f->p, f->sizep, fs->np, Proto *);
758 luaM_shrinkvector(L, f->locvars, f->sizelocvars, fs->ndebugvars, LocVar);
759 luaM_shrinkvector(L, f->upvalues, f->sizeupvalues, fs->nups, Upvaldesc);
760 ls->fs = fs->prev;
761 luaC_checkGC(L);
762}
763
764
765
766/*============================================================*/
767/* GRAMMAR RULES */
768/*============================================================*/
769
770
771/*
772** check whether current token is in the follow set of a block.
773** 'until' closes syntactical blocks, but do not close scope,
774** so it is handled in separate.
775*/
776static int block_follow (LexState *ls, int withuntil) {
777 switch (ls->t.token) {
778 case TK_ELSE: case TK_ELSEIF:
779 case TK_END: case TK_EOS:
780 return 1;
781 case TK_UNTIL: return withuntil;
782 default: return 0;
783 }
784}
785
786
787static void statlist (LexState *ls) {
788 /* statlist -> { stat [';'] } */
789 while (!block_follow(ls, 1)) {
790 if (ls->t.token == TK_RETURN) {
791 statement(ls);
792 return; /* 'return' must be last statement */
793 }
794 statement(ls);
795 }
796}
797
798
799static void fieldsel (LexState *ls, expdesc *v) {
800 /* fieldsel -> ['.' | ':'] NAME */
801 FuncState *fs = ls->fs;
802 expdesc key;
803 luaK_exp2anyregup(fs, v);
804 luaX_next(ls); /* skip the dot or colon */
805 codename(ls, &key);
806 luaK_indexed(fs, v, &key);
807}
808
809
810static void yindex (LexState *ls, expdesc *v) {
811 /* index -> '[' expr ']' */
812 luaX_next(ls); /* skip the '[' */
813 expr(ls, v);
814 luaK_exp2val(ls->fs, v);
815 checknext(ls, ']');
816}
817
818
819/*
820** {======================================================================
821** Rules for Constructors
822** =======================================================================
823*/
824
825
826typedef struct ConsControl {
827 expdesc v; /* last list item read */
828 expdesc *t; /* table descriptor */
829 int nh; /* total number of 'record' elements */
830 int na; /* number of array elements already stored */
831 int tostore; /* number of array elements pending to be stored */
832} ConsControl;
833
834
835static void recfield (LexState *ls, ConsControl *cc) {
836 /* recfield -> (NAME | '['exp']') = exp */
837 FuncState *fs = ls->fs;
838 int reg = ls->fs->freereg;
839 expdesc tab, key, val;
840 if (ls->t.token == TK_NAME) {
841 checklimit(fs, cc->nh, MAX_INT, "items in a constructor");
842 codename(ls, &key);
843 }
844 else /* ls->t.token == '[' */
845 yindex(ls, &key);
846 cc->nh++;
847 checknext(ls, '=');
848 tab = *cc->t;
849 luaK_indexed(fs, &tab, &key);
850 expr(ls, &val);
851 luaK_storevar(fs, &tab, &val);
852 fs->freereg = reg; /* free registers */
853}
854
855
856static void closelistfield (FuncState *fs, ConsControl *cc) {
857 if (cc->v.k == VVOID) return; /* there is no list item */
858 luaK_exp2nextreg(fs, &cc->v);
859 cc->v.k = VVOID;
860 if (cc->tostore == LFIELDS_PER_FLUSH) {
861 luaK_setlist(fs, cc->t->u.info, cc->na, cc->tostore); /* flush */
862 cc->na += cc->tostore;
863 cc->tostore = 0; /* no more items pending */
864 }
865}
866
867
868static void lastlistfield (FuncState *fs, ConsControl *cc) {
869 if (cc->tostore == 0) return;
870 if (hasmultret(cc->v.k)) {
871 luaK_setmultret(fs, &cc->v);
872 luaK_setlist(fs, cc->t->u.info, cc->na, LUA_MULTRET);
873 cc->na--; /* do not count last expression (unknown number of elements) */
874 }
875 else {
876 if (cc->v.k != VVOID)
877 luaK_exp2nextreg(fs, &cc->v);
878 luaK_setlist(fs, cc->t->u.info, cc->na, cc->tostore);
879 }
880 cc->na += cc->tostore;
881}
882
883
884static void listfield (LexState *ls, ConsControl *cc) {
885 /* listfield -> exp */
886 expr(ls, &cc->v);
887 cc->tostore++;
888}
889
890
891static void field (LexState *ls, ConsControl *cc) {
892 /* field -> listfield | recfield */
893 switch(ls->t.token) {
894 case TK_NAME: { /* may be 'listfield' or 'recfield' */
895 if (luaX_lookahead(ls) != '=') /* expression? */
896 listfield(ls, cc);
897 else
898 recfield(ls, cc);
899 break;
900 }
901 case '[': {
902 recfield(ls, cc);
903 break;
904 }
905 default: {
906 listfield(ls, cc);
907 break;
908 }
909 }
910}
911
912
913static void constructor (LexState *ls, expdesc *t) {
914 /* constructor -> '{' [ field { sep field } [sep] ] '}'
915 sep -> ',' | ';' */
916 FuncState *fs = ls->fs;
917 int line = ls->linenumber;
918 int pc = luaK_codeABC(fs, OP_NEWTABLE, 0, 0, 0);
919 ConsControl cc;
920 luaK_code(fs, 0); /* space for extra arg. */
921 cc.na = cc.nh = cc.tostore = 0;
922 cc.t = t;
923 init_exp(t, VNONRELOC, fs->freereg); /* table will be at stack top */
924 luaK_reserveregs(fs, 1);
925 init_exp(&cc.v, VVOID, 0); /* no value (yet) */
926 checknext(ls, '{');
927 do {
928 lua_assert(cc.v.k == VVOID || cc.tostore > 0);
929 if (ls->t.token == '}') break;
930 closelistfield(fs, &cc);
931 field(ls, &cc);
932 } while (testnext(ls, ',') || testnext(ls, ';'));
933 check_match(ls, '}', '{', line);
934 lastlistfield(fs, &cc);
935 luaK_settablesize(fs, pc, t->u.info, cc.na, cc.nh);
936}
937
938/* }====================================================================== */
939
940
941static void setvararg (FuncState *fs, int nparams) {
942 fs->f->is_vararg = 1;
943 luaK_codeABC(fs, OP_VARARGPREP, nparams, 0, 0);
944}
945
946
947static void parlist (LexState *ls) {
948 /* parlist -> [ {NAME ','} (NAME | '...') ] */
949 FuncState *fs = ls->fs;
950 Proto *f = fs->f;
951 int nparams = 0;
952 int isvararg = 0;
953 if (ls->t.token != ')') { /* is 'parlist' not empty? */
954 do {
955 switch (ls->t.token) {
956 case TK_NAME: {
957 new_localvar(ls, str_checkname(ls));
958 nparams++;
959 break;
960 }
961 case TK_DOTS: {
962 luaX_next(ls);
963 isvararg = 1;
964 break;
965 }
966 default: luaX_syntaxerror(ls, "<name> or '...' expected");
967 }
968 } while (!isvararg && testnext(ls, ','));
969 }
970 adjustlocalvars(ls, nparams);
971 f->numparams = cast_byte(fs->nactvar);
972 if (isvararg)
973 setvararg(fs, f->numparams); /* declared vararg */
974 luaK_reserveregs(fs, fs->nactvar); /* reserve registers for parameters */
975}
976
977
978static void body (LexState *ls, expdesc *e, int ismethod, int line) {
979 /* body -> '(' parlist ')' block END */
980 FuncState new_fs;
981 BlockCnt bl;
982 new_fs.f = addprototype(ls);
983 new_fs.f->linedefined = line;
984 open_func(ls, &new_fs, &bl);
985 checknext(ls, '(');
986 if (ismethod) {
987 new_localvarliteral(ls, "self"); /* create 'self' parameter */
988 adjustlocalvars(ls, 1);
989 }
990 parlist(ls);
991 checknext(ls, ')');
992 statlist(ls);
993 new_fs.f->lastlinedefined = ls->linenumber;
994 check_match(ls, TK_END, TK_FUNCTION, line);
995 codeclosure(ls, e);
996 close_func(ls);
997}
998
999
1000static int explist (LexState *ls, expdesc *v) {
1001 /* explist -> expr { ',' expr } */
1002 int n = 1; /* at least one expression */
1003 expr(ls, v);
1004 while (testnext(ls, ',')) {
1005 luaK_exp2nextreg(ls->fs, v);
1006 expr(ls, v);
1007 n++;
1008 }
1009 return n;
1010}
1011
1012
1013static void funcargs (LexState *ls, expdesc *f, int line) {
1014 FuncState *fs = ls->fs;
1015 expdesc args;
1016 int base, nparams;
1017 switch (ls->t.token) {
1018 case '(': { /* funcargs -> '(' [ explist ] ')' */
1019 luaX_next(ls);
1020 if (ls->t.token == ')') /* arg list is empty? */
1021 args.k = VVOID;
1022 else {
1023 explist(ls, &args);
1024 if (hasmultret(args.k))
1025 luaK_setmultret(fs, &args);
1026 }
1027 check_match(ls, ')', '(', line);
1028 break;
1029 }
1030 case '{': { /* funcargs -> constructor */
1031 constructor(ls, &args);
1032 break;
1033 }
1034 case TK_STRING: { /* funcargs -> STRING */
1035 codestring(&args, ls->t.seminfo.ts);
1036 luaX_next(ls); /* must use 'seminfo' before 'next' */
1037 break;
1038 }
1039 default: {
1040 luaX_syntaxerror(ls, "function arguments expected");
1041 }
1042 }
1043 lua_assert(f->k == VNONRELOC);
1044 base = f->u.info; /* base register for call */
1045 if (hasmultret(args.k))
1046 nparams = LUA_MULTRET; /* open call */
1047 else {
1048 if (args.k != VVOID)
1049 luaK_exp2nextreg(fs, &args); /* close last argument */
1050 nparams = fs->freereg - (base+1);
1051 }
1052 init_exp(f, VCALL, luaK_codeABC(fs, OP_CALL, base, nparams+1, 2));
1053 luaK_fixline(fs, line);
1054 fs->freereg = base+1; /* call remove function and arguments and leaves
1055 (unless changed) one result */
1056}
1057
1058
1059
1060
1061/*
1062** {======================================================================
1063** Expression parsing
1064** =======================================================================
1065*/
1066
1067
1068static void primaryexp (LexState *ls, expdesc *v) {
1069 /* primaryexp -> NAME | '(' expr ')' */
1070 switch (ls->t.token) {
1071 case '(': {
1072 int line = ls->linenumber;
1073 luaX_next(ls);
1074 expr(ls, v);
1075 check_match(ls, ')', '(', line);
1076 luaK_dischargevars(ls->fs, v);
1077 return;
1078 }
1079 case TK_NAME: {
1080 singlevar(ls, v);
1081 return;
1082 }
1083 default: {
1084 luaX_syntaxerror(ls, "unexpected symbol");
1085 }
1086 }
1087}
1088
1089
1090static void suffixedexp (LexState *ls, expdesc *v) {
1091 /* suffixedexp ->
1092 primaryexp { '.' NAME | '[' exp ']' | ':' NAME funcargs | funcargs } */
1093 FuncState *fs = ls->fs;
1094 int line = ls->linenumber;
1095 primaryexp(ls, v);
1096 for (;;) {
1097 switch (ls->t.token) {
1098 case '.': { /* fieldsel */
1099 fieldsel(ls, v);
1100 break;
1101 }
1102 case '[': { /* '[' exp ']' */
1103 expdesc key;
1104 luaK_exp2anyregup(fs, v);
1105 yindex(ls, &key);
1106 luaK_indexed(fs, v, &key);
1107 break;
1108 }
1109 case ':': { /* ':' NAME funcargs */
1110 expdesc key;
1111 luaX_next(ls);
1112 codename(ls, &key);
1113 luaK_self(fs, v, &key);
1114 funcargs(ls, v, line);
1115 break;
1116 }
1117 case '(': case TK_STRING: case '{': { /* funcargs */
1118 luaK_exp2nextreg(fs, v);
1119 funcargs(ls, v, line);
1120 break;
1121 }
1122 default: return;
1123 }
1124 }
1125}
1126
1127
1128static void simpleexp (LexState *ls, expdesc *v) {
1129 /* simpleexp -> FLT | INT | STRING | NIL | TRUE | FALSE | ... |
1130 constructor | FUNCTION body | suffixedexp */
1131 switch (ls->t.token) {
1132 case TK_FLT: {
1133 init_exp(v, VKFLT, 0);
1134 v->u.nval = ls->t.seminfo.r;
1135 break;
1136 }
1137 case TK_INT: {
1138 init_exp(v, VKINT, 0);
1139 v->u.ival = ls->t.seminfo.i;
1140 break;
1141 }
1142 case TK_STRING: {
1143 codestring(v, ls->t.seminfo.ts);
1144 break;
1145 }
1146 case TK_NIL: {
1147 init_exp(v, VNIL, 0);
1148 break;
1149 }
1150 case TK_TRUE: {
1151 init_exp(v, VTRUE, 0);
1152 break;
1153 }
1154 case TK_FALSE: {
1155 init_exp(v, VFALSE, 0);
1156 break;
1157 }
1158 case TK_DOTS: { /* vararg */
1159 FuncState *fs = ls->fs;
1160 check_condition(ls, fs->f->is_vararg,
1161 "cannot use '...' outside a vararg function");
1162 init_exp(v, VVARARG, luaK_codeABC(fs, OP_VARARG, 0, 0, 1));
1163 break;
1164 }
1165 case '{': { /* constructor */
1166 constructor(ls, v);
1167 return;
1168 }
1169 case TK_FUNCTION: {
1170 luaX_next(ls);
1171 body(ls, v, 0, ls->linenumber);
1172 return;
1173 }
1174 default: {
1175 suffixedexp(ls, v);
1176 return;
1177 }
1178 }
1179 luaX_next(ls);
1180}
1181
1182
1183static UnOpr getunopr (int op) {
1184 switch (op) {
1185 case TK_NOT: return OPR_NOT;
1186 case '-': return OPR_MINUS;
1187 case '~': return OPR_BNOT;
1188 case '#': return OPR_LEN;
1189 default: return OPR_NOUNOPR;
1190 }
1191}
1192
1193
1194static BinOpr getbinopr (int op) {
1195 switch (op) {
1196 case '+': return OPR_ADD;
1197 case '-': return OPR_SUB;
1198 case '*': return OPR_MUL;
1199 case '%': return OPR_MOD;
1200 case '^': return OPR_POW;
1201 case '/': return OPR_DIV;
1202 case TK_IDIV: return OPR_IDIV;
1203 case '&': return OPR_BAND;
1204 case '|': return OPR_BOR;
1205 case '~': return OPR_BXOR;
1206 case TK_SHL: return OPR_SHL;
1207 case TK_SHR: return OPR_SHR;
1208 case TK_CONCAT: return OPR_CONCAT;
1209 case TK_NE: return OPR_NE;
1210 case TK_EQ: return OPR_EQ;
1211 case '<': return OPR_LT;
1212 case TK_LE: return OPR_LE;
1213 case '>': return OPR_GT;
1214 case TK_GE: return OPR_GE;
1215 case TK_AND: return OPR_AND;
1216 case TK_OR: return OPR_OR;
1217 default: return OPR_NOBINOPR;
1218 }
1219}
1220
1221
1222/*
1223** Priority table for binary operators.
1224*/
1225static const struct {
1226 lu_byte left; /* left priority for each binary operator */
1227 lu_byte right; /* right priority */
1228} priority[] = { /* ORDER OPR */
1229 {10, 10}, {10, 10}, /* '+' '-' */
1230 {11, 11}, {11, 11}, /* '*' '%' */
1231 {14, 13}, /* '^' (right associative) */
1232 {11, 11}, {11, 11}, /* '/' '//' */
1233 {6, 6}, {4, 4}, {5, 5}, /* '&' '|' '~' */
1234 {7, 7}, {7, 7}, /* '<<' '>>' */
1235 {9, 8}, /* '..' (right associative) */
1236 {3, 3}, {3, 3}, {3, 3}, /* ==, <, <= */
1237 {3, 3}, {3, 3}, {3, 3}, /* ~=, >, >= */
1238 {2, 2}, {1, 1} /* and, or */
1239};
1240
1241#define UNARY_PRIORITY 12 /* priority for unary operators */
1242
1243
1244/*
1245** subexpr -> (simpleexp | unop subexpr) { binop subexpr }
1246** where 'binop' is any binary operator with a priority higher than 'limit'
1247*/
1248static BinOpr subexpr (LexState *ls, expdesc *v, int limit) {
1249 BinOpr op;
1250 UnOpr uop;
1251 enterlevel(ls);
1252 uop = getunopr(ls->t.token);
1253 if (uop != OPR_NOUNOPR) { /* prefix (unary) operator? */
1254 int line = ls->linenumber;
1255 luaX_next(ls); /* skip operator */
1256 subexpr(ls, v, UNARY_PRIORITY);
1257 luaK_prefix(ls->fs, uop, v, line);
1258 }
1259 else simpleexp(ls, v);
1260 /* expand while operators have priorities higher than 'limit' */
1261 op = getbinopr(ls->t.token);
1262 while (op != OPR_NOBINOPR && priority[op].left > limit) {
1263 expdesc v2;
1264 BinOpr nextop;
1265 int line = ls->linenumber;
1266 luaX_next(ls); /* skip operator */
1267 luaK_infix(ls->fs, op, v);
1268 /* read sub-expression with higher priority */
1269 nextop = subexpr(ls, &v2, priority[op].right);
1270 luaK_posfix(ls->fs, op, v, &v2, line);
1271 op = nextop;
1272 }
1273 leavelevel(ls);
1274 return op; /* return first untreated operator */
1275}
1276
1277
1278static void expr (LexState *ls, expdesc *v) {
1279 subexpr(ls, v, 0);
1280}
1281
1282/* }==================================================================== */
1283
1284
1285
1286/*
1287** {======================================================================
1288** Rules for Statements
1289** =======================================================================
1290*/
1291
1292
1293static void block (LexState *ls) {
1294 /* block -> statlist */
1295 FuncState *fs = ls->fs;
1296 BlockCnt bl;
1297 enterblock(fs, &bl, 0);
1298 statlist(ls);
1299 leaveblock(fs);
1300}
1301
1302
1303/*
1304** structure to chain all variables in the left-hand side of an
1305** assignment
1306*/
1307struct LHS_assign {
1308 struct LHS_assign *prev;
1309 expdesc v; /* variable (global, local, upvalue, or indexed) */
1310};
1311
1312
1313/*
1314** check whether, in an assignment to an upvalue/local variable, the
1315** upvalue/local variable is begin used in a previous assignment to a
1316** table. If so, save original upvalue/local value in a safe place and
1317** use this safe copy in the previous assignment.
1318*/
1319static void check_conflict (LexState *ls, struct LHS_assign *lh, expdesc *v) {
1320 FuncState *fs = ls->fs;
1321 int extra = fs->freereg; /* eventual position to save local variable */
1322 int conflict = 0;
1323 for (; lh; lh = lh->prev) { /* check all previous assignments */
1324 if (vkisindexed(lh->v.k)) { /* assignment to table field? */
1325 if (lh->v.k == VINDEXUP) { /* is table an upvalue? */
1326 if (v->k == VUPVAL && lh->v.u.ind.t == v->u.info) {
1327 conflict = 1; /* table is the upvalue being assigned now */
1328 lh->v.k = VINDEXSTR;
1329 lh->v.u.ind.t = extra; /* assignment will use safe copy */
1330 }
1331 }
1332 else { /* table is a register */
1333 if (v->k == VLOCAL && lh->v.u.ind.t == v->u.var.ridx) {
1334 conflict = 1; /* table is the local being assigned now */
1335 lh->v.u.ind.t = extra; /* assignment will use safe copy */
1336 }
1337 /* is index the local being assigned? */
1338 if (lh->v.k == VINDEXED && v->k == VLOCAL &&
1339 lh->v.u.ind.idx == v->u.var.ridx) {
1340 conflict = 1;
1341 lh->v.u.ind.idx = extra; /* previous assignment will use safe copy */
1342 }
1343 }
1344 }
1345 }
1346 if (conflict) {
1347 /* copy upvalue/local value to a temporary (in position 'extra') */
1348 if (v->k == VLOCAL)
1349 luaK_codeABC(fs, OP_MOVE, extra, v->u.var.ridx, 0);
1350 else
1351 luaK_codeABC(fs, OP_GETUPVAL, extra, v->u.info, 0);
1352 luaK_reserveregs(fs, 1);
1353 }
1354}
1355
1356/*
1357** Parse and compile a multiple assignment. The first "variable"
1358** (a 'suffixedexp') was already read by the caller.
1359**
1360** assignment -> suffixedexp restassign
1361** restassign -> ',' suffixedexp restassign | '=' explist
1362*/
1363static void restassign (LexState *ls, struct LHS_assign *lh, int nvars) {
1364 expdesc e;
1365 check_condition(ls, vkisvar(lh->v.k), "syntax error");
1366 check_readonly(ls, &lh->v);
1367 if (testnext(ls, ',')) { /* restassign -> ',' suffixedexp restassign */
1368 struct LHS_assign nv;
1369 nv.prev = lh;
1370 suffixedexp(ls, &nv.v);
1371 if (!vkisindexed(nv.v.k))
1372 check_conflict(ls, lh, &nv.v);
1373 enterlevel(ls); /* control recursion depth */
1374 restassign(ls, &nv, nvars+1);
1375 leavelevel(ls);
1376 }
1377 else { /* restassign -> '=' explist */
1378 int nexps;
1379 checknext(ls, '=');
1380 nexps = explist(ls, &e);
1381 if (nexps != nvars)
1382 adjust_assign(ls, nvars, nexps, &e);
1383 else {
1384 luaK_setoneret(ls->fs, &e); /* close last expression */
1385 luaK_storevar(ls->fs, &lh->v, &e);
1386 return; /* avoid default */
1387 }
1388 }
1389 init_exp(&e, VNONRELOC, ls->fs->freereg-1); /* default assignment */
1390 luaK_storevar(ls->fs, &lh->v, &e);
1391}
1392
1393
1394static int cond (LexState *ls) {
1395 /* cond -> exp */
1396 expdesc v;
1397 expr(ls, &v); /* read condition */
1398 if (v.k == VNIL) v.k = VFALSE; /* 'falses' are all equal here */
1399 luaK_goiftrue(ls->fs, &v);
1400 return v.f;
1401}
1402
1403
1404static void gotostat (LexState *ls) {
1405 FuncState *fs = ls->fs;
1406 int line = ls->linenumber;
1407 TString *name = str_checkname(ls); /* label's name */
1408 Labeldesc *lb = findlabel(ls, name);
1409 if (lb == NULL) /* no label? */
1410 /* forward jump; will be resolved when the label is declared */
1411 newgotoentry(ls, name, line, luaK_jump(fs));
1412 else { /* found a label */
1413 /* backward jump; will be resolved here */
1414 int lblevel = reglevel(fs, lb->nactvar); /* label level */
1415 if (luaY_nvarstack(fs) > lblevel) /* leaving the scope of a variable? */
1416 luaK_codeABC(fs, OP_CLOSE, lblevel, 0, 0);
1417 /* create jump and link it to the label */
1418 luaK_patchlist(fs, luaK_jump(fs), lb->pc);
1419 }
1420}
1421
1422
1423/*
1424** Break statement. Semantically equivalent to "goto break".
1425*/
1426static void breakstat (LexState *ls) {
1427 int line = ls->linenumber;
1428 luaX_next(ls); /* skip break */
1429 newgotoentry(ls, luaS_newliteral(ls->L, "break"), line, luaK_jump(ls->fs));
1430}
1431
1432
1433/*
1434** Check whether there is already a label with the given 'name'.
1435*/
1436static void checkrepeated (LexState *ls, TString *name) {
1437 Labeldesc *lb = findlabel(ls, name);
1438 if (l_unlikely(lb != NULL)) { /* already defined? */
1439 const char *msg = "label '%s' already defined on line %d";
1440 msg = luaO_pushfstring(ls->L, msg, getstr(name), lb->line);
1441 luaK_semerror(ls, msg); /* error */
1442 }
1443}
1444
1445
1446static void labelstat (LexState *ls, TString *name, int line) {
1447 /* label -> '::' NAME '::' */
1448 checknext(ls, TK_DBCOLON); /* skip double colon */
1449 while (ls->t.token == ';' || ls->t.token == TK_DBCOLON)
1450 statement(ls); /* skip other no-op statements */
1451 checkrepeated(ls, name); /* check for repeated labels */
1452 createlabel(ls, name, line, block_follow(ls, 0));
1453}
1454
1455
1456static void whilestat (LexState *ls, int line) {
1457 /* whilestat -> WHILE cond DO block END */
1458 FuncState *fs = ls->fs;
1459 int whileinit;
1460 int condexit;
1461 BlockCnt bl;
1462 luaX_next(ls); /* skip WHILE */
1463 whileinit = luaK_getlabel(fs);
1464 condexit = cond(ls);
1465 enterblock(fs, &bl, 1);
1466 checknext(ls, TK_DO);
1467 block(ls);
1468 luaK_jumpto(fs, whileinit);
1469 check_match(ls, TK_END, TK_WHILE, line);
1470 leaveblock(fs);
1471 luaK_patchtohere(fs, condexit); /* false conditions finish the loop */
1472}
1473
1474
1475static void repeatstat (LexState *ls, int line) {
1476 /* repeatstat -> REPEAT block UNTIL cond */
1477 int condexit;
1478 FuncState *fs = ls->fs;
1479 int repeat_init = luaK_getlabel(fs);
1480 BlockCnt bl1, bl2;
1481 enterblock(fs, &bl1, 1); /* loop block */
1482 enterblock(fs, &bl2, 0); /* scope block */
1483 luaX_next(ls); /* skip REPEAT */
1484 statlist(ls);
1485 check_match(ls, TK_UNTIL, TK_REPEAT, line);
1486 condexit = cond(ls); /* read condition (inside scope block) */
1487 leaveblock(fs); /* finish scope */
1488 if (bl2.upval) { /* upvalues? */
1489 int exit = luaK_jump(fs); /* normal exit must jump over fix */
1490 luaK_patchtohere(fs, condexit); /* repetition must close upvalues */
1491 luaK_codeABC(fs, OP_CLOSE, reglevel(fs, bl2.nactvar), 0, 0);
1492 condexit = luaK_jump(fs); /* repeat after closing upvalues */
1493 luaK_patchtohere(fs, exit); /* normal exit comes to here */
1494 }
1495 luaK_patchlist(fs, condexit, repeat_init); /* close the loop */
1496 leaveblock(fs); /* finish loop */
1497}
1498
1499
1500/*
1501** Read an expression and generate code to put its results in next
1502** stack slot.
1503**
1504*/
1505static void exp1 (LexState *ls) {
1506 expdesc e;
1507 expr(ls, &e);
1508 luaK_exp2nextreg(ls->fs, &e);
1509 lua_assert(e.k == VNONRELOC);
1510}
1511
1512
1513/*
1514** Fix for instruction at position 'pc' to jump to 'dest'.
1515** (Jump addresses are relative in Lua). 'back' true means
1516** a back jump.
1517*/
1518static void fixforjump (FuncState *fs, int pc, int dest, int back) {
1519 Instruction *jmp = &fs->f->code[pc];
1520 int offset = dest - (pc + 1);
1521 if (back)
1522 offset = -offset;
1523 if (l_unlikely(offset > MAXARG_Bx))
1524 luaX_syntaxerror(fs->ls, "control structure too long");
1525 SETARG_Bx(*jmp, offset);
1526}
1527
1528
1529/*
1530** Generate code for a 'for' loop.
1531*/
1532static void forbody (LexState *ls, int base, int line, int nvars, int isgen) {
1533 /* forbody -> DO block */
1534 static const OpCode forprep[2] = {OP_FORPREP, OP_TFORPREP};
1535 static const OpCode forloop[2] = {OP_FORLOOP, OP_TFORLOOP};
1536 BlockCnt bl;
1537 FuncState *fs = ls->fs;
1538 int prep, endfor;
1539 checknext(ls, TK_DO);
1540 prep = luaK_codeABx(fs, forprep[isgen], base, 0);
1541 enterblock(fs, &bl, 0); /* scope for declared variables */
1542 adjustlocalvars(ls, nvars);
1543 luaK_reserveregs(fs, nvars);
1544 block(ls);
1545 leaveblock(fs); /* end of scope for declared variables */
1546 fixforjump(fs, prep, luaK_getlabel(fs), 0);
1547 if (isgen) { /* generic for? */
1548 luaK_codeABC(fs, OP_TFORCALL, base, 0, nvars);
1549 luaK_fixline(fs, line);
1550 }
1551 endfor = luaK_codeABx(fs, forloop[isgen], base, 0);
1552 fixforjump(fs, endfor, prep + 1, 1);
1553 luaK_fixline(fs, line);
1554}
1555
1556
1557static void fornum (LexState *ls, TString *varname, int line) {
1558 /* fornum -> NAME = exp,exp[,exp] forbody */
1559 FuncState *fs = ls->fs;
1560 int base = fs->freereg;
1561 new_localvarliteral(ls, "(for state)");
1562 new_localvarliteral(ls, "(for state)");
1563 new_localvarliteral(ls, "(for state)");
1564 new_localvar(ls, varname);
1565 checknext(ls, '=');
1566 exp1(ls); /* initial value */
1567 checknext(ls, ',');
1568 exp1(ls); /* limit */
1569 if (testnext(ls, ','))
1570 exp1(ls); /* optional step */
1571 else { /* default step = 1 */
1572 luaK_int(fs, fs->freereg, 1);
1573 luaK_reserveregs(fs, 1);
1574 }
1575 adjustlocalvars(ls, 3); /* control variables */
1576 forbody(ls, base, line, 1, 0);
1577}
1578
1579
1580static void forlist (LexState *ls, TString *indexname) {
1581 /* forlist -> NAME {,NAME} IN explist forbody */
1582 FuncState *fs = ls->fs;
1583 expdesc e;
1584 int nvars = 5; /* gen, state, control, toclose, 'indexname' */
1585 int line;
1586 int base = fs->freereg;
1587 /* create control variables */
1588 new_localvarliteral(ls, "(for state)");
1589 new_localvarliteral(ls, "(for state)");
1590 new_localvarliteral(ls, "(for state)");
1591 new_localvarliteral(ls, "(for state)");
1592 /* create declared variables */
1593 new_localvar(ls, indexname);
1594 while (testnext(ls, ',')) {
1595 new_localvar(ls, str_checkname(ls));
1596 nvars++;
1597 }
1598 checknext(ls, TK_IN);
1599 line = ls->linenumber;
1600 adjust_assign(ls, 4, explist(ls, &e), &e);
1601 adjustlocalvars(ls, 4); /* control variables */
1602 markupval(fs, fs->nactvar); /* last control var. must be closed */
1603 luaK_checkstack(fs, 3); /* extra space to call generator */
1604 forbody(ls, base, line, nvars - 4, 1);
1605}
1606
1607
1608static void forstat (LexState *ls, int line) {
1609 /* forstat -> FOR (fornum | forlist) END */
1610 FuncState *fs = ls->fs;
1611 TString *varname;
1612 BlockCnt bl;
1613 enterblock(fs, &bl, 1); /* scope for loop and control variables */
1614 luaX_next(ls); /* skip 'for' */
1615 varname = str_checkname(ls); /* first variable name */
1616 switch (ls->t.token) {
1617 case '=': fornum(ls, varname, line); break;
1618 case ',': case TK_IN: forlist(ls, varname); break;
1619 default: luaX_syntaxerror(ls, "'=' or 'in' expected");
1620 }
1621 check_match(ls, TK_END, TK_FOR, line);
1622 leaveblock(fs); /* loop scope ('break' jumps to this point) */
1623}
1624
1625
1626static void test_then_block (LexState *ls, int *escapelist) {
1627 /* test_then_block -> [IF | ELSEIF] cond THEN block */
1628 BlockCnt bl;
1629 FuncState *fs = ls->fs;
1630 expdesc v;
1631 int jf; /* instruction to skip 'then' code (if condition is false) */
1632 luaX_next(ls); /* skip IF or ELSEIF */
1633 expr(ls, &v); /* read condition */
1634 checknext(ls, TK_THEN);
1635 if (ls->t.token == TK_BREAK) { /* 'if x then break' ? */
1636 int line = ls->linenumber;
1637 luaK_goiffalse(ls->fs, &v); /* will jump if condition is true */
1638 luaX_next(ls); /* skip 'break' */
1639 enterblock(fs, &bl, 0); /* must enter block before 'goto' */
1640 newgotoentry(ls, luaS_newliteral(ls->L, "break"), line, v.t);
1641 while (testnext(ls, ';')) {} /* skip semicolons */
1642 if (block_follow(ls, 0)) { /* jump is the entire block? */
1643 leaveblock(fs);
1644 return; /* and that is it */
1645 }
1646 else /* must skip over 'then' part if condition is false */
1647 jf = luaK_jump(fs);
1648 }
1649 else { /* regular case (not a break) */
1650 luaK_goiftrue(ls->fs, &v); /* skip over block if condition is false */
1651 enterblock(fs, &bl, 0);
1652 jf = v.f;
1653 }
1654 statlist(ls); /* 'then' part */
1655 leaveblock(fs);
1656 if (ls->t.token == TK_ELSE ||
1657 ls->t.token == TK_ELSEIF) /* followed by 'else'/'elseif'? */
1658 luaK_concat(fs, escapelist, luaK_jump(fs)); /* must jump over it */
1659 luaK_patchtohere(fs, jf);
1660}
1661
1662
1663static void ifstat (LexState *ls, int line) {
1664 /* ifstat -> IF cond THEN block {ELSEIF cond THEN block} [ELSE block] END */
1665 FuncState *fs = ls->fs;
1666 int escapelist = NO_JUMP; /* exit list for finished parts */
1667 test_then_block(ls, &escapelist); /* IF cond THEN block */
1668 while (ls->t.token == TK_ELSEIF)
1669 test_then_block(ls, &escapelist); /* ELSEIF cond THEN block */
1670 if (testnext(ls, TK_ELSE))
1671 block(ls); /* 'else' part */
1672 check_match(ls, TK_END, TK_IF, line);
1673 luaK_patchtohere(fs, escapelist); /* patch escape list to 'if' end */
1674}
1675
1676
1677static void localfunc (LexState *ls) {
1678 expdesc b;
1679 FuncState *fs = ls->fs;
1680 int fvar = fs->nactvar; /* function's variable index */
1681 new_localvar(ls, str_checkname(ls)); /* new local variable */
1682 adjustlocalvars(ls, 1); /* enter its scope */
1683 body(ls, &b, 0, ls->linenumber); /* function created in next register */
1684 /* debug information will only see the variable after this point! */
1685 localdebuginfo(fs, fvar)->startpc = fs->pc;
1686}
1687
1688
1689static int getlocalattribute (LexState *ls) {
1690 /* ATTRIB -> ['<' Name '>'] */
1691 if (testnext(ls, '<')) {
1692 const char *attr = getstr(str_checkname(ls));
1693 checknext(ls, '>');
1694 if (strcmp(attr, "const") == 0)
1695 return RDKCONST; /* read-only variable */
1696 else if (strcmp(attr, "close") == 0)
1697 return RDKTOCLOSE; /* to-be-closed variable */
1698 else
1699 luaK_semerror(ls,
1700 luaO_pushfstring(ls->L, "unknown attribute '%s'", attr));
1701 }
1702 return VDKREG; /* regular variable */
1703}
1704
1705
1706static void checktoclose (LexState *ls, int level) {
1707 if (level != -1) { /* is there a to-be-closed variable? */
1708 FuncState *fs = ls->fs;
1709 markupval(fs, level + 1);
1710 fs->bl->insidetbc = 1; /* in the scope of a to-be-closed variable */
1711 luaK_codeABC(fs, OP_TBC, reglevel(fs, level), 0, 0);
1712 }
1713}
1714
1715
1716static void localstat (LexState *ls) {
1717 /* stat -> LOCAL NAME ATTRIB { ',' NAME ATTRIB } ['=' explist] */
1718 FuncState *fs = ls->fs;
1719 int toclose = -1; /* index of to-be-closed variable (if any) */
1720 Vardesc *var; /* last variable */
1721 int vidx, kind; /* index and kind of last variable */
1722 int nvars = 0;
1723 int nexps;
1724 expdesc e;
1725 do {
1726 vidx = new_localvar(ls, str_checkname(ls));
1727 kind = getlocalattribute(ls);
1728 getlocalvardesc(fs, vidx)->vd.kind = kind;
1729 if (kind == RDKTOCLOSE) { /* to-be-closed? */
1730 if (toclose != -1) /* one already present? */
1731 luaK_semerror(ls, "multiple to-be-closed variables in local list");
1732 toclose = fs->nactvar + nvars;
1733 }
1734 nvars++;
1735 } while (testnext(ls, ','));
1736 if (testnext(ls, '='))
1737 nexps = explist(ls, &e);
1738 else {
1739 e.k = VVOID;
1740 nexps = 0;
1741 }
1742 var = getlocalvardesc(fs, vidx); /* get last variable */
1743 if (nvars == nexps && /* no adjustments? */
1744 var->vd.kind == RDKCONST && /* last variable is const? */
1745 luaK_exp2const(fs, &e, &var->k)) { /* compile-time constant? */
1746 var->vd.kind = RDKCTC; /* variable is a compile-time constant */
1747 adjustlocalvars(ls, nvars - 1); /* exclude last variable */
1748 fs->nactvar++; /* but count it */
1749 }
1750 else {
1751 adjust_assign(ls, nvars, nexps, &e);
1752 adjustlocalvars(ls, nvars);
1753 }
1754 checktoclose(ls, toclose);
1755}
1756
1757
1758static int funcname (LexState *ls, expdesc *v) {
1759 /* funcname -> NAME {fieldsel} [':' NAME] */
1760 int ismethod = 0;
1761 singlevar(ls, v);
1762 while (ls->t.token == '.')
1763 fieldsel(ls, v);
1764 if (ls->t.token == ':') {
1765 ismethod = 1;
1766 fieldsel(ls, v);
1767 }
1768 return ismethod;
1769}
1770
1771
1772static void funcstat (LexState *ls, int line) {
1773 /* funcstat -> FUNCTION funcname body */
1774 int ismethod;
1775 expdesc v, b;
1776 luaX_next(ls); /* skip FUNCTION */
1777 ismethod = funcname(ls, &v);
1778 body(ls, &b, ismethod, line);
1779 luaK_storevar(ls->fs, &v, &b);
1780 luaK_fixline(ls->fs, line); /* definition "happens" in the first line */
1781}
1782
1783
1784static void exprstat (LexState *ls) {
1785 /* stat -> func | assignment */
1786 FuncState *fs = ls->fs;
1787 struct LHS_assign v;
1788 suffixedexp(ls, &v.v);
1789 if (ls->t.token == '=' || ls->t.token == ',') { /* stat -> assignment ? */
1790 v.prev = NULL;
1791 restassign(ls, &v, 1);
1792 }
1793 else { /* stat -> func */
1794 Instruction *inst;
1795 check_condition(ls, v.v.k == VCALL, "syntax error");
1796 inst = &getinstruction(fs, &v.v);
1797 SETARG_C(*inst, 1); /* call statement uses no results */
1798 }
1799}
1800
1801
1802static void retstat (LexState *ls) {
1803 /* stat -> RETURN [explist] [';'] */
1804 FuncState *fs = ls->fs;
1805 expdesc e;
1806 int nret; /* number of values being returned */
1807 int first = luaY_nvarstack(fs); /* first slot to be returned */
1808 if (block_follow(ls, 1) || ls->t.token == ';')
1809 nret = 0; /* return no values */
1810 else {
1811 nret = explist(ls, &e); /* optional return values */
1812 if (hasmultret(e.k)) {
1813 luaK_setmultret(fs, &e);
1814 if (e.k == VCALL && nret == 1 && !fs->bl->insidetbc) { /* tail call? */
1815 SET_OPCODE(getinstruction(fs,&e), OP_TAILCALL);
1816 lua_assert(GETARG_A(getinstruction(fs,&e)) == luaY_nvarstack(fs));
1817 }
1818 nret = LUA_MULTRET; /* return all values */
1819 }
1820 else {
1821 if (nret == 1) /* only one single value? */
1822 first = luaK_exp2anyreg(fs, &e); /* can use original slot */
1823 else { /* values must go to the top of the stack */
1824 luaK_exp2nextreg(fs, &e);
1825 lua_assert(nret == fs->freereg - first);
1826 }
1827 }
1828 }
1829 luaK_ret(fs, first, nret);
1830 testnext(ls, ';'); /* skip optional semicolon */
1831}
1832
1833
1834static void statement (LexState *ls) {
1835 int line = ls->linenumber; /* may be needed for error messages */
1836 enterlevel(ls);
1837 switch (ls->t.token) {
1838 case ';': { /* stat -> ';' (empty statement) */
1839 luaX_next(ls); /* skip ';' */
1840 break;
1841 }
1842 case TK_IF: { /* stat -> ifstat */
1843 ifstat(ls, line);
1844 break;
1845 }
1846 case TK_WHILE: { /* stat -> whilestat */
1847 whilestat(ls, line);
1848 break;
1849 }
1850 case TK_DO: { /* stat -> DO block END */
1851 luaX_next(ls); /* skip DO */
1852 block(ls);
1853 check_match(ls, TK_END, TK_DO, line);
1854 break;
1855 }
1856 case TK_FOR: { /* stat -> forstat */
1857 forstat(ls, line);
1858 break;
1859 }
1860 case TK_REPEAT: { /* stat -> repeatstat */
1861 repeatstat(ls, line);
1862 break;
1863 }
1864 case TK_FUNCTION: { /* stat -> funcstat */
1865 funcstat(ls, line);
1866 break;
1867 }
1868 case TK_LOCAL: { /* stat -> localstat */
1869 luaX_next(ls); /* skip LOCAL */
1870 if (testnext(ls, TK_FUNCTION)) /* local function? */
1871 localfunc(ls);
1872 else
1873 localstat(ls);
1874 break;
1875 }
1876 case TK_DBCOLON: { /* stat -> label */
1877 luaX_next(ls); /* skip double colon */
1878 labelstat(ls, str_checkname(ls), line);
1879 break;
1880 }
1881 case TK_RETURN: { /* stat -> retstat */
1882 luaX_next(ls); /* skip RETURN */
1883 retstat(ls);
1884 break;
1885 }
1886 case TK_BREAK: { /* stat -> breakstat */
1887 breakstat(ls);
1888 break;
1889 }
1890 case TK_GOTO: { /* stat -> 'goto' NAME */
1891 luaX_next(ls); /* skip 'goto' */
1892 gotostat(ls);
1893 break;
1894 }
1895 default: { /* stat -> func | assignment */
1896 exprstat(ls);
1897 break;
1898 }
1899 }
1900 lua_assert(ls->fs->f->maxstacksize >= ls->fs->freereg &&
1901 ls->fs->freereg >= luaY_nvarstack(ls->fs));
1902 ls->fs->freereg = luaY_nvarstack(ls->fs); /* free registers */
1903 leavelevel(ls);
1904}
1905
1906/* }====================================================================== */
1907
1908
1909/*
1910** compiles the main function, which is a regular vararg function with an
1911** upvalue named LUA_ENV
1912*/
1913static void mainfunc (LexState *ls, FuncState *fs) {
1914 BlockCnt bl;
1915 Upvaldesc *env;
1916 open_func(ls, fs, &bl);
1917 setvararg(fs, 0); /* main function is always declared vararg */
1918 env = allocupvalue(fs); /* ...set environment upvalue */
1919 env->instack = 1;
1920 env->idx = 0;
1921 env->kind = VDKREG;
1922 env->name = ls->envn;
1923 luaC_objbarrier(ls->L, fs->f, env->name);
1924 luaX_next(ls); /* read first token */
1925 statlist(ls); /* parse main body */
1926 check(ls, TK_EOS);
1927 close_func(ls);
1928}
1929
1930
1931LClosure *luaY_parser (lua_State *L, ZIO *z, Mbuffer *buff,
1932 Dyndata *dyd, const char *name, int firstchar) {
1933 LexState lexstate;
1934 FuncState funcstate;
1935 LClosure *cl = luaF_newLclosure(L, 1); /* create main closure */
1936 setclLvalue2s(L, L->top, cl); /* anchor it (to avoid being collected) */
1937 luaD_inctop(L);
1938 lexstate.h = luaH_new(L); /* create table for scanner */
1939 sethvalue2s(L, L->top, lexstate.h); /* anchor it */
1940 luaD_inctop(L);
1941 funcstate.f = cl->p = luaF_newproto(L);
1942 luaC_objbarrier(L, cl, cl->p);
1943 funcstate.f->source = luaS_new(L, name); /* create and anchor TString */
1944 luaC_objbarrier(L, funcstate.f, funcstate.f->source);
1945 lexstate.buff = buff;
1946 lexstate.dyd = dyd;
1947 dyd->actvar.n = dyd->gt.n = dyd->label.n = 0;
1948 luaX_setinput(L, &lexstate, z, funcstate.f->source, firstchar);
1949 mainfunc(&lexstate, &funcstate);
1950 lua_assert(!funcstate.prev && funcstate.nups == 1 && !lexstate.fs);
1951 /* all scopes should be correctly finished */
1952 lua_assert(dyd->actvar.n == 0 && dyd->gt.n == 0 && dyd->label.n == 0);
1953 L->top--; /* remove scanner's table */
1954 return cl; /* closure is on the stack, too */
1955}
1956
diff --git a/src/lua/lparser.h b/src/lua/lparser.h
deleted file mode 100644
index 5e4500f..0000000
--- a/src/lua/lparser.h
+++ /dev/null
@@ -1,171 +0,0 @@
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 of 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.ridx = register index;
39 var.vidx = relative index in 'actvar.arr' */
40 VUPVAL, /* upvalue variable; info = index of upvalue in 'upvalues' */
41 VCONST, /* compile-time <const> variable;
42 info = absolute index in 'actvar.arr' */
43 VINDEXED, /* indexed variable;
44 ind.t = table register;
45 ind.idx = key's R index */
46 VINDEXUP, /* indexed upvalue;
47 ind.t = table upvalue;
48 ind.idx = key's K index */
49 VINDEXI, /* indexed variable with constant integer;
50 ind.t = table register;
51 ind.idx = key's value */
52 VINDEXSTR, /* indexed variable with literal string;
53 ind.t = table register;
54 ind.idx = key's K index */
55 VJMP, /* expression is a test/comparison;
56 info = pc of corresponding jump instruction */
57 VRELOC, /* expression can put result in any register;
58 info = instruction pc */
59 VCALL, /* expression is a function call; info = instruction pc */
60 VVARARG /* vararg expression; info = instruction pc */
61} expkind;
62
63
64#define vkisvar(k) (VLOCAL <= (k) && (k) <= VINDEXSTR)
65#define vkisindexed(k) (VINDEXED <= (k) && (k) <= VINDEXSTR)
66
67
68typedef struct expdesc {
69 expkind k;
70 union {
71 lua_Integer ival; /* for VKINT */
72 lua_Number nval; /* for VKFLT */
73 TString *strval; /* for VKSTR */
74 int info; /* for generic use */
75 struct { /* for indexed variables */
76 short idx; /* index (R or "long" K) */
77 lu_byte t; /* table (register or upvalue) */
78 } ind;
79 struct { /* for local variables */
80 lu_byte ridx; /* register holding the variable */
81 unsigned short vidx; /* compiler index (in 'actvar.arr') */
82 } var;
83 } u;
84 int t; /* patch list of 'exit when true' */
85 int f; /* patch list of 'exit when false' */
86} expdesc;
87
88
89/* kinds of variables */
90#define VDKREG 0 /* regular */
91#define RDKCONST 1 /* constant */
92#define RDKTOCLOSE 2 /* to-be-closed */
93#define RDKCTC 3 /* compile-time constant */
94
95/* description of an active local variable */
96typedef union Vardesc {
97 struct {
98 TValuefields; /* constant value (if it is a compile-time constant) */
99 lu_byte kind;
100 lu_byte ridx; /* register holding the variable */
101 short pidx; /* index of the variable in the Proto's 'locvars' array */
102 TString *name; /* variable name */
103 } vd;
104 TValue k; /* constant value (if any) */
105} Vardesc;
106
107
108
109/* description of pending goto statements and label statements */
110typedef struct Labeldesc {
111 TString *name; /* label identifier */
112 int pc; /* position in code */
113 int line; /* line where it appeared */
114 lu_byte nactvar; /* number of active variables in that position */
115 lu_byte close; /* goto that escapes upvalues */
116} Labeldesc;
117
118
119/* list of labels or gotos */
120typedef struct Labellist {
121 Labeldesc *arr; /* array */
122 int n; /* number of entries in use */
123 int size; /* array size */
124} Labellist;
125
126
127/* dynamic structures used by the parser */
128typedef struct Dyndata {
129 struct { /* list of all active local variables */
130 Vardesc *arr;
131 int n;
132 int size;
133 } actvar;
134 Labellist gt; /* list of pending gotos */
135 Labellist label; /* list of active labels */
136} Dyndata;
137
138
139/* control of blocks */
140struct BlockCnt; /* defined in lparser.c */
141
142
143/* state needed to generate code for a given function */
144typedef struct FuncState {
145 Proto *f; /* current function header */
146 struct FuncState *prev; /* enclosing function */
147 struct LexState *ls; /* lexical state */
148 struct BlockCnt *bl; /* chain of current blocks */
149 int pc; /* next position to code (equivalent to 'ncode') */
150 int lasttarget; /* 'label' of last 'jump label' */
151 int previousline; /* last line that was saved in 'lineinfo' */
152 int nk; /* number of elements in 'k' */
153 int np; /* number of elements in 'p' */
154 int nabslineinfo; /* number of elements in 'abslineinfo' */
155 int firstlocal; /* index of first local var (in Dyndata array) */
156 int firstlabel; /* index of first label (in 'dyd->label->arr') */
157 short ndebugvars; /* number of elements in 'f->locvars' */
158 lu_byte nactvar; /* number of active local variables */
159 lu_byte nups; /* number of upvalues */
160 lu_byte freereg; /* first free register */
161 lu_byte iwthabs; /* instructions issued since last absolute line info */
162 lu_byte needclose; /* function needs to close upvalues when returning */
163} FuncState;
164
165
166LUAI_FUNC int luaY_nvarstack (FuncState *fs);
167LUAI_FUNC LClosure *luaY_parser (lua_State *L, ZIO *z, Mbuffer *buff,
168 Dyndata *dyd, const char *name, int firstchar);
169
170
171#endif
diff --git a/src/lua/lprefix.h b/src/lua/lprefix.h
deleted file mode 100644
index 484f2ad..0000000
--- a/src/lua/lprefix.h
+++ /dev/null
@@ -1,45 +0,0 @@
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
deleted file mode 100644
index c5e3b43..0000000
--- a/src/lua/lstate.c
+++ /dev/null
@@ -1,439 +0,0 @@
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);
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 UNUSED(L); UNUSED(limit);
101 return LUAI_MAXCCALLS; /* warning?? */
102}
103
104
105CallInfo *luaE_extendCI (lua_State *L) {
106 CallInfo *ci;
107 lua_assert(L->ci->next == NULL);
108 ci = luaM_new(L, CallInfo);
109 lua_assert(L->ci->next == NULL);
110 L->ci->next = ci;
111 ci->previous = L->ci;
112 ci->next = NULL;
113 ci->u.l.trap = 0;
114 L->nci++;
115 return ci;
116}
117
118
119/*
120** free all CallInfo structures not in use by a thread
121*/
122void luaE_freeCI (lua_State *L) {
123 CallInfo *ci = L->ci;
124 CallInfo *next = ci->next;
125 ci->next = NULL;
126 while ((ci = next) != NULL) {
127 next = ci->next;
128 luaM_free(L, ci);
129 L->nci--;
130 }
131}
132
133
134/*
135** free half of the CallInfo structures not in use by a thread,
136** keeping the first one.
137*/
138void luaE_shrinkCI (lua_State *L) {
139 CallInfo *ci = L->ci->next; /* first free CallInfo */
140 CallInfo *next;
141 if (ci == NULL)
142 return; /* no extra elements */
143 while ((next = ci->next) != NULL) { /* two extra elements? */
144 CallInfo *next2 = next->next; /* next's next */
145 ci->next = next2; /* remove next from the list */
146 L->nci--;
147 luaM_free(L, next); /* free next */
148 if (next2 == NULL)
149 break; /* no more elements */
150 else {
151 next2->previous = ci;
152 ci = next2; /* continue */
153 }
154 }
155}
156
157
158/*
159** Called when 'getCcalls(L)' larger or equal to LUAI_MAXCCALLS.
160** If equal, raises an overflow error. If value is larger than
161** LUAI_MAXCCALLS (which means it is handling an overflow) but
162** not much larger, does not report an error (to allow overflow
163** handling to work).
164*/
165void luaE_checkcstack (lua_State *L) {
166 if (getCcalls(L) == LUAI_MAXCCALLS)
167 luaG_runerror(L, "C stack overflow");
168 else if (getCcalls(L) >= (LUAI_MAXCCALLS / 10 * 11))
169 luaD_throw(L, LUA_ERRERR); /* error while handing stack error */
170}
171
172
173LUAI_FUNC void luaE_incCstack (lua_State *L) {
174 L->nCcalls++;
175 if (l_unlikely(getCcalls(L) >= LUAI_MAXCCALLS))
176 luaE_checkcstack(L);
177}
178
179
180static void stack_init (lua_State *L1, lua_State *L) {
181 int i; CallInfo *ci;
182 /* initialize stack array */
183 L1->stack = luaM_newvector(L, BASIC_STACK_SIZE + EXTRA_STACK, StackValue);
184 L1->tbclist = L1->stack;
185 for (i = 0; i < BASIC_STACK_SIZE + EXTRA_STACK; i++)
186 setnilvalue(s2v(L1->stack + i)); /* erase new stack */
187 L1->top = L1->stack;
188 L1->stack_last = L1->stack + BASIC_STACK_SIZE;
189 /* initialize first ci */
190 ci = &L1->base_ci;
191 ci->next = ci->previous = NULL;
192 ci->callstatus = CIST_C;
193 ci->func = L1->top;
194 ci->u.c.k = NULL;
195 ci->nresults = 0;
196 setnilvalue(s2v(L1->top)); /* 'function' entry for this 'ci' */
197 L1->top++;
198 ci->top = L1->top + LUA_MINSTACK;
199 L1->ci = ci;
200}
201
202
203static void freestack (lua_State *L) {
204 if (L->stack == NULL)
205 return; /* stack not completely built yet */
206 L->ci = &L->base_ci; /* free the entire 'ci' list */
207 luaE_freeCI(L);
208 lua_assert(L->nci == 0);
209 luaM_freearray(L, L->stack, stacksize(L) + EXTRA_STACK); /* free stack */
210}
211
212
213/*
214** Create registry table and its predefined values
215*/
216static void init_registry (lua_State *L, global_State *g) {
217 /* create registry */
218 Table *registry = luaH_new(L);
219 sethvalue(L, &g->l_registry, registry);
220 luaH_resize(L, registry, LUA_RIDX_LAST, 0);
221 /* registry[LUA_RIDX_MAINTHREAD] = L */
222 setthvalue(L, &registry->array[LUA_RIDX_MAINTHREAD - 1], L);
223 /* registry[LUA_RIDX_GLOBALS] = new table (table of globals) */
224 sethvalue(L, &registry->array[LUA_RIDX_GLOBALS - 1], luaH_new(L));
225}
226
227
228/*
229** open parts of the state that may cause memory-allocation errors.
230*/
231static void f_luaopen (lua_State *L, void *ud) {
232 global_State *g = G(L);
233 UNUSED(ud);
234 stack_init(L, L); /* init stack */
235 init_registry(L, g);
236 luaS_init(L);
237 luaT_init(L);
238 luaX_init(L);
239 g->gcrunning = 1; /* allow gc */
240 setnilvalue(&g->nilvalue); /* now state is complete */
241 luai_userstateopen(L);
242}
243
244
245/*
246** preinitialize a thread with consistent values without allocating
247** any memory (to avoid errors)
248*/
249static void preinit_thread (lua_State *L, global_State *g) {
250 G(L) = g;
251 L->stack = NULL;
252 L->ci = NULL;
253 L->nci = 0;
254 L->twups = L; /* thread has no upvalues */
255 L->nCcalls = 0;
256 L->errorJmp = NULL;
257 L->hook = NULL;
258 L->hookmask = 0;
259 L->basehookcount = 0;
260 L->allowhook = 1;
261 resethookcount(L);
262 L->openupval = NULL;
263 L->status = LUA_OK;
264 L->errfunc = 0;
265 L->oldpc = 0;
266}
267
268
269static void close_state (lua_State *L) {
270 global_State *g = G(L);
271 if (!completestate(g)) /* closing a partially built state? */
272 luaC_freeallobjects(L); /* jucst collect its objects */
273 else { /* closing a fully built state */
274 luaD_closeprotected(L, 1, LUA_OK); /* close all upvalues */
275 luaC_freeallobjects(L); /* collect all objects */
276 luai_userstateclose(L);
277 }
278 luaM_freearray(L, G(L)->strt.hash, G(L)->strt.size);
279 freestack(L);
280 lua_assert(gettotalbytes(g) == sizeof(LG));
281 (*g->frealloc)(g->ud, fromstate(L), sizeof(LG), 0); /* free main block */
282}
283
284
285LUA_API lua_State *lua_newthread (lua_State *L) {
286 global_State *g;
287 lua_State *L1;
288 lua_lock(L);
289 g = G(L);
290 luaC_checkGC(L);
291 /* create new thread */
292 L1 = &cast(LX *, luaM_newobject(L, LUA_TTHREAD, sizeof(LX)))->l;
293 L1->marked = luaC_white(g);
294 L1->tt = LUA_VTHREAD;
295 /* link it on list 'allgc' */
296 L1->next = g->allgc;
297 g->allgc = obj2gco(L1);
298 /* anchor it on L stack */
299 setthvalue2s(L, L->top, L1);
300 api_incr_top(L);
301 preinit_thread(L1, g);
302 L1->hookmask = L->hookmask;
303 L1->basehookcount = L->basehookcount;
304 L1->hook = L->hook;
305 resethookcount(L1);
306 /* initialize L1 extra space */
307 memcpy(lua_getextraspace(L1), lua_getextraspace(g->mainthread),
308 LUA_EXTRASPACE);
309 luai_userstatethread(L, L1);
310 stack_init(L1, L); /* init stack */
311 lua_unlock(L);
312 return L1;
313}
314
315
316void luaE_freethread (lua_State *L, lua_State *L1) {
317 LX *l = fromstate(L1);
318 luaF_closeupval(L1, L1->stack); /* close all upvalues */
319 lua_assert(L1->openupval == NULL);
320 luai_userstatefree(L, L1);
321 freestack(L1);
322 luaM_free(L, l);
323}
324
325
326int luaE_resetthread (lua_State *L, int status) {
327 CallInfo *ci = L->ci = &L->base_ci; /* unwind CallInfo list */
328 setnilvalue(s2v(L->stack)); /* 'function' entry for basic 'ci' */
329 ci->func = L->stack;
330 ci->callstatus = CIST_C;
331 if (status == LUA_YIELD)
332 status = LUA_OK;
333 status = luaD_closeprotected(L, 1, status);
334 if (status != LUA_OK) /* errors? */
335 luaD_seterrorobj(L, status, L->stack + 1);
336 else
337 L->top = L->stack + 1;
338 ci->top = L->top + LUA_MINSTACK;
339 L->status = cast_byte(status);
340 luaD_reallocstack(L, cast_int(ci->top - L->stack), 0);
341 return status;
342}
343
344
345LUA_API int lua_resetthread (lua_State *L) {
346 int status;
347 lua_lock(L);
348 status = luaE_resetthread(L, L->status);
349 lua_unlock(L);
350 return status;
351}
352
353
354LUA_API lua_State *lua_newstate (lua_Alloc f, void *ud) {
355 int i;
356 lua_State *L;
357 global_State *g;
358 LG *l = cast(LG *, (*f)(ud, NULL, LUA_TTHREAD, sizeof(LG)));
359 if (l == NULL) return NULL;
360 L = &l->l.l;
361 g = &l->g;
362 L->tt = LUA_VTHREAD;
363 g->currentwhite = bitmask(WHITE0BIT);
364 L->marked = luaC_white(g);
365 preinit_thread(L, g);
366 g->allgc = obj2gco(L); /* by now, only object is the main thread */
367 L->next = NULL;
368 incnny(L); /* main thread is always non yieldable */
369 g->frealloc = f;
370 g->ud = ud;
371 g->warnf = NULL;
372 g->ud_warn = NULL;
373 g->mainthread = L;
374 g->seed = luai_makeseed(L);
375 g->gcrunning = 0; /* no GC while building state */
376 g->strt.size = g->strt.nuse = 0;
377 g->strt.hash = NULL;
378 setnilvalue(&g->l_registry);
379 g->panic = NULL;
380 g->gcstate = GCSpause;
381 g->gckind = KGC_INC;
382 g->gcstopem = 0;
383 g->gcemergency = 0;
384 g->finobj = g->tobefnz = g->fixedgc = NULL;
385 g->firstold1 = g->survival = g->old1 = g->reallyold = NULL;
386 g->finobjsur = g->finobjold1 = g->finobjrold = NULL;
387 g->sweepgc = NULL;
388 g->gray = g->grayagain = NULL;
389 g->weak = g->ephemeron = g->allweak = NULL;
390 g->twups = NULL;
391 g->totalbytes = sizeof(LG);
392 g->GCdebt = 0;
393 g->lastatomic = 0;
394 setivalue(&g->nilvalue, 0); /* to signal that state is not yet built */
395 setgcparam(g->gcpause, LUAI_GCPAUSE);
396 setgcparam(g->gcstepmul, LUAI_GCMUL);
397 g->gcstepsize = LUAI_GCSTEPSIZE;
398 setgcparam(g->genmajormul, LUAI_GENMAJORMUL);
399 g->genminormul = LUAI_GENMINORMUL;
400 for (i=0; i < LUA_NUMTAGS; i++) g->mt[i] = NULL;
401 if (luaD_rawrunprotected(L, f_luaopen, NULL) != LUA_OK) {
402 /* memory allocation error: free partial state */
403 close_state(L);
404 L = NULL;
405 }
406 return L;
407}
408
409
410LUA_API void lua_close (lua_State *L) {
411 lua_lock(L);
412 L = G(L)->mainthread; /* only the main thread can be closed */
413 close_state(L);
414}
415
416
417void luaE_warning (lua_State *L, const char *msg, int tocont) {
418 lua_WarnFunction wf = G(L)->warnf;
419 if (wf != NULL)
420 wf(G(L)->ud_warn, msg, tocont);
421}
422
423
424/*
425** Generate a warning from an error message
426*/
427void luaE_warnerror (lua_State *L, const char *where) {
428 TValue *errobj = s2v(L->top - 1); /* error object */
429 const char *msg = (ttisstring(errobj))
430 ? svalue(errobj)
431 : "error object is not a string";
432 /* produce warning "error in %s (%s)" (where, msg) */
433 luaE_warning(L, "error in ", 1);
434 luaE_warning(L, where, 1);
435 luaE_warning(L, " (", 1);
436 luaE_warning(L, msg, 1);
437 luaE_warning(L, ")", 0);
438}
439
diff --git a/src/lua/lstate.h b/src/lua/lstate.h
deleted file mode 100644
index c1283bb..0000000
--- a/src/lua/lstate.h
+++ /dev/null
@@ -1,404 +0,0 @@
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** 'old1' -> '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' -> 'finobjold1': survived """";
40** 'finobjold1' -> 'finobjrold': just old """";
41** 'finobjrold' -> NULL: really old """".
42**
43** All lists can contain elements older than their main ages, due
44** to 'luaC_checkfinalizer' and 'udata2finalize', which move
45** objects between the normal lists and the "marked for finalization"
46** lists. Moreover, barriers can age young objects in young lists as
47** OLD0, which then become OLD1. However, a list never contains
48** elements younger than their main ages.
49**
50** The generational collector also uses a pointer 'firstold1', which
51** points to the first OLD1 object in the list. It is used to optimize
52** 'markold'. (Potentially OLD1 objects can be anywhere between 'allgc'
53** and 'reallyold', but often the list has no OLD1 objects or they are
54** after 'old1'.) Note the difference between it and 'old1':
55** 'firstold1': no OLD1 objects before this point; there can be all
56** ages after it.
57** 'old1': no objects younger than OLD1 after this point.
58*/
59
60/*
61** Moreover, there is another set of lists that control gray objects.
62** These lists are linked by fields 'gclist'. (All objects that
63** can become gray have such a field. The field is not the same
64** in all objects, but it always has this name.) Any gray object
65** must belong to one of these lists, and all objects in these lists
66** must be gray (with two exceptions explained below):
67**
68** 'gray': regular gray objects, still waiting to be visited.
69** 'grayagain': objects that must be revisited at the atomic phase.
70** That includes
71** - black objects got in a write barrier;
72** - all kinds of weak tables during propagation phase;
73** - all threads.
74** 'weak': tables with weak values to be cleared;
75** 'ephemeron': ephemeron tables with white->white entries;
76** 'allweak': tables with weak keys and/or weak values to be cleared.
77**
78** The exceptions to that "gray rule" are:
79** - TOUCHED2 objects in generational mode stay in a gray list (because
80** they must be visited again at the end of the cycle), but they are
81** marked black because assignments to them must activate barriers (to
82** move them back to TOUCHED1).
83** - Open upvales are kept gray to avoid barriers, but they stay out
84** of gray lists. (They don't even have a 'gclist' field.)
85*/
86
87
88
89/*
90** About 'nCcalls': This count has two parts: the lower 16 bits counts
91** the number of recursive invocations in the C stack; the higher
92** 16 bits counts the number of non-yieldable calls in the stack.
93** (They are together so that we can change and save both with one
94** instruction.)
95*/
96
97
98/* true if this thread does not have non-yieldable calls in the stack */
99#define yieldable(L) (((L)->nCcalls & 0xffff0000) == 0)
100
101/* real number of C calls */
102#define getCcalls(L) ((L)->nCcalls & 0xffff)
103
104
105/* Increment the number of non-yieldable calls */
106#define incnny(L) ((L)->nCcalls += 0x10000)
107
108/* Decrement the number of non-yieldable calls */
109#define decnny(L) ((L)->nCcalls -= 0x10000)
110
111/* Non-yieldable call increment */
112#define nyci (0x10000 | 1)
113
114
115
116
117struct lua_longjmp; /* defined in ldo.c */
118
119
120/*
121** Atomic type (relative to signals) to better ensure that 'lua_sethook'
122** is thread safe
123*/
124#if !defined(l_signalT)
125#include <signal.h>
126#define l_signalT sig_atomic_t
127#endif
128
129
130/*
131** Extra stack space to handle TM calls and some other extras. This
132** space is not included in 'stack_last'. It is used only to avoid stack
133** checks, either because the element will be promptly popped or because
134** there will be a stack check soon after the push. Function frames
135** never use this extra space, so it does not need to be kept clean.
136*/
137#define EXTRA_STACK 5
138
139
140#define BASIC_STACK_SIZE (2*LUA_MINSTACK)
141
142#define stacksize(th) cast_int((th)->stack_last - (th)->stack)
143
144
145/* kinds of Garbage Collection */
146#define KGC_INC 0 /* incremental gc */
147#define KGC_GEN 1 /* generational gc */
148
149
150typedef struct stringtable {
151 TString **hash;
152 int nuse; /* number of elements */
153 int size;
154} stringtable;
155
156
157/*
158** Information about a call.
159** About union 'u':
160** - field 'l' is used only for Lua functions;
161** - field 'c' is used only for C functions.
162** About union 'u2':
163** - field 'funcidx' is used only by C functions while doing a
164** protected call;
165** - field 'nyield' is used only while a function is "doing" an
166** yield (from the yield until the next resume);
167** - field 'nres' is used only while closing tbc variables when
168** returning from a C function;
169** - field 'transferinfo' is used only during call/returnhooks,
170** before the function starts or after it ends.
171*/
172typedef struct CallInfo {
173 StkId func; /* function index in the stack */
174 StkId top; /* top for this function */
175 struct CallInfo *previous, *next; /* dynamic call link */
176 union {
177 struct { /* only for Lua functions */
178 const Instruction *savedpc;
179 volatile l_signalT trap;
180 int nextraargs; /* # of extra arguments in vararg functions */
181 } l;
182 struct { /* only for C functions */
183 lua_KFunction k; /* continuation in case of yields */
184 ptrdiff_t old_errfunc;
185 lua_KContext ctx; /* context info. in case of yields */
186 } c;
187 } u;
188 union {
189 int funcidx; /* called-function index */
190 int nyield; /* number of values yielded */
191 int nres; /* number of values returned */
192 struct { /* info about transferred values (for call/return hooks) */
193 unsigned short ftransfer; /* offset of first value transferred */
194 unsigned short ntransfer; /* number of values transferred */
195 } transferinfo;
196 } u2;
197 short nresults; /* expected number of results from this function */
198 unsigned short callstatus;
199} CallInfo;
200
201
202/*
203** Bits in CallInfo status
204*/
205#define CIST_OAH (1<<0) /* original value of 'allowhook' */
206#define CIST_C (1<<1) /* call is running a C function */
207#define CIST_FRESH (1<<2) /* call is on a fresh "luaV_execute" frame */
208#define CIST_HOOKED (1<<3) /* call is running a debug hook */
209#define CIST_YPCALL (1<<4) /* doing a yieldable protected call */
210#define CIST_TAIL (1<<5) /* call was tail called */
211#define CIST_HOOKYIELD (1<<6) /* last hook called yielded */
212#define CIST_FIN (1<<7) /* call is running a finalizer */
213#define CIST_TRAN (1<<8) /* 'ci' has transfer information */
214#define CIST_CLSRET (1<<9) /* function is closing tbc variables */
215/* Bits 10-12 are used for CIST_RECST (see below) */
216#define CIST_RECST 10
217#if defined(LUA_COMPAT_LT_LE)
218#define CIST_LEQ (1<<13) /* using __lt for __le */
219#endif
220
221
222/*
223** Field CIST_RECST stores the "recover status", used to keep the error
224** status while closing to-be-closed variables in coroutines, so that
225** Lua can correctly resume after an yield from a __close method called
226** because of an error. (Three bits are enough for error status.)
227*/
228#define getcistrecst(ci) (((ci)->callstatus >> CIST_RECST) & 7)
229#define setcistrecst(ci,st) \
230 check_exp(((st) & 7) == (st), /* status must fit in three bits */ \
231 ((ci)->callstatus = ((ci)->callstatus & ~(7 << CIST_RECST)) \
232 | ((st) << CIST_RECST)))
233
234
235/* active function is a Lua function */
236#define isLua(ci) (!((ci)->callstatus & CIST_C))
237
238/* call is running Lua code (not a hook) */
239#define isLuacode(ci) (!((ci)->callstatus & (CIST_C | CIST_HOOKED)))
240
241/* assume that CIST_OAH has offset 0 and that 'v' is strictly 0/1 */
242#define setoah(st,v) ((st) = ((st) & ~CIST_OAH) | (v))
243#define getoah(st) ((st) & CIST_OAH)
244
245
246/*
247** 'global state', shared by all threads of this state
248*/
249typedef struct global_State {
250 lua_Alloc frealloc; /* function to reallocate memory */
251 void *ud; /* auxiliary data to 'frealloc' */
252 l_mem totalbytes; /* number of bytes currently allocated - GCdebt */
253 l_mem GCdebt; /* bytes allocated not yet compensated by the collector */
254 lu_mem GCestimate; /* an estimate of the non-garbage memory in use */
255 lu_mem lastatomic; /* see function 'genstep' in file 'lgc.c' */
256 stringtable strt; /* hash table for strings */
257 TValue l_registry;
258 TValue nilvalue; /* a nil value */
259 unsigned int seed; /* randomized seed for hashes */
260 lu_byte currentwhite;
261 lu_byte gcstate; /* state of garbage collector */
262 lu_byte gckind; /* kind of GC running */
263 lu_byte gcstopem; /* stops emergency collections */
264 lu_byte genminormul; /* control for minor generational collections */
265 lu_byte genmajormul; /* control for major generational collections */
266 lu_byte gcrunning; /* true if GC is running */
267 lu_byte gcemergency; /* true if this is an emergency collection */
268 lu_byte gcpause; /* size of pause between successive GCs */
269 lu_byte gcstepmul; /* GC "speed" */
270 lu_byte gcstepsize; /* (log2 of) GC granularity */
271 GCObject *allgc; /* list of all collectable objects */
272 GCObject **sweepgc; /* current position of sweep in list */
273 GCObject *finobj; /* list of collectable objects with finalizers */
274 GCObject *gray; /* list of gray objects */
275 GCObject *grayagain; /* list of objects to be traversed atomically */
276 GCObject *weak; /* list of tables with weak values */
277 GCObject *ephemeron; /* list of ephemeron tables (weak keys) */
278 GCObject *allweak; /* list of all-weak tables */
279 GCObject *tobefnz; /* list of userdata to be GC */
280 GCObject *fixedgc; /* list of objects not to be collected */
281 /* fields for generational collector */
282 GCObject *survival; /* start of objects that survived one GC cycle */
283 GCObject *old1; /* start of old1 objects */
284 GCObject *reallyold; /* objects more than one cycle old ("really old") */
285 GCObject *firstold1; /* first OLD1 object in the list (if any) */
286 GCObject *finobjsur; /* list of survival objects with finalizers */
287 GCObject *finobjold1; /* list of old1 objects with finalizers */
288 GCObject *finobjrold; /* list of really old objects with finalizers */
289 struct lua_State *twups; /* list of threads with open upvalues */
290 lua_CFunction panic; /* to be called in unprotected errors */
291 struct lua_State *mainthread;
292 TString *memerrmsg; /* message for memory-allocation errors */
293 TString *tmname[TM_N]; /* array with tag-method names */
294 struct Table *mt[LUA_NUMTAGS]; /* metatables for basic types */
295 TString *strcache[STRCACHE_N][STRCACHE_M]; /* cache for strings in API */
296 lua_WarnFunction warnf; /* warning function */
297 void *ud_warn; /* auxiliary data to 'warnf' */
298} global_State;
299
300
301/*
302** 'per thread' state
303*/
304struct lua_State {
305 CommonHeader;
306 lu_byte status;
307 lu_byte allowhook;
308 unsigned short nci; /* number of items in 'ci' list */
309 StkId top; /* first free slot in the stack */
310 global_State *l_G;
311 CallInfo *ci; /* call info for current function */
312 StkId stack_last; /* end of stack (last element + 1) */
313 StkId stack; /* stack base */
314 UpVal *openupval; /* list of open upvalues in this stack */
315 StkId tbclist; /* list of to-be-closed variables */
316 GCObject *gclist;
317 struct lua_State *twups; /* list of threads with open upvalues */
318 struct lua_longjmp *errorJmp; /* current error recover point */
319 CallInfo base_ci; /* CallInfo for first level (C calling Lua) */
320 volatile lua_Hook hook;
321 ptrdiff_t errfunc; /* current error handling function (stack index) */
322 l_uint32 nCcalls; /* number of nested (non-yieldable | C) calls */
323 int oldpc; /* last pc traced */
324 int basehookcount;
325 int hookcount;
326 volatile l_signalT hookmask;
327};
328
329
330#define G(L) (L->l_G)
331
332/*
333** 'g->nilvalue' being a nil value flags that the state was completely
334** build.
335*/
336#define completestate(g) ttisnil(&g->nilvalue)
337
338
339/*
340** Union of all collectable objects (only for conversions)
341** ISO C99, 6.5.2.3 p.5:
342** "if a union contains several structures that share a common initial
343** sequence [...], and if the union object currently contains one
344** of these structures, it is permitted to inspect the common initial
345** part of any of them anywhere that a declaration of the complete type
346** of the union is visible."
347*/
348union GCUnion {
349 GCObject gc; /* common header */
350 struct TString ts;
351 struct Udata u;
352 union Closure cl;
353 struct Table h;
354 struct Proto p;
355 struct lua_State th; /* thread */
356 struct UpVal upv;
357};
358
359
360/*
361** ISO C99, 6.7.2.1 p.14:
362** "A pointer to a union object, suitably converted, points to each of
363** its members [...], and vice versa."
364*/
365#define cast_u(o) cast(union GCUnion *, (o))
366
367/* macros to convert a GCObject into a specific value */
368#define gco2ts(o) \
369 check_exp(novariant((o)->tt) == LUA_TSTRING, &((cast_u(o))->ts))
370#define gco2u(o) check_exp((o)->tt == LUA_VUSERDATA, &((cast_u(o))->u))
371#define gco2lcl(o) check_exp((o)->tt == LUA_VLCL, &((cast_u(o))->cl.l))
372#define gco2ccl(o) check_exp((o)->tt == LUA_VCCL, &((cast_u(o))->cl.c))
373#define gco2cl(o) \
374 check_exp(novariant((o)->tt) == LUA_TFUNCTION, &((cast_u(o))->cl))
375#define gco2t(o) check_exp((o)->tt == LUA_VTABLE, &((cast_u(o))->h))
376#define gco2p(o) check_exp((o)->tt == LUA_VPROTO, &((cast_u(o))->p))
377#define gco2th(o) check_exp((o)->tt == LUA_VTHREAD, &((cast_u(o))->th))
378#define gco2upv(o) check_exp((o)->tt == LUA_VUPVAL, &((cast_u(o))->upv))
379
380
381/*
382** macro to convert a Lua object into a GCObject
383** (The access to 'tt' tries to ensure that 'v' is actually a Lua object.)
384*/
385#define obj2gco(v) check_exp((v)->tt >= LUA_TSTRING, &(cast_u(v)->gc))
386
387
388/* actual number of total bytes allocated */
389#define gettotalbytes(g) cast(lu_mem, (g)->totalbytes + (g)->GCdebt)
390
391LUAI_FUNC void luaE_setdebt (global_State *g, l_mem debt);
392LUAI_FUNC void luaE_freethread (lua_State *L, lua_State *L1);
393LUAI_FUNC CallInfo *luaE_extendCI (lua_State *L);
394LUAI_FUNC void luaE_freeCI (lua_State *L);
395LUAI_FUNC void luaE_shrinkCI (lua_State *L);
396LUAI_FUNC void luaE_checkcstack (lua_State *L);
397LUAI_FUNC void luaE_incCstack (lua_State *L);
398LUAI_FUNC void luaE_warning (lua_State *L, const char *msg, int tocont);
399LUAI_FUNC void luaE_warnerror (lua_State *L, const char *where);
400LUAI_FUNC int luaE_resetthread (lua_State *L, int status);
401
402
403#endif
404
diff --git a/src/lua/lstring.c b/src/lua/lstring.c
deleted file mode 100644
index 13dcaf4..0000000
--- a/src/lua/lstring.c
+++ /dev/null
@@ -1,273 +0,0 @@
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** Maximum size for string table.
27*/
28#define MAXSTRTB cast_int(luaM_limitN(MAX_INT, TString*))
29
30
31/*
32** equality for long strings
33*/
34int luaS_eqlngstr (TString *a, TString *b) {
35 size_t len = a->u.lnglen;
36 lua_assert(a->tt == LUA_VLNGSTR && b->tt == LUA_VLNGSTR);
37 return (a == b) || /* same instance or... */
38 ((len == b->u.lnglen) && /* equal length and ... */
39 (memcmp(getstr(a), getstr(b), len) == 0)); /* equal contents */
40}
41
42
43unsigned int luaS_hash (const char *str, size_t l, unsigned int seed) {
44 unsigned int h = seed ^ cast_uint(l);
45 for (; l > 0; l--)
46 h ^= ((h<<5) + (h>>2) + cast_byte(str[l - 1]));
47 return h;
48}
49
50
51unsigned int luaS_hashlongstr (TString *ts) {
52 lua_assert(ts->tt == LUA_VLNGSTR);
53 if (ts->extra == 0) { /* no hash? */
54 size_t len = ts->u.lnglen;
55 ts->hash = luaS_hash(getstr(ts), len, ts->hash);
56 ts->extra = 1; /* now it has its hash */
57 }
58 return ts->hash;
59}
60
61
62static void tablerehash (TString **vect, int osize, int nsize) {
63 int i;
64 for (i = osize; i < nsize; i++) /* clear new elements */
65 vect[i] = NULL;
66 for (i = 0; i < osize; i++) { /* rehash old part of the array */
67 TString *p = vect[i];
68 vect[i] = NULL;
69 while (p) { /* for each string in the list */
70 TString *hnext = p->u.hnext; /* save next */
71 unsigned int h = lmod(p->hash, nsize); /* new position */
72 p->u.hnext = vect[h]; /* chain it into array */
73 vect[h] = p;
74 p = hnext;
75 }
76 }
77}
78
79
80/*
81** Resize the string table. If allocation fails, keep the current size.
82** (This can degrade performance, but any non-zero size should work
83** correctly.)
84*/
85void luaS_resize (lua_State *L, int nsize) {
86 stringtable *tb = &G(L)->strt;
87 int osize = tb->size;
88 TString **newvect;
89 if (nsize < osize) /* shrinking table? */
90 tablerehash(tb->hash, osize, nsize); /* depopulate shrinking part */
91 newvect = luaM_reallocvector(L, tb->hash, osize, nsize, TString*);
92 if (l_unlikely(newvect == NULL)) { /* reallocation failed? */
93 if (nsize < osize) /* was it shrinking table? */
94 tablerehash(tb->hash, nsize, osize); /* restore to original size */
95 /* leave table as it was */
96 }
97 else { /* allocation succeeded */
98 tb->hash = newvect;
99 tb->size = nsize;
100 if (nsize > osize)
101 tablerehash(newvect, osize, nsize); /* rehash for new size */
102 }
103}
104
105
106/*
107** Clear API string cache. (Entries cannot be empty, so fill them with
108** a non-collectable string.)
109*/
110void luaS_clearcache (global_State *g) {
111 int i, j;
112 for (i = 0; i < STRCACHE_N; i++)
113 for (j = 0; j < STRCACHE_M; j++) {
114 if (iswhite(g->strcache[i][j])) /* will entry be collected? */
115 g->strcache[i][j] = g->memerrmsg; /* replace it with something fixed */
116 }
117}
118
119
120/*
121** Initialize the string table and the string cache
122*/
123void luaS_init (lua_State *L) {
124 global_State *g = G(L);
125 int i, j;
126 stringtable *tb = &G(L)->strt;
127 tb->hash = luaM_newvector(L, MINSTRTABSIZE, TString*);
128 tablerehash(tb->hash, 0, MINSTRTABSIZE); /* clear array */
129 tb->size = MINSTRTABSIZE;
130 /* pre-create memory-error message */
131 g->memerrmsg = luaS_newliteral(L, MEMERRMSG);
132 luaC_fix(L, obj2gco(g->memerrmsg)); /* it should never be collected */
133 for (i = 0; i < STRCACHE_N; i++) /* fill cache with valid strings */
134 for (j = 0; j < STRCACHE_M; j++)
135 g->strcache[i][j] = g->memerrmsg;
136}
137
138
139
140/*
141** creates a new string object
142*/
143static TString *createstrobj (lua_State *L, size_t l, int tag, unsigned int h) {
144 TString *ts;
145 GCObject *o;
146 size_t totalsize; /* total size of TString object */
147 totalsize = sizelstring(l);
148 o = luaC_newobj(L, tag, totalsize);
149 ts = gco2ts(o);
150 ts->hash = h;
151 ts->extra = 0;
152 getstr(ts)[l] = '\0'; /* ending 0 */
153 return ts;
154}
155
156
157TString *luaS_createlngstrobj (lua_State *L, size_t l) {
158 TString *ts = createstrobj(L, l, LUA_VLNGSTR, G(L)->seed);
159 ts->u.lnglen = l;
160 return ts;
161}
162
163
164void luaS_remove (lua_State *L, TString *ts) {
165 stringtable *tb = &G(L)->strt;
166 TString **p = &tb->hash[lmod(ts->hash, tb->size)];
167 while (*p != ts) /* find previous element */
168 p = &(*p)->u.hnext;
169 *p = (*p)->u.hnext; /* remove element from its list */
170 tb->nuse--;
171}
172
173
174static void growstrtab (lua_State *L, stringtable *tb) {
175 if (l_unlikely(tb->nuse == MAX_INT)) { /* too many strings? */
176 luaC_fullgc(L, 1); /* try to free some... */
177 if (tb->nuse == MAX_INT) /* still too many? */
178 luaM_error(L); /* cannot even create a message... */
179 }
180 if (tb->size <= MAXSTRTB / 2) /* can grow string table? */
181 luaS_resize(L, tb->size * 2);
182}
183
184
185/*
186** Checks whether short string exists and reuses it or creates a new one.
187*/
188static TString *internshrstr (lua_State *L, const char *str, size_t l) {
189 TString *ts;
190 global_State *g = G(L);
191 stringtable *tb = &g->strt;
192 unsigned int h = luaS_hash(str, l, g->seed);
193 TString **list = &tb->hash[lmod(h, tb->size)];
194 lua_assert(str != NULL); /* otherwise 'memcmp'/'memcpy' are undefined */
195 for (ts = *list; ts != NULL; ts = ts->u.hnext) {
196 if (l == ts->shrlen && (memcmp(str, getstr(ts), l * sizeof(char)) == 0)) {
197 /* found! */
198 if (isdead(g, ts)) /* dead (but not collected yet)? */
199 changewhite(ts); /* resurrect it */
200 return ts;
201 }
202 }
203 /* else must create a new string */
204 if (tb->nuse >= tb->size) { /* need to grow string table? */
205 growstrtab(L, tb);
206 list = &tb->hash[lmod(h, tb->size)]; /* rehash with new size */
207 }
208 ts = createstrobj(L, l, LUA_VSHRSTR, h);
209 memcpy(getstr(ts), str, l * sizeof(char));
210 ts->shrlen = cast_byte(l);
211 ts->u.hnext = *list;
212 *list = ts;
213 tb->nuse++;
214 return ts;
215}
216
217
218/*
219** new string (with explicit length)
220*/
221TString *luaS_newlstr (lua_State *L, const char *str, size_t l) {
222 if (l <= LUAI_MAXSHORTLEN) /* short string? */
223 return internshrstr(L, str, l);
224 else {
225 TString *ts;
226 if (l_unlikely(l >= (MAX_SIZE - sizeof(TString))/sizeof(char)))
227 luaM_toobig(L);
228 ts = luaS_createlngstrobj(L, l);
229 memcpy(getstr(ts), str, l * sizeof(char));
230 return ts;
231 }
232}
233
234
235/*
236** Create or reuse a zero-terminated string, first checking in the
237** cache (using the string address as a key). The cache can contain
238** only zero-terminated strings, so it is safe to use 'strcmp' to
239** check hits.
240*/
241TString *luaS_new (lua_State *L, const char *str) {
242 unsigned int i = point2uint(str) % STRCACHE_N; /* hash */
243 int j;
244 TString **p = G(L)->strcache[i];
245 for (j = 0; j < STRCACHE_M; j++) {
246 if (strcmp(str, getstr(p[j])) == 0) /* hit? */
247 return p[j]; /* that is it */
248 }
249 /* normal route */
250 for (j = STRCACHE_M - 1; j > 0; j--)
251 p[j] = p[j - 1]; /* move out last element */
252 /* new element is first in the list */
253 p[0] = luaS_newlstr(L, str, strlen(str));
254 return p[0];
255}
256
257
258Udata *luaS_newudata (lua_State *L, size_t s, int nuvalue) {
259 Udata *u;
260 int i;
261 GCObject *o;
262 if (l_unlikely(s > MAX_SIZE - udatamemoffset(nuvalue)))
263 luaM_toobig(L);
264 o = luaC_newobj(L, LUA_VUSERDATA, sizeudata(nuvalue, s));
265 u = gco2u(o);
266 u->len = s;
267 u->nuvalue = nuvalue;
268 u->metatable = NULL;
269 for (i = 0; i < nuvalue; i++)
270 setnilvalue(&u->uv[i].uv);
271 return u;
272}
273
diff --git a/src/lua/lstring.h b/src/lua/lstring.h
deleted file mode 100644
index 450c239..0000000
--- a/src/lua/lstring.h
+++ /dev/null
@@ -1,57 +0,0 @@
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, unsigned int seed);
45LUAI_FUNC unsigned int luaS_hashlongstr (TString *ts);
46LUAI_FUNC int luaS_eqlngstr (TString *a, TString *b);
47LUAI_FUNC void luaS_resize (lua_State *L, int newsize);
48LUAI_FUNC void luaS_clearcache (global_State *g);
49LUAI_FUNC void luaS_init (lua_State *L);
50LUAI_FUNC void luaS_remove (lua_State *L, TString *ts);
51LUAI_FUNC Udata *luaS_newudata (lua_State *L, size_t s, int nuvalue);
52LUAI_FUNC TString *luaS_newlstr (lua_State *L, const char *str, size_t l);
53LUAI_FUNC TString *luaS_new (lua_State *L, const char *str);
54LUAI_FUNC TString *luaS_createlngstrobj (lua_State *L, size_t l);
55
56
57#endif
diff --git a/src/lua/lstrlib.c b/src/lua/lstrlib.c
deleted file mode 100644
index 47e5b27..0000000
--- a/src/lua/lstrlib.c
+++ /dev/null
@@ -1,1817 +0,0 @@
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)
156 lua_pushliteral(L, "");
157 else if (l_unlikely(l + lsep < l || l + lsep > MAXSIZE / n))
158 return luaL_error(L, "resulting string too large");
159 else {
160 size_t totallen = (size_t)n * l + (size_t)(n - 1) * lsep;
161 luaL_Buffer b;
162 char *p = luaL_buffinitsize(L, &b, totallen);
163 while (n-- > 1) { /* first n-1 copies (followed by separator) */
164 memcpy(p, s, l * sizeof(char)); p += l;
165 if (lsep > 0) { /* empty 'memcpy' is not that cheap */
166 memcpy(p, sep, lsep * sizeof(char));
167 p += lsep;
168 }
169 }
170 memcpy(p, s, l * sizeof(char)); /* last copy (not followed by separator) */
171 luaL_pushresultsize(&b, totallen);
172 }
173 return 1;
174}
175
176
177static int str_byte (lua_State *L) {
178 size_t l;
179 const char *s = luaL_checklstring(L, 1, &l);
180 lua_Integer pi = luaL_optinteger(L, 2, 1);
181 size_t posi = posrelatI(pi, l);
182 size_t pose = getendpos(L, 3, pi, l);
183 int n, i;
184 if (posi > pose) return 0; /* empty interval; return no values */
185 if (l_unlikely(pose - posi >= (size_t)INT_MAX)) /* arithmetic overflow? */
186 return luaL_error(L, "string slice too long");
187 n = (int)(pose - posi) + 1;
188 luaL_checkstack(L, n, "string slice too long");
189 for (i=0; i<n; i++)
190 lua_pushinteger(L, uchar(s[posi+i-1]));
191 return n;
192}
193
194
195static int str_char (lua_State *L) {
196 int n = lua_gettop(L); /* number of arguments */
197 int i;
198 luaL_Buffer b;
199 char *p = luaL_buffinitsize(L, &b, n);
200 for (i=1; i<=n; i++) {
201 lua_Unsigned c = (lua_Unsigned)luaL_checkinteger(L, i);
202 luaL_argcheck(L, c <= (lua_Unsigned)UCHAR_MAX, i, "value out of range");
203 p[i - 1] = uchar(c);
204 }
205 luaL_pushresultsize(&b, n);
206 return 1;
207}
208
209
210/*
211** Buffer to store the result of 'string.dump'. It must be initialized
212** after the call to 'lua_dump', to ensure that the function is on the
213** top of the stack when 'lua_dump' is called. ('luaL_buffinit' might
214** push stuff.)
215*/
216struct str_Writer {
217 int init; /* true iff buffer has been initialized */
218 luaL_Buffer B;
219};
220
221
222static int writer (lua_State *L, const void *b, size_t size, void *ud) {
223 struct str_Writer *state = (struct str_Writer *)ud;
224 if (!state->init) {
225 state->init = 1;
226 luaL_buffinit(L, &state->B);
227 }
228 luaL_addlstring(&state->B, (const char *)b, size);
229 return 0;
230}
231
232
233static int str_dump (lua_State *L) {
234 struct str_Writer state;
235 int strip = lua_toboolean(L, 2);
236 luaL_checktype(L, 1, LUA_TFUNCTION);
237 lua_settop(L, 1); /* ensure function is on the top of the stack */
238 state.init = 0;
239 if (l_unlikely(lua_dump(L, writer, &state, strip) != 0))
240 return luaL_error(L, "unable to dump given function");
241 luaL_pushresult(&state.B);
242 return 1;
243}
244
245
246
247/*
248** {======================================================
249** METAMETHODS
250** =======================================================
251*/
252
253#if defined(LUA_NOCVTS2N) /* { */
254
255/* no coercion from strings to numbers */
256
257static const luaL_Reg stringmetamethods[] = {
258 {"__index", NULL}, /* placeholder */
259 {NULL, NULL}
260};
261
262#else /* }{ */
263
264static int tonum (lua_State *L, int arg) {
265 if (lua_type(L, arg) == LUA_TNUMBER) { /* already a number? */
266 lua_pushvalue(L, arg);
267 return 1;
268 }
269 else { /* check whether it is a numerical string */
270 size_t len;
271 const char *s = lua_tolstring(L, arg, &len);
272 return (s != NULL && lua_stringtonumber(L, s) == len + 1);
273 }
274}
275
276
277static void trymt (lua_State *L, const char *mtname) {
278 lua_settop(L, 2); /* back to the original arguments */
279 if (l_unlikely(lua_type(L, 2) == LUA_TSTRING ||
280 !luaL_getmetafield(L, 2, mtname)))
281 luaL_error(L, "attempt to %s a '%s' with a '%s'", mtname + 2,
282 luaL_typename(L, -2), luaL_typename(L, -1));
283 lua_insert(L, -3); /* put metamethod before arguments */
284 lua_call(L, 2, 1); /* call metamethod */
285}
286
287
288static int arith (lua_State *L, int op, const char *mtname) {
289 if (tonum(L, 1) && tonum(L, 2))
290 lua_arith(L, op); /* result will be on the top */
291 else
292 trymt(L, mtname);
293 return 1;
294}
295
296
297static int arith_add (lua_State *L) {
298 return arith(L, LUA_OPADD, "__add");
299}
300
301static int arith_sub (lua_State *L) {
302 return arith(L, LUA_OPSUB, "__sub");
303}
304
305static int arith_mul (lua_State *L) {
306 return arith(L, LUA_OPMUL, "__mul");
307}
308
309static int arith_mod (lua_State *L) {
310 return arith(L, LUA_OPMOD, "__mod");
311}
312
313static int arith_pow (lua_State *L) {
314 return arith(L, LUA_OPPOW, "__pow");
315}
316
317static int arith_div (lua_State *L) {
318 return arith(L, LUA_OPDIV, "__div");
319}
320
321static int arith_idiv (lua_State *L) {
322 return arith(L, LUA_OPIDIV, "__idiv");
323}
324
325static int arith_unm (lua_State *L) {
326 return arith(L, LUA_OPUNM, "__unm");
327}
328
329
330static const luaL_Reg stringmetamethods[] = {
331 {"__add", arith_add},
332 {"__sub", arith_sub},
333 {"__mul", arith_mul},
334 {"__mod", arith_mod},
335 {"__pow", arith_pow},
336 {"__div", arith_div},
337 {"__idiv", arith_idiv},
338 {"__unm", arith_unm},
339 {"__index", NULL}, /* placeholder */
340 {NULL, NULL}
341};
342
343#endif /* } */
344
345/* }====================================================== */
346
347/*
348** {======================================================
349** PATTERN MATCHING
350** =======================================================
351*/
352
353
354#define CAP_UNFINISHED (-1)
355#define CAP_POSITION (-2)
356
357
358typedef struct MatchState {
359 const char *src_init; /* init of source string */
360 const char *src_end; /* end ('\0') of source string */
361 const char *p_end; /* end ('\0') of pattern */
362 lua_State *L;
363 int matchdepth; /* control for recursive depth (to avoid C stack overflow) */
364 unsigned char level; /* total number of captures (finished or unfinished) */
365 struct {
366 const char *init;
367 ptrdiff_t len;
368 } capture[LUA_MAXCAPTURES];
369} MatchState;
370
371
372/* recursive function */
373static const char *match (MatchState *ms, const char *s, const char *p);
374
375
376/* maximum recursion depth for 'match' */
377#if !defined(MAXCCALLS)
378#define MAXCCALLS 200
379#endif
380
381
382#define L_ESC '%'
383#define SPECIALS "^$*+?.([%-"
384
385
386static int check_capture (MatchState *ms, int l) {
387 l -= '1';
388 if (l_unlikely(l < 0 || l >= ms->level ||
389 ms->capture[l].len == CAP_UNFINISHED))
390 return luaL_error(ms->L, "invalid capture index %%%d", l + 1);
391 return l;
392}
393
394
395static int capture_to_close (MatchState *ms) {
396 int level = ms->level;
397 for (level--; level>=0; level--)
398 if (ms->capture[level].len == CAP_UNFINISHED) return level;
399 return luaL_error(ms->L, "invalid pattern capture");
400}
401
402
403static const char *classend (MatchState *ms, const char *p) {
404 switch (*p++) {
405 case L_ESC: {
406 if (l_unlikely(p == ms->p_end))
407 luaL_error(ms->L, "malformed pattern (ends with '%%')");
408 return p+1;
409 }
410 case '[': {
411 if (*p == '^') p++;
412 do { /* look for a ']' */
413 if (l_unlikely(p == ms->p_end))
414 luaL_error(ms->L, "malformed pattern (missing ']')");
415 if (*(p++) == L_ESC && p < ms->p_end)
416 p++; /* skip escapes (e.g. '%]') */
417 } while (*p != ']');
418 return p+1;
419 }
420 default: {
421 return p;
422 }
423 }
424}
425
426
427static int match_class (int c, int cl) {
428 int res;
429 switch (tolower(cl)) {
430 case 'a' : res = isalpha(c); break;
431 case 'c' : res = iscntrl(c); break;
432 case 'd' : res = isdigit(c); break;
433 case 'g' : res = isgraph(c); break;
434 case 'l' : res = islower(c); break;
435 case 'p' : res = ispunct(c); break;
436 case 's' : res = isspace(c); break;
437 case 'u' : res = isupper(c); break;
438 case 'w' : res = isalnum(c); break;
439 case 'x' : res = isxdigit(c); break;
440 case 'z' : res = (c == 0); break; /* deprecated option */
441 default: return (cl == c);
442 }
443 return (islower(cl) ? res : !res);
444}
445
446
447static int matchbracketclass (int c, const char *p, const char *ec) {
448 int sig = 1;
449 if (*(p+1) == '^') {
450 sig = 0;
451 p++; /* skip the '^' */
452 }
453 while (++p < ec) {
454 if (*p == L_ESC) {
455 p++;
456 if (match_class(c, uchar(*p)))
457 return sig;
458 }
459 else if ((*(p+1) == '-') && (p+2 < ec)) {
460 p+=2;
461 if (uchar(*(p-2)) <= c && c <= uchar(*p))
462 return sig;
463 }
464 else if (uchar(*p) == c) return sig;
465 }
466 return !sig;
467}
468
469
470static int singlematch (MatchState *ms, const char *s, const char *p,
471 const char *ep) {
472 if (s >= ms->src_end)
473 return 0;
474 else {
475 int c = uchar(*s);
476 switch (*p) {
477 case '.': return 1; /* matches any char */
478 case L_ESC: return match_class(c, uchar(*(p+1)));
479 case '[': return matchbracketclass(c, p, ep-1);
480 default: return (uchar(*p) == c);
481 }
482 }
483}
484
485
486static const char *matchbalance (MatchState *ms, const char *s,
487 const char *p) {
488 if (l_unlikely(p >= ms->p_end - 1))
489 luaL_error(ms->L, "malformed pattern (missing arguments to '%%b')");
490 if (*s != *p) return NULL;
491 else {
492 int b = *p;
493 int e = *(p+1);
494 int cont = 1;
495 while (++s < ms->src_end) {
496 if (*s == e) {
497 if (--cont == 0) return s+1;
498 }
499 else if (*s == b) cont++;
500 }
501 }
502 return NULL; /* string ends out of balance */
503}
504
505
506static const char *max_expand (MatchState *ms, const char *s,
507 const char *p, const char *ep) {
508 ptrdiff_t i = 0; /* counts maximum expand for item */
509 while (singlematch(ms, s + i, p, ep))
510 i++;
511 /* keeps trying to match with the maximum repetitions */
512 while (i>=0) {
513 const char *res = match(ms, (s+i), ep+1);
514 if (res) return res;
515 i--; /* else didn't match; reduce 1 repetition to try again */
516 }
517 return NULL;
518}
519
520
521static const char *min_expand (MatchState *ms, const char *s,
522 const char *p, const char *ep) {
523 for (;;) {
524 const char *res = match(ms, s, ep+1);
525 if (res != NULL)
526 return res;
527 else if (singlematch(ms, s, p, ep))
528 s++; /* try with one more repetition */
529 else return NULL;
530 }
531}
532
533
534static const char *start_capture (MatchState *ms, const char *s,
535 const char *p, int what) {
536 const char *res;
537 int level = ms->level;
538 if (level >= LUA_MAXCAPTURES) luaL_error(ms->L, "too many captures");
539 ms->capture[level].init = s;
540 ms->capture[level].len = what;
541 ms->level = level+1;
542 if ((res=match(ms, s, p)) == NULL) /* match failed? */
543 ms->level--; /* undo capture */
544 return res;
545}
546
547
548static const char *end_capture (MatchState *ms, const char *s,
549 const char *p) {
550 int l = capture_to_close(ms);
551 const char *res;
552 ms->capture[l].len = s - ms->capture[l].init; /* close capture */
553 if ((res = match(ms, s, p)) == NULL) /* match failed? */
554 ms->capture[l].len = CAP_UNFINISHED; /* undo capture */
555 return res;
556}
557
558
559static const char *match_capture (MatchState *ms, const char *s, int l) {
560 size_t len;
561 l = check_capture(ms, l);
562 len = ms->capture[l].len;
563 if ((size_t)(ms->src_end-s) >= len &&
564 memcmp(ms->capture[l].init, s, len) == 0)
565 return s+len;
566 else return NULL;
567}
568
569
570static const char *match (MatchState *ms, const char *s, const char *p) {
571 if (l_unlikely(ms->matchdepth-- == 0))
572 luaL_error(ms->L, "pattern too complex");
573 init: /* using goto's to optimize tail recursion */
574 if (p != ms->p_end) { /* end of pattern? */
575 switch (*p) {
576 case '(': { /* start capture */
577 if (*(p + 1) == ')') /* position capture? */
578 s = start_capture(ms, s, p + 2, CAP_POSITION);
579 else
580 s = start_capture(ms, s, p + 1, CAP_UNFINISHED);
581 break;
582 }
583 case ')': { /* end capture */
584 s = end_capture(ms, s, p + 1);
585 break;
586 }
587 case '$': {
588 if ((p + 1) != ms->p_end) /* is the '$' the last char in pattern? */
589 goto dflt; /* no; go to default */
590 s = (s == ms->src_end) ? s : NULL; /* check end of string */
591 break;
592 }
593 case L_ESC: { /* escaped sequences not in the format class[*+?-]? */
594 switch (*(p + 1)) {
595 case 'b': { /* balanced string? */
596 s = matchbalance(ms, s, p + 2);
597 if (s != NULL) {
598 p += 4; goto init; /* return match(ms, s, p + 4); */
599 } /* else fail (s == NULL) */
600 break;
601 }
602 case 'f': { /* frontier? */
603 const char *ep; char previous;
604 p += 2;
605 if (l_unlikely(*p != '['))
606 luaL_error(ms->L, "missing '[' after '%%f' in pattern");
607 ep = classend(ms, p); /* points to what is next */
608 previous = (s == ms->src_init) ? '\0' : *(s - 1);
609 if (!matchbracketclass(uchar(previous), p, ep - 1) &&
610 matchbracketclass(uchar(*s), p, ep - 1)) {
611 p = ep; goto init; /* return match(ms, s, ep); */
612 }
613 s = NULL; /* match failed */
614 break;
615 }
616 case '0': case '1': case '2': case '3':
617 case '4': case '5': case '6': case '7':
618 case '8': case '9': { /* capture results (%0-%9)? */
619 s = match_capture(ms, s, uchar(*(p + 1)));
620 if (s != NULL) {
621 p += 2; goto init; /* return match(ms, s, p + 2) */
622 }
623 break;
624 }
625 default: goto dflt;
626 }
627 break;
628 }
629 default: dflt: { /* pattern class plus optional suffix */
630 const char *ep = classend(ms, p); /* points to optional suffix */
631 /* does not match at least once? */
632 if (!singlematch(ms, s, p, ep)) {
633 if (*ep == '*' || *ep == '?' || *ep == '-') { /* accept empty? */
634 p = ep + 1; goto init; /* return match(ms, s, ep + 1); */
635 }
636 else /* '+' or no suffix */
637 s = NULL; /* fail */
638 }
639 else { /* matched once */
640 switch (*ep) { /* handle optional suffix */
641 case '?': { /* optional */
642 const char *res;
643 if ((res = match(ms, s + 1, ep + 1)) != NULL)
644 s = res;
645 else {
646 p = ep + 1; goto init; /* else return match(ms, s, ep + 1); */
647 }
648 break;
649 }
650 case '+': /* 1 or more repetitions */
651 s++; /* 1 match already done */
652 /* FALLTHROUGH */
653 case '*': /* 0 or more repetitions */
654 s = max_expand(ms, s, p, ep);
655 break;
656 case '-': /* 0 or more repetitions (minimum) */
657 s = min_expand(ms, s, p, ep);
658 break;
659 default: /* no suffix */
660 s++; p = ep; goto init; /* return match(ms, s + 1, ep); */
661 }
662 }
663 break;
664 }
665 }
666 }
667 ms->matchdepth++;
668 return s;
669}
670
671
672
673static const char *lmemfind (const char *s1, size_t l1,
674 const char *s2, size_t l2) {
675 if (l2 == 0) return s1; /* empty strings are everywhere */
676 else if (l2 > l1) return NULL; /* avoids a negative 'l1' */
677 else {
678 const char *init; /* to search for a '*s2' inside 's1' */
679 l2--; /* 1st char will be checked by 'memchr' */
680 l1 = l1-l2; /* 's2' cannot be found after that */
681 while (l1 > 0 && (init = (const char *)memchr(s1, *s2, l1)) != NULL) {
682 init++; /* 1st char is already checked */
683 if (memcmp(init, s2+1, l2) == 0)
684 return init-1;
685 else { /* correct 'l1' and 's1' to try again */
686 l1 -= init-s1;
687 s1 = init;
688 }
689 }
690 return NULL; /* not found */
691 }
692}
693
694
695/*
696** get information about the i-th capture. If there are no captures
697** and 'i==0', return information about the whole match, which
698** is the range 's'..'e'. If the capture is a string, return
699** its length and put its address in '*cap'. If it is an integer
700** (a position), push it on the stack and return CAP_POSITION.
701*/
702static size_t get_onecapture (MatchState *ms, int i, const char *s,
703 const char *e, const char **cap) {
704 if (i >= ms->level) {
705 if (l_unlikely(i != 0))
706 luaL_error(ms->L, "invalid capture index %%%d", i + 1);
707 *cap = s;
708 return e - s;
709 }
710 else {
711 ptrdiff_t capl = ms->capture[i].len;
712 *cap = ms->capture[i].init;
713 if (l_unlikely(capl == CAP_UNFINISHED))
714 luaL_error(ms->L, "unfinished capture");
715 else if (capl == CAP_POSITION)
716 lua_pushinteger(ms->L, (ms->capture[i].init - ms->src_init) + 1);
717 return capl;
718 }
719}
720
721
722/*
723** Push the i-th capture on the stack.
724*/
725static void push_onecapture (MatchState *ms, int i, const char *s,
726 const char *e) {
727 const char *cap;
728 ptrdiff_t l = get_onecapture(ms, i, s, e, &cap);
729 if (l != CAP_POSITION)
730 lua_pushlstring(ms->L, cap, l);
731 /* else position was already pushed */
732}
733
734
735static int push_captures (MatchState *ms, const char *s, const char *e) {
736 int i;
737 int nlevels = (ms->level == 0 && s) ? 1 : ms->level;
738 luaL_checkstack(ms->L, nlevels, "too many captures");
739 for (i = 0; i < nlevels; i++)
740 push_onecapture(ms, i, s, e);
741 return nlevels; /* number of strings pushed */
742}
743
744
745/* check whether pattern has no special characters */
746static int nospecials (const char *p, size_t l) {
747 size_t upto = 0;
748 do {
749 if (strpbrk(p + upto, SPECIALS))
750 return 0; /* pattern has a special character */
751 upto += strlen(p + upto) + 1; /* may have more after \0 */
752 } while (upto <= l);
753 return 1; /* no special chars found */
754}
755
756
757static void prepstate (MatchState *ms, lua_State *L,
758 const char *s, size_t ls, const char *p, size_t lp) {
759 ms->L = L;
760 ms->matchdepth = MAXCCALLS;
761 ms->src_init = s;
762 ms->src_end = s + ls;
763 ms->p_end = p + lp;
764}
765
766
767static void reprepstate (MatchState *ms) {
768 ms->level = 0;
769 lua_assert(ms->matchdepth == MAXCCALLS);
770}
771
772
773static int str_find_aux (lua_State *L, int find) {
774 size_t ls, lp;
775 const char *s = luaL_checklstring(L, 1, &ls);
776 const char *p = luaL_checklstring(L, 2, &lp);
777 size_t init = posrelatI(luaL_optinteger(L, 3, 1), ls) - 1;
778 if (init > ls) { /* start after string's end? */
779 luaL_pushfail(L); /* cannot find anything */
780 return 1;
781 }
782 /* explicit request or no special characters? */
783 if (find && (lua_toboolean(L, 4) || nospecials(p, lp))) {
784 /* do a plain search */
785 const char *s2 = lmemfind(s + init, ls - init, p, lp);
786 if (s2) {
787 lua_pushinteger(L, (s2 - s) + 1);
788 lua_pushinteger(L, (s2 - s) + lp);
789 return 2;
790 }
791 }
792 else {
793 MatchState ms;
794 const char *s1 = s + init;
795 int anchor = (*p == '^');
796 if (anchor) {
797 p++; lp--; /* skip anchor character */
798 }
799 prepstate(&ms, L, s, ls, p, lp);
800 do {
801 const char *res;
802 reprepstate(&ms);
803 if ((res=match(&ms, s1, p)) != NULL) {
804 if (find) {
805 lua_pushinteger(L, (s1 - s) + 1); /* start */
806 lua_pushinteger(L, res - s); /* end */
807 return push_captures(&ms, NULL, 0) + 2;
808 }
809 else
810 return push_captures(&ms, s1, res);
811 }
812 } while (s1++ < ms.src_end && !anchor);
813 }
814 luaL_pushfail(L); /* not found */
815 return 1;
816}
817
818
819static int str_find (lua_State *L) {
820 return str_find_aux(L, 1);
821}
822
823
824static int str_match (lua_State *L) {
825 return str_find_aux(L, 0);
826}
827
828
829/* state for 'gmatch' */
830typedef struct GMatchState {
831 const char *src; /* current position */
832 const char *p; /* pattern */
833 const char *lastmatch; /* end of last match */
834 MatchState ms; /* match state */
835} GMatchState;
836
837
838static int gmatch_aux (lua_State *L) {
839 GMatchState *gm = (GMatchState *)lua_touserdata(L, lua_upvalueindex(3));
840 const char *src;
841 gm->ms.L = L;
842 for (src = gm->src; src <= gm->ms.src_end; src++) {
843 const char *e;
844 reprepstate(&gm->ms);
845 if ((e = match(&gm->ms, src, gm->p)) != NULL && e != gm->lastmatch) {
846 gm->src = gm->lastmatch = e;
847 return push_captures(&gm->ms, src, e);
848 }
849 }
850 return 0; /* not found */
851}
852
853
854static int gmatch (lua_State *L) {
855 size_t ls, lp;
856 const char *s = luaL_checklstring(L, 1, &ls);
857 const char *p = luaL_checklstring(L, 2, &lp);
858 size_t init = posrelatI(luaL_optinteger(L, 3, 1), ls) - 1;
859 GMatchState *gm;
860 lua_settop(L, 2); /* keep strings on closure to avoid being collected */
861 gm = (GMatchState *)lua_newuserdatauv(L, sizeof(GMatchState), 0);
862 if (init > ls) /* start after string's end? */
863 init = ls + 1; /* avoid overflows in 's + init' */
864 prepstate(&gm->ms, L, s, ls, p, lp);
865 gm->src = s + init; gm->p = p; gm->lastmatch = NULL;
866 lua_pushcclosure(L, gmatch_aux, 3);
867 return 1;
868}
869
870
871static void add_s (MatchState *ms, luaL_Buffer *b, const char *s,
872 const char *e) {
873 size_t l;
874 lua_State *L = ms->L;
875 const char *news = lua_tolstring(L, 3, &l);
876 const char *p;
877 while ((p = (char *)memchr(news, L_ESC, l)) != NULL) {
878 luaL_addlstring(b, news, p - news);
879 p++; /* skip ESC */
880 if (*p == L_ESC) /* '%%' */
881 luaL_addchar(b, *p);
882 else if (*p == '0') /* '%0' */
883 luaL_addlstring(b, s, e - s);
884 else if (isdigit(uchar(*p))) { /* '%n' */
885 const char *cap;
886 ptrdiff_t resl = get_onecapture(ms, *p - '1', s, e, &cap);
887 if (resl == CAP_POSITION)
888 luaL_addvalue(b); /* add position to accumulated result */
889 else
890 luaL_addlstring(b, cap, resl);
891 }
892 else
893 luaL_error(L, "invalid use of '%c' in replacement string", L_ESC);
894 l -= p + 1 - news;
895 news = p + 1;
896 }
897 luaL_addlstring(b, news, l);
898}
899
900
901/*
902** Add the replacement value to the string buffer 'b'.
903** Return true if the original string was changed. (Function calls and
904** table indexing resulting in nil or false do not change the subject.)
905*/
906static int add_value (MatchState *ms, luaL_Buffer *b, const char *s,
907 const char *e, int tr) {
908 lua_State *L = ms->L;
909 switch (tr) {
910 case LUA_TFUNCTION: { /* call the function */
911 int n;
912 lua_pushvalue(L, 3); /* push the function */
913 n = push_captures(ms, s, e); /* all captures as arguments */
914 lua_call(L, n, 1); /* call it */
915 break;
916 }
917 case LUA_TTABLE: { /* index the table */
918 push_onecapture(ms, 0, s, e); /* first capture is the index */
919 lua_gettable(L, 3);
920 break;
921 }
922 default: { /* LUA_TNUMBER or LUA_TSTRING */
923 add_s(ms, b, s, e); /* add value to the buffer */
924 return 1; /* something changed */
925 }
926 }
927 if (!lua_toboolean(L, -1)) { /* nil or false? */
928 lua_pop(L, 1); /* remove value */
929 luaL_addlstring(b, s, e - s); /* keep original text */
930 return 0; /* no changes */
931 }
932 else if (l_unlikely(!lua_isstring(L, -1)))
933 return luaL_error(L, "invalid replacement value (a %s)",
934 luaL_typename(L, -1));
935 else {
936 luaL_addvalue(b); /* add result to accumulator */
937 return 1; /* something changed */
938 }
939}
940
941
942static int str_gsub (lua_State *L) {
943 size_t srcl, lp;
944 const char *src = luaL_checklstring(L, 1, &srcl); /* subject */
945 const char *p = luaL_checklstring(L, 2, &lp); /* pattern */
946 const char *lastmatch = NULL; /* end of last match */
947 int tr = lua_type(L, 3); /* replacement type */
948 lua_Integer max_s = luaL_optinteger(L, 4, srcl + 1); /* max replacements */
949 int anchor = (*p == '^');
950 lua_Integer n = 0; /* replacement count */
951 int changed = 0; /* change flag */
952 MatchState ms;
953 luaL_Buffer b;
954 luaL_argexpected(L, tr == LUA_TNUMBER || tr == LUA_TSTRING ||
955 tr == LUA_TFUNCTION || tr == LUA_TTABLE, 3,
956 "string/function/table");
957 luaL_buffinit(L, &b);
958 if (anchor) {
959 p++; lp--; /* skip anchor character */
960 }
961 prepstate(&ms, L, src, srcl, p, lp);
962 while (n < max_s) {
963 const char *e;
964 reprepstate(&ms); /* (re)prepare state for new match */
965 if ((e = match(&ms, src, p)) != NULL && e != lastmatch) { /* match? */
966 n++;
967 changed = add_value(&ms, &b, src, e, tr) | changed;
968 src = lastmatch = e;
969 }
970 else if (src < ms.src_end) /* otherwise, skip one character */
971 luaL_addchar(&b, *src++);
972 else break; /* end of subject */
973 if (anchor) break;
974 }
975 if (!changed) /* no changes? */
976 lua_pushvalue(L, 1); /* return original string */
977 else { /* something changed */
978 luaL_addlstring(&b, src, ms.src_end-src);
979 luaL_pushresult(&b); /* create and return new string */
980 }
981 lua_pushinteger(L, n); /* number of substitutions */
982 return 2;
983}
984
985/* }====================================================== */
986
987
988
989/*
990** {======================================================
991** STRING FORMAT
992** =======================================================
993*/
994
995#if !defined(lua_number2strx) /* { */
996
997/*
998** Hexadecimal floating-point formatter
999*/
1000
1001#define SIZELENMOD (sizeof(LUA_NUMBER_FRMLEN)/sizeof(char))
1002
1003
1004/*
1005** Number of bits that goes into the first digit. It can be any value
1006** between 1 and 4; the following definition tries to align the number
1007** to nibble boundaries by making what is left after that first digit a
1008** multiple of 4.
1009*/
1010#define L_NBFD ((l_floatatt(MANT_DIG) - 1)%4 + 1)
1011
1012
1013/*
1014** Add integer part of 'x' to buffer and return new 'x'
1015*/
1016static lua_Number adddigit (char *buff, int n, lua_Number x) {
1017 lua_Number dd = l_mathop(floor)(x); /* get integer part from 'x' */
1018 int d = (int)dd;
1019 buff[n] = (d < 10 ? d + '0' : d - 10 + 'a'); /* add to buffer */
1020 return x - dd; /* return what is left */
1021}
1022
1023
1024static int num2straux (char *buff, int sz, lua_Number x) {
1025 /* if 'inf' or 'NaN', format it like '%g' */
1026 if (x != x || x == (lua_Number)HUGE_VAL || x == -(lua_Number)HUGE_VAL)
1027 return l_sprintf(buff, sz, LUA_NUMBER_FMT, (LUAI_UACNUMBER)x);
1028 else if (x == 0) { /* can be -0... */
1029 /* create "0" or "-0" followed by exponent */
1030 return l_sprintf(buff, sz, LUA_NUMBER_FMT "x0p+0", (LUAI_UACNUMBER)x);
1031 }
1032 else {
1033 int e;
1034 lua_Number m = l_mathop(frexp)(x, &e); /* 'x' fraction and exponent */
1035 int n = 0; /* character count */
1036 if (m < 0) { /* is number negative? */
1037 buff[n++] = '-'; /* add sign */
1038 m = -m; /* make it positive */
1039 }
1040 buff[n++] = '0'; buff[n++] = 'x'; /* add "0x" */
1041 m = adddigit(buff, n++, m * (1 << L_NBFD)); /* add first digit */
1042 e -= L_NBFD; /* this digit goes before the radix point */
1043 if (m > 0) { /* more digits? */
1044 buff[n++] = lua_getlocaledecpoint(); /* add radix point */
1045 do { /* add as many digits as needed */
1046 m = adddigit(buff, n++, m * 16);
1047 } while (m > 0);
1048 }
1049 n += l_sprintf(buff + n, sz - n, "p%+d", e); /* add exponent */
1050 lua_assert(n < sz);
1051 return n;
1052 }
1053}
1054
1055
1056static int lua_number2strx (lua_State *L, char *buff, int sz,
1057 const char *fmt, lua_Number x) {
1058 int n = num2straux(buff, sz, x);
1059 if (fmt[SIZELENMOD] == 'A') {
1060 int i;
1061 for (i = 0; i < n; i++)
1062 buff[i] = toupper(uchar(buff[i]));
1063 }
1064 else if (l_unlikely(fmt[SIZELENMOD] != 'a'))
1065 return luaL_error(L, "modifiers for format '%%a'/'%%A' not implemented");
1066 return n;
1067}
1068
1069#endif /* } */
1070
1071
1072/*
1073** Maximum size for items formatted with '%f'. This size is produced
1074** by format('%.99f', -maxfloat), and is equal to 99 + 3 ('-', '.',
1075** and '\0') + number of decimal digits to represent maxfloat (which
1076** is maximum exponent + 1). (99+3+1, adding some extra, 110)
1077*/
1078#define MAX_ITEMF (110 + l_floatatt(MAX_10_EXP))
1079
1080
1081/*
1082** All formats except '%f' do not need that large limit. The other
1083** float formats use exponents, so that they fit in the 99 limit for
1084** significant digits; 's' for large strings and 'q' add items directly
1085** to the buffer; all integer formats also fit in the 99 limit. The
1086** worst case are floats: they may need 99 significant digits, plus
1087** '0x', '-', '.', 'e+XXXX', and '\0'. Adding some extra, 120.
1088*/
1089#define MAX_ITEM 120
1090
1091
1092/* valid flags in a format specification */
1093#if !defined(L_FMTFLAGS)
1094#define L_FMTFLAGS "-+ #0"
1095#endif
1096
1097
1098/*
1099** maximum size of each format specification (such as "%-099.99d")
1100*/
1101#define MAX_FORMAT 32
1102
1103
1104static void addquoted (luaL_Buffer *b, const char *s, size_t len) {
1105 luaL_addchar(b, '"');
1106 while (len--) {
1107 if (*s == '"' || *s == '\\' || *s == '\n') {
1108 luaL_addchar(b, '\\');
1109 luaL_addchar(b, *s);
1110 }
1111 else if (iscntrl(uchar(*s))) {
1112 char buff[10];
1113 if (!isdigit(uchar(*(s+1))))
1114 l_sprintf(buff, sizeof(buff), "\\%d", (int)uchar(*s));
1115 else
1116 l_sprintf(buff, sizeof(buff), "\\%03d", (int)uchar(*s));
1117 luaL_addstring(b, buff);
1118 }
1119 else
1120 luaL_addchar(b, *s);
1121 s++;
1122 }
1123 luaL_addchar(b, '"');
1124}
1125
1126
1127/*
1128** Serialize a floating-point number in such a way that it can be
1129** scanned back by Lua. Use hexadecimal format for "common" numbers
1130** (to preserve precision); inf, -inf, and NaN are handled separately.
1131** (NaN cannot be expressed as a numeral, so we write '(0/0)' for it.)
1132*/
1133static int quotefloat (lua_State *L, char *buff, lua_Number n) {
1134 const char *s; /* for the fixed representations */
1135 if (n == (lua_Number)HUGE_VAL) /* inf? */
1136 s = "1e9999";
1137 else if (n == -(lua_Number)HUGE_VAL) /* -inf? */
1138 s = "-1e9999";
1139 else if (n != n) /* NaN? */
1140 s = "(0/0)";
1141 else { /* format number as hexadecimal */
1142 int nb = lua_number2strx(L, buff, MAX_ITEM,
1143 "%" LUA_NUMBER_FRMLEN "a", n);
1144 /* ensures that 'buff' string uses a dot as the radix character */
1145 if (memchr(buff, '.', nb) == NULL) { /* no dot? */
1146 char point = lua_getlocaledecpoint(); /* try locale point */
1147 char *ppoint = (char *)memchr(buff, point, nb);
1148 if (ppoint) *ppoint = '.'; /* change it to a dot */
1149 }
1150 return nb;
1151 }
1152 /* for the fixed representations */
1153 return l_sprintf(buff, MAX_ITEM, "%s", s);
1154}
1155
1156
1157static void addliteral (lua_State *L, luaL_Buffer *b, int arg) {
1158 switch (lua_type(L, arg)) {
1159 case LUA_TSTRING: {
1160 size_t len;
1161 const char *s = lua_tolstring(L, arg, &len);
1162 addquoted(b, s, len);
1163 break;
1164 }
1165 case LUA_TNUMBER: {
1166 char *buff = luaL_prepbuffsize(b, MAX_ITEM);
1167 int nb;
1168 if (!lua_isinteger(L, arg)) /* float? */
1169 nb = quotefloat(L, buff, lua_tonumber(L, arg));
1170 else { /* integers */
1171 lua_Integer n = lua_tointeger(L, arg);
1172 const char *format = (n == LUA_MININTEGER) /* corner case? */
1173 ? "0x%" LUA_INTEGER_FRMLEN "x" /* use hex */
1174 : LUA_INTEGER_FMT; /* else use default format */
1175 nb = l_sprintf(buff, MAX_ITEM, format, (LUAI_UACINT)n);
1176 }
1177 luaL_addsize(b, nb);
1178 break;
1179 }
1180 case LUA_TNIL: case LUA_TBOOLEAN: {
1181 luaL_tolstring(L, arg, NULL);
1182 luaL_addvalue(b);
1183 break;
1184 }
1185 default: {
1186 luaL_argerror(L, arg, "value has no literal form");
1187 }
1188 }
1189}
1190
1191
1192static const char *scanformat (lua_State *L, const char *strfrmt, char *form) {
1193 const char *p = strfrmt;
1194 while (*p != '\0' && strchr(L_FMTFLAGS, *p) != NULL) p++; /* skip flags */
1195 if ((size_t)(p - strfrmt) >= sizeof(L_FMTFLAGS)/sizeof(char))
1196 luaL_error(L, "invalid format (repeated flags)");
1197 if (isdigit(uchar(*p))) p++; /* skip width */
1198 if (isdigit(uchar(*p))) p++; /* (2 digits at most) */
1199 if (*p == '.') {
1200 p++;
1201 if (isdigit(uchar(*p))) p++; /* skip precision */
1202 if (isdigit(uchar(*p))) p++; /* (2 digits at most) */
1203 }
1204 if (isdigit(uchar(*p)))
1205 luaL_error(L, "invalid format (width or precision too long)");
1206 *(form++) = '%';
1207 memcpy(form, strfrmt, ((p - strfrmt) + 1) * sizeof(char));
1208 form += (p - strfrmt) + 1;
1209 *form = '\0';
1210 return p;
1211}
1212
1213
1214/*
1215** add length modifier into formats
1216*/
1217static void addlenmod (char *form, const char *lenmod) {
1218 size_t l = strlen(form);
1219 size_t lm = strlen(lenmod);
1220 char spec = form[l - 1];
1221 strcpy(form + l - 1, lenmod);
1222 form[l + lm - 1] = spec;
1223 form[l + lm] = '\0';
1224}
1225
1226
1227static int str_format (lua_State *L) {
1228 int top = lua_gettop(L);
1229 int arg = 1;
1230 size_t sfl;
1231 const char *strfrmt = luaL_checklstring(L, arg, &sfl);
1232 const char *strfrmt_end = strfrmt+sfl;
1233 luaL_Buffer b;
1234 luaL_buffinit(L, &b);
1235 while (strfrmt < strfrmt_end) {
1236 if (*strfrmt != L_ESC)
1237 luaL_addchar(&b, *strfrmt++);
1238 else if (*++strfrmt == L_ESC)
1239 luaL_addchar(&b, *strfrmt++); /* %% */
1240 else { /* format item */
1241 char form[MAX_FORMAT]; /* to store the format ('%...') */
1242 int maxitem = MAX_ITEM;
1243 char *buff = luaL_prepbuffsize(&b, maxitem); /* to put formatted item */
1244 int nb = 0; /* number of bytes in added item */
1245 if (++arg > top)
1246 return luaL_argerror(L, arg, "no value");
1247 strfrmt = scanformat(L, strfrmt, form);
1248 switch (*strfrmt++) {
1249 case 'c': {
1250 nb = l_sprintf(buff, maxitem, form, (int)luaL_checkinteger(L, arg));
1251 break;
1252 }
1253 case 'd': case 'i':
1254 case 'o': case 'u': case 'x': case 'X': {
1255 lua_Integer n = luaL_checkinteger(L, arg);
1256 addlenmod(form, LUA_INTEGER_FRMLEN);
1257 nb = l_sprintf(buff, maxitem, form, (LUAI_UACINT)n);
1258 break;
1259 }
1260 case 'a': case 'A':
1261 addlenmod(form, LUA_NUMBER_FRMLEN);
1262 nb = lua_number2strx(L, buff, maxitem, form,
1263 luaL_checknumber(L, arg));
1264 break;
1265 case 'f':
1266 maxitem = MAX_ITEMF; /* extra space for '%f' */
1267 buff = luaL_prepbuffsize(&b, maxitem);
1268 /* FALLTHROUGH */
1269 case 'e': case 'E': case 'g': case 'G': {
1270 lua_Number n = luaL_checknumber(L, arg);
1271 addlenmod(form, LUA_NUMBER_FRMLEN);
1272 nb = l_sprintf(buff, maxitem, form, (LUAI_UACNUMBER)n);
1273 break;
1274 }
1275 case 'p': {
1276 const void *p = lua_topointer(L, arg);
1277 if (p == NULL) { /* avoid calling 'printf' with argument NULL */
1278 p = "(null)"; /* result */
1279 form[strlen(form) - 1] = 's'; /* format it as a string */
1280 }
1281 nb = l_sprintf(buff, maxitem, form, p);
1282 break;
1283 }
1284 case 'q': {
1285 if (form[2] != '\0') /* modifiers? */
1286 return luaL_error(L, "specifier '%%q' cannot have modifiers");
1287 addliteral(L, &b, arg);
1288 break;
1289 }
1290 case 's': {
1291 size_t l;
1292 const char *s = luaL_tolstring(L, arg, &l);
1293 if (form[2] == '\0') /* no modifiers? */
1294 luaL_addvalue(&b); /* keep entire string */
1295 else {
1296 luaL_argcheck(L, l == strlen(s), arg, "string contains zeros");
1297 if (!strchr(form, '.') && l >= 100) {
1298 /* no precision and string is too long to be formatted */
1299 luaL_addvalue(&b); /* keep entire string */
1300 }
1301 else { /* format the string into 'buff' */
1302 nb = l_sprintf(buff, maxitem, form, s);
1303 lua_pop(L, 1); /* remove result from 'luaL_tolstring' */
1304 }
1305 }
1306 break;
1307 }
1308 default: { /* also treat cases 'pnLlh' */
1309 return luaL_error(L, "invalid conversion '%s' to 'format'", form);
1310 }
1311 }
1312 lua_assert(nb < maxitem);
1313 luaL_addsize(&b, nb);
1314 }
1315 }
1316 luaL_pushresult(&b);
1317 return 1;
1318}
1319
1320/* }====================================================== */
1321
1322
1323/*
1324** {======================================================
1325** PACK/UNPACK
1326** =======================================================
1327*/
1328
1329
1330/* value used for padding */
1331#if !defined(LUAL_PACKPADBYTE)
1332#define LUAL_PACKPADBYTE 0x00
1333#endif
1334
1335/* maximum size for the binary representation of an integer */
1336#define MAXINTSIZE 16
1337
1338/* number of bits in a character */
1339#define NB CHAR_BIT
1340
1341/* mask for one character (NB 1's) */
1342#define MC ((1 << NB) - 1)
1343
1344/* size of a lua_Integer */
1345#define SZINT ((int)sizeof(lua_Integer))
1346
1347
1348/* dummy union to get native endianness */
1349static const union {
1350 int dummy;
1351 char little; /* true iff machine is little endian */
1352} nativeendian = {1};
1353
1354
1355/* dummy structure to get native alignment requirements */
1356struct cD {
1357 char c;
1358 union { double d; void *p; lua_Integer i; lua_Number n; } u;
1359};
1360
1361#define MAXALIGN (offsetof(struct cD, u))
1362
1363
1364/*
1365** information to pack/unpack stuff
1366*/
1367typedef struct Header {
1368 lua_State *L;
1369 int islittle;
1370 int maxalign;
1371} Header;
1372
1373
1374/*
1375** options for pack/unpack
1376*/
1377typedef enum KOption {
1378 Kint, /* signed integers */
1379 Kuint, /* unsigned integers */
1380 Kfloat, /* single-precision floating-point numbers */
1381 Knumber, /* Lua "native" floating-point numbers */
1382 Kdouble, /* double-precision floating-point numbers */
1383 Kchar, /* fixed-length strings */
1384 Kstring, /* strings with prefixed length */
1385 Kzstr, /* zero-terminated strings */
1386 Kpadding, /* padding */
1387 Kpaddalign, /* padding for alignment */
1388 Knop /* no-op (configuration or spaces) */
1389} KOption;
1390
1391
1392/*
1393** Read an integer numeral from string 'fmt' or return 'df' if
1394** there is no numeral
1395*/
1396static int digit (int c) { return '0' <= c && c <= '9'; }
1397
1398static int getnum (const char **fmt, int df) {
1399 if (!digit(**fmt)) /* no number? */
1400 return df; /* return default value */
1401 else {
1402 int a = 0;
1403 do {
1404 a = a*10 + (*((*fmt)++) - '0');
1405 } while (digit(**fmt) && a <= ((int)MAXSIZE - 9)/10);
1406 return a;
1407 }
1408}
1409
1410
1411/*
1412** Read an integer numeral and raises an error if it is larger
1413** than the maximum size for integers.
1414*/
1415static int getnumlimit (Header *h, const char **fmt, int df) {
1416 int sz = getnum(fmt, df);
1417 if (l_unlikely(sz > MAXINTSIZE || sz <= 0))
1418 return luaL_error(h->L, "integral size (%d) out of limits [1,%d]",
1419 sz, MAXINTSIZE);
1420 return sz;
1421}
1422
1423
1424/*
1425** Initialize Header
1426*/
1427static void initheader (lua_State *L, Header *h) {
1428 h->L = L;
1429 h->islittle = nativeendian.little;
1430 h->maxalign = 1;
1431}
1432
1433
1434/*
1435** Read and classify next option. 'size' is filled with option's size.
1436*/
1437static KOption getoption (Header *h, const char **fmt, int *size) {
1438 int opt = *((*fmt)++);
1439 *size = 0; /* default */
1440 switch (opt) {
1441 case 'b': *size = sizeof(char); return Kint;
1442 case 'B': *size = sizeof(char); return Kuint;
1443 case 'h': *size = sizeof(short); return Kint;
1444 case 'H': *size = sizeof(short); return Kuint;
1445 case 'l': *size = sizeof(long); return Kint;
1446 case 'L': *size = sizeof(long); return Kuint;
1447 case 'j': *size = sizeof(lua_Integer); return Kint;
1448 case 'J': *size = sizeof(lua_Integer); return Kuint;
1449 case 'T': *size = sizeof(size_t); return Kuint;
1450 case 'f': *size = sizeof(float); return Kfloat;
1451 case 'n': *size = sizeof(lua_Number); return Knumber;
1452 case 'd': *size = sizeof(double); return Kdouble;
1453 case 'i': *size = getnumlimit(h, fmt, sizeof(int)); return Kint;
1454 case 'I': *size = getnumlimit(h, fmt, sizeof(int)); return Kuint;
1455 case 's': *size = getnumlimit(h, fmt, sizeof(size_t)); return Kstring;
1456 case 'c':
1457 *size = getnum(fmt, -1);
1458 if (l_unlikely(*size == -1))
1459 luaL_error(h->L, "missing size for format option 'c'");
1460 return Kchar;
1461 case 'z': return Kzstr;
1462 case 'x': *size = 1; return Kpadding;
1463 case 'X': return Kpaddalign;
1464 case ' ': break;
1465 case '<': h->islittle = 1; break;
1466 case '>': h->islittle = 0; break;
1467 case '=': h->islittle = nativeendian.little; break;
1468 case '!': h->maxalign = getnumlimit(h, fmt, MAXALIGN); break;
1469 default: luaL_error(h->L, "invalid format option '%c'", opt);
1470 }
1471 return Knop;
1472}
1473
1474
1475/*
1476** Read, classify, and fill other details about the next option.
1477** 'psize' is filled with option's size, 'notoalign' with its
1478** alignment requirements.
1479** Local variable 'size' gets the size to be aligned. (Kpadal option
1480** always gets its full alignment, other options are limited by
1481** the maximum alignment ('maxalign'). Kchar option needs no alignment
1482** despite its size.
1483*/
1484static KOption getdetails (Header *h, size_t totalsize,
1485 const char **fmt, int *psize, int *ntoalign) {
1486 KOption opt = getoption(h, fmt, psize);
1487 int align = *psize; /* usually, alignment follows size */
1488 if (opt == Kpaddalign) { /* 'X' gets alignment from following option */
1489 if (**fmt == '\0' || getoption(h, fmt, &align) == Kchar || align == 0)
1490 luaL_argerror(h->L, 1, "invalid next option for option 'X'");
1491 }
1492 if (align <= 1 || opt == Kchar) /* need no alignment? */
1493 *ntoalign = 0;
1494 else {
1495 if (align > h->maxalign) /* enforce maximum alignment */
1496 align = h->maxalign;
1497 if (l_unlikely((align & (align - 1)) != 0)) /* not a power of 2? */
1498 luaL_argerror(h->L, 1, "format asks for alignment not power of 2");
1499 *ntoalign = (align - (int)(totalsize & (align - 1))) & (align - 1);
1500 }
1501 return opt;
1502}
1503
1504
1505/*
1506** Pack integer 'n' with 'size' bytes and 'islittle' endianness.
1507** The final 'if' handles the case when 'size' is larger than
1508** the size of a Lua integer, correcting the extra sign-extension
1509** bytes if necessary (by default they would be zeros).
1510*/
1511static void packint (luaL_Buffer *b, lua_Unsigned n,
1512 int islittle, int size, int neg) {
1513 char *buff = luaL_prepbuffsize(b, size);
1514 int i;
1515 buff[islittle ? 0 : size - 1] = (char)(n & MC); /* first byte */
1516 for (i = 1; i < size; i++) {
1517 n >>= NB;
1518 buff[islittle ? i : size - 1 - i] = (char)(n & MC);
1519 }
1520 if (neg && size > SZINT) { /* negative number need sign extension? */
1521 for (i = SZINT; i < size; i++) /* correct extra bytes */
1522 buff[islittle ? i : size - 1 - i] = (char)MC;
1523 }
1524 luaL_addsize(b, size); /* add result to buffer */
1525}
1526
1527
1528/*
1529** Copy 'size' bytes from 'src' to 'dest', correcting endianness if
1530** given 'islittle' is different from native endianness.
1531*/
1532static void copywithendian (char *dest, const char *src,
1533 int size, int islittle) {
1534 if (islittle == nativeendian.little)
1535 memcpy(dest, src, size);
1536 else {
1537 dest += size - 1;
1538 while (size-- != 0)
1539 *(dest--) = *(src++);
1540 }
1541}
1542
1543
1544static int str_pack (lua_State *L) {
1545 luaL_Buffer b;
1546 Header h;
1547 const char *fmt = luaL_checkstring(L, 1); /* format string */
1548 int arg = 1; /* current argument to pack */
1549 size_t totalsize = 0; /* accumulate total size of result */
1550 initheader(L, &h);
1551 lua_pushnil(L); /* mark to separate arguments from string buffer */
1552 luaL_buffinit(L, &b);
1553 while (*fmt != '\0') {
1554 int size, ntoalign;
1555 KOption opt = getdetails(&h, totalsize, &fmt, &size, &ntoalign);
1556 totalsize += ntoalign + size;
1557 while (ntoalign-- > 0)
1558 luaL_addchar(&b, LUAL_PACKPADBYTE); /* fill alignment */
1559 arg++;
1560 switch (opt) {
1561 case Kint: { /* signed integers */
1562 lua_Integer n = luaL_checkinteger(L, arg);
1563 if (size < SZINT) { /* need overflow check? */
1564 lua_Integer lim = (lua_Integer)1 << ((size * NB) - 1);
1565 luaL_argcheck(L, -lim <= n && n < lim, arg, "integer overflow");
1566 }
1567 packint(&b, (lua_Unsigned)n, h.islittle, size, (n < 0));
1568 break;
1569 }
1570 case Kuint: { /* unsigned integers */
1571 lua_Integer n = luaL_checkinteger(L, arg);
1572 if (size < SZINT) /* need overflow check? */
1573 luaL_argcheck(L, (lua_Unsigned)n < ((lua_Unsigned)1 << (size * NB)),
1574 arg, "unsigned overflow");
1575 packint(&b, (lua_Unsigned)n, h.islittle, size, 0);
1576 break;
1577 }
1578 case Kfloat: { /* C float */
1579 float f = (float)luaL_checknumber(L, arg); /* get argument */
1580 char *buff = luaL_prepbuffsize(&b, sizeof(f));
1581 /* move 'f' to final result, correcting endianness if needed */
1582 copywithendian(buff, (char *)&f, sizeof(f), h.islittle);
1583 luaL_addsize(&b, size);
1584 break;
1585 }
1586 case Knumber: { /* Lua float */
1587 lua_Number f = luaL_checknumber(L, arg); /* get argument */
1588 char *buff = luaL_prepbuffsize(&b, sizeof(f));
1589 /* move 'f' to final result, correcting endianness if needed */
1590 copywithendian(buff, (char *)&f, sizeof(f), h.islittle);
1591 luaL_addsize(&b, size);
1592 break;
1593 }
1594 case Kdouble: { /* C double */
1595 double f = (double)luaL_checknumber(L, arg); /* get argument */
1596 char *buff = luaL_prepbuffsize(&b, sizeof(f));
1597 /* move 'f' to final result, correcting endianness if needed */
1598 copywithendian(buff, (char *)&f, sizeof(f), h.islittle);
1599 luaL_addsize(&b, size);
1600 break;
1601 }
1602 case Kchar: { /* fixed-size string */
1603 size_t len;
1604 const char *s = luaL_checklstring(L, arg, &len);
1605 luaL_argcheck(L, len <= (size_t)size, arg,
1606 "string longer than given size");
1607 luaL_addlstring(&b, s, len); /* add string */
1608 while (len++ < (size_t)size) /* pad extra space */
1609 luaL_addchar(&b, LUAL_PACKPADBYTE);
1610 break;
1611 }
1612 case Kstring: { /* strings with length count */
1613 size_t len;
1614 const char *s = luaL_checklstring(L, arg, &len);
1615 luaL_argcheck(L, size >= (int)sizeof(size_t) ||
1616 len < ((size_t)1 << (size * NB)),
1617 arg, "string length does not fit in given size");
1618 packint(&b, (lua_Unsigned)len, h.islittle, size, 0); /* pack length */
1619 luaL_addlstring(&b, s, len);
1620 totalsize += len;
1621 break;
1622 }
1623 case Kzstr: { /* zero-terminated string */
1624 size_t len;
1625 const char *s = luaL_checklstring(L, arg, &len);
1626 luaL_argcheck(L, strlen(s) == len, arg, "string contains zeros");
1627 luaL_addlstring(&b, s, len);
1628 luaL_addchar(&b, '\0'); /* add zero at the end */
1629 totalsize += len + 1;
1630 break;
1631 }
1632 case Kpadding: luaL_addchar(&b, LUAL_PACKPADBYTE); /* FALLTHROUGH */
1633 case Kpaddalign: case Knop:
1634 arg--; /* undo increment */
1635 break;
1636 }
1637 }
1638 luaL_pushresult(&b);
1639 return 1;
1640}
1641
1642
1643static int str_packsize (lua_State *L) {
1644 Header h;
1645 const char *fmt = luaL_checkstring(L, 1); /* format string */
1646 size_t totalsize = 0; /* accumulate total size of result */
1647 initheader(L, &h);
1648 while (*fmt != '\0') {
1649 int size, ntoalign;
1650 KOption opt = getdetails(&h, totalsize, &fmt, &size, &ntoalign);
1651 luaL_argcheck(L, opt != Kstring && opt != Kzstr, 1,
1652 "variable-length format");
1653 size += ntoalign; /* total space used by option */
1654 luaL_argcheck(L, totalsize <= MAXSIZE - size, 1,
1655 "format result too large");
1656 totalsize += size;
1657 }
1658 lua_pushinteger(L, (lua_Integer)totalsize);
1659 return 1;
1660}
1661
1662
1663/*
1664** Unpack an integer with 'size' bytes and 'islittle' endianness.
1665** If size is smaller than the size of a Lua integer and integer
1666** is signed, must do sign extension (propagating the sign to the
1667** higher bits); if size is larger than the size of a Lua integer,
1668** it must check the unread bytes to see whether they do not cause an
1669** overflow.
1670*/
1671static lua_Integer unpackint (lua_State *L, const char *str,
1672 int islittle, int size, int issigned) {
1673 lua_Unsigned res = 0;
1674 int i;
1675 int limit = (size <= SZINT) ? size : SZINT;
1676 for (i = limit - 1; i >= 0; i--) {
1677 res <<= NB;
1678 res |= (lua_Unsigned)(unsigned char)str[islittle ? i : size - 1 - i];
1679 }
1680 if (size < SZINT) { /* real size smaller than lua_Integer? */
1681 if (issigned) { /* needs sign extension? */
1682 lua_Unsigned mask = (lua_Unsigned)1 << (size*NB - 1);
1683 res = ((res ^ mask) - mask); /* do sign extension */
1684 }
1685 }
1686 else if (size > SZINT) { /* must check unread bytes */
1687 int mask = (!issigned || (lua_Integer)res >= 0) ? 0 : MC;
1688 for (i = limit; i < size; i++) {
1689 if (l_unlikely((unsigned char)str[islittle ? i : size - 1 - i] != mask))
1690 luaL_error(L, "%d-byte integer does not fit into Lua Integer", size);
1691 }
1692 }
1693 return (lua_Integer)res;
1694}
1695
1696
1697static int str_unpack (lua_State *L) {
1698 Header h;
1699 const char *fmt = luaL_checkstring(L, 1);
1700 size_t ld;
1701 const char *data = luaL_checklstring(L, 2, &ld);
1702 size_t pos = posrelatI(luaL_optinteger(L, 3, 1), ld) - 1;
1703 int n = 0; /* number of results */
1704 luaL_argcheck(L, pos <= ld, 3, "initial position out of string");
1705 initheader(L, &h);
1706 while (*fmt != '\0') {
1707 int size, ntoalign;
1708 KOption opt = getdetails(&h, pos, &fmt, &size, &ntoalign);
1709 luaL_argcheck(L, (size_t)ntoalign + size <= ld - pos, 2,
1710 "data string too short");
1711 pos += ntoalign; /* skip alignment */
1712 /* stack space for item + next position */
1713 luaL_checkstack(L, 2, "too many results");
1714 n++;
1715 switch (opt) {
1716 case Kint:
1717 case Kuint: {
1718 lua_Integer res = unpackint(L, data + pos, h.islittle, size,
1719 (opt == Kint));
1720 lua_pushinteger(L, res);
1721 break;
1722 }
1723 case Kfloat: {
1724 float f;
1725 copywithendian((char *)&f, data + pos, sizeof(f), h.islittle);
1726 lua_pushnumber(L, (lua_Number)f);
1727 break;
1728 }
1729 case Knumber: {
1730 lua_Number f;
1731 copywithendian((char *)&f, data + pos, sizeof(f), h.islittle);
1732 lua_pushnumber(L, f);
1733 break;
1734 }
1735 case Kdouble: {
1736 double f;
1737 copywithendian((char *)&f, data + pos, sizeof(f), h.islittle);
1738 lua_pushnumber(L, (lua_Number)f);
1739 break;
1740 }
1741 case Kchar: {
1742 lua_pushlstring(L, data + pos, size);
1743 break;
1744 }
1745 case Kstring: {
1746 size_t len = (size_t)unpackint(L, data + pos, h.islittle, size, 0);
1747 luaL_argcheck(L, len <= ld - pos - size, 2, "data string too short");
1748 lua_pushlstring(L, data + pos + size, len);
1749 pos += len; /* skip string */
1750 break;
1751 }
1752 case Kzstr: {
1753 size_t len = strlen(data + pos);
1754 luaL_argcheck(L, pos + len < ld, 2,
1755 "unfinished string for format 'z'");
1756 lua_pushlstring(L, data + pos, len);
1757 pos += len + 1; /* skip string plus final '\0' */
1758 break;
1759 }
1760 case Kpaddalign: case Kpadding: case Knop:
1761 n--; /* undo increment */
1762 break;
1763 }
1764 pos += size;
1765 }
1766 lua_pushinteger(L, pos + 1); /* next position */
1767 return n + 1;
1768}
1769
1770/* }====================================================== */
1771
1772
1773static const luaL_Reg strlib[] = {
1774 {"byte", str_byte},
1775 {"char", str_char},
1776 {"dump", str_dump},
1777 {"find", str_find},
1778 {"format", str_format},
1779 {"gmatch", gmatch},
1780 {"gsub", str_gsub},
1781 {"len", str_len},
1782 {"lower", str_lower},
1783 {"match", str_match},
1784 {"rep", str_rep},
1785 {"reverse", str_reverse},
1786 {"sub", str_sub},
1787 {"upper", str_upper},
1788 {"pack", str_pack},
1789 {"packsize", str_packsize},
1790 {"unpack", str_unpack},
1791 {NULL, NULL}
1792};
1793
1794
1795static void createmetatable (lua_State *L) {
1796 /* table to be metatable for strings */
1797 luaL_newlibtable(L, stringmetamethods);
1798 luaL_setfuncs(L, stringmetamethods, 0);
1799 lua_pushliteral(L, ""); /* dummy string */
1800 lua_pushvalue(L, -2); /* copy table */
1801 lua_setmetatable(L, -2); /* set table as metatable for strings */
1802 lua_pop(L, 1); /* pop dummy string */
1803 lua_pushvalue(L, -2); /* get string library */
1804 lua_setfield(L, -2, "__index"); /* metatable.__index = string */
1805 lua_pop(L, 1); /* pop metatable */
1806}
1807
1808
1809/*
1810** Open string library
1811*/
1812LUAMOD_API int luaopen_string (lua_State *L) {
1813 luaL_newlib(L, strlib);
1814 createmetatable(L);
1815 return 1;
1816}
1817
diff --git a/src/lua/ltable.c b/src/lua/ltable.c
deleted file mode 100644
index 33c1ab3..0000000
--- a/src/lua/ltable.c
+++ /dev/null
@@ -1,971 +0,0 @@
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/*
72** When the original hash value is good, hashing by a power of 2
73** avoids the cost of '%'.
74*/
75#define hashpow2(t,n) (gnode(t, lmod((n), sizenode(t))))
76
77/*
78** for other types, it is better to avoid modulo by power of 2, as
79** they can have many 2 factors.
80*/
81#define hashmod(t,n) (gnode(t, ((n) % ((sizenode(t)-1)|1))))
82
83
84#define hashstr(t,str) hashpow2(t, (str)->hash)
85#define hashboolean(t,p) hashpow2(t, p)
86
87#define hashint(t,i) hashpow2(t, i)
88
89
90#define hashpointer(t,p) hashmod(t, point2uint(p))
91
92
93#define dummynode (&dummynode_)
94
95static const Node dummynode_ = {
96 {{NULL}, LUA_VEMPTY, /* value's value and type */
97 LUA_VNIL, 0, {NULL}} /* key type, next, and key value */
98};
99
100
101static const TValue absentkey = {ABSTKEYCONSTANT};
102
103
104
105/*
106** Hash for floating-point numbers.
107** The main computation should be just
108** n = frexp(n, &i); return (n * INT_MAX) + i
109** but there are some numerical subtleties.
110** In a two-complement representation, INT_MAX does not has an exact
111** representation as a float, but INT_MIN does; because the absolute
112** value of 'frexp' is smaller than 1 (unless 'n' is inf/NaN), the
113** absolute value of the product 'frexp * -INT_MIN' is smaller or equal
114** to INT_MAX. Next, the use of 'unsigned int' avoids overflows when
115** adding 'i'; the use of '~u' (instead of '-u') avoids problems with
116** INT_MIN.
117*/
118#if !defined(l_hashfloat)
119static int l_hashfloat (lua_Number n) {
120 int i;
121 lua_Integer ni;
122 n = l_mathop(frexp)(n, &i) * -cast_num(INT_MIN);
123 if (!lua_numbertointeger(n, &ni)) { /* is 'n' inf/-inf/NaN? */
124 lua_assert(luai_numisnan(n) || l_mathop(fabs)(n) == cast_num(HUGE_VAL));
125 return 0;
126 }
127 else { /* normal case */
128 unsigned int u = cast_uint(i) + cast_uint(ni);
129 return cast_int(u <= cast_uint(INT_MAX) ? u : ~u);
130 }
131}
132#endif
133
134
135/*
136** returns the 'main' position of an element in a table (that is,
137** the index of its hash value). The key comes broken (tag in 'ktt'
138** and value in 'vkl') so that we can call it on keys inserted into
139** nodes.
140*/
141static Node *mainposition (const Table *t, int ktt, const Value *kvl) {
142 switch (withvariant(ktt)) {
143 case LUA_VNUMINT: {
144 lua_Integer key = ivalueraw(*kvl);
145 return hashint(t, key);
146 }
147 case LUA_VNUMFLT: {
148 lua_Number n = fltvalueraw(*kvl);
149 return hashmod(t, l_hashfloat(n));
150 }
151 case LUA_VSHRSTR: {
152 TString *ts = tsvalueraw(*kvl);
153 return hashstr(t, ts);
154 }
155 case LUA_VLNGSTR: {
156 TString *ts = tsvalueraw(*kvl);
157 return hashpow2(t, luaS_hashlongstr(ts));
158 }
159 case LUA_VFALSE:
160 return hashboolean(t, 0);
161 case LUA_VTRUE:
162 return hashboolean(t, 1);
163 case LUA_VLIGHTUSERDATA: {
164 void *p = pvalueraw(*kvl);
165 return hashpointer(t, p);
166 }
167 case LUA_VLCF: {
168 lua_CFunction f = fvalueraw(*kvl);
169 return hashpointer(t, f);
170 }
171 default: {
172 GCObject *o = gcvalueraw(*kvl);
173 return hashpointer(t, o);
174 }
175 }
176}
177
178
179/*
180** Returns the main position of an element given as a 'TValue'
181*/
182static Node *mainpositionTV (const Table *t, const TValue *key) {
183 return mainposition(t, rawtt(key), valraw(key));
184}
185
186
187/*
188** Check whether key 'k1' is equal to the key in node 'n2'. This
189** equality is raw, so there are no metamethods. Floats with integer
190** values have been normalized, so integers cannot be equal to
191** floats. It is assumed that 'eqshrstr' is simply pointer equality, so
192** that short strings are handled in the default case.
193** A true 'deadok' means to accept dead keys as equal to their original
194** values. All dead keys are compared in the default case, by pointer
195** identity. (Only collectable objects can produce dead keys.) Note that
196** dead long strings are also compared by identity.
197** Once a key is dead, its corresponding value may be collected, and
198** then another value can be created with the same address. If this
199** other value is given to 'next', 'equalkey' will signal a false
200** positive. In a regular traversal, this situation should never happen,
201** as all keys given to 'next' came from the table itself, and therefore
202** could not have been collected. Outside a regular traversal, we
203** have garbage in, garbage out. What is relevant is that this false
204** positive does not break anything. (In particular, 'next' will return
205** some other valid item on the table or nil.)
206*/
207static int equalkey (const TValue *k1, const Node *n2, int deadok) {
208 if ((rawtt(k1) != keytt(n2)) && /* not the same variants? */
209 !(deadok && keyisdead(n2) && iscollectable(k1)))
210 return 0; /* cannot be same key */
211 switch (keytt(n2)) {
212 case LUA_VNIL: case LUA_VFALSE: case LUA_VTRUE:
213 return 1;
214 case LUA_VNUMINT:
215 return (ivalue(k1) == keyival(n2));
216 case LUA_VNUMFLT:
217 return luai_numeq(fltvalue(k1), fltvalueraw(keyval(n2)));
218 case LUA_VLIGHTUSERDATA:
219 return pvalue(k1) == pvalueraw(keyval(n2));
220 case LUA_VLCF:
221 return fvalue(k1) == fvalueraw(keyval(n2));
222 case ctb(LUA_VLNGSTR):
223 return luaS_eqlngstr(tsvalue(k1), keystrval(n2));
224 default:
225 return gcvalue(k1) == gcvalueraw(keyval(n2));
226 }
227}
228
229
230/*
231** True if value of 'alimit' is equal to the real size of the array
232** part of table 't'. (Otherwise, the array part must be larger than
233** 'alimit'.)
234*/
235#define limitequalsasize(t) (isrealasize(t) || ispow2((t)->alimit))
236
237
238/*
239** Returns the real size of the 'array' array
240*/
241LUAI_FUNC unsigned int luaH_realasize (const Table *t) {
242 if (limitequalsasize(t))
243 return t->alimit; /* this is the size */
244 else {
245 unsigned int size = t->alimit;
246 /* compute the smallest power of 2 not smaller than 'n' */
247 size |= (size >> 1);
248 size |= (size >> 2);
249 size |= (size >> 4);
250 size |= (size >> 8);
251 size |= (size >> 16);
252#if (UINT_MAX >> 30) > 3
253 size |= (size >> 32); /* unsigned int has more than 32 bits */
254#endif
255 size++;
256 lua_assert(ispow2(size) && size/2 < t->alimit && t->alimit < size);
257 return size;
258 }
259}
260
261
262/*
263** Check whether real size of the array is a power of 2.
264** (If it is not, 'alimit' cannot be changed to any other value
265** without changing the real size.)
266*/
267static int ispow2realasize (const Table *t) {
268 return (!isrealasize(t) || ispow2(t->alimit));
269}
270
271
272static unsigned int setlimittosize (Table *t) {
273 t->alimit = luaH_realasize(t);
274 setrealasize(t);
275 return t->alimit;
276}
277
278
279#define limitasasize(t) check_exp(isrealasize(t), t->alimit)
280
281
282
283/*
284** "Generic" get version. (Not that generic: not valid for integers,
285** which may be in array part, nor for floats with integral values.)
286** See explanation about 'deadok' in function 'equalkey'.
287*/
288static const TValue *getgeneric (Table *t, const TValue *key, int deadok) {
289 Node *n = mainpositionTV(t, key);
290 for (;;) { /* check whether 'key' is somewhere in the chain */
291 if (equalkey(key, n, deadok))
292 return gval(n); /* that's it */
293 else {
294 int nx = gnext(n);
295 if (nx == 0)
296 return &absentkey; /* not found */
297 n += nx;
298 }
299 }
300}
301
302
303/*
304** returns the index for 'k' if 'k' is an appropriate key to live in
305** the array part of a table, 0 otherwise.
306*/
307static unsigned int arrayindex (lua_Integer k) {
308 if (l_castS2U(k) - 1u < MAXASIZE) /* 'k' in [1, MAXASIZE]? */
309 return cast_uint(k); /* 'key' is an appropriate array index */
310 else
311 return 0;
312}
313
314
315/*
316** returns the index of a 'key' for table traversals. First goes all
317** elements in the array part, then elements in the hash part. The
318** beginning of a traversal is signaled by 0.
319*/
320static unsigned int findindex (lua_State *L, Table *t, TValue *key,
321 unsigned int asize) {
322 unsigned int i;
323 if (ttisnil(key)) return 0; /* first iteration */
324 i = ttisinteger(key) ? arrayindex(ivalue(key)) : 0;
325 if (i - 1u < asize) /* is 'key' inside array part? */
326 return i; /* yes; that's the index */
327 else {
328 const TValue *n = getgeneric(t, key, 1);
329 if (l_unlikely(isabstkey(n)))
330 luaG_runerror(L, "invalid key to 'next'"); /* key not found */
331 i = cast_int(nodefromval(n) - gnode(t, 0)); /* key index in hash table */
332 /* hash elements are numbered after array ones */
333 return (i + 1) + asize;
334 }
335}
336
337
338int luaH_next (lua_State *L, Table *t, StkId key) {
339 unsigned int asize = luaH_realasize(t);
340 unsigned int i = findindex(L, t, s2v(key), asize); /* find original key */
341 for (; i < asize; i++) { /* try first array part */
342 if (!isempty(&t->array[i])) { /* a non-empty entry? */
343 setivalue(s2v(key), i + 1);
344 setobj2s(L, key + 1, &t->array[i]);
345 return 1;
346 }
347 }
348 for (i -= asize; cast_int(i) < sizenode(t); i++) { /* hash part */
349 if (!isempty(gval(gnode(t, i)))) { /* a non-empty entry? */
350 Node *n = gnode(t, i);
351 getnodekey(L, s2v(key), n);
352 setobj2s(L, key + 1, gval(n));
353 return 1;
354 }
355 }
356 return 0; /* no more elements */
357}
358
359
360static void freehash (lua_State *L, Table *t) {
361 if (!isdummy(t))
362 luaM_freearray(L, t->node, cast_sizet(sizenode(t)));
363}
364
365
366/*
367** {=============================================================
368** Rehash
369** ==============================================================
370*/
371
372/*
373** Compute the optimal size for the array part of table 't'. 'nums' is a
374** "count array" where 'nums[i]' is the number of integers in the table
375** between 2^(i - 1) + 1 and 2^i. 'pna' enters with the total number of
376** integer keys in the table and leaves with the number of keys that
377** will go to the array part; return the optimal size. (The condition
378** 'twotoi > 0' in the for loop stops the loop if 'twotoi' overflows.)
379*/
380static unsigned int computesizes (unsigned int nums[], unsigned int *pna) {
381 int i;
382 unsigned int twotoi; /* 2^i (candidate for optimal size) */
383 unsigned int a = 0; /* number of elements smaller than 2^i */
384 unsigned int na = 0; /* number of elements to go to array part */
385 unsigned int optimal = 0; /* optimal size for array part */
386 /* loop while keys can fill more than half of total size */
387 for (i = 0, twotoi = 1;
388 twotoi > 0 && *pna > twotoi / 2;
389 i++, twotoi *= 2) {
390 a += nums[i];
391 if (a > twotoi/2) { /* more than half elements present? */
392 optimal = twotoi; /* optimal size (till now) */
393 na = a; /* all elements up to 'optimal' will go to array part */
394 }
395 }
396 lua_assert((optimal == 0 || optimal / 2 < na) && na <= optimal);
397 *pna = na;
398 return optimal;
399}
400
401
402static int countint (lua_Integer key, unsigned int *nums) {
403 unsigned int k = arrayindex(key);
404 if (k != 0) { /* is 'key' an appropriate array index? */
405 nums[luaO_ceillog2(k)]++; /* count as such */
406 return 1;
407 }
408 else
409 return 0;
410}
411
412
413/*
414** Count keys in array part of table 't': Fill 'nums[i]' with
415** number of keys that will go into corresponding slice and return
416** total number of non-nil keys.
417*/
418static unsigned int numusearray (const Table *t, unsigned int *nums) {
419 int lg;
420 unsigned int ttlg; /* 2^lg */
421 unsigned int ause = 0; /* summation of 'nums' */
422 unsigned int i = 1; /* count to traverse all array keys */
423 unsigned int asize = limitasasize(t); /* real array size */
424 /* traverse each slice */
425 for (lg = 0, ttlg = 1; lg <= MAXABITS; lg++, ttlg *= 2) {
426 unsigned int lc = 0; /* counter */
427 unsigned int lim = ttlg;
428 if (lim > asize) {
429 lim = asize; /* adjust upper limit */
430 if (i > lim)
431 break; /* no more elements to count */
432 }
433 /* count elements in range (2^(lg - 1), 2^lg] */
434 for (; i <= lim; i++) {
435 if (!isempty(&t->array[i-1]))
436 lc++;
437 }
438 nums[lg] += lc;
439 ause += lc;
440 }
441 return ause;
442}
443
444
445static int numusehash (const Table *t, unsigned int *nums, unsigned int *pna) {
446 int totaluse = 0; /* total number of elements */
447 int ause = 0; /* elements added to 'nums' (can go to array part) */
448 int i = sizenode(t);
449 while (i--) {
450 Node *n = &t->node[i];
451 if (!isempty(gval(n))) {
452 if (keyisinteger(n))
453 ause += countint(keyival(n), nums);
454 totaluse++;
455 }
456 }
457 *pna += ause;
458 return totaluse;
459}
460
461
462/*
463** Creates an array for the hash part of a table with the given
464** size, or reuses the dummy node if size is zero.
465** The computation for size overflow is in two steps: the first
466** comparison ensures that the shift in the second one does not
467** overflow.
468*/
469static void setnodevector (lua_State *L, Table *t, unsigned int size) {
470 if (size == 0) { /* no elements to hash part? */
471 t->node = cast(Node *, dummynode); /* use common 'dummynode' */
472 t->lsizenode = 0;
473 t->lastfree = NULL; /* signal that it is using dummy node */
474 }
475 else {
476 int i;
477 int lsize = luaO_ceillog2(size);
478 if (lsize > MAXHBITS || (1u << lsize) > MAXHSIZE)
479 luaG_runerror(L, "table overflow");
480 size = twoto(lsize);
481 t->node = luaM_newvector(L, size, Node);
482 for (i = 0; i < (int)size; i++) {
483 Node *n = gnode(t, i);
484 gnext(n) = 0;
485 setnilkey(n);
486 setempty(gval(n));
487 }
488 t->lsizenode = cast_byte(lsize);
489 t->lastfree = gnode(t, size); /* all positions are free */
490 }
491}
492
493
494/*
495** (Re)insert all elements from the hash part of 'ot' into table 't'.
496*/
497static void reinsert (lua_State *L, Table *ot, Table *t) {
498 int j;
499 int size = sizenode(ot);
500 for (j = 0; j < size; j++) {
501 Node *old = gnode(ot, j);
502 if (!isempty(gval(old))) {
503 /* doesn't need barrier/invalidate cache, as entry was
504 already present in the table */
505 TValue k;
506 getnodekey(L, &k, old);
507 luaH_set(L, t, &k, gval(old));
508 }
509 }
510}
511
512
513/*
514** Exchange the hash part of 't1' and 't2'.
515*/
516static void exchangehashpart (Table *t1, Table *t2) {
517 lu_byte lsizenode = t1->lsizenode;
518 Node *node = t1->node;
519 Node *lastfree = t1->lastfree;
520 t1->lsizenode = t2->lsizenode;
521 t1->node = t2->node;
522 t1->lastfree = t2->lastfree;
523 t2->lsizenode = lsizenode;
524 t2->node = node;
525 t2->lastfree = lastfree;
526}
527
528
529/*
530** Resize table 't' for the new given sizes. Both allocations (for
531** the hash part and for the array part) can fail, which creates some
532** subtleties. If the first allocation, for the hash part, fails, an
533** error is raised and that is it. Otherwise, it copies the elements from
534** the shrinking part of the array (if it is shrinking) into the new
535** hash. Then it reallocates the array part. If that fails, the table
536** is in its original state; the function frees the new hash part and then
537** raises the allocation error. Otherwise, it sets the new hash part
538** into the table, initializes the new part of the array (if any) with
539** nils and reinserts the elements of the old hash back into the new
540** parts of the table.
541*/
542void luaH_resize (lua_State *L, Table *t, unsigned int newasize,
543 unsigned int nhsize) {
544 unsigned int i;
545 Table newt; /* to keep the new hash part */
546 unsigned int oldasize = setlimittosize(t);
547 TValue *newarray;
548 /* create new hash part with appropriate size into 'newt' */
549 setnodevector(L, &newt, nhsize);
550 if (newasize < oldasize) { /* will array shrink? */
551 t->alimit = newasize; /* pretend array has new size... */
552 exchangehashpart(t, &newt); /* and new hash */
553 /* re-insert into the new hash the elements from vanishing slice */
554 for (i = newasize; i < oldasize; i++) {
555 if (!isempty(&t->array[i]))
556 luaH_setint(L, t, i + 1, &t->array[i]);
557 }
558 t->alimit = oldasize; /* restore current size... */
559 exchangehashpart(t, &newt); /* and hash (in case of errors) */
560 }
561 /* allocate new array */
562 newarray = luaM_reallocvector(L, t->array, oldasize, newasize, TValue);
563 if (l_unlikely(newarray == NULL && newasize > 0)) { /* allocation failed? */
564 freehash(L, &newt); /* release new hash part */
565 luaM_error(L); /* raise error (with array unchanged) */
566 }
567 /* allocation ok; initialize new part of the array */
568 exchangehashpart(t, &newt); /* 't' has the new hash ('newt' has the old) */
569 t->array = newarray; /* set new array part */
570 t->alimit = newasize;
571 for (i = oldasize; i < newasize; i++) /* clear new slice of the array */
572 setempty(&t->array[i]);
573 /* re-insert elements from old hash part into new parts */
574 reinsert(L, &newt, t); /* 'newt' now has the old hash */
575 freehash(L, &newt); /* free old hash part */
576}
577
578
579void luaH_resizearray (lua_State *L, Table *t, unsigned int nasize) {
580 int nsize = allocsizenode(t);
581 luaH_resize(L, t, nasize, nsize);
582}
583
584/*
585** nums[i] = number of keys 'k' where 2^(i - 1) < k <= 2^i
586*/
587static void rehash (lua_State *L, Table *t, const TValue *ek) {
588 unsigned int asize; /* optimal size for array part */
589 unsigned int na; /* number of keys in the array part */
590 unsigned int nums[MAXABITS + 1];
591 int i;
592 int totaluse;
593 for (i = 0; i <= MAXABITS; i++) nums[i] = 0; /* reset counts */
594 setlimittosize(t);
595 na = numusearray(t, nums); /* count keys in array part */
596 totaluse = na; /* all those keys are integer keys */
597 totaluse += numusehash(t, nums, &na); /* count keys in hash part */
598 /* count extra key */
599 if (ttisinteger(ek))
600 na += countint(ivalue(ek), nums);
601 totaluse++;
602 /* compute new size for array part */
603 asize = computesizes(nums, &na);
604 /* resize the table to new computed sizes */
605 luaH_resize(L, t, asize, totaluse - na);
606}
607
608
609
610/*
611** }=============================================================
612*/
613
614
615Table *luaH_new (lua_State *L) {
616 GCObject *o = luaC_newobj(L, LUA_VTABLE, sizeof(Table));
617 Table *t = gco2t(o);
618 t->metatable = NULL;
619 t->flags = cast_byte(maskflags); /* table has no metamethod fields */
620 t->array = NULL;
621 t->alimit = 0;
622 setnodevector(L, t, 0);
623 return t;
624}
625
626
627void luaH_free (lua_State *L, Table *t) {
628 freehash(L, t);
629 luaM_freearray(L, t->array, luaH_realasize(t));
630 luaM_free(L, t);
631}
632
633
634static Node *getfreepos (Table *t) {
635 if (!isdummy(t)) {
636 while (t->lastfree > t->node) {
637 t->lastfree--;
638 if (keyisnil(t->lastfree))
639 return t->lastfree;
640 }
641 }
642 return NULL; /* could not find a free place */
643}
644
645
646
647/*
648** inserts a new key into a hash table; first, check whether key's main
649** position is free. If not, check whether colliding node is in its main
650** position or not: if it is not, move colliding node to an empty place and
651** put new key in its main position; otherwise (colliding node is in its main
652** position), new key goes to an empty position.
653*/
654void luaH_newkey (lua_State *L, Table *t, const TValue *key, TValue *value) {
655 Node *mp;
656 TValue aux;
657 if (l_unlikely(ttisnil(key)))
658 luaG_runerror(L, "table index is nil");
659 else if (ttisfloat(key)) {
660 lua_Number f = fltvalue(key);
661 lua_Integer k;
662 if (luaV_flttointeger(f, &k, F2Ieq)) { /* does key fit in an integer? */
663 setivalue(&aux, k);
664 key = &aux; /* insert it as an integer */
665 }
666 else if (l_unlikely(luai_numisnan(f)))
667 luaG_runerror(L, "table index is NaN");
668 }
669 if (ttisnil(value))
670 return; /* do not insert nil values */
671 mp = mainpositionTV(t, key);
672 if (!isempty(gval(mp)) || isdummy(t)) { /* main position is taken? */
673 Node *othern;
674 Node *f = getfreepos(t); /* get a free place */
675 if (f == NULL) { /* cannot find a free place? */
676 rehash(L, t, key); /* grow table */
677 /* whatever called 'newkey' takes care of TM cache */
678 luaH_set(L, t, key, value); /* insert key into grown table */
679 return;
680 }
681 lua_assert(!isdummy(t));
682 othern = mainposition(t, keytt(mp), &keyval(mp));
683 if (othern != mp) { /* is colliding node out of its main position? */
684 /* yes; move colliding node into free position */
685 while (othern + gnext(othern) != mp) /* find previous */
686 othern += gnext(othern);
687 gnext(othern) = cast_int(f - othern); /* rechain to point to 'f' */
688 *f = *mp; /* copy colliding node into free pos. (mp->next also goes) */
689 if (gnext(mp) != 0) {
690 gnext(f) += cast_int(mp - f); /* correct 'next' */
691 gnext(mp) = 0; /* now 'mp' is free */
692 }
693 setempty(gval(mp));
694 }
695 else { /* colliding node is in its own main position */
696 /* new node will go into free position */
697 if (gnext(mp) != 0)
698 gnext(f) = cast_int((mp + gnext(mp)) - f); /* chain new position */
699 else lua_assert(gnext(f) == 0);
700 gnext(mp) = cast_int(f - mp);
701 mp = f;
702 }
703 }
704 setnodekey(L, mp, key);
705 luaC_barrierback(L, obj2gco(t), key);
706 lua_assert(isempty(gval(mp)));
707 setobj2t(L, gval(mp), value);
708}
709
710
711/*
712** Search function for integers. If integer is inside 'alimit', get it
713** directly from the array part. Otherwise, if 'alimit' is not equal to
714** the real size of the array, key still can be in the array part. In
715** this case, try to avoid a call to 'luaH_realasize' when key is just
716** one more than the limit (so that it can be incremented without
717** changing the real size of the array).
718*/
719const TValue *luaH_getint (Table *t, lua_Integer key) {
720 if (l_castS2U(key) - 1u < t->alimit) /* 'key' in [1, t->alimit]? */
721 return &t->array[key - 1];
722 else if (!limitequalsasize(t) && /* key still may be in the array part? */
723 (l_castS2U(key) == t->alimit + 1 ||
724 l_castS2U(key) - 1u < luaH_realasize(t))) {
725 t->alimit = cast_uint(key); /* probably '#t' is here now */
726 return &t->array[key - 1];
727 }
728 else {
729 Node *n = hashint(t, key);
730 for (;;) { /* check whether 'key' is somewhere in the chain */
731 if (keyisinteger(n) && keyival(n) == key)
732 return gval(n); /* that's it */
733 else {
734 int nx = gnext(n);
735 if (nx == 0) break;
736 n += nx;
737 }
738 }
739 return &absentkey;
740 }
741}
742
743
744/*
745** search function for short strings
746*/
747const TValue *luaH_getshortstr (Table *t, TString *key) {
748 Node *n = hashstr(t, key);
749 lua_assert(key->tt == LUA_VSHRSTR);
750 for (;;) { /* check whether 'key' is somewhere in the chain */
751 if (keyisshrstr(n) && eqshrstr(keystrval(n), key))
752 return gval(n); /* that's it */
753 else {
754 int nx = gnext(n);
755 if (nx == 0)
756 return &absentkey; /* not found */
757 n += nx;
758 }
759 }
760}
761
762
763const TValue *luaH_getstr (Table *t, TString *key) {
764 if (key->tt == LUA_VSHRSTR)
765 return luaH_getshortstr(t, key);
766 else { /* for long strings, use generic case */
767 TValue ko;
768 setsvalue(cast(lua_State *, NULL), &ko, key);
769 return getgeneric(t, &ko, 0);
770 }
771}
772
773
774/*
775** main search function
776*/
777const TValue *luaH_get (Table *t, const TValue *key) {
778 switch (ttypetag(key)) {
779 case LUA_VSHRSTR: return luaH_getshortstr(t, tsvalue(key));
780 case LUA_VNUMINT: return luaH_getint(t, ivalue(key));
781 case LUA_VNIL: return &absentkey;
782 case LUA_VNUMFLT: {
783 lua_Integer k;
784 if (luaV_flttointeger(fltvalue(key), &k, F2Ieq)) /* integral index? */
785 return luaH_getint(t, k); /* use specialized version */
786 /* else... */
787 } /* FALLTHROUGH */
788 default:
789 return getgeneric(t, key, 0);
790 }
791}
792
793
794/*
795** Finish a raw "set table" operation, where 'slot' is where the value
796** should have been (the result of a previous "get table").
797** Beware: when using this function you probably need to check a GC
798** barrier and invalidate the TM cache.
799*/
800void luaH_finishset (lua_State *L, Table *t, const TValue *key,
801 const TValue *slot, TValue *value) {
802 if (isabstkey(slot))
803 luaH_newkey(L, t, key, value);
804 else
805 setobj2t(L, cast(TValue *, slot), value);
806}
807
808
809/*
810** beware: when using this function you probably need to check a GC
811** barrier and invalidate the TM cache.
812*/
813void luaH_set (lua_State *L, Table *t, const TValue *key, TValue *value) {
814 const TValue *slot = luaH_get(t, key);
815 luaH_finishset(L, t, key, slot, value);
816}
817
818
819void luaH_setint (lua_State *L, Table *t, lua_Integer key, TValue *value) {
820 const TValue *p = luaH_getint(t, key);
821 if (isabstkey(p)) {
822 TValue k;
823 setivalue(&k, key);
824 luaH_newkey(L, t, &k, value);
825 }
826 else
827 setobj2t(L, cast(TValue *, p), value);
828}
829
830
831/*
832** Try to find a boundary in the hash part of table 't'. From the
833** caller, we know that 'j' is zero or present and that 'j + 1' is
834** present. We want to find a larger key that is absent from the
835** table, so that we can do a binary search between the two keys to
836** find a boundary. We keep doubling 'j' until we get an absent index.
837** If the doubling would overflow, we try LUA_MAXINTEGER. If it is
838** absent, we are ready for the binary search. ('j', being max integer,
839** is larger or equal to 'i', but it cannot be equal because it is
840** absent while 'i' is present; so 'j > i'.) Otherwise, 'j' is a
841** boundary. ('j + 1' cannot be a present integer key because it is
842** not a valid integer in Lua.)
843*/
844static lua_Unsigned hash_search (Table *t, lua_Unsigned j) {
845 lua_Unsigned i;
846 if (j == 0) j++; /* the caller ensures 'j + 1' is present */
847 do {
848 i = j; /* 'i' is a present index */
849 if (j <= l_castS2U(LUA_MAXINTEGER) / 2)
850 j *= 2;
851 else {
852 j = LUA_MAXINTEGER;
853 if (isempty(luaH_getint(t, j))) /* t[j] not present? */
854 break; /* 'j' now is an absent index */
855 else /* weird case */
856 return j; /* well, max integer is a boundary... */
857 }
858 } while (!isempty(luaH_getint(t, j))); /* repeat until an absent t[j] */
859 /* i < j && t[i] present && t[j] absent */
860 while (j - i > 1u) { /* do a binary search between them */
861 lua_Unsigned m = (i + j) / 2;
862 if (isempty(luaH_getint(t, m))) j = m;
863 else i = m;
864 }
865 return i;
866}
867
868
869static unsigned int binsearch (const TValue *array, unsigned int i,
870 unsigned int j) {
871 while (j - i > 1u) { /* binary search */
872 unsigned int m = (i + j) / 2;
873 if (isempty(&array[m - 1])) j = m;
874 else i = m;
875 }
876 return i;
877}
878
879
880/*
881** Try to find a boundary in table 't'. (A 'boundary' is an integer index
882** such that t[i] is present and t[i+1] is absent, or 0 if t[1] is absent
883** and 'maxinteger' if t[maxinteger] is present.)
884** (In the next explanation, we use Lua indices, that is, with base 1.
885** The code itself uses base 0 when indexing the array part of the table.)
886** The code starts with 'limit = t->alimit', a position in the array
887** part that may be a boundary.
888**
889** (1) If 't[limit]' is empty, there must be a boundary before it.
890** As a common case (e.g., after 't[#t]=nil'), check whether 'limit-1'
891** is present. If so, it is a boundary. Otherwise, do a binary search
892** between 0 and limit to find a boundary. In both cases, try to
893** use this boundary as the new 'alimit', as a hint for the next call.
894**
895** (2) If 't[limit]' is not empty and the array has more elements
896** after 'limit', try to find a boundary there. Again, try first
897** the special case (which should be quite frequent) where 'limit+1'
898** is empty, so that 'limit' is a boundary. Otherwise, check the
899** last element of the array part. If it is empty, there must be a
900** boundary between the old limit (present) and the last element
901** (absent), which is found with a binary search. (This boundary always
902** can be a new limit.)
903**
904** (3) The last case is when there are no elements in the array part
905** (limit == 0) or its last element (the new limit) is present.
906** In this case, must check the hash part. If there is no hash part
907** or 'limit+1' is absent, 'limit' is a boundary. Otherwise, call
908** 'hash_search' to find a boundary in the hash part of the table.
909** (In those cases, the boundary is not inside the array part, and
910** therefore cannot be used as a new limit.)
911*/
912lua_Unsigned luaH_getn (Table *t) {
913 unsigned int limit = t->alimit;
914 if (limit > 0 && isempty(&t->array[limit - 1])) { /* (1)? */
915 /* there must be a boundary before 'limit' */
916 if (limit >= 2 && !isempty(&t->array[limit - 2])) {
917 /* 'limit - 1' is a boundary; can it be a new limit? */
918 if (ispow2realasize(t) && !ispow2(limit - 1)) {
919 t->alimit = limit - 1;
920 setnorealasize(t); /* now 'alimit' is not the real size */
921 }
922 return limit - 1;
923 }
924 else { /* must search for a boundary in [0, limit] */
925 unsigned int boundary = binsearch(t->array, 0, limit);
926 /* can this boundary represent the real size of the array? */
927 if (ispow2realasize(t) && boundary > luaH_realasize(t) / 2) {
928 t->alimit = boundary; /* use it as the new limit */
929 setnorealasize(t);
930 }
931 return boundary;
932 }
933 }
934 /* 'limit' is zero or present in table */
935 if (!limitequalsasize(t)) { /* (2)? */
936 /* 'limit' > 0 and array has more elements after 'limit' */
937 if (isempty(&t->array[limit])) /* 'limit + 1' is empty? */
938 return limit; /* this is the boundary */
939 /* else, try last element in the array */
940 limit = luaH_realasize(t);
941 if (isempty(&t->array[limit - 1])) { /* empty? */
942 /* there must be a boundary in the array after old limit,
943 and it must be a valid new limit */
944 unsigned int boundary = binsearch(t->array, t->alimit, limit);
945 t->alimit = boundary;
946 return boundary;
947 }
948 /* else, new limit is present in the table; check the hash part */
949 }
950 /* (3) 'limit' is the last element and either is zero or present in table */
951 lua_assert(limit == luaH_realasize(t) &&
952 (limit == 0 || !isempty(&t->array[limit - 1])));
953 if (isdummy(t) || isempty(luaH_getint(t, cast(lua_Integer, limit + 1))))
954 return limit; /* 'limit + 1' is absent */
955 else /* 'limit + 1' is also present */
956 return hash_search(t, limit);
957}
958
959
960
961#if defined(LUA_DEBUG)
962
963/* export these functions for the test library */
964
965Node *luaH_mainposition (const Table *t, const TValue *key) {
966 return mainpositionTV(t, key);
967}
968
969int luaH_isdummy (const Table *t) { return isdummy(t); }
970
971#endif
diff --git a/src/lua/ltable.h b/src/lua/ltable.h
deleted file mode 100644
index 7bbbcb2..0000000
--- a/src/lua/ltable.h
+++ /dev/null
@@ -1,66 +0,0 @@
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/*
19** Clear all bits of fast-access metamethods, which means that the table
20** may have any of these metamethods. (First access that fails after the
21** clearing will set the bit again.)
22*/
23#define invalidateTMcache(t) ((t)->flags &= ~maskflags)
24
25
26/* true when 't' is using 'dummynode' as its hash part */
27#define isdummy(t) ((t)->lastfree == NULL)
28
29
30/* allocated size for hash nodes */
31#define allocsizenode(t) (isdummy(t) ? 0 : sizenode(t))
32
33
34/* returns the Node, given the value of a table entry */
35#define nodefromval(v) cast(Node *, (v))
36
37
38LUAI_FUNC const TValue *luaH_getint (Table *t, lua_Integer key);
39LUAI_FUNC void luaH_setint (lua_State *L, Table *t, lua_Integer key,
40 TValue *value);
41LUAI_FUNC const TValue *luaH_getshortstr (Table *t, TString *key);
42LUAI_FUNC const TValue *luaH_getstr (Table *t, TString *key);
43LUAI_FUNC const TValue *luaH_get (Table *t, const TValue *key);
44LUAI_FUNC void luaH_newkey (lua_State *L, Table *t, const TValue *key,
45 TValue *value);
46LUAI_FUNC void luaH_set (lua_State *L, Table *t, const TValue *key,
47 TValue *value);
48LUAI_FUNC void luaH_finishset (lua_State *L, Table *t, const TValue *key,
49 const TValue *slot, TValue *value);
50LUAI_FUNC Table *luaH_new (lua_State *L);
51LUAI_FUNC void luaH_resize (lua_State *L, Table *t, unsigned int nasize,
52 unsigned int nhsize);
53LUAI_FUNC void luaH_resizearray (lua_State *L, Table *t, unsigned int nasize);
54LUAI_FUNC void luaH_free (lua_State *L, Table *t);
55LUAI_FUNC int luaH_next (lua_State *L, Table *t, StkId key);
56LUAI_FUNC lua_Unsigned luaH_getn (Table *t);
57LUAI_FUNC unsigned int luaH_realasize (const Table *t);
58
59
60#if defined(LUA_DEBUG)
61LUAI_FUNC Node *luaH_mainposition (const Table *t, const TValue *key);
62LUAI_FUNC int luaH_isdummy (const Table *t);
63#endif
64
65
66#endif
diff --git a/src/lua/ltablib.c b/src/lua/ltablib.c
deleted file mode 100644
index d80eb80..0000000
--- a/src/lua/ltablib.c
+++ /dev/null
@@ -1,429 +0,0 @@
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 (l_unlikely(!lua_isstring(L, -1)))
149 luaL_error(L, "invalid value (%s) at index %I 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 (l_unlikely(n >= (unsigned int)INT_MAX ||
200 !lua_checkstack(L, (int)(++n))))
201 return luaL_error(L, "too many results to unpack");
202 for (; i < e; i++) { /* push arg[i..e - 1] (to avoid overflows) */
203 lua_geti(L, 1, i);
204 }
205 lua_geti(L, 1, e); /* push last element */
206 return (int)n;
207}
208
209/* }====================================================== */
210
211
212
213/*
214** {======================================================
215** Quicksort
216** (based on 'Algorithms in MODULA-3', Robert Sedgewick;
217** Addison-Wesley, 1993.)
218** =======================================================
219*/
220
221
222/* type for array indices */
223typedef unsigned int IdxT;
224
225
226/*
227** Produce a "random" 'unsigned int' to randomize pivot choice. This
228** macro is used only when 'sort' detects a big imbalance in the result
229** of a partition. (If you don't want/need this "randomness", ~0 is a
230** good choice.)
231*/
232#if !defined(l_randomizePivot) /* { */
233
234#include <time.h>
235
236/* size of 'e' measured in number of 'unsigned int's */
237#define sof(e) (sizeof(e) / sizeof(unsigned int))
238
239/*
240** Use 'time' and 'clock' as sources of "randomness". Because we don't
241** know the types 'clock_t' and 'time_t', we cannot cast them to
242** anything without risking overflows. A safe way to use their values
243** is to copy them to an array of a known type and use the array values.
244*/
245static unsigned int l_randomizePivot (void) {
246 clock_t c = clock();
247 time_t t = time(NULL);
248 unsigned int buff[sof(c) + sof(t)];
249 unsigned int i, rnd = 0;
250 memcpy(buff, &c, sof(c) * sizeof(unsigned int));
251 memcpy(buff + sof(c), &t, sof(t) * sizeof(unsigned int));
252 for (i = 0; i < sof(buff); i++)
253 rnd += buff[i];
254 return rnd;
255}
256
257#endif /* } */
258
259
260/* arrays larger than 'RANLIMIT' may use randomized pivots */
261#define RANLIMIT 100u
262
263
264static void set2 (lua_State *L, IdxT i, IdxT j) {
265 lua_seti(L, 1, i);
266 lua_seti(L, 1, j);
267}
268
269
270/*
271** Return true iff value at stack index 'a' is less than the value at
272** index 'b' (according to the order of the sort).
273*/
274static int sort_comp (lua_State *L, int a, int b) {
275 if (lua_isnil(L, 2)) /* no function? */
276 return lua_compare(L, a, b, LUA_OPLT); /* a < b */
277 else { /* function */
278 int res;
279 lua_pushvalue(L, 2); /* push function */
280 lua_pushvalue(L, a-1); /* -1 to compensate function */
281 lua_pushvalue(L, b-2); /* -2 to compensate function and 'a' */
282 lua_call(L, 2, 1); /* call function */
283 res = lua_toboolean(L, -1); /* get result */
284 lua_pop(L, 1); /* pop result */
285 return res;
286 }
287}
288
289
290/*
291** Does the partition: Pivot P is at the top of the stack.
292** precondition: a[lo] <= P == a[up-1] <= a[up],
293** so it only needs to do the partition from lo + 1 to up - 2.
294** Pos-condition: a[lo .. i - 1] <= a[i] == P <= a[i + 1 .. up]
295** returns 'i'.
296*/
297static IdxT partition (lua_State *L, IdxT lo, IdxT up) {
298 IdxT i = lo; /* will be incremented before first use */
299 IdxT j = up - 1; /* will be decremented before first use */
300 /* loop invariant: a[lo .. i] <= P <= a[j .. up] */
301 for (;;) {
302 /* next loop: repeat ++i while a[i] < P */
303 while ((void)lua_geti(L, 1, ++i), sort_comp(L, -1, -2)) {
304 if (l_unlikely(i == up - 1)) /* a[i] < P but a[up - 1] == P ?? */
305 luaL_error(L, "invalid order function for sorting");
306 lua_pop(L, 1); /* remove a[i] */
307 }
308 /* after the loop, a[i] >= P and a[lo .. i - 1] < P */
309 /* next loop: repeat --j while P < a[j] */
310 while ((void)lua_geti(L, 1, --j), sort_comp(L, -3, -1)) {
311 if (l_unlikely(j < i)) /* j < i but a[j] > P ?? */
312 luaL_error(L, "invalid order function for sorting");
313 lua_pop(L, 1); /* remove a[j] */
314 }
315 /* after the loop, a[j] <= P and a[j + 1 .. up] >= P */
316 if (j < i) { /* no elements out of place? */
317 /* a[lo .. i - 1] <= P <= a[j + 1 .. i .. up] */
318 lua_pop(L, 1); /* pop a[j] */
319 /* swap pivot (a[up - 1]) with a[i] to satisfy pos-condition */
320 set2(L, up - 1, i);
321 return i;
322 }
323 /* otherwise, swap a[i] - a[j] to restore invariant and repeat */
324 set2(L, i, j);
325 }
326}
327
328
329/*
330** Choose an element in the middle (2nd-3th quarters) of [lo,up]
331** "randomized" by 'rnd'
332*/
333static IdxT choosePivot (IdxT lo, IdxT up, unsigned int rnd) {
334 IdxT r4 = (up - lo) / 4; /* range/4 */
335 IdxT p = rnd % (r4 * 2) + (lo + r4);
336 lua_assert(lo + r4 <= p && p <= up - r4);
337 return p;
338}
339
340
341/*
342** Quicksort algorithm (recursive function)
343*/
344static void auxsort (lua_State *L, IdxT lo, IdxT up,
345 unsigned int rnd) {
346 while (lo < up) { /* loop for tail recursion */
347 IdxT p; /* Pivot index */
348 IdxT n; /* to be used later */
349 /* sort elements 'lo', 'p', and 'up' */
350 lua_geti(L, 1, lo);
351 lua_geti(L, 1, up);
352 if (sort_comp(L, -1, -2)) /* a[up] < a[lo]? */
353 set2(L, lo, up); /* swap a[lo] - a[up] */
354 else
355 lua_pop(L, 2); /* remove both values */
356 if (up - lo == 1) /* only 2 elements? */
357 return; /* already sorted */
358 if (up - lo < RANLIMIT || rnd == 0) /* small interval or no randomize? */
359 p = (lo + up)/2; /* middle element is a good pivot */
360 else /* for larger intervals, it is worth a random pivot */
361 p = choosePivot(lo, up, rnd);
362 lua_geti(L, 1, p);
363 lua_geti(L, 1, lo);
364 if (sort_comp(L, -2, -1)) /* a[p] < a[lo]? */
365 set2(L, p, lo); /* swap a[p] - a[lo] */
366 else {
367 lua_pop(L, 1); /* remove a[lo] */
368 lua_geti(L, 1, up);
369 if (sort_comp(L, -1, -2)) /* a[up] < a[p]? */
370 set2(L, p, up); /* swap a[up] - a[p] */
371 else
372 lua_pop(L, 2);
373 }
374 if (up - lo == 2) /* only 3 elements? */
375 return; /* already sorted */
376 lua_geti(L, 1, p); /* get middle element (Pivot) */
377 lua_pushvalue(L, -1); /* push Pivot */
378 lua_geti(L, 1, up - 1); /* push a[up - 1] */
379 set2(L, p, up - 1); /* swap Pivot (a[p]) with a[up - 1] */
380 p = partition(L, lo, up);
381 /* a[lo .. p - 1] <= a[p] == P <= a[p + 1 .. up] */
382 if (p - lo < up - p) { /* lower interval is smaller? */
383 auxsort(L, lo, p - 1, rnd); /* call recursively for lower interval */
384 n = p - lo; /* size of smaller interval */
385 lo = p + 1; /* tail call for [p + 1 .. up] (upper interval) */
386 }
387 else {
388 auxsort(L, p + 1, up, rnd); /* call recursively for upper interval */
389 n = up - p; /* size of smaller interval */
390 up = p - 1; /* tail call for [lo .. p - 1] (lower interval) */
391 }
392 if ((up - lo) / 128 > n) /* partition too imbalanced? */
393 rnd = l_randomizePivot(); /* try a new randomization */
394 } /* tail call auxsort(L, lo, up, rnd) */
395}
396
397
398static int sort (lua_State *L) {
399 lua_Integer n = aux_getn(L, 1, TAB_RW);
400 if (n > 1) { /* non-trivial interval? */
401 luaL_argcheck(L, n < INT_MAX, 1, "array too big");
402 if (!lua_isnoneornil(L, 2)) /* is there a 2nd argument? */
403 luaL_checktype(L, 2, LUA_TFUNCTION); /* must be a function */
404 lua_settop(L, 2); /* make sure there are two arguments */
405 auxsort(L, 1, (IdxT)n, 0);
406 }
407 return 0;
408}
409
410/* }====================================================== */
411
412
413static const luaL_Reg tab_funcs[] = {
414 {"concat", tconcat},
415 {"insert", tinsert},
416 {"pack", tpack},
417 {"unpack", tunpack},
418 {"remove", tremove},
419 {"move", tmove},
420 {"sort", sort},
421 {NULL, NULL}
422};
423
424
425LUAMOD_API int luaopen_table (lua_State *L) {
426 luaL_newlib(L, tab_funcs);
427 return 1;
428}
429
diff --git a/src/lua/ltm.c b/src/lua/ltm.c
deleted file mode 100644
index b657b78..0000000
--- a/src/lua/ltm.c
+++ /dev/null
@@ -1,271 +0,0 @@
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 (l_unlikely(!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 (l_unlikely(!callbinTM(L, s2v(top - 2), s2v(top - 1), top - 2,
170 TM_CONCAT)))
171 luaG_concaterror(L, s2v(top - 2), s2v(top - 1));
172}
173
174
175void luaT_trybinassocTM (lua_State *L, const TValue *p1, const TValue *p2,
176 int flip, StkId res, TMS event) {
177 if (flip)
178 luaT_trybinTM(L, p2, p1, res, event);
179 else
180 luaT_trybinTM(L, p1, p2, res, event);
181}
182
183
184void luaT_trybiniTM (lua_State *L, const TValue *p1, lua_Integer i2,
185 int flip, StkId res, TMS event) {
186 TValue aux;
187 setivalue(&aux, i2);
188 luaT_trybinassocTM(L, p1, &aux, flip, res, event);
189}
190
191
192/*
193** Calls an order tag method.
194** For lessequal, LUA_COMPAT_LT_LE keeps compatibility with old
195** behavior: if there is no '__le', try '__lt', based on l <= r iff
196** !(r < l) (assuming a total order). If the metamethod yields during
197** this substitution, the continuation has to know about it (to negate
198** the result of r<l); bit CIST_LEQ in the call status keeps that
199** information.
200*/
201int luaT_callorderTM (lua_State *L, const TValue *p1, const TValue *p2,
202 TMS event) {
203 if (callbinTM(L, p1, p2, L->top, event)) /* try original event */
204 return !l_isfalse(s2v(L->top));
205#if defined(LUA_COMPAT_LT_LE)
206 else if (event == TM_LE) {
207 /* try '!(p2 < p1)' for '(p1 <= p2)' */
208 L->ci->callstatus |= CIST_LEQ; /* mark it is doing 'lt' for 'le' */
209 if (callbinTM(L, p2, p1, L->top, TM_LT)) {
210 L->ci->callstatus ^= CIST_LEQ; /* clear mark */
211 return l_isfalse(s2v(L->top));
212 }
213 /* else error will remove this 'ci'; no need to clear mark */
214 }
215#endif
216 luaG_ordererror(L, p1, p2); /* no metamethod found */
217 return 0; /* to avoid warnings */
218}
219
220
221int luaT_callorderiTM (lua_State *L, const TValue *p1, int v2,
222 int flip, int isfloat, TMS event) {
223 TValue aux; const TValue *p2;
224 if (isfloat) {
225 setfltvalue(&aux, cast_num(v2));
226 }
227 else
228 setivalue(&aux, v2);
229 if (flip) { /* arguments were exchanged? */
230 p2 = p1; p1 = &aux; /* correct them */
231 }
232 else
233 p2 = &aux;
234 return luaT_callorderTM(L, p1, p2, event);
235}
236
237
238void luaT_adjustvarargs (lua_State *L, int nfixparams, CallInfo *ci,
239 const Proto *p) {
240 int i;
241 int actual = cast_int(L->top - ci->func) - 1; /* number of arguments */
242 int nextra = actual - nfixparams; /* number of extra arguments */
243 ci->u.l.nextraargs = nextra;
244 luaD_checkstack(L, p->maxstacksize + 1);
245 /* copy function to the top of the stack */
246 setobjs2s(L, L->top++, ci->func);
247 /* move fixed parameters to the top of the stack */
248 for (i = 1; i <= nfixparams; i++) {
249 setobjs2s(L, L->top++, ci->func + i);
250 setnilvalue(s2v(ci->func + i)); /* erase original parameter (for GC) */
251 }
252 ci->func += actual + 1;
253 ci->top += actual + 1;
254 lua_assert(L->top <= ci->top && ci->top <= L->stack_last);
255}
256
257
258void luaT_getvarargs (lua_State *L, CallInfo *ci, StkId where, int wanted) {
259 int i;
260 int nextra = ci->u.l.nextraargs;
261 if (wanted < 0) {
262 wanted = nextra; /* get all extra arguments available */
263 checkstackGCp(L, nextra, where); /* ensure stack space */
264 L->top = where + nextra; /* next instruction will need top */
265 }
266 for (i = 0; i < wanted && i < nextra; i++)
267 setobjs2s(L, where + i, ci->func - nextra + i);
268 for (; i < wanted; i++) /* complete required results with nil */
269 setnilvalue(s2v(where + i));
270}
271
diff --git a/src/lua/ltm.h b/src/lua/ltm.h
deleted file mode 100644
index 73b833c..0000000
--- a/src/lua/ltm.h
+++ /dev/null
@@ -1,103 +0,0 @@
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** Mask with 1 in all fast-access methods. A 1 in any of these bits
50** in the flag of a (meta)table means the metatable does not have the
51** corresponding metamethod field. (Bit 7 of the flag is used for
52** 'isrealasize'.)
53*/
54#define maskflags (~(~0u << (TM_EQ + 1)))
55
56
57/*
58** Test whether there is no tagmethod.
59** (Because tagmethods use raw accesses, the result may be an "empty" nil.)
60*/
61#define notm(tm) ttisnil(tm)
62
63
64#define gfasttm(g,et,e) ((et) == NULL ? NULL : \
65 ((et)->flags & (1u<<(e))) ? NULL : luaT_gettm(et, e, (g)->tmname[e]))
66
67#define fasttm(l,et,e) gfasttm(G(l), et, e)
68
69#define ttypename(x) luaT_typenames_[(x) + 1]
70
71LUAI_DDEC(const char *const luaT_typenames_[LUA_TOTALTYPES];)
72
73
74LUAI_FUNC const char *luaT_objtypename (lua_State *L, const TValue *o);
75
76LUAI_FUNC const TValue *luaT_gettm (Table *events, TMS event, TString *ename);
77LUAI_FUNC const TValue *luaT_gettmbyobj (lua_State *L, const TValue *o,
78 TMS event);
79LUAI_FUNC void luaT_init (lua_State *L);
80
81LUAI_FUNC void luaT_callTM (lua_State *L, const TValue *f, const TValue *p1,
82 const TValue *p2, const TValue *p3);
83LUAI_FUNC void luaT_callTMres (lua_State *L, const TValue *f,
84 const TValue *p1, const TValue *p2, StkId p3);
85LUAI_FUNC void luaT_trybinTM (lua_State *L, const TValue *p1, const TValue *p2,
86 StkId res, TMS event);
87LUAI_FUNC void luaT_tryconcatTM (lua_State *L);
88LUAI_FUNC void luaT_trybinassocTM (lua_State *L, const TValue *p1,
89 const TValue *p2, int inv, StkId res, TMS event);
90LUAI_FUNC void luaT_trybiniTM (lua_State *L, const TValue *p1, lua_Integer i2,
91 int inv, StkId res, TMS event);
92LUAI_FUNC int luaT_callorderTM (lua_State *L, const TValue *p1,
93 const TValue *p2, TMS event);
94LUAI_FUNC int luaT_callorderiTM (lua_State *L, const TValue *p1, int v2,
95 int inv, int isfloat, TMS event);
96
97LUAI_FUNC void luaT_adjustvarargs (lua_State *L, int nfixparams,
98 struct CallInfo *ci, const Proto *p);
99LUAI_FUNC void luaT_getvarargs (lua_State *L, struct CallInfo *ci,
100 StkId where, int wanted);
101
102
103#endif
diff --git a/src/lua/lua.c b/src/lua/lua.c
deleted file mode 100644
index 46b48db..0000000
--- a/src/lua/lua.c
+++ /dev/null
@@ -1,659 +0,0 @@
1/*
2** $Id: lua.c $
3** Lua stand-alone interpreter
4** See Copyright Notice in lua.h
5*/
6
7#define lua_c
8
9#include "lprefix.h"
10
11
12#include <stdio.h>
13#include <stdlib.h>
14#include <string.h>
15
16#include <signal.h>
17
18#include "lua.h"
19
20#include "lauxlib.h"
21#include "lualib.h"
22
23
24#if !defined(LUA_PROGNAME)
25#define LUA_PROGNAME "lua"
26#endif
27
28#if !defined(LUA_INIT_VAR)
29#define LUA_INIT_VAR "LUA_INIT"
30#endif
31
32#define LUA_INITVARVERSION LUA_INIT_VAR LUA_VERSUFFIX
33
34
35static lua_State *globalL = NULL;
36
37static const char *progname = LUA_PROGNAME;
38
39
40#if defined(LUA_USE_POSIX) /* { */
41
42/*
43** Use 'sigaction' when available.
44*/
45static void setsignal (int sig, void (*handler)(int)) {
46 struct sigaction sa;
47 sa.sa_handler = handler;
48 sa.sa_flags = 0;
49 sigemptyset(&sa.sa_mask); /* do not mask any signal */
50 sigaction(sig, &sa, NULL);
51}
52
53#else /* }{ */
54
55#define setsignal signal
56
57#endif /* } */
58
59
60/*
61** Hook set by signal function to stop the interpreter.
62*/
63static void lstop (lua_State *L, lua_Debug *ar) {
64 (void)ar; /* unused arg. */
65 lua_sethook(L, NULL, 0, 0); /* reset hook */
66 luaL_error(L, "interrupted!");
67}
68
69
70/*
71** Function to be called at a C signal. Because a C signal cannot
72** just change a Lua state (as there is no proper synchronization),
73** this function only sets a hook that, when called, will stop the
74** interpreter.
75*/
76static void laction (int i) {
77 int flag = LUA_MASKCALL | LUA_MASKRET | LUA_MASKLINE | LUA_MASKCOUNT;
78 setsignal(i, SIG_DFL); /* if another SIGINT happens, terminate process */
79 lua_sethook(globalL, lstop, flag, 1);
80}
81
82
83static void print_usage (const char *badoption) {
84 lua_writestringerror("%s: ", progname);
85 if (badoption[1] == 'e' || badoption[1] == 'l')
86 lua_writestringerror("'%s' needs argument\n", badoption);
87 else
88 lua_writestringerror("unrecognized option '%s'\n", badoption);
89 lua_writestringerror(
90 "usage: %s [options] [script [args]]\n"
91 "Available options are:\n"
92 " -e stat execute string 'stat'\n"
93 " -i enter interactive mode after executing 'script'\n"
94 " -l name require library 'name' into global 'name'\n"
95 " -v show version information\n"
96 " -E ignore environment variables\n"
97 " -W turn warnings on\n"
98 " -- stop handling options\n"
99 " - stop handling options and execute stdin\n"
100 ,
101 progname);
102}
103
104
105/*
106** Prints an error message, adding the program name in front of it
107** (if present)
108*/
109static void l_message (const char *pname, const char *msg) {
110 if (pname) lua_writestringerror("%s: ", pname);
111 lua_writestringerror("%s\n", msg);
112}
113
114
115/*
116** Check whether 'status' is not OK and, if so, prints the error
117** message on the top of the stack. It assumes that the error object
118** is a string, as it was either generated by Lua or by 'msghandler'.
119*/
120static int report (lua_State *L, int status) {
121 if (status != LUA_OK) {
122 const char *msg = lua_tostring(L, -1);
123 l_message(progname, msg);
124 lua_pop(L, 1); /* remove message */
125 }
126 return status;
127}
128
129
130/*
131** Message handler used to run all chunks
132*/
133static int msghandler (lua_State *L) {
134 const char *msg = lua_tostring(L, 1);
135 if (msg == NULL) { /* is error object not a string? */
136 if (luaL_callmeta(L, 1, "__tostring") && /* does it have a metamethod */
137 lua_type(L, -1) == LUA_TSTRING) /* that produces a string? */
138 return 1; /* that is the message */
139 else
140 msg = lua_pushfstring(L, "(error object is a %s value)",
141 luaL_typename(L, 1));
142 }
143 luaL_traceback(L, L, msg, 1); /* append a standard traceback */
144 return 1; /* return the traceback */
145}
146
147
148/*
149** Interface to 'lua_pcall', which sets appropriate message function
150** and C-signal handler. Used to run all chunks.
151*/
152static int docall (lua_State *L, int narg, int nres) {
153 int status;
154 int base = lua_gettop(L) - narg; /* function index */
155 lua_pushcfunction(L, msghandler); /* push message handler */
156 lua_insert(L, base); /* put it under function and args */
157 globalL = L; /* to be available to 'laction' */
158 setsignal(SIGINT, laction); /* set C-signal handler */
159 status = lua_pcall(L, narg, nres, base);
160 setsignal(SIGINT, SIG_DFL); /* reset C-signal handler */
161 lua_remove(L, base); /* remove message handler from the stack */
162 return status;
163}
164
165
166static void print_version (void) {
167 lua_writestring(LUA_COPYRIGHT, strlen(LUA_COPYRIGHT));
168 lua_writeline();
169}
170
171
172/*
173** Create the 'arg' table, which stores all arguments from the
174** command line ('argv'). It should be aligned so that, at index 0,
175** it has 'argv[script]', which is the script name. The arguments
176** to the script (everything after 'script') go to positive indices;
177** other arguments (before the script name) go to negative indices.
178** If there is no script name, assume interpreter's name as base.
179*/
180static void createargtable (lua_State *L, char **argv, int argc, int script) {
181 int i, narg;
182 if (script == argc) script = 0; /* no script name? */
183 narg = argc - (script + 1); /* number of positive indices */
184 lua_createtable(L, narg, script + 1);
185 for (i = 0; i < argc; i++) {
186 lua_pushstring(L, argv[i]);
187 lua_rawseti(L, -2, i - script);
188 }
189 lua_setglobal(L, "arg");
190}
191
192
193static int dochunk (lua_State *L, int status) {
194 if (status == LUA_OK) status = docall(L, 0, 0);
195 return report(L, status);
196}
197
198
199static int dofile (lua_State *L, const char *name) {
200 return dochunk(L, luaL_loadfile(L, name));
201}
202
203
204static int dostring (lua_State *L, const char *s, const char *name) {
205 return dochunk(L, luaL_loadbuffer(L, s, strlen(s), name));
206}
207
208
209/*
210** Calls 'require(name)' and stores the result in a global variable
211** with the given name.
212*/
213static int dolibrary (lua_State *L, const char *name) {
214 int status;
215 lua_getglobal(L, "require");
216 lua_pushstring(L, name);
217 status = docall(L, 1, 1); /* call 'require(name)' */
218 if (status == LUA_OK)
219 lua_setglobal(L, name); /* global[name] = require return */
220 return report(L, status);
221}
222
223
224/*
225** Push on the stack the contents of table 'arg' from 1 to #arg
226*/
227static int pushargs (lua_State *L) {
228 int i, n;
229 if (lua_getglobal(L, "arg") != LUA_TTABLE)
230 luaL_error(L, "'arg' is not a table");
231 n = (int)luaL_len(L, -1);
232 luaL_checkstack(L, n + 3, "too many arguments to script");
233 for (i = 1; i <= n; i++)
234 lua_rawgeti(L, -i, i);
235 lua_remove(L, -i); /* remove table from the stack */
236 return n;
237}
238
239
240static int handle_script (lua_State *L, char **argv) {
241 int status;
242 const char *fname = argv[0];
243 if (strcmp(fname, "-") == 0 && strcmp(argv[-1], "--") != 0)
244 fname = NULL; /* stdin */
245 status = luaL_loadfile(L, fname);
246 if (status == LUA_OK) {
247 int n = pushargs(L); /* push arguments to script */
248 status = docall(L, n, LUA_MULTRET);
249 }
250 return report(L, status);
251}
252
253
254/* bits of various argument indicators in 'args' */
255#define has_error 1 /* bad option */
256#define has_i 2 /* -i */
257#define has_v 4 /* -v */
258#define has_e 8 /* -e */
259#define has_E 16 /* -E */
260
261
262/*
263** Traverses all arguments from 'argv', returning a mask with those
264** needed before running any Lua code (or an error code if it finds
265** any invalid argument). 'first' returns the first not-handled argument
266** (either the script name or a bad argument in case of error).
267*/
268static int collectargs (char **argv, int *first) {
269 int args = 0;
270 int i;
271 for (i = 1; argv[i] != NULL; i++) {
272 *first = i;
273 if (argv[i][0] != '-') /* not an option? */
274 return args; /* stop handling options */
275 switch (argv[i][1]) { /* else check option */
276 case '-': /* '--' */
277 if (argv[i][2] != '\0') /* extra characters after '--'? */
278 return has_error; /* invalid option */
279 *first = i + 1;
280 return args;
281 case '\0': /* '-' */
282 return args; /* script "name" is '-' */
283 case 'E':
284 if (argv[i][2] != '\0') /* extra characters? */
285 return has_error; /* invalid option */
286 args |= has_E;
287 break;
288 case 'W':
289 if (argv[i][2] != '\0') /* extra characters? */
290 return has_error; /* invalid option */
291 break;
292 case 'i':
293 args |= has_i; /* (-i implies -v) *//* FALLTHROUGH */
294 case 'v':
295 if (argv[i][2] != '\0') /* extra characters? */
296 return has_error; /* invalid option */
297 args |= has_v;
298 break;
299 case 'e':
300 args |= has_e; /* FALLTHROUGH */
301 case 'l': /* both options need an argument */
302 if (argv[i][2] == '\0') { /* no concatenated argument? */
303 i++; /* try next 'argv' */
304 if (argv[i] == NULL || argv[i][0] == '-')
305 return has_error; /* no next argument or it is another option */
306 }
307 break;
308 default: /* invalid option */
309 return has_error;
310 }
311 }
312 *first = i; /* no script name */
313 return args;
314}
315
316
317/*
318** Processes options 'e' and 'l', which involve running Lua code, and
319** 'W', which also affects the state.
320** Returns 0 if some code raises an error.
321*/
322static int runargs (lua_State *L, char **argv, int n) {
323 int i;
324 for (i = 1; i < n; i++) {
325 int option = argv[i][1];
326 lua_assert(argv[i][0] == '-'); /* already checked */
327 switch (option) {
328 case 'e': case 'l': {
329 int status;
330 const char *extra = argv[i] + 2; /* both options need an argument */
331 if (*extra == '\0') extra = argv[++i];
332 lua_assert(extra != NULL);
333 status = (option == 'e')
334 ? dostring(L, extra, "=(command line)")
335 : dolibrary(L, extra);
336 if (status != LUA_OK) return 0;
337 break;
338 }
339 case 'W':
340 lua_warning(L, "@on", 0); /* warnings on */
341 break;
342 }
343 }
344 return 1;
345}
346
347
348static int handle_luainit (lua_State *L) {
349 const char *name = "=" LUA_INITVARVERSION;
350 const char *init = getenv(name + 1);
351 if (init == NULL) {
352 name = "=" LUA_INIT_VAR;
353 init = getenv(name + 1); /* try alternative name */
354 }
355 if (init == NULL) return LUA_OK;
356 else if (init[0] == '@')
357 return dofile(L, init+1);
358 else
359 return dostring(L, init, name);
360}
361
362
363/*
364** {==================================================================
365** Read-Eval-Print Loop (REPL)
366** ===================================================================
367*/
368
369#if !defined(LUA_PROMPT)
370#define LUA_PROMPT "> "
371#define LUA_PROMPT2 ">> "
372#endif
373
374#if !defined(LUA_MAXINPUT)
375#define LUA_MAXINPUT 512
376#endif
377
378
379/*
380** lua_stdin_is_tty detects whether the standard input is a 'tty' (that
381** is, whether we're running lua interactively).
382*/
383#if !defined(lua_stdin_is_tty) /* { */
384
385#if defined(LUA_USE_POSIX) /* { */
386
387#include <unistd.h>
388#define lua_stdin_is_tty() isatty(0)
389
390#elif defined(LUA_USE_WINDOWS) /* }{ */
391
392#include <io.h>
393#include <windows.h>
394
395#define lua_stdin_is_tty() _isatty(_fileno(stdin))
396
397#else /* }{ */
398
399/* ISO C definition */
400#define lua_stdin_is_tty() 1 /* assume stdin is a tty */
401
402#endif /* } */
403
404#endif /* } */
405
406
407/*
408** lua_readline defines how to show a prompt and then read a line from
409** the standard input.
410** lua_saveline defines how to "save" a read line in a "history".
411** lua_freeline defines how to free a line read by lua_readline.
412*/
413#if !defined(lua_readline) /* { */
414
415#if defined(LUA_USE_READLINE) /* { */
416
417#include <readline/readline.h>
418#include <readline/history.h>
419#define lua_initreadline(L) ((void)L, rl_readline_name="lua")
420#define lua_readline(L,b,p) ((void)L, ((b)=readline(p)) != NULL)
421#define lua_saveline(L,line) ((void)L, add_history(line))
422#define lua_freeline(L,b) ((void)L, free(b))
423
424#else /* }{ */
425
426#define lua_initreadline(L) ((void)L)
427#define lua_readline(L,b,p) \
428 ((void)L, fputs(p, stdout), fflush(stdout), /* show prompt */ \
429 fgets(b, LUA_MAXINPUT, stdin) != NULL) /* get line */
430#define lua_saveline(L,line) { (void)L; (void)line; }
431#define lua_freeline(L,b) { (void)L; (void)b; }
432
433#endif /* } */
434
435#endif /* } */
436
437
438/*
439** Return the string to be used as a prompt by the interpreter. Leave
440** the string (or nil, if using the default value) on the stack, to keep
441** it anchored.
442*/
443static const char *get_prompt (lua_State *L, int firstline) {
444 if (lua_getglobal(L, firstline ? "_PROMPT" : "_PROMPT2") == LUA_TNIL)
445 return (firstline ? LUA_PROMPT : LUA_PROMPT2); /* use the default */
446 else { /* apply 'tostring' over the value */
447 const char *p = luaL_tolstring(L, -1, NULL);
448 lua_remove(L, -2); /* remove original value */
449 return p;
450 }
451}
452
453/* mark in error messages for incomplete statements */
454#define EOFMARK "<eof>"
455#define marklen (sizeof(EOFMARK)/sizeof(char) - 1)
456
457
458/*
459** Check whether 'status' signals a syntax error and the error
460** message at the top of the stack ends with the above mark for
461** incomplete statements.
462*/
463static int incomplete (lua_State *L, int status) {
464 if (status == LUA_ERRSYNTAX) {
465 size_t lmsg;
466 const char *msg = lua_tolstring(L, -1, &lmsg);
467 if (lmsg >= marklen && strcmp(msg + lmsg - marklen, EOFMARK) == 0) {
468 lua_pop(L, 1);
469 return 1;
470 }
471 }
472 return 0; /* else... */
473}
474
475
476/*
477** Prompt the user, read a line, and push it into the Lua stack.
478*/
479static int pushline (lua_State *L, int firstline) {
480 char buffer[LUA_MAXINPUT];
481 char *b = buffer;
482 size_t l;
483 const char *prmt = get_prompt(L, firstline);
484 int readstatus = lua_readline(L, b, prmt);
485 if (readstatus == 0)
486 return 0; /* no input (prompt will be popped by caller) */
487 lua_pop(L, 1); /* remove prompt */
488 l = strlen(b);
489 if (l > 0 && b[l-1] == '\n') /* line ends with newline? */
490 b[--l] = '\0'; /* remove it */
491 if (firstline && b[0] == '=') /* for compatibility with 5.2, ... */
492 lua_pushfstring(L, "return %s", b + 1); /* change '=' to 'return' */
493 else
494 lua_pushlstring(L, b, l);
495 lua_freeline(L, b);
496 return 1;
497}
498
499
500/*
501** Try to compile line on the stack as 'return <line>;'; on return, stack
502** has either compiled chunk or original line (if compilation failed).
503*/
504static int addreturn (lua_State *L) {
505 const char *line = lua_tostring(L, -1); /* original line */
506 const char *retline = lua_pushfstring(L, "return %s;", line);
507 int status = luaL_loadbuffer(L, retline, strlen(retline), "=stdin");
508 if (status == LUA_OK) {
509 lua_remove(L, -2); /* remove modified line */
510 if (line[0] != '\0') /* non empty? */
511 lua_saveline(L, line); /* keep history */
512 }
513 else
514 lua_pop(L, 2); /* pop result from 'luaL_loadbuffer' and modified line */
515 return status;
516}
517
518
519/*
520** Read multiple lines until a complete Lua statement
521*/
522static int multiline (lua_State *L) {
523 for (;;) { /* repeat until gets a complete statement */
524 size_t len;
525 const char *line = lua_tolstring(L, 1, &len); /* get what it has */
526 int status = luaL_loadbuffer(L, line, len, "=stdin"); /* try it */
527 if (!incomplete(L, status) || !pushline(L, 0)) {
528 lua_saveline(L, line); /* keep history */
529 return status; /* cannot or should not try to add continuation line */
530 }
531 lua_pushliteral(L, "\n"); /* add newline... */
532 lua_insert(L, -2); /* ...between the two lines */
533 lua_concat(L, 3); /* join them */
534 }
535}
536
537
538/*
539** Read a line and try to load (compile) it first as an expression (by
540** adding "return " in front of it) and second as a statement. Return
541** the final status of load/call with the resulting function (if any)
542** in the top of the stack.
543*/
544static int loadline (lua_State *L) {
545 int status;
546 lua_settop(L, 0);
547 if (!pushline(L, 1))
548 return -1; /* no input */
549 if ((status = addreturn(L)) != LUA_OK) /* 'return ...' did not work? */
550 status = multiline(L); /* try as command, maybe with continuation lines */
551 lua_remove(L, 1); /* remove line from the stack */
552 lua_assert(lua_gettop(L) == 1);
553 return status;
554}
555
556
557/*
558** Prints (calling the Lua 'print' function) any values on the stack
559*/
560static void l_print (lua_State *L) {
561 int n = lua_gettop(L);
562 if (n > 0) { /* any result to be printed? */
563 luaL_checkstack(L, LUA_MINSTACK, "too many results to print");
564 lua_getglobal(L, "print");
565 lua_insert(L, 1);
566 if (lua_pcall(L, n, 0, 0) != LUA_OK)
567 l_message(progname, lua_pushfstring(L, "error calling 'print' (%s)",
568 lua_tostring(L, -1)));
569 }
570}
571
572
573/*
574** Do the REPL: repeatedly read (load) a line, evaluate (call) it, and
575** print any results.
576*/
577static void doREPL (lua_State *L) {
578 int status;
579 const char *oldprogname = progname;
580 progname = NULL; /* no 'progname' on errors in interactive mode */
581 lua_initreadline(L);
582 while ((status = loadline(L)) != -1) {
583 if (status == LUA_OK)
584 status = docall(L, 0, LUA_MULTRET);
585 if (status == LUA_OK) l_print(L);
586 else report(L, status);
587 }
588 lua_settop(L, 0); /* clear stack */
589 lua_writeline();
590 progname = oldprogname;
591}
592
593/* }================================================================== */
594
595
596/*
597** Main body of stand-alone interpreter (to be called in protected mode).
598** Reads the options and handles them all.
599*/
600static int pmain (lua_State *L) {
601 int argc = (int)lua_tointeger(L, 1);
602 char **argv = (char **)lua_touserdata(L, 2);
603 int script;
604 int args = collectargs(argv, &script);
605 luaL_checkversion(L); /* check that interpreter has correct version */
606 if (argv[0] && argv[0][0]) progname = argv[0];
607 if (args == has_error) { /* bad arg? */
608 print_usage(argv[script]); /* 'script' has index of bad arg. */
609 return 0;
610 }
611 if (args & has_v) /* option '-v'? */
612 print_version();
613 if (args & has_E) { /* option '-E'? */
614 lua_pushboolean(L, 1); /* signal for libraries to ignore env. vars. */
615 lua_setfield(L, LUA_REGISTRYINDEX, "LUA_NOENV");
616 }
617 luaL_openlibs(L); /* open standard libraries */
618 createargtable(L, argv, argc, script); /* create table 'arg' */
619 lua_gc(L, LUA_GCGEN, 0, 0); /* GC in generational mode */
620 if (!(args & has_E)) { /* no option '-E'? */
621 if (handle_luainit(L) != LUA_OK) /* run LUA_INIT */
622 return 0; /* error running LUA_INIT */
623 }
624 if (!runargs(L, argv, script)) /* execute arguments -e and -l */
625 return 0; /* something failed */
626 if (script < argc && /* execute main script (if there is one) */
627 handle_script(L, argv + script) != LUA_OK)
628 return 0;
629 if (args & has_i) /* -i option? */
630 doREPL(L); /* do read-eval-print loop */
631 else if (script == argc && !(args & (has_e | has_v))) { /* no arguments? */
632 if (lua_stdin_is_tty()) { /* running in interactive mode? */
633 print_version();
634 doREPL(L); /* do read-eval-print loop */
635 }
636 else dofile(L, NULL); /* executes stdin as a file */
637 }
638 lua_pushboolean(L, 1); /* signal no errors */
639 return 1;
640}
641
642
643int main (int argc, char **argv) {
644 int status, result;
645 lua_State *L = luaL_newstate(); /* create state */
646 if (L == NULL) {
647 l_message(argv[0], "cannot create state: not enough memory");
648 return EXIT_FAILURE;
649 }
650 lua_pushcfunction(L, &pmain); /* to call 'pmain' in protected mode */
651 lua_pushinteger(L, argc); /* 1st argument */
652 lua_pushlightuserdata(L, argv); /* 2nd argument */
653 status = lua_pcall(L, 2, 1, 0); /* do the call */
654 result = lua_toboolean(L, -1); /* get result */
655 report(L, status);
656 lua_close(L);
657 return (result && status == LUA_OK) ? EXIT_SUCCESS : EXIT_FAILURE;
658}
659
diff --git a/src/lua/lua.h b/src/lua/lua.h
deleted file mode 100644
index 820535b..0000000
--- a/src/lua/lua.h
+++ /dev/null
@@ -1,518 +0,0 @@
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 "3"
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-2021 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);
351LUA_API void (lua_closeslot) (lua_State *L, int idx);
352
353
354/*
355** {==============================================================
356** some useful macros
357** ===============================================================
358*/
359
360#define lua_getextraspace(L) ((void *)((char *)(L) - LUA_EXTRASPACE))
361
362#define lua_tonumber(L,i) lua_tonumberx(L,(i),NULL)
363#define lua_tointeger(L,i) lua_tointegerx(L,(i),NULL)
364
365#define lua_pop(L,n) lua_settop(L, -(n)-1)
366
367#define lua_newtable(L) lua_createtable(L, 0, 0)
368
369#define lua_register(L,n,f) (lua_pushcfunction(L, (f)), lua_setglobal(L, (n)))
370
371#define lua_pushcfunction(L,f) lua_pushcclosure(L, (f), 0)
372
373#define lua_isfunction(L,n) (lua_type(L, (n)) == LUA_TFUNCTION)
374#define lua_istable(L,n) (lua_type(L, (n)) == LUA_TTABLE)
375#define lua_islightuserdata(L,n) (lua_type(L, (n)) == LUA_TLIGHTUSERDATA)
376#define lua_isnil(L,n) (lua_type(L, (n)) == LUA_TNIL)
377#define lua_isboolean(L,n) (lua_type(L, (n)) == LUA_TBOOLEAN)
378#define lua_isthread(L,n) (lua_type(L, (n)) == LUA_TTHREAD)
379#define lua_isnone(L,n) (lua_type(L, (n)) == LUA_TNONE)
380#define lua_isnoneornil(L, n) (lua_type(L, (n)) <= 0)
381
382#define lua_pushliteral(L, s) lua_pushstring(L, "" s)
383
384#define lua_pushglobaltable(L) \
385 ((void)lua_rawgeti(L, LUA_REGISTRYINDEX, LUA_RIDX_GLOBALS))
386
387#define lua_tostring(L,i) lua_tolstring(L, (i), NULL)
388
389
390#define lua_insert(L,idx) lua_rotate(L, (idx), 1)
391
392#define lua_remove(L,idx) (lua_rotate(L, (idx), -1), lua_pop(L, 1))
393
394#define lua_replace(L,idx) (lua_copy(L, -1, (idx)), lua_pop(L, 1))
395
396/* }============================================================== */
397
398
399/*
400** {==============================================================
401** compatibility macros
402** ===============================================================
403*/
404#if defined(LUA_COMPAT_APIINTCASTS)
405
406#define lua_pushunsigned(L,n) lua_pushinteger(L, (lua_Integer)(n))
407#define lua_tounsignedx(L,i,is) ((lua_Unsigned)lua_tointegerx(L,i,is))
408#define lua_tounsigned(L,i) lua_tounsignedx(L,(i),NULL)
409
410#endif
411
412#define lua_newuserdata(L,s) lua_newuserdatauv(L,s,1)
413#define lua_getuservalue(L,idx) lua_getiuservalue(L,idx,1)
414#define lua_setuservalue(L,idx) lua_setiuservalue(L,idx,1)
415
416#define LUA_NUMTAGS LUA_NUMTYPES
417
418/* }============================================================== */
419
420/*
421** {======================================================================
422** Debug API
423** =======================================================================
424*/
425
426
427/*
428** Event codes
429*/
430#define LUA_HOOKCALL 0
431#define LUA_HOOKRET 1
432#define LUA_HOOKLINE 2
433#define LUA_HOOKCOUNT 3
434#define LUA_HOOKTAILCALL 4
435
436
437/*
438** Event masks
439*/
440#define LUA_MASKCALL (1 << LUA_HOOKCALL)
441#define LUA_MASKRET (1 << LUA_HOOKRET)
442#define LUA_MASKLINE (1 << LUA_HOOKLINE)
443#define LUA_MASKCOUNT (1 << LUA_HOOKCOUNT)
444
445typedef struct lua_Debug lua_Debug; /* activation record */
446
447
448/* Functions to be called by the debugger in specific events */
449typedef void (*lua_Hook) (lua_State *L, lua_Debug *ar);
450
451
452LUA_API int (lua_getstack) (lua_State *L, int level, lua_Debug *ar);
453LUA_API int (lua_getinfo) (lua_State *L, const char *what, lua_Debug *ar);
454LUA_API const char *(lua_getlocal) (lua_State *L, const lua_Debug *ar, int n);
455LUA_API const char *(lua_setlocal) (lua_State *L, const lua_Debug *ar, int n);
456LUA_API const char *(lua_getupvalue) (lua_State *L, int funcindex, int n);
457LUA_API const char *(lua_setupvalue) (lua_State *L, int funcindex, int n);
458
459LUA_API void *(lua_upvalueid) (lua_State *L, int fidx, int n);
460LUA_API void (lua_upvaluejoin) (lua_State *L, int fidx1, int n1,
461 int fidx2, int n2);
462
463LUA_API void (lua_sethook) (lua_State *L, lua_Hook func, int mask, int count);
464LUA_API lua_Hook (lua_gethook) (lua_State *L);
465LUA_API int (lua_gethookmask) (lua_State *L);
466LUA_API int (lua_gethookcount) (lua_State *L);
467
468LUA_API int (lua_setcstacklimit) (lua_State *L, unsigned int limit);
469
470struct lua_Debug {
471 int event;
472 const char *name; /* (n) */
473 const char *namewhat; /* (n) 'global', 'local', 'field', 'method' */
474 const char *what; /* (S) 'Lua', 'C', 'main', 'tail' */
475 const char *source; /* (S) */
476 size_t srclen; /* (S) */
477 int currentline; /* (l) */
478 int linedefined; /* (S) */
479 int lastlinedefined; /* (S) */
480 unsigned char nups; /* (u) number of upvalues */
481 unsigned char nparams;/* (u) number of parameters */
482 char isvararg; /* (u) */
483 char istailcall; /* (t) */
484 unsigned short ftransfer; /* (r) index of first value transferred */
485 unsigned short ntransfer; /* (r) number of transferred values */
486 char short_src[LUA_IDSIZE]; /* (S) */
487 /* private part */
488 struct CallInfo *i_ci; /* active function */
489};
490
491/* }====================================================================== */
492
493
494/******************************************************************************
495* Copyright (C) 1994-2021 Lua.org, PUC-Rio.
496*
497* Permission is hereby granted, free of charge, to any person obtaining
498* a copy of this software and associated documentation files (the
499* "Software"), to deal in the Software without restriction, including
500* without limitation the rights to use, copy, modify, merge, publish,
501* distribute, sublicense, and/or sell copies of the Software, and to
502* permit persons to whom the Software is furnished to do so, subject to
503* the following conditions:
504*
505* The above copyright notice and this permission notice shall be
506* included in all copies or substantial portions of the Software.
507*
508* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
509* EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
510* MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
511* IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
512* CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
513* TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
514* SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
515******************************************************************************/
516
517
518#endif
diff --git a/src/lua/lua.hpp b/src/lua/lua.hpp
deleted file mode 100644
index ec417f5..0000000
--- a/src/lua/lua.hpp
+++ /dev/null
@@ -1,9 +0,0 @@
1// lua.hpp
2// Lua header files for C++
3// <<extern "C">> not supplied automatically because Lua also compiles as C++
4
5extern "C" {
6#include "lua.h"
7#include "lualib.h"
8#include "lauxlib.h"
9}
diff --git a/src/lua/luac.c b/src/lua/luac.c
deleted file mode 100644
index 56ddc41..0000000
--- a/src/lua/luac.c
+++ /dev/null
@@ -1,724 +0,0 @@
1/*
2** $Id: luac.c $
3** Lua compiler (saves bytecodes to files; also lists bytecodes)
4** See Copyright Notice in lua.h
5*/
6
7#define luac_c
8#define LUA_CORE
9
10#include "lprefix.h"
11
12#include <ctype.h>
13#include <errno.h>
14#include <stdio.h>
15#include <stdlib.h>
16#include <string.h>
17
18#include "lua.h"
19#include "lauxlib.h"
20
21#include "ldebug.h"
22#include "lobject.h"
23#include "lopcodes.h"
24#include "lopnames.h"
25#include "lstate.h"
26#include "lundump.h"
27
28static void PrintFunction(const Proto* f, int full);
29#define luaU_print PrintFunction
30
31#define PROGNAME "luac" /* default program name */
32#define OUTPUT PROGNAME ".out" /* default output file */
33
34static int listing=0; /* list bytecodes? */
35static int dumping=1; /* dump bytecodes? */
36static int stripping=0; /* strip debug information? */
37static char Output[]={ OUTPUT }; /* default output file name */
38static const char* output=Output; /* actual output file name */
39static const char* progname=PROGNAME; /* actual program name */
40static TString **tmname;
41
42static void fatal(const char* message)
43{
44 fprintf(stderr,"%s: %s\n",progname,message);
45 exit(EXIT_FAILURE);
46}
47
48static void cannot(const char* what)
49{
50 fprintf(stderr,"%s: cannot %s %s: %s\n",progname,what,output,strerror(errno));
51 exit(EXIT_FAILURE);
52}
53
54static void usage(const char* message)
55{
56 if (*message=='-')
57 fprintf(stderr,"%s: unrecognized option '%s'\n",progname,message);
58 else
59 fprintf(stderr,"%s: %s\n",progname,message);
60 fprintf(stderr,
61 "usage: %s [options] [filenames]\n"
62 "Available options are:\n"
63 " -l list (use -l -l for full listing)\n"
64 " -o name output to file 'name' (default is \"%s\")\n"
65 " -p parse only\n"
66 " -s strip debug information\n"
67 " -v show version information\n"
68 " -- stop handling options\n"
69 " - stop handling options and process stdin\n"
70 ,progname,Output);
71 exit(EXIT_FAILURE);
72}
73
74#define IS(s) (strcmp(argv[i],s)==0)
75
76static int doargs(int argc, char* argv[])
77{
78 int i;
79 int version=0;
80 if (argv[0]!=NULL && *argv[0]!=0) progname=argv[0];
81 for (i=1; i<argc; i++)
82 {
83 if (*argv[i]!='-') /* end of options; keep it */
84 break;
85 else if (IS("--")) /* end of options; skip it */
86 {
87 ++i;
88 if (version) ++version;
89 break;
90 }
91 else if (IS("-")) /* end of options; use stdin */
92 break;
93 else if (IS("-l")) /* list */
94 ++listing;
95 else if (IS("-o")) /* output file */
96 {
97 output=argv[++i];
98 if (output==NULL || *output==0 || (*output=='-' && output[1]!=0))
99 usage("'-o' needs argument");
100 if (IS("-")) output=NULL;
101 }
102 else if (IS("-p")) /* parse only */
103 dumping=0;
104 else if (IS("-s")) /* strip debug information */
105 stripping=1;
106 else if (IS("-v")) /* show version */
107 ++version;
108 else /* unknown option */
109 usage(argv[i]);
110 }
111 if (i==argc && (listing || !dumping))
112 {
113 dumping=0;
114 argv[--i]=Output;
115 }
116 if (version)
117 {
118 printf("%s\n",LUA_COPYRIGHT);
119 if (version==argc-1) exit(EXIT_SUCCESS);
120 }
121 return i;
122}
123
124#define FUNCTION "(function()end)();"
125
126static const char* reader(lua_State* L, void* ud, size_t* size)
127{
128 UNUSED(L);
129 if ((*(int*)ud)--)
130 {
131 *size=sizeof(FUNCTION)-1;
132 return FUNCTION;
133 }
134 else
135 {
136 *size=0;
137 return NULL;
138 }
139}
140
141#define toproto(L,i) getproto(s2v(L->top+(i)))
142
143static const Proto* combine(lua_State* L, int n)
144{
145 if (n==1)
146 return toproto(L,-1);
147 else
148 {
149 Proto* f;
150 int i=n;
151 if (lua_load(L,reader,&i,"=(" PROGNAME ")",NULL)!=LUA_OK) fatal(lua_tostring(L,-1));
152 f=toproto(L,-1);
153 for (i=0; i<n; i++)
154 {
155 f->p[i]=toproto(L,i-n-1);
156 if (f->p[i]->sizeupvalues>0) f->p[i]->upvalues[0].instack=0;
157 }
158 f->sizelineinfo=0;
159 return f;
160 }
161}
162
163static int writer(lua_State* L, const void* p, size_t size, void* u)
164{
165 UNUSED(L);
166 return (fwrite(p,size,1,(FILE*)u)!=1) && (size!=0);
167}
168
169static int pmain(lua_State* L)
170{
171 int argc=(int)lua_tointeger(L,1);
172 char** argv=(char**)lua_touserdata(L,2);
173 const Proto* f;
174 int i;
175 tmname=G(L)->tmname;
176 if (!lua_checkstack(L,argc)) fatal("too many input files");
177 for (i=0; i<argc; i++)
178 {
179 const char* filename=IS("-") ? NULL : argv[i];
180 if (luaL_loadfile(L,filename)!=LUA_OK) fatal(lua_tostring(L,-1));
181 }
182 f=combine(L,argc);
183 if (listing) luaU_print(f,listing>1);
184 if (dumping)
185 {
186 FILE* D= (output==NULL) ? stdout : fopen(output,"wb");
187 if (D==NULL) cannot("open");
188 lua_lock(L);
189 luaU_dump(L,f,writer,D,stripping);
190 lua_unlock(L);
191 if (ferror(D)) cannot("write");
192 if (fclose(D)) cannot("close");
193 }
194 return 0;
195}
196
197int main(int argc, char* argv[])
198{
199 lua_State* L;
200 int i=doargs(argc,argv);
201 argc-=i; argv+=i;
202 if (argc<=0) usage("no input files given");
203 L=luaL_newstate();
204 if (L==NULL) fatal("cannot create state: not enough memory");
205 lua_pushcfunction(L,&pmain);
206 lua_pushinteger(L,argc);
207 lua_pushlightuserdata(L,argv);
208 if (lua_pcall(L,2,0,0)!=LUA_OK) fatal(lua_tostring(L,-1));
209 lua_close(L);
210 return EXIT_SUCCESS;
211}
212
213/*
214** print bytecodes
215*/
216
217#define UPVALNAME(x) ((f->upvalues[x].name) ? getstr(f->upvalues[x].name) : "-")
218#define VOID(p) ((const void*)(p))
219#define eventname(i) (getstr(tmname[i]))
220
221static void PrintString(const TString* ts)
222{
223 const char* s=getstr(ts);
224 size_t i,n=tsslen(ts);
225 printf("\"");
226 for (i=0; i<n; i++)
227 {
228 int c=(int)(unsigned char)s[i];
229 switch (c)
230 {
231 case '"':
232 printf("\\\"");
233 break;
234 case '\\':
235 printf("\\\\");
236 break;
237 case '\a':
238 printf("\\a");
239 break;
240 case '\b':
241 printf("\\b");
242 break;
243 case '\f':
244 printf("\\f");
245 break;
246 case '\n':
247 printf("\\n");
248 break;
249 case '\r':
250 printf("\\r");
251 break;
252 case '\t':
253 printf("\\t");
254 break;
255 case '\v':
256 printf("\\v");
257 break;
258 default:
259 if (isprint(c)) printf("%c",c); else printf("\\%03d",c);
260 break;
261 }
262 }
263 printf("\"");
264}
265
266static void PrintType(const Proto* f, int i)
267{
268 const TValue* o=&f->k[i];
269 switch (ttypetag(o))
270 {
271 case LUA_VNIL:
272 printf("N");
273 break;
274 case LUA_VFALSE:
275 case LUA_VTRUE:
276 printf("B");
277 break;
278 case LUA_VNUMFLT:
279 printf("F");
280 break;
281 case LUA_VNUMINT:
282 printf("I");
283 break;
284 case LUA_VSHRSTR:
285 case LUA_VLNGSTR:
286 printf("S");
287 break;
288 default: /* cannot happen */
289 printf("?%d",ttypetag(o));
290 break;
291 }
292 printf("\t");
293}
294
295static void PrintConstant(const Proto* f, int i)
296{
297 const TValue* o=&f->k[i];
298 switch (ttypetag(o))
299 {
300 case LUA_VNIL:
301 printf("nil");
302 break;
303 case LUA_VFALSE:
304 printf("false");
305 break;
306 case LUA_VTRUE:
307 printf("true");
308 break;
309 case LUA_VNUMFLT:
310 {
311 char buff[100];
312 sprintf(buff,LUA_NUMBER_FMT,fltvalue(o));
313 printf("%s",buff);
314 if (buff[strspn(buff,"-0123456789")]=='\0') printf(".0");
315 break;
316 }
317 case LUA_VNUMINT:
318 printf(LUA_INTEGER_FMT,ivalue(o));
319 break;
320 case LUA_VSHRSTR:
321 case LUA_VLNGSTR:
322 PrintString(tsvalue(o));
323 break;
324 default: /* cannot happen */
325 printf("?%d",ttypetag(o));
326 break;
327 }
328}
329
330#define COMMENT "\t; "
331#define EXTRAARG GETARG_Ax(code[pc+1])
332#define EXTRAARGC (EXTRAARG*(MAXARG_C+1))
333#define ISK (isk ? "k" : "")
334
335static void PrintCode(const Proto* f)
336{
337 const Instruction* code=f->code;
338 int pc,n=f->sizecode;
339 for (pc=0; pc<n; pc++)
340 {
341 Instruction i=code[pc];
342 OpCode o=GET_OPCODE(i);
343 int a=GETARG_A(i);
344 int b=GETARG_B(i);
345 int c=GETARG_C(i);
346 int ax=GETARG_Ax(i);
347 int bx=GETARG_Bx(i);
348 int sb=GETARG_sB(i);
349 int sc=GETARG_sC(i);
350 int sbx=GETARG_sBx(i);
351 int isk=GETARG_k(i);
352 int line=luaG_getfuncline(f,pc);
353 printf("\t%d\t",pc+1);
354 if (line>0) printf("[%d]\t",line); else printf("[-]\t");
355 printf("%-9s\t",opnames[o]);
356 switch (o)
357 {
358 case OP_MOVE:
359 printf("%d %d",a,b);
360 break;
361 case OP_LOADI:
362 printf("%d %d",a,sbx);
363 break;
364 case OP_LOADF:
365 printf("%d %d",a,sbx);
366 break;
367 case OP_LOADK:
368 printf("%d %d",a,bx);
369 printf(COMMENT); PrintConstant(f,bx);
370 break;
371 case OP_LOADKX:
372 printf("%d",a);
373 printf(COMMENT); PrintConstant(f,EXTRAARG);
374 break;
375 case OP_LOADFALSE:
376 printf("%d",a);
377 break;
378 case OP_LFALSESKIP:
379 printf("%d",a);
380 break;
381 case OP_LOADTRUE:
382 printf("%d",a);
383 break;
384 case OP_LOADNIL:
385 printf("%d %d",a,b);
386 printf(COMMENT "%d out",b+1);
387 break;
388 case OP_GETUPVAL:
389 printf("%d %d",a,b);
390 printf(COMMENT "%s",UPVALNAME(b));
391 break;
392 case OP_SETUPVAL:
393 printf("%d %d",a,b);
394 printf(COMMENT "%s",UPVALNAME(b));
395 break;
396 case OP_GETTABUP:
397 printf("%d %d %d",a,b,c);
398 printf(COMMENT "%s",UPVALNAME(b));
399 printf(" "); PrintConstant(f,c);
400 break;
401 case OP_GETTABLE:
402 printf("%d %d %d",a,b,c);
403 break;
404 case OP_GETI:
405 printf("%d %d %d",a,b,c);
406 break;
407 case OP_GETFIELD:
408 printf("%d %d %d",a,b,c);
409 printf(COMMENT); PrintConstant(f,c);
410 break;
411 case OP_SETTABUP:
412 printf("%d %d %d%s",a,b,c,ISK);
413 printf(COMMENT "%s",UPVALNAME(a));
414 printf(" "); PrintConstant(f,b);
415 if (isk) { printf(" "); PrintConstant(f,c); }
416 break;
417 case OP_SETTABLE:
418 printf("%d %d %d%s",a,b,c,ISK);
419 if (isk) { printf(COMMENT); PrintConstant(f,c); }
420 break;
421 case OP_SETI:
422 printf("%d %d %d%s",a,b,c,ISK);
423 if (isk) { printf(COMMENT); PrintConstant(f,c); }
424 break;
425 case OP_SETFIELD:
426 printf("%d %d %d%s",a,b,c,ISK);
427 printf(COMMENT); PrintConstant(f,b);
428 if (isk) { printf(" "); PrintConstant(f,c); }
429 break;
430 case OP_NEWTABLE:
431 printf("%d %d %d",a,b,c);
432 printf(COMMENT "%d",c+EXTRAARGC);
433 break;
434 case OP_SELF:
435 printf("%d %d %d%s",a,b,c,ISK);
436 if (isk) { printf(COMMENT); PrintConstant(f,c); }
437 break;
438 case OP_ADDI:
439 printf("%d %d %d",a,b,sc);
440 break;
441 case OP_ADDK:
442 printf("%d %d %d",a,b,c);
443 printf(COMMENT); PrintConstant(f,c);
444 break;
445 case OP_SUBK:
446 printf("%d %d %d",a,b,c);
447 printf(COMMENT); PrintConstant(f,c);
448 break;
449 case OP_MULK:
450 printf("%d %d %d",a,b,c);
451 printf(COMMENT); PrintConstant(f,c);
452 break;
453 case OP_MODK:
454 printf("%d %d %d",a,b,c);
455 printf(COMMENT); PrintConstant(f,c);
456 break;
457 case OP_POWK:
458 printf("%d %d %d",a,b,c);
459 printf(COMMENT); PrintConstant(f,c);
460 break;
461 case OP_DIVK:
462 printf("%d %d %d",a,b,c);
463 printf(COMMENT); PrintConstant(f,c);
464 break;
465 case OP_IDIVK:
466 printf("%d %d %d",a,b,c);
467 printf(COMMENT); PrintConstant(f,c);
468 break;
469 case OP_BANDK:
470 printf("%d %d %d",a,b,c);
471 printf(COMMENT); PrintConstant(f,c);
472 break;
473 case OP_BORK:
474 printf("%d %d %d",a,b,c);
475 printf(COMMENT); PrintConstant(f,c);
476 break;
477 case OP_BXORK:
478 printf("%d %d %d",a,b,c);
479 printf(COMMENT); PrintConstant(f,c);
480 break;
481 case OP_SHRI:
482 printf("%d %d %d",a,b,sc);
483 break;
484 case OP_SHLI:
485 printf("%d %d %d",a,b,sc);
486 break;
487 case OP_ADD:
488 printf("%d %d %d",a,b,c);
489 break;
490 case OP_SUB:
491 printf("%d %d %d",a,b,c);
492 break;
493 case OP_MUL:
494 printf("%d %d %d",a,b,c);
495 break;
496 case OP_MOD:
497 printf("%d %d %d",a,b,c);
498 break;
499 case OP_POW:
500 printf("%d %d %d",a,b,c);
501 break;
502 case OP_DIV:
503 printf("%d %d %d",a,b,c);
504 break;
505 case OP_IDIV:
506 printf("%d %d %d",a,b,c);
507 break;
508 case OP_BAND:
509 printf("%d %d %d",a,b,c);
510 break;
511 case OP_BOR:
512 printf("%d %d %d",a,b,c);
513 break;
514 case OP_BXOR:
515 printf("%d %d %d",a,b,c);
516 break;
517 case OP_SHL:
518 printf("%d %d %d",a,b,c);
519 break;
520 case OP_SHR:
521 printf("%d %d %d",a,b,c);
522 break;
523 case OP_MMBIN:
524 printf("%d %d %d",a,b,c);
525 printf(COMMENT "%s",eventname(c));
526 break;
527 case OP_MMBINI:
528 printf("%d %d %d %d",a,sb,c,isk);
529 printf(COMMENT "%s",eventname(c));
530 if (isk) printf(" flip");
531 break;
532 case OP_MMBINK:
533 printf("%d %d %d %d",a,b,c,isk);
534 printf(COMMENT "%s ",eventname(c)); PrintConstant(f,b);
535 if (isk) printf(" flip");
536 break;
537 case OP_UNM:
538 printf("%d %d",a,b);
539 break;
540 case OP_BNOT:
541 printf("%d %d",a,b);
542 break;
543 case OP_NOT:
544 printf("%d %d",a,b);
545 break;
546 case OP_LEN:
547 printf("%d %d",a,b);
548 break;
549 case OP_CONCAT:
550 printf("%d %d",a,b);
551 break;
552 case OP_CLOSE:
553 printf("%d",a);
554 break;
555 case OP_TBC:
556 printf("%d",a);
557 break;
558 case OP_JMP:
559 printf("%d",GETARG_sJ(i));
560 printf(COMMENT "to %d",GETARG_sJ(i)+pc+2);
561 break;
562 case OP_EQ:
563 printf("%d %d %d",a,b,isk);
564 break;
565 case OP_LT:
566 printf("%d %d %d",a,b,isk);
567 break;
568 case OP_LE:
569 printf("%d %d %d",a,b,isk);
570 break;
571 case OP_EQK:
572 printf("%d %d %d",a,b,isk);
573 printf(COMMENT); PrintConstant(f,b);
574 break;
575 case OP_EQI:
576 printf("%d %d %d",a,sb,isk);
577 break;
578 case OP_LTI:
579 printf("%d %d %d",a,sb,isk);
580 break;
581 case OP_LEI:
582 printf("%d %d %d",a,sb,isk);
583 break;
584 case OP_GTI:
585 printf("%d %d %d",a,sb,isk);
586 break;
587 case OP_GEI:
588 printf("%d %d %d",a,sb,isk);
589 break;
590 case OP_TEST:
591 printf("%d %d",a,isk);
592 break;
593 case OP_TESTSET:
594 printf("%d %d %d",a,b,isk);
595 break;
596 case OP_CALL:
597 printf("%d %d %d",a,b,c);
598 printf(COMMENT);
599 if (b==0) printf("all in "); else printf("%d in ",b-1);
600 if (c==0) printf("all out"); else printf("%d out",c-1);
601 break;
602 case OP_TAILCALL:
603 printf("%d %d %d",a,b,c);
604 printf(COMMENT "%d in",b-1);
605 break;
606 case OP_RETURN:
607 printf("%d %d %d",a,b,c);
608 printf(COMMENT);
609 if (b==0) printf("all out"); else printf("%d out",b-1);
610 break;
611 case OP_RETURN0:
612 break;
613 case OP_RETURN1:
614 printf("%d",a);
615 break;
616 case OP_FORLOOP:
617 printf("%d %d",a,bx);
618 printf(COMMENT "to %d",pc-bx+2);
619 break;
620 case OP_FORPREP:
621 printf("%d %d",a,bx);
622 printf(COMMENT "to %d",pc+bx+2);
623 break;
624 case OP_TFORPREP:
625 printf("%d %d",a,bx);
626 printf(COMMENT "to %d",pc+bx+2);
627 break;
628 case OP_TFORCALL:
629 printf("%d %d",a,c);
630 break;
631 case OP_TFORLOOP:
632 printf("%d %d",a,bx);
633 printf(COMMENT "to %d",pc-bx+2);
634 break;
635 case OP_SETLIST:
636 printf("%d %d %d",a,b,c);
637 if (isk) printf(COMMENT "%d",c+EXTRAARGC);
638 break;
639 case OP_CLOSURE:
640 printf("%d %d",a,bx);
641 printf(COMMENT "%p",VOID(f->p[bx]));
642 break;
643 case OP_VARARG:
644 printf("%d %d",a,c);
645 printf(COMMENT);
646 if (c==0) printf("all out"); else printf("%d out",c-1);
647 break;
648 case OP_VARARGPREP:
649 printf("%d",a);
650 break;
651 case OP_EXTRAARG:
652 printf("%d",ax);
653 break;
654#if 0
655 default:
656 printf("%d %d %d",a,b,c);
657 printf(COMMENT "not handled");
658 break;
659#endif
660 }
661 printf("\n");
662 }
663}
664
665
666#define SS(x) ((x==1)?"":"s")
667#define S(x) (int)(x),SS(x)
668
669static void PrintHeader(const Proto* f)
670{
671 const char* s=f->source ? getstr(f->source) : "=?";
672 if (*s=='@' || *s=='=')
673 s++;
674 else if (*s==LUA_SIGNATURE[0])
675 s="(bstring)";
676 else
677 s="(string)";
678 printf("\n%s <%s:%d,%d> (%d instruction%s at %p)\n",
679 (f->linedefined==0)?"main":"function",s,
680 f->linedefined,f->lastlinedefined,
681 S(f->sizecode),VOID(f));
682 printf("%d%s param%s, %d slot%s, %d upvalue%s, ",
683 (int)(f->numparams),f->is_vararg?"+":"",SS(f->numparams),
684 S(f->maxstacksize),S(f->sizeupvalues));
685 printf("%d local%s, %d constant%s, %d function%s\n",
686 S(f->sizelocvars),S(f->sizek),S(f->sizep));
687}
688
689static void PrintDebug(const Proto* f)
690{
691 int i,n;
692 n=f->sizek;
693 printf("constants (%d) for %p:\n",n,VOID(f));
694 for (i=0; i<n; i++)
695 {
696 printf("\t%d\t",i);
697 PrintType(f,i);
698 PrintConstant(f,i);
699 printf("\n");
700 }
701 n=f->sizelocvars;
702 printf("locals (%d) for %p:\n",n,VOID(f));
703 for (i=0; i<n; i++)
704 {
705 printf("\t%d\t%s\t%d\t%d\n",
706 i,getstr(f->locvars[i].varname),f->locvars[i].startpc+1,f->locvars[i].endpc+1);
707 }
708 n=f->sizeupvalues;
709 printf("upvalues (%d) for %p:\n",n,VOID(f));
710 for (i=0; i<n; i++)
711 {
712 printf("\t%d\t%s\t%d\t%d\n",
713 i,UPVALNAME(i),f->upvalues[i].instack,f->upvalues[i].idx);
714 }
715}
716
717static void PrintFunction(const Proto* f, int full)
718{
719 int i,n=f->sizep;
720 PrintHeader(f);
721 PrintCode(f);
722 if (full) PrintDebug(f);
723 for (i=0; i<n; i++) PrintFunction(f->p[i],full);
724}
diff --git a/src/lua/luaconf.h b/src/lua/luaconf.h
deleted file mode 100644
index e64d2ee..0000000
--- a/src/lua/luaconf.h
+++ /dev/null
@@ -1,790 +0,0 @@
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 compiler
20** (e.g., with '-D' options): They are commented out or protected
21** by '#if !defined' guards. However, several other definitions
22** should be changed directly here, either because they affect the
23** Lua ABI (by making the changes here, you ensure that all software
24** connected to Lua, such as C libraries, will be compiled with the same
25** 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@@ LUA_USE_C89 controls the use of non-ISO-C89 features.
41** Define it if you want Lua to avoid the use of a few C99 features
42** or Windows-specific features on Windows.
43*/
44/* #define LUA_USE_C89 */
45
46
47/*
48** By default, Lua on Windows use (some) specific Windows features
49*/
50#if !defined(LUA_USE_C89) && defined(_WIN32) && !defined(_WIN32_WCE)
51#define LUA_USE_WINDOWS /* enable goodies for regular Windows */
52#endif
53
54
55#if defined(LUA_USE_WINDOWS)
56#define LUA_DL_DLL /* enable support for DLL */
57#define LUA_USE_C89 /* broadly, Windows is C89 */
58#endif
59
60
61#if defined(LUA_USE_LINUX)
62#define LUA_USE_POSIX
63#define LUA_USE_DLOPEN /* needs an extra library: -ldl */
64#endif
65
66
67#if defined(LUA_USE_MACOSX)
68#define LUA_USE_POSIX
69#define LUA_USE_DLOPEN /* MacOS does not need -ldl */
70#endif
71
72
73/*
74@@ LUAI_IS32INT is true iff 'int' has (at least) 32 bits.
75*/
76#define LUAI_IS32INT ((UINT_MAX >> 30) >= 3)
77
78/* }================================================================== */
79
80
81
82/*
83** {==================================================================
84** Configuration for Number types. These options should not be
85** set externally, because any other code connected to Lua must
86** use the same configuration.
87** ===================================================================
88*/
89
90/*
91@@ LUA_INT_TYPE defines the type for Lua integers.
92@@ LUA_FLOAT_TYPE defines the type for Lua floats.
93** Lua should work fine with any mix of these options supported
94** by your C compiler. The usual configurations are 64-bit integers
95** and 'double' (the default), 32-bit integers and 'float' (for
96** restricted platforms), and 'long'/'double' (for C compilers not
97** compliant with C99, which may not have support for 'long long').
98*/
99
100/* predefined options for LUA_INT_TYPE */
101#define LUA_INT_INT 1
102#define LUA_INT_LONG 2
103#define LUA_INT_LONGLONG 3
104
105/* predefined options for LUA_FLOAT_TYPE */
106#define LUA_FLOAT_FLOAT 1
107#define LUA_FLOAT_DOUBLE 2
108#define LUA_FLOAT_LONGDOUBLE 3
109
110
111/* Default configuration ('long long' and 'double', for 64-bit Lua) */
112#define LUA_INT_DEFAULT LUA_INT_LONGLONG
113#define LUA_FLOAT_DEFAULT LUA_FLOAT_DOUBLE
114
115
116/*
117@@ LUA_32BITS enables Lua with 32-bit integers and 32-bit floats.
118*/
119#define LUA_32BITS 0
120
121
122/*
123@@ LUA_C89_NUMBERS ensures that Lua uses the largest types available for
124** C89 ('long' and 'double'); Windows always has '__int64', so it does
125** not need to use this case.
126*/
127#if defined(LUA_USE_C89) && !defined(LUA_USE_WINDOWS)
128#define LUA_C89_NUMBERS 1
129#else
130#define LUA_C89_NUMBERS 0
131#endif
132
133
134#if LUA_32BITS /* { */
135/*
136** 32-bit integers and 'float'
137*/
138#if LUAI_IS32INT /* use 'int' if big enough */
139#define LUA_INT_TYPE LUA_INT_INT
140#else /* otherwise use 'long' */
141#define LUA_INT_TYPE LUA_INT_LONG
142#endif
143#define LUA_FLOAT_TYPE LUA_FLOAT_FLOAT
144
145#elif LUA_C89_NUMBERS /* }{ */
146/*
147** largest types available for C89 ('long' and 'double')
148*/
149#define LUA_INT_TYPE LUA_INT_LONG
150#define LUA_FLOAT_TYPE LUA_FLOAT_DOUBLE
151
152#else /* }{ */
153/* use defaults */
154
155#define LUA_INT_TYPE LUA_INT_DEFAULT
156#define LUA_FLOAT_TYPE LUA_FLOAT_DEFAULT
157
158#endif /* } */
159
160
161/* }================================================================== */
162
163
164
165/*
166** {==================================================================
167** Configuration for Paths.
168** ===================================================================
169*/
170
171/*
172** LUA_PATH_SEP is the character that separates templates in a path.
173** LUA_PATH_MARK is the string that marks the substitution points in a
174** template.
175** LUA_EXEC_DIR in a Windows path is replaced by the executable's
176** directory.
177*/
178#define LUA_PATH_SEP ";"
179#define LUA_PATH_MARK "?"
180#define LUA_EXEC_DIR "!"
181
182
183/*
184@@ LUA_PATH_DEFAULT is the default path that Lua uses to look for
185** Lua libraries.
186@@ LUA_CPATH_DEFAULT is the default path that Lua uses to look for
187** C libraries.
188** CHANGE them if your machine has a non-conventional directory
189** hierarchy or if you want to install your libraries in
190** non-conventional directories.
191*/
192
193#define LUA_VDIR LUA_VERSION_MAJOR "." LUA_VERSION_MINOR
194#if defined(_WIN32) /* { */
195/*
196** In Windows, any exclamation mark ('!') in the path is replaced by the
197** path of the directory of the executable file of the current process.
198*/
199#define LUA_LDIR "!\\lua\\"
200#define LUA_CDIR "!\\"
201#define LUA_SHRDIR "!\\..\\share\\lua\\" LUA_VDIR "\\"
202
203#if !defined(LUA_PATH_DEFAULT)
204#define LUA_PATH_DEFAULT \
205 LUA_LDIR"?.lua;" LUA_LDIR"?\\init.lua;" \
206 LUA_CDIR"?.lua;" LUA_CDIR"?\\init.lua;" \
207 LUA_SHRDIR"?.lua;" LUA_SHRDIR"?\\init.lua;" \
208 ".\\?.lua;" ".\\?\\init.lua"
209#endif
210
211#if !defined(LUA_CPATH_DEFAULT)
212#define LUA_CPATH_DEFAULT \
213 LUA_CDIR"?.dll;" \
214 LUA_CDIR"..\\lib\\lua\\" LUA_VDIR "\\?.dll;" \
215 LUA_CDIR"loadall.dll;" ".\\?.dll"
216#endif
217
218#else /* }{ */
219
220#define LUA_ROOT "/usr/local/"
221#define LUA_LDIR LUA_ROOT "share/lua/" LUA_VDIR "/"
222#define LUA_CDIR LUA_ROOT "lib/lua/" LUA_VDIR "/"
223
224#if !defined(LUA_PATH_DEFAULT)
225#define LUA_PATH_DEFAULT \
226 LUA_LDIR"?.lua;" LUA_LDIR"?/init.lua;" \
227 LUA_CDIR"?.lua;" LUA_CDIR"?/init.lua;" \
228 "./?.lua;" "./?/init.lua"
229#endif
230
231#if !defined(LUA_CPATH_DEFAULT)
232#define LUA_CPATH_DEFAULT \
233 LUA_CDIR"?.so;" LUA_CDIR"loadall.so;" "./?.so"
234#endif
235
236#endif /* } */
237
238
239/*
240@@ LUA_DIRSEP is the directory separator (for submodules).
241** CHANGE it if your machine does not use "/" as the directory separator
242** and is not Windows. (On Windows Lua automatically uses "\".)
243*/
244#if !defined(LUA_DIRSEP)
245
246#if defined(_WIN32)
247#define LUA_DIRSEP "\\"
248#else
249#define LUA_DIRSEP "/"
250#endif
251
252#endif
253
254/* }================================================================== */
255
256
257/*
258** {==================================================================
259** Marks for exported symbols in the C code
260** ===================================================================
261*/
262
263/*
264@@ LUA_API is a mark for all core API functions.
265@@ LUALIB_API is a mark for all auxiliary library functions.
266@@ LUAMOD_API is a mark for all standard library opening functions.
267** CHANGE them if you need to define those functions in some special way.
268** For instance, if you want to create one Windows DLL with the core and
269** the libraries, you may want to use the following definition (define
270** LUA_BUILD_AS_DLL to get it).
271*/
272#if defined(LUA_BUILD_AS_DLL) /* { */
273
274#if defined(LUA_CORE) || defined(LUA_LIB) /* { */
275#define LUA_API __declspec(dllexport)
276#else /* }{ */
277#define LUA_API __declspec(dllimport)
278#endif /* } */
279
280#else /* }{ */
281
282#define LUA_API extern
283
284#endif /* } */
285
286
287/*
288** More often than not the libs go together with the core.
289*/
290#define LUALIB_API LUA_API
291#define LUAMOD_API LUA_API
292
293
294/*
295@@ LUAI_FUNC is a mark for all extern functions that are not to be
296** exported to outside modules.
297@@ LUAI_DDEF and LUAI_DDEC are marks for all extern (const) variables,
298** none of which to be exported to outside modules (LUAI_DDEF for
299** definitions and LUAI_DDEC for declarations).
300** CHANGE them if you need to mark them in some special way. Elf/gcc
301** (versions 3.2 and later) mark them as "hidden" to optimize access
302** when Lua is compiled as a shared library. Not all elf targets support
303** this attribute. Unfortunately, gcc does not offer a way to check
304** whether the target offers that support, and those without support
305** give a warning about it. To avoid these warnings, change to the
306** default definition.
307*/
308#if defined(__GNUC__) && ((__GNUC__*100 + __GNUC_MINOR__) >= 302) && \
309 defined(__ELF__) /* { */
310#define LUAI_FUNC __attribute__((visibility("internal"))) extern
311#else /* }{ */
312#define LUAI_FUNC extern
313#endif /* } */
314
315#define LUAI_DDEC(dec) LUAI_FUNC dec
316#define LUAI_DDEF /* empty */
317
318/* }================================================================== */
319
320
321/*
322** {==================================================================
323** Compatibility with previous versions
324** ===================================================================
325*/
326
327/*
328@@ LUA_COMPAT_5_3 controls other macros for compatibility with Lua 5.3.
329** You can define it to get all options, or change specific options
330** to fit your specific needs.
331*/
332#if defined(LUA_COMPAT_5_3) /* { */
333
334/*
335@@ LUA_COMPAT_MATHLIB controls the presence of several deprecated
336** functions in the mathematical library.
337** (These functions were already officially removed in 5.3;
338** nevertheless they are still available here.)
339*/
340#define LUA_COMPAT_MATHLIB
341
342/*
343@@ LUA_COMPAT_APIINTCASTS controls the presence of macros for
344** manipulating other integer types (lua_pushunsigned, lua_tounsigned,
345** luaL_checkint, luaL_checklong, etc.)
346** (These macros were also officially removed in 5.3, but they are still
347** available here.)
348*/
349#define LUA_COMPAT_APIINTCASTS
350
351
352/*
353@@ LUA_COMPAT_LT_LE controls the emulation of the '__le' metamethod
354** using '__lt'.
355*/
356#define LUA_COMPAT_LT_LE
357
358
359/*
360@@ The following macros supply trivial compatibility for some
361** changes in the API. The macros themselves document how to
362** change your code to avoid using them.
363** (Once more, these macros were officially removed in 5.3, but they are
364** still available here.)
365*/
366#define lua_strlen(L,i) lua_rawlen(L, (i))
367
368#define lua_objlen(L,i) lua_rawlen(L, (i))
369
370#define lua_equal(L,idx1,idx2) lua_compare(L,(idx1),(idx2),LUA_OPEQ)
371#define lua_lessthan(L,idx1,idx2) lua_compare(L,(idx1),(idx2),LUA_OPLT)
372
373#endif /* } */
374
375/* }================================================================== */
376
377
378
379/*
380** {==================================================================
381** Configuration for Numbers (low-level part).
382** Change these definitions if no predefined LUA_FLOAT_* / LUA_INT_*
383** satisfy your needs.
384** ===================================================================
385*/
386
387/*
388@@ LUAI_UACNUMBER is the result of a 'default argument promotion'
389@@ over a floating number.
390@@ l_floatatt(x) corrects float attribute 'x' to the proper float type
391** by prefixing it with one of FLT/DBL/LDBL.
392@@ LUA_NUMBER_FRMLEN is the length modifier for writing floats.
393@@ LUA_NUMBER_FMT is the format for writing floats.
394@@ lua_number2str converts a float to a string.
395@@ l_mathop allows the addition of an 'l' or 'f' to all math operations.
396@@ l_floor takes the floor of a float.
397@@ lua_str2number converts a decimal numeral to a number.
398*/
399
400
401/* The following definitions are good for most cases here */
402
403#define l_floor(x) (l_mathop(floor)(x))
404
405#define lua_number2str(s,sz,n) \
406 l_sprintf((s), sz, LUA_NUMBER_FMT, (LUAI_UACNUMBER)(n))
407
408/*
409@@ lua_numbertointeger converts a float number with an integral value
410** to an integer, or returns 0 if float is not within the range of
411** a lua_Integer. (The range comparisons are tricky because of
412** rounding. The tests here assume a two-complement representation,
413** where MININTEGER always has an exact representation as a float;
414** MAXINTEGER may not have one, and therefore its conversion to float
415** may have an ill-defined value.)
416*/
417#define lua_numbertointeger(n,p) \
418 ((n) >= (LUA_NUMBER)(LUA_MININTEGER) && \
419 (n) < -(LUA_NUMBER)(LUA_MININTEGER) && \
420 (*(p) = (LUA_INTEGER)(n), 1))
421
422
423/* now the variable definitions */
424
425#if LUA_FLOAT_TYPE == LUA_FLOAT_FLOAT /* { single float */
426
427#define LUA_NUMBER float
428
429#define l_floatatt(n) (FLT_##n)
430
431#define LUAI_UACNUMBER double
432
433#define LUA_NUMBER_FRMLEN ""
434#define LUA_NUMBER_FMT "%.7g"
435
436#define l_mathop(op) op##f
437
438#define lua_str2number(s,p) strtof((s), (p))
439
440
441#elif LUA_FLOAT_TYPE == LUA_FLOAT_LONGDOUBLE /* }{ long double */
442
443#define LUA_NUMBER long double
444
445#define l_floatatt(n) (LDBL_##n)
446
447#define LUAI_UACNUMBER long double
448
449#define LUA_NUMBER_FRMLEN "L"
450#define LUA_NUMBER_FMT "%.19Lg"
451
452#define l_mathop(op) op##l
453
454#define lua_str2number(s,p) strtold((s), (p))
455
456#elif LUA_FLOAT_TYPE == LUA_FLOAT_DOUBLE /* }{ double */
457
458#define LUA_NUMBER double
459
460#define l_floatatt(n) (DBL_##n)
461
462#define LUAI_UACNUMBER double
463
464#define LUA_NUMBER_FRMLEN ""
465#define LUA_NUMBER_FMT "%.14g"
466
467#define l_mathop(op) op
468
469#define lua_str2number(s,p) strtod((s), (p))
470
471#else /* }{ */
472
473#error "numeric float type not defined"
474
475#endif /* } */
476
477
478
479/*
480@@ LUA_UNSIGNED is the unsigned version of LUA_INTEGER.
481@@ LUAI_UACINT is the result of a 'default argument promotion'
482@@ over a LUA_INTEGER.
483@@ LUA_INTEGER_FRMLEN is the length modifier for reading/writing integers.
484@@ LUA_INTEGER_FMT is the format for writing integers.
485@@ LUA_MAXINTEGER is the maximum value for a LUA_INTEGER.
486@@ LUA_MININTEGER is the minimum value for a LUA_INTEGER.
487@@ LUA_MAXUNSIGNED is the maximum value for a LUA_UNSIGNED.
488@@ LUA_UNSIGNEDBITS is the number of bits in a LUA_UNSIGNED.
489@@ lua_integer2str converts an integer to a string.
490*/
491
492
493/* The following definitions are good for most cases here */
494
495#define LUA_INTEGER_FMT "%" LUA_INTEGER_FRMLEN "d"
496
497#define LUAI_UACINT LUA_INTEGER
498
499#define lua_integer2str(s,sz,n) \
500 l_sprintf((s), sz, LUA_INTEGER_FMT, (LUAI_UACINT)(n))
501
502/*
503** use LUAI_UACINT here to avoid problems with promotions (which
504** can turn a comparison between unsigneds into a signed comparison)
505*/
506#define LUA_UNSIGNED unsigned LUAI_UACINT
507
508
509#define LUA_UNSIGNEDBITS (sizeof(LUA_UNSIGNED) * CHAR_BIT)
510
511
512/* now the variable definitions */
513
514#if LUA_INT_TYPE == LUA_INT_INT /* { int */
515
516#define LUA_INTEGER int
517#define LUA_INTEGER_FRMLEN ""
518
519#define LUA_MAXINTEGER INT_MAX
520#define LUA_MININTEGER INT_MIN
521
522#define LUA_MAXUNSIGNED UINT_MAX
523
524#elif LUA_INT_TYPE == LUA_INT_LONG /* }{ long */
525
526#define LUA_INTEGER long
527#define LUA_INTEGER_FRMLEN "l"
528
529#define LUA_MAXINTEGER LONG_MAX
530#define LUA_MININTEGER LONG_MIN
531
532#define LUA_MAXUNSIGNED ULONG_MAX
533
534#elif LUA_INT_TYPE == LUA_INT_LONGLONG /* }{ long long */
535
536/* use presence of macro LLONG_MAX as proxy for C99 compliance */
537#if defined(LLONG_MAX) /* { */
538/* use ISO C99 stuff */
539
540#define LUA_INTEGER long long
541#define LUA_INTEGER_FRMLEN "ll"
542
543#define LUA_MAXINTEGER LLONG_MAX
544#define LUA_MININTEGER LLONG_MIN
545
546#define LUA_MAXUNSIGNED ULLONG_MAX
547
548#elif defined(LUA_USE_WINDOWS) /* }{ */
549/* in Windows, can use specific Windows types */
550
551#define LUA_INTEGER __int64
552#define LUA_INTEGER_FRMLEN "I64"
553
554#define LUA_MAXINTEGER _I64_MAX
555#define LUA_MININTEGER _I64_MIN
556
557#define LUA_MAXUNSIGNED _UI64_MAX
558
559#else /* }{ */
560
561#error "Compiler does not support 'long long'. Use option '-DLUA_32BITS' \
562 or '-DLUA_C89_NUMBERS' (see file 'luaconf.h' for details)"
563
564#endif /* } */
565
566#else /* }{ */
567
568#error "numeric integer type not defined"
569
570#endif /* } */
571
572/* }================================================================== */
573
574
575/*
576** {==================================================================
577** Dependencies with C99 and other C details
578** ===================================================================
579*/
580
581/*
582@@ l_sprintf is equivalent to 'snprintf' or 'sprintf' in C89.
583** (All uses in Lua have only one format item.)
584*/
585#if !defined(LUA_USE_C89)
586#define l_sprintf(s,sz,f,i) snprintf(s,sz,f,i)
587#else
588#define l_sprintf(s,sz,f,i) ((void)(sz), sprintf(s,f,i))
589#endif
590
591
592/*
593@@ lua_strx2number converts a hexadecimal numeral to a number.
594** In C99, 'strtod' does that conversion. Otherwise, you can
595** leave 'lua_strx2number' undefined and Lua will provide its own
596** implementation.
597*/
598#if !defined(LUA_USE_C89)
599#define lua_strx2number(s,p) lua_str2number(s,p)
600#endif
601
602
603/*
604@@ lua_pointer2str converts a pointer to a readable string in a
605** non-specified way.
606*/
607#define lua_pointer2str(buff,sz,p) l_sprintf(buff,sz,"%p",p)
608
609
610/*
611@@ lua_number2strx converts a float to a hexadecimal numeral.
612** In C99, 'sprintf' (with format specifiers '%a'/'%A') does that.
613** Otherwise, you can leave 'lua_number2strx' undefined and Lua will
614** provide its own implementation.
615*/
616#if !defined(LUA_USE_C89)
617#define lua_number2strx(L,b,sz,f,n) \
618 ((void)L, l_sprintf(b,sz,f,(LUAI_UACNUMBER)(n)))
619#endif
620
621
622/*
623** 'strtof' and 'opf' variants for math functions are not valid in
624** C89. Otherwise, the macro 'HUGE_VALF' is a good proxy for testing the
625** availability of these variants. ('math.h' is already included in
626** all files that use these macros.)
627*/
628#if defined(LUA_USE_C89) || (defined(HUGE_VAL) && !defined(HUGE_VALF))
629#undef l_mathop /* variants not available */
630#undef lua_str2number
631#define l_mathop(op) (lua_Number)op /* no variant */
632#define lua_str2number(s,p) ((lua_Number)strtod((s), (p)))
633#endif
634
635
636/*
637@@ LUA_KCONTEXT is the type of the context ('ctx') for continuation
638** functions. It must be a numerical type; Lua will use 'intptr_t' if
639** available, otherwise it will use 'ptrdiff_t' (the nearest thing to
640** 'intptr_t' in C89)
641*/
642#define LUA_KCONTEXT ptrdiff_t
643
644#if !defined(LUA_USE_C89) && defined(__STDC_VERSION__) && \
645 __STDC_VERSION__ >= 199901L
646#include <stdint.h>
647#if defined(INTPTR_MAX) /* even in C99 this type is optional */
648#undef LUA_KCONTEXT
649#define LUA_KCONTEXT intptr_t
650#endif
651#endif
652
653
654/*
655@@ lua_getlocaledecpoint gets the locale "radix character" (decimal point).
656** Change that if you do not want to use C locales. (Code using this
657** macro must include the header 'locale.h'.)
658*/
659#if !defined(lua_getlocaledecpoint)
660#define lua_getlocaledecpoint() (localeconv()->decimal_point[0])
661#endif
662
663
664/*
665** macros to improve jump prediction, used mostly for error handling
666** and debug facilities. (Some macros in the Lua API use these macros.
667** Define LUA_NOBUILTIN if you do not want '__builtin_expect' in your
668** code.)
669*/
670#if !defined(luai_likely)
671
672#if defined(__GNUC__) && !defined(LUA_NOBUILTIN)
673#define luai_likely(x) (__builtin_expect(((x) != 0), 1))
674#define luai_unlikely(x) (__builtin_expect(((x) != 0), 0))
675#else
676#define luai_likely(x) (x)
677#define luai_unlikely(x) (x)
678#endif
679
680#endif
681
682
683#if defined(LUA_CORE) || defined(LUA_LIB)
684/* shorter names for Lua's own use */
685#define l_likely(x) luai_likely(x)
686#define l_unlikely(x) luai_unlikely(x)
687#endif
688
689
690
691/* }================================================================== */
692
693
694/*
695** {==================================================================
696** Language Variations
697** =====================================================================
698*/
699
700/*
701@@ LUA_NOCVTN2S/LUA_NOCVTS2N control how Lua performs some
702** coercions. Define LUA_NOCVTN2S to turn off automatic coercion from
703** numbers to strings. Define LUA_NOCVTS2N to turn off automatic
704** coercion from strings to numbers.
705*/
706/* #define LUA_NOCVTN2S */
707/* #define LUA_NOCVTS2N */
708
709
710/*
711@@ LUA_USE_APICHECK turns on several consistency checks on the C API.
712** Define it as a help when debugging C code.
713*/
714#if defined(LUA_USE_APICHECK)
715#include <assert.h>
716#define luai_apicheck(l,e) assert(e)
717#endif
718
719/* }================================================================== */
720
721
722/*
723** {==================================================================
724** Macros that affect the API and must be stable (that is, must be the
725** same when you compile Lua and when you compile code that links to
726** Lua).
727** =====================================================================
728*/
729
730/*
731@@ LUAI_MAXSTACK limits the size of the Lua stack.
732** CHANGE it if you need a different limit. This limit is arbitrary;
733** its only purpose is to stop Lua from consuming unlimited stack
734** space (and to reserve some numbers for pseudo-indices).
735** (It must fit into max(size_t)/32.)
736*/
737#if LUAI_IS32INT
738#define LUAI_MAXSTACK 1000000
739#else
740#define LUAI_MAXSTACK 15000
741#endif
742
743
744/*
745@@ LUA_EXTRASPACE defines the size of a raw memory area associated with
746** a Lua state with very fast access.
747** CHANGE it if you need a different size.
748*/
749#define LUA_EXTRASPACE (sizeof(void *))
750
751
752/*
753@@ LUA_IDSIZE gives the maximum size for the description of the source
754@@ of a function in debug information.
755** CHANGE it if you want a different size.
756*/
757#define LUA_IDSIZE 60
758
759
760/*
761@@ LUAL_BUFFERSIZE is the buffer size used by the lauxlib buffer system.
762*/
763#define LUAL_BUFFERSIZE ((int)(16 * sizeof(void*) * sizeof(lua_Number)))
764
765
766/*
767@@ LUAI_MAXALIGN defines fields that, when used in a union, ensure
768** maximum alignment for the other items in that union.
769*/
770#define LUAI_MAXALIGN lua_Number n; double u; void *s; lua_Integer i; long l
771
772/* }================================================================== */
773
774
775
776
777
778/* =================================================================== */
779
780/*
781** Local configuration. You can use this space to add your redefinitions
782** without modifying the main part of the file.
783*/
784
785
786
787
788
789#endif
790
diff --git a/src/lua/lualib.h b/src/lua/lualib.h
deleted file mode 100644
index 2625529..0000000
--- a/src/lua/lualib.h
+++ /dev/null
@@ -1,52 +0,0 @@
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#endif
diff --git a/src/lua/lundump.c b/src/lua/lundump.c
deleted file mode 100644
index 5aa55c4..0000000
--- a/src/lua/lundump.c
+++ /dev/null
@@ -1,333 +0,0 @@
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 setsvalue2s(L, L->top, ts); /* anchor it ('loadVector' can GC) */
124 luaD_inctop(L);
125 loadVector(S, getstr(ts), size); /* load directly in final place */
126 L->top--; /* pop string */
127 }
128 luaC_objbarrier(L, p, ts);
129 return ts;
130}
131
132
133/*
134** Load a non-nullable string into prototype 'p'.
135*/
136static TString *loadString (LoadState *S, Proto *p) {
137 TString *st = loadStringN(S, p);
138 if (st == NULL)
139 error(S, "bad format for constant string");
140 return st;
141}
142
143
144static void loadCode (LoadState *S, Proto *f) {
145 int n = loadInt(S);
146 f->code = luaM_newvectorchecked(S->L, n, Instruction);
147 f->sizecode = n;
148 loadVector(S, f->code, n);
149}
150
151
152static void loadFunction(LoadState *S, Proto *f, TString *psource);
153
154
155static void loadConstants (LoadState *S, Proto *f) {
156 int i;
157 int n = loadInt(S);
158 f->k = luaM_newvectorchecked(S->L, n, TValue);
159 f->sizek = n;
160 for (i = 0; i < n; i++)
161 setnilvalue(&f->k[i]);
162 for (i = 0; i < n; i++) {
163 TValue *o = &f->k[i];
164 int t = loadByte(S);
165 switch (t) {
166 case LUA_VNIL:
167 setnilvalue(o);
168 break;
169 case LUA_VFALSE:
170 setbfvalue(o);
171 break;
172 case LUA_VTRUE:
173 setbtvalue(o);
174 break;
175 case LUA_VNUMFLT:
176 setfltvalue(o, loadNumber(S));
177 break;
178 case LUA_VNUMINT:
179 setivalue(o, loadInteger(S));
180 break;
181 case LUA_VSHRSTR:
182 case LUA_VLNGSTR:
183 setsvalue2n(S->L, o, loadString(S, f));
184 break;
185 default: lua_assert(0);
186 }
187 }
188}
189
190
191static void loadProtos (LoadState *S, Proto *f) {
192 int i;
193 int n = loadInt(S);
194 f->p = luaM_newvectorchecked(S->L, n, Proto *);
195 f->sizep = n;
196 for (i = 0; i < n; i++)
197 f->p[i] = NULL;
198 for (i = 0; i < n; i++) {
199 f->p[i] = luaF_newproto(S->L);
200 luaC_objbarrier(S->L, f, f->p[i]);
201 loadFunction(S, f->p[i], f->source);
202 }
203}
204
205
206/*
207** Load the upvalues for a function. The names must be filled first,
208** because the filling of the other fields can raise read errors and
209** the creation of the error message can call an emergency collection;
210** in that case all prototypes must be consistent for the GC.
211*/
212static void loadUpvalues (LoadState *S, Proto *f) {
213 int i, n;
214 n = loadInt(S);
215 f->upvalues = luaM_newvectorchecked(S->L, n, Upvaldesc);
216 f->sizeupvalues = n;
217 for (i = 0; i < n; i++) /* make array valid for GC */
218 f->upvalues[i].name = NULL;
219 for (i = 0; i < n; i++) { /* following calls can raise errors */
220 f->upvalues[i].instack = loadByte(S);
221 f->upvalues[i].idx = loadByte(S);
222 f->upvalues[i].kind = loadByte(S);
223 }
224}
225
226
227static void loadDebug (LoadState *S, Proto *f) {
228 int i, n;
229 n = loadInt(S);
230 f->lineinfo = luaM_newvectorchecked(S->L, n, ls_byte);
231 f->sizelineinfo = n;
232 loadVector(S, f->lineinfo, n);
233 n = loadInt(S);
234 f->abslineinfo = luaM_newvectorchecked(S->L, n, AbsLineInfo);
235 f->sizeabslineinfo = n;
236 for (i = 0; i < n; i++) {
237 f->abslineinfo[i].pc = loadInt(S);
238 f->abslineinfo[i].line = loadInt(S);
239 }
240 n = loadInt(S);
241 f->locvars = luaM_newvectorchecked(S->L, n, LocVar);
242 f->sizelocvars = n;
243 for (i = 0; i < n; i++)
244 f->locvars[i].varname = NULL;
245 for (i = 0; i < n; i++) {
246 f->locvars[i].varname = loadStringN(S, f);
247 f->locvars[i].startpc = loadInt(S);
248 f->locvars[i].endpc = loadInt(S);
249 }
250 n = loadInt(S);
251 for (i = 0; i < n; i++)
252 f->upvalues[i].name = loadStringN(S, f);
253}
254
255
256static void loadFunction (LoadState *S, Proto *f, TString *psource) {
257 f->source = loadStringN(S, f);
258 if (f->source == NULL) /* no source in dump? */
259 f->source = psource; /* reuse parent's source */
260 f->linedefined = loadInt(S);
261 f->lastlinedefined = loadInt(S);
262 f->numparams = loadByte(S);
263 f->is_vararg = loadByte(S);
264 f->maxstacksize = loadByte(S);
265 loadCode(S, f);
266 loadConstants(S, f);
267 loadUpvalues(S, f);
268 loadProtos(S, f);
269 loadDebug(S, f);
270}
271
272
273static void checkliteral (LoadState *S, const char *s, const char *msg) {
274 char buff[sizeof(LUA_SIGNATURE) + sizeof(LUAC_DATA)]; /* larger than both */
275 size_t len = strlen(s);
276 loadVector(S, buff, len);
277 if (memcmp(s, buff, len) != 0)
278 error(S, msg);
279}
280
281
282static void fchecksize (LoadState *S, size_t size, const char *tname) {
283 if (loadByte(S) != size)
284 error(S, luaO_pushfstring(S->L, "%s size mismatch", tname));
285}
286
287
288#define checksize(S,t) fchecksize(S,sizeof(t),#t)
289
290static void checkHeader (LoadState *S) {
291 /* skip 1st char (already read and checked) */
292 checkliteral(S, &LUA_SIGNATURE[1], "not a binary chunk");
293 if (loadByte(S) != LUAC_VERSION)
294 error(S, "version mismatch");
295 if (loadByte(S) != LUAC_FORMAT)
296 error(S, "format mismatch");
297 checkliteral(S, LUAC_DATA, "corrupted chunk");
298 checksize(S, Instruction);
299 checksize(S, lua_Integer);
300 checksize(S, lua_Number);
301 if (loadInteger(S) != LUAC_INT)
302 error(S, "integer format mismatch");
303 if (loadNumber(S) != LUAC_NUM)
304 error(S, "float format mismatch");
305}
306
307
308/*
309** Load precompiled chunk.
310*/
311LClosure *luaU_undump(lua_State *L, ZIO *Z, const char *name) {
312 LoadState S;
313 LClosure *cl;
314 if (*name == '@' || *name == '=')
315 S.name = name + 1;
316 else if (*name == LUA_SIGNATURE[0])
317 S.name = "binary string";
318 else
319 S.name = name;
320 S.L = L;
321 S.Z = Z;
322 checkHeader(&S);
323 cl = luaF_newLclosure(L, loadByte(&S));
324 setclLvalue2s(L, L->top, cl);
325 luaD_inctop(L);
326 cl->p = luaF_newproto(L);
327 luaC_objbarrier(L, cl, cl->p);
328 loadFunction(&S, cl->p, NULL);
329 lua_assert(cl->nupvalues == cl->p->sizeupvalues);
330 luai_verifycode(L, cl->p);
331 return cl;
332}
333
diff --git a/src/lua/lundump.h b/src/lua/lundump.h
deleted file mode 100644
index f3748a9..0000000
--- a/src/lua/lundump.h
+++ /dev/null
@@ -1,36 +0,0 @@
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
deleted file mode 100644
index 901d985..0000000
--- a/src/lua/lutf8lib.c
+++ /dev/null
@@ -1,289 +0,0 @@
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
deleted file mode 100644
index c9729bc..0000000
--- a/src/lua/lvm.c
+++ /dev/null
@@ -1,1836 +0,0 @@
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 (l_unlikely(!tonumber(plimit, &limit)))
239 luaG_forerror(L, plimit, "limit");
240 if (l_unlikely(!tonumber(pstep, &step)))
241 luaG_forerror(L, pstep, "step");
242 if (l_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 (l_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 luaH_finishset(L, h, key, slot, val); /* set new value */
341 invalidateTMcache(h);
342 luaC_barrierback(L, obj2gco(h), val);
343 return;
344 }
345 /* else will try the metamethod */
346 }
347 else { /* not a table; check metamethod */
348 tm = luaT_gettmbyobj(L, t, TM_NEWINDEX);
349 if (l_unlikely(notm(tm)))
350 luaG_typeerror(L, t, "index");
351 }
352 /* try the metamethod */
353 if (ttisfunction(tm)) {
354 luaT_callTM(L, tm, t, key, val);
355 return;
356 }
357 t = tm; /* else repeat assignment over 'tm' */
358 if (luaV_fastget(L, t, key, slot, luaH_get)) {
359 luaV_finishfastset(L, t, slot, val);
360 return; /* done */
361 }
362 /* else 'return luaV_finishset(L, t, key, val, slot)' (loop) */
363 }
364 luaG_runerror(L, "'__newindex' chain too long; possible loop");
365}
366
367
368/*
369** Compare two strings 'ls' x 'rs', returning an integer less-equal-
370** -greater than zero if 'ls' is less-equal-greater than 'rs'.
371** The code is a little tricky because it allows '\0' in the strings
372** and it uses 'strcoll' (to respect locales) for each segments
373** of the strings.
374*/
375static int l_strcmp (const TString *ls, const TString *rs) {
376 const char *l = getstr(ls);
377 size_t ll = tsslen(ls);
378 const char *r = getstr(rs);
379 size_t lr = tsslen(rs);
380 for (;;) { /* for each segment */
381 int temp = strcoll(l, r);
382 if (temp != 0) /* not equal? */
383 return temp; /* done */
384 else { /* strings are equal up to a '\0' */
385 size_t len = strlen(l); /* index of first '\0' in both strings */
386 if (len == lr) /* 'rs' is finished? */
387 return (len == ll) ? 0 : 1; /* check 'ls' */
388 else if (len == ll) /* 'ls' is finished? */
389 return -1; /* 'ls' is less than 'rs' ('rs' is not finished) */
390 /* both strings longer than 'len'; go on comparing after the '\0' */
391 len++;
392 l += len; ll -= len; r += len; lr -= len;
393 }
394 }
395}
396
397
398/*
399** Check whether integer 'i' is less than float 'f'. If 'i' has an
400** exact representation as a float ('l_intfitsf'), compare numbers as
401** floats. Otherwise, use the equivalence 'i < f <=> i < ceil(f)'.
402** If 'ceil(f)' is out of integer range, either 'f' is greater than
403** all integers or less than all integers.
404** (The test with 'l_intfitsf' is only for performance; the else
405** case is correct for all values, but it is slow due to the conversion
406** from float to int.)
407** When 'f' is NaN, comparisons must result in false.
408*/
409static int LTintfloat (lua_Integer i, lua_Number f) {
410 if (l_intfitsf(i))
411 return luai_numlt(cast_num(i), f); /* compare them as floats */
412 else { /* i < f <=> i < ceil(f) */
413 lua_Integer fi;
414 if (luaV_flttointeger(f, &fi, F2Iceil)) /* fi = ceil(f) */
415 return i < fi; /* compare them as integers */
416 else /* 'f' is either greater or less than all integers */
417 return f > 0; /* greater? */
418 }
419}
420
421
422/*
423** Check whether integer 'i' is less than or equal to float 'f'.
424** See comments on previous function.
425*/
426static int LEintfloat (lua_Integer i, lua_Number f) {
427 if (l_intfitsf(i))
428 return luai_numle(cast_num(i), f); /* compare them as floats */
429 else { /* i <= f <=> i <= floor(f) */
430 lua_Integer fi;
431 if (luaV_flttointeger(f, &fi, F2Ifloor)) /* fi = floor(f) */
432 return i <= fi; /* compare them as integers */
433 else /* 'f' is either greater or less than all integers */
434 return f > 0; /* greater? */
435 }
436}
437
438
439/*
440** Check whether float 'f' is less than integer 'i'.
441** See comments on previous function.
442*/
443static int LTfloatint (lua_Number f, lua_Integer i) {
444 if (l_intfitsf(i))
445 return luai_numlt(f, cast_num(i)); /* compare them as floats */
446 else { /* f < i <=> floor(f) < i */
447 lua_Integer fi;
448 if (luaV_flttointeger(f, &fi, F2Ifloor)) /* fi = floor(f) */
449 return fi < i; /* compare them as integers */
450 else /* 'f' is either greater or less than all integers */
451 return f < 0; /* less? */
452 }
453}
454
455
456/*
457** Check whether float 'f' is less than or equal to integer 'i'.
458** See comments on previous function.
459*/
460static int LEfloatint (lua_Number f, lua_Integer i) {
461 if (l_intfitsf(i))
462 return luai_numle(f, cast_num(i)); /* compare them as floats */
463 else { /* f <= i <=> ceil(f) <= i */
464 lua_Integer fi;
465 if (luaV_flttointeger(f, &fi, F2Iceil)) /* fi = ceil(f) */
466 return fi <= i; /* compare them as integers */
467 else /* 'f' is either greater or less than all integers */
468 return f < 0; /* less? */
469 }
470}
471
472
473/*
474** Return 'l < r', for numbers.
475*/
476static int LTnum (const TValue *l, const TValue *r) {
477 lua_assert(ttisnumber(l) && ttisnumber(r));
478 if (ttisinteger(l)) {
479 lua_Integer li = ivalue(l);
480 if (ttisinteger(r))
481 return li < ivalue(r); /* both are integers */
482 else /* 'l' is int and 'r' is float */
483 return LTintfloat(li, fltvalue(r)); /* l < r ? */
484 }
485 else {
486 lua_Number lf = fltvalue(l); /* 'l' must be float */
487 if (ttisfloat(r))
488 return luai_numlt(lf, fltvalue(r)); /* both are float */
489 else /* 'l' is float and 'r' is int */
490 return LTfloatint(lf, ivalue(r));
491 }
492}
493
494
495/*
496** Return 'l <= r', for numbers.
497*/
498static int LEnum (const TValue *l, const TValue *r) {
499 lua_assert(ttisnumber(l) && ttisnumber(r));
500 if (ttisinteger(l)) {
501 lua_Integer li = ivalue(l);
502 if (ttisinteger(r))
503 return li <= ivalue(r); /* both are integers */
504 else /* 'l' is int and 'r' is float */
505 return LEintfloat(li, fltvalue(r)); /* l <= r ? */
506 }
507 else {
508 lua_Number lf = fltvalue(l); /* 'l' must be float */
509 if (ttisfloat(r))
510 return luai_numle(lf, fltvalue(r)); /* both are float */
511 else /* 'l' is float and 'r' is int */
512 return LEfloatint(lf, ivalue(r));
513 }
514}
515
516
517/*
518** return 'l < r' for non-numbers.
519*/
520static int lessthanothers (lua_State *L, const TValue *l, const TValue *r) {
521 lua_assert(!ttisnumber(l) || !ttisnumber(r));
522 if (ttisstring(l) && ttisstring(r)) /* both are strings? */
523 return l_strcmp(tsvalue(l), tsvalue(r)) < 0;
524 else
525 return luaT_callorderTM(L, l, r, TM_LT);
526}
527
528
529/*
530** Main operation less than; return 'l < r'.
531*/
532int luaV_lessthan (lua_State *L, const TValue *l, const TValue *r) {
533 if (ttisnumber(l) && ttisnumber(r)) /* both operands are numbers? */
534 return LTnum(l, r);
535 else return lessthanothers(L, l, r);
536}
537
538
539/*
540** return 'l <= r' for non-numbers.
541*/
542static int lessequalothers (lua_State *L, const TValue *l, const TValue *r) {
543 lua_assert(!ttisnumber(l) || !ttisnumber(r));
544 if (ttisstring(l) && ttisstring(r)) /* both are strings? */
545 return l_strcmp(tsvalue(l), tsvalue(r)) <= 0;
546 else
547 return luaT_callorderTM(L, l, r, TM_LE);
548}
549
550
551/*
552** Main operation less than or equal to; return 'l <= r'.
553*/
554int luaV_lessequal (lua_State *L, const TValue *l, const TValue *r) {
555 if (ttisnumber(l) && ttisnumber(r)) /* both operands are numbers? */
556 return LEnum(l, r);
557 else return lessequalothers(L, l, r);
558}
559
560
561/*
562** Main operation for equality of Lua values; return 't1 == t2'.
563** L == NULL means raw equality (no metamethods)
564*/
565int luaV_equalobj (lua_State *L, const TValue *t1, const TValue *t2) {
566 const TValue *tm;
567 if (ttypetag(t1) != ttypetag(t2)) { /* not the same variant? */
568 if (ttype(t1) != ttype(t2) || ttype(t1) != LUA_TNUMBER)
569 return 0; /* only numbers can be equal with different variants */
570 else { /* two numbers with different variants */
571 /* One of them is an integer. If the other does not have an
572 integer value, they cannot be equal; otherwise, compare their
573 integer values. */
574 lua_Integer i1, i2;
575 return (luaV_tointegerns(t1, &i1, F2Ieq) &&
576 luaV_tointegerns(t2, &i2, F2Ieq) &&
577 i1 == i2);
578 }
579 }
580 /* values have same type and same variant */
581 switch (ttypetag(t1)) {
582 case LUA_VNIL: case LUA_VFALSE: case LUA_VTRUE: return 1;
583 case LUA_VNUMINT: return (ivalue(t1) == ivalue(t2));
584 case LUA_VNUMFLT: return luai_numeq(fltvalue(t1), fltvalue(t2));
585 case LUA_VLIGHTUSERDATA: return pvalue(t1) == pvalue(t2);
586 case LUA_VLCF: return fvalue(t1) == fvalue(t2);
587 case LUA_VSHRSTR: return eqshrstr(tsvalue(t1), tsvalue(t2));
588 case LUA_VLNGSTR: return luaS_eqlngstr(tsvalue(t1), tsvalue(t2));
589 case LUA_VUSERDATA: {
590 if (uvalue(t1) == uvalue(t2)) return 1;
591 else if (L == NULL) return 0;
592 tm = fasttm(L, uvalue(t1)->metatable, TM_EQ);
593 if (tm == NULL)
594 tm = fasttm(L, uvalue(t2)->metatable, TM_EQ);
595 break; /* will try TM */
596 }
597 case LUA_VTABLE: {
598 if (hvalue(t1) == hvalue(t2)) return 1;
599 else if (L == NULL) return 0;
600 tm = fasttm(L, hvalue(t1)->metatable, TM_EQ);
601 if (tm == NULL)
602 tm = fasttm(L, hvalue(t2)->metatable, TM_EQ);
603 break; /* will try TM */
604 }
605 default:
606 return gcvalue(t1) == gcvalue(t2);
607 }
608 if (tm == NULL) /* no TM? */
609 return 0; /* objects are different */
610 else {
611 luaT_callTMres(L, tm, t1, t2, L->top); /* call TM */
612 return !l_isfalse(s2v(L->top));
613 }
614}
615
616
617/* macro used by 'luaV_concat' to ensure that element at 'o' is a string */
618#define tostring(L,o) \
619 (ttisstring(o) || (cvt2str(o) && (luaO_tostring(L, o), 1)))
620
621#define isemptystr(o) (ttisshrstring(o) && tsvalue(o)->shrlen == 0)
622
623/* copy strings in stack from top - n up to top - 1 to buffer */
624static void copy2buff (StkId top, int n, char *buff) {
625 size_t tl = 0; /* size already copied */
626 do {
627 size_t l = vslen(s2v(top - n)); /* length of string being copied */
628 memcpy(buff + tl, svalue(s2v(top - n)), l * sizeof(char));
629 tl += l;
630 } while (--n > 0);
631}
632
633
634/*
635** Main operation for concatenation: concat 'total' values in the stack,
636** from 'L->top - total' up to 'L->top - 1'.
637*/
638void luaV_concat (lua_State *L, int total) {
639 if (total == 1)
640 return; /* "all" values already concatenated */
641 do {
642 StkId top = L->top;
643 int n = 2; /* number of elements handled in this pass (at least 2) */
644 if (!(ttisstring(s2v(top - 2)) || cvt2str(s2v(top - 2))) ||
645 !tostring(L, s2v(top - 1)))
646 luaT_tryconcatTM(L);
647 else if (isemptystr(s2v(top - 1))) /* second operand is empty? */
648 cast_void(tostring(L, s2v(top - 2))); /* result is first operand */
649 else if (isemptystr(s2v(top - 2))) { /* first operand is empty string? */
650 setobjs2s(L, top - 2, top - 1); /* result is second op. */
651 }
652 else {
653 /* at least two non-empty string values; get as many as possible */
654 size_t tl = vslen(s2v(top - 1));
655 TString *ts;
656 /* collect total length and number of strings */
657 for (n = 1; n < total && tostring(L, s2v(top - n - 1)); n++) {
658 size_t l = vslen(s2v(top - n - 1));
659 if (l_unlikely(l >= (MAX_SIZE/sizeof(char)) - tl))
660 luaG_runerror(L, "string length overflow");
661 tl += l;
662 }
663 if (tl <= LUAI_MAXSHORTLEN) { /* is result a short string? */
664 char buff[LUAI_MAXSHORTLEN];
665 copy2buff(top, n, buff); /* copy strings to buffer */
666 ts = luaS_newlstr(L, buff, tl);
667 }
668 else { /* long string; copy strings directly to final result */
669 ts = luaS_createlngstrobj(L, tl);
670 copy2buff(top, n, getstr(ts));
671 }
672 setsvalue2s(L, top - n, ts); /* create result */
673 }
674 total -= n-1; /* got 'n' strings to create 1 new */
675 L->top -= n-1; /* popped 'n' strings and pushed one */
676 } while (total > 1); /* repeat until only 1 result left */
677}
678
679
680/*
681** Main operation 'ra = #rb'.
682*/
683void luaV_objlen (lua_State *L, StkId ra, const TValue *rb) {
684 const TValue *tm;
685 switch (ttypetag(rb)) {
686 case LUA_VTABLE: {
687 Table *h = hvalue(rb);
688 tm = fasttm(L, h->metatable, TM_LEN);
689 if (tm) break; /* metamethod? break switch to call it */
690 setivalue(s2v(ra), luaH_getn(h)); /* else primitive len */
691 return;
692 }
693 case LUA_VSHRSTR: {
694 setivalue(s2v(ra), tsvalue(rb)->shrlen);
695 return;
696 }
697 case LUA_VLNGSTR: {
698 setivalue(s2v(ra), tsvalue(rb)->u.lnglen);
699 return;
700 }
701 default: { /* try metamethod */
702 tm = luaT_gettmbyobj(L, rb, TM_LEN);
703 if (l_unlikely(notm(tm))) /* no metamethod? */
704 luaG_typeerror(L, rb, "get length of");
705 break;
706 }
707 }
708 luaT_callTMres(L, tm, rb, rb, ra);
709}
710
711
712/*
713** Integer division; return 'm // n', that is, floor(m/n).
714** C division truncates its result (rounds towards zero).
715** 'floor(q) == trunc(q)' when 'q >= 0' or when 'q' is integer,
716** otherwise 'floor(q) == trunc(q) - 1'.
717*/
718lua_Integer luaV_idiv (lua_State *L, lua_Integer m, lua_Integer n) {
719 if (l_unlikely(l_castS2U(n) + 1u <= 1u)) { /* special cases: -1 or 0 */
720 if (n == 0)
721 luaG_runerror(L, "attempt to divide by zero");
722 return intop(-, 0, m); /* n==-1; avoid overflow with 0x80000...//-1 */
723 }
724 else {
725 lua_Integer q = m / n; /* perform C division */
726 if ((m ^ n) < 0 && m % n != 0) /* 'm/n' would be negative non-integer? */
727 q -= 1; /* correct result for different rounding */
728 return q;
729 }
730}
731
732
733/*
734** Integer modulus; return 'm % n'. (Assume that C '%' with
735** negative operands follows C99 behavior. See previous comment
736** about luaV_idiv.)
737*/
738lua_Integer luaV_mod (lua_State *L, lua_Integer m, lua_Integer n) {
739 if (l_unlikely(l_castS2U(n) + 1u <= 1u)) { /* special cases: -1 or 0 */
740 if (n == 0)
741 luaG_runerror(L, "attempt to perform 'n%%0'");
742 return 0; /* m % -1 == 0; avoid overflow with 0x80000...%-1 */
743 }
744 else {
745 lua_Integer r = m % n;
746 if (r != 0 && (r ^ n) < 0) /* 'm/n' would be non-integer negative? */
747 r += n; /* correct result for different rounding */
748 return r;
749 }
750}
751
752
753/*
754** Float modulus
755*/
756lua_Number luaV_modf (lua_State *L, lua_Number m, lua_Number n) {
757 lua_Number r;
758 luai_nummod(L, m, n, r);
759 return r;
760}
761
762
763/* number of bits in an integer */
764#define NBITS cast_int(sizeof(lua_Integer) * CHAR_BIT)
765
766/*
767** Shift left operation. (Shift right just negates 'y'.)
768*/
769#define luaV_shiftr(x,y) luaV_shiftl(x,-(y))
770
771lua_Integer luaV_shiftl (lua_Integer x, lua_Integer y) {
772 if (y < 0) { /* shift right? */
773 if (y <= -NBITS) return 0;
774 else return intop(>>, x, -y);
775 }
776 else { /* shift left */
777 if (y >= NBITS) return 0;
778 else return intop(<<, x, y);
779 }
780}
781
782
783/*
784** create a new Lua closure, push it in the stack, and initialize
785** its upvalues.
786*/
787static void pushclosure (lua_State *L, Proto *p, UpVal **encup, StkId base,
788 StkId ra) {
789 int nup = p->sizeupvalues;
790 Upvaldesc *uv = p->upvalues;
791 int i;
792 LClosure *ncl = luaF_newLclosure(L, nup);
793 ncl->p = p;
794 setclLvalue2s(L, ra, ncl); /* anchor new closure in stack */
795 for (i = 0; i < nup; i++) { /* fill in its upvalues */
796 if (uv[i].instack) /* upvalue refers to local variable? */
797 ncl->upvals[i] = luaF_findupval(L, base + uv[i].idx);
798 else /* get upvalue from enclosing function */
799 ncl->upvals[i] = encup[uv[i].idx];
800 luaC_objbarrier(L, ncl, ncl->upvals[i]);
801 }
802}
803
804
805/*
806** finish execution of an opcode interrupted by a yield
807*/
808void luaV_finishOp (lua_State *L) {
809 CallInfo *ci = L->ci;
810 StkId base = ci->func + 1;
811 Instruction inst = *(ci->u.l.savedpc - 1); /* interrupted instruction */
812 OpCode op = GET_OPCODE(inst);
813 switch (op) { /* finish its execution */
814 case OP_MMBIN: case OP_MMBINI: case OP_MMBINK: {
815 setobjs2s(L, base + GETARG_A(*(ci->u.l.savedpc - 2)), --L->top);
816 break;
817 }
818 case OP_UNM: case OP_BNOT: case OP_LEN:
819 case OP_GETTABUP: case OP_GETTABLE: case OP_GETI:
820 case OP_GETFIELD: case OP_SELF: {
821 setobjs2s(L, base + GETARG_A(inst), --L->top);
822 break;
823 }
824 case OP_LT: case OP_LE:
825 case OP_LTI: case OP_LEI:
826 case OP_GTI: case OP_GEI:
827 case OP_EQ: { /* note that 'OP_EQI'/'OP_EQK' cannot yield */
828 int res = !l_isfalse(s2v(L->top - 1));
829 L->top--;
830#if defined(LUA_COMPAT_LT_LE)
831 if (ci->callstatus & CIST_LEQ) { /* "<=" using "<" instead? */
832 ci->callstatus ^= CIST_LEQ; /* clear mark */
833 res = !res; /* negate result */
834 }
835#endif
836 lua_assert(GET_OPCODE(*ci->u.l.savedpc) == OP_JMP);
837 if (res != GETARG_k(inst)) /* condition failed? */
838 ci->u.l.savedpc++; /* skip jump instruction */
839 break;
840 }
841 case OP_CONCAT: {
842 StkId top = L->top - 1; /* top when 'luaT_tryconcatTM' was called */
843 int a = GETARG_A(inst); /* first element to concatenate */
844 int total = cast_int(top - 1 - (base + a)); /* yet to concatenate */
845 setobjs2s(L, top - 2, top); /* put TM result in proper position */
846 L->top = top - 1; /* top is one after last element (at top-2) */
847 luaV_concat(L, total); /* concat them (may yield again) */
848 break;
849 }
850 case OP_CLOSE: case OP_RETURN: { /* yielded closing variables */
851 ci->u.l.savedpc--; /* repeat instruction to close other vars. */
852 break;
853 }
854 default: {
855 /* only these other opcodes can yield */
856 lua_assert(op == OP_TFORCALL || op == OP_CALL ||
857 op == OP_TAILCALL || op == OP_SETTABUP || op == OP_SETTABLE ||
858 op == OP_SETI || op == OP_SETFIELD);
859 break;
860 }
861 }
862}
863
864
865
866
867/*
868** {==================================================================
869** Macros for arithmetic/bitwise/comparison opcodes in 'luaV_execute'
870** ===================================================================
871*/
872
873#define l_addi(L,a,b) intop(+, a, b)
874#define l_subi(L,a,b) intop(-, a, b)
875#define l_muli(L,a,b) intop(*, a, b)
876#define l_band(a,b) intop(&, a, b)
877#define l_bor(a,b) intop(|, a, b)
878#define l_bxor(a,b) intop(^, a, b)
879
880#define l_lti(a,b) (a < b)
881#define l_lei(a,b) (a <= b)
882#define l_gti(a,b) (a > b)
883#define l_gei(a,b) (a >= b)
884
885
886/*
887** Arithmetic operations with immediate operands. 'iop' is the integer
888** operation, 'fop' is the float operation.
889*/
890#define op_arithI(L,iop,fop) { \
891 TValue *v1 = vRB(i); \
892 int imm = GETARG_sC(i); \
893 if (ttisinteger(v1)) { \
894 lua_Integer iv1 = ivalue(v1); \
895 pc++; setivalue(s2v(ra), iop(L, iv1, imm)); \
896 } \
897 else if (ttisfloat(v1)) { \
898 lua_Number nb = fltvalue(v1); \
899 lua_Number fimm = cast_num(imm); \
900 pc++; setfltvalue(s2v(ra), fop(L, nb, fimm)); \
901 }}
902
903
904/*
905** Auxiliary function for arithmetic operations over floats and others
906** with two register operands.
907*/
908#define op_arithf_aux(L,v1,v2,fop) { \
909 lua_Number n1; lua_Number n2; \
910 if (tonumberns(v1, n1) && tonumberns(v2, n2)) { \
911 pc++; setfltvalue(s2v(ra), fop(L, n1, n2)); \
912 }}
913
914
915/*
916** Arithmetic operations over floats and others with register operands.
917*/
918#define op_arithf(L,fop) { \
919 TValue *v1 = vRB(i); \
920 TValue *v2 = vRC(i); \
921 op_arithf_aux(L, v1, v2, fop); }
922
923
924/*
925** Arithmetic operations with K operands for floats.
926*/
927#define op_arithfK(L,fop) { \
928 TValue *v1 = vRB(i); \
929 TValue *v2 = KC(i); lua_assert(ttisnumber(v2)); \
930 op_arithf_aux(L, v1, v2, fop); }
931
932
933/*
934** Arithmetic operations over integers and floats.
935*/
936#define op_arith_aux(L,v1,v2,iop,fop) { \
937 if (ttisinteger(v1) && ttisinteger(v2)) { \
938 lua_Integer i1 = ivalue(v1); lua_Integer i2 = ivalue(v2); \
939 pc++; setivalue(s2v(ra), iop(L, i1, i2)); \
940 } \
941 else op_arithf_aux(L, v1, v2, fop); }
942
943
944/*
945** Arithmetic operations with register operands.
946*/
947#define op_arith(L,iop,fop) { \
948 TValue *v1 = vRB(i); \
949 TValue *v2 = vRC(i); \
950 op_arith_aux(L, v1, v2, iop, fop); }
951
952
953/*
954** Arithmetic operations with K operands.
955*/
956#define op_arithK(L,iop,fop) { \
957 TValue *v1 = vRB(i); \
958 TValue *v2 = KC(i); lua_assert(ttisnumber(v2)); \
959 op_arith_aux(L, v1, v2, iop, fop); }
960
961
962/*
963** Bitwise operations with constant operand.
964*/
965#define op_bitwiseK(L,op) { \
966 TValue *v1 = vRB(i); \
967 TValue *v2 = KC(i); \
968 lua_Integer i1; \
969 lua_Integer i2 = ivalue(v2); \
970 if (tointegerns(v1, &i1)) { \
971 pc++; setivalue(s2v(ra), op(i1, i2)); \
972 }}
973
974
975/*
976** Bitwise operations with register operands.
977*/
978#define op_bitwise(L,op) { \
979 TValue *v1 = vRB(i); \
980 TValue *v2 = vRC(i); \
981 lua_Integer i1; lua_Integer i2; \
982 if (tointegerns(v1, &i1) && tointegerns(v2, &i2)) { \
983 pc++; setivalue(s2v(ra), op(i1, i2)); \
984 }}
985
986
987/*
988** Order operations with register operands. 'opn' actually works
989** for all numbers, but the fast track improves performance for
990** integers.
991*/
992#define op_order(L,opi,opn,other) { \
993 int cond; \
994 TValue *rb = vRB(i); \
995 if (ttisinteger(s2v(ra)) && ttisinteger(rb)) { \
996 lua_Integer ia = ivalue(s2v(ra)); \
997 lua_Integer ib = ivalue(rb); \
998 cond = opi(ia, ib); \
999 } \
1000 else if (ttisnumber(s2v(ra)) && ttisnumber(rb)) \
1001 cond = opn(s2v(ra), rb); \
1002 else \
1003 Protect(cond = other(L, s2v(ra), rb)); \
1004 docondjump(); }
1005
1006
1007/*
1008** Order operations with immediate operand. (Immediate operand is
1009** always small enough to have an exact representation as a float.)
1010*/
1011#define op_orderI(L,opi,opf,inv,tm) { \
1012 int cond; \
1013 int im = GETARG_sB(i); \
1014 if (ttisinteger(s2v(ra))) \
1015 cond = opi(ivalue(s2v(ra)), im); \
1016 else if (ttisfloat(s2v(ra))) { \
1017 lua_Number fa = fltvalue(s2v(ra)); \
1018 lua_Number fim = cast_num(im); \
1019 cond = opf(fa, fim); \
1020 } \
1021 else { \
1022 int isf = GETARG_C(i); \
1023 Protect(cond = luaT_callorderiTM(L, s2v(ra), im, inv, isf, tm)); \
1024 } \
1025 docondjump(); }
1026
1027/* }================================================================== */
1028
1029
1030/*
1031** {==================================================================
1032** Function 'luaV_execute': main interpreter loop
1033** ===================================================================
1034*/
1035
1036/*
1037** some macros for common tasks in 'luaV_execute'
1038*/
1039
1040
1041#define RA(i) (base+GETARG_A(i))
1042#define RB(i) (base+GETARG_B(i))
1043#define vRB(i) s2v(RB(i))
1044#define KB(i) (k+GETARG_B(i))
1045#define RC(i) (base+GETARG_C(i))
1046#define vRC(i) s2v(RC(i))
1047#define KC(i) (k+GETARG_C(i))
1048#define RKC(i) ((TESTARG_k(i)) ? k + GETARG_C(i) : s2v(base + GETARG_C(i)))
1049
1050
1051
1052#define updatetrap(ci) (trap = ci->u.l.trap)
1053
1054#define updatebase(ci) (base = ci->func + 1)
1055
1056
1057#define updatestack(ci) \
1058 { if (l_unlikely(trap)) { updatebase(ci); ra = RA(i); } }
1059
1060
1061/*
1062** Execute a jump instruction. The 'updatetrap' allows signals to stop
1063** tight loops. (Without it, the local copy of 'trap' could never change.)
1064*/
1065#define dojump(ci,i,e) { pc += GETARG_sJ(i) + e; updatetrap(ci); }
1066
1067
1068/* for test instructions, execute the jump instruction that follows it */
1069#define donextjump(ci) { Instruction ni = *pc; dojump(ci, ni, 1); }
1070
1071/*
1072** do a conditional jump: skip next instruction if 'cond' is not what
1073** was expected (parameter 'k'), else do next instruction, which must
1074** be a jump.
1075*/
1076#define docondjump() if (cond != GETARG_k(i)) pc++; else donextjump(ci);
1077
1078
1079/*
1080** Correct global 'pc'.
1081*/
1082#define savepc(L) (ci->u.l.savedpc = pc)
1083
1084
1085/*
1086** Whenever code can raise errors, the global 'pc' and the global
1087** 'top' must be correct to report occasional errors.
1088*/
1089#define savestate(L,ci) (savepc(L), L->top = ci->top)
1090
1091
1092/*
1093** Protect code that, in general, can raise errors, reallocate the
1094** stack, and change the hooks.
1095*/
1096#define Protect(exp) (savestate(L,ci), (exp), updatetrap(ci))
1097
1098/* special version that does not change the top */
1099#define ProtectNT(exp) (savepc(L), (exp), updatetrap(ci))
1100
1101/*
1102** Protect code that can only raise errors. (That is, it cannnot change
1103** the stack or hooks.)
1104*/
1105#define halfProtect(exp) (savestate(L,ci), (exp))
1106
1107/* 'c' is the limit of live values in the stack */
1108#define checkGC(L,c) \
1109 { luaC_condGC(L, (savepc(L), L->top = (c)), \
1110 updatetrap(ci)); \
1111 luai_threadyield(L); }
1112
1113
1114/* fetch an instruction and prepare its execution */
1115#define vmfetch() { \
1116 if (l_unlikely(trap)) { /* stack reallocation or hooks? */ \
1117 trap = luaG_traceexec(L, pc); /* handle hooks */ \
1118 updatebase(ci); /* correct stack */ \
1119 } \
1120 i = *(pc++); \
1121 ra = RA(i); /* WARNING: any stack reallocation invalidates 'ra' */ \
1122}
1123
1124#define vmdispatch(o) switch(o)
1125#define vmcase(l) case l:
1126#define vmbreak break
1127
1128
1129void luaV_execute (lua_State *L, CallInfo *ci) {
1130 LClosure *cl;
1131 TValue *k;
1132 StkId base;
1133 const Instruction *pc;
1134 int trap;
1135#if LUA_USE_JUMPTABLE
1136#include "ljumptab.h"
1137#endif
1138 startfunc:
1139 trap = L->hookmask;
1140 returning: /* trap already set */
1141 cl = clLvalue(s2v(ci->func));
1142 k = cl->p->k;
1143 pc = ci->u.l.savedpc;
1144 if (l_unlikely(trap)) {
1145 if (pc == cl->p->code) { /* first instruction (not resuming)? */
1146 if (cl->p->is_vararg)
1147 trap = 0; /* hooks will start after VARARGPREP instruction */
1148 else /* check 'call' hook */
1149 luaD_hookcall(L, ci);
1150 }
1151 ci->u.l.trap = 1; /* assume trap is on, for now */
1152 }
1153 base = ci->func + 1;
1154 /* main loop of interpreter */
1155 for (;;) {
1156 Instruction i; /* instruction being executed */
1157 StkId ra; /* instruction's A register */
1158 vmfetch();
1159// low-level line tracing for debugging Lua
1160// printf("line: %d\n", luaG_getfuncline(cl->p, pcRel(pc, cl->p)));
1161 lua_assert(base == ci->func + 1);
1162 lua_assert(base <= L->top && L->top < L->stack_last);
1163 /* invalidate top for instructions not expecting it */
1164 lua_assert(isIT(i) || (cast_void(L->top = base), 1));
1165 vmdispatch (GET_OPCODE(i)) {
1166 vmcase(OP_MOVE) {
1167 setobjs2s(L, ra, RB(i));
1168 vmbreak;
1169 }
1170 vmcase(OP_LOADI) {
1171 lua_Integer b = GETARG_sBx(i);
1172 setivalue(s2v(ra), b);
1173 vmbreak;
1174 }
1175 vmcase(OP_LOADF) {
1176 int b = GETARG_sBx(i);
1177 setfltvalue(s2v(ra), cast_num(b));
1178 vmbreak;
1179 }
1180 vmcase(OP_LOADK) {
1181 TValue *rb = k + GETARG_Bx(i);
1182 setobj2s(L, ra, rb);
1183 vmbreak;
1184 }
1185 vmcase(OP_LOADKX) {
1186 TValue *rb;
1187 rb = k + GETARG_Ax(*pc); pc++;
1188 setobj2s(L, ra, rb);
1189 vmbreak;
1190 }
1191 vmcase(OP_LOADFALSE) {
1192 setbfvalue(s2v(ra));
1193 vmbreak;
1194 }
1195 vmcase(OP_LFALSESKIP) {
1196 setbfvalue(s2v(ra));
1197 pc++; /* skip next instruction */
1198 vmbreak;
1199 }
1200 vmcase(OP_LOADTRUE) {
1201 setbtvalue(s2v(ra));
1202 vmbreak;
1203 }
1204 vmcase(OP_LOADNIL) {
1205 int b = GETARG_B(i);
1206 do {
1207 setnilvalue(s2v(ra++));
1208 } while (b--);
1209 vmbreak;
1210 }
1211 vmcase(OP_GETUPVAL) {
1212 int b = GETARG_B(i);
1213 setobj2s(L, ra, cl->upvals[b]->v);
1214 vmbreak;
1215 }
1216 vmcase(OP_SETUPVAL) {
1217 UpVal *uv = cl->upvals[GETARG_B(i)];
1218 setobj(L, uv->v, s2v(ra));
1219 luaC_barrier(L, uv, s2v(ra));
1220 vmbreak;
1221 }
1222 vmcase(OP_GETTABUP) {
1223 const TValue *slot;
1224 TValue *upval = cl->upvals[GETARG_B(i)]->v;
1225 TValue *rc = KC(i);
1226 TString *key = tsvalue(rc); /* key must be a string */
1227 if (luaV_fastget(L, upval, key, slot, luaH_getshortstr)) {
1228 setobj2s(L, ra, slot);
1229 }
1230 else
1231 Protect(luaV_finishget(L, upval, rc, ra, slot));
1232 vmbreak;
1233 }
1234 vmcase(OP_GETTABLE) {
1235 const TValue *slot;
1236 TValue *rb = vRB(i);
1237 TValue *rc = vRC(i);
1238 lua_Unsigned n;
1239 if (ttisinteger(rc) /* fast track for integers? */
1240 ? (cast_void(n = ivalue(rc)), luaV_fastgeti(L, rb, n, slot))
1241 : luaV_fastget(L, rb, rc, slot, luaH_get)) {
1242 setobj2s(L, ra, slot);
1243 }
1244 else
1245 Protect(luaV_finishget(L, rb, rc, ra, slot));
1246 vmbreak;
1247 }
1248 vmcase(OP_GETI) {
1249 const TValue *slot;
1250 TValue *rb = vRB(i);
1251 int c = GETARG_C(i);
1252 if (luaV_fastgeti(L, rb, c, slot)) {
1253 setobj2s(L, ra, slot);
1254 }
1255 else {
1256 TValue key;
1257 setivalue(&key, c);
1258 Protect(luaV_finishget(L, rb, &key, ra, slot));
1259 }
1260 vmbreak;
1261 }
1262 vmcase(OP_GETFIELD) {
1263 const TValue *slot;
1264 TValue *rb = vRB(i);
1265 TValue *rc = KC(i);
1266 TString *key = tsvalue(rc); /* key must be a string */
1267 if (luaV_fastget(L, rb, key, slot, luaH_getshortstr)) {
1268 setobj2s(L, ra, slot);
1269 }
1270 else
1271 Protect(luaV_finishget(L, rb, rc, ra, slot));
1272 vmbreak;
1273 }
1274 vmcase(OP_SETTABUP) {
1275 const TValue *slot;
1276 TValue *upval = cl->upvals[GETARG_A(i)]->v;
1277 TValue *rb = KB(i);
1278 TValue *rc = RKC(i);
1279 TString *key = tsvalue(rb); /* key must be a string */
1280 if (luaV_fastget(L, upval, key, slot, luaH_getshortstr)) {
1281 luaV_finishfastset(L, upval, slot, rc);
1282 }
1283 else
1284 Protect(luaV_finishset(L, upval, rb, rc, slot));
1285 vmbreak;
1286 }
1287 vmcase(OP_SETTABLE) {
1288 const TValue *slot;
1289 TValue *rb = vRB(i); /* key (table is in 'ra') */
1290 TValue *rc = RKC(i); /* value */
1291 lua_Unsigned n;
1292 if (ttisinteger(rb) /* fast track for integers? */
1293 ? (cast_void(n = ivalue(rb)), luaV_fastgeti(L, s2v(ra), n, slot))
1294 : luaV_fastget(L, s2v(ra), rb, slot, luaH_get)) {
1295 luaV_finishfastset(L, s2v(ra), slot, rc);
1296 }
1297 else
1298 Protect(luaV_finishset(L, s2v(ra), rb, rc, slot));
1299 vmbreak;
1300 }
1301 vmcase(OP_SETI) {
1302 const TValue *slot;
1303 int c = GETARG_B(i);
1304 TValue *rc = RKC(i);
1305 if (luaV_fastgeti(L, s2v(ra), c, slot)) {
1306 luaV_finishfastset(L, s2v(ra), slot, rc);
1307 }
1308 else {
1309 TValue key;
1310 setivalue(&key, c);
1311 Protect(luaV_finishset(L, s2v(ra), &key, rc, slot));
1312 }
1313 vmbreak;
1314 }
1315 vmcase(OP_SETFIELD) {
1316 const TValue *slot;
1317 TValue *rb = KB(i);
1318 TValue *rc = RKC(i);
1319 TString *key = tsvalue(rb); /* key must be a string */
1320 if (luaV_fastget(L, s2v(ra), key, slot, luaH_getshortstr)) {
1321 luaV_finishfastset(L, s2v(ra), slot, rc);
1322 }
1323 else
1324 Protect(luaV_finishset(L, s2v(ra), rb, rc, slot));
1325 vmbreak;
1326 }
1327 vmcase(OP_NEWTABLE) {
1328 int b = GETARG_B(i); /* log2(hash size) + 1 */
1329 int c = GETARG_C(i); /* array size */
1330 Table *t;
1331 if (b > 0)
1332 b = 1 << (b - 1); /* size is 2^(b - 1) */
1333 lua_assert((!TESTARG_k(i)) == (GETARG_Ax(*pc) == 0));
1334 if (TESTARG_k(i)) /* non-zero extra argument? */
1335 c += GETARG_Ax(*pc) * (MAXARG_C + 1); /* add it to size */
1336 pc++; /* skip extra argument */
1337 L->top = ra + 1; /* correct top in case of emergency GC */
1338 t = luaH_new(L); /* memory allocation */
1339 sethvalue2s(L, ra, t);
1340 if (b != 0 || c != 0)
1341 luaH_resize(L, t, c, b); /* idem */
1342 checkGC(L, ra + 1);
1343 vmbreak;
1344 }
1345 vmcase(OP_SELF) {
1346 const TValue *slot;
1347 TValue *rb = vRB(i);
1348 TValue *rc = RKC(i);
1349 TString *key = tsvalue(rc); /* key must be a string */
1350 setobj2s(L, ra + 1, rb);
1351 if (luaV_fastget(L, rb, key, slot, luaH_getstr)) {
1352 setobj2s(L, ra, slot);
1353 }
1354 else
1355 Protect(luaV_finishget(L, rb, rc, ra, slot));
1356 vmbreak;
1357 }
1358 vmcase(OP_ADDI) {
1359 op_arithI(L, l_addi, luai_numadd);
1360 vmbreak;
1361 }
1362 vmcase(OP_ADDK) {
1363 op_arithK(L, l_addi, luai_numadd);
1364 vmbreak;
1365 }
1366 vmcase(OP_SUBK) {
1367 op_arithK(L, l_subi, luai_numsub);
1368 vmbreak;
1369 }
1370 vmcase(OP_MULK) {
1371 op_arithK(L, l_muli, luai_nummul);
1372 vmbreak;
1373 }
1374 vmcase(OP_MODK) {
1375 op_arithK(L, luaV_mod, luaV_modf);
1376 vmbreak;
1377 }
1378 vmcase(OP_POWK) {
1379 op_arithfK(L, luai_numpow);
1380 vmbreak;
1381 }
1382 vmcase(OP_DIVK) {
1383 op_arithfK(L, luai_numdiv);
1384 vmbreak;
1385 }
1386 vmcase(OP_IDIVK) {
1387 op_arithK(L, luaV_idiv, luai_numidiv);
1388 vmbreak;
1389 }
1390 vmcase(OP_BANDK) {
1391 op_bitwiseK(L, l_band);
1392 vmbreak;
1393 }
1394 vmcase(OP_BORK) {
1395 op_bitwiseK(L, l_bor);
1396 vmbreak;
1397 }
1398 vmcase(OP_BXORK) {
1399 op_bitwiseK(L, l_bxor);
1400 vmbreak;
1401 }
1402 vmcase(OP_SHRI) {
1403 TValue *rb = vRB(i);
1404 int ic = GETARG_sC(i);
1405 lua_Integer ib;
1406 if (tointegerns(rb, &ib)) {
1407 pc++; setivalue(s2v(ra), luaV_shiftl(ib, -ic));
1408 }
1409 vmbreak;
1410 }
1411 vmcase(OP_SHLI) {
1412 TValue *rb = vRB(i);
1413 int ic = GETARG_sC(i);
1414 lua_Integer ib;
1415 if (tointegerns(rb, &ib)) {
1416 pc++; setivalue(s2v(ra), luaV_shiftl(ic, ib));
1417 }
1418 vmbreak;
1419 }
1420 vmcase(OP_ADD) {
1421 op_arith(L, l_addi, luai_numadd);
1422 vmbreak;
1423 }
1424 vmcase(OP_SUB) {
1425 op_arith(L, l_subi, luai_numsub);
1426 vmbreak;
1427 }
1428 vmcase(OP_MUL) {
1429 op_arith(L, l_muli, luai_nummul);
1430 vmbreak;
1431 }
1432 vmcase(OP_MOD) {
1433 op_arith(L, luaV_mod, luaV_modf);
1434 vmbreak;
1435 }
1436 vmcase(OP_POW) {
1437 op_arithf(L, luai_numpow);
1438 vmbreak;
1439 }
1440 vmcase(OP_DIV) { /* float division (always with floats) */
1441 op_arithf(L, luai_numdiv);
1442 vmbreak;
1443 }
1444 vmcase(OP_IDIV) { /* floor division */
1445 op_arith(L, luaV_idiv, luai_numidiv);
1446 vmbreak;
1447 }
1448 vmcase(OP_BAND) {
1449 op_bitwise(L, l_band);
1450 vmbreak;
1451 }
1452 vmcase(OP_BOR) {
1453 op_bitwise(L, l_bor);
1454 vmbreak;
1455 }
1456 vmcase(OP_BXOR) {
1457 op_bitwise(L, l_bxor);
1458 vmbreak;
1459 }
1460 vmcase(OP_SHR) {
1461 op_bitwise(L, luaV_shiftr);
1462 vmbreak;
1463 }
1464 vmcase(OP_SHL) {
1465 op_bitwise(L, luaV_shiftl);
1466 vmbreak;
1467 }
1468 vmcase(OP_MMBIN) {
1469 Instruction pi = *(pc - 2); /* original arith. expression */
1470 TValue *rb = vRB(i);
1471 TMS tm = (TMS)GETARG_C(i);
1472 StkId result = RA(pi);
1473 lua_assert(OP_ADD <= GET_OPCODE(pi) && GET_OPCODE(pi) <= OP_SHR);
1474 Protect(luaT_trybinTM(L, s2v(ra), rb, result, tm));
1475 vmbreak;
1476 }
1477 vmcase(OP_MMBINI) {
1478 Instruction pi = *(pc - 2); /* original arith. expression */
1479 int imm = GETARG_sB(i);
1480 TMS tm = (TMS)GETARG_C(i);
1481 int flip = GETARG_k(i);
1482 StkId result = RA(pi);
1483 Protect(luaT_trybiniTM(L, s2v(ra), imm, flip, result, tm));
1484 vmbreak;
1485 }
1486 vmcase(OP_MMBINK) {
1487 Instruction pi = *(pc - 2); /* original arith. expression */
1488 TValue *imm = KB(i);
1489 TMS tm = (TMS)GETARG_C(i);
1490 int flip = GETARG_k(i);
1491 StkId result = RA(pi);
1492 Protect(luaT_trybinassocTM(L, s2v(ra), imm, flip, result, tm));
1493 vmbreak;
1494 }
1495 vmcase(OP_UNM) {
1496 TValue *rb = vRB(i);
1497 lua_Number nb;
1498 if (ttisinteger(rb)) {
1499 lua_Integer ib = ivalue(rb);
1500 setivalue(s2v(ra), intop(-, 0, ib));
1501 }
1502 else if (tonumberns(rb, nb)) {
1503 setfltvalue(s2v(ra), luai_numunm(L, nb));
1504 }
1505 else
1506 Protect(luaT_trybinTM(L, rb, rb, ra, TM_UNM));
1507 vmbreak;
1508 }
1509 vmcase(OP_BNOT) {
1510 TValue *rb = vRB(i);
1511 lua_Integer ib;
1512 if (tointegerns(rb, &ib)) {
1513 setivalue(s2v(ra), intop(^, ~l_castS2U(0), ib));
1514 }
1515 else
1516 Protect(luaT_trybinTM(L, rb, rb, ra, TM_BNOT));
1517 vmbreak;
1518 }
1519 vmcase(OP_NOT) {
1520 TValue *rb = vRB(i);
1521 if (l_isfalse(rb))
1522 setbtvalue(s2v(ra));
1523 else
1524 setbfvalue(s2v(ra));
1525 vmbreak;
1526 }
1527 vmcase(OP_LEN) {
1528 Protect(luaV_objlen(L, ra, vRB(i)));
1529 vmbreak;
1530 }
1531 vmcase(OP_CONCAT) {
1532 int n = GETARG_B(i); /* number of elements to concatenate */
1533 L->top = ra + n; /* mark the end of concat operands */
1534 ProtectNT(luaV_concat(L, n));
1535 checkGC(L, L->top); /* 'luaV_concat' ensures correct top */
1536 vmbreak;
1537 }
1538 vmcase(OP_CLOSE) {
1539 Protect(luaF_close(L, ra, LUA_OK, 1));
1540 vmbreak;
1541 }
1542 vmcase(OP_TBC) {
1543 /* create new to-be-closed upvalue */
1544 halfProtect(luaF_newtbcupval(L, ra));
1545 vmbreak;
1546 }
1547 vmcase(OP_JMP) {
1548 dojump(ci, i, 0);
1549 vmbreak;
1550 }
1551 vmcase(OP_EQ) {
1552 int cond;
1553 TValue *rb = vRB(i);
1554 Protect(cond = luaV_equalobj(L, s2v(ra), rb));
1555 docondjump();
1556 vmbreak;
1557 }
1558 vmcase(OP_LT) {
1559 op_order(L, l_lti, LTnum, lessthanothers);
1560 vmbreak;
1561 }
1562 vmcase(OP_LE) {
1563 op_order(L, l_lei, LEnum, lessequalothers);
1564 vmbreak;
1565 }
1566 vmcase(OP_EQK) {
1567 TValue *rb = KB(i);
1568 /* basic types do not use '__eq'; we can use raw equality */
1569 int cond = luaV_rawequalobj(s2v(ra), rb);
1570 docondjump();
1571 vmbreak;
1572 }
1573 vmcase(OP_EQI) {
1574 int cond;
1575 int im = GETARG_sB(i);
1576 if (ttisinteger(s2v(ra)))
1577 cond = (ivalue(s2v(ra)) == im);
1578 else if (ttisfloat(s2v(ra)))
1579 cond = luai_numeq(fltvalue(s2v(ra)), cast_num(im));
1580 else
1581 cond = 0; /* other types cannot be equal to a number */
1582 docondjump();
1583 vmbreak;
1584 }
1585 vmcase(OP_LTI) {
1586 op_orderI(L, l_lti, luai_numlt, 0, TM_LT);
1587 vmbreak;
1588 }
1589 vmcase(OP_LEI) {
1590 op_orderI(L, l_lei, luai_numle, 0, TM_LE);
1591 vmbreak;
1592 }
1593 vmcase(OP_GTI) {
1594 op_orderI(L, l_gti, luai_numgt, 1, TM_LT);
1595 vmbreak;
1596 }
1597 vmcase(OP_GEI) {
1598 op_orderI(L, l_gei, luai_numge, 1, TM_LE);
1599 vmbreak;
1600 }
1601 vmcase(OP_TEST) {
1602 int cond = !l_isfalse(s2v(ra));
1603 docondjump();
1604 vmbreak;
1605 }
1606 vmcase(OP_TESTSET) {
1607 TValue *rb = vRB(i);
1608 if (l_isfalse(rb) == GETARG_k(i))
1609 pc++;
1610 else {
1611 setobj2s(L, ra, rb);
1612 donextjump(ci);
1613 }
1614 vmbreak;
1615 }
1616 vmcase(OP_CALL) {
1617 CallInfo *newci;
1618 int b = GETARG_B(i);
1619 int nresults = GETARG_C(i) - 1;
1620 if (b != 0) /* fixed number of arguments? */
1621 L->top = ra + b; /* top signals number of arguments */
1622 /* else previous instruction set top */
1623 savepc(L); /* in case of errors */
1624 if ((newci = luaD_precall(L, ra, nresults)) == NULL)
1625 updatetrap(ci); /* C call; nothing else to be done */
1626 else { /* Lua call: run function in this same C frame */
1627 ci = newci;
1628 ci->callstatus = 0; /* call re-uses 'luaV_execute' */
1629 goto startfunc;
1630 }
1631 vmbreak;
1632 }
1633 vmcase(OP_TAILCALL) {
1634 int b = GETARG_B(i); /* number of arguments + 1 (function) */
1635 int nparams1 = GETARG_C(i);
1636 /* delta is virtual 'func' - real 'func' (vararg functions) */
1637 int delta = (nparams1) ? ci->u.l.nextraargs + nparams1 : 0;
1638 if (b != 0)
1639 L->top = ra + b;
1640 else /* previous instruction set top */
1641 b = cast_int(L->top - ra);
1642 savepc(ci); /* several calls here can raise errors */
1643 if (TESTARG_k(i)) {
1644 luaF_closeupval(L, base); /* close upvalues from current call */
1645 lua_assert(L->tbclist < base); /* no pending tbc variables */
1646 lua_assert(base == ci->func + 1);
1647 }
1648 while (!ttisfunction(s2v(ra))) { /* not a function? */
1649 luaD_tryfuncTM(L, ra); /* try '__call' metamethod */
1650 b++; /* there is now one extra argument */
1651 checkstackGCp(L, 1, ra);
1652 }
1653 if (!ttisLclosure(s2v(ra))) { /* C function? */
1654 luaD_precall(L, ra, LUA_MULTRET); /* call it */
1655 updatetrap(ci);
1656 updatestack(ci); /* stack may have been relocated */
1657 ci->func -= delta; /* restore 'func' (if vararg) */
1658 luaD_poscall(L, ci, cast_int(L->top - ra)); /* finish caller */
1659 updatetrap(ci); /* 'luaD_poscall' can change hooks */
1660 goto ret; /* caller returns after the tail call */
1661 }
1662 ci->func -= delta; /* restore 'func' (if vararg) */
1663 luaD_pretailcall(L, ci, ra, b); /* prepare call frame */
1664 goto startfunc; /* execute the callee */
1665 }
1666 vmcase(OP_RETURN) {
1667 int n = GETARG_B(i) - 1; /* number of results */
1668 int nparams1 = GETARG_C(i);
1669 if (n < 0) /* not fixed? */
1670 n = cast_int(L->top - ra); /* get what is available */
1671 savepc(ci);
1672 if (TESTARG_k(i)) { /* may there be open upvalues? */
1673 if (L->top < ci->top)
1674 L->top = ci->top;
1675 luaF_close(L, base, CLOSEKTOP, 1);
1676 updatetrap(ci);
1677 updatestack(ci);
1678 }
1679 if (nparams1) /* vararg function? */
1680 ci->func -= ci->u.l.nextraargs + nparams1;
1681 L->top = ra + n; /* set call for 'luaD_poscall' */
1682 luaD_poscall(L, ci, n);
1683 updatetrap(ci); /* 'luaD_poscall' can change hooks */
1684 goto ret;
1685 }
1686 vmcase(OP_RETURN0) {
1687 if (l_unlikely(L->hookmask)) {
1688 L->top = ra;
1689 savepc(ci);
1690 luaD_poscall(L, ci, 0); /* no hurry... */
1691 trap = 1;
1692 }
1693 else { /* do the 'poscall' here */
1694 int nres;
1695 L->ci = ci->previous; /* back to caller */
1696 L->top = base - 1;
1697 for (nres = ci->nresults; l_unlikely(nres > 0); nres--)
1698 setnilvalue(s2v(L->top++)); /* all results are nil */
1699 }
1700 goto ret;
1701 }
1702 vmcase(OP_RETURN1) {
1703 if (l_unlikely(L->hookmask)) {
1704 L->top = ra + 1;
1705 savepc(ci);
1706 luaD_poscall(L, ci, 1); /* no hurry... */
1707 trap = 1;
1708 }
1709 else { /* do the 'poscall' here */
1710 int nres = ci->nresults;
1711 L->ci = ci->previous; /* back to caller */
1712 if (nres == 0)
1713 L->top = base - 1; /* asked for no results */
1714 else {
1715 setobjs2s(L, base - 1, ra); /* at least this result */
1716 L->top = base;
1717 for (; l_unlikely(nres > 1); nres--)
1718 setnilvalue(s2v(L->top++)); /* complete missing results */
1719 }
1720 }
1721 ret: /* return from a Lua function */
1722 if (ci->callstatus & CIST_FRESH)
1723 return; /* end this frame */
1724 else {
1725 ci = ci->previous;
1726 goto returning; /* continue running caller in this frame */
1727 }
1728 }
1729 vmcase(OP_FORLOOP) {
1730 if (ttisinteger(s2v(ra + 2))) { /* integer loop? */
1731 lua_Unsigned count = l_castS2U(ivalue(s2v(ra + 1)));
1732 if (count > 0) { /* still more iterations? */
1733 lua_Integer step = ivalue(s2v(ra + 2));
1734 lua_Integer idx = ivalue(s2v(ra)); /* internal index */
1735 chgivalue(s2v(ra + 1), count - 1); /* update counter */
1736 idx = intop(+, idx, step); /* add step to index */
1737 chgivalue(s2v(ra), idx); /* update internal index */
1738 setivalue(s2v(ra + 3), idx); /* and control variable */
1739 pc -= GETARG_Bx(i); /* jump back */
1740 }
1741 }
1742 else if (floatforloop(ra)) /* float loop */
1743 pc -= GETARG_Bx(i); /* jump back */
1744 updatetrap(ci); /* allows a signal to break the loop */
1745 vmbreak;
1746 }
1747 vmcase(OP_FORPREP) {
1748 savestate(L, ci); /* in case of errors */
1749 if (forprep(L, ra))
1750 pc += GETARG_Bx(i) + 1; /* skip the loop */
1751 vmbreak;
1752 }
1753 vmcase(OP_TFORPREP) {
1754 /* create to-be-closed upvalue (if needed) */
1755 halfProtect(luaF_newtbcupval(L, ra + 3));
1756 pc += GETARG_Bx(i);
1757 i = *(pc++); /* go to next instruction */
1758 lua_assert(GET_OPCODE(i) == OP_TFORCALL && ra == RA(i));
1759 goto l_tforcall;
1760 }
1761 vmcase(OP_TFORCALL) {
1762 l_tforcall:
1763 /* 'ra' has the iterator function, 'ra + 1' has the state,
1764 'ra + 2' has the control variable, and 'ra + 3' has the
1765 to-be-closed variable. The call will use the stack after
1766 these values (starting at 'ra + 4')
1767 */
1768 /* push function, state, and control variable */
1769 memcpy(ra + 4, ra, 3 * sizeof(*ra));
1770 L->top = ra + 4 + 3;
1771 ProtectNT(luaD_call(L, ra + 4, GETARG_C(i))); /* do the call */
1772 updatestack(ci); /* stack may have changed */
1773 i = *(pc++); /* go to next instruction */
1774 lua_assert(GET_OPCODE(i) == OP_TFORLOOP && ra == RA(i));
1775 goto l_tforloop;
1776 }
1777 vmcase(OP_TFORLOOP) {
1778 l_tforloop:
1779 if (!ttisnil(s2v(ra + 4))) { /* continue loop? */
1780 setobjs2s(L, ra + 2, ra + 4); /* save control variable */
1781 pc -= GETARG_Bx(i); /* jump back */
1782 }
1783 vmbreak;
1784 }
1785 vmcase(OP_SETLIST) {
1786 int n = GETARG_B(i);
1787 unsigned int last = GETARG_C(i);
1788 Table *h = hvalue(s2v(ra));
1789 if (n == 0)
1790 n = cast_int(L->top - ra) - 1; /* get up to the top */
1791 else
1792 L->top = ci->top; /* correct top in case of emergency GC */
1793 last += n;
1794 if (TESTARG_k(i)) {
1795 last += GETARG_Ax(*pc) * (MAXARG_C + 1);
1796 pc++;
1797 }
1798 if (last > luaH_realasize(h)) /* needs more space? */
1799 luaH_resizearray(L, h, last); /* preallocate it at once */
1800 for (; n > 0; n--) {
1801 TValue *val = s2v(ra + n);
1802 setobj2t(L, &h->array[last - 1], val);
1803 last--;
1804 luaC_barrierback(L, obj2gco(h), val);
1805 }
1806 vmbreak;
1807 }
1808 vmcase(OP_CLOSURE) {
1809 Proto *p = cl->p->p[GETARG_Bx(i)];
1810 halfProtect(pushclosure(L, p, cl->upvals, base, ra));
1811 checkGC(L, ra + 1);
1812 vmbreak;
1813 }
1814 vmcase(OP_VARARG) {
1815 int n = GETARG_C(i) - 1; /* required results */
1816 Protect(luaT_getvarargs(L, ci, ra, n));
1817 vmbreak;
1818 }
1819 vmcase(OP_VARARGPREP) {
1820 ProtectNT(luaT_adjustvarargs(L, GETARG_A(i), ci, cl->p));
1821 if (l_unlikely(trap)) { /* previous "Protect" updated trap */
1822 luaD_hookcall(L, ci);
1823 L->oldpc = 1; /* next opcode will be seen as a "new" line */
1824 }
1825 updatebase(ci); /* function has new base after adjustment */
1826 vmbreak;
1827 }
1828 vmcase(OP_EXTRAARG) {
1829 lua_assert(0);
1830 vmbreak;
1831 }
1832 }
1833 }
1834}
1835
1836/* }================================================================== */
diff --git a/src/lua/lvm.h b/src/lua/lvm.h
deleted file mode 100644
index 1bc16f3..0000000
--- a/src/lua/lvm.h
+++ /dev/null
@@ -1,136 +0,0 @@
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 (l_likely(ttisinteger(o)) ? (*(i) = ivalue(o), 1) \
64 : luaV_tointeger(o,i,LUA_FLOORN2I))
65
66
67/* convert an object to an integer (without string coercion) */
68#define tointegerns(o,i) \
69 (l_likely(ttisinteger(o)) ? (*(i) = ivalue(o), 1) \
70 : luaV_tointegerns(o,i,LUA_FLOORN2I))
71
72
73#define intop(op,v1,v2) l_castU2S(l_castS2U(v1) op l_castS2U(v2))
74
75#define luaV_rawequalobj(t1,t2) luaV_equalobj(NULL,t1,t2)
76
77
78/*
79** fast track for 'gettable': if 't' is a table and 't[k]' is present,
80** return 1 with 'slot' pointing to 't[k]' (position of final result).
81** Otherwise, return 0 (meaning it will have to check metamethod)
82** with 'slot' pointing to an empty 't[k]' (if 't' is a table) or NULL
83** (otherwise). 'f' is the raw get function to use.
84*/
85#define luaV_fastget(L,t,k,slot,f) \
86 (!ttistable(t) \
87 ? (slot = NULL, 0) /* not a table; 'slot' is NULL and result is 0 */ \
88 : (slot = f(hvalue(t), k), /* else, do raw access */ \
89 !isempty(slot))) /* result not empty? */
90
91
92/*
93** Special case of 'luaV_fastget' for integers, inlining the fast case
94** of 'luaH_getint'.
95*/
96#define luaV_fastgeti(L,t,k,slot) \
97 (!ttistable(t) \
98 ? (slot = NULL, 0) /* not a table; 'slot' is NULL and result is 0 */ \
99 : (slot = (l_castS2U(k) - 1u < hvalue(t)->alimit) \
100 ? &hvalue(t)->array[k - 1] : luaH_getint(hvalue(t), k), \
101 !isempty(slot))) /* result not empty? */
102
103
104/*
105** Finish a fast set operation (when fast get succeeds). In that case,
106** 'slot' points to the place to put the value.
107*/
108#define luaV_finishfastset(L,t,slot,v) \
109 { setobj2t(L, cast(TValue *,slot), v); \
110 luaC_barrierback(L, gcvalue(t), v); }
111
112
113
114
115LUAI_FUNC int luaV_equalobj (lua_State *L, const TValue *t1, const TValue *t2);
116LUAI_FUNC int luaV_lessthan (lua_State *L, const TValue *l, const TValue *r);
117LUAI_FUNC int luaV_lessequal (lua_State *L, const TValue *l, const TValue *r);
118LUAI_FUNC int luaV_tonumber_ (const TValue *obj, lua_Number *n);
119LUAI_FUNC int luaV_tointeger (const TValue *obj, lua_Integer *p, F2Imod mode);
120LUAI_FUNC int luaV_tointegerns (const TValue *obj, lua_Integer *p,
121 F2Imod mode);
122LUAI_FUNC int luaV_flttointeger (lua_Number n, lua_Integer *p, F2Imod mode);
123LUAI_FUNC void luaV_finishget (lua_State *L, const TValue *t, TValue *key,
124 StkId val, const TValue *slot);
125LUAI_FUNC void luaV_finishset (lua_State *L, const TValue *t, TValue *key,
126 TValue *val, const TValue *slot);
127LUAI_FUNC void luaV_finishOp (lua_State *L);
128LUAI_FUNC void luaV_execute (lua_State *L, CallInfo *ci);
129LUAI_FUNC void luaV_concat (lua_State *L, int total);
130LUAI_FUNC lua_Integer luaV_idiv (lua_State *L, lua_Integer x, lua_Integer y);
131LUAI_FUNC lua_Integer luaV_mod (lua_State *L, lua_Integer x, lua_Integer y);
132LUAI_FUNC lua_Number luaV_modf (lua_State *L, lua_Number x, lua_Number y);
133LUAI_FUNC lua_Integer luaV_shiftl (lua_Integer x, lua_Integer y);
134LUAI_FUNC void luaV_objlen (lua_State *L, StkId ra, const TValue *rb);
135
136#endif
diff --git a/src/lua/lzio.c b/src/lua/lzio.c
deleted file mode 100644
index cd0a02d..0000000
--- a/src/lua/lzio.c
+++ /dev/null
@@ -1,68 +0,0 @@
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
deleted file mode 100644
index 38f397f..0000000
--- a/src/lua/lzio.h
+++ /dev/null
@@ -1,66 +0,0 @@
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
deleted file mode 100644
index f78c0b8..0000000
--- a/src/lua/makefile
+++ /dev/null
@@ -1,222 +0,0 @@
1# Makefile for building Lua
2# See ../doc/readme.html for installation and customization instructions.
3
4# == CHANGE THE SETTINGS BELOW TO SUIT YOUR ENVIRONMENT =======================
5
6# Your platform. See PLATS for possible values.
7PLAT= guess
8
9CC= gcc -std=gnu99
10CFLAGS= -O2 -Wall -Wextra -DLUA_COMPAT_5_3 $(SYSCFLAGS) $(MYCFLAGS)
11LDFLAGS= $(SYSLDFLAGS) $(MYLDFLAGS)
12LIBS= -lm $(SYSLIBS) $(MYLIBS)
13
14AR= ar rcu
15RANLIB= ranlib
16RM= rm -f
17UNAME= uname
18
19SYSCFLAGS=
20SYSLDFLAGS=
21SYSLIBS=
22
23MYCFLAGS=
24MYLDFLAGS=
25MYLIBS=
26MYOBJS=
27
28# Special flags for compiler modules; -Os reduces code size.
29CMCFLAGS=
30
31# == END OF USER SETTINGS -- NO NEED TO CHANGE ANYTHING BELOW THIS LINE =======
32
33PLATS= guess aix bsd c89 freebsd generic linux linux-readline macosx mingw posix solaris
34
35LUA_A= liblua.a
36CORE_O= lapi.o lcode.o lctype.o ldebug.o ldo.o ldump.o lfunc.o lgc.o llex.o lmem.o lobject.o lopcodes.o lparser.o lstate.o lstring.o ltable.o ltm.o lundump.o lvm.o lzio.o
37LIB_O= lauxlib.o lbaselib.o lcorolib.o ldblib.o liolib.o lmathlib.o loadlib.o loslib.o lstrlib.o ltablib.o lutf8lib.o linit.o
38BASE_O= $(CORE_O) $(LIB_O) $(MYOBJS)
39
40LUA_T= lua
41LUA_O= lua.o
42
43LUAC_T= luac
44LUAC_O= luac.o
45
46ALL_O= $(BASE_O) $(LUA_O) $(LUAC_O)
47ALL_T= $(LUA_A) $(LUA_T) $(LUAC_T)
48ALL_A= $(LUA_A)
49
50# Targets start here.
51default: $(PLAT)
52
53all: $(ALL_T)
54
55o: $(ALL_O)
56
57a: $(ALL_A)
58
59$(LUA_A): $(BASE_O)
60 $(AR) $@ $(BASE_O)
61 $(RANLIB) $@
62
63$(LUA_T): $(LUA_O) $(LUA_A)
64 $(CC) -o $@ $(LDFLAGS) $(LUA_O) $(LUA_A) $(LIBS)
65
66$(LUAC_T): $(LUAC_O) $(LUA_A)
67 $(CC) -o $@ $(LDFLAGS) $(LUAC_O) $(LUA_A) $(LIBS)
68
69test:
70 ./$(LUA_T) -v
71
72clean:
73 $(RM) $(ALL_T) $(ALL_O)
74
75depend:
76 @$(CC) $(CFLAGS) -MM l*.c
77
78echo:
79 @echo "PLAT= $(PLAT)"
80 @echo "CC= $(CC)"
81 @echo "CFLAGS= $(CFLAGS)"
82 @echo "LDFLAGS= $(SYSLDFLAGS)"
83 @echo "LIBS= $(LIBS)"
84 @echo "AR= $(AR)"
85 @echo "RANLIB= $(RANLIB)"
86 @echo "RM= $(RM)"
87 @echo "UNAME= $(UNAME)"
88
89# Convenience targets for popular platforms.
90ALL= all
91
92help:
93 @echo "Do 'make PLATFORM' where PLATFORM is one of these:"
94 @echo " $(PLATS)"
95 @echo "See doc/readme.html for complete instructions."
96
97guess:
98 @echo Guessing `$(UNAME)`
99 @$(MAKE) `$(UNAME)`
100
101AIX aix:
102 $(MAKE) $(ALL) CC="xlc" CFLAGS="-O2 -DLUA_USE_POSIX -DLUA_USE_DLOPEN" SYSLIBS="-ldl" SYSLDFLAGS="-brtl -bexpall"
103
104bsd:
105 $(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_POSIX -DLUA_USE_DLOPEN" SYSLIBS="-Wl,-E"
106
107c89:
108 $(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_C89" CC="gcc -std=c89"
109 @echo ''
110 @echo '*** C89 does not guarantee 64-bit integers for Lua.'
111 @echo '*** Make sure to compile all external Lua libraries'
112 @echo '*** with LUA_USE_C89 to ensure consistency'
113 @echo ''
114
115FreeBSD NetBSD OpenBSD freebsd:
116 $(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_LINUX -DLUA_USE_READLINE -I/usr/include/edit" SYSLIBS="-Wl,-E -ledit" CC="cc"
117
118generic: $(ALL)
119
120Linux linux: linux-noreadline
121
122linux-noreadline:
123 $(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_LINUX" SYSLIBS="-Wl,-E -ldl"
124
125linux-readline:
126 $(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_LINUX -DLUA_USE_READLINE" SYSLIBS="-Wl,-E -ldl -lreadline"
127
128Darwin macos macosx:
129 $(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_MACOSX -DLUA_USE_READLINE" SYSLIBS="-lreadline"
130
131mingw:
132 $(MAKE) "LUA_A=lua54.dll" "LUA_T=lua.exe" \
133 "AR=$(CC) -shared -o" "RANLIB=strip --strip-unneeded" \
134 "SYSCFLAGS=-DLUA_BUILD_AS_DLL" "SYSLIBS=" "SYSLDFLAGS=-s" lua.exe
135 $(MAKE) "LUAC_T=luac.exe" luac.exe
136
137posix:
138 $(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_POSIX"
139
140SunOS solaris:
141 $(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_POSIX -DLUA_USE_DLOPEN -D_REENTRANT" SYSLIBS="-ldl"
142
143# Targets that do not create files (not all makes understand .PHONY).
144.PHONY: all $(PLATS) help test clean default o a depend echo
145
146# Compiler modules may use special flags.
147llex.o:
148 $(CC) $(CFLAGS) $(CMCFLAGS) -c llex.c
149
150lparser.o:
151 $(CC) $(CFLAGS) $(CMCFLAGS) -c lparser.c
152
153lcode.o:
154 $(CC) $(CFLAGS) $(CMCFLAGS) -c lcode.c
155
156# DO NOT DELETE
157
158lapi.o: lapi.c lprefix.h lua.h luaconf.h lapi.h llimits.h lstate.h \
159 lobject.h ltm.h lzio.h lmem.h ldebug.h ldo.h lfunc.h lgc.h lstring.h \
160 ltable.h lundump.h lvm.h
161lauxlib.o: lauxlib.c lprefix.h lua.h luaconf.h lauxlib.h
162lbaselib.o: lbaselib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
163lcode.o: lcode.c lprefix.h lua.h luaconf.h lcode.h llex.h lobject.h \
164 llimits.h lzio.h lmem.h lopcodes.h lparser.h ldebug.h lstate.h ltm.h \
165 ldo.h lgc.h lstring.h ltable.h lvm.h
166lcorolib.o: lcorolib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
167lctype.o: lctype.c lprefix.h lctype.h lua.h luaconf.h llimits.h
168ldblib.o: ldblib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
169ldebug.o: ldebug.c lprefix.h lua.h luaconf.h lapi.h llimits.h lstate.h \
170 lobject.h ltm.h lzio.h lmem.h lcode.h llex.h lopcodes.h lparser.h \
171 ldebug.h ldo.h lfunc.h lstring.h lgc.h ltable.h lvm.h
172ldo.o: ldo.c lprefix.h lua.h luaconf.h lapi.h llimits.h lstate.h \
173 lobject.h ltm.h lzio.h lmem.h ldebug.h ldo.h lfunc.h lgc.h lopcodes.h \
174 lparser.h lstring.h ltable.h lundump.h lvm.h
175ldump.o: ldump.c lprefix.h lua.h luaconf.h lobject.h llimits.h lstate.h \
176 ltm.h lzio.h lmem.h lundump.h
177lfunc.o: lfunc.c lprefix.h lua.h luaconf.h ldebug.h lstate.h lobject.h \
178 llimits.h ltm.h lzio.h lmem.h ldo.h lfunc.h lgc.h
179lgc.o: lgc.c lprefix.h lua.h luaconf.h ldebug.h lstate.h lobject.h \
180 llimits.h ltm.h lzio.h lmem.h ldo.h lfunc.h lgc.h lstring.h ltable.h
181linit.o: linit.c lprefix.h lua.h luaconf.h lualib.h lauxlib.h
182liolib.o: liolib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
183llex.o: llex.c lprefix.h lua.h luaconf.h lctype.h llimits.h ldebug.h \
184 lstate.h lobject.h ltm.h lzio.h lmem.h ldo.h lgc.h llex.h lparser.h \
185 lstring.h ltable.h
186lmathlib.o: lmathlib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
187lmem.o: lmem.c lprefix.h lua.h luaconf.h ldebug.h lstate.h lobject.h \
188 llimits.h ltm.h lzio.h lmem.h ldo.h lgc.h
189loadlib.o: loadlib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
190lobject.o: lobject.c lprefix.h lua.h luaconf.h lctype.h llimits.h \
191 ldebug.h lstate.h lobject.h ltm.h lzio.h lmem.h ldo.h lstring.h lgc.h \
192 lvm.h
193lopcodes.o: lopcodes.c lprefix.h lopcodes.h llimits.h lua.h luaconf.h
194loslib.o: loslib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
195lparser.o: lparser.c lprefix.h lua.h luaconf.h lcode.h llex.h lobject.h \
196 llimits.h lzio.h lmem.h lopcodes.h lparser.h ldebug.h lstate.h ltm.h \
197 ldo.h lfunc.h lstring.h lgc.h ltable.h
198lstate.o: lstate.c lprefix.h lua.h luaconf.h lapi.h llimits.h lstate.h \
199 lobject.h ltm.h lzio.h lmem.h ldebug.h ldo.h lfunc.h lgc.h llex.h \
200 lstring.h ltable.h
201lstring.o: lstring.c lprefix.h lua.h luaconf.h ldebug.h lstate.h \
202 lobject.h llimits.h ltm.h lzio.h lmem.h ldo.h lstring.h lgc.h
203lstrlib.o: lstrlib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
204ltable.o: ltable.c lprefix.h lua.h luaconf.h ldebug.h lstate.h lobject.h \
205 llimits.h ltm.h lzio.h lmem.h ldo.h lgc.h lstring.h ltable.h lvm.h
206ltablib.o: ltablib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
207ltm.o: ltm.c lprefix.h lua.h luaconf.h ldebug.h lstate.h lobject.h \
208 llimits.h ltm.h lzio.h lmem.h ldo.h lgc.h lstring.h ltable.h lvm.h
209lua.o: lua.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
210luac.o: luac.c lprefix.h lua.h luaconf.h lauxlib.h ldebug.h lstate.h \
211 lobject.h llimits.h ltm.h lzio.h lmem.h lopcodes.h lopnames.h lundump.h
212lundump.o: lundump.c lprefix.h lua.h luaconf.h ldebug.h lstate.h \
213 lobject.h llimits.h ltm.h lzio.h lmem.h ldo.h lfunc.h lstring.h lgc.h \
214 lundump.h
215lutf8lib.o: lutf8lib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h
216lvm.o: lvm.c lprefix.h lua.h luaconf.h ldebug.h lstate.h lobject.h \
217 llimits.h ltm.h lzio.h lmem.h ldo.h lfunc.h lgc.h lopcodes.h lstring.h \
218 ltable.h lvm.h ljumptab.h
219lzio.o: lzio.c lprefix.h lua.h luaconf.h llimits.h lmem.h lstate.h \
220 lobject.h ltm.h lzio.h
221
222# (end of Makefile)