lua (empty) → 1.0.0
raw patch · 77 files changed
+24963/−0 lines, 77 filesdep +basedep +bytestringdep +lua
Dependencies added: base, bytestring, lua, tasty, tasty-hunit
Files
- CHANGELOG.md +12/−0
- LICENSE +23/−0
- README.md +85/−0
- cbits/hslua/hslcall.c +102/−0
- cbits/hslua/hslcall.h +12/−0
- cbits/hslua/hslua-export.h +8/−0
- cbits/hslua/hslua.c +205/−0
- cbits/hslua/hslua.h +33/−0
- cbits/hslua/hsludata.c +41/−0
- cbits/hslua/hsludata.h +11/−0
- cbits/lua-5.3.6/lapi.c +1299/−0
- cbits/lua-5.3.6/lapi.h +24/−0
- cbits/lua-5.3.6/lauxlib.c +1048/−0
- cbits/lua-5.3.6/lauxlib.h +264/−0
- cbits/lua-5.3.6/lbaselib.c +498/−0
- cbits/lua-5.3.6/lbitlib.c +233/−0
- cbits/lua-5.3.6/lcode.c +1203/−0
- cbits/lua-5.3.6/lcode.h +88/−0
- cbits/lua-5.3.6/lcorolib.c +168/−0
- cbits/lua-5.3.6/lctype.c +55/−0
- cbits/lua-5.3.6/lctype.h +95/−0
- cbits/lua-5.3.6/ldblib.c +456/−0
- cbits/lua-5.3.6/ldebug.c +700/−0
- cbits/lua-5.3.6/ldebug.h +39/−0
- cbits/lua-5.3.6/ldo.c +802/−0
- cbits/lua-5.3.6/ldo.h +58/−0
- cbits/lua-5.3.6/ldump.c +215/−0
- cbits/lua-5.3.6/lfunc.c +151/−0
- cbits/lua-5.3.6/lfunc.h +61/−0
- cbits/lua-5.3.6/lgc.c +1179/−0
- cbits/lua-5.3.6/lgc.h +147/−0
- cbits/lua-5.3.6/linit.c +68/−0
- cbits/lua-5.3.6/liolib.c +778/−0
- cbits/lua-5.3.6/llex.c +568/−0
- cbits/lua-5.3.6/llex.h +85/−0
- cbits/lua-5.3.6/llimits.h +323/−0
- cbits/lua-5.3.6/lmathlib.c +410/−0
- cbits/lua-5.3.6/lmem.c +100/−0
- cbits/lua-5.3.6/lmem.h +69/−0
- cbits/lua-5.3.6/loadlib.c +790/−0
- cbits/lua-5.3.6/lobject.c +522/−0
- cbits/lua-5.3.6/lobject.h +549/−0
- cbits/lua-5.3.6/lopcodes.c +124/−0
- cbits/lua-5.3.6/lopcodes.h +297/−0
- cbits/lua-5.3.6/loslib.c +409/−0
- cbits/lua-5.3.6/lparser.c +1653/−0
- cbits/lua-5.3.6/lparser.h +133/−0
- cbits/lua-5.3.6/lprefix.h +45/−0
- cbits/lua-5.3.6/lstate.c +347/−0
- cbits/lua-5.3.6/lstate.h +253/−0
- cbits/lua-5.3.6/lstring.c +248/−0
- cbits/lua-5.3.6/lstring.h +49/−0
- cbits/lua-5.3.6/lstrlib.c +1584/−0
- cbits/lua-5.3.6/ltable.c +688/−0
- cbits/lua-5.3.6/ltable.h +66/−0
- cbits/lua-5.3.6/ltablib.c +450/−0
- cbits/lua-5.3.6/ltm.c +165/−0
- cbits/lua-5.3.6/ltm.h +76/−0
- cbits/lua-5.3.6/lua.h +485/−0
- cbits/lua-5.3.6/luaconf.h +790/−0
- cbits/lua-5.3.6/lualib.h +61/−0
- cbits/lua-5.3.6/lundump.c +287/−0
- cbits/lua-5.3.6/lundump.h +32/−0
- cbits/lua-5.3.6/lutf8lib.c +256/−0
- cbits/lua-5.3.6/lvm.c +1322/−0
- cbits/lua-5.3.6/lvm.h +113/−0
- cbits/lua-5.3.6/lzio.c +68/−0
- cbits/lua-5.3.6/lzio.h +66/−0
- lua.cabal +200/−0
- src/Foreign/Lua/Raw/Auxiliary.hs +133/−0
- src/Foreign/Lua/Raw/Call.hs +65/−0
- src/Foreign/Lua/Raw/Constants.hs +39/−0
- src/Foreign/Lua/Raw/Error.hs +40/−0
- src/Foreign/Lua/Raw/Functions.hs +403/−0
- src/Foreign/Lua/Raw/Types.hsc +281/−0
- src/Foreign/Lua/Raw/Userdata.hs +65/−0
- test/test-lua.hs +93/−0
+ CHANGELOG.md view
@@ -0,0 +1,12 @@+# Changelog++`lua` uses [PVP Versioning][1].++## lua 1.0++Release pending++- Initially created. Contains all modules in the `Foreign.Lua.Raw`+ hierarchy from `hslua-1.3`. Documentation has been improved.++[1]: https://pvp.haskell.org
+ LICENSE view
@@ -0,0 +1,23 @@+Copyright © 1994-2020 Lua.org, PUC-Rio.+Copyright © 2007-2012 Gracjan Polak+Copyright © 2012-2015 Ömer Sinan Ağacan+Copyright © 2016-2021 Albert Krewinkel++Permission is hereby granted, free of charge, to any person obtaining a+copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,85 @@+# lua++[![Build status][GitHub Actions badge]][GitHub Actions]+[![AppVeyor Status]](https://ci.appveyor.com/project/tarleb/hslua-r2y18)+[![Hackage]](https://hackage.haskell.org/package/lua)++The *lua* package provides a Lua interpreter as well as bindings,+wrappers and types to combine Haskell and Lua.++[GitHub Actions badge]: https://img.shields.io/github/workflow/status/hslua/hslua/CI.svg?logo=github+[GitHub Actions]: https://github.com/hslua/hslua/actions+[AppVeyor Status]: https://ci.appveyor.com/api/projects/status/ldutrilgxhpcau94/branch/main?svg=true+[Hackage]: https://img.shields.io/hackage/v/lua.svg+++Overview+--------++[Lua](https://lua.org) is a small, well-designed, embeddable+scripting language. It has become the de-facto default to make+programs extensible and is widely used everywhere from servers+over games and desktop applications up to security software and+embedded devices. This package provides Haskell bindings to Lua,+enable coders to embed the language into their programs, making+them scriptable.++*Lua* ships with the official Lua interpreter, version 5.3.6.+Cabal flags allow to compile against a system-wide Lua+installation instead, if desired.++Build flags+-----------++The following cabal build flags are supported:++- `system-lua`: Use the locally installed Lua version instead of+ the version shipped as part of this package.++- `pkg-config`: Use *pkg-config* to discover library and include+ paths. Setting this flag implies `system-lua`.++- `allow-unsafe-gc`: Allow optimizations which make Lua's garbage+ collection potentially unsafe; enabling this should be safe if+ there are no callbacks into Haskell during Lua garbage+ collection cycles. The flag should be *disabled* if Lua objects+ can have Haskell finalizers, i.e., `__gc` metamethods that call+ Haskell function.++ The flag is *enabled* per default, as Haskell functions are+ rarely used in finalizers. It can help to disable the flag if+ there are issues related to Lua's garbage collection.++- `apicheck`: Compile Lua with its API checks enabled.++- `lua_32bits`: Compile Lua for a 32-bits system (e.g., i386,+ PowerPC G4).++- `export-dynamic`: Add all symbols to dynamic symbol table;+ disabling this will make it possible to create fully static+ binaries, but renders loading of dynamic C libraries impossible.++- `hardcode-reg-keys`: Don't use CAPI to determine the names of+ certain registry key names but use hard coded values instead.+ This flag is required when compiling against Lua 5.3.3 or+ earlier, as those versions do not expose the necessary+ information in the @lauxlib.h@ header file. Setting this flag+ should usually be unproblematic, except if the used Lua version+ has been patched heavily.++### Example: using a different Lua version++To use a system-wide installed Lua when linking *lua* as a+dependency, build/install your package using+`--constraint="lua +system-lua"`. For example, you can+install Pandoc with hslua that uses system-wide Lua like this:++``` sh+cabal install pandoc --constraint="lua +system-lua"+```++or with stack:++``` sh+stack install pandoc --flag=lua:system-lua+```
+ cbits/hslua/hslcall.c view
@@ -0,0 +1,102 @@+#include <HsFFI.h>+#include <lua.h>+#include <lauxlib.h>+#include "hslua-export.h"+#include "hslcall.h"+#include "hsludata.h"++/* ***************************************************************+ * Transforming Haskell errors to Lua errors+ * ***************************************************************/+void hslua_pushhaskellerr(lua_State *L)+{+ lua_getfield(L, LUA_REGISTRYINDEX, HSLUA_ERR);+}++/*+** Marks the occurence of an error; the returned value should be+** used as the error message.+*/+int hslua_error(lua_State *L)+{+ hslua_pushhaskellerr(L);+ lua_insert(L, -2);+ return 2;+}++/*+** Checks whether the object at the given index is a Haskell error.+*/+int hslua_is_haskell_error(lua_State *L, int idx)+{+ int erridx = lua_absindex(L, idx);+ hslua_pushhaskellerr(L);+ int is_err = lua_rawequal(L, erridx, -1);+ lua_pop(L, 1); /* pop haskellerr used for equality test */+ return is_err;+}++/*+** Converts a Haskell function into a CFunction.+**+** We signal an error on the haskell side by passing two values:+** the special HSLUA_ERR object and the error message. The+** function returned an error iff there are exactly two results+** objects where the first object is the special HSLUA_ERR+** registry entry.+*/+int hslua_call_hs(lua_State *L)+{+ int nargs = lua_gettop(L);+ /* Push HaskellFunction and call the underlying function */+ lua_pushvalue(L, lua_upvalueindex(1));+ lua_insert(L, 1);+ lua_call(L, nargs, LUA_MULTRET);++ /* Check whether an error value was returned */+ int nres = lua_gettop(L);++ /* If there are two results, the first of which is the special+ * error object, then the other object is thrown as an error.+ */+ if (nres == 2 && hslua_is_haskell_error(L, 1)) {+ return lua_error(L); /* throw 2nd return value as error */+ }++ return nres;+}++/*+** Retrieves a HsStablePtr to a Haskell function from a+** function-wrapping userdata when it's been called and removes+** the userdata from the stack.+*/+void *hslua_hs_fun_ptr(lua_State *L)+{+ void *fn = luaL_testudata(L, 1, HSLUA_HSFUN_NAME);+ lua_remove(L, 1);+ return fn;+}++/*+** Pushes a metatable for Haskell function wrapping userdata to+** the stack.+*/+void hslua_registerhsfunmetatable(lua_State *L)+{+ hslua_newudmetatable(L, HSLUA_HSFUN_NAME);+ lua_pushcfunction(L, &hslua_call_wrapped_hs_fun);+ lua_setfield(L, -2, "__call");+ lua_pop(L, 1);+}++/*+** Creates a new C function from a Haskell function.+*/+void hslua_newhsfunction(lua_State *L, HsStablePtr fn)+{+ HsStablePtr *ud = lua_newuserdata(L, sizeof fn);+ *ud = fn;+ luaL_setmetatable(L, HSLUA_HSFUN_NAME);+ lua_pushcclosure(L, &hslua_call_hs, 1);+}
+ cbits/hslua/hslcall.h view
@@ -0,0 +1,12 @@+#ifndef hslcall_h+#define hslcall_h++#define HSLUA_ERR "HSLUA_ERR"+#define HSLUA_HSFUN_NAME "HsLuaFunction"+#include <HsFFI.h>+#include <lua.h>++/* register metatable for HaskellFunction userdata wrappers */+void hslua_registerhsfunmetatable(lua_State *L);++#endif
+ cbits/hslua/hslua-export.h view
@@ -0,0 +1,8 @@+/* ***************************************************************+ * Functions exported from Haskell+ * ***************************************************************/++#include <lua.h>++/* exported from Foreign.Lua.Raw.Call */+int hslua_call_wrapped_hs_fun(lua_State *L);
+ cbits/hslua/hslua.c view
@@ -0,0 +1,205 @@+#include <HsFFI.h>+#include <stdio.h>+#include <string.h>+#include "hslua.h"+#include "hslcall.h"++/* ***************************************************************+ * Transforming Lua errors to Haskell errors+ * ***************************************************************/++/*+** compare+*/+int hslua__compare(lua_State *L)+{+ int op = lua_tointeger(L, 3);+ int res = lua_compare(L, 1, 2, op);+ lua_pushinteger(L, res);+ return 1;+}++int hslua_compare(lua_State *L, int index1, int index2, int op, int *status)+{+ index1 = lua_absindex(L, index1);+ index2 = lua_absindex(L, index2);+ lua_pushcfunction(L, hslua__compare);+ lua_pushvalue(L, index1);+ lua_pushvalue(L, index2);+ lua_pushinteger(L, op);+ *status = lua_pcall(L, 3, 1, 0);+ if (*status != LUA_OK) {+ return 0;+ }+ int result = lua_tointeger(L, -1);+ lua_pop(L, 1);+ return result;+}+++/*+** concat+*/+int hslua__concat(lua_State *L)+{+ lua_concat(L, lua_gettop(L));+ return 1;+}++void hslua_concat(lua_State *L, int n, int *status)+{+ lua_pushcfunction(L, hslua__concat);+ lua_insert(L, -n - 1);+ *status = lua_pcall(L, n, 1, 0);+}+++/*+** getglobal+*/+int hslua__getglobal(lua_State *L)+{+ lua_gettable(L, 1);+ return 1;+}++void hslua_getglobal(lua_State *L, const char *name, size_t len, int *status)+{+ lua_pushcfunction(L, hslua__getglobal);+ lua_pushglobaltable(L);+ lua_pushlstring(L, name, len);+ *status = lua_pcall(L, 2, 1, 0);+}+++/*+** gettable+*/+int hslua__gettable(lua_State *L)+{+ lua_pushvalue(L, 1);+ lua_gettable(L, 2);+ return 1;+}++void hslua_gettable(lua_State *L, int index, int *status)+{+ lua_pushvalue(L, index);+ lua_pushcfunction(L, hslua__gettable);+ lua_insert(L, -3);+ *status = lua_pcall(L, 2, 1, 0);+}+++/*+** setglobal+*/+int hslua__setglobal(lua_State *L)+{+ /* index 1: value */+ /* index 2: the global table */+ /* index 3: key */+ lua_pushvalue(L, 1);+ lua_settable(L, 2);+ return 0;+}++void hslua_setglobal(lua_State *L, const char *name, size_t len, int *status)+{+ /* we expect the new value to be at the top of the stack */+ lua_pushglobaltable(L);+ lua_pushlstring(L, name, len);+ lua_pushcfunction(L, hslua__setglobal);+ lua_insert(L, -4);+ *status = lua_pcall(L, 3, 0, 0);+}+++/*+** settable+*/+int hslua__settable(lua_State *L)+{+ lua_pushvalue(L, 1); /* key */+ lua_pushvalue(L, 2); /* value */+ lua_settable(L, 3); /* table is the third argument */+ return 0;+}++void hslua_settable(lua_State *L, int index, int *status)+{+ lua_pushvalue(L, index);+ lua_pushcfunction(L, hslua__settable);+ lua_insert(L, -4);+ *status = lua_pcall(L, 3, 0, 0);+}+++/*+** next+*/+int hslua__next(lua_State *L)+{+ lua_pushvalue(L, 1);+ return lua_next(L, 2) ? 2 : 0;+}++int hslua_next(lua_State *L, int index, int *status)+{+ int oldsize = lua_gettop(L);+ lua_pushvalue(L, index);+ lua_pushcfunction(L, hslua__next);+ lua_insert(L, -3);+ *status = lua_pcall(L, 2, LUA_MULTRET, 0);+ if (*status != 0) {+ /* error */+ return 0;+ }+ /* success */+ return (lua_gettop(L) - oldsize + 1); /* correct for popped value */+}+++/*+** Auxiliary Library+*/++/*+** newstate+*/+lua_State *hsluaL_newstate()+{+ lua_State *L = luaL_newstate();++ /* add error value */+ lua_createtable(L, 0, 0);+ lua_setfield(L, LUA_REGISTRYINDEX, HSLUA_ERR);++ /* register HaskellFunction userdata metatable */+ hslua_registerhsfunmetatable(L);++ return L;+}+++/*+** tolstring'+*/+int hsluaL__tolstring(lua_State *L)+{+ luaL_tolstring(L, 1, NULL);+ return 1;+}++const char *hsluaL_tolstring(lua_State *L, int index, size_t *len)+{+ lua_pushvalue(L, index);+ lua_pushcfunction(L, hsluaL__tolstring);+ lua_insert(L, -2);+ int res = lua_pcall(L, 1, 1, 0);+ if (res != 0) {+ /* error */+ return NULL;+ }+ return lua_tolstring(L, -1, len);+}
+ cbits/hslua/hslua.h view
@@ -0,0 +1,33 @@+#include "lua.h"+#include "lauxlib.h"++int hslua_error(lua_State *L);++int hslua_call_hs(lua_State *L);++int hslua_userdata_gc(lua_State *L);++int hslua_compare(lua_State *L, int index1, int index2, int op, int *status);++void hslua_concat(lua_State *L, int n, int *status);++void hslua_getglobal(lua_State *L, const char *name, size_t len, int *status);++void hslua_gettable(lua_State *L, int index, int *status);++void hslua_setglobal(lua_State *L, const char *k, size_t len, int *status);++void hslua_settable(lua_State *L, int index, int *status);++int hslua_next(lua_State *L, int index, int *status);+++/* auxiliary library */+const char *hsluaL_tolstring(lua_State *L, int index, size_t *len);++/*+** function calling+*/++/* Wraps a Haskell function with an userdata object. */+void hslua_newhsfunwrapper(lua_State *L, HsStablePtr fn);
+ cbits/hslua/hsludata.c view
@@ -0,0 +1,41 @@+#include <HsFFI.h>+#include "hslua.h"+#include "hsludata.h"++/* ***************************************************************+ * Userdata Creation and Garbage Collection+ * ***************************************************************/++/*+** Free stable Haskell pointer in userdata.+**+** The userdata whose contents is garbage collected must be on+** stack index 1 (i.e., the first argument).+*/+int hslua_userdata_gc(lua_State *L)+{+ HsStablePtr *userdata = lua_touserdata(L, 1);+ if (userdata) {+ hs_free_stable_ptr(*userdata);+ }+ return 0;+}++/*+** Creates a new userdata metatable for Haskell objects, or gets+** is from the registry if possible.+*/+int hslua_newudmetatable(lua_State *L, const char *tname)+{+ int created = luaL_newmetatable(L, tname);+ if (created) {+ /* Prevent accessing or changing the metatable with+ * getmetatable/setmetatable. */+ lua_pushboolean(L, 1);+ lua_setfield(L, -2, "__metatable");+ /* Mark objects for finalization when collecting garbage. */+ lua_pushcfunction(L, &hslua_userdata_gc);+ lua_setfield(L, -2, "__gc");+ }+ return created;+}
+ cbits/hslua/hsludata.h view
@@ -0,0 +1,11 @@+#include <HsFFI.h>+#include <lua.h>++/* ***************************************************************+ * Userdata for Haskell values+ * ***************************************************************/++/*+** Creates a new userdata metatable for Haskell objects.+*/+int hslua_newudmetatable(lua_State *L, const char *tname);
+ cbits/lua-5.3.6/lapi.c view
@@ -0,0 +1,1299 @@+/*+** $Id: lapi.c,v 2.259.1.2 2017/12/06 18:35:12 roberto Exp $+** Lua API+** See Copyright Notice in lua.h+*/++#define lapi_c+#define LUA_CORE++#include "lprefix.h"+++#include <stdarg.h>+#include <string.h>++#include "lua.h"++#include "lapi.h"+#include "ldebug.h"+#include "ldo.h"+#include "lfunc.h"+#include "lgc.h"+#include "lmem.h"+#include "lobject.h"+#include "lstate.h"+#include "lstring.h"+#include "ltable.h"+#include "ltm.h"+#include "lundump.h"+#include "lvm.h"++++const char lua_ident[] =+ "$LuaVersion: " LUA_COPYRIGHT " $"+ "$LuaAuthors: " LUA_AUTHORS " $";+++/* value at a non-valid index */+#define NONVALIDVALUE cast(TValue *, luaO_nilobject)++/* corresponding test */+#define isvalid(o) ((o) != luaO_nilobject)++/* test for pseudo index */+#define ispseudo(i) ((i) <= LUA_REGISTRYINDEX)++/* test for upvalue */+#define isupvalue(i) ((i) < LUA_REGISTRYINDEX)++/* test for valid but not pseudo index */+#define isstackindex(i, o) (isvalid(o) && !ispseudo(i))++#define api_checkvalidindex(l,o) api_check(l, isvalid(o), "invalid index")++#define api_checkstackindex(l, i, o) \+ api_check(l, isstackindex(i, o), "index not in the stack")+++static TValue *index2addr (lua_State *L, int idx) {+ CallInfo *ci = L->ci;+ if (idx > 0) {+ TValue *o = ci->func + idx;+ api_check(L, idx <= ci->top - (ci->func + 1), "unacceptable index");+ if (o >= L->top) return NONVALIDVALUE;+ else return o;+ }+ else if (!ispseudo(idx)) { /* negative index */+ api_check(L, idx != 0 && -idx <= L->top - (ci->func + 1), "invalid index");+ return L->top + idx;+ }+ else if (idx == LUA_REGISTRYINDEX)+ return &G(L)->l_registry;+ else { /* upvalues */+ idx = LUA_REGISTRYINDEX - idx;+ api_check(L, idx <= MAXUPVAL + 1, "upvalue index too large");+ if (ttislcf(ci->func)) /* light C function? */+ return NONVALIDVALUE; /* it has no upvalues */+ else {+ CClosure *func = clCvalue(ci->func);+ return (idx <= func->nupvalues) ? &func->upvalue[idx-1] : NONVALIDVALUE;+ }+ }+}+++/*+** to be called by 'lua_checkstack' in protected mode, to grow stack+** capturing memory errors+*/+static void growstack (lua_State *L, void *ud) {+ int size = *(int *)ud;+ luaD_growstack(L, size);+}+++LUA_API int lua_checkstack (lua_State *L, int n) {+ int res;+ CallInfo *ci = L->ci;+ lua_lock(L);+ api_check(L, n >= 0, "negative 'n'");+ if (L->stack_last - L->top > n) /* stack large enough? */+ res = 1; /* yes; check is OK */+ else { /* no; need to grow stack */+ int inuse = cast_int(L->top - L->stack) + EXTRA_STACK;+ if (inuse > LUAI_MAXSTACK - n) /* can grow without overflow? */+ res = 0; /* no */+ else /* try to grow stack */+ res = (luaD_rawrunprotected(L, &growstack, &n) == LUA_OK);+ }+ if (res && ci->top < L->top + n)+ ci->top = L->top + n; /* adjust frame top */+ lua_unlock(L);+ return res;+}+++LUA_API void lua_xmove (lua_State *from, lua_State *to, int n) {+ int i;+ if (from == to) return;+ lua_lock(to);+ api_checknelems(from, n);+ api_check(from, G(from) == G(to), "moving among independent states");+ api_check(from, to->ci->top - to->top >= n, "stack overflow");+ from->top -= n;+ for (i = 0; i < n; i++) {+ setobj2s(to, to->top, from->top + i);+ to->top++; /* stack already checked by previous 'api_check' */+ }+ lua_unlock(to);+}+++LUA_API lua_CFunction lua_atpanic (lua_State *L, lua_CFunction panicf) {+ lua_CFunction old;+ lua_lock(L);+ old = G(L)->panic;+ G(L)->panic = panicf;+ lua_unlock(L);+ return old;+}+++LUA_API const lua_Number *lua_version (lua_State *L) {+ static const lua_Number version = LUA_VERSION_NUM;+ if (L == NULL) return &version;+ else return G(L)->version;+}++++/*+** basic stack manipulation+*/+++/*+** convert an acceptable stack index into an absolute index+*/+LUA_API int lua_absindex (lua_State *L, int idx) {+ return (idx > 0 || ispseudo(idx))+ ? idx+ : cast_int(L->top - L->ci->func) + idx;+}+++LUA_API int lua_gettop (lua_State *L) {+ return cast_int(L->top - (L->ci->func + 1));+}+++LUA_API void lua_settop (lua_State *L, int idx) {+ StkId func = L->ci->func;+ lua_lock(L);+ if (idx >= 0) {+ api_check(L, idx <= L->stack_last - (func + 1), "new top too large");+ while (L->top < (func + 1) + idx)+ setnilvalue(L->top++);+ L->top = (func + 1) + idx;+ }+ else {+ api_check(L, -(idx+1) <= (L->top - (func + 1)), "invalid new top");+ L->top += idx+1; /* 'subtract' index (index is negative) */+ }+ lua_unlock(L);+}+++/*+** Reverse the stack segment from 'from' to 'to'+** (auxiliary to 'lua_rotate')+*/+static void reverse (lua_State *L, StkId from, StkId to) {+ for (; from < to; from++, to--) {+ TValue temp;+ setobj(L, &temp, from);+ setobjs2s(L, from, to);+ setobj2s(L, to, &temp);+ }+}+++/*+** Let x = AB, where A is a prefix of length 'n'. Then,+** rotate x n == BA. But BA == (A^r . B^r)^r.+*/+LUA_API void lua_rotate (lua_State *L, int idx, int n) {+ StkId p, t, m;+ lua_lock(L);+ t = L->top - 1; /* end of stack segment being rotated */+ p = index2addr(L, idx); /* start of segment */+ api_checkstackindex(L, idx, p);+ api_check(L, (n >= 0 ? n : -n) <= (t - p + 1), "invalid 'n'");+ m = (n >= 0 ? t - n : p - n - 1); /* end of prefix */+ reverse(L, p, m); /* reverse the prefix with length 'n' */+ reverse(L, m + 1, t); /* reverse the suffix */+ reverse(L, p, t); /* reverse the entire segment */+ lua_unlock(L);+}+++LUA_API void lua_copy (lua_State *L, int fromidx, int toidx) {+ TValue *fr, *to;+ lua_lock(L);+ fr = index2addr(L, fromidx);+ to = index2addr(L, toidx);+ api_checkvalidindex(L, to);+ setobj(L, to, fr);+ if (isupvalue(toidx)) /* function upvalue? */+ luaC_barrier(L, clCvalue(L->ci->func), fr);+ /* LUA_REGISTRYINDEX does not need gc barrier+ (collector revisits it before finishing collection) */+ lua_unlock(L);+}+++LUA_API void lua_pushvalue (lua_State *L, int idx) {+ lua_lock(L);+ setobj2s(L, L->top, index2addr(L, idx));+ api_incr_top(L);+ lua_unlock(L);+}++++/*+** access functions (stack -> C)+*/+++LUA_API int lua_type (lua_State *L, int idx) {+ StkId o = index2addr(L, idx);+ return (isvalid(o) ? ttnov(o) : LUA_TNONE);+}+++LUA_API const char *lua_typename (lua_State *L, int t) {+ UNUSED(L);+ api_check(L, LUA_TNONE <= t && t < LUA_NUMTAGS, "invalid tag");+ return ttypename(t);+}+++LUA_API int lua_iscfunction (lua_State *L, int idx) {+ StkId o = index2addr(L, idx);+ return (ttislcf(o) || (ttisCclosure(o)));+}+++LUA_API int lua_isinteger (lua_State *L, int idx) {+ StkId o = index2addr(L, idx);+ return ttisinteger(o);+}+++LUA_API int lua_isnumber (lua_State *L, int idx) {+ lua_Number n;+ const TValue *o = index2addr(L, idx);+ return tonumber(o, &n);+}+++LUA_API int lua_isstring (lua_State *L, int idx) {+ const TValue *o = index2addr(L, idx);+ return (ttisstring(o) || cvt2str(o));+}+++LUA_API int lua_isuserdata (lua_State *L, int idx) {+ const TValue *o = index2addr(L, idx);+ return (ttisfulluserdata(o) || ttislightuserdata(o));+}+++LUA_API int lua_rawequal (lua_State *L, int index1, int index2) {+ StkId o1 = index2addr(L, index1);+ StkId o2 = index2addr(L, index2);+ return (isvalid(o1) && isvalid(o2)) ? luaV_rawequalobj(o1, o2) : 0;+}+++LUA_API void lua_arith (lua_State *L, int op) {+ lua_lock(L);+ if (op != LUA_OPUNM && op != LUA_OPBNOT)+ api_checknelems(L, 2); /* all other operations expect two operands */+ else { /* for unary operations, add fake 2nd operand */+ api_checknelems(L, 1);+ setobjs2s(L, L->top, L->top - 1);+ api_incr_top(L);+ }+ /* first operand at top - 2, second at top - 1; result go to top - 2 */+ luaO_arith(L, op, L->top - 2, L->top - 1, L->top - 2);+ L->top--; /* remove second operand */+ lua_unlock(L);+}+++LUA_API int lua_compare (lua_State *L, int index1, int index2, int op) {+ StkId o1, o2;+ int i = 0;+ lua_lock(L); /* may call tag method */+ o1 = index2addr(L, index1);+ o2 = index2addr(L, index2);+ if (isvalid(o1) && isvalid(o2)) {+ switch (op) {+ case LUA_OPEQ: i = luaV_equalobj(L, o1, o2); break;+ case LUA_OPLT: i = luaV_lessthan(L, o1, o2); break;+ case LUA_OPLE: i = luaV_lessequal(L, o1, o2); break;+ default: api_check(L, 0, "invalid option");+ }+ }+ lua_unlock(L);+ return i;+}+++LUA_API size_t lua_stringtonumber (lua_State *L, const char *s) {+ size_t sz = luaO_str2num(s, L->top);+ if (sz != 0)+ api_incr_top(L);+ return sz;+}+++LUA_API lua_Number lua_tonumberx (lua_State *L, int idx, int *pisnum) {+ lua_Number n;+ const TValue *o = index2addr(L, idx);+ int isnum = tonumber(o, &n);+ if (!isnum)+ n = 0; /* call to 'tonumber' may change 'n' even if it fails */+ if (pisnum) *pisnum = isnum;+ return n;+}+++LUA_API lua_Integer lua_tointegerx (lua_State *L, int idx, int *pisnum) {+ lua_Integer res;+ const TValue *o = index2addr(L, idx);+ int isnum = tointeger(o, &res);+ if (!isnum)+ res = 0; /* call to 'tointeger' may change 'n' even if it fails */+ if (pisnum) *pisnum = isnum;+ return res;+}+++LUA_API int lua_toboolean (lua_State *L, int idx) {+ const TValue *o = index2addr(L, idx);+ return !l_isfalse(o);+}+++LUA_API const char *lua_tolstring (lua_State *L, int idx, size_t *len) {+ StkId o = index2addr(L, idx);+ if (!ttisstring(o)) {+ if (!cvt2str(o)) { /* not convertible? */+ if (len != NULL) *len = 0;+ return NULL;+ }+ lua_lock(L); /* 'luaO_tostring' may create a new string */+ luaO_tostring(L, o);+ luaC_checkGC(L);+ o = index2addr(L, idx); /* previous call may reallocate the stack */+ lua_unlock(L);+ }+ if (len != NULL)+ *len = vslen(o);+ return svalue(o);+}+++LUA_API size_t lua_rawlen (lua_State *L, int idx) {+ StkId o = index2addr(L, idx);+ switch (ttype(o)) {+ case LUA_TSHRSTR: return tsvalue(o)->shrlen;+ case LUA_TLNGSTR: return tsvalue(o)->u.lnglen;+ case LUA_TUSERDATA: return uvalue(o)->len;+ case LUA_TTABLE: return luaH_getn(hvalue(o));+ default: return 0;+ }+}+++LUA_API lua_CFunction lua_tocfunction (lua_State *L, int idx) {+ StkId o = index2addr(L, idx);+ if (ttislcf(o)) return fvalue(o);+ else if (ttisCclosure(o))+ return clCvalue(o)->f;+ else return NULL; /* not a C function */+}+++LUA_API void *lua_touserdata (lua_State *L, int idx) {+ StkId o = index2addr(L, idx);+ switch (ttnov(o)) {+ case LUA_TUSERDATA: return getudatamem(uvalue(o));+ case LUA_TLIGHTUSERDATA: return pvalue(o);+ default: return NULL;+ }+}+++LUA_API lua_State *lua_tothread (lua_State *L, int idx) {+ StkId o = index2addr(L, idx);+ return (!ttisthread(o)) ? NULL : thvalue(o);+}+++LUA_API const void *lua_topointer (lua_State *L, int idx) {+ StkId o = index2addr(L, idx);+ switch (ttype(o)) {+ case LUA_TTABLE: return hvalue(o);+ case LUA_TLCL: return clLvalue(o);+ case LUA_TCCL: return clCvalue(o);+ case LUA_TLCF: return cast(void *, cast(size_t, fvalue(o)));+ case LUA_TTHREAD: return thvalue(o);+ case LUA_TUSERDATA: return getudatamem(uvalue(o));+ case LUA_TLIGHTUSERDATA: return pvalue(o);+ default: return NULL;+ }+}++++/*+** push functions (C -> stack)+*/+++LUA_API void lua_pushnil (lua_State *L) {+ lua_lock(L);+ setnilvalue(L->top);+ api_incr_top(L);+ lua_unlock(L);+}+++LUA_API void lua_pushnumber (lua_State *L, lua_Number n) {+ lua_lock(L);+ setfltvalue(L->top, n);+ api_incr_top(L);+ lua_unlock(L);+}+++LUA_API void lua_pushinteger (lua_State *L, lua_Integer n) {+ lua_lock(L);+ setivalue(L->top, n);+ api_incr_top(L);+ lua_unlock(L);+}+++/*+** Pushes on the stack a string with given length. Avoid using 's' when+** 'len' == 0 (as 's' can be NULL in that case), due to later use of+** 'memcmp' and 'memcpy'.+*/+LUA_API const char *lua_pushlstring (lua_State *L, const char *s, size_t len) {+ TString *ts;+ lua_lock(L);+ ts = (len == 0) ? luaS_new(L, "") : luaS_newlstr(L, s, len);+ setsvalue2s(L, L->top, ts);+ api_incr_top(L);+ luaC_checkGC(L);+ lua_unlock(L);+ return getstr(ts);+}+++LUA_API const char *lua_pushstring (lua_State *L, const char *s) {+ lua_lock(L);+ if (s == NULL)+ setnilvalue(L->top);+ else {+ TString *ts;+ ts = luaS_new(L, s);+ setsvalue2s(L, L->top, ts);+ s = getstr(ts); /* internal copy's address */+ }+ api_incr_top(L);+ luaC_checkGC(L);+ lua_unlock(L);+ return s;+}+++LUA_API const char *lua_pushvfstring (lua_State *L, const char *fmt,+ va_list argp) {+ const char *ret;+ lua_lock(L);+ ret = luaO_pushvfstring(L, fmt, argp);+ luaC_checkGC(L);+ lua_unlock(L);+ return ret;+}+++LUA_API const char *lua_pushfstring (lua_State *L, const char *fmt, ...) {+ const char *ret;+ va_list argp;+ lua_lock(L);+ va_start(argp, fmt);+ ret = luaO_pushvfstring(L, fmt, argp);+ va_end(argp);+ luaC_checkGC(L);+ lua_unlock(L);+ return ret;+}+++LUA_API void lua_pushcclosure (lua_State *L, lua_CFunction fn, int n) {+ lua_lock(L);+ if (n == 0) {+ setfvalue(L->top, fn);+ api_incr_top(L);+ }+ else {+ CClosure *cl;+ api_checknelems(L, n);+ api_check(L, n <= MAXUPVAL, "upvalue index too large");+ cl = luaF_newCclosure(L, n);+ cl->f = fn;+ L->top -= n;+ while (n--) {+ setobj2n(L, &cl->upvalue[n], L->top + n);+ /* does not need barrier because closure is white */+ }+ setclCvalue(L, L->top, cl);+ api_incr_top(L);+ luaC_checkGC(L);+ }+ lua_unlock(L);+}+++LUA_API void lua_pushboolean (lua_State *L, int b) {+ lua_lock(L);+ setbvalue(L->top, (b != 0)); /* ensure that true is 1 */+ api_incr_top(L);+ lua_unlock(L);+}+++LUA_API void lua_pushlightuserdata (lua_State *L, void *p) {+ lua_lock(L);+ setpvalue(L->top, p);+ api_incr_top(L);+ lua_unlock(L);+}+++LUA_API int lua_pushthread (lua_State *L) {+ lua_lock(L);+ setthvalue(L, L->top, L);+ api_incr_top(L);+ lua_unlock(L);+ return (G(L)->mainthread == L);+}++++/*+** get functions (Lua -> stack)+*/+++static int auxgetstr (lua_State *L, const TValue *t, const char *k) {+ const TValue *slot;+ TString *str = luaS_new(L, k);+ if (luaV_fastget(L, t, str, slot, luaH_getstr)) {+ setobj2s(L, L->top, slot);+ api_incr_top(L);+ }+ else {+ setsvalue2s(L, L->top, str);+ api_incr_top(L);+ luaV_finishget(L, t, L->top - 1, L->top - 1, slot);+ }+ lua_unlock(L);+ return ttnov(L->top - 1);+}+++LUA_API int lua_getglobal (lua_State *L, const char *name) {+ Table *reg = hvalue(&G(L)->l_registry);+ lua_lock(L);+ return auxgetstr(L, luaH_getint(reg, LUA_RIDX_GLOBALS), name);+}+++LUA_API int lua_gettable (lua_State *L, int idx) {+ StkId t;+ lua_lock(L);+ t = index2addr(L, idx);+ luaV_gettable(L, t, L->top - 1, L->top - 1);+ lua_unlock(L);+ return ttnov(L->top - 1);+}+++LUA_API int lua_getfield (lua_State *L, int idx, const char *k) {+ lua_lock(L);+ return auxgetstr(L, index2addr(L, idx), k);+}+++LUA_API int lua_geti (lua_State *L, int idx, lua_Integer n) {+ StkId t;+ const TValue *slot;+ lua_lock(L);+ t = index2addr(L, idx);+ if (luaV_fastget(L, t, n, slot, luaH_getint)) {+ setobj2s(L, L->top, slot);+ api_incr_top(L);+ }+ else {+ setivalue(L->top, n);+ api_incr_top(L);+ luaV_finishget(L, t, L->top - 1, L->top - 1, slot);+ }+ lua_unlock(L);+ return ttnov(L->top - 1);+}+++LUA_API int lua_rawget (lua_State *L, int idx) {+ StkId t;+ lua_lock(L);+ t = index2addr(L, idx);+ api_check(L, ttistable(t), "table expected");+ setobj2s(L, L->top - 1, luaH_get(hvalue(t), L->top - 1));+ lua_unlock(L);+ return ttnov(L->top - 1);+}+++LUA_API int lua_rawgeti (lua_State *L, int idx, lua_Integer n) {+ StkId t;+ lua_lock(L);+ t = index2addr(L, idx);+ api_check(L, ttistable(t), "table expected");+ setobj2s(L, L->top, luaH_getint(hvalue(t), n));+ api_incr_top(L);+ lua_unlock(L);+ return ttnov(L->top - 1);+}+++LUA_API int lua_rawgetp (lua_State *L, int idx, const void *p) {+ StkId t;+ TValue k;+ lua_lock(L);+ t = index2addr(L, idx);+ api_check(L, ttistable(t), "table expected");+ setpvalue(&k, cast(void *, p));+ setobj2s(L, L->top, luaH_get(hvalue(t), &k));+ api_incr_top(L);+ lua_unlock(L);+ return ttnov(L->top - 1);+}+++LUA_API void lua_createtable (lua_State *L, int narray, int nrec) {+ Table *t;+ lua_lock(L);+ t = luaH_new(L);+ sethvalue(L, L->top, t);+ api_incr_top(L);+ if (narray > 0 || nrec > 0)+ luaH_resize(L, t, narray, nrec);+ luaC_checkGC(L);+ lua_unlock(L);+}+++LUA_API int lua_getmetatable (lua_State *L, int objindex) {+ const TValue *obj;+ Table *mt;+ int res = 0;+ lua_lock(L);+ obj = index2addr(L, objindex);+ switch (ttnov(obj)) {+ case LUA_TTABLE:+ mt = hvalue(obj)->metatable;+ break;+ case LUA_TUSERDATA:+ mt = uvalue(obj)->metatable;+ break;+ default:+ mt = G(L)->mt[ttnov(obj)];+ break;+ }+ if (mt != NULL) {+ sethvalue(L, L->top, mt);+ api_incr_top(L);+ res = 1;+ }+ lua_unlock(L);+ return res;+}+++LUA_API int lua_getuservalue (lua_State *L, int idx) {+ StkId o;+ lua_lock(L);+ o = index2addr(L, idx);+ api_check(L, ttisfulluserdata(o), "full userdata expected");+ getuservalue(L, uvalue(o), L->top);+ api_incr_top(L);+ lua_unlock(L);+ return ttnov(L->top - 1);+}+++/*+** set functions (stack -> Lua)+*/++/*+** t[k] = value at the top of the stack (where 'k' is a string)+*/+static void auxsetstr (lua_State *L, const TValue *t, const char *k) {+ const TValue *slot;+ TString *str = luaS_new(L, k);+ api_checknelems(L, 1);+ if (luaV_fastset(L, t, str, slot, luaH_getstr, L->top - 1))+ L->top--; /* pop value */+ else {+ setsvalue2s(L, L->top, str); /* push 'str' (to make it a TValue) */+ api_incr_top(L);+ luaV_finishset(L, t, L->top - 1, L->top - 2, slot);+ L->top -= 2; /* pop value and key */+ }+ lua_unlock(L); /* lock done by caller */+}+++LUA_API void lua_setglobal (lua_State *L, const char *name) {+ Table *reg = hvalue(&G(L)->l_registry);+ lua_lock(L); /* unlock done in 'auxsetstr' */+ auxsetstr(L, luaH_getint(reg, LUA_RIDX_GLOBALS), name);+}+++LUA_API void lua_settable (lua_State *L, int idx) {+ StkId t;+ lua_lock(L);+ api_checknelems(L, 2);+ t = index2addr(L, idx);+ luaV_settable(L, t, L->top - 2, L->top - 1);+ L->top -= 2; /* pop index and value */+ lua_unlock(L);+}+++LUA_API void lua_setfield (lua_State *L, int idx, const char *k) {+ lua_lock(L); /* unlock done in 'auxsetstr' */+ auxsetstr(L, index2addr(L, idx), k);+}+++LUA_API void lua_seti (lua_State *L, int idx, lua_Integer n) {+ StkId t;+ const TValue *slot;+ lua_lock(L);+ api_checknelems(L, 1);+ t = index2addr(L, idx);+ if (luaV_fastset(L, t, n, slot, luaH_getint, L->top - 1))+ L->top--; /* pop value */+ else {+ setivalue(L->top, n);+ api_incr_top(L);+ luaV_finishset(L, t, L->top - 1, L->top - 2, slot);+ L->top -= 2; /* pop value and key */+ }+ lua_unlock(L);+}+++LUA_API void lua_rawset (lua_State *L, int idx) {+ StkId o;+ TValue *slot;+ lua_lock(L);+ api_checknelems(L, 2);+ o = index2addr(L, idx);+ api_check(L, ttistable(o), "table expected");+ slot = luaH_set(L, hvalue(o), L->top - 2);+ setobj2t(L, slot, L->top - 1);+ invalidateTMcache(hvalue(o));+ luaC_barrierback(L, hvalue(o), L->top-1);+ L->top -= 2;+ lua_unlock(L);+}+++LUA_API void lua_rawseti (lua_State *L, int idx, lua_Integer n) {+ StkId o;+ lua_lock(L);+ api_checknelems(L, 1);+ o = index2addr(L, idx);+ api_check(L, ttistable(o), "table expected");+ luaH_setint(L, hvalue(o), n, L->top - 1);+ luaC_barrierback(L, hvalue(o), L->top-1);+ L->top--;+ lua_unlock(L);+}+++LUA_API void lua_rawsetp (lua_State *L, int idx, const void *p) {+ StkId o;+ TValue k, *slot;+ lua_lock(L);+ api_checknelems(L, 1);+ o = index2addr(L, idx);+ api_check(L, ttistable(o), "table expected");+ setpvalue(&k, cast(void *, p));+ slot = luaH_set(L, hvalue(o), &k);+ setobj2t(L, slot, L->top - 1);+ luaC_barrierback(L, hvalue(o), L->top - 1);+ L->top--;+ lua_unlock(L);+}+++LUA_API int lua_setmetatable (lua_State *L, int objindex) {+ TValue *obj;+ Table *mt;+ lua_lock(L);+ api_checknelems(L, 1);+ obj = index2addr(L, objindex);+ if (ttisnil(L->top - 1))+ mt = NULL;+ else {+ api_check(L, ttistable(L->top - 1), "table expected");+ mt = hvalue(L->top - 1);+ }+ switch (ttnov(obj)) {+ case LUA_TTABLE: {+ hvalue(obj)->metatable = mt;+ if (mt) {+ luaC_objbarrier(L, gcvalue(obj), mt);+ luaC_checkfinalizer(L, gcvalue(obj), mt);+ }+ break;+ }+ case LUA_TUSERDATA: {+ uvalue(obj)->metatable = mt;+ if (mt) {+ luaC_objbarrier(L, uvalue(obj), mt);+ luaC_checkfinalizer(L, gcvalue(obj), mt);+ }+ break;+ }+ default: {+ G(L)->mt[ttnov(obj)] = mt;+ break;+ }+ }+ L->top--;+ lua_unlock(L);+ return 1;+}+++LUA_API void lua_setuservalue (lua_State *L, int idx) {+ StkId o;+ lua_lock(L);+ api_checknelems(L, 1);+ o = index2addr(L, idx);+ api_check(L, ttisfulluserdata(o), "full userdata expected");+ setuservalue(L, uvalue(o), L->top - 1);+ luaC_barrier(L, gcvalue(o), L->top - 1);+ L->top--;+ lua_unlock(L);+}+++/*+** 'load' and 'call' functions (run Lua code)+*/+++#define checkresults(L,na,nr) \+ api_check(L, (nr) == LUA_MULTRET || (L->ci->top - L->top >= (nr) - (na)), \+ "results from function overflow current stack size")+++LUA_API void lua_callk (lua_State *L, int nargs, int nresults,+ lua_KContext ctx, lua_KFunction k) {+ StkId func;+ lua_lock(L);+ api_check(L, k == NULL || !isLua(L->ci),+ "cannot use continuations inside hooks");+ api_checknelems(L, nargs+1);+ api_check(L, L->status == LUA_OK, "cannot do calls on non-normal thread");+ checkresults(L, nargs, nresults);+ func = L->top - (nargs+1);+ if (k != NULL && L->nny == 0) { /* need to prepare continuation? */+ L->ci->u.c.k = k; /* save continuation */+ L->ci->u.c.ctx = ctx; /* save context */+ luaD_call(L, func, nresults); /* do the call */+ }+ else /* no continuation or no yieldable */+ luaD_callnoyield(L, func, nresults); /* just do the call */+ adjustresults(L, nresults);+ lua_unlock(L);+}++++/*+** Execute a protected call.+*/+struct CallS { /* data to 'f_call' */+ StkId func;+ int nresults;+};+++static void f_call (lua_State *L, void *ud) {+ struct CallS *c = cast(struct CallS *, ud);+ luaD_callnoyield(L, c->func, c->nresults);+}++++LUA_API int lua_pcallk (lua_State *L, int nargs, int nresults, int errfunc,+ lua_KContext ctx, lua_KFunction k) {+ struct CallS c;+ int status;+ ptrdiff_t func;+ lua_lock(L);+ api_check(L, k == NULL || !isLua(L->ci),+ "cannot use continuations inside hooks");+ api_checknelems(L, nargs+1);+ api_check(L, L->status == LUA_OK, "cannot do calls on non-normal thread");+ checkresults(L, nargs, nresults);+ if (errfunc == 0)+ func = 0;+ else {+ StkId o = index2addr(L, errfunc);+ api_checkstackindex(L, errfunc, o);+ func = savestack(L, o);+ }+ c.func = L->top - (nargs+1); /* function to be called */+ if (k == NULL || L->nny > 0) { /* no continuation or no yieldable? */+ c.nresults = nresults; /* do a 'conventional' protected call */+ status = luaD_pcall(L, f_call, &c, savestack(L, c.func), func);+ }+ else { /* prepare continuation (call is already protected by 'resume') */+ CallInfo *ci = L->ci;+ ci->u.c.k = k; /* save continuation */+ ci->u.c.ctx = ctx; /* save context */+ /* save information for error recovery */+ ci->extra = savestack(L, c.func);+ ci->u.c.old_errfunc = L->errfunc;+ L->errfunc = func;+ setoah(ci->callstatus, L->allowhook); /* save value of 'allowhook' */+ ci->callstatus |= CIST_YPCALL; /* function can do error recovery */+ luaD_call(L, c.func, nresults); /* do the call */+ ci->callstatus &= ~CIST_YPCALL;+ L->errfunc = ci->u.c.old_errfunc;+ status = LUA_OK; /* if it is here, there were no errors */+ }+ adjustresults(L, nresults);+ lua_unlock(L);+ return status;+}+++LUA_API int lua_load (lua_State *L, lua_Reader reader, void *data,+ const char *chunkname, const char *mode) {+ ZIO z;+ int status;+ lua_lock(L);+ if (!chunkname) chunkname = "?";+ luaZ_init(L, &z, reader, data);+ status = luaD_protectedparser(L, &z, chunkname, mode);+ if (status == LUA_OK) { /* no errors? */+ LClosure *f = clLvalue(L->top - 1); /* get newly created function */+ if (f->nupvalues >= 1) { /* does it have an upvalue? */+ /* get global table from registry */+ Table *reg = hvalue(&G(L)->l_registry);+ const TValue *gt = luaH_getint(reg, LUA_RIDX_GLOBALS);+ /* set global table as 1st upvalue of 'f' (may be LUA_ENV) */+ setobj(L, f->upvals[0]->v, gt);+ luaC_upvalbarrier(L, f->upvals[0]);+ }+ }+ lua_unlock(L);+ return status;+}+++LUA_API int lua_dump (lua_State *L, lua_Writer writer, void *data, int strip) {+ int status;+ TValue *o;+ lua_lock(L);+ api_checknelems(L, 1);+ o = L->top - 1;+ if (isLfunction(o))+ status = luaU_dump(L, getproto(o), writer, data, strip);+ else+ status = 1;+ lua_unlock(L);+ return status;+}+++LUA_API int lua_status (lua_State *L) {+ return L->status;+}+++/*+** Garbage-collection function+*/++LUA_API int lua_gc (lua_State *L, int what, int data) {+ int res = 0;+ global_State *g;+ lua_lock(L);+ g = G(L);+ switch (what) {+ case LUA_GCSTOP: {+ g->gcrunning = 0;+ break;+ }+ case LUA_GCRESTART: {+ luaE_setdebt(g, 0);+ g->gcrunning = 1;+ break;+ }+ case LUA_GCCOLLECT: {+ luaC_fullgc(L, 0);+ break;+ }+ case LUA_GCCOUNT: {+ /* GC values are expressed in Kbytes: #bytes/2^10 */+ res = cast_int(gettotalbytes(g) >> 10);+ break;+ }+ case LUA_GCCOUNTB: {+ res = cast_int(gettotalbytes(g) & 0x3ff);+ break;+ }+ case LUA_GCSTEP: {+ l_mem debt = 1; /* =1 to signal that it did an actual step */+ lu_byte oldrunning = g->gcrunning;+ g->gcrunning = 1; /* allow GC to run */+ if (data == 0) {+ luaE_setdebt(g, -GCSTEPSIZE); /* to do a "small" step */+ luaC_step(L);+ }+ else { /* add 'data' to total debt */+ debt = cast(l_mem, data) * 1024 + g->GCdebt;+ luaE_setdebt(g, debt);+ luaC_checkGC(L);+ }+ g->gcrunning = oldrunning; /* restore previous state */+ if (debt > 0 && g->gcstate == GCSpause) /* end of cycle? */+ res = 1; /* signal it */+ break;+ }+ case LUA_GCSETPAUSE: {+ res = g->gcpause;+ g->gcpause = data;+ break;+ }+ case LUA_GCSETSTEPMUL: {+ res = g->gcstepmul;+ if (data < 40) data = 40; /* avoid ridiculous low values (and 0) */+ g->gcstepmul = data;+ break;+ }+ case LUA_GCISRUNNING: {+ res = g->gcrunning;+ break;+ }+ default: res = -1; /* invalid option */+ }+ lua_unlock(L);+ return res;+}++++/*+** miscellaneous functions+*/+++LUA_API int lua_error (lua_State *L) {+ lua_lock(L);+ api_checknelems(L, 1);+ luaG_errormsg(L);+ /* code unreachable; will unlock when control actually leaves the kernel */+ return 0; /* to avoid warnings */+}+++LUA_API int lua_next (lua_State *L, int idx) {+ StkId t;+ int more;+ lua_lock(L);+ t = index2addr(L, idx);+ api_check(L, ttistable(t), "table expected");+ more = luaH_next(L, hvalue(t), L->top - 1);+ if (more) {+ api_incr_top(L);+ }+ else /* no more elements */+ L->top -= 1; /* remove key */+ lua_unlock(L);+ return more;+}+++LUA_API void lua_concat (lua_State *L, int n) {+ lua_lock(L);+ api_checknelems(L, n);+ if (n >= 2) {+ luaV_concat(L, n);+ }+ else if (n == 0) { /* push empty string */+ setsvalue2s(L, L->top, luaS_newlstr(L, "", 0));+ api_incr_top(L);+ }+ /* else n == 1; nothing to do */+ luaC_checkGC(L);+ lua_unlock(L);+}+++LUA_API void lua_len (lua_State *L, int idx) {+ StkId t;+ lua_lock(L);+ t = index2addr(L, idx);+ luaV_objlen(L, L->top, t);+ api_incr_top(L);+ lua_unlock(L);+}+++LUA_API lua_Alloc lua_getallocf (lua_State *L, void **ud) {+ lua_Alloc f;+ lua_lock(L);+ if (ud) *ud = G(L)->ud;+ f = G(L)->frealloc;+ lua_unlock(L);+ return f;+}+++LUA_API void lua_setallocf (lua_State *L, lua_Alloc f, void *ud) {+ lua_lock(L);+ G(L)->ud = ud;+ G(L)->frealloc = f;+ lua_unlock(L);+}+++LUA_API void *lua_newuserdata (lua_State *L, size_t size) {+ Udata *u;+ lua_lock(L);+ u = luaS_newudata(L, size);+ setuvalue(L, L->top, u);+ api_incr_top(L);+ luaC_checkGC(L);+ lua_unlock(L);+ return getudatamem(u);+}++++static const char *aux_upvalue (StkId fi, int n, TValue **val,+ CClosure **owner, UpVal **uv) {+ switch (ttype(fi)) {+ case LUA_TCCL: { /* C closure */+ CClosure *f = clCvalue(fi);+ if (!(1 <= n && n <= f->nupvalues)) return NULL;+ *val = &f->upvalue[n-1];+ if (owner) *owner = f;+ return "";+ }+ case LUA_TLCL: { /* Lua closure */+ LClosure *f = clLvalue(fi);+ TString *name;+ Proto *p = f->p;+ if (!(1 <= n && n <= p->sizeupvalues)) return NULL;+ *val = f->upvals[n-1]->v;+ if (uv) *uv = f->upvals[n - 1];+ name = p->upvalues[n-1].name;+ return (name == NULL) ? "(*no name)" : getstr(name);+ }+ default: return NULL; /* not a closure */+ }+}+++LUA_API const char *lua_getupvalue (lua_State *L, int funcindex, int n) {+ const char *name;+ TValue *val = NULL; /* to avoid warnings */+ lua_lock(L);+ name = aux_upvalue(index2addr(L, funcindex), n, &val, NULL, NULL);+ if (name) {+ setobj2s(L, L->top, val);+ api_incr_top(L);+ }+ lua_unlock(L);+ return name;+}+++LUA_API const char *lua_setupvalue (lua_State *L, int funcindex, int n) {+ const char *name;+ TValue *val = NULL; /* to avoid warnings */+ CClosure *owner = NULL;+ UpVal *uv = NULL;+ StkId fi;+ lua_lock(L);+ fi = index2addr(L, funcindex);+ api_checknelems(L, 1);+ name = aux_upvalue(fi, n, &val, &owner, &uv);+ if (name) {+ L->top--;+ setobj(L, val, L->top);+ if (owner) { luaC_barrier(L, owner, L->top); }+ else if (uv) { luaC_upvalbarrier(L, uv); }+ }+ lua_unlock(L);+ return name;+}+++static UpVal **getupvalref (lua_State *L, int fidx, int n) {+ LClosure *f;+ StkId fi = index2addr(L, fidx);+ api_check(L, ttisLclosure(fi), "Lua function expected");+ f = clLvalue(fi);+ api_check(L, (1 <= n && n <= f->p->sizeupvalues), "invalid upvalue index");+ return &f->upvals[n - 1]; /* get its upvalue pointer */+}+++LUA_API void *lua_upvalueid (lua_State *L, int fidx, int n) {+ StkId fi = index2addr(L, fidx);+ switch (ttype(fi)) {+ case LUA_TLCL: { /* lua closure */+ return *getupvalref(L, fidx, n);+ }+ case LUA_TCCL: { /* C closure */+ CClosure *f = clCvalue(fi);+ api_check(L, 1 <= n && n <= f->nupvalues, "invalid upvalue index");+ return &f->upvalue[n - 1];+ }+ default: {+ api_check(L, 0, "closure expected");+ return NULL;+ }+ }+}+++LUA_API void lua_upvaluejoin (lua_State *L, int fidx1, int n1,+ int fidx2, int n2) {+ UpVal **up1 = getupvalref(L, fidx1, n1);+ UpVal **up2 = getupvalref(L, fidx2, n2);+ if (*up1 == *up2)+ return;+ luaC_upvdeccount(L, *up1);+ *up1 = *up2;+ (*up1)->refcount++;+ if (upisopen(*up1)) (*up1)->u.open.touched = 1;+ luaC_upvalbarrier(L, *up1);+}++
+ cbits/lua-5.3.6/lapi.h view
@@ -0,0 +1,24 @@+/*+** $Id: lapi.h,v 2.9.1.1 2017/04/19 17:20:42 roberto Exp $+** Auxiliary functions from Lua API+** See Copyright Notice in lua.h+*/++#ifndef lapi_h+#define lapi_h+++#include "llimits.h"+#include "lstate.h"++#define api_incr_top(L) {L->top++; api_check(L, L->top <= L->ci->top, \+ "stack overflow");}++#define adjustresults(L,nres) \+ { if ((nres) == LUA_MULTRET && L->ci->top < L->top) L->ci->top = L->top; }++#define api_checknelems(L,n) api_check(L, (n) < (L->top - L->ci->func), \+ "not enough elements in the stack")+++#endif
+ cbits/lua-5.3.6/lauxlib.c view
@@ -0,0 +1,1048 @@+/*+** $Id: lauxlib.c,v 1.289.1.1 2017/04/19 17:20:42 roberto Exp $+** Auxiliary functions for building Lua libraries+** See Copyright Notice in lua.h+*/++#define lauxlib_c+#define LUA_LIB++#include "lprefix.h"+++#include <errno.h>+#include <stdarg.h>+#include <stdio.h>+#include <stdlib.h>+#include <string.h>+++/*+** This file uses only the official API of Lua.+** Any function declared here could be written as an application function.+*/++#include "lua.h"++#include "lauxlib.h"+++/*+** {======================================================+** Traceback+** =======================================================+*/+++#define LEVELS1 10 /* size of the first part of the stack */+#define LEVELS2 11 /* size of the second part of the stack */++++/*+** search for 'objidx' in table at index -1.+** return 1 + string at top if find a good name.+*/+static int findfield (lua_State *L, int objidx, int level) {+ if (level == 0 || !lua_istable(L, -1))+ return 0; /* not found */+ lua_pushnil(L); /* start 'next' loop */+ while (lua_next(L, -2)) { /* for each pair in table */+ if (lua_type(L, -2) == LUA_TSTRING) { /* ignore non-string keys */+ if (lua_rawequal(L, objidx, -1)) { /* found object? */+ lua_pop(L, 1); /* remove value (but keep name) */+ return 1;+ }+ else if (findfield(L, objidx, level - 1)) { /* try recursively */+ lua_remove(L, -2); /* remove table (but keep name) */+ lua_pushliteral(L, ".");+ lua_insert(L, -2); /* place '.' between the two names */+ lua_concat(L, 3);+ return 1;+ }+ }+ lua_pop(L, 1); /* remove value */+ }+ return 0; /* not found */+}+++/*+** Search for a name for a function in all loaded modules+*/+static int pushglobalfuncname (lua_State *L, lua_Debug *ar) {+ int top = lua_gettop(L);+ lua_getinfo(L, "f", ar); /* push function */+ lua_getfield(L, LUA_REGISTRYINDEX, LUA_LOADED_TABLE);+ if (findfield(L, top + 1, 2)) {+ const char *name = lua_tostring(L, -1);+ if (strncmp(name, "_G.", 3) == 0) { /* name start with '_G.'? */+ lua_pushstring(L, name + 3); /* push name without prefix */+ lua_remove(L, -2); /* remove original name */+ }+ lua_copy(L, -1, top + 1); /* move name to proper place */+ lua_pop(L, 2); /* remove pushed values */+ return 1;+ }+ else {+ lua_settop(L, top); /* remove function and global table */+ return 0;+ }+}+++static void pushfuncname (lua_State *L, lua_Debug *ar) {+ if (pushglobalfuncname(L, ar)) { /* try first a global name */+ lua_pushfstring(L, "function '%s'", lua_tostring(L, -1));+ lua_remove(L, -2); /* remove name */+ }+ else if (*ar->namewhat != '\0') /* is there a name from code? */+ lua_pushfstring(L, "%s '%s'", ar->namewhat, ar->name); /* use it */+ else if (*ar->what == 'm') /* main? */+ lua_pushliteral(L, "main chunk");+ else if (*ar->what != 'C') /* for Lua functions, use <file:line> */+ lua_pushfstring(L, "function <%s:%d>", ar->short_src, ar->linedefined);+ else /* nothing left... */+ lua_pushliteral(L, "?");+}+++static int lastlevel (lua_State *L) {+ lua_Debug ar;+ int li = 1, le = 1;+ /* find an upper bound */+ while (lua_getstack(L, le, &ar)) { li = le; le *= 2; }+ /* do a binary search */+ while (li < le) {+ int m = (li + le)/2;+ if (lua_getstack(L, m, &ar)) li = m + 1;+ else le = m;+ }+ return le - 1;+}+++LUALIB_API void luaL_traceback (lua_State *L, lua_State *L1,+ const char *msg, int level) {+ lua_Debug ar;+ int top = lua_gettop(L);+ int last = lastlevel(L1);+ int n1 = (last - level > LEVELS1 + LEVELS2) ? LEVELS1 : -1;+ if (msg)+ lua_pushfstring(L, "%s\n", msg);+ luaL_checkstack(L, 10, NULL);+ lua_pushliteral(L, "stack traceback:");+ while (lua_getstack(L1, level++, &ar)) {+ if (n1-- == 0) { /* too many levels? */+ lua_pushliteral(L, "\n\t..."); /* add a '...' */+ level = last - LEVELS2 + 1; /* and skip to last ones */+ }+ else {+ lua_getinfo(L1, "Slnt", &ar);+ lua_pushfstring(L, "\n\t%s:", ar.short_src);+ if (ar.currentline > 0)+ lua_pushfstring(L, "%d:", ar.currentline);+ lua_pushliteral(L, " in ");+ pushfuncname(L, &ar);+ if (ar.istailcall)+ lua_pushliteral(L, "\n\t(...tail calls...)");+ lua_concat(L, lua_gettop(L) - top);+ }+ }+ lua_concat(L, lua_gettop(L) - top);+}++/* }====================================================== */+++/*+** {======================================================+** Error-report functions+** =======================================================+*/++LUALIB_API int luaL_argerror (lua_State *L, int arg, const char *extramsg) {+ lua_Debug ar;+ if (!lua_getstack(L, 0, &ar)) /* no stack frame? */+ return luaL_error(L, "bad argument #%d (%s)", arg, extramsg);+ lua_getinfo(L, "n", &ar);+ if (strcmp(ar.namewhat, "method") == 0) {+ arg--; /* do not count 'self' */+ if (arg == 0) /* error is in the self argument itself? */+ return luaL_error(L, "calling '%s' on bad self (%s)",+ ar.name, extramsg);+ }+ if (ar.name == NULL)+ ar.name = (pushglobalfuncname(L, &ar)) ? lua_tostring(L, -1) : "?";+ return luaL_error(L, "bad argument #%d to '%s' (%s)",+ arg, ar.name, extramsg);+}+++static int typeerror (lua_State *L, int arg, const char *tname) {+ const char *msg;+ const char *typearg; /* name for the type of the actual argument */+ if (luaL_getmetafield(L, arg, "__name") == LUA_TSTRING)+ typearg = lua_tostring(L, -1); /* use the given type name */+ else if (lua_type(L, arg) == LUA_TLIGHTUSERDATA)+ typearg = "light userdata"; /* special name for messages */+ else+ typearg = luaL_typename(L, arg); /* standard name */+ msg = lua_pushfstring(L, "%s expected, got %s", tname, typearg);+ return luaL_argerror(L, arg, msg);+}+++static void tag_error (lua_State *L, int arg, int tag) {+ typeerror(L, arg, lua_typename(L, tag));+}+++/*+** The use of 'lua_pushfstring' ensures this function does not+** need reserved stack space when called.+*/+LUALIB_API void luaL_where (lua_State *L, int level) {+ lua_Debug ar;+ if (lua_getstack(L, level, &ar)) { /* check function at level */+ lua_getinfo(L, "Sl", &ar); /* get info about it */+ if (ar.currentline > 0) { /* is there info? */+ lua_pushfstring(L, "%s:%d: ", ar.short_src, ar.currentline);+ return;+ }+ }+ lua_pushfstring(L, ""); /* else, no information available... */+}+++/*+** Again, the use of 'lua_pushvfstring' ensures this function does+** not need reserved stack space when called. (At worst, it generates+** an error with "stack overflow" instead of the given message.)+*/+LUALIB_API int luaL_error (lua_State *L, const char *fmt, ...) {+ va_list argp;+ va_start(argp, fmt);+ luaL_where(L, 1);+ lua_pushvfstring(L, fmt, argp);+ va_end(argp);+ lua_concat(L, 2);+ return lua_error(L);+}+++LUALIB_API int luaL_fileresult (lua_State *L, int stat, const char *fname) {+ int en = errno; /* calls to Lua API may change this value */+ if (stat) {+ lua_pushboolean(L, 1);+ return 1;+ }+ else {+ lua_pushnil(L);+ if (fname)+ lua_pushfstring(L, "%s: %s", fname, strerror(en));+ else+ lua_pushstring(L, strerror(en));+ lua_pushinteger(L, en);+ return 3;+ }+}+++#if !defined(l_inspectstat) /* { */++#if defined(LUA_USE_POSIX)++#include <sys/wait.h>++/*+** use appropriate macros to interpret 'pclose' return status+*/+#define l_inspectstat(stat,what) \+ if (WIFEXITED(stat)) { stat = WEXITSTATUS(stat); } \+ else if (WIFSIGNALED(stat)) { stat = WTERMSIG(stat); what = "signal"; }++#else++#define l_inspectstat(stat,what) /* no op */++#endif++#endif /* } */+++LUALIB_API int luaL_execresult (lua_State *L, int stat) {+ const char *what = "exit"; /* type of termination */+ if (stat == -1) /* error? */+ return luaL_fileresult(L, 0, NULL);+ else {+ l_inspectstat(stat, what); /* interpret result */+ if (*what == 'e' && stat == 0) /* successful termination? */+ lua_pushboolean(L, 1);+ else+ lua_pushnil(L);+ lua_pushstring(L, what);+ lua_pushinteger(L, stat);+ return 3; /* return true/nil,what,code */+ }+}++/* }====================================================== */+++/*+** {======================================================+** Userdata's metatable manipulation+** =======================================================+*/++LUALIB_API int luaL_newmetatable (lua_State *L, const char *tname) {+ if (luaL_getmetatable(L, tname) != LUA_TNIL) /* name already in use? */+ return 0; /* leave previous value on top, but return 0 */+ lua_pop(L, 1);+ lua_createtable(L, 0, 2); /* create metatable */+ lua_pushstring(L, tname);+ lua_setfield(L, -2, "__name"); /* metatable.__name = tname */+ lua_pushvalue(L, -1);+ lua_setfield(L, LUA_REGISTRYINDEX, tname); /* registry.name = metatable */+ return 1;+}+++LUALIB_API void luaL_setmetatable (lua_State *L, const char *tname) {+ luaL_getmetatable(L, tname);+ lua_setmetatable(L, -2);+}+++LUALIB_API void *luaL_testudata (lua_State *L, int ud, const char *tname) {+ void *p = lua_touserdata(L, ud);+ if (p != NULL) { /* value is a userdata? */+ if (lua_getmetatable(L, ud)) { /* does it have a metatable? */+ luaL_getmetatable(L, tname); /* get correct metatable */+ if (!lua_rawequal(L, -1, -2)) /* not the same? */+ p = NULL; /* value is a userdata with wrong metatable */+ lua_pop(L, 2); /* remove both metatables */+ return p;+ }+ }+ return NULL; /* value is not a userdata with a metatable */+}+++LUALIB_API void *luaL_checkudata (lua_State *L, int ud, const char *tname) {+ void *p = luaL_testudata(L, ud, tname);+ if (p == NULL) typeerror(L, ud, tname);+ return p;+}++/* }====================================================== */+++/*+** {======================================================+** Argument check functions+** =======================================================+*/++LUALIB_API int luaL_checkoption (lua_State *L, int arg, const char *def,+ const char *const lst[]) {+ const char *name = (def) ? luaL_optstring(L, arg, def) :+ luaL_checkstring(L, arg);+ int i;+ for (i=0; lst[i]; i++)+ if (strcmp(lst[i], name) == 0)+ return i;+ return luaL_argerror(L, arg,+ lua_pushfstring(L, "invalid option '%s'", name));+}+++/*+** Ensures the stack has at least 'space' extra slots, raising an error+** if it cannot fulfill the request. (The error handling needs a few+** extra slots to format the error message. In case of an error without+** this extra space, Lua will generate the same 'stack overflow' error,+** but without 'msg'.)+*/+LUALIB_API void luaL_checkstack (lua_State *L, int space, const char *msg) {+ if (!lua_checkstack(L, space)) {+ if (msg)+ luaL_error(L, "stack overflow (%s)", msg);+ else+ luaL_error(L, "stack overflow");+ }+}+++LUALIB_API void luaL_checktype (lua_State *L, int arg, int t) {+ if (lua_type(L, arg) != t)+ tag_error(L, arg, t);+}+++LUALIB_API void luaL_checkany (lua_State *L, int arg) {+ if (lua_type(L, arg) == LUA_TNONE)+ luaL_argerror(L, arg, "value expected");+}+++LUALIB_API const char *luaL_checklstring (lua_State *L, int arg, size_t *len) {+ const char *s = lua_tolstring(L, arg, len);+ if (!s) tag_error(L, arg, LUA_TSTRING);+ return s;+}+++LUALIB_API const char *luaL_optlstring (lua_State *L, int arg,+ const char *def, size_t *len) {+ if (lua_isnoneornil(L, arg)) {+ if (len)+ *len = (def ? strlen(def) : 0);+ return def;+ }+ else return luaL_checklstring(L, arg, len);+}+++LUALIB_API lua_Number luaL_checknumber (lua_State *L, int arg) {+ int isnum;+ lua_Number d = lua_tonumberx(L, arg, &isnum);+ if (!isnum)+ tag_error(L, arg, LUA_TNUMBER);+ return d;+}+++LUALIB_API lua_Number luaL_optnumber (lua_State *L, int arg, lua_Number def) {+ return luaL_opt(L, luaL_checknumber, arg, def);+}+++static void interror (lua_State *L, int arg) {+ if (lua_isnumber(L, arg))+ luaL_argerror(L, arg, "number has no integer representation");+ else+ tag_error(L, arg, LUA_TNUMBER);+}+++LUALIB_API lua_Integer luaL_checkinteger (lua_State *L, int arg) {+ int isnum;+ lua_Integer d = lua_tointegerx(L, arg, &isnum);+ if (!isnum) {+ interror(L, arg);+ }+ return d;+}+++LUALIB_API lua_Integer luaL_optinteger (lua_State *L, int arg,+ lua_Integer def) {+ return luaL_opt(L, luaL_checkinteger, arg, def);+}++/* }====================================================== */+++/*+** {======================================================+** Generic Buffer manipulation+** =======================================================+*/++/* userdata to box arbitrary data */+typedef struct UBox {+ void *box;+ size_t bsize;+} UBox;+++static void *resizebox (lua_State *L, int idx, size_t newsize) {+ void *ud;+ lua_Alloc allocf = lua_getallocf(L, &ud);+ UBox *box = (UBox *)lua_touserdata(L, idx);+ void *temp = allocf(ud, box->box, box->bsize, newsize);+ if (temp == NULL && newsize > 0) { /* allocation error? */+ resizebox(L, idx, 0); /* free buffer */+ luaL_error(L, "not enough memory for buffer allocation");+ }+ box->box = temp;+ box->bsize = newsize;+ return temp;+}+++static int boxgc (lua_State *L) {+ resizebox(L, 1, 0);+ return 0;+}+++static void *newbox (lua_State *L, size_t newsize) {+ UBox *box = (UBox *)lua_newuserdata(L, sizeof(UBox));+ box->box = NULL;+ box->bsize = 0;+ if (luaL_newmetatable(L, "LUABOX")) { /* creating metatable? */+ lua_pushcfunction(L, boxgc);+ lua_setfield(L, -2, "__gc"); /* metatable.__gc = boxgc */+ }+ lua_setmetatable(L, -2);+ return resizebox(L, -1, newsize);+}+++/*+** check whether buffer is using a userdata on the stack as a temporary+** buffer+*/+#define buffonstack(B) ((B)->b != (B)->initb)+++/*+** returns a pointer to a free area with at least 'sz' bytes+*/+LUALIB_API char *luaL_prepbuffsize (luaL_Buffer *B, size_t sz) {+ lua_State *L = B->L;+ if (B->size - B->n < sz) { /* not enough space? */+ char *newbuff;+ size_t newsize = B->size * 2; /* double buffer size */+ if (newsize - B->n < sz) /* not big enough? */+ newsize = B->n + sz;+ if (newsize < B->n || newsize - B->n < sz)+ luaL_error(L, "buffer too large");+ /* create larger buffer */+ if (buffonstack(B))+ newbuff = (char *)resizebox(L, -1, newsize);+ else { /* no buffer yet */+ newbuff = (char *)newbox(L, newsize);+ memcpy(newbuff, B->b, B->n * sizeof(char)); /* copy original content */+ }+ B->b = newbuff;+ B->size = newsize;+ }+ return &B->b[B->n];+}+++LUALIB_API void luaL_addlstring (luaL_Buffer *B, const char *s, size_t l) {+ if (l > 0) { /* avoid 'memcpy' when 's' can be NULL */+ char *b = luaL_prepbuffsize(B, l);+ memcpy(b, s, l * sizeof(char));+ luaL_addsize(B, l);+ }+}+++LUALIB_API void luaL_addstring (luaL_Buffer *B, const char *s) {+ luaL_addlstring(B, s, strlen(s));+}+++LUALIB_API void luaL_pushresult (luaL_Buffer *B) {+ lua_State *L = B->L;+ lua_pushlstring(L, B->b, B->n);+ if (buffonstack(B)) {+ resizebox(L, -2, 0); /* delete old buffer */+ lua_remove(L, -2); /* remove its header from the stack */+ }+}+++LUALIB_API void luaL_pushresultsize (luaL_Buffer *B, size_t sz) {+ luaL_addsize(B, sz);+ luaL_pushresult(B);+}+++LUALIB_API void luaL_addvalue (luaL_Buffer *B) {+ lua_State *L = B->L;+ size_t l;+ const char *s = lua_tolstring(L, -1, &l);+ if (buffonstack(B))+ lua_insert(L, -2); /* put value below buffer */+ luaL_addlstring(B, s, l);+ lua_remove(L, (buffonstack(B)) ? -2 : -1); /* remove value */+}+++LUALIB_API void luaL_buffinit (lua_State *L, luaL_Buffer *B) {+ B->L = L;+ B->b = B->initb;+ B->n = 0;+ B->size = LUAL_BUFFERSIZE;+}+++LUALIB_API char *luaL_buffinitsize (lua_State *L, luaL_Buffer *B, size_t sz) {+ luaL_buffinit(L, B);+ return luaL_prepbuffsize(B, sz);+}++/* }====================================================== */+++/*+** {======================================================+** Reference system+** =======================================================+*/++/* index of free-list header */+#define freelist 0+++LUALIB_API int luaL_ref (lua_State *L, int t) {+ int ref;+ if (lua_isnil(L, -1)) {+ lua_pop(L, 1); /* remove from stack */+ return LUA_REFNIL; /* 'nil' has a unique fixed reference */+ }+ t = lua_absindex(L, t);+ lua_rawgeti(L, t, freelist); /* get first free element */+ ref = (int)lua_tointeger(L, -1); /* ref = t[freelist] */+ lua_pop(L, 1); /* remove it from stack */+ if (ref != 0) { /* any free element? */+ lua_rawgeti(L, t, ref); /* remove it from list */+ lua_rawseti(L, t, freelist); /* (t[freelist] = t[ref]) */+ }+ else /* no free elements */+ ref = (int)lua_rawlen(L, t) + 1; /* get a new reference */+ lua_rawseti(L, t, ref);+ return ref;+}+++LUALIB_API void luaL_unref (lua_State *L, int t, int ref) {+ if (ref >= 0) {+ t = lua_absindex(L, t);+ lua_rawgeti(L, t, freelist);+ lua_rawseti(L, t, ref); /* t[ref] = t[freelist] */+ lua_pushinteger(L, ref);+ lua_rawseti(L, t, freelist); /* t[freelist] = ref */+ }+}++/* }====================================================== */+++/*+** {======================================================+** Load functions+** =======================================================+*/++typedef struct LoadF {+ int n; /* number of pre-read characters */+ FILE *f; /* file being read */+ char buff[BUFSIZ]; /* area for reading file */+} LoadF;+++static const char *getF (lua_State *L, void *ud, size_t *size) {+ LoadF *lf = (LoadF *)ud;+ (void)L; /* not used */+ if (lf->n > 0) { /* are there pre-read characters to be read? */+ *size = lf->n; /* return them (chars already in buffer) */+ lf->n = 0; /* no more pre-read characters */+ }+ else { /* read a block from file */+ /* 'fread' can return > 0 *and* set the EOF flag. If next call to+ 'getF' called 'fread', it might still wait for user input.+ The next check avoids this problem. */+ if (feof(lf->f)) return NULL;+ *size = fread(lf->buff, 1, sizeof(lf->buff), lf->f); /* read block */+ }+ return lf->buff;+}+++static int errfile (lua_State *L, const char *what, int fnameindex) {+ const char *serr = strerror(errno);+ const char *filename = lua_tostring(L, fnameindex) + 1;+ lua_pushfstring(L, "cannot %s %s: %s", what, filename, serr);+ lua_remove(L, fnameindex);+ return LUA_ERRFILE;+}+++static int skipBOM (LoadF *lf) {+ const char *p = "\xEF\xBB\xBF"; /* UTF-8 BOM mark */+ int c;+ lf->n = 0;+ do {+ c = getc(lf->f);+ if (c == EOF || c != *(const unsigned char *)p++) return c;+ lf->buff[lf->n++] = c; /* to be read by the parser */+ } while (*p != '\0');+ lf->n = 0; /* prefix matched; discard it */+ return getc(lf->f); /* return next character */+}+++/*+** reads the first character of file 'f' and skips an optional BOM mark+** in its beginning plus its first line if it starts with '#'. Returns+** true if it skipped the first line. In any case, '*cp' has the+** first "valid" character of the file (after the optional BOM and+** a first-line comment).+*/+static int skipcomment (LoadF *lf, int *cp) {+ int c = *cp = skipBOM(lf);+ if (c == '#') { /* first line is a comment (Unix exec. file)? */+ do { /* skip first line */+ c = getc(lf->f);+ } while (c != EOF && c != '\n');+ *cp = getc(lf->f); /* skip end-of-line, if present */+ return 1; /* there was a comment */+ }+ else return 0; /* no comment */+}+++LUALIB_API int luaL_loadfilex (lua_State *L, const char *filename,+ const char *mode) {+ LoadF lf;+ int status, readstatus;+ int c;+ int fnameindex = lua_gettop(L) + 1; /* index of filename on the stack */+ if (filename == NULL) {+ lua_pushliteral(L, "=stdin");+ lf.f = stdin;+ }+ else {+ lua_pushfstring(L, "@%s", filename);+ lf.f = fopen(filename, "r");+ if (lf.f == NULL) return errfile(L, "open", fnameindex);+ }+ if (skipcomment(&lf, &c)) /* read initial portion */+ lf.buff[lf.n++] = '\n'; /* add line to correct line numbers */+ if (c == LUA_SIGNATURE[0] && filename) { /* binary file? */+ lf.f = freopen(filename, "rb", lf.f); /* reopen in binary mode */+ if (lf.f == NULL) return errfile(L, "reopen", fnameindex);+ skipcomment(&lf, &c); /* re-read initial portion */+ }+ if (c != EOF)+ lf.buff[lf.n++] = c; /* 'c' is the first character of the stream */+ status = lua_load(L, getF, &lf, lua_tostring(L, -1), mode);+ readstatus = ferror(lf.f);+ if (filename) fclose(lf.f); /* close file (even in case of errors) */+ if (readstatus) {+ lua_settop(L, fnameindex); /* ignore results from 'lua_load' */+ return errfile(L, "read", fnameindex);+ }+ lua_remove(L, fnameindex);+ return status;+}+++typedef struct LoadS {+ const char *s;+ size_t size;+} LoadS;+++static const char *getS (lua_State *L, void *ud, size_t *size) {+ LoadS *ls = (LoadS *)ud;+ (void)L; /* not used */+ if (ls->size == 0) return NULL;+ *size = ls->size;+ ls->size = 0;+ return ls->s;+}+++LUALIB_API int luaL_loadbufferx (lua_State *L, const char *buff, size_t size,+ const char *name, const char *mode) {+ LoadS ls;+ ls.s = buff;+ ls.size = size;+ return lua_load(L, getS, &ls, name, mode);+}+++LUALIB_API int luaL_loadstring (lua_State *L, const char *s) {+ return luaL_loadbuffer(L, s, strlen(s), s);+}++/* }====================================================== */++++LUALIB_API int luaL_getmetafield (lua_State *L, int obj, const char *event) {+ if (!lua_getmetatable(L, obj)) /* no metatable? */+ return LUA_TNIL;+ else {+ int tt;+ lua_pushstring(L, event);+ tt = lua_rawget(L, -2);+ if (tt == LUA_TNIL) /* is metafield nil? */+ lua_pop(L, 2); /* remove metatable and metafield */+ else+ lua_remove(L, -2); /* remove only metatable */+ return tt; /* return metafield type */+ }+}+++LUALIB_API int luaL_callmeta (lua_State *L, int obj, const char *event) {+ obj = lua_absindex(L, obj);+ if (luaL_getmetafield(L, obj, event) == LUA_TNIL) /* no metafield? */+ return 0;+ lua_pushvalue(L, obj);+ lua_call(L, 1, 1);+ return 1;+}+++LUALIB_API lua_Integer luaL_len (lua_State *L, int idx) {+ lua_Integer l;+ int isnum;+ lua_len(L, idx);+ l = lua_tointegerx(L, -1, &isnum);+ if (!isnum)+ luaL_error(L, "object length is not an integer");+ lua_pop(L, 1); /* remove object */+ return l;+}+++LUALIB_API const char *luaL_tolstring (lua_State *L, int idx, size_t *len) {+ if (luaL_callmeta(L, idx, "__tostring")) { /* metafield? */+ if (!lua_isstring(L, -1))+ luaL_error(L, "'__tostring' must return a string");+ }+ else {+ switch (lua_type(L, idx)) {+ case LUA_TNUMBER: {+ if (lua_isinteger(L, idx))+ lua_pushfstring(L, "%I", (LUAI_UACINT)lua_tointeger(L, idx));+ else+ lua_pushfstring(L, "%f", (LUAI_UACNUMBER)lua_tonumber(L, idx));+ break;+ }+ case LUA_TSTRING:+ lua_pushvalue(L, idx);+ break;+ case LUA_TBOOLEAN:+ lua_pushstring(L, (lua_toboolean(L, idx) ? "true" : "false"));+ break;+ case LUA_TNIL:+ lua_pushliteral(L, "nil");+ break;+ default: {+ int tt = luaL_getmetafield(L, idx, "__name"); /* try name */+ const char *kind = (tt == LUA_TSTRING) ? lua_tostring(L, -1) :+ luaL_typename(L, idx);+ lua_pushfstring(L, "%s: %p", kind, lua_topointer(L, idx));+ if (tt != LUA_TNIL)+ lua_remove(L, -2); /* remove '__name' */+ break;+ }+ }+ }+ return lua_tolstring(L, -1, len);+}+++/*+** {======================================================+** Compatibility with 5.1 module functions+** =======================================================+*/+#if defined(LUA_COMPAT_MODULE)++static const char *luaL_findtable (lua_State *L, int idx,+ const char *fname, int szhint) {+ const char *e;+ if (idx) lua_pushvalue(L, idx);+ do {+ e = strchr(fname, '.');+ if (e == NULL) e = fname + strlen(fname);+ lua_pushlstring(L, fname, e - fname);+ if (lua_rawget(L, -2) == LUA_TNIL) { /* no such field? */+ lua_pop(L, 1); /* remove this nil */+ lua_createtable(L, 0, (*e == '.' ? 1 : szhint)); /* new table for field */+ lua_pushlstring(L, fname, e - fname);+ lua_pushvalue(L, -2);+ lua_settable(L, -4); /* set new table into field */+ }+ else if (!lua_istable(L, -1)) { /* field has a non-table value? */+ lua_pop(L, 2); /* remove table and value */+ return fname; /* return problematic part of the name */+ }+ lua_remove(L, -2); /* remove previous table */+ fname = e + 1;+ } while (*e == '.');+ return NULL;+}+++/*+** Count number of elements in a luaL_Reg list.+*/+static int libsize (const luaL_Reg *l) {+ int size = 0;+ for (; l && l->name; l++) size++;+ return size;+}+++/*+** Find or create a module table with a given name. The function+** first looks at the LOADED table and, if that fails, try a+** global variable with that name. In any case, leaves on the stack+** the module table.+*/+LUALIB_API void luaL_pushmodule (lua_State *L, const char *modname,+ int sizehint) {+ luaL_findtable(L, LUA_REGISTRYINDEX, LUA_LOADED_TABLE, 1);+ if (lua_getfield(L, -1, modname) != LUA_TTABLE) { /* no LOADED[modname]? */+ lua_pop(L, 1); /* remove previous result */+ /* try global variable (and create one if it does not exist) */+ lua_pushglobaltable(L);+ if (luaL_findtable(L, 0, modname, sizehint) != NULL)+ luaL_error(L, "name conflict for module '%s'", modname);+ lua_pushvalue(L, -1);+ lua_setfield(L, -3, modname); /* LOADED[modname] = new table */+ }+ lua_remove(L, -2); /* remove LOADED table */+}+++LUALIB_API void luaL_openlib (lua_State *L, const char *libname,+ const luaL_Reg *l, int nup) {+ luaL_checkversion(L);+ if (libname) {+ luaL_pushmodule(L, libname, libsize(l)); /* get/create library table */+ lua_insert(L, -(nup + 1)); /* move library table to below upvalues */+ }+ if (l)+ luaL_setfuncs(L, l, nup);+ else+ lua_pop(L, nup); /* remove upvalues */+}++#endif+/* }====================================================== */++/*+** set functions from list 'l' into table at top - 'nup'; each+** function gets the 'nup' elements at the top as upvalues.+** Returns with only the table at the stack.+*/+LUALIB_API void luaL_setfuncs (lua_State *L, const luaL_Reg *l, int nup) {+ luaL_checkstack(L, nup, "too many upvalues");+ for (; l->name != NULL; l++) { /* fill the table with given functions */+ int i;+ for (i = 0; i < nup; i++) /* copy upvalues to the top */+ lua_pushvalue(L, -nup);+ lua_pushcclosure(L, l->func, nup); /* closure with those upvalues */+ lua_setfield(L, -(nup + 2), l->name);+ }+ lua_pop(L, nup); /* remove upvalues */+}+++/*+** ensure that stack[idx][fname] has a table and push that table+** into the stack+*/+LUALIB_API int luaL_getsubtable (lua_State *L, int idx, const char *fname) {+ if (lua_getfield(L, idx, fname) == LUA_TTABLE)+ return 1; /* table already there */+ else {+ lua_pop(L, 1); /* remove previous result */+ idx = lua_absindex(L, idx);+ lua_newtable(L);+ lua_pushvalue(L, -1); /* copy to be left at top */+ lua_setfield(L, idx, fname); /* assign new table to field */+ return 0; /* false, because did not find table there */+ }+}+++/*+** Stripped-down 'require': After checking "loaded" table, calls 'openf'+** to open a module, registers the result in 'package.loaded' table and,+** if 'glb' is true, also registers the result in the global table.+** Leaves resulting module on the top.+*/+LUALIB_API void luaL_requiref (lua_State *L, const char *modname,+ lua_CFunction openf, int glb) {+ luaL_getsubtable(L, LUA_REGISTRYINDEX, LUA_LOADED_TABLE);+ lua_getfield(L, -1, modname); /* LOADED[modname] */+ if (!lua_toboolean(L, -1)) { /* package not already loaded? */+ lua_pop(L, 1); /* remove field */+ lua_pushcfunction(L, openf);+ lua_pushstring(L, modname); /* argument to open function */+ lua_call(L, 1, 1); /* call 'openf' to open module */+ lua_pushvalue(L, -1); /* make copy of module (call result) */+ lua_setfield(L, -3, modname); /* LOADED[modname] = module */+ }+ lua_remove(L, -2); /* remove LOADED table */+ if (glb) {+ lua_pushvalue(L, -1); /* copy of module */+ lua_setglobal(L, modname); /* _G[modname] = module */+ }+}+++LUALIB_API const char *luaL_gsub (lua_State *L, const char *s, const char *p,+ const char *r) {+ const char *wild;+ size_t l = strlen(p);+ luaL_Buffer b;+ luaL_buffinit(L, &b);+ while ((wild = strstr(s, p)) != NULL) {+ luaL_addlstring(&b, s, wild - s); /* push prefix */+ luaL_addstring(&b, r); /* push replacement in place of pattern */+ s = wild + l; /* continue after 'p' */+ }+ luaL_addstring(&b, s); /* push last suffix */+ luaL_pushresult(&b);+ return lua_tostring(L, -1);+}+++static void *l_alloc (void *ud, void *ptr, size_t osize, size_t nsize) {+ (void)ud; (void)osize; /* not used */+ if (nsize == 0) {+ free(ptr);+ return NULL;+ }+ else { /* cannot fail when shrinking a block */+ void *newptr = realloc(ptr, nsize);+ if (newptr == NULL && ptr != NULL && nsize <= osize)+ return ptr; /* keep the original block */+ else /* no fail or not shrinking */+ return newptr; /* use the new block */+ }+}+++static int panic (lua_State *L) {+ lua_writestringerror("PANIC: unprotected error in call to Lua API (%s)\n",+ lua_tostring(L, -1));+ return 0; /* return to Lua to abort */+}+++LUALIB_API lua_State *luaL_newstate (void) {+ lua_State *L = lua_newstate(l_alloc, NULL);+ if (L) lua_atpanic(L, &panic);+ return L;+}+++LUALIB_API void luaL_checkversion_ (lua_State *L, lua_Number ver, size_t sz) {+ const lua_Number *v = lua_version(L);+ if (sz != LUAL_NUMSIZES) /* check numeric types */+ luaL_error(L, "core and library have incompatible numeric types");+ if (v != lua_version(NULL))+ luaL_error(L, "multiple Lua VMs detected");+ else if (*v != ver)+ luaL_error(L, "version mismatch: app. needs %f, Lua core provides %f",+ (LUAI_UACNUMBER)ver, (LUAI_UACNUMBER)*v);+}+
+ cbits/lua-5.3.6/lauxlib.h view
@@ -0,0 +1,264 @@+/*+** $Id: lauxlib.h,v 1.131.1.1 2017/04/19 17:20:42 roberto Exp $+** Auxiliary functions for building Lua libraries+** See Copyright Notice in lua.h+*/+++#ifndef lauxlib_h+#define lauxlib_h+++#include <stddef.h>+#include <stdio.h>++#include "lua.h"++++/* extra error code for 'luaL_loadfilex' */+#define LUA_ERRFILE (LUA_ERRERR+1)+++/* key, in the registry, for table of loaded modules */+#define LUA_LOADED_TABLE "_LOADED"+++/* key, in the registry, for table of preloaded loaders */+#define LUA_PRELOAD_TABLE "_PRELOAD"+++typedef struct luaL_Reg {+ const char *name;+ lua_CFunction func;+} luaL_Reg;+++#define LUAL_NUMSIZES (sizeof(lua_Integer)*16 + sizeof(lua_Number))++LUALIB_API void (luaL_checkversion_) (lua_State *L, lua_Number ver, size_t sz);+#define luaL_checkversion(L) \+ luaL_checkversion_(L, LUA_VERSION_NUM, LUAL_NUMSIZES)++LUALIB_API int (luaL_getmetafield) (lua_State *L, int obj, const char *e);+LUALIB_API int (luaL_callmeta) (lua_State *L, int obj, const char *e);+LUALIB_API const char *(luaL_tolstring) (lua_State *L, int idx, size_t *len);+LUALIB_API int (luaL_argerror) (lua_State *L, int arg, const char *extramsg);+LUALIB_API const char *(luaL_checklstring) (lua_State *L, int arg,+ size_t *l);+LUALIB_API const char *(luaL_optlstring) (lua_State *L, int arg,+ const char *def, size_t *l);+LUALIB_API lua_Number (luaL_checknumber) (lua_State *L, int arg);+LUALIB_API lua_Number (luaL_optnumber) (lua_State *L, int arg, lua_Number def);++LUALIB_API lua_Integer (luaL_checkinteger) (lua_State *L, int arg);+LUALIB_API lua_Integer (luaL_optinteger) (lua_State *L, int arg,+ lua_Integer def);++LUALIB_API void (luaL_checkstack) (lua_State *L, int sz, const char *msg);+LUALIB_API void (luaL_checktype) (lua_State *L, int arg, int t);+LUALIB_API void (luaL_checkany) (lua_State *L, int arg);++LUALIB_API int (luaL_newmetatable) (lua_State *L, const char *tname);+LUALIB_API void (luaL_setmetatable) (lua_State *L, const char *tname);+LUALIB_API void *(luaL_testudata) (lua_State *L, int ud, const char *tname);+LUALIB_API void *(luaL_checkudata) (lua_State *L, int ud, const char *tname);++LUALIB_API void (luaL_where) (lua_State *L, int lvl);+LUALIB_API int (luaL_error) (lua_State *L, const char *fmt, ...);++LUALIB_API int (luaL_checkoption) (lua_State *L, int arg, const char *def,+ const char *const lst[]);++LUALIB_API int (luaL_fileresult) (lua_State *L, int stat, const char *fname);+LUALIB_API int (luaL_execresult) (lua_State *L, int stat);++/* predefined references */+#define LUA_NOREF (-2)+#define LUA_REFNIL (-1)++LUALIB_API int (luaL_ref) (lua_State *L, int t);+LUALIB_API void (luaL_unref) (lua_State *L, int t, int ref);++LUALIB_API int (luaL_loadfilex) (lua_State *L, const char *filename,+ const char *mode);++#define luaL_loadfile(L,f) luaL_loadfilex(L,f,NULL)++LUALIB_API int (luaL_loadbufferx) (lua_State *L, const char *buff, size_t sz,+ const char *name, const char *mode);+LUALIB_API int (luaL_loadstring) (lua_State *L, const char *s);++LUALIB_API lua_State *(luaL_newstate) (void);++LUALIB_API lua_Integer (luaL_len) (lua_State *L, int idx);++LUALIB_API const char *(luaL_gsub) (lua_State *L, const char *s, const char *p,+ const char *r);++LUALIB_API void (luaL_setfuncs) (lua_State *L, const luaL_Reg *l, int nup);++LUALIB_API int (luaL_getsubtable) (lua_State *L, int idx, const char *fname);++LUALIB_API void (luaL_traceback) (lua_State *L, lua_State *L1,+ const char *msg, int level);++LUALIB_API void (luaL_requiref) (lua_State *L, const char *modname,+ lua_CFunction openf, int glb);++/*+** ===============================================================+** some useful macros+** ===============================================================+*/+++#define luaL_newlibtable(L,l) \+ lua_createtable(L, 0, sizeof(l)/sizeof((l)[0]) - 1)++#define luaL_newlib(L,l) \+ (luaL_checkversion(L), luaL_newlibtable(L,l), luaL_setfuncs(L,l,0))++#define luaL_argcheck(L, cond,arg,extramsg) \+ ((void)((cond) || luaL_argerror(L, (arg), (extramsg))))+#define luaL_checkstring(L,n) (luaL_checklstring(L, (n), NULL))+#define luaL_optstring(L,n,d) (luaL_optlstring(L, (n), (d), NULL))++#define luaL_typename(L,i) lua_typename(L, lua_type(L,(i)))++#define luaL_dofile(L, fn) \+ (luaL_loadfile(L, fn) || lua_pcall(L, 0, LUA_MULTRET, 0))++#define luaL_dostring(L, s) \+ (luaL_loadstring(L, s) || lua_pcall(L, 0, LUA_MULTRET, 0))++#define luaL_getmetatable(L,n) (lua_getfield(L, LUA_REGISTRYINDEX, (n)))++#define luaL_opt(L,f,n,d) (lua_isnoneornil(L,(n)) ? (d) : f(L,(n)))++#define luaL_loadbuffer(L,s,sz,n) luaL_loadbufferx(L,s,sz,n,NULL)+++/*+** {======================================================+** Generic Buffer manipulation+** =======================================================+*/++typedef struct luaL_Buffer {+ char *b; /* buffer address */+ size_t size; /* buffer size */+ size_t n; /* number of characters in buffer */+ lua_State *L;+ char initb[LUAL_BUFFERSIZE]; /* initial buffer */+} luaL_Buffer;+++#define luaL_addchar(B,c) \+ ((void)((B)->n < (B)->size || luaL_prepbuffsize((B), 1)), \+ ((B)->b[(B)->n++] = (c)))++#define luaL_addsize(B,s) ((B)->n += (s))++LUALIB_API void (luaL_buffinit) (lua_State *L, luaL_Buffer *B);+LUALIB_API char *(luaL_prepbuffsize) (luaL_Buffer *B, size_t sz);+LUALIB_API void (luaL_addlstring) (luaL_Buffer *B, const char *s, size_t l);+LUALIB_API void (luaL_addstring) (luaL_Buffer *B, const char *s);+LUALIB_API void (luaL_addvalue) (luaL_Buffer *B);+LUALIB_API void (luaL_pushresult) (luaL_Buffer *B);+LUALIB_API void (luaL_pushresultsize) (luaL_Buffer *B, size_t sz);+LUALIB_API char *(luaL_buffinitsize) (lua_State *L, luaL_Buffer *B, size_t sz);++#define luaL_prepbuffer(B) luaL_prepbuffsize(B, LUAL_BUFFERSIZE)++/* }====================================================== */++++/*+** {======================================================+** File handles for IO library+** =======================================================+*/++/*+** A file handle is a userdata with metatable 'LUA_FILEHANDLE' and+** initial structure 'luaL_Stream' (it may contain other fields+** after that initial structure).+*/++#define LUA_FILEHANDLE "FILE*"+++typedef struct luaL_Stream {+ FILE *f; /* stream (NULL for incompletely created streams) */+ lua_CFunction closef; /* to close stream (NULL for closed streams) */+} luaL_Stream;++/* }====================================================== */++++/* compatibility with old module system */+#if defined(LUA_COMPAT_MODULE)++LUALIB_API void (luaL_pushmodule) (lua_State *L, const char *modname,+ int sizehint);+LUALIB_API void (luaL_openlib) (lua_State *L, const char *libname,+ const luaL_Reg *l, int nup);++#define luaL_register(L,n,l) (luaL_openlib(L,(n),(l),0))++#endif+++/*+** {==================================================================+** "Abstraction Layer" for basic report of messages and errors+** ===================================================================+*/++/* print a string */+#if !defined(lua_writestring)+#define lua_writestring(s,l) fwrite((s), sizeof(char), (l), stdout)+#endif++/* print a newline and flush the output */+#if !defined(lua_writeline)+#define lua_writeline() (lua_writestring("\n", 1), fflush(stdout))+#endif++/* print an error message */+#if !defined(lua_writestringerror)+#define lua_writestringerror(s,p) \+ (fprintf(stderr, (s), (p)), fflush(stderr))+#endif++/* }================================================================== */+++/*+** {============================================================+** Compatibility with deprecated conversions+** =============================================================+*/+#if defined(LUA_COMPAT_APIINTCASTS)++#define luaL_checkunsigned(L,a) ((lua_Unsigned)luaL_checkinteger(L,a))+#define luaL_optunsigned(L,a,d) \+ ((lua_Unsigned)luaL_optinteger(L,a,(lua_Integer)(d)))++#define luaL_checkint(L,n) ((int)luaL_checkinteger(L, (n)))+#define luaL_optint(L,n,d) ((int)luaL_optinteger(L, (n), (d)))++#define luaL_checklong(L,n) ((long)luaL_checkinteger(L, (n)))+#define luaL_optlong(L,n,d) ((long)luaL_optinteger(L, (n), (d)))++#endif+/* }============================================================ */++++#endif++
+ cbits/lua-5.3.6/lbaselib.c view
@@ -0,0 +1,498 @@+/*+** $Id: lbaselib.c,v 1.314.1.1 2017/04/19 17:39:34 roberto Exp $+** Basic library+** See Copyright Notice in lua.h+*/++#define lbaselib_c+#define LUA_LIB++#include "lprefix.h"+++#include <ctype.h>+#include <stdio.h>+#include <stdlib.h>+#include <string.h>++#include "lua.h"++#include "lauxlib.h"+#include "lualib.h"+++static int luaB_print (lua_State *L) {+ int n = lua_gettop(L); /* number of arguments */+ int i;+ lua_getglobal(L, "tostring");+ for (i=1; i<=n; i++) {+ const char *s;+ size_t l;+ lua_pushvalue(L, -1); /* function to be called */+ lua_pushvalue(L, i); /* value to print */+ lua_call(L, 1, 1);+ s = lua_tolstring(L, -1, &l); /* get result */+ if (s == NULL)+ return luaL_error(L, "'tostring' must return a string to 'print'");+ if (i>1) lua_writestring("\t", 1);+ lua_writestring(s, l);+ lua_pop(L, 1); /* pop result */+ }+ lua_writeline();+ return 0;+}+++#define SPACECHARS " \f\n\r\t\v"++static const char *b_str2int (const char *s, int base, lua_Integer *pn) {+ lua_Unsigned n = 0;+ int neg = 0;+ s += strspn(s, SPACECHARS); /* skip initial spaces */+ if (*s == '-') { s++; neg = 1; } /* handle signal */+ else if (*s == '+') s++;+ if (!isalnum((unsigned char)*s)) /* no digit? */+ return NULL;+ do {+ int digit = (isdigit((unsigned char)*s)) ? *s - '0'+ : (toupper((unsigned char)*s) - 'A') + 10;+ if (digit >= base) return NULL; /* invalid numeral */+ n = n * base + digit;+ s++;+ } while (isalnum((unsigned char)*s));+ s += strspn(s, SPACECHARS); /* skip trailing spaces */+ *pn = (lua_Integer)((neg) ? (0u - n) : n);+ return s;+}+++static int luaB_tonumber (lua_State *L) {+ if (lua_isnoneornil(L, 2)) { /* standard conversion? */+ luaL_checkany(L, 1);+ if (lua_type(L, 1) == LUA_TNUMBER) { /* already a number? */+ lua_settop(L, 1); /* yes; return it */+ return 1;+ }+ else {+ size_t l;+ const char *s = lua_tolstring(L, 1, &l);+ if (s != NULL && lua_stringtonumber(L, s) == l + 1)+ return 1; /* successful conversion to number */+ /* else not a number */+ }+ }+ else {+ size_t l;+ const char *s;+ lua_Integer n = 0; /* to avoid warnings */+ lua_Integer base = luaL_checkinteger(L, 2);+ luaL_checktype(L, 1, LUA_TSTRING); /* no numbers as strings */+ s = lua_tolstring(L, 1, &l);+ luaL_argcheck(L, 2 <= base && base <= 36, 2, "base out of range");+ if (b_str2int(s, (int)base, &n) == s + l) {+ lua_pushinteger(L, n);+ return 1;+ } /* else not a number */+ } /* else not a number */+ lua_pushnil(L); /* not a number */+ return 1;+}+++static int luaB_error (lua_State *L) {+ int level = (int)luaL_optinteger(L, 2, 1);+ lua_settop(L, 1);+ if (lua_type(L, 1) == LUA_TSTRING && level > 0) {+ luaL_where(L, level); /* add extra information */+ lua_pushvalue(L, 1);+ lua_concat(L, 2);+ }+ return lua_error(L);+}+++static int luaB_getmetatable (lua_State *L) {+ luaL_checkany(L, 1);+ if (!lua_getmetatable(L, 1)) {+ lua_pushnil(L);+ return 1; /* no metatable */+ }+ luaL_getmetafield(L, 1, "__metatable");+ return 1; /* returns either __metatable field (if present) or metatable */+}+++static int luaB_setmetatable (lua_State *L) {+ int t = lua_type(L, 2);+ luaL_checktype(L, 1, LUA_TTABLE);+ luaL_argcheck(L, t == LUA_TNIL || t == LUA_TTABLE, 2,+ "nil or table expected");+ if (luaL_getmetafield(L, 1, "__metatable") != LUA_TNIL)+ return luaL_error(L, "cannot change a protected metatable");+ lua_settop(L, 2);+ lua_setmetatable(L, 1);+ return 1;+}+++static int luaB_rawequal (lua_State *L) {+ luaL_checkany(L, 1);+ luaL_checkany(L, 2);+ lua_pushboolean(L, lua_rawequal(L, 1, 2));+ return 1;+}+++static int luaB_rawlen (lua_State *L) {+ int t = lua_type(L, 1);+ luaL_argcheck(L, t == LUA_TTABLE || t == LUA_TSTRING, 1,+ "table or string expected");+ lua_pushinteger(L, lua_rawlen(L, 1));+ return 1;+}+++static int luaB_rawget (lua_State *L) {+ luaL_checktype(L, 1, LUA_TTABLE);+ luaL_checkany(L, 2);+ lua_settop(L, 2);+ lua_rawget(L, 1);+ return 1;+}++static int luaB_rawset (lua_State *L) {+ luaL_checktype(L, 1, LUA_TTABLE);+ luaL_checkany(L, 2);+ luaL_checkany(L, 3);+ lua_settop(L, 3);+ lua_rawset(L, 1);+ return 1;+}+++static int luaB_collectgarbage (lua_State *L) {+ static const char *const opts[] = {"stop", "restart", "collect",+ "count", "step", "setpause", "setstepmul",+ "isrunning", NULL};+ static const int optsnum[] = {LUA_GCSTOP, LUA_GCRESTART, LUA_GCCOLLECT,+ LUA_GCCOUNT, LUA_GCSTEP, LUA_GCSETPAUSE, LUA_GCSETSTEPMUL,+ LUA_GCISRUNNING};+ int o = optsnum[luaL_checkoption(L, 1, "collect", opts)];+ int ex = (int)luaL_optinteger(L, 2, 0);+ int res = lua_gc(L, o, ex);+ switch (o) {+ case LUA_GCCOUNT: {+ int b = lua_gc(L, LUA_GCCOUNTB, 0);+ lua_pushnumber(L, (lua_Number)res + ((lua_Number)b/1024));+ return 1;+ }+ case LUA_GCSTEP: case LUA_GCISRUNNING: {+ lua_pushboolean(L, res);+ return 1;+ }+ default: {+ lua_pushinteger(L, res);+ return 1;+ }+ }+}+++static int luaB_type (lua_State *L) {+ int t = lua_type(L, 1);+ luaL_argcheck(L, t != LUA_TNONE, 1, "value expected");+ lua_pushstring(L, lua_typename(L, t));+ return 1;+}+++static int pairsmeta (lua_State *L, const char *method, int iszero,+ lua_CFunction iter) {+ luaL_checkany(L, 1);+ if (luaL_getmetafield(L, 1, method) == LUA_TNIL) { /* no metamethod? */+ lua_pushcfunction(L, iter); /* will return generator, */+ lua_pushvalue(L, 1); /* state, */+ if (iszero) lua_pushinteger(L, 0); /* and initial value */+ else lua_pushnil(L);+ }+ else {+ lua_pushvalue(L, 1); /* argument 'self' to metamethod */+ lua_call(L, 1, 3); /* get 3 values from metamethod */+ }+ return 3;+}+++static int luaB_next (lua_State *L) {+ luaL_checktype(L, 1, LUA_TTABLE);+ lua_settop(L, 2); /* create a 2nd argument if there isn't one */+ if (lua_next(L, 1))+ return 2;+ else {+ lua_pushnil(L);+ return 1;+ }+}+++static int luaB_pairs (lua_State *L) {+ return pairsmeta(L, "__pairs", 0, luaB_next);+}+++/*+** Traversal function for 'ipairs'+*/+static int ipairsaux (lua_State *L) {+ lua_Integer i = luaL_checkinteger(L, 2) + 1;+ lua_pushinteger(L, i);+ return (lua_geti(L, 1, i) == LUA_TNIL) ? 1 : 2;+}+++/*+** 'ipairs' function. Returns 'ipairsaux', given "table", 0.+** (The given "table" may not be a table.)+*/+static int luaB_ipairs (lua_State *L) {+#if defined(LUA_COMPAT_IPAIRS)+ return pairsmeta(L, "__ipairs", 1, ipairsaux);+#else+ luaL_checkany(L, 1);+ lua_pushcfunction(L, ipairsaux); /* iteration function */+ lua_pushvalue(L, 1); /* state */+ lua_pushinteger(L, 0); /* initial value */+ return 3;+#endif+}+++static int load_aux (lua_State *L, int status, int envidx) {+ if (status == LUA_OK) {+ if (envidx != 0) { /* 'env' parameter? */+ lua_pushvalue(L, envidx); /* environment for loaded function */+ if (!lua_setupvalue(L, -2, 1)) /* set it as 1st upvalue */+ lua_pop(L, 1); /* remove 'env' if not used by previous call */+ }+ return 1;+ }+ else { /* error (message is on top of the stack) */+ lua_pushnil(L);+ lua_insert(L, -2); /* put before error message */+ return 2; /* return nil plus error message */+ }+}+++static int luaB_loadfile (lua_State *L) {+ const char *fname = luaL_optstring(L, 1, NULL);+ const char *mode = luaL_optstring(L, 2, NULL);+ int env = (!lua_isnone(L, 3) ? 3 : 0); /* 'env' index or 0 if no 'env' */+ int status = luaL_loadfilex(L, fname, mode);+ return load_aux(L, status, env);+}+++/*+** {======================================================+** Generic Read function+** =======================================================+*/+++/*+** reserved slot, above all arguments, to hold a copy of the returned+** string to avoid it being collected while parsed. 'load' has four+** optional arguments (chunk, source name, mode, and environment).+*/+#define RESERVEDSLOT 5+++/*+** Reader for generic 'load' function: 'lua_load' uses the+** stack for internal stuff, so the reader cannot change the+** stack top. Instead, it keeps its resulting string in a+** reserved slot inside the stack.+*/+static const char *generic_reader (lua_State *L, void *ud, size_t *size) {+ (void)(ud); /* not used */+ luaL_checkstack(L, 2, "too many nested functions");+ lua_pushvalue(L, 1); /* get function */+ lua_call(L, 0, 1); /* call it */+ if (lua_isnil(L, -1)) {+ lua_pop(L, 1); /* pop result */+ *size = 0;+ return NULL;+ }+ else if (!lua_isstring(L, -1))+ luaL_error(L, "reader function must return a string");+ lua_replace(L, RESERVEDSLOT); /* save string in reserved slot */+ return lua_tolstring(L, RESERVEDSLOT, size);+}+++static int luaB_load (lua_State *L) {+ int status;+ size_t l;+ const char *s = lua_tolstring(L, 1, &l);+ const char *mode = luaL_optstring(L, 3, "bt");+ int env = (!lua_isnone(L, 4) ? 4 : 0); /* 'env' index or 0 if no 'env' */+ if (s != NULL) { /* loading a string? */+ const char *chunkname = luaL_optstring(L, 2, s);+ status = luaL_loadbufferx(L, s, l, chunkname, mode);+ }+ else { /* loading from a reader function */+ const char *chunkname = luaL_optstring(L, 2, "=(load)");+ luaL_checktype(L, 1, LUA_TFUNCTION);+ lua_settop(L, RESERVEDSLOT); /* create reserved slot */+ status = lua_load(L, generic_reader, NULL, chunkname, mode);+ }+ return load_aux(L, status, env);+}++/* }====================================================== */+++static int dofilecont (lua_State *L, int d1, lua_KContext d2) {+ (void)d1; (void)d2; /* only to match 'lua_Kfunction' prototype */+ return lua_gettop(L) - 1;+}+++static int luaB_dofile (lua_State *L) {+ const char *fname = luaL_optstring(L, 1, NULL);+ lua_settop(L, 1);+ if (luaL_loadfile(L, fname) != LUA_OK)+ return lua_error(L);+ lua_callk(L, 0, LUA_MULTRET, 0, dofilecont);+ return dofilecont(L, 0, 0);+}+++static int luaB_assert (lua_State *L) {+ if (lua_toboolean(L, 1)) /* condition is true? */+ return lua_gettop(L); /* return all arguments */+ else { /* error */+ luaL_checkany(L, 1); /* there must be a condition */+ lua_remove(L, 1); /* remove it */+ lua_pushliteral(L, "assertion failed!"); /* default message */+ lua_settop(L, 1); /* leave only message (default if no other one) */+ return luaB_error(L); /* call 'error' */+ }+}+++static int luaB_select (lua_State *L) {+ int n = lua_gettop(L);+ if (lua_type(L, 1) == LUA_TSTRING && *lua_tostring(L, 1) == '#') {+ lua_pushinteger(L, n-1);+ return 1;+ }+ else {+ lua_Integer i = luaL_checkinteger(L, 1);+ if (i < 0) i = n + i;+ else if (i > n) i = n;+ luaL_argcheck(L, 1 <= i, 1, "index out of range");+ return n - (int)i;+ }+}+++/*+** Continuation function for 'pcall' and 'xpcall'. Both functions+** already pushed a 'true' before doing the call, so in case of success+** 'finishpcall' only has to return everything in the stack minus+** 'extra' values (where 'extra' is exactly the number of items to be+** ignored).+*/+static int finishpcall (lua_State *L, int status, lua_KContext extra) {+ if (status != LUA_OK && status != LUA_YIELD) { /* error? */+ lua_pushboolean(L, 0); /* first result (false) */+ lua_pushvalue(L, -2); /* error message */+ return 2; /* return false, msg */+ }+ else+ return lua_gettop(L) - (int)extra; /* return all results */+}+++static int luaB_pcall (lua_State *L) {+ int status;+ luaL_checkany(L, 1);+ lua_pushboolean(L, 1); /* first result if no errors */+ lua_insert(L, 1); /* put it in place */+ status = lua_pcallk(L, lua_gettop(L) - 2, LUA_MULTRET, 0, 0, finishpcall);+ return finishpcall(L, status, 0);+}+++/*+** Do a protected call with error handling. After 'lua_rotate', the+** stack will have <f, err, true, f, [args...]>; so, the function passes+** 2 to 'finishpcall' to skip the 2 first values when returning results.+*/+static int luaB_xpcall (lua_State *L) {+ int status;+ int n = lua_gettop(L);+ luaL_checktype(L, 2, LUA_TFUNCTION); /* check error function */+ lua_pushboolean(L, 1); /* first result */+ lua_pushvalue(L, 1); /* function */+ lua_rotate(L, 3, 2); /* move them below function's arguments */+ status = lua_pcallk(L, n - 2, LUA_MULTRET, 2, 2, finishpcall);+ return finishpcall(L, status, 2);+}+++static int luaB_tostring (lua_State *L) {+ luaL_checkany(L, 1);+ luaL_tolstring(L, 1, NULL);+ return 1;+}+++static const luaL_Reg base_funcs[] = {+ {"assert", luaB_assert},+ {"collectgarbage", luaB_collectgarbage},+ {"dofile", luaB_dofile},+ {"error", luaB_error},+ {"getmetatable", luaB_getmetatable},+ {"ipairs", luaB_ipairs},+ {"loadfile", luaB_loadfile},+ {"load", luaB_load},+#if defined(LUA_COMPAT_LOADSTRING)+ {"loadstring", luaB_load},+#endif+ {"next", luaB_next},+ {"pairs", luaB_pairs},+ {"pcall", luaB_pcall},+ {"print", luaB_print},+ {"rawequal", luaB_rawequal},+ {"rawlen", luaB_rawlen},+ {"rawget", luaB_rawget},+ {"rawset", luaB_rawset},+ {"select", luaB_select},+ {"setmetatable", luaB_setmetatable},+ {"tonumber", luaB_tonumber},+ {"tostring", luaB_tostring},+ {"type", luaB_type},+ {"xpcall", luaB_xpcall},+ /* placeholders */+ {"_G", NULL},+ {"_VERSION", NULL},+ {NULL, NULL}+};+++LUAMOD_API int luaopen_base (lua_State *L) {+ /* open lib into global table */+ lua_pushglobaltable(L);+ luaL_setfuncs(L, base_funcs, 0);+ /* set global _G */+ lua_pushvalue(L, -1);+ lua_setfield(L, -2, "_G");+ /* set global _VERSION */+ lua_pushliteral(L, LUA_VERSION);+ lua_setfield(L, -2, "_VERSION");+ return 1;+}+
+ cbits/lua-5.3.6/lbitlib.c view
@@ -0,0 +1,233 @@+/*+** $Id: lbitlib.c,v 1.30.1.1 2017/04/19 17:20:42 roberto Exp $+** Standard library for bitwise operations+** See Copyright Notice in lua.h+*/++#define lbitlib_c+#define LUA_LIB++#include "lprefix.h"+++#include "lua.h"++#include "lauxlib.h"+#include "lualib.h"+++#if defined(LUA_COMPAT_BITLIB) /* { */+++#define pushunsigned(L,n) lua_pushinteger(L, (lua_Integer)(n))+#define checkunsigned(L,i) ((lua_Unsigned)luaL_checkinteger(L,i))+++/* number of bits to consider in a number */+#if !defined(LUA_NBITS)+#define LUA_NBITS 32+#endif+++/*+** a lua_Unsigned with its first LUA_NBITS bits equal to 1. (Shift must+** be made in two parts to avoid problems when LUA_NBITS is equal to the+** number of bits in a lua_Unsigned.)+*/+#define ALLONES (~(((~(lua_Unsigned)0) << (LUA_NBITS - 1)) << 1))+++/* macro to trim extra bits */+#define trim(x) ((x) & ALLONES)+++/* builds a number with 'n' ones (1 <= n <= LUA_NBITS) */+#define mask(n) (~((ALLONES << 1) << ((n) - 1)))++++static lua_Unsigned andaux (lua_State *L) {+ int i, n = lua_gettop(L);+ lua_Unsigned r = ~(lua_Unsigned)0;+ for (i = 1; i <= n; i++)+ r &= checkunsigned(L, i);+ return trim(r);+}+++static int b_and (lua_State *L) {+ lua_Unsigned r = andaux(L);+ pushunsigned(L, r);+ return 1;+}+++static int b_test (lua_State *L) {+ lua_Unsigned r = andaux(L);+ lua_pushboolean(L, r != 0);+ return 1;+}+++static int b_or (lua_State *L) {+ int i, n = lua_gettop(L);+ lua_Unsigned r = 0;+ for (i = 1; i <= n; i++)+ r |= checkunsigned(L, i);+ pushunsigned(L, trim(r));+ return 1;+}+++static int b_xor (lua_State *L) {+ int i, n = lua_gettop(L);+ lua_Unsigned r = 0;+ for (i = 1; i <= n; i++)+ r ^= checkunsigned(L, i);+ pushunsigned(L, trim(r));+ return 1;+}+++static int b_not (lua_State *L) {+ lua_Unsigned r = ~checkunsigned(L, 1);+ pushunsigned(L, trim(r));+ return 1;+}+++static int b_shift (lua_State *L, lua_Unsigned r, lua_Integer i) {+ if (i < 0) { /* shift right? */+ i = -i;+ r = trim(r);+ if (i >= LUA_NBITS) r = 0;+ else r >>= i;+ }+ else { /* shift left */+ if (i >= LUA_NBITS) r = 0;+ else r <<= i;+ r = trim(r);+ }+ pushunsigned(L, r);+ return 1;+}+++static int b_lshift (lua_State *L) {+ return b_shift(L, checkunsigned(L, 1), luaL_checkinteger(L, 2));+}+++static int b_rshift (lua_State *L) {+ return b_shift(L, checkunsigned(L, 1), -luaL_checkinteger(L, 2));+}+++static int b_arshift (lua_State *L) {+ lua_Unsigned r = checkunsigned(L, 1);+ lua_Integer i = luaL_checkinteger(L, 2);+ if (i < 0 || !(r & ((lua_Unsigned)1 << (LUA_NBITS - 1))))+ return b_shift(L, r, -i);+ else { /* arithmetic shift for 'negative' number */+ if (i >= LUA_NBITS) r = ALLONES;+ else+ r = trim((r >> i) | ~(trim(~(lua_Unsigned)0) >> i)); /* add signal bit */+ pushunsigned(L, r);+ return 1;+ }+}+++static int b_rot (lua_State *L, lua_Integer d) {+ lua_Unsigned r = checkunsigned(L, 1);+ int i = d & (LUA_NBITS - 1); /* i = d % NBITS */+ r = trim(r);+ if (i != 0) /* avoid undefined shift of LUA_NBITS when i == 0 */+ r = (r << i) | (r >> (LUA_NBITS - i));+ pushunsigned(L, trim(r));+ return 1;+}+++static int b_lrot (lua_State *L) {+ return b_rot(L, luaL_checkinteger(L, 2));+}+++static int b_rrot (lua_State *L) {+ return b_rot(L, -luaL_checkinteger(L, 2));+}+++/*+** get field and width arguments for field-manipulation functions,+** checking whether they are valid.+** ('luaL_error' called without 'return' to avoid later warnings about+** 'width' being used uninitialized.)+*/+static int fieldargs (lua_State *L, int farg, int *width) {+ lua_Integer f = luaL_checkinteger(L, farg);+ lua_Integer w = luaL_optinteger(L, farg + 1, 1);+ luaL_argcheck(L, 0 <= f, farg, "field cannot be negative");+ luaL_argcheck(L, 0 < w, farg + 1, "width must be positive");+ if (f + w > LUA_NBITS)+ luaL_error(L, "trying to access non-existent bits");+ *width = (int)w;+ return (int)f;+}+++static int b_extract (lua_State *L) {+ int w;+ lua_Unsigned r = trim(checkunsigned(L, 1));+ int f = fieldargs(L, 2, &w);+ r = (r >> f) & mask(w);+ pushunsigned(L, r);+ return 1;+}+++static int b_replace (lua_State *L) {+ int w;+ lua_Unsigned r = trim(checkunsigned(L, 1));+ lua_Unsigned v = trim(checkunsigned(L, 2));+ int f = fieldargs(L, 3, &w);+ lua_Unsigned m = mask(w);+ r = (r & ~(m << f)) | ((v & m) << f);+ pushunsigned(L, r);+ return 1;+}+++static const luaL_Reg bitlib[] = {+ {"arshift", b_arshift},+ {"band", b_and},+ {"bnot", b_not},+ {"bor", b_or},+ {"bxor", b_xor},+ {"btest", b_test},+ {"extract", b_extract},+ {"lrotate", b_lrot},+ {"lshift", b_lshift},+ {"replace", b_replace},+ {"rrotate", b_rrot},+ {"rshift", b_rshift},+ {NULL, NULL}+};++++LUAMOD_API int luaopen_bit32 (lua_State *L) {+ luaL_newlib(L, bitlib);+ return 1;+}+++#else /* }{ */+++LUAMOD_API int luaopen_bit32 (lua_State *L) {+ return luaL_error(L, "library 'bit32' has been deprecated");+}++#endif /* } */
+ cbits/lua-5.3.6/lcode.c view
@@ -0,0 +1,1203 @@+/*+** $Id: lcode.c,v 2.112.1.1 2017/04/19 17:20:42 roberto Exp $+** Code generator for Lua+** See Copyright Notice in lua.h+*/++#define lcode_c+#define LUA_CORE++#include "lprefix.h"+++#include <math.h>+#include <stdlib.h>++#include "lua.h"++#include "lcode.h"+#include "ldebug.h"+#include "ldo.h"+#include "lgc.h"+#include "llex.h"+#include "lmem.h"+#include "lobject.h"+#include "lopcodes.h"+#include "lparser.h"+#include "lstring.h"+#include "ltable.h"+#include "lvm.h"+++/* Maximum number of registers in a Lua function (must fit in 8 bits) */+#define MAXREGS 255+++#define hasjumps(e) ((e)->t != (e)->f)+++/*+** If expression is a numeric constant, fills 'v' with its value+** and returns 1. Otherwise, returns 0.+*/+static int tonumeral(const expdesc *e, TValue *v) {+ if (hasjumps(e))+ return 0; /* not a numeral */+ switch (e->k) {+ case VKINT:+ if (v) setivalue(v, e->u.ival);+ return 1;+ case VKFLT:+ if (v) setfltvalue(v, e->u.nval);+ return 1;+ default: return 0;+ }+}+++/*+** Create a OP_LOADNIL instruction, but try to optimize: if the previous+** instruction is also OP_LOADNIL and ranges are compatible, adjust+** range of previous instruction instead of emitting a new one. (For+** instance, 'local a; local b' will generate a single opcode.)+*/+void luaK_nil (FuncState *fs, int from, int n) {+ Instruction *previous;+ int l = from + n - 1; /* last register to set nil */+ if (fs->pc > fs->lasttarget) { /* no jumps to current position? */+ previous = &fs->f->code[fs->pc-1];+ if (GET_OPCODE(*previous) == OP_LOADNIL) { /* previous is LOADNIL? */+ int pfrom = GETARG_A(*previous); /* get previous range */+ int pl = pfrom + GETARG_B(*previous);+ if ((pfrom <= from && from <= pl + 1) ||+ (from <= pfrom && pfrom <= l + 1)) { /* can connect both? */+ if (pfrom < from) from = pfrom; /* from = min(from, pfrom) */+ if (pl > l) l = pl; /* l = max(l, pl) */+ SETARG_A(*previous, from);+ SETARG_B(*previous, l - from);+ return;+ }+ } /* else go through */+ }+ luaK_codeABC(fs, OP_LOADNIL, from, n - 1, 0); /* else no optimization */+}+++/*+** Gets the destination address of a jump instruction. Used to traverse+** a list of jumps.+*/+static int getjump (FuncState *fs, int pc) {+ int offset = GETARG_sBx(fs->f->code[pc]);+ if (offset == NO_JUMP) /* point to itself represents end of list */+ return NO_JUMP; /* end of list */+ else+ return (pc+1)+offset; /* turn offset into absolute position */+}+++/*+** Fix jump instruction at position 'pc' to jump to 'dest'.+** (Jump addresses are relative in Lua)+*/+static void fixjump (FuncState *fs, int pc, int dest) {+ Instruction *jmp = &fs->f->code[pc];+ int offset = dest - (pc + 1);+ lua_assert(dest != NO_JUMP);+ if (abs(offset) > MAXARG_sBx)+ luaX_syntaxerror(fs->ls, "control structure too long");+ SETARG_sBx(*jmp, offset);+}+++/*+** Concatenate jump-list 'l2' into jump-list 'l1'+*/+void luaK_concat (FuncState *fs, int *l1, int l2) {+ if (l2 == NO_JUMP) return; /* nothing to concatenate? */+ else if (*l1 == NO_JUMP) /* no original list? */+ *l1 = l2; /* 'l1' points to 'l2' */+ else {+ int list = *l1;+ int next;+ while ((next = getjump(fs, list)) != NO_JUMP) /* find last element */+ list = next;+ fixjump(fs, list, l2); /* last element links to 'l2' */+ }+}+++/*+** Create a jump instruction and return its position, so its destination+** can be fixed later (with 'fixjump'). If there are jumps to+** this position (kept in 'jpc'), link them all together so that+** 'patchlistaux' will fix all them directly to the final destination.+*/+int luaK_jump (FuncState *fs) {+ int jpc = fs->jpc; /* save list of jumps to here */+ int j;+ fs->jpc = NO_JUMP; /* no more jumps to here */+ j = luaK_codeAsBx(fs, OP_JMP, 0, NO_JUMP);+ luaK_concat(fs, &j, jpc); /* keep them on hold */+ return j;+}+++/*+** Code a 'return' instruction+*/+void luaK_ret (FuncState *fs, int first, int nret) {+ luaK_codeABC(fs, OP_RETURN, first, nret+1, 0);+}+++/*+** Code a "conditional jump", that is, a test or comparison opcode+** followed by a jump. Return jump position.+*/+static int condjump (FuncState *fs, OpCode op, int A, int B, int C) {+ luaK_codeABC(fs, op, A, B, C);+ return luaK_jump(fs);+}+++/*+** returns current 'pc' and marks it as a jump target (to avoid wrong+** optimizations with consecutive instructions not in the same basic block).+*/+int luaK_getlabel (FuncState *fs) {+ fs->lasttarget = fs->pc;+ return fs->pc;+}+++/*+** Returns the position of the instruction "controlling" a given+** jump (that is, its condition), or the jump itself if it is+** unconditional.+*/+static Instruction *getjumpcontrol (FuncState *fs, int pc) {+ Instruction *pi = &fs->f->code[pc];+ if (pc >= 1 && testTMode(GET_OPCODE(*(pi-1))))+ return pi-1;+ else+ return pi;+}+++/*+** Patch destination register for a TESTSET instruction.+** If instruction in position 'node' is not a TESTSET, return 0 ("fails").+** Otherwise, if 'reg' is not 'NO_REG', set it as the destination+** register. Otherwise, change instruction to a simple 'TEST' (produces+** no register value)+*/+static int patchtestreg (FuncState *fs, int node, int reg) {+ Instruction *i = getjumpcontrol(fs, node);+ if (GET_OPCODE(*i) != OP_TESTSET)+ return 0; /* cannot patch other instructions */+ if (reg != NO_REG && reg != GETARG_B(*i))+ SETARG_A(*i, reg);+ else {+ /* no register to put value or register already has the value;+ change instruction to simple test */+ *i = CREATE_ABC(OP_TEST, GETARG_B(*i), 0, GETARG_C(*i));+ }+ return 1;+}+++/*+** Traverse a list of tests ensuring no one produces a value+*/+static void removevalues (FuncState *fs, int list) {+ for (; list != NO_JUMP; list = getjump(fs, list))+ patchtestreg(fs, list, NO_REG);+}+++/*+** Traverse a list of tests, patching their destination address and+** registers: tests producing values jump to 'vtarget' (and put their+** values in 'reg'), other tests jump to 'dtarget'.+*/+static void patchlistaux (FuncState *fs, int list, int vtarget, int reg,+ int dtarget) {+ while (list != NO_JUMP) {+ int next = getjump(fs, list);+ if (patchtestreg(fs, list, reg))+ fixjump(fs, list, vtarget);+ else+ fixjump(fs, list, dtarget); /* jump to default target */+ list = next;+ }+}+++/*+** Ensure all pending jumps to current position are fixed (jumping+** to current position with no values) and reset list of pending+** jumps+*/+static void dischargejpc (FuncState *fs) {+ patchlistaux(fs, fs->jpc, fs->pc, NO_REG, fs->pc);+ fs->jpc = NO_JUMP;+}+++/*+** Add elements in 'list' to list of pending jumps to "here"+** (current position)+*/+void luaK_patchtohere (FuncState *fs, int list) {+ luaK_getlabel(fs); /* mark "here" as a jump target */+ luaK_concat(fs, &fs->jpc, list);+}+++/*+** Path all jumps in 'list' to jump to 'target'.+** (The assert means that we cannot fix a jump to a forward address+** because we only know addresses once code is generated.)+*/+void luaK_patchlist (FuncState *fs, int list, int target) {+ if (target == fs->pc) /* 'target' is current position? */+ luaK_patchtohere(fs, list); /* add list to pending jumps */+ else {+ lua_assert(target < fs->pc);+ patchlistaux(fs, list, target, NO_REG, target);+ }+}+++/*+** Path all jumps in 'list' to close upvalues up to given 'level'+** (The assertion checks that jumps either were closing nothing+** or were closing higher levels, from inner blocks.)+*/+void luaK_patchclose (FuncState *fs, int list, int level) {+ level++; /* argument is +1 to reserve 0 as non-op */+ for (; list != NO_JUMP; list = getjump(fs, list)) {+ lua_assert(GET_OPCODE(fs->f->code[list]) == OP_JMP &&+ (GETARG_A(fs->f->code[list]) == 0 ||+ GETARG_A(fs->f->code[list]) >= level));+ SETARG_A(fs->f->code[list], level);+ }+}+++/*+** Emit instruction 'i', checking for array sizes and saving also its+** line information. Return 'i' position.+*/+static int luaK_code (FuncState *fs, Instruction i) {+ Proto *f = fs->f;+ dischargejpc(fs); /* 'pc' will change */+ /* put new instruction in code array */+ luaM_growvector(fs->ls->L, f->code, fs->pc, f->sizecode, Instruction,+ MAX_INT, "opcodes");+ f->code[fs->pc] = i;+ /* save corresponding line information */+ luaM_growvector(fs->ls->L, f->lineinfo, fs->pc, f->sizelineinfo, int,+ MAX_INT, "opcodes");+ f->lineinfo[fs->pc] = fs->ls->lastline;+ return fs->pc++;+}+++/*+** Format and emit an 'iABC' instruction. (Assertions check consistency+** of parameters versus opcode.)+*/+int luaK_codeABC (FuncState *fs, OpCode o, int a, int b, int c) {+ lua_assert(getOpMode(o) == iABC);+ lua_assert(getBMode(o) != OpArgN || b == 0);+ lua_assert(getCMode(o) != OpArgN || c == 0);+ lua_assert(a <= MAXARG_A && b <= MAXARG_B && c <= MAXARG_C);+ return luaK_code(fs, CREATE_ABC(o, a, b, c));+}+++/*+** Format and emit an 'iABx' instruction.+*/+int luaK_codeABx (FuncState *fs, OpCode o, int a, unsigned int bc) {+ lua_assert(getOpMode(o) == iABx || getOpMode(o) == iAsBx);+ lua_assert(getCMode(o) == OpArgN);+ lua_assert(a <= MAXARG_A && bc <= MAXARG_Bx);+ return luaK_code(fs, CREATE_ABx(o, a, bc));+}+++/*+** Emit an "extra argument" instruction (format 'iAx')+*/+static int codeextraarg (FuncState *fs, int a) {+ lua_assert(a <= MAXARG_Ax);+ return luaK_code(fs, CREATE_Ax(OP_EXTRAARG, a));+}+++/*+** Emit a "load constant" instruction, using either 'OP_LOADK'+** (if constant index 'k' fits in 18 bits) or an 'OP_LOADKX'+** instruction with "extra argument".+*/+int luaK_codek (FuncState *fs, int reg, int k) {+ if (k <= MAXARG_Bx)+ return luaK_codeABx(fs, OP_LOADK, reg, k);+ else {+ int p = luaK_codeABx(fs, OP_LOADKX, reg, 0);+ codeextraarg(fs, k);+ return p;+ }+}+++/*+** Check register-stack level, keeping track of its maximum size+** in field 'maxstacksize'+*/+void luaK_checkstack (FuncState *fs, int n) {+ int newstack = fs->freereg + n;+ if (newstack > fs->f->maxstacksize) {+ if (newstack >= MAXREGS)+ luaX_syntaxerror(fs->ls,+ "function or expression needs too many registers");+ fs->f->maxstacksize = cast_byte(newstack);+ }+}+++/*+** Reserve 'n' registers in register stack+*/+void luaK_reserveregs (FuncState *fs, int n) {+ luaK_checkstack(fs, n);+ fs->freereg += n;+}+++/*+** Free register 'reg', if it is neither a constant index nor+** a local variable.+)+*/+static void freereg (FuncState *fs, int reg) {+ if (!ISK(reg) && reg >= fs->nactvar) {+ fs->freereg--;+ lua_assert(reg == fs->freereg);+ }+}+++/*+** Free register used by expression 'e' (if any)+*/+static void freeexp (FuncState *fs, expdesc *e) {+ if (e->k == VNONRELOC)+ freereg(fs, e->u.info);+}+++/*+** Free registers used by expressions 'e1' and 'e2' (if any) in proper+** order.+*/+static void freeexps (FuncState *fs, expdesc *e1, expdesc *e2) {+ int r1 = (e1->k == VNONRELOC) ? e1->u.info : -1;+ int r2 = (e2->k == VNONRELOC) ? e2->u.info : -1;+ if (r1 > r2) {+ freereg(fs, r1);+ freereg(fs, r2);+ }+ else {+ freereg(fs, r2);+ freereg(fs, r1);+ }+}+++/*+** Add constant 'v' to prototype's list of constants (field 'k').+** Use scanner's table to cache position of constants in constant list+** and try to reuse constants. Because some values should not be used+** as keys (nil cannot be a key, integer keys can collapse with float+** keys), the caller must provide a useful 'key' for indexing the cache.+*/+static int addk (FuncState *fs, TValue *key, TValue *v) {+ lua_State *L = fs->ls->L;+ Proto *f = fs->f;+ TValue *idx = luaH_set(L, fs->ls->h, key); /* index scanner table */+ int k, oldsize;+ if (ttisinteger(idx)) { /* is there an index there? */+ k = cast_int(ivalue(idx));+ /* correct value? (warning: must distinguish floats from integers!) */+ if (k < fs->nk && ttype(&f->k[k]) == ttype(v) &&+ luaV_rawequalobj(&f->k[k], v))+ return k; /* reuse index */+ }+ /* constant not found; create a new entry */+ oldsize = f->sizek;+ k = fs->nk;+ /* numerical value does not need GC barrier;+ table has no metatable, so it does not need to invalidate cache */+ setivalue(idx, k);+ luaM_growvector(L, f->k, k, f->sizek, TValue, MAXARG_Ax, "constants");+ while (oldsize < f->sizek) setnilvalue(&f->k[oldsize++]);+ setobj(L, &f->k[k], v);+ fs->nk++;+ luaC_barrier(L, f, v);+ return k;+}+++/*+** Add a string to list of constants and return its index.+*/+int luaK_stringK (FuncState *fs, TString *s) {+ TValue o;+ setsvalue(fs->ls->L, &o, s);+ return addk(fs, &o, &o); /* use string itself as key */+}+++/*+** Add an integer to list of constants and return its index.+** Integers use userdata as keys to avoid collision with floats with+** same value; conversion to 'void*' is used only for hashing, so there+** are no "precision" problems.+*/+int luaK_intK (FuncState *fs, lua_Integer n) {+ TValue k, o;+ setpvalue(&k, cast(void*, cast(size_t, n)));+ setivalue(&o, n);+ return addk(fs, &k, &o);+}++/*+** Add a float to list of constants and return its index.+*/+static int luaK_numberK (FuncState *fs, lua_Number r) {+ TValue o;+ setfltvalue(&o, r);+ return addk(fs, &o, &o); /* use number itself as key */+}+++/*+** Add a boolean to list of constants and return its index.+*/+static int boolK (FuncState *fs, int b) {+ TValue o;+ setbvalue(&o, b);+ return addk(fs, &o, &o); /* use boolean itself as key */+}+++/*+** Add nil to list of constants and return its index.+*/+static int nilK (FuncState *fs) {+ TValue k, v;+ setnilvalue(&v);+ /* cannot use nil as key; instead use table itself to represent nil */+ sethvalue(fs->ls->L, &k, fs->ls->h);+ return addk(fs, &k, &v);+}+++/*+** Fix an expression to return the number of results 'nresults'.+** Either 'e' is a multi-ret expression (function call or vararg)+** or 'nresults' is LUA_MULTRET (as any expression can satisfy that).+*/+void luaK_setreturns (FuncState *fs, expdesc *e, int nresults) {+ if (e->k == VCALL) { /* expression is an open function call? */+ SETARG_C(getinstruction(fs, e), nresults + 1);+ }+ else if (e->k == VVARARG) {+ Instruction *pc = &getinstruction(fs, e);+ SETARG_B(*pc, nresults + 1);+ SETARG_A(*pc, fs->freereg);+ luaK_reserveregs(fs, 1);+ }+ else lua_assert(nresults == LUA_MULTRET);+}+++/*+** Fix an expression to return one result.+** If expression is not a multi-ret expression (function call or+** vararg), it already returns one result, so nothing needs to be done.+** Function calls become VNONRELOC expressions (as its result comes+** fixed in the base register of the call), while vararg expressions+** become VRELOCABLE (as OP_VARARG puts its results where it wants).+** (Calls are created returning one result, so that does not need+** to be fixed.)+*/+void luaK_setoneret (FuncState *fs, expdesc *e) {+ if (e->k == VCALL) { /* expression is an open function call? */+ /* already returns 1 value */+ lua_assert(GETARG_C(getinstruction(fs, e)) == 2);+ e->k = VNONRELOC; /* result has fixed position */+ e->u.info = GETARG_A(getinstruction(fs, e));+ }+ else if (e->k == VVARARG) {+ SETARG_B(getinstruction(fs, e), 2);+ e->k = VRELOCABLE; /* can relocate its simple result */+ }+}+++/*+** Ensure that expression 'e' is not a variable.+*/+void luaK_dischargevars (FuncState *fs, expdesc *e) {+ switch (e->k) {+ case VLOCAL: { /* already in a register */+ e->k = VNONRELOC; /* becomes a non-relocatable value */+ break;+ }+ case VUPVAL: { /* move value to some (pending) register */+ e->u.info = luaK_codeABC(fs, OP_GETUPVAL, 0, e->u.info, 0);+ e->k = VRELOCABLE;+ break;+ }+ case VINDEXED: {+ OpCode op;+ freereg(fs, e->u.ind.idx);+ if (e->u.ind.vt == VLOCAL) { /* is 't' in a register? */+ freereg(fs, e->u.ind.t);+ op = OP_GETTABLE;+ }+ else {+ lua_assert(e->u.ind.vt == VUPVAL);+ op = OP_GETTABUP; /* 't' is in an upvalue */+ }+ e->u.info = luaK_codeABC(fs, op, 0, e->u.ind.t, e->u.ind.idx);+ e->k = VRELOCABLE;+ break;+ }+ case VVARARG: case VCALL: {+ luaK_setoneret(fs, e);+ break;+ }+ default: break; /* there is one value available (somewhere) */+ }+}+++/*+** Ensures expression value is in register 'reg' (and therefore+** 'e' will become a non-relocatable expression).+*/+static void discharge2reg (FuncState *fs, expdesc *e, int reg) {+ luaK_dischargevars(fs, e);+ switch (e->k) {+ case VNIL: {+ luaK_nil(fs, reg, 1);+ break;+ }+ case VFALSE: case VTRUE: {+ luaK_codeABC(fs, OP_LOADBOOL, reg, e->k == VTRUE, 0);+ break;+ }+ case VK: {+ luaK_codek(fs, reg, e->u.info);+ break;+ }+ case VKFLT: {+ luaK_codek(fs, reg, luaK_numberK(fs, e->u.nval));+ break;+ }+ case VKINT: {+ luaK_codek(fs, reg, luaK_intK(fs, e->u.ival));+ break;+ }+ case VRELOCABLE: {+ Instruction *pc = &getinstruction(fs, e);+ SETARG_A(*pc, reg); /* instruction will put result in 'reg' */+ break;+ }+ case VNONRELOC: {+ if (reg != e->u.info)+ luaK_codeABC(fs, OP_MOVE, reg, e->u.info, 0);+ break;+ }+ default: {+ lua_assert(e->k == VJMP);+ return; /* nothing to do... */+ }+ }+ e->u.info = reg;+ e->k = VNONRELOC;+}+++/*+** Ensures expression value is in any register.+*/+static void discharge2anyreg (FuncState *fs, expdesc *e) {+ if (e->k != VNONRELOC) { /* no fixed register yet? */+ luaK_reserveregs(fs, 1); /* get a register */+ discharge2reg(fs, e, fs->freereg-1); /* put value there */+ }+}+++static int code_loadbool (FuncState *fs, int A, int b, int jump) {+ luaK_getlabel(fs); /* those instructions may be jump targets */+ return luaK_codeABC(fs, OP_LOADBOOL, A, b, jump);+}+++/*+** check whether list has any jump that do not produce a value+** or produce an inverted value+*/+static int need_value (FuncState *fs, int list) {+ for (; list != NO_JUMP; list = getjump(fs, list)) {+ Instruction i = *getjumpcontrol(fs, list);+ if (GET_OPCODE(i) != OP_TESTSET) return 1;+ }+ return 0; /* not found */+}+++/*+** Ensures final expression result (including results from its jump+** lists) is in register 'reg'.+** If expression has jumps, need to patch these jumps either to+** its final position or to "load" instructions (for those tests+** that do not produce values).+*/+static void exp2reg (FuncState *fs, expdesc *e, int reg) {+ discharge2reg(fs, e, reg);+ if (e->k == VJMP) /* expression itself is a test? */+ luaK_concat(fs, &e->t, e->u.info); /* put this jump in 't' list */+ if (hasjumps(e)) {+ int final; /* position after whole expression */+ int p_f = NO_JUMP; /* position of an eventual LOAD false */+ int p_t = NO_JUMP; /* position of an eventual LOAD true */+ if (need_value(fs, e->t) || need_value(fs, e->f)) {+ int fj = (e->k == VJMP) ? NO_JUMP : luaK_jump(fs);+ p_f = code_loadbool(fs, reg, 0, 1);+ p_t = code_loadbool(fs, reg, 1, 0);+ luaK_patchtohere(fs, fj);+ }+ final = luaK_getlabel(fs);+ patchlistaux(fs, e->f, final, reg, p_f);+ patchlistaux(fs, e->t, final, reg, p_t);+ }+ e->f = e->t = NO_JUMP;+ e->u.info = reg;+ e->k = VNONRELOC;+}+++/*+** Ensures final expression result (including results from its jump+** lists) is in next available register.+*/+void luaK_exp2nextreg (FuncState *fs, expdesc *e) {+ luaK_dischargevars(fs, e);+ freeexp(fs, e);+ luaK_reserveregs(fs, 1);+ exp2reg(fs, e, fs->freereg - 1);+}+++/*+** Ensures final expression result (including results from its jump+** lists) is in some (any) register and return that register.+*/+int luaK_exp2anyreg (FuncState *fs, expdesc *e) {+ luaK_dischargevars(fs, e);+ if (e->k == VNONRELOC) { /* expression already has a register? */+ if (!hasjumps(e)) /* no jumps? */+ return e->u.info; /* result is already in a register */+ if (e->u.info >= fs->nactvar) { /* reg. is not a local? */+ exp2reg(fs, e, e->u.info); /* put final result in it */+ return e->u.info;+ }+ }+ luaK_exp2nextreg(fs, e); /* otherwise, use next available register */+ return e->u.info;+}+++/*+** Ensures final expression result is either in a register or in an+** upvalue.+*/+void luaK_exp2anyregup (FuncState *fs, expdesc *e) {+ if (e->k != VUPVAL || hasjumps(e))+ luaK_exp2anyreg(fs, e);+}+++/*+** Ensures final expression result is either in a register or it is+** a constant.+*/+void luaK_exp2val (FuncState *fs, expdesc *e) {+ if (hasjumps(e))+ luaK_exp2anyreg(fs, e);+ else+ luaK_dischargevars(fs, e);+}+++/*+** Ensures final expression result is in a valid R/K index+** (that is, it is either in a register or in 'k' with an index+** in the range of R/K indices).+** Returns R/K index.+*/+int luaK_exp2RK (FuncState *fs, expdesc *e) {+ luaK_exp2val(fs, e);+ switch (e->k) { /* move constants to 'k' */+ case VTRUE: e->u.info = boolK(fs, 1); goto vk;+ case VFALSE: e->u.info = boolK(fs, 0); goto vk;+ case VNIL: e->u.info = nilK(fs); goto vk;+ case VKINT: e->u.info = luaK_intK(fs, e->u.ival); goto vk;+ case VKFLT: e->u.info = luaK_numberK(fs, e->u.nval); goto vk;+ case VK:+ vk:+ e->k = VK;+ if (e->u.info <= MAXINDEXRK) /* constant fits in 'argC'? */+ return RKASK(e->u.info);+ else break;+ default: break;+ }+ /* not a constant in the right range: put it in a register */+ return luaK_exp2anyreg(fs, e);+}+++/*+** Generate code to store result of expression 'ex' into variable 'var'.+*/+void luaK_storevar (FuncState *fs, expdesc *var, expdesc *ex) {+ switch (var->k) {+ case VLOCAL: {+ freeexp(fs, ex);+ exp2reg(fs, ex, var->u.info); /* compute 'ex' into proper place */+ return;+ }+ case VUPVAL: {+ int e = luaK_exp2anyreg(fs, ex);+ luaK_codeABC(fs, OP_SETUPVAL, e, var->u.info, 0);+ break;+ }+ case VINDEXED: {+ OpCode op = (var->u.ind.vt == VLOCAL) ? OP_SETTABLE : OP_SETTABUP;+ int e = luaK_exp2RK(fs, ex);+ luaK_codeABC(fs, op, var->u.ind.t, var->u.ind.idx, e);+ break;+ }+ default: lua_assert(0); /* invalid var kind to store */+ }+ freeexp(fs, ex);+}+++/*+** Emit SELF instruction (convert expression 'e' into 'e:key(e,').+*/+void luaK_self (FuncState *fs, expdesc *e, expdesc *key) {+ int ereg;+ luaK_exp2anyreg(fs, e);+ ereg = e->u.info; /* register where 'e' was placed */+ freeexp(fs, e);+ e->u.info = fs->freereg; /* base register for op_self */+ e->k = VNONRELOC; /* self expression has a fixed register */+ luaK_reserveregs(fs, 2); /* function and 'self' produced by op_self */+ luaK_codeABC(fs, OP_SELF, e->u.info, ereg, luaK_exp2RK(fs, key));+ freeexp(fs, key);+}+++/*+** Negate condition 'e' (where 'e' is a comparison).+*/+static void negatecondition (FuncState *fs, expdesc *e) {+ Instruction *pc = getjumpcontrol(fs, e->u.info);+ lua_assert(testTMode(GET_OPCODE(*pc)) && GET_OPCODE(*pc) != OP_TESTSET &&+ GET_OPCODE(*pc) != OP_TEST);+ SETARG_A(*pc, !(GETARG_A(*pc)));+}+++/*+** Emit instruction to jump if 'e' is 'cond' (that is, if 'cond'+** is true, code will jump if 'e' is true.) Return jump position.+** Optimize when 'e' is 'not' something, inverting the condition+** and removing the 'not'.+*/+static int jumponcond (FuncState *fs, expdesc *e, int cond) {+ if (e->k == VRELOCABLE) {+ Instruction ie = getinstruction(fs, e);+ if (GET_OPCODE(ie) == OP_NOT) {+ fs->pc--; /* remove previous OP_NOT */+ return condjump(fs, OP_TEST, GETARG_B(ie), 0, !cond);+ }+ /* else go through */+ }+ discharge2anyreg(fs, e);+ freeexp(fs, e);+ return condjump(fs, OP_TESTSET, NO_REG, e->u.info, cond);+}+++/*+** Emit code to go through if 'e' is true, jump otherwise.+*/+void luaK_goiftrue (FuncState *fs, expdesc *e) {+ int pc; /* pc of new jump */+ luaK_dischargevars(fs, e);+ switch (e->k) {+ case VJMP: { /* condition? */+ negatecondition(fs, e); /* jump when it is false */+ pc = e->u.info; /* save jump position */+ break;+ }+ case VK: case VKFLT: case VKINT: case VTRUE: {+ pc = NO_JUMP; /* always true; do nothing */+ break;+ }+ default: {+ pc = jumponcond(fs, e, 0); /* jump when false */+ break;+ }+ }+ luaK_concat(fs, &e->f, pc); /* insert new jump in false list */+ luaK_patchtohere(fs, e->t); /* true list jumps to here (to go through) */+ e->t = NO_JUMP;+}+++/*+** Emit code to go through if 'e' is false, jump otherwise.+*/+void luaK_goiffalse (FuncState *fs, expdesc *e) {+ int pc; /* pc of new jump */+ luaK_dischargevars(fs, e);+ switch (e->k) {+ case VJMP: {+ pc = e->u.info; /* already jump if true */+ break;+ }+ case VNIL: case VFALSE: {+ pc = NO_JUMP; /* always false; do nothing */+ break;+ }+ default: {+ pc = jumponcond(fs, e, 1); /* jump if true */+ break;+ }+ }+ luaK_concat(fs, &e->t, pc); /* insert new jump in 't' list */+ luaK_patchtohere(fs, e->f); /* false list jumps to here (to go through) */+ e->f = NO_JUMP;+}+++/*+** Code 'not e', doing constant folding.+*/+static void codenot (FuncState *fs, expdesc *e) {+ luaK_dischargevars(fs, e);+ switch (e->k) {+ case VNIL: case VFALSE: {+ e->k = VTRUE; /* true == not nil == not false */+ break;+ }+ case VK: case VKFLT: case VKINT: case VTRUE: {+ e->k = VFALSE; /* false == not "x" == not 0.5 == not 1 == not true */+ break;+ }+ case VJMP: {+ negatecondition(fs, e);+ break;+ }+ case VRELOCABLE:+ case VNONRELOC: {+ discharge2anyreg(fs, e);+ freeexp(fs, e);+ e->u.info = luaK_codeABC(fs, OP_NOT, 0, e->u.info, 0);+ e->k = VRELOCABLE;+ break;+ }+ default: lua_assert(0); /* cannot happen */+ }+ /* interchange true and false lists */+ { int temp = e->f; e->f = e->t; e->t = temp; }+ removevalues(fs, e->f); /* values are useless when negated */+ removevalues(fs, e->t);+}+++/*+** Create expression 't[k]'. 't' must have its final result already in a+** register or upvalue.+*/+void luaK_indexed (FuncState *fs, expdesc *t, expdesc *k) {+ lua_assert(!hasjumps(t) && (vkisinreg(t->k) || t->k == VUPVAL));+ t->u.ind.t = t->u.info; /* register or upvalue index */+ t->u.ind.idx = luaK_exp2RK(fs, k); /* R/K index for key */+ t->u.ind.vt = (t->k == VUPVAL) ? VUPVAL : VLOCAL;+ t->k = VINDEXED;+}+++/*+** Return false if folding can raise an error.+** Bitwise operations need operands convertible to integers; division+** operations cannot have 0 as divisor.+*/+static int validop (int op, TValue *v1, TValue *v2) {+ switch (op) {+ case LUA_OPBAND: case LUA_OPBOR: case LUA_OPBXOR:+ case LUA_OPSHL: case LUA_OPSHR: case LUA_OPBNOT: { /* conversion errors */+ lua_Integer i;+ return (tointeger(v1, &i) && tointeger(v2, &i));+ }+ case LUA_OPDIV: case LUA_OPIDIV: case LUA_OPMOD: /* division by 0 */+ return (nvalue(v2) != 0);+ default: return 1; /* everything else is valid */+ }+}+++/*+** Try to "constant-fold" an operation; return 1 iff successful.+** (In this case, 'e1' has the final result.)+*/+static int constfolding (FuncState *fs, int op, expdesc *e1,+ const expdesc *e2) {+ TValue v1, v2, res;+ if (!tonumeral(e1, &v1) || !tonumeral(e2, &v2) || !validop(op, &v1, &v2))+ return 0; /* non-numeric operands or not safe to fold */+ luaO_arith(fs->ls->L, op, &v1, &v2, &res); /* does operation */+ if (ttisinteger(&res)) {+ e1->k = VKINT;+ e1->u.ival = ivalue(&res);+ }+ else { /* folds neither NaN nor 0.0 (to avoid problems with -0.0) */+ lua_Number n = fltvalue(&res);+ if (luai_numisnan(n) || n == 0)+ return 0;+ e1->k = VKFLT;+ e1->u.nval = n;+ }+ return 1;+}+++/*+** Emit code for unary expressions that "produce values"+** (everything but 'not').+** Expression to produce final result will be encoded in 'e'.+*/+static void codeunexpval (FuncState *fs, OpCode op, expdesc *e, int line) {+ int r = luaK_exp2anyreg(fs, e); /* opcodes operate only on registers */+ freeexp(fs, e);+ e->u.info = luaK_codeABC(fs, op, 0, r, 0); /* generate opcode */+ e->k = VRELOCABLE; /* all those operations are relocatable */+ luaK_fixline(fs, line);+}+++/*+** Emit code for binary expressions that "produce values"+** (everything but logical operators 'and'/'or' and comparison+** operators).+** Expression to produce final result will be encoded in 'e1'.+** Because 'luaK_exp2RK' can free registers, its calls must be+** in "stack order" (that is, first on 'e2', which may have more+** recent registers to be released).+*/+static void codebinexpval (FuncState *fs, OpCode op,+ expdesc *e1, expdesc *e2, int line) {+ int rk2 = luaK_exp2RK(fs, e2); /* both operands are "RK" */+ int rk1 = luaK_exp2RK(fs, e1);+ freeexps(fs, e1, e2);+ e1->u.info = luaK_codeABC(fs, op, 0, rk1, rk2); /* generate opcode */+ e1->k = VRELOCABLE; /* all those operations are relocatable */+ luaK_fixline(fs, line);+}+++/*+** Emit code for comparisons.+** 'e1' was already put in R/K form by 'luaK_infix'.+*/+static void codecomp (FuncState *fs, BinOpr opr, expdesc *e1, expdesc *e2) {+ int rk1 = (e1->k == VK) ? RKASK(e1->u.info)+ : check_exp(e1->k == VNONRELOC, e1->u.info);+ int rk2 = luaK_exp2RK(fs, e2);+ freeexps(fs, e1, e2);+ switch (opr) {+ case OPR_NE: { /* '(a ~= b)' ==> 'not (a == b)' */+ e1->u.info = condjump(fs, OP_EQ, 0, rk1, rk2);+ break;+ }+ case OPR_GT: case OPR_GE: {+ /* '(a > b)' ==> '(b < a)'; '(a >= b)' ==> '(b <= a)' */+ OpCode op = cast(OpCode, (opr - OPR_NE) + OP_EQ);+ e1->u.info = condjump(fs, op, 1, rk2, rk1); /* invert operands */+ break;+ }+ default: { /* '==', '<', '<=' use their own opcodes */+ OpCode op = cast(OpCode, (opr - OPR_EQ) + OP_EQ);+ e1->u.info = condjump(fs, op, 1, rk1, rk2);+ break;+ }+ }+ e1->k = VJMP;+}+++/*+** Apply prefix operation 'op' to expression 'e'.+*/+void luaK_prefix (FuncState *fs, UnOpr op, expdesc *e, int line) {+ static const expdesc ef = {VKINT, {0}, NO_JUMP, NO_JUMP};+ switch (op) {+ case OPR_MINUS: case OPR_BNOT: /* use 'ef' as fake 2nd operand */+ if (constfolding(fs, op + LUA_OPUNM, e, &ef))+ break;+ /* FALLTHROUGH */+ case OPR_LEN:+ codeunexpval(fs, cast(OpCode, op + OP_UNM), e, line);+ break;+ case OPR_NOT: codenot(fs, e); break;+ default: lua_assert(0);+ }+}+++/*+** Process 1st operand 'v' of binary operation 'op' before reading+** 2nd operand.+*/+void luaK_infix (FuncState *fs, BinOpr op, expdesc *v) {+ switch (op) {+ case OPR_AND: {+ luaK_goiftrue(fs, v); /* go ahead only if 'v' is true */+ break;+ }+ case OPR_OR: {+ luaK_goiffalse(fs, v); /* go ahead only if 'v' is false */+ break;+ }+ case OPR_CONCAT: {+ luaK_exp2nextreg(fs, v); /* operand must be on the 'stack' */+ break;+ }+ case OPR_ADD: case OPR_SUB:+ case OPR_MUL: case OPR_DIV: case OPR_IDIV:+ case OPR_MOD: case OPR_POW:+ case OPR_BAND: case OPR_BOR: case OPR_BXOR:+ case OPR_SHL: case OPR_SHR: {+ if (!tonumeral(v, NULL))+ luaK_exp2RK(fs, v);+ /* else keep numeral, which may be folded with 2nd operand */+ break;+ }+ default: {+ luaK_exp2RK(fs, v);+ break;+ }+ }+}+++/*+** Finalize code for binary operation, after reading 2nd operand.+** For '(a .. b .. c)' (which is '(a .. (b .. c))', because+** concatenation is right associative), merge second CONCAT into first+** one.+*/+void luaK_posfix (FuncState *fs, BinOpr op,+ expdesc *e1, expdesc *e2, int line) {+ switch (op) {+ case OPR_AND: {+ lua_assert(e1->t == NO_JUMP); /* list closed by 'luK_infix' */+ luaK_dischargevars(fs, e2);+ luaK_concat(fs, &e2->f, e1->f);+ *e1 = *e2;+ break;+ }+ case OPR_OR: {+ lua_assert(e1->f == NO_JUMP); /* list closed by 'luK_infix' */+ luaK_dischargevars(fs, e2);+ luaK_concat(fs, &e2->t, e1->t);+ *e1 = *e2;+ break;+ }+ case OPR_CONCAT: {+ luaK_exp2val(fs, e2);+ if (e2->k == VRELOCABLE &&+ GET_OPCODE(getinstruction(fs, e2)) == OP_CONCAT) {+ lua_assert(e1->u.info == GETARG_B(getinstruction(fs, e2))-1);+ freeexp(fs, e1);+ SETARG_B(getinstruction(fs, e2), e1->u.info);+ e1->k = VRELOCABLE; e1->u.info = e2->u.info;+ }+ else {+ luaK_exp2nextreg(fs, e2); /* operand must be on the 'stack' */+ codebinexpval(fs, OP_CONCAT, e1, e2, line);+ }+ break;+ }+ case OPR_ADD: case OPR_SUB: case OPR_MUL: case OPR_DIV:+ case OPR_IDIV: case OPR_MOD: case OPR_POW:+ case OPR_BAND: case OPR_BOR: case OPR_BXOR:+ case OPR_SHL: case OPR_SHR: {+ if (!constfolding(fs, op + LUA_OPADD, e1, e2))+ codebinexpval(fs, cast(OpCode, op + OP_ADD), e1, e2, line);+ break;+ }+ case OPR_EQ: case OPR_LT: case OPR_LE:+ case OPR_NE: case OPR_GT: case OPR_GE: {+ codecomp(fs, op, e1, e2);+ break;+ }+ default: lua_assert(0);+ }+}+++/*+** Change line information associated with current position.+*/+void luaK_fixline (FuncState *fs, int line) {+ fs->f->lineinfo[fs->pc - 1] = line;+}+++/*+** Emit a SETLIST instruction.+** 'base' is register that keeps table;+** 'nelems' is #table plus those to be stored now;+** 'tostore' is number of values (in registers 'base + 1',...) to add to+** table (or LUA_MULTRET to add up to stack top).+*/+void luaK_setlist (FuncState *fs, int base, int nelems, int tostore) {+ int c = (nelems - 1)/LFIELDS_PER_FLUSH + 1;+ int b = (tostore == LUA_MULTRET) ? 0 : tostore;+ lua_assert(tostore != 0 && tostore <= LFIELDS_PER_FLUSH);+ if (c <= MAXARG_C)+ luaK_codeABC(fs, OP_SETLIST, base, b, c);+ else if (c <= MAXARG_Ax) {+ luaK_codeABC(fs, OP_SETLIST, base, b, 0);+ codeextraarg(fs, c);+ }+ else+ luaX_syntaxerror(fs->ls, "constructor too long");+ fs->freereg = base + 1; /* free registers with list values */+}+
+ cbits/lua-5.3.6/lcode.h view
@@ -0,0 +1,88 @@+/*+** $Id: lcode.h,v 1.64.1.1 2017/04/19 17:20:42 roberto Exp $+** Code generator for Lua+** See Copyright Notice in lua.h+*/++#ifndef lcode_h+#define lcode_h++#include "llex.h"+#include "lobject.h"+#include "lopcodes.h"+#include "lparser.h"+++/*+** Marks the end of a patch list. It is an invalid value both as an absolute+** address, and as a list link (would link an element to itself).+*/+#define NO_JUMP (-1)+++/*+** grep "ORDER OPR" if you change these enums (ORDER OP)+*/+typedef enum BinOpr {+ OPR_ADD, OPR_SUB, OPR_MUL, OPR_MOD, OPR_POW,+ OPR_DIV,+ OPR_IDIV,+ OPR_BAND, OPR_BOR, OPR_BXOR,+ OPR_SHL, OPR_SHR,+ OPR_CONCAT,+ OPR_EQ, OPR_LT, OPR_LE,+ OPR_NE, OPR_GT, OPR_GE,+ OPR_AND, OPR_OR,+ OPR_NOBINOPR+} BinOpr;+++typedef enum UnOpr { OPR_MINUS, OPR_BNOT, OPR_NOT, OPR_LEN, OPR_NOUNOPR } UnOpr;+++/* get (pointer to) instruction of given 'expdesc' */+#define getinstruction(fs,e) ((fs)->f->code[(e)->u.info])++#define luaK_codeAsBx(fs,o,A,sBx) luaK_codeABx(fs,o,A,(sBx)+MAXARG_sBx)++#define luaK_setmultret(fs,e) luaK_setreturns(fs, e, LUA_MULTRET)++#define luaK_jumpto(fs,t) luaK_patchlist(fs, luaK_jump(fs), t)++LUAI_FUNC int luaK_codeABx (FuncState *fs, OpCode o, int A, unsigned int Bx);+LUAI_FUNC int luaK_codeABC (FuncState *fs, OpCode o, int A, int B, int C);+LUAI_FUNC int luaK_codek (FuncState *fs, int reg, int k);+LUAI_FUNC void luaK_fixline (FuncState *fs, int line);+LUAI_FUNC void luaK_nil (FuncState *fs, int from, int n);+LUAI_FUNC void luaK_reserveregs (FuncState *fs, int n);+LUAI_FUNC void luaK_checkstack (FuncState *fs, int n);+LUAI_FUNC int luaK_stringK (FuncState *fs, TString *s);+LUAI_FUNC int luaK_intK (FuncState *fs, lua_Integer n);+LUAI_FUNC void luaK_dischargevars (FuncState *fs, expdesc *e);+LUAI_FUNC int luaK_exp2anyreg (FuncState *fs, expdesc *e);+LUAI_FUNC void luaK_exp2anyregup (FuncState *fs, expdesc *e);+LUAI_FUNC void luaK_exp2nextreg (FuncState *fs, expdesc *e);+LUAI_FUNC void luaK_exp2val (FuncState *fs, expdesc *e);+LUAI_FUNC int luaK_exp2RK (FuncState *fs, expdesc *e);+LUAI_FUNC void luaK_self (FuncState *fs, expdesc *e, expdesc *key);+LUAI_FUNC void luaK_indexed (FuncState *fs, expdesc *t, expdesc *k);+LUAI_FUNC void luaK_goiftrue (FuncState *fs, expdesc *e);+LUAI_FUNC void luaK_goiffalse (FuncState *fs, expdesc *e);+LUAI_FUNC void luaK_storevar (FuncState *fs, expdesc *var, expdesc *e);+LUAI_FUNC void luaK_setreturns (FuncState *fs, expdesc *e, int nresults);+LUAI_FUNC void luaK_setoneret (FuncState *fs, expdesc *e);+LUAI_FUNC int luaK_jump (FuncState *fs);+LUAI_FUNC void luaK_ret (FuncState *fs, int first, int nret);+LUAI_FUNC void luaK_patchlist (FuncState *fs, int list, int target);+LUAI_FUNC void luaK_patchtohere (FuncState *fs, int list);+LUAI_FUNC void luaK_patchclose (FuncState *fs, int list, int level);+LUAI_FUNC void luaK_concat (FuncState *fs, int *l1, int l2);+LUAI_FUNC int luaK_getlabel (FuncState *fs);+LUAI_FUNC void luaK_prefix (FuncState *fs, UnOpr op, expdesc *v, int line);+LUAI_FUNC void luaK_infix (FuncState *fs, BinOpr op, expdesc *v);+LUAI_FUNC void luaK_posfix (FuncState *fs, BinOpr op, expdesc *v1,+ expdesc *v2, int line);+LUAI_FUNC void luaK_setlist (FuncState *fs, int base, int nelems, int tostore);+++#endif
+ cbits/lua-5.3.6/lcorolib.c view
@@ -0,0 +1,168 @@+/*+** $Id: lcorolib.c,v 1.10.1.1 2017/04/19 17:20:42 roberto Exp $+** Coroutine Library+** See Copyright Notice in lua.h+*/++#define lcorolib_c+#define LUA_LIB++#include "lprefix.h"+++#include <stdlib.h>++#include "lua.h"++#include "lauxlib.h"+#include "lualib.h"+++static lua_State *getco (lua_State *L) {+ lua_State *co = lua_tothread(L, 1);+ luaL_argcheck(L, co, 1, "thread expected");+ return co;+}+++static int auxresume (lua_State *L, lua_State *co, int narg) {+ int status;+ if (!lua_checkstack(co, narg)) {+ lua_pushliteral(L, "too many arguments to resume");+ return -1; /* error flag */+ }+ if (lua_status(co) == LUA_OK && lua_gettop(co) == 0) {+ lua_pushliteral(L, "cannot resume dead coroutine");+ return -1; /* error flag */+ }+ lua_xmove(L, co, narg);+ status = lua_resume(co, L, narg);+ if (status == LUA_OK || status == LUA_YIELD) {+ int nres = lua_gettop(co);+ if (!lua_checkstack(L, nres + 1)) {+ lua_pop(co, nres); /* remove results anyway */+ lua_pushliteral(L, "too many results to resume");+ return -1; /* error flag */+ }+ lua_xmove(co, L, nres); /* move yielded values */+ return nres;+ }+ else {+ lua_xmove(co, L, 1); /* move error message */+ return -1; /* error flag */+ }+}+++static int luaB_coresume (lua_State *L) {+ lua_State *co = getco(L);+ int r;+ r = auxresume(L, co, lua_gettop(L) - 1);+ if (r < 0) {+ lua_pushboolean(L, 0);+ lua_insert(L, -2);+ return 2; /* return false + error message */+ }+ else {+ lua_pushboolean(L, 1);+ lua_insert(L, -(r + 1));+ return r + 1; /* return true + 'resume' returns */+ }+}+++static int luaB_auxwrap (lua_State *L) {+ lua_State *co = lua_tothread(L, lua_upvalueindex(1));+ int r = auxresume(L, co, lua_gettop(L));+ if (r < 0) {+ if (lua_type(L, -1) == LUA_TSTRING) { /* error object is a string? */+ luaL_where(L, 1); /* add extra info */+ lua_insert(L, -2);+ lua_concat(L, 2);+ }+ return lua_error(L); /* propagate error */+ }+ return r;+}+++static int luaB_cocreate (lua_State *L) {+ lua_State *NL;+ luaL_checktype(L, 1, LUA_TFUNCTION);+ NL = lua_newthread(L);+ lua_pushvalue(L, 1); /* move function to top */+ lua_xmove(L, NL, 1); /* move function from L to NL */+ return 1;+}+++static int luaB_cowrap (lua_State *L) {+ luaB_cocreate(L);+ lua_pushcclosure(L, luaB_auxwrap, 1);+ return 1;+}+++static int luaB_yield (lua_State *L) {+ return lua_yield(L, lua_gettop(L));+}+++static int luaB_costatus (lua_State *L) {+ lua_State *co = getco(L);+ if (L == co) lua_pushliteral(L, "running");+ else {+ switch (lua_status(co)) {+ case LUA_YIELD:+ lua_pushliteral(L, "suspended");+ break;+ case LUA_OK: {+ lua_Debug ar;+ if (lua_getstack(co, 0, &ar) > 0) /* does it have frames? */+ lua_pushliteral(L, "normal"); /* it is running */+ else if (lua_gettop(co) == 0)+ lua_pushliteral(L, "dead");+ else+ lua_pushliteral(L, "suspended"); /* initial state */+ break;+ }+ default: /* some error occurred */+ lua_pushliteral(L, "dead");+ break;+ }+ }+ return 1;+}+++static int luaB_yieldable (lua_State *L) {+ lua_pushboolean(L, lua_isyieldable(L));+ return 1;+}+++static int luaB_corunning (lua_State *L) {+ int ismain = lua_pushthread(L);+ lua_pushboolean(L, ismain);+ return 2;+}+++static const luaL_Reg co_funcs[] = {+ {"create", luaB_cocreate},+ {"resume", luaB_coresume},+ {"running", luaB_corunning},+ {"status", luaB_costatus},+ {"wrap", luaB_cowrap},+ {"yield", luaB_yield},+ {"isyieldable", luaB_yieldable},+ {NULL, NULL}+};++++LUAMOD_API int luaopen_coroutine (lua_State *L) {+ luaL_newlib(L, co_funcs);+ return 1;+}+
+ cbits/lua-5.3.6/lctype.c view
@@ -0,0 +1,55 @@+/*+** $Id: lctype.c,v 1.12.1.1 2017/04/19 17:20:42 roberto Exp $+** 'ctype' functions for Lua+** See Copyright Notice in lua.h+*/++#define lctype_c+#define LUA_CORE++#include "lprefix.h"+++#include "lctype.h"++#if !LUA_USE_CTYPE /* { */++#include <limits.h>++LUAI_DDEF const lu_byte luai_ctype_[UCHAR_MAX + 2] = {+ 0x00, /* EOZ */+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* 0. */+ 0x00, 0x08, 0x08, 0x08, 0x08, 0x08, 0x00, 0x00,+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* 1. */+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,+ 0x0c, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04, /* 2. */+ 0x04, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04,+ 0x16, 0x16, 0x16, 0x16, 0x16, 0x16, 0x16, 0x16, /* 3. */+ 0x16, 0x16, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04,+ 0x04, 0x15, 0x15, 0x15, 0x15, 0x15, 0x15, 0x05, /* 4. */+ 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05,+ 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, /* 5. */+ 0x05, 0x05, 0x05, 0x04, 0x04, 0x04, 0x04, 0x05,+ 0x04, 0x15, 0x15, 0x15, 0x15, 0x15, 0x15, 0x05, /* 6. */+ 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05,+ 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, /* 7. */+ 0x05, 0x05, 0x05, 0x04, 0x04, 0x04, 0x04, 0x00,+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* 8. */+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* 9. */+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* a. */+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* b. */+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* c. */+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* d. */+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* e. */+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* f. */+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,+};++#endif /* } */
+ cbits/lua-5.3.6/lctype.h view
@@ -0,0 +1,95 @@+/*+** $Id: lctype.h,v 1.12.1.1 2013/04/12 18:48:47 roberto Exp $+** 'ctype' functions for Lua+** See Copyright Notice in lua.h+*/++#ifndef lctype_h+#define lctype_h++#include "lua.h"+++/*+** WARNING: the functions defined here do not necessarily correspond+** to the similar functions in the standard C ctype.h. They are+** optimized for the specific needs of Lua+*/++#if !defined(LUA_USE_CTYPE)++#if 'A' == 65 && '0' == 48+/* ASCII case: can use its own tables; faster and fixed */+#define LUA_USE_CTYPE 0+#else+/* must use standard C ctype */+#define LUA_USE_CTYPE 1+#endif++#endif+++#if !LUA_USE_CTYPE /* { */++#include <limits.h>++#include "llimits.h"+++#define ALPHABIT 0+#define DIGITBIT 1+#define PRINTBIT 2+#define SPACEBIT 3+#define XDIGITBIT 4+++#define MASK(B) (1 << (B))+++/*+** add 1 to char to allow index -1 (EOZ)+*/+#define testprop(c,p) (luai_ctype_[(c)+1] & (p))++/*+** 'lalpha' (Lua alphabetic) and 'lalnum' (Lua alphanumeric) both include '_'+*/+#define lislalpha(c) testprop(c, MASK(ALPHABIT))+#define lislalnum(c) testprop(c, (MASK(ALPHABIT) | MASK(DIGITBIT)))+#define lisdigit(c) testprop(c, MASK(DIGITBIT))+#define lisspace(c) testprop(c, MASK(SPACEBIT))+#define lisprint(c) testprop(c, MASK(PRINTBIT))+#define lisxdigit(c) testprop(c, MASK(XDIGITBIT))++/*+** this 'ltolower' only works for alphabetic characters+*/+#define ltolower(c) ((c) | ('A' ^ 'a'))+++/* two more entries for 0 and -1 (EOZ) */+LUAI_DDEC const lu_byte luai_ctype_[UCHAR_MAX + 2];+++#else /* }{ */++/*+** use standard C ctypes+*/++#include <ctype.h>+++#define lislalpha(c) (isalpha(c) || (c) == '_')+#define lislalnum(c) (isalnum(c) || (c) == '_')+#define lisdigit(c) (isdigit(c))+#define lisspace(c) (isspace(c))+#define lisprint(c) (isprint(c))+#define lisxdigit(c) (isxdigit(c))++#define ltolower(c) (tolower(c))++#endif /* } */++#endif+
+ cbits/lua-5.3.6/ldblib.c view
@@ -0,0 +1,456 @@+/*+** $Id: ldblib.c,v 1.151.1.1 2017/04/19 17:20:42 roberto Exp $+** Interface from Lua to its debug API+** See Copyright Notice in lua.h+*/++#define ldblib_c+#define LUA_LIB++#include "lprefix.h"+++#include <stdio.h>+#include <stdlib.h>+#include <string.h>++#include "lua.h"++#include "lauxlib.h"+#include "lualib.h"+++/*+** The hook table at registry[&HOOKKEY] maps threads to their current+** hook function. (We only need the unique address of 'HOOKKEY'.)+*/+static const int HOOKKEY = 0;+++/*+** If L1 != L, L1 can be in any state, and therefore there are no+** guarantees about its stack space; any push in L1 must be+** checked.+*/+static void checkstack (lua_State *L, lua_State *L1, int n) {+ if (L != L1 && !lua_checkstack(L1, n))+ luaL_error(L, "stack overflow");+}+++static int db_getregistry (lua_State *L) {+ lua_pushvalue(L, LUA_REGISTRYINDEX);+ return 1;+}+++static int db_getmetatable (lua_State *L) {+ luaL_checkany(L, 1);+ if (!lua_getmetatable(L, 1)) {+ lua_pushnil(L); /* no metatable */+ }+ return 1;+}+++static int db_setmetatable (lua_State *L) {+ int t = lua_type(L, 2);+ luaL_argcheck(L, t == LUA_TNIL || t == LUA_TTABLE, 2,+ "nil or table expected");+ lua_settop(L, 2);+ lua_setmetatable(L, 1);+ return 1; /* return 1st argument */+}+++static int db_getuservalue (lua_State *L) {+ if (lua_type(L, 1) != LUA_TUSERDATA)+ lua_pushnil(L);+ else+ lua_getuservalue(L, 1);+ return 1;+}+++static int db_setuservalue (lua_State *L) {+ luaL_checktype(L, 1, LUA_TUSERDATA);+ luaL_checkany(L, 2);+ lua_settop(L, 2);+ lua_setuservalue(L, 1);+ return 1;+}+++/*+** Auxiliary function used by several library functions: check for+** an optional thread as function's first argument and set 'arg' with+** 1 if this argument is present (so that functions can skip it to+** access their other arguments)+*/+static lua_State *getthread (lua_State *L, int *arg) {+ if (lua_isthread(L, 1)) {+ *arg = 1;+ return lua_tothread(L, 1);+ }+ else {+ *arg = 0;+ return L; /* function will operate over current thread */+ }+}+++/*+** Variations of 'lua_settable', used by 'db_getinfo' to put results+** from 'lua_getinfo' into result table. Key is always a string;+** value can be a string, an int, or a boolean.+*/+static void settabss (lua_State *L, const char *k, const char *v) {+ lua_pushstring(L, v);+ lua_setfield(L, -2, k);+}++static void settabsi (lua_State *L, const char *k, int v) {+ lua_pushinteger(L, v);+ lua_setfield(L, -2, k);+}++static void settabsb (lua_State *L, const char *k, int v) {+ lua_pushboolean(L, v);+ lua_setfield(L, -2, k);+}+++/*+** In function 'db_getinfo', the call to 'lua_getinfo' may push+** results on the stack; later it creates the result table to put+** these objects. Function 'treatstackoption' puts the result from+** 'lua_getinfo' on top of the result table so that it can call+** 'lua_setfield'.+*/+static void treatstackoption (lua_State *L, lua_State *L1, const char *fname) {+ if (L == L1)+ lua_rotate(L, -2, 1); /* exchange object and table */+ else+ lua_xmove(L1, L, 1); /* move object to the "main" stack */+ lua_setfield(L, -2, fname); /* put object into table */+}+++/*+** Calls 'lua_getinfo' and collects all results in a new table.+** L1 needs stack space for an optional input (function) plus+** two optional outputs (function and line table) from function+** 'lua_getinfo'.+*/+static int db_getinfo (lua_State *L) {+ lua_Debug ar;+ int arg;+ lua_State *L1 = getthread(L, &arg);+ const char *options = luaL_optstring(L, arg+2, "flnStu");+ checkstack(L, L1, 3);+ if (lua_isfunction(L, arg + 1)) { /* info about a function? */+ options = lua_pushfstring(L, ">%s", options); /* add '>' to 'options' */+ lua_pushvalue(L, arg + 1); /* move function to 'L1' stack */+ lua_xmove(L, L1, 1);+ }+ else { /* stack level */+ if (!lua_getstack(L1, (int)luaL_checkinteger(L, arg + 1), &ar)) {+ lua_pushnil(L); /* level out of range */+ return 1;+ }+ }+ if (!lua_getinfo(L1, options, &ar))+ return luaL_argerror(L, arg+2, "invalid option");+ lua_newtable(L); /* table to collect results */+ if (strchr(options, 'S')) {+ settabss(L, "source", ar.source);+ settabss(L, "short_src", ar.short_src);+ settabsi(L, "linedefined", ar.linedefined);+ settabsi(L, "lastlinedefined", ar.lastlinedefined);+ settabss(L, "what", ar.what);+ }+ if (strchr(options, 'l'))+ settabsi(L, "currentline", ar.currentline);+ if (strchr(options, 'u')) {+ settabsi(L, "nups", ar.nups);+ settabsi(L, "nparams", ar.nparams);+ settabsb(L, "isvararg", ar.isvararg);+ }+ if (strchr(options, 'n')) {+ settabss(L, "name", ar.name);+ settabss(L, "namewhat", ar.namewhat);+ }+ if (strchr(options, 't'))+ settabsb(L, "istailcall", ar.istailcall);+ if (strchr(options, 'L'))+ treatstackoption(L, L1, "activelines");+ if (strchr(options, 'f'))+ treatstackoption(L, L1, "func");+ return 1; /* return table */+}+++static int db_getlocal (lua_State *L) {+ int arg;+ lua_State *L1 = getthread(L, &arg);+ lua_Debug ar;+ const char *name;+ int nvar = (int)luaL_checkinteger(L, arg + 2); /* local-variable index */+ if (lua_isfunction(L, arg + 1)) { /* function argument? */+ lua_pushvalue(L, arg + 1); /* push function */+ lua_pushstring(L, lua_getlocal(L, NULL, nvar)); /* push local name */+ return 1; /* return only name (there is no value) */+ }+ else { /* stack-level argument */+ int level = (int)luaL_checkinteger(L, arg + 1);+ if (!lua_getstack(L1, level, &ar)) /* out of range? */+ return luaL_argerror(L, arg+1, "level out of range");+ checkstack(L, L1, 1);+ name = lua_getlocal(L1, &ar, nvar);+ if (name) {+ lua_xmove(L1, L, 1); /* move local value */+ lua_pushstring(L, name); /* push name */+ lua_rotate(L, -2, 1); /* re-order */+ return 2;+ }+ else {+ lua_pushnil(L); /* no name (nor value) */+ return 1;+ }+ }+}+++static int db_setlocal (lua_State *L) {+ int arg;+ const char *name;+ lua_State *L1 = getthread(L, &arg);+ lua_Debug ar;+ int level = (int)luaL_checkinteger(L, arg + 1);+ int nvar = (int)luaL_checkinteger(L, arg + 2);+ if (!lua_getstack(L1, level, &ar)) /* out of range? */+ return luaL_argerror(L, arg+1, "level out of range");+ luaL_checkany(L, arg+3);+ lua_settop(L, arg+3);+ checkstack(L, L1, 1);+ lua_xmove(L, L1, 1);+ name = lua_setlocal(L1, &ar, nvar);+ if (name == NULL)+ lua_pop(L1, 1); /* pop value (if not popped by 'lua_setlocal') */+ lua_pushstring(L, name);+ return 1;+}+++/*+** get (if 'get' is true) or set an upvalue from a closure+*/+static int auxupvalue (lua_State *L, int get) {+ const char *name;+ int n = (int)luaL_checkinteger(L, 2); /* upvalue index */+ luaL_checktype(L, 1, LUA_TFUNCTION); /* closure */+ name = get ? lua_getupvalue(L, 1, n) : lua_setupvalue(L, 1, n);+ if (name == NULL) return 0;+ lua_pushstring(L, name);+ lua_insert(L, -(get+1)); /* no-op if get is false */+ return get + 1;+}+++static int db_getupvalue (lua_State *L) {+ return auxupvalue(L, 1);+}+++static int db_setupvalue (lua_State *L) {+ luaL_checkany(L, 3);+ return auxupvalue(L, 0);+}+++/*+** Check whether a given upvalue from a given closure exists and+** returns its index+*/+static int checkupval (lua_State *L, int argf, int argnup) {+ int nup = (int)luaL_checkinteger(L, argnup); /* upvalue index */+ luaL_checktype(L, argf, LUA_TFUNCTION); /* closure */+ luaL_argcheck(L, (lua_getupvalue(L, argf, nup) != NULL), argnup,+ "invalid upvalue index");+ return nup;+}+++static int db_upvalueid (lua_State *L) {+ int n = checkupval(L, 1, 2);+ lua_pushlightuserdata(L, lua_upvalueid(L, 1, n));+ return 1;+}+++static int db_upvaluejoin (lua_State *L) {+ int n1 = checkupval(L, 1, 2);+ int n2 = checkupval(L, 3, 4);+ luaL_argcheck(L, !lua_iscfunction(L, 1), 1, "Lua function expected");+ luaL_argcheck(L, !lua_iscfunction(L, 3), 3, "Lua function expected");+ lua_upvaluejoin(L, 1, n1, 3, n2);+ return 0;+}+++/*+** Call hook function registered at hook table for the current+** thread (if there is one)+*/+static void hookf (lua_State *L, lua_Debug *ar) {+ static const char *const hooknames[] =+ {"call", "return", "line", "count", "tail call"};+ lua_rawgetp(L, LUA_REGISTRYINDEX, &HOOKKEY);+ lua_pushthread(L);+ if (lua_rawget(L, -2) == LUA_TFUNCTION) { /* is there a hook function? */+ lua_pushstring(L, hooknames[(int)ar->event]); /* push event name */+ if (ar->currentline >= 0)+ lua_pushinteger(L, ar->currentline); /* push current line */+ else lua_pushnil(L);+ lua_assert(lua_getinfo(L, "lS", ar));+ lua_call(L, 2, 0); /* call hook function */+ }+}+++/*+** Convert a string mask (for 'sethook') into a bit mask+*/+static int makemask (const char *smask, int count) {+ int mask = 0;+ if (strchr(smask, 'c')) mask |= LUA_MASKCALL;+ if (strchr(smask, 'r')) mask |= LUA_MASKRET;+ if (strchr(smask, 'l')) mask |= LUA_MASKLINE;+ if (count > 0) mask |= LUA_MASKCOUNT;+ return mask;+}+++/*+** Convert a bit mask (for 'gethook') into a string mask+*/+static char *unmakemask (int mask, char *smask) {+ int i = 0;+ if (mask & LUA_MASKCALL) smask[i++] = 'c';+ if (mask & LUA_MASKRET) smask[i++] = 'r';+ if (mask & LUA_MASKLINE) smask[i++] = 'l';+ smask[i] = '\0';+ return smask;+}+++static int db_sethook (lua_State *L) {+ int arg, mask, count;+ lua_Hook func;+ lua_State *L1 = getthread(L, &arg);+ if (lua_isnoneornil(L, arg+1)) { /* no hook? */+ lua_settop(L, arg+1);+ func = NULL; mask = 0; count = 0; /* turn off hooks */+ }+ else {+ const char *smask = luaL_checkstring(L, arg+2);+ luaL_checktype(L, arg+1, LUA_TFUNCTION);+ count = (int)luaL_optinteger(L, arg + 3, 0);+ func = hookf; mask = makemask(smask, count);+ }+ if (lua_rawgetp(L, LUA_REGISTRYINDEX, &HOOKKEY) == LUA_TNIL) {+ lua_createtable(L, 0, 2); /* create a hook table */+ lua_pushvalue(L, -1);+ lua_rawsetp(L, LUA_REGISTRYINDEX, &HOOKKEY); /* set it in position */+ lua_pushstring(L, "k");+ lua_setfield(L, -2, "__mode"); /** hooktable.__mode = "k" */+ lua_pushvalue(L, -1);+ lua_setmetatable(L, -2); /* setmetatable(hooktable) = hooktable */+ }+ checkstack(L, L1, 1);+ lua_pushthread(L1); lua_xmove(L1, L, 1); /* key (thread) */+ lua_pushvalue(L, arg + 1); /* value (hook function) */+ lua_rawset(L, -3); /* hooktable[L1] = new Lua hook */+ lua_sethook(L1, func, mask, count);+ return 0;+}+++static int db_gethook (lua_State *L) {+ int arg;+ lua_State *L1 = getthread(L, &arg);+ char buff[5];+ int mask = lua_gethookmask(L1);+ lua_Hook hook = lua_gethook(L1);+ if (hook == NULL) /* no hook? */+ lua_pushnil(L);+ else if (hook != hookf) /* external hook? */+ lua_pushliteral(L, "external hook");+ else { /* hook table must exist */+ lua_rawgetp(L, LUA_REGISTRYINDEX, &HOOKKEY);+ checkstack(L, L1, 1);+ lua_pushthread(L1); lua_xmove(L1, L, 1);+ lua_rawget(L, -2); /* 1st result = hooktable[L1] */+ lua_remove(L, -2); /* remove hook table */+ }+ lua_pushstring(L, unmakemask(mask, buff)); /* 2nd result = mask */+ lua_pushinteger(L, lua_gethookcount(L1)); /* 3rd result = count */+ return 3;+}+++static int db_debug (lua_State *L) {+ for (;;) {+ char buffer[250];+ lua_writestringerror("%s", "lua_debug> ");+ if (fgets(buffer, sizeof(buffer), stdin) == 0 ||+ strcmp(buffer, "cont\n") == 0)+ return 0;+ if (luaL_loadbuffer(L, buffer, strlen(buffer), "=(debug command)") ||+ lua_pcall(L, 0, 0, 0))+ lua_writestringerror("%s\n", lua_tostring(L, -1));+ lua_settop(L, 0); /* remove eventual returns */+ }+}+++static int db_traceback (lua_State *L) {+ int arg;+ lua_State *L1 = getthread(L, &arg);+ const char *msg = lua_tostring(L, arg + 1);+ if (msg == NULL && !lua_isnoneornil(L, arg + 1)) /* non-string 'msg'? */+ lua_pushvalue(L, arg + 1); /* return it untouched */+ else {+ int level = (int)luaL_optinteger(L, arg + 2, (L == L1) ? 1 : 0);+ luaL_traceback(L, L1, msg, level);+ }+ return 1;+}+++static const luaL_Reg dblib[] = {+ {"debug", db_debug},+ {"getuservalue", db_getuservalue},+ {"gethook", db_gethook},+ {"getinfo", db_getinfo},+ {"getlocal", db_getlocal},+ {"getregistry", db_getregistry},+ {"getmetatable", db_getmetatable},+ {"getupvalue", db_getupvalue},+ {"upvaluejoin", db_upvaluejoin},+ {"upvalueid", db_upvalueid},+ {"setuservalue", db_setuservalue},+ {"sethook", db_sethook},+ {"setlocal", db_setlocal},+ {"setmetatable", db_setmetatable},+ {"setupvalue", db_setupvalue},+ {"traceback", db_traceback},+ {NULL, NULL}+};+++LUAMOD_API int luaopen_debug (lua_State *L) {+ luaL_newlib(L, dblib);+ return 1;+}+
+ cbits/lua-5.3.6/ldebug.c view
@@ -0,0 +1,700 @@+/*+** $Id: ldebug.c,v 2.121.1.2 2017/07/10 17:21:50 roberto Exp $+** Debug Interface+** See Copyright Notice in lua.h+*/++#define ldebug_c+#define LUA_CORE++#include "lprefix.h"+++#include <stdarg.h>+#include <stddef.h>+#include <string.h>++#include "lua.h"++#include "lapi.h"+#include "lcode.h"+#include "ldebug.h"+#include "ldo.h"+#include "lfunc.h"+#include "lobject.h"+#include "lopcodes.h"+#include "lstate.h"+#include "lstring.h"+#include "ltable.h"+#include "ltm.h"+#include "lvm.h"++++#define noLuaClosure(f) ((f) == NULL || (f)->c.tt == LUA_TCCL)+++/* Active Lua function (given call info) */+#define ci_func(ci) (clLvalue((ci)->func))+++static const char *funcnamefromcode (lua_State *L, CallInfo *ci,+ const char **name);+++static int currentpc (CallInfo *ci) {+ lua_assert(isLua(ci));+ return pcRel(ci->u.l.savedpc, ci_func(ci)->p);+}+++static int currentline (CallInfo *ci) {+ return getfuncline(ci_func(ci)->p, currentpc(ci));+}+++/*+** If function yielded, its 'func' can be in the 'extra' field. The+** next function restores 'func' to its correct value for debugging+** purposes. (It exchanges 'func' and 'extra'; so, when called again,+** after debugging, it also "re-restores" ** 'func' to its altered value.+*/+static void swapextra (lua_State *L) {+ if (L->status == LUA_YIELD) {+ CallInfo *ci = L->ci; /* get function that yielded */+ StkId temp = ci->func; /* exchange its 'func' and 'extra' values */+ ci->func = restorestack(L, ci->extra);+ ci->extra = savestack(L, temp);+ }+}+++/*+** This function can be called asynchronously (e.g. during a signal).+** Fields 'oldpc', 'basehookcount', and 'hookcount' (set by+** 'resethookcount') are for debug only, and it is no problem if they+** get arbitrary values (causes at most one wrong hook call). 'hookmask'+** is an atomic value. We assume that pointers are atomic too (e.g., gcc+** ensures that for all platforms where it runs). Moreover, 'hook' is+** always checked before being called (see 'luaD_hook').+*/+LUA_API void lua_sethook (lua_State *L, lua_Hook func, int mask, int count) {+ if (func == NULL || mask == 0) { /* turn off hooks? */+ mask = 0;+ func = NULL;+ }+ if (isLua(L->ci))+ L->oldpc = L->ci->u.l.savedpc;+ L->hook = func;+ L->basehookcount = count;+ resethookcount(L);+ L->hookmask = cast_byte(mask);+}+++LUA_API lua_Hook lua_gethook (lua_State *L) {+ return L->hook;+}+++LUA_API int lua_gethookmask (lua_State *L) {+ return L->hookmask;+}+++LUA_API int lua_gethookcount (lua_State *L) {+ return L->basehookcount;+}+++LUA_API int lua_getstack (lua_State *L, int level, lua_Debug *ar) {+ int status;+ CallInfo *ci;+ if (level < 0) return 0; /* invalid (negative) level */+ lua_lock(L);+ for (ci = L->ci; level > 0 && ci != &L->base_ci; ci = ci->previous)+ level--;+ if (level == 0 && ci != &L->base_ci) { /* level found? */+ status = 1;+ ar->i_ci = ci;+ }+ else status = 0; /* no such level */+ lua_unlock(L);+ return status;+}+++static const char *upvalname (Proto *p, int uv) {+ TString *s = check_exp(uv < p->sizeupvalues, p->upvalues[uv].name);+ if (s == NULL) return "?";+ else return getstr(s);+}+++static const char *findvararg (CallInfo *ci, int n, StkId *pos) {+ int nparams = clLvalue(ci->func)->p->numparams;+ int nvararg = cast_int(ci->u.l.base - ci->func) - nparams;+ if (n <= -nvararg)+ return NULL; /* no such vararg */+ else {+ *pos = ci->func + nparams - n;+ return "(*vararg)"; /* generic name for any vararg */+ }+}+++static const char *findlocal (lua_State *L, CallInfo *ci, int n,+ StkId *pos) {+ const char *name = NULL;+ StkId base;+ if (isLua(ci)) {+ if (n < 0) /* access to vararg values? */+ return findvararg(ci, n, pos);+ else {+ base = ci->u.l.base;+ name = luaF_getlocalname(ci_func(ci)->p, n, currentpc(ci));+ }+ }+ else+ base = ci->func + 1;+ if (name == NULL) { /* no 'standard' name? */+ StkId limit = (ci == L->ci) ? L->top : ci->next->func;+ if (limit - base >= n && n > 0) /* is 'n' inside 'ci' stack? */+ name = "(*temporary)"; /* generic name for any valid slot */+ else+ return NULL; /* no name */+ }+ *pos = base + (n - 1);+ return name;+}+++LUA_API const char *lua_getlocal (lua_State *L, const lua_Debug *ar, int n) {+ const char *name;+ lua_lock(L);+ swapextra(L);+ if (ar == NULL) { /* information about non-active function? */+ if (!isLfunction(L->top - 1)) /* not a Lua function? */+ name = NULL;+ else /* consider live variables at function start (parameters) */+ name = luaF_getlocalname(clLvalue(L->top - 1)->p, n, 0);+ }+ else { /* active function; get information through 'ar' */+ StkId pos = NULL; /* to avoid warnings */+ name = findlocal(L, ar->i_ci, n, &pos);+ if (name) {+ setobj2s(L, L->top, pos);+ api_incr_top(L);+ }+ }+ swapextra(L);+ lua_unlock(L);+ return name;+}+++LUA_API const char *lua_setlocal (lua_State *L, const lua_Debug *ar, int n) {+ StkId pos = NULL; /* to avoid warnings */+ const char *name;+ lua_lock(L);+ swapextra(L);+ name = findlocal(L, ar->i_ci, n, &pos);+ if (name) {+ setobjs2s(L, pos, L->top - 1);+ L->top--; /* pop value */+ }+ swapextra(L);+ lua_unlock(L);+ return name;+}+++static void funcinfo (lua_Debug *ar, Closure *cl) {+ if (noLuaClosure(cl)) {+ ar->source = "=[C]";+ ar->linedefined = -1;+ ar->lastlinedefined = -1;+ ar->what = "C";+ }+ else {+ Proto *p = cl->l.p;+ ar->source = p->source ? getstr(p->source) : "=?";+ ar->linedefined = p->linedefined;+ ar->lastlinedefined = p->lastlinedefined;+ ar->what = (ar->linedefined == 0) ? "main" : "Lua";+ }+ luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE);+}+++static void collectvalidlines (lua_State *L, Closure *f) {+ if (noLuaClosure(f)) {+ setnilvalue(L->top);+ api_incr_top(L);+ }+ else {+ int i;+ TValue v;+ int *lineinfo = f->l.p->lineinfo;+ Table *t = luaH_new(L); /* new table to store active lines */+ sethvalue(L, L->top, t); /* push it on stack */+ api_incr_top(L);+ setbvalue(&v, 1); /* boolean 'true' to be the value of all indices */+ for (i = 0; i < f->l.p->sizelineinfo; i++) /* for all lines with code */+ luaH_setint(L, t, lineinfo[i], &v); /* table[line] = true */+ }+}+++static const char *getfuncname (lua_State *L, CallInfo *ci, const char **name) {+ if (ci == NULL) /* no 'ci'? */+ return NULL; /* no info */+ else if (ci->callstatus & CIST_FIN) { /* is this a finalizer? */+ *name = "__gc";+ return "metamethod"; /* report it as such */+ }+ /* calling function is a known Lua function? */+ else if (!(ci->callstatus & CIST_TAIL) && isLua(ci->previous))+ return funcnamefromcode(L, ci->previous, name);+ else return NULL; /* no way to find a name */+}+++static int auxgetinfo (lua_State *L, const char *what, lua_Debug *ar,+ Closure *f, CallInfo *ci) {+ int status = 1;+ for (; *what; what++) {+ switch (*what) {+ case 'S': {+ funcinfo(ar, f);+ break;+ }+ case 'l': {+ ar->currentline = (ci && isLua(ci)) ? currentline(ci) : -1;+ break;+ }+ case 'u': {+ ar->nups = (f == NULL) ? 0 : f->c.nupvalues;+ if (noLuaClosure(f)) {+ ar->isvararg = 1;+ ar->nparams = 0;+ }+ else {+ ar->isvararg = f->l.p->is_vararg;+ ar->nparams = f->l.p->numparams;+ }+ break;+ }+ case 't': {+ ar->istailcall = (ci) ? ci->callstatus & CIST_TAIL : 0;+ break;+ }+ case 'n': {+ ar->namewhat = getfuncname(L, ci, &ar->name);+ if (ar->namewhat == NULL) {+ ar->namewhat = ""; /* not found */+ ar->name = NULL;+ }+ break;+ }+ case 'L':+ case 'f': /* handled by lua_getinfo */+ break;+ default: status = 0; /* invalid option */+ }+ }+ return status;+}+++LUA_API int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar) {+ int status;+ Closure *cl;+ CallInfo *ci;+ StkId func;+ lua_lock(L);+ swapextra(L);+ if (*what == '>') {+ ci = NULL;+ func = L->top - 1;+ api_check(L, ttisfunction(func), "function expected");+ what++; /* skip the '>' */+ L->top--; /* pop function */+ }+ else {+ ci = ar->i_ci;+ func = ci->func;+ lua_assert(ttisfunction(ci->func));+ }+ cl = ttisclosure(func) ? clvalue(func) : NULL;+ status = auxgetinfo(L, what, ar, cl, ci);+ if (strchr(what, 'f')) {+ setobjs2s(L, L->top, func);+ api_incr_top(L);+ }+ swapextra(L); /* correct before option 'L', which can raise a mem. error */+ if (strchr(what, 'L'))+ collectvalidlines(L, cl);+ lua_unlock(L);+ return status;+}+++/*+** {======================================================+** Symbolic Execution+** =======================================================+*/++static const char *getobjname (Proto *p, int lastpc, int reg,+ const char **name);+++/*+** find a "name" for the RK value 'c'+*/+static void kname (Proto *p, int pc, int c, const char **name) {+ if (ISK(c)) { /* is 'c' a constant? */+ TValue *kvalue = &p->k[INDEXK(c)];+ if (ttisstring(kvalue)) { /* literal constant? */+ *name = svalue(kvalue); /* it is its own name */+ return;+ }+ /* else no reasonable name found */+ }+ else { /* 'c' is a register */+ const char *what = getobjname(p, pc, c, name); /* search for 'c' */+ if (what && *what == 'c') { /* found a constant name? */+ return; /* 'name' already filled */+ }+ /* else no reasonable name found */+ }+ *name = "?"; /* no reasonable name found */+}+++static int filterpc (int pc, int jmptarget) {+ if (pc < jmptarget) /* is code conditional (inside a jump)? */+ return -1; /* cannot know who sets that register */+ else return pc; /* current position sets that register */+}+++/*+** try to find last instruction before 'lastpc' that modified register 'reg'+*/+static int findsetreg (Proto *p, int lastpc, int reg) {+ int pc;+ int setreg = -1; /* keep last instruction that changed 'reg' */+ int jmptarget = 0; /* any code before this address is conditional */+ for (pc = 0; pc < lastpc; pc++) {+ Instruction i = p->code[pc];+ OpCode op = GET_OPCODE(i);+ int a = GETARG_A(i);+ switch (op) {+ case OP_LOADNIL: {+ int b = GETARG_B(i);+ if (a <= reg && reg <= a + b) /* set registers from 'a' to 'a+b' */+ setreg = filterpc(pc, jmptarget);+ break;+ }+ case OP_TFORCALL: {+ if (reg >= a + 2) /* affect all regs above its base */+ setreg = filterpc(pc, jmptarget);+ break;+ }+ case OP_CALL:+ case OP_TAILCALL: {+ if (reg >= a) /* affect all registers above base */+ setreg = filterpc(pc, jmptarget);+ break;+ }+ case OP_JMP: {+ int b = GETARG_sBx(i);+ int dest = pc + 1 + b;+ /* jump is forward and do not skip 'lastpc'? */+ if (pc < dest && dest <= lastpc) {+ if (dest > jmptarget)+ jmptarget = dest; /* update 'jmptarget' */+ }+ break;+ }+ default:+ if (testAMode(op) && reg == a) /* any instruction that set A */+ setreg = filterpc(pc, jmptarget);+ break;+ }+ }+ return setreg;+}+++static const char *getobjname (Proto *p, int lastpc, int reg,+ const char **name) {+ int pc;+ *name = luaF_getlocalname(p, reg + 1, lastpc);+ if (*name) /* is a local? */+ return "local";+ /* else try symbolic execution */+ pc = findsetreg(p, lastpc, reg);+ if (pc != -1) { /* could find instruction? */+ Instruction i = p->code[pc];+ OpCode op = GET_OPCODE(i);+ switch (op) {+ case OP_MOVE: {+ int b = GETARG_B(i); /* move from 'b' to 'a' */+ if (b < GETARG_A(i))+ return getobjname(p, pc, b, name); /* get name for 'b' */+ break;+ }+ case OP_GETTABUP:+ case OP_GETTABLE: {+ int k = GETARG_C(i); /* key index */+ int t = GETARG_B(i); /* table index */+ const char *vn = (op == OP_GETTABLE) /* name of indexed variable */+ ? luaF_getlocalname(p, t + 1, pc)+ : upvalname(p, t);+ kname(p, pc, k, name);+ return (vn && strcmp(vn, LUA_ENV) == 0) ? "global" : "field";+ }+ case OP_GETUPVAL: {+ *name = upvalname(p, GETARG_B(i));+ return "upvalue";+ }+ case OP_LOADK:+ case OP_LOADKX: {+ int b = (op == OP_LOADK) ? GETARG_Bx(i)+ : GETARG_Ax(p->code[pc + 1]);+ if (ttisstring(&p->k[b])) {+ *name = svalue(&p->k[b]);+ return "constant";+ }+ break;+ }+ case OP_SELF: {+ int k = GETARG_C(i); /* key index */+ kname(p, pc, k, name);+ return "method";+ }+ default: break; /* go through to return NULL */+ }+ }+ return NULL; /* could not find reasonable name */+}+++/*+** Try to find a name for a function based on the code that called it.+** (Only works when function was called by a Lua function.)+** Returns what the name is (e.g., "for iterator", "method",+** "metamethod") and sets '*name' to point to the name.+*/+static const char *funcnamefromcode (lua_State *L, CallInfo *ci,+ const char **name) {+ TMS tm = (TMS)0; /* (initial value avoids warnings) */+ Proto *p = ci_func(ci)->p; /* calling function */+ int pc = currentpc(ci); /* calling instruction index */+ Instruction i = p->code[pc]; /* calling instruction */+ if (ci->callstatus & CIST_HOOKED) { /* was it called inside a hook? */+ *name = "?";+ return "hook";+ }+ switch (GET_OPCODE(i)) {+ case OP_CALL:+ case OP_TAILCALL:+ return getobjname(p, pc, GETARG_A(i), name); /* get function name */+ case OP_TFORCALL: { /* for iterator */+ *name = "for iterator";+ return "for iterator";+ }+ /* other instructions can do calls through metamethods */+ case OP_SELF: case OP_GETTABUP: case OP_GETTABLE:+ tm = TM_INDEX;+ break;+ case OP_SETTABUP: case OP_SETTABLE:+ tm = TM_NEWINDEX;+ break;+ case OP_ADD: case OP_SUB: case OP_MUL: case OP_MOD:+ case OP_POW: case OP_DIV: case OP_IDIV: case OP_BAND:+ case OP_BOR: case OP_BXOR: case OP_SHL: case OP_SHR: {+ int offset = cast_int(GET_OPCODE(i)) - cast_int(OP_ADD); /* ORDER OP */+ tm = cast(TMS, offset + cast_int(TM_ADD)); /* ORDER TM */+ break;+ }+ case OP_UNM: tm = TM_UNM; break;+ case OP_BNOT: tm = TM_BNOT; break;+ case OP_LEN: tm = TM_LEN; break;+ case OP_CONCAT: tm = TM_CONCAT; break;+ case OP_EQ: tm = TM_EQ; break;+ case OP_LT: tm = TM_LT; break;+ case OP_LE: tm = TM_LE; break;+ default:+ return NULL; /* cannot find a reasonable name */+ }+ *name = getstr(G(L)->tmname[tm]);+ return "metamethod";+}++/* }====================================================== */++++/*+** The subtraction of two potentially unrelated pointers is+** not ISO C, but it should not crash a program; the subsequent+** checks are ISO C and ensure a correct result.+*/+static int isinstack (CallInfo *ci, const TValue *o) {+ ptrdiff_t i = o - ci->u.l.base;+ return (0 <= i && i < (ci->top - ci->u.l.base) && ci->u.l.base + i == o);+}+++/*+** Checks whether value 'o' came from an upvalue. (That can only happen+** with instructions OP_GETTABUP/OP_SETTABUP, which operate directly on+** upvalues.)+*/+static const char *getupvalname (CallInfo *ci, const TValue *o,+ const char **name) {+ LClosure *c = ci_func(ci);+ int i;+ for (i = 0; i < c->nupvalues; i++) {+ if (c->upvals[i]->v == o) {+ *name = upvalname(c->p, i);+ return "upvalue";+ }+ }+ return NULL;+}+++static const char *varinfo (lua_State *L, const TValue *o) {+ const char *name = NULL; /* to avoid warnings */+ CallInfo *ci = L->ci;+ const char *kind = NULL;+ if (isLua(ci)) {+ kind = getupvalname(ci, o, &name); /* check whether 'o' is an upvalue */+ if (!kind && isinstack(ci, o)) /* no? try a register */+ kind = getobjname(ci_func(ci)->p, currentpc(ci),+ cast_int(o - ci->u.l.base), &name);+ }+ return (kind) ? luaO_pushfstring(L, " (%s '%s')", kind, name) : "";+}+++l_noret luaG_typeerror (lua_State *L, const TValue *o, const char *op) {+ const char *t = luaT_objtypename(L, o);+ luaG_runerror(L, "attempt to %s a %s value%s", op, t, varinfo(L, o));+}+++l_noret luaG_concaterror (lua_State *L, const TValue *p1, const TValue *p2) {+ if (ttisstring(p1) || cvt2str(p1)) p1 = p2;+ luaG_typeerror(L, p1, "concatenate");+}+++l_noret luaG_opinterror (lua_State *L, const TValue *p1,+ const TValue *p2, const char *msg) {+ lua_Number temp;+ if (!tonumber(p1, &temp)) /* first operand is wrong? */+ p2 = p1; /* now second is wrong */+ luaG_typeerror(L, p2, msg);+}+++/*+** Error when both values are convertible to numbers, but not to integers+*/+l_noret luaG_tointerror (lua_State *L, const TValue *p1, const TValue *p2) {+ lua_Integer temp;+ if (!tointeger(p1, &temp))+ p2 = p1;+ luaG_runerror(L, "number%s has no integer representation", varinfo(L, p2));+}+++l_noret luaG_ordererror (lua_State *L, const TValue *p1, const TValue *p2) {+ const char *t1 = luaT_objtypename(L, p1);+ const char *t2 = luaT_objtypename(L, p2);+ if (strcmp(t1, t2) == 0)+ luaG_runerror(L, "attempt to compare two %s values", t1);+ else+ luaG_runerror(L, "attempt to compare %s with %s", t1, t2);+}+++/* add src:line information to 'msg' */+const char *luaG_addinfo (lua_State *L, const char *msg, TString *src,+ int line) {+ char buff[LUA_IDSIZE];+ if (src)+ luaO_chunkid(buff, getstr(src), LUA_IDSIZE);+ else { /* no source available; use "?" instead */+ buff[0] = '?'; buff[1] = '\0';+ }+ return luaO_pushfstring(L, "%s:%d: %s", buff, line, msg);+}+++l_noret luaG_errormsg (lua_State *L) {+ if (L->errfunc != 0) { /* is there an error handling function? */+ StkId errfunc = restorestack(L, L->errfunc);+ setobjs2s(L, L->top, L->top - 1); /* move argument */+ setobjs2s(L, L->top - 1, errfunc); /* push function */+ L->top++; /* assume EXTRA_STACK */+ luaD_callnoyield(L, L->top - 2, 1); /* call it */+ }+ luaD_throw(L, LUA_ERRRUN);+}+++l_noret luaG_runerror (lua_State *L, const char *fmt, ...) {+ CallInfo *ci = L->ci;+ const char *msg;+ va_list argp;+ luaC_checkGC(L); /* error message uses memory */+ va_start(argp, fmt);+ msg = luaO_pushvfstring(L, fmt, argp); /* format message */+ va_end(argp);+ if (isLua(ci)) /* if Lua function, add source:line information */+ luaG_addinfo(L, msg, ci_func(ci)->p->source, currentline(ci));+ luaG_errormsg(L);+}+++void luaG_traceexec (lua_State *L) {+ CallInfo *ci = L->ci;+ lu_byte mask = L->hookmask;+ int counthook = (--L->hookcount == 0 && (mask & LUA_MASKCOUNT));+ if (counthook)+ resethookcount(L); /* reset count */+ else if (!(mask & LUA_MASKLINE))+ return; /* no line hook and count != 0; nothing to be done */+ if (ci->callstatus & CIST_HOOKYIELD) { /* called hook last time? */+ ci->callstatus &= ~CIST_HOOKYIELD; /* erase mark */+ return; /* do not call hook again (VM yielded, so it did not move) */+ }+ if (counthook)+ luaD_hook(L, LUA_HOOKCOUNT, -1); /* call count hook */+ if (mask & LUA_MASKLINE) {+ Proto *p = ci_func(ci)->p;+ int npc = pcRel(ci->u.l.savedpc, p);+ int newline = getfuncline(p, npc);+ if (npc == 0 || /* call linehook when enter a new function, */+ ci->u.l.savedpc <= L->oldpc || /* when jump back (loop), or when */+ newline != getfuncline(p, pcRel(L->oldpc, p))) /* enter a new line */+ luaD_hook(L, LUA_HOOKLINE, newline); /* call line hook */+ }+ L->oldpc = ci->u.l.savedpc;+ if (L->status == LUA_YIELD) { /* did hook yield? */+ if (counthook)+ L->hookcount = 1; /* undo decrement to zero */+ ci->u.l.savedpc--; /* undo increment (resume will increment it again) */+ ci->callstatus |= CIST_HOOKYIELD; /* mark that it yielded */+ ci->func = L->top - 1; /* protect stack below results */+ luaD_throw(L, LUA_YIELD);+ }+}+
+ cbits/lua-5.3.6/ldebug.h view
@@ -0,0 +1,39 @@+/*+** $Id: ldebug.h,v 2.14.1.1 2017/04/19 17:20:42 roberto Exp $+** Auxiliary functions from Debug Interface module+** See Copyright Notice in lua.h+*/++#ifndef ldebug_h+#define ldebug_h+++#include "lstate.h"+++#define pcRel(pc, p) (cast(int, (pc) - (p)->code) - 1)++#define getfuncline(f,pc) (((f)->lineinfo) ? (f)->lineinfo[pc] : -1)++#define resethookcount(L) (L->hookcount = L->basehookcount)+++LUAI_FUNC l_noret luaG_typeerror (lua_State *L, const TValue *o,+ const char *opname);+LUAI_FUNC l_noret luaG_concaterror (lua_State *L, const TValue *p1,+ const TValue *p2);+LUAI_FUNC l_noret luaG_opinterror (lua_State *L, const TValue *p1,+ const TValue *p2,+ const char *msg);+LUAI_FUNC l_noret luaG_tointerror (lua_State *L, const TValue *p1,+ const TValue *p2);+LUAI_FUNC l_noret luaG_ordererror (lua_State *L, const TValue *p1,+ const TValue *p2);+LUAI_FUNC l_noret luaG_runerror (lua_State *L, const char *fmt, ...);+LUAI_FUNC const char *luaG_addinfo (lua_State *L, const char *msg,+ TString *src, int line);+LUAI_FUNC l_noret luaG_errormsg (lua_State *L);+LUAI_FUNC void luaG_traceexec (lua_State *L);+++#endif
+ cbits/lua-5.3.6/ldo.c view
@@ -0,0 +1,802 @@+/*+** $Id: ldo.c,v 2.157.1.1 2017/04/19 17:20:42 roberto Exp $+** Stack and Call structure of Lua+** See Copyright Notice in lua.h+*/++#define ldo_c+#define LUA_CORE++#include "lprefix.h"+++#include <setjmp.h>+#include <stdlib.h>+#include <string.h>++#include "lua.h"++#include "lapi.h"+#include "ldebug.h"+#include "ldo.h"+#include "lfunc.h"+#include "lgc.h"+#include "lmem.h"+#include "lobject.h"+#include "lopcodes.h"+#include "lparser.h"+#include "lstate.h"+#include "lstring.h"+#include "ltable.h"+#include "ltm.h"+#include "lundump.h"+#include "lvm.h"+#include "lzio.h"++++#define errorstatus(s) ((s) > LUA_YIELD)+++/*+** {======================================================+** Error-recovery functions+** =======================================================+*/++/*+** LUAI_THROW/LUAI_TRY define how Lua does exception handling. By+** default, Lua handles errors with exceptions when compiling as+** C++ code, with _longjmp/_setjmp when asked to use them, and with+** longjmp/setjmp otherwise.+*/+#if !defined(LUAI_THROW) /* { */++#if defined(__cplusplus) && !defined(LUA_USE_LONGJMP) /* { */++/* C++ exceptions */+#define LUAI_THROW(L,c) throw(c)+#define LUAI_TRY(L,c,a) \+ try { a } catch(...) { if ((c)->status == 0) (c)->status = -1; }+#define luai_jmpbuf int /* dummy variable */++#elif defined(LUA_USE_POSIX) /* }{ */++/* in POSIX, try _longjmp/_setjmp (more efficient) */+#define LUAI_THROW(L,c) _longjmp((c)->b, 1)+#define LUAI_TRY(L,c,a) if (_setjmp((c)->b) == 0) { a }+#define luai_jmpbuf jmp_buf++#else /* }{ */++/* ISO C handling with long jumps */+#define LUAI_THROW(L,c) longjmp((c)->b, 1)+#define LUAI_TRY(L,c,a) if (setjmp((c)->b) == 0) { a }+#define luai_jmpbuf jmp_buf++#endif /* } */++#endif /* } */++++/* chain list of long jump buffers */+struct lua_longjmp {+ struct lua_longjmp *previous;+ luai_jmpbuf b;+ volatile int status; /* error code */+};+++static void seterrorobj (lua_State *L, int errcode, StkId oldtop) {+ switch (errcode) {+ case LUA_ERRMEM: { /* memory error? */+ setsvalue2s(L, oldtop, G(L)->memerrmsg); /* reuse preregistered msg. */+ break;+ }+ case LUA_ERRERR: {+ setsvalue2s(L, oldtop, luaS_newliteral(L, "error in error handling"));+ break;+ }+ default: {+ setobjs2s(L, oldtop, L->top - 1); /* error message on current top */+ break;+ }+ }+ L->top = oldtop + 1;+}+++l_noret luaD_throw (lua_State *L, int errcode) {+ if (L->errorJmp) { /* thread has an error handler? */+ L->errorJmp->status = errcode; /* set status */+ LUAI_THROW(L, L->errorJmp); /* jump to it */+ }+ else { /* thread has no error handler */+ global_State *g = G(L);+ L->status = cast_byte(errcode); /* mark it as dead */+ if (g->mainthread->errorJmp) { /* main thread has a handler? */+ setobjs2s(L, g->mainthread->top++, L->top - 1); /* copy error obj. */+ luaD_throw(g->mainthread, errcode); /* re-throw in main thread */+ }+ else { /* no handler at all; abort */+ if (g->panic) { /* panic function? */+ seterrorobj(L, errcode, L->top); /* assume EXTRA_STACK */+ if (L->ci->top < L->top)+ L->ci->top = L->top; /* pushing msg. can break this invariant */+ lua_unlock(L);+ g->panic(L); /* call panic function (last chance to jump out) */+ }+ abort();+ }+ }+}+++int luaD_rawrunprotected (lua_State *L, Pfunc f, void *ud) {+ unsigned short oldnCcalls = L->nCcalls;+ struct lua_longjmp lj;+ lj.status = LUA_OK;+ lj.previous = L->errorJmp; /* chain new error handler */+ L->errorJmp = &lj;+ LUAI_TRY(L, &lj,+ (*f)(L, ud);+ );+ L->errorJmp = lj.previous; /* restore old error handler */+ L->nCcalls = oldnCcalls;+ return lj.status;+}++/* }====================================================== */+++/*+** {==================================================================+** Stack reallocation+** ===================================================================+*/+static void correctstack (lua_State *L, TValue *oldstack) {+ CallInfo *ci;+ UpVal *up;+ L->top = (L->top - oldstack) + L->stack;+ for (up = L->openupval; up != NULL; up = up->u.open.next)+ up->v = (up->v - oldstack) + L->stack;+ for (ci = L->ci; ci != NULL; ci = ci->previous) {+ ci->top = (ci->top - oldstack) + L->stack;+ ci->func = (ci->func - oldstack) + L->stack;+ if (isLua(ci))+ ci->u.l.base = (ci->u.l.base - oldstack) + L->stack;+ }+}+++/* some space for error handling */+#define ERRORSTACKSIZE (LUAI_MAXSTACK + 200)+++void luaD_reallocstack (lua_State *L, int newsize) {+ TValue *oldstack = L->stack;+ int lim = L->stacksize;+ lua_assert(newsize <= LUAI_MAXSTACK || newsize == ERRORSTACKSIZE);+ lua_assert(L->stack_last - L->stack == L->stacksize - EXTRA_STACK);+ luaM_reallocvector(L, L->stack, L->stacksize, newsize, TValue);+ for (; lim < newsize; lim++)+ setnilvalue(L->stack + lim); /* erase new segment */+ L->stacksize = newsize;+ L->stack_last = L->stack + newsize - EXTRA_STACK;+ correctstack(L, oldstack);+}+++void luaD_growstack (lua_State *L, int n) {+ int size = L->stacksize;+ if (size > LUAI_MAXSTACK) /* error after extra size? */+ luaD_throw(L, LUA_ERRERR);+ else {+ int needed = cast_int(L->top - L->stack) + n + EXTRA_STACK;+ int newsize = 2 * size;+ if (newsize > LUAI_MAXSTACK) newsize = LUAI_MAXSTACK;+ if (newsize < needed) newsize = needed;+ if (newsize > LUAI_MAXSTACK) { /* stack overflow? */+ luaD_reallocstack(L, ERRORSTACKSIZE);+ luaG_runerror(L, "stack overflow");+ }+ else+ luaD_reallocstack(L, newsize);+ }+}+++static int stackinuse (lua_State *L) {+ CallInfo *ci;+ StkId lim = L->top;+ for (ci = L->ci; ci != NULL; ci = ci->previous) {+ if (lim < ci->top) lim = ci->top;+ }+ lua_assert(lim <= L->stack_last);+ return cast_int(lim - L->stack) + 1; /* part of stack in use */+}+++void luaD_shrinkstack (lua_State *L) {+ int inuse = stackinuse(L);+ int goodsize = inuse + (inuse / 8) + 2*EXTRA_STACK;+ if (goodsize > LUAI_MAXSTACK)+ goodsize = LUAI_MAXSTACK; /* respect stack limit */+ if (L->stacksize > LUAI_MAXSTACK) /* had been handling stack overflow? */+ luaE_freeCI(L); /* free all CIs (list grew because of an error) */+ else+ luaE_shrinkCI(L); /* shrink list */+ /* if thread is currently not handling a stack overflow and its+ good size is smaller than current size, shrink its stack */+ if (inuse <= (LUAI_MAXSTACK - EXTRA_STACK) &&+ goodsize < L->stacksize)+ luaD_reallocstack(L, goodsize);+ else /* don't change stack */+ condmovestack(L,{},{}); /* (change only for debugging) */+}+++void luaD_inctop (lua_State *L) {+ luaD_checkstack(L, 1);+ L->top++;+}++/* }================================================================== */+++/*+** Call a hook for the given event. Make sure there is a hook to be+** called. (Both 'L->hook' and 'L->hookmask', which triggers this+** function, can be changed asynchronously by signals.)+*/+void luaD_hook (lua_State *L, int event, int line) {+ lua_Hook hook = L->hook;+ if (hook && L->allowhook) { /* make sure there is a hook */+ CallInfo *ci = L->ci;+ ptrdiff_t top = savestack(L, L->top);+ ptrdiff_t ci_top = savestack(L, ci->top);+ lua_Debug ar;+ ar.event = event;+ ar.currentline = line;+ ar.i_ci = ci;+ luaD_checkstack(L, LUA_MINSTACK); /* ensure minimum stack size */+ ci->top = L->top + LUA_MINSTACK;+ lua_assert(ci->top <= L->stack_last);+ L->allowhook = 0; /* cannot call hooks inside a hook */+ ci->callstatus |= CIST_HOOKED;+ lua_unlock(L);+ (*hook)(L, &ar);+ lua_lock(L);+ lua_assert(!L->allowhook);+ L->allowhook = 1;+ ci->top = restorestack(L, ci_top);+ L->top = restorestack(L, top);+ ci->callstatus &= ~CIST_HOOKED;+ }+}+++static void callhook (lua_State *L, CallInfo *ci) {+ int hook = LUA_HOOKCALL;+ ci->u.l.savedpc++; /* hooks assume 'pc' is already incremented */+ if (isLua(ci->previous) &&+ GET_OPCODE(*(ci->previous->u.l.savedpc - 1)) == OP_TAILCALL) {+ ci->callstatus |= CIST_TAIL;+ hook = LUA_HOOKTAILCALL;+ }+ luaD_hook(L, hook, -1);+ ci->u.l.savedpc--; /* correct 'pc' */+}+++static StkId adjust_varargs (lua_State *L, Proto *p, int actual) {+ int i;+ int nfixargs = p->numparams;+ StkId base, fixed;+ /* move fixed parameters to final position */+ fixed = L->top - actual; /* first fixed argument */+ base = L->top; /* final position of first argument */+ for (i = 0; i < nfixargs && i < actual; i++) {+ setobjs2s(L, L->top++, fixed + i);+ setnilvalue(fixed + i); /* erase original copy (for GC) */+ }+ for (; i < nfixargs; i++)+ setnilvalue(L->top++); /* complete missing arguments */+ return base;+}+++/*+** Check whether __call metafield of 'func' is a function. If so, put+** it in stack below original 'func' so that 'luaD_precall' can call+** it. Raise an error if __call metafield is not a function.+*/+static void tryfuncTM (lua_State *L, StkId func) {+ const TValue *tm = luaT_gettmbyobj(L, func, TM_CALL);+ StkId p;+ if (!ttisfunction(tm))+ luaG_typeerror(L, func, "call");+ /* Open a hole inside the stack at 'func' */+ for (p = L->top; p > func; p--)+ setobjs2s(L, p, p-1);+ L->top++; /* slot ensured by caller */+ setobj2s(L, func, tm); /* tag method is the new function to be called */+}+++/*+** Given 'nres' results at 'firstResult', move 'wanted' of them to 'res'.+** Handle most typical cases (zero results for commands, one result for+** expressions, multiple results for tail calls/single parameters)+** separated.+*/+static int moveresults (lua_State *L, const TValue *firstResult, StkId res,+ int nres, int wanted) {+ switch (wanted) { /* handle typical cases separately */+ case 0: break; /* nothing to move */+ case 1: { /* one result needed */+ if (nres == 0) /* no results? */+ firstResult = luaO_nilobject; /* adjust with nil */+ setobjs2s(L, res, firstResult); /* move it to proper place */+ break;+ }+ case LUA_MULTRET: {+ int i;+ for (i = 0; i < nres; i++) /* move all results to correct place */+ setobjs2s(L, res + i, firstResult + i);+ L->top = res + nres;+ return 0; /* wanted == LUA_MULTRET */+ }+ default: {+ int i;+ if (wanted <= nres) { /* enough results? */+ for (i = 0; i < wanted; i++) /* move wanted results to correct place */+ setobjs2s(L, res + i, firstResult + i);+ }+ else { /* not enough results; use all of them plus nils */+ for (i = 0; i < nres; i++) /* move all results to correct place */+ setobjs2s(L, res + i, firstResult + i);+ for (; i < wanted; i++) /* complete wanted number of results */+ setnilvalue(res + i);+ }+ break;+ }+ }+ L->top = res + wanted; /* top points after the last result */+ return 1;+}+++/*+** Finishes a function call: calls hook if necessary, removes CallInfo,+** moves current number of results to proper place; returns 0 iff call+** wanted multiple (variable number of) results.+*/+int luaD_poscall (lua_State *L, CallInfo *ci, StkId firstResult, int nres) {+ StkId res;+ int wanted = ci->nresults;+ if (L->hookmask & (LUA_MASKRET | LUA_MASKLINE)) {+ if (L->hookmask & LUA_MASKRET) {+ ptrdiff_t fr = savestack(L, firstResult); /* hook may change stack */+ luaD_hook(L, LUA_HOOKRET, -1);+ firstResult = restorestack(L, fr);+ }+ L->oldpc = ci->previous->u.l.savedpc; /* 'oldpc' for caller function */+ }+ res = ci->func; /* res == final position of 1st result */+ L->ci = ci->previous; /* back to caller */+ /* move results to proper place */+ return moveresults(L, firstResult, res, nres, wanted);+}++++#define next_ci(L) (L->ci = (L->ci->next ? L->ci->next : luaE_extendCI(L)))+++/* macro to check stack size, preserving 'p' */+#define checkstackp(L,n,p) \+ luaD_checkstackaux(L, n, \+ ptrdiff_t t__ = savestack(L, p); /* save 'p' */ \+ luaC_checkGC(L), /* stack grow uses memory */ \+ p = restorestack(L, t__)) /* 'pos' part: restore 'p' */+++/*+** Prepares a function call: checks the stack, creates a new CallInfo+** entry, fills in the relevant information, calls hook if needed.+** If function is a C function, does the call, too. (Otherwise, leave+** the execution ('luaV_execute') to the caller, to allow stackless+** calls.) Returns true iff function has been executed (C function).+*/+int luaD_precall (lua_State *L, StkId func, int nresults) {+ lua_CFunction f;+ CallInfo *ci;+ switch (ttype(func)) {+ case LUA_TCCL: /* C closure */+ f = clCvalue(func)->f;+ goto Cfunc;+ case LUA_TLCF: /* light C function */+ f = fvalue(func);+ Cfunc: {+ int n; /* number of returns */+ checkstackp(L, LUA_MINSTACK, func); /* ensure minimum stack size */+ ci = next_ci(L); /* now 'enter' new function */+ ci->nresults = nresults;+ ci->func = func;+ ci->top = L->top + LUA_MINSTACK;+ lua_assert(ci->top <= L->stack_last);+ ci->callstatus = 0;+ if (L->hookmask & LUA_MASKCALL)+ luaD_hook(L, LUA_HOOKCALL, -1);+ lua_unlock(L);+ n = (*f)(L); /* do the actual call */+ lua_lock(L);+ api_checknelems(L, n);+ luaD_poscall(L, ci, L->top - n, n);+ return 1;+ }+ case LUA_TLCL: { /* Lua function: prepare its call */+ StkId base;+ Proto *p = clLvalue(func)->p;+ int n = cast_int(L->top - func) - 1; /* number of real arguments */+ int fsize = p->maxstacksize; /* frame size */+ checkstackp(L, fsize, func);+ if (p->is_vararg)+ base = adjust_varargs(L, p, n);+ else { /* non vararg function */+ for (; n < p->numparams; n++)+ setnilvalue(L->top++); /* complete missing arguments */+ base = func + 1;+ }+ ci = next_ci(L); /* now 'enter' new function */+ ci->nresults = nresults;+ ci->func = func;+ ci->u.l.base = base;+ L->top = ci->top = base + fsize;+ lua_assert(ci->top <= L->stack_last);+ ci->u.l.savedpc = p->code; /* starting point */+ ci->callstatus = CIST_LUA;+ if (L->hookmask & LUA_MASKCALL)+ callhook(L, ci);+ return 0;+ }+ default: { /* not a function */+ checkstackp(L, 1, func); /* ensure space for metamethod */+ tryfuncTM(L, func); /* try to get '__call' metamethod */+ return luaD_precall(L, func, nresults); /* now it must be a function */+ }+ }+}+++/*+** Check appropriate error for stack overflow ("regular" overflow or+** overflow while handling stack overflow). If 'nCalls' is larger than+** LUAI_MAXCCALLS (which means it is handling a "regular" overflow) but+** smaller than 9/8 of LUAI_MAXCCALLS, does not report an error (to+** allow overflow handling to work)+*/+static void stackerror (lua_State *L) {+ if (L->nCcalls == LUAI_MAXCCALLS)+ luaG_runerror(L, "C stack overflow");+ else if (L->nCcalls >= (LUAI_MAXCCALLS + (LUAI_MAXCCALLS>>3)))+ luaD_throw(L, LUA_ERRERR); /* error while handing stack error */+}+++/*+** Call a function (C or Lua). The function to be called is at *func.+** The arguments are on the stack, right after the function.+** When returns, all the results are on the stack, starting at the original+** function position.+*/+void luaD_call (lua_State *L, StkId func, int nResults) {+ if (++L->nCcalls >= LUAI_MAXCCALLS)+ stackerror(L);+ if (!luaD_precall(L, func, nResults)) /* is a Lua function? */+ luaV_execute(L); /* call it */+ L->nCcalls--;+}+++/*+** Similar to 'luaD_call', but does not allow yields during the call+*/+void luaD_callnoyield (lua_State *L, StkId func, int nResults) {+ L->nny++;+ luaD_call(L, func, nResults);+ L->nny--;+}+++/*+** Completes the execution of an interrupted C function, calling its+** continuation function.+*/+static void finishCcall (lua_State *L, int status) {+ CallInfo *ci = L->ci;+ int n;+ /* must have a continuation and must be able to call it */+ lua_assert(ci->u.c.k != NULL && L->nny == 0);+ /* error status can only happen in a protected call */+ lua_assert((ci->callstatus & CIST_YPCALL) || status == LUA_YIELD);+ if (ci->callstatus & CIST_YPCALL) { /* was inside a pcall? */+ ci->callstatus &= ~CIST_YPCALL; /* continuation is also inside it */+ L->errfunc = ci->u.c.old_errfunc; /* with the same error function */+ }+ /* finish 'lua_callk'/'lua_pcall'; CIST_YPCALL and 'errfunc' already+ handled */+ adjustresults(L, ci->nresults);+ lua_unlock(L);+ n = (*ci->u.c.k)(L, status, ci->u.c.ctx); /* call continuation function */+ lua_lock(L);+ api_checknelems(L, n);+ luaD_poscall(L, ci, L->top - n, n); /* finish 'luaD_precall' */+}+++/*+** Executes "full continuation" (everything in the stack) of a+** previously interrupted coroutine until the stack is empty (or another+** interruption long-jumps out of the loop). If the coroutine is+** recovering from an error, 'ud' points to the error status, which must+** be passed to the first continuation function (otherwise the default+** status is LUA_YIELD).+*/+static void unroll (lua_State *L, void *ud) {+ if (ud != NULL) /* error status? */+ finishCcall(L, *(int *)ud); /* finish 'lua_pcallk' callee */+ while (L->ci != &L->base_ci) { /* something in the stack */+ if (!isLua(L->ci)) /* C function? */+ finishCcall(L, LUA_YIELD); /* complete its execution */+ else { /* Lua function */+ luaV_finishOp(L); /* finish interrupted instruction */+ luaV_execute(L); /* execute down to higher C 'boundary' */+ }+ }+}+++/*+** Try to find a suspended protected call (a "recover point") for the+** given thread.+*/+static CallInfo *findpcall (lua_State *L) {+ CallInfo *ci;+ for (ci = L->ci; ci != NULL; ci = ci->previous) { /* search for a pcall */+ if (ci->callstatus & CIST_YPCALL)+ return ci;+ }+ return NULL; /* no pending pcall */+}+++/*+** Recovers from an error in a coroutine. Finds a recover point (if+** there is one) and completes the execution of the interrupted+** 'luaD_pcall'. If there is no recover point, returns zero.+*/+static int recover (lua_State *L, int status) {+ StkId oldtop;+ CallInfo *ci = findpcall(L);+ if (ci == NULL) return 0; /* no recovery point */+ /* "finish" luaD_pcall */+ oldtop = restorestack(L, ci->extra);+ luaF_close(L, oldtop);+ seterrorobj(L, status, oldtop);+ L->ci = ci;+ L->allowhook = getoah(ci->callstatus); /* restore original 'allowhook' */+ L->nny = 0; /* should be zero to be yieldable */+ luaD_shrinkstack(L);+ L->errfunc = ci->u.c.old_errfunc;+ return 1; /* continue running the coroutine */+}+++/*+** Signal an error in the call to 'lua_resume', not in the execution+** of the coroutine itself. (Such errors should not be handled by any+** coroutine error handler and should not kill the coroutine.)+*/+static int resume_error (lua_State *L, const char *msg, int narg) {+ L->top -= narg; /* remove args from the stack */+ setsvalue2s(L, L->top, luaS_new(L, msg)); /* push error message */+ api_incr_top(L);+ lua_unlock(L);+ return LUA_ERRRUN;+}+++/*+** Do the work for 'lua_resume' in protected mode. Most of the work+** depends on the status of the coroutine: initial state, suspended+** inside a hook, or regularly suspended (optionally with a continuation+** function), plus erroneous cases: non-suspended coroutine or dead+** coroutine.+*/+static void resume (lua_State *L, void *ud) {+ int n = *(cast(int*, ud)); /* number of arguments */+ StkId firstArg = L->top - n; /* first argument */+ CallInfo *ci = L->ci;+ if (L->status == LUA_OK) { /* starting a coroutine? */+ if (!luaD_precall(L, firstArg - 1, LUA_MULTRET)) /* Lua function? */+ luaV_execute(L); /* call it */+ }+ else { /* resuming from previous yield */+ lua_assert(L->status == LUA_YIELD);+ L->status = LUA_OK; /* mark that it is running (again) */+ ci->func = restorestack(L, ci->extra);+ if (isLua(ci)) /* yielded inside a hook? */+ luaV_execute(L); /* just continue running Lua code */+ else { /* 'common' yield */+ if (ci->u.c.k != NULL) { /* does it have a continuation function? */+ lua_unlock(L);+ n = (*ci->u.c.k)(L, LUA_YIELD, ci->u.c.ctx); /* call continuation */+ lua_lock(L);+ api_checknelems(L, n);+ firstArg = L->top - n; /* yield results come from continuation */+ }+ luaD_poscall(L, ci, firstArg, n); /* finish 'luaD_precall' */+ }+ unroll(L, NULL); /* run continuation */+ }+}+++LUA_API int lua_resume (lua_State *L, lua_State *from, int nargs) {+ int status;+ unsigned short oldnny = L->nny; /* save "number of non-yieldable" calls */+ lua_lock(L);+ if (L->status == LUA_OK) { /* may be starting a coroutine */+ if (L->ci != &L->base_ci) /* not in base level? */+ return resume_error(L, "cannot resume non-suspended coroutine", nargs);+ }+ else if (L->status != LUA_YIELD)+ return resume_error(L, "cannot resume dead coroutine", nargs);+ L->nCcalls = (from) ? from->nCcalls + 1 : 1;+ if (L->nCcalls >= LUAI_MAXCCALLS)+ return resume_error(L, "C stack overflow", nargs);+ luai_userstateresume(L, nargs);+ L->nny = 0; /* allow yields */+ api_checknelems(L, (L->status == LUA_OK) ? nargs + 1 : nargs);+ status = luaD_rawrunprotected(L, resume, &nargs);+ if (status == -1) /* error calling 'lua_resume'? */+ status = LUA_ERRRUN;+ else { /* continue running after recoverable errors */+ while (errorstatus(status) && recover(L, status)) {+ /* unroll continuation */+ status = luaD_rawrunprotected(L, unroll, &status);+ }+ if (errorstatus(status)) { /* unrecoverable error? */+ L->status = cast_byte(status); /* mark thread as 'dead' */+ seterrorobj(L, status, L->top); /* push error message */+ L->ci->top = L->top;+ }+ else lua_assert(status == L->status); /* normal end or yield */+ }+ L->nny = oldnny; /* restore 'nny' */+ L->nCcalls--;+ lua_assert(L->nCcalls == ((from) ? from->nCcalls : 0));+ lua_unlock(L);+ return status;+}+++LUA_API int lua_isyieldable (lua_State *L) {+ return (L->nny == 0);+}+++LUA_API int lua_yieldk (lua_State *L, int nresults, lua_KContext ctx,+ lua_KFunction k) {+ CallInfo *ci = L->ci;+ luai_userstateyield(L, nresults);+ lua_lock(L);+ api_checknelems(L, nresults);+ if (L->nny > 0) {+ if (L != G(L)->mainthread)+ luaG_runerror(L, "attempt to yield across a C-call boundary");+ else+ luaG_runerror(L, "attempt to yield from outside a coroutine");+ }+ L->status = LUA_YIELD;+ ci->extra = savestack(L, ci->func); /* save current 'func' */+ if (isLua(ci)) { /* inside a hook? */+ api_check(L, k == NULL, "hooks cannot continue after yielding");+ }+ else {+ if ((ci->u.c.k = k) != NULL) /* is there a continuation? */+ ci->u.c.ctx = ctx; /* save context */+ ci->func = L->top - nresults - 1; /* protect stack below results */+ luaD_throw(L, LUA_YIELD);+ }+ lua_assert(ci->callstatus & CIST_HOOKED); /* must be inside a hook */+ lua_unlock(L);+ return 0; /* return to 'luaD_hook' */+}+++int luaD_pcall (lua_State *L, Pfunc func, void *u,+ ptrdiff_t old_top, ptrdiff_t ef) {+ int status;+ CallInfo *old_ci = L->ci;+ lu_byte old_allowhooks = L->allowhook;+ unsigned short old_nny = L->nny;+ ptrdiff_t old_errfunc = L->errfunc;+ L->errfunc = ef;+ status = luaD_rawrunprotected(L, func, u);+ if (status != LUA_OK) { /* an error occurred? */+ StkId oldtop = restorestack(L, old_top);+ luaF_close(L, oldtop); /* close possible pending closures */+ seterrorobj(L, status, oldtop);+ L->ci = old_ci;+ L->allowhook = old_allowhooks;+ L->nny = old_nny;+ luaD_shrinkstack(L);+ }+ L->errfunc = old_errfunc;+ return status;+}++++/*+** Execute a protected parser.+*/+struct SParser { /* data to 'f_parser' */+ ZIO *z;+ Mbuffer buff; /* dynamic structure used by the scanner */+ Dyndata dyd; /* dynamic structures used by the parser */+ const char *mode;+ const char *name;+};+++static void checkmode (lua_State *L, const char *mode, const char *x) {+ if (mode && strchr(mode, x[0]) == NULL) {+ luaO_pushfstring(L,+ "attempt to load a %s chunk (mode is '%s')", x, mode);+ luaD_throw(L, LUA_ERRSYNTAX);+ }+}+++static void f_parser (lua_State *L, void *ud) {+ LClosure *cl;+ struct SParser *p = cast(struct SParser *, ud);+ int c = zgetc(p->z); /* read first character */+ if (c == LUA_SIGNATURE[0]) {+ checkmode(L, p->mode, "binary");+ cl = luaU_undump(L, p->z, p->name);+ }+ else {+ checkmode(L, p->mode, "text");+ cl = luaY_parser(L, p->z, &p->buff, &p->dyd, p->name, c);+ }+ lua_assert(cl->nupvalues == cl->p->sizeupvalues);+ luaF_initupvals(L, cl);+}+++int luaD_protectedparser (lua_State *L, ZIO *z, const char *name,+ const char *mode) {+ struct SParser p;+ int status;+ L->nny++; /* cannot yield during parsing */+ p.z = z; p.name = name; p.mode = mode;+ p.dyd.actvar.arr = NULL; p.dyd.actvar.size = 0;+ p.dyd.gt.arr = NULL; p.dyd.gt.size = 0;+ p.dyd.label.arr = NULL; p.dyd.label.size = 0;+ luaZ_initbuffer(L, &p.buff);+ status = luaD_pcall(L, f_parser, &p, savestack(L, L->top), L->errfunc);+ luaZ_freebuffer(L, &p.buff);+ luaM_freearray(L, p.dyd.actvar.arr, p.dyd.actvar.size);+ luaM_freearray(L, p.dyd.gt.arr, p.dyd.gt.size);+ luaM_freearray(L, p.dyd.label.arr, p.dyd.label.size);+ L->nny--;+ return status;+}++
+ cbits/lua-5.3.6/ldo.h view
@@ -0,0 +1,58 @@+/*+** $Id: ldo.h,v 2.29.1.1 2017/04/19 17:20:42 roberto Exp $+** Stack and Call structure of Lua+** See Copyright Notice in lua.h+*/++#ifndef ldo_h+#define ldo_h+++#include "lobject.h"+#include "lstate.h"+#include "lzio.h"+++/*+** Macro to check stack size and grow stack if needed. Parameters+** 'pre'/'pos' allow the macro to preserve a pointer into the+** stack across reallocations, doing the work only when needed.+** 'condmovestack' is used in heavy tests to force a stack reallocation+** at every check.+*/+#define luaD_checkstackaux(L,n,pre,pos) \+ if (L->stack_last - L->top <= (n)) \+ { pre; luaD_growstack(L, n); pos; } else { condmovestack(L,pre,pos); }++/* In general, 'pre'/'pos' are empty (nothing to save) */+#define luaD_checkstack(L,n) luaD_checkstackaux(L,n,(void)0,(void)0)++++#define savestack(L,p) ((char *)(p) - (char *)L->stack)+#define restorestack(L,n) ((TValue *)((char *)L->stack + (n)))+++/* type of protected functions, to be ran by 'runprotected' */+typedef void (*Pfunc) (lua_State *L, void *ud);++LUAI_FUNC int luaD_protectedparser (lua_State *L, ZIO *z, const char *name,+ const char *mode);+LUAI_FUNC void luaD_hook (lua_State *L, int event, int line);+LUAI_FUNC int luaD_precall (lua_State *L, StkId func, int nresults);+LUAI_FUNC void luaD_call (lua_State *L, StkId func, int nResults);+LUAI_FUNC void luaD_callnoyield (lua_State *L, StkId func, int nResults);+LUAI_FUNC int luaD_pcall (lua_State *L, Pfunc func, void *u,+ ptrdiff_t oldtop, ptrdiff_t ef);+LUAI_FUNC int luaD_poscall (lua_State *L, CallInfo *ci, StkId firstResult,+ int nres);+LUAI_FUNC void luaD_reallocstack (lua_State *L, int newsize);+LUAI_FUNC void luaD_growstack (lua_State *L, int n);+LUAI_FUNC void luaD_shrinkstack (lua_State *L);+LUAI_FUNC void luaD_inctop (lua_State *L);++LUAI_FUNC l_noret luaD_throw (lua_State *L, int errcode);+LUAI_FUNC int luaD_rawrunprotected (lua_State *L, Pfunc f, void *ud);++#endif+
+ cbits/lua-5.3.6/ldump.c view
@@ -0,0 +1,215 @@+/*+** $Id: ldump.c,v 2.37.1.1 2017/04/19 17:20:42 roberto Exp $+** save precompiled Lua chunks+** See Copyright Notice in lua.h+*/++#define ldump_c+#define LUA_CORE++#include "lprefix.h"+++#include <stddef.h>++#include "lua.h"++#include "lobject.h"+#include "lstate.h"+#include "lundump.h"+++typedef struct {+ lua_State *L;+ lua_Writer writer;+ void *data;+ int strip;+ int status;+} DumpState;+++/*+** All high-level dumps go through DumpVector; you can change it to+** change the endianness of the result+*/+#define DumpVector(v,n,D) DumpBlock(v,(n)*sizeof((v)[0]),D)++#define DumpLiteral(s,D) DumpBlock(s, sizeof(s) - sizeof(char), D)+++static void DumpBlock (const void *b, size_t size, DumpState *D) {+ if (D->status == 0 && size > 0) {+ lua_unlock(D->L);+ D->status = (*D->writer)(D->L, b, size, D->data);+ lua_lock(D->L);+ }+}+++#define DumpVar(x,D) DumpVector(&x,1,D)+++static void DumpByte (int y, DumpState *D) {+ lu_byte x = (lu_byte)y;+ DumpVar(x, D);+}+++static void DumpInt (int x, DumpState *D) {+ DumpVar(x, D);+}+++static void DumpNumber (lua_Number x, DumpState *D) {+ DumpVar(x, D);+}+++static void DumpInteger (lua_Integer x, DumpState *D) {+ DumpVar(x, D);+}+++static void DumpString (const TString *s, DumpState *D) {+ if (s == NULL)+ DumpByte(0, D);+ else {+ size_t size = tsslen(s) + 1; /* include trailing '\0' */+ const char *str = getstr(s);+ if (size < 0xFF)+ DumpByte(cast_int(size), D);+ else {+ DumpByte(0xFF, D);+ DumpVar(size, D);+ }+ DumpVector(str, size - 1, D); /* no need to save '\0' */+ }+}+++static void DumpCode (const Proto *f, DumpState *D) {+ DumpInt(f->sizecode, D);+ DumpVector(f->code, f->sizecode, D);+}+++static void DumpFunction(const Proto *f, TString *psource, DumpState *D);++static void DumpConstants (const Proto *f, DumpState *D) {+ int i;+ int n = f->sizek;+ DumpInt(n, D);+ for (i = 0; i < n; i++) {+ const TValue *o = &f->k[i];+ DumpByte(ttype(o), D);+ switch (ttype(o)) {+ case LUA_TNIL:+ break;+ case LUA_TBOOLEAN:+ DumpByte(bvalue(o), D);+ break;+ case LUA_TNUMFLT:+ DumpNumber(fltvalue(o), D);+ break;+ case LUA_TNUMINT:+ DumpInteger(ivalue(o), D);+ break;+ case LUA_TSHRSTR:+ case LUA_TLNGSTR:+ DumpString(tsvalue(o), D);+ break;+ default:+ lua_assert(0);+ }+ }+}+++static void DumpProtos (const Proto *f, DumpState *D) {+ int i;+ int n = f->sizep;+ DumpInt(n, D);+ for (i = 0; i < n; i++)+ DumpFunction(f->p[i], f->source, D);+}+++static void DumpUpvalues (const Proto *f, DumpState *D) {+ int i, n = f->sizeupvalues;+ DumpInt(n, D);+ for (i = 0; i < n; i++) {+ DumpByte(f->upvalues[i].instack, D);+ DumpByte(f->upvalues[i].idx, D);+ }+}+++static void DumpDebug (const Proto *f, DumpState *D) {+ int i, n;+ n = (D->strip) ? 0 : f->sizelineinfo;+ DumpInt(n, D);+ DumpVector(f->lineinfo, n, D);+ n = (D->strip) ? 0 : f->sizelocvars;+ DumpInt(n, D);+ for (i = 0; i < n; i++) {+ DumpString(f->locvars[i].varname, D);+ DumpInt(f->locvars[i].startpc, D);+ DumpInt(f->locvars[i].endpc, D);+ }+ n = (D->strip) ? 0 : f->sizeupvalues;+ DumpInt(n, D);+ for (i = 0; i < n; i++)+ DumpString(f->upvalues[i].name, D);+}+++static void DumpFunction (const Proto *f, TString *psource, DumpState *D) {+ if (D->strip || f->source == psource)+ DumpString(NULL, D); /* no debug info or same source as its parent */+ else+ DumpString(f->source, D);+ DumpInt(f->linedefined, D);+ DumpInt(f->lastlinedefined, D);+ DumpByte(f->numparams, D);+ DumpByte(f->is_vararg, D);+ DumpByte(f->maxstacksize, D);+ DumpCode(f, D);+ DumpConstants(f, D);+ DumpUpvalues(f, D);+ DumpProtos(f, D);+ DumpDebug(f, D);+}+++static void DumpHeader (DumpState *D) {+ DumpLiteral(LUA_SIGNATURE, D);+ DumpByte(LUAC_VERSION, D);+ DumpByte(LUAC_FORMAT, D);+ DumpLiteral(LUAC_DATA, D);+ DumpByte(sizeof(int), D);+ DumpByte(sizeof(size_t), D);+ DumpByte(sizeof(Instruction), D);+ DumpByte(sizeof(lua_Integer), D);+ DumpByte(sizeof(lua_Number), D);+ DumpInteger(LUAC_INT, D);+ DumpNumber(LUAC_NUM, D);+}+++/*+** dump Lua function as precompiled chunk+*/+int luaU_dump(lua_State *L, const Proto *f, lua_Writer w, void *data,+ int strip) {+ DumpState D;+ D.L = L;+ D.writer = w;+ D.data = data;+ D.strip = strip;+ D.status = 0;+ DumpHeader(&D);+ DumpByte(f->sizeupvalues, &D);+ DumpFunction(f, NULL, &D);+ return D.status;+}+
+ cbits/lua-5.3.6/lfunc.c view
@@ -0,0 +1,151 @@+/*+** $Id: lfunc.c,v 2.45.1.1 2017/04/19 17:39:34 roberto Exp $+** Auxiliary functions to manipulate prototypes and closures+** See Copyright Notice in lua.h+*/++#define lfunc_c+#define LUA_CORE++#include "lprefix.h"+++#include <stddef.h>++#include "lua.h"++#include "lfunc.h"+#include "lgc.h"+#include "lmem.h"+#include "lobject.h"+#include "lstate.h"++++CClosure *luaF_newCclosure (lua_State *L, int n) {+ GCObject *o = luaC_newobj(L, LUA_TCCL, sizeCclosure(n));+ CClosure *c = gco2ccl(o);+ c->nupvalues = cast_byte(n);+ return c;+}+++LClosure *luaF_newLclosure (lua_State *L, int n) {+ GCObject *o = luaC_newobj(L, LUA_TLCL, sizeLclosure(n));+ LClosure *c = gco2lcl(o);+ c->p = NULL;+ c->nupvalues = cast_byte(n);+ while (n--) c->upvals[n] = NULL;+ return c;+}++/*+** fill a closure with new closed upvalues+*/+void luaF_initupvals (lua_State *L, LClosure *cl) {+ int i;+ for (i = 0; i < cl->nupvalues; i++) {+ UpVal *uv = luaM_new(L, UpVal);+ uv->refcount = 1;+ uv->v = &uv->u.value; /* make it closed */+ setnilvalue(uv->v);+ cl->upvals[i] = uv;+ }+}+++UpVal *luaF_findupval (lua_State *L, StkId level) {+ UpVal **pp = &L->openupval;+ UpVal *p;+ UpVal *uv;+ lua_assert(isintwups(L) || L->openupval == NULL);+ while (*pp != NULL && (p = *pp)->v >= level) {+ lua_assert(upisopen(p));+ if (p->v == level) /* found a corresponding upvalue? */+ return p; /* return it */+ pp = &p->u.open.next;+ }+ /* not found: create a new upvalue */+ uv = luaM_new(L, UpVal);+ uv->refcount = 0;+ uv->u.open.next = *pp; /* link it to list of open upvalues */+ uv->u.open.touched = 1;+ *pp = uv;+ uv->v = level; /* current value lives in the stack */+ if (!isintwups(L)) { /* thread not in list of threads with upvalues? */+ L->twups = G(L)->twups; /* link it to the list */+ G(L)->twups = L;+ }+ return uv;+}+++void luaF_close (lua_State *L, StkId level) {+ UpVal *uv;+ while (L->openupval != NULL && (uv = L->openupval)->v >= level) {+ lua_assert(upisopen(uv));+ L->openupval = uv->u.open.next; /* remove from 'open' list */+ if (uv->refcount == 0) /* no references? */+ luaM_free(L, uv); /* free upvalue */+ else {+ setobj(L, &uv->u.value, uv->v); /* move value to upvalue slot */+ uv->v = &uv->u.value; /* now current value lives here */+ luaC_upvalbarrier(L, uv);+ }+ }+}+++Proto *luaF_newproto (lua_State *L) {+ GCObject *o = luaC_newobj(L, LUA_TPROTO, sizeof(Proto));+ Proto *f = gco2p(o);+ f->k = NULL;+ f->sizek = 0;+ f->p = NULL;+ f->sizep = 0;+ f->code = NULL;+ f->cache = NULL;+ f->sizecode = 0;+ f->lineinfo = NULL;+ f->sizelineinfo = 0;+ f->upvalues = NULL;+ f->sizeupvalues = 0;+ f->numparams = 0;+ f->is_vararg = 0;+ f->maxstacksize = 0;+ f->locvars = NULL;+ f->sizelocvars = 0;+ f->linedefined = 0;+ f->lastlinedefined = 0;+ f->source = NULL;+ return f;+}+++void luaF_freeproto (lua_State *L, Proto *f) {+ luaM_freearray(L, f->code, f->sizecode);+ luaM_freearray(L, f->p, f->sizep);+ luaM_freearray(L, f->k, f->sizek);+ luaM_freearray(L, f->lineinfo, f->sizelineinfo);+ luaM_freearray(L, f->locvars, f->sizelocvars);+ luaM_freearray(L, f->upvalues, f->sizeupvalues);+ luaM_free(L, f);+}+++/*+** Look for n-th local variable at line 'line' in function 'func'.+** Returns NULL if not found.+*/+const char *luaF_getlocalname (const Proto *f, int local_number, int pc) {+ int i;+ for (i = 0; i<f->sizelocvars && f->locvars[i].startpc <= pc; i++) {+ if (pc < f->locvars[i].endpc) { /* is variable active? */+ local_number--;+ if (local_number == 0)+ return getstr(f->locvars[i].varname);+ }+ }+ return NULL; /* not found */+}+
+ cbits/lua-5.3.6/lfunc.h view
@@ -0,0 +1,61 @@+/*+** $Id: lfunc.h,v 2.15.1.1 2017/04/19 17:39:34 roberto Exp $+** Auxiliary functions to manipulate prototypes and closures+** See Copyright Notice in lua.h+*/++#ifndef lfunc_h+#define lfunc_h+++#include "lobject.h"+++#define sizeCclosure(n) (cast(int, sizeof(CClosure)) + \+ cast(int, sizeof(TValue)*((n)-1)))++#define sizeLclosure(n) (cast(int, sizeof(LClosure)) + \+ cast(int, sizeof(TValue *)*((n)-1)))+++/* test whether thread is in 'twups' list */+#define isintwups(L) (L->twups != L)+++/*+** maximum number of upvalues in a closure (both C and Lua). (Value+** must fit in a VM register.)+*/+#define MAXUPVAL 255+++/*+** Upvalues for Lua closures+*/+struct UpVal {+ TValue *v; /* points to stack or to its own value */+ lu_mem refcount; /* reference counter */+ union {+ struct { /* (when open) */+ UpVal *next; /* linked list */+ int touched; /* mark to avoid cycles with dead threads */+ } open;+ TValue value; /* the value (when closed) */+ } u;+};++#define upisopen(up) ((up)->v != &(up)->u.value)+++LUAI_FUNC Proto *luaF_newproto (lua_State *L);+LUAI_FUNC CClosure *luaF_newCclosure (lua_State *L, int nelems);+LUAI_FUNC LClosure *luaF_newLclosure (lua_State *L, int nelems);+LUAI_FUNC void luaF_initupvals (lua_State *L, LClosure *cl);+LUAI_FUNC UpVal *luaF_findupval (lua_State *L, StkId level);+LUAI_FUNC void luaF_close (lua_State *L, StkId level);+LUAI_FUNC void luaF_freeproto (lua_State *L, Proto *f);+LUAI_FUNC const char *luaF_getlocalname (const Proto *func, int local_number,+ int pc);+++#endif
+ cbits/lua-5.3.6/lgc.c view
@@ -0,0 +1,1179 @@+/*+** $Id: lgc.c,v 2.215.1.2 2017/08/31 16:15:27 roberto Exp $+** Garbage Collector+** See Copyright Notice in lua.h+*/++#define lgc_c+#define LUA_CORE++#include "lprefix.h"+++#include <string.h>++#include "lua.h"++#include "ldebug.h"+#include "ldo.h"+#include "lfunc.h"+#include "lgc.h"+#include "lmem.h"+#include "lobject.h"+#include "lstate.h"+#include "lstring.h"+#include "ltable.h"+#include "ltm.h"+++/*+** internal state for collector while inside the atomic phase. The+** collector should never be in this state while running regular code.+*/+#define GCSinsideatomic (GCSpause + 1)++/*+** cost of sweeping one element (the size of a small object divided+** by some adjust for the sweep speed)+*/+#define GCSWEEPCOST ((sizeof(TString) + 4) / 4)++/* maximum number of elements to sweep in each single step */+#define GCSWEEPMAX (cast_int((GCSTEPSIZE / GCSWEEPCOST) / 4))++/* cost of calling one finalizer */+#define GCFINALIZECOST GCSWEEPCOST+++/*+** macro to adjust 'stepmul': 'stepmul' is actually used like+** 'stepmul / STEPMULADJ' (value chosen by tests)+*/+#define STEPMULADJ 200+++/*+** macro to adjust 'pause': 'pause' is actually used like+** 'pause / PAUSEADJ' (value chosen by tests)+*/+#define PAUSEADJ 100+++/*+** 'makewhite' erases all color bits then sets only the current white+** bit+*/+#define maskcolors (~(bitmask(BLACKBIT) | WHITEBITS))+#define makewhite(g,x) \+ (x->marked = cast_byte((x->marked & maskcolors) | luaC_white(g)))++#define white2gray(x) resetbits(x->marked, WHITEBITS)+#define black2gray(x) resetbit(x->marked, BLACKBIT)+++#define valiswhite(x) (iscollectable(x) && iswhite(gcvalue(x)))++#define checkdeadkey(n) lua_assert(!ttisdeadkey(gkey(n)) || ttisnil(gval(n)))+++#define checkconsistency(obj) \+ lua_longassert(!iscollectable(obj) || righttt(obj))+++#define markvalue(g,o) { checkconsistency(o); \+ if (valiswhite(o)) reallymarkobject(g,gcvalue(o)); }++#define markobject(g,t) { if (iswhite(t)) reallymarkobject(g, obj2gco(t)); }++/*+** mark an object that can be NULL (either because it is really optional,+** or it was stripped as debug info, or inside an uncompleted structure)+*/+#define markobjectN(g,t) { if (t) markobject(g,t); }++static void reallymarkobject (global_State *g, GCObject *o);+++/*+** {======================================================+** Generic functions+** =======================================================+*/+++/*+** one after last element in a hash array+*/+#define gnodelast(h) gnode(h, cast(size_t, sizenode(h)))+++/*+** link collectable object 'o' into list pointed by 'p'+*/+#define linkgclist(o,p) ((o)->gclist = (p), (p) = obj2gco(o))+++/*+** If key is not marked, mark its entry as dead. This allows key to be+** collected, but keeps its entry in the table. A dead node is needed+** when Lua looks up for a key (it may be part of a chain) and when+** traversing a weak table (key might be removed from the table during+** traversal). Other places never manipulate dead keys, because its+** associated nil value is enough to signal that the entry is logically+** empty.+*/+static void removeentry (Node *n) {+ lua_assert(ttisnil(gval(n)));+ if (valiswhite(gkey(n)))+ setdeadvalue(wgkey(n)); /* unused and unmarked key; remove it */+}+++/*+** tells whether a key or value can be cleared from a weak+** table. Non-collectable objects are never removed from weak+** tables. Strings behave as 'values', so are never removed too. for+** other objects: if really collected, cannot keep them; for objects+** being finalized, keep them in keys, but not in values+*/+static int iscleared (global_State *g, const TValue *o) {+ if (!iscollectable(o)) return 0;+ else if (ttisstring(o)) {+ markobject(g, tsvalue(o)); /* strings are 'values', so are never weak */+ return 0;+ }+ else return iswhite(gcvalue(o));+}+++/*+** barrier that moves collector forward, that is, mark the white object+** being pointed by a black object. (If in sweep phase, clear the black+** object to white [sweep it] to avoid other barrier calls for this+** same object.)+*/+void luaC_barrier_ (lua_State *L, GCObject *o, GCObject *v) {+ global_State *g = G(L);+ lua_assert(isblack(o) && iswhite(v) && !isdead(g, v) && !isdead(g, o));+ if (keepinvariant(g)) /* must keep invariant? */+ reallymarkobject(g, v); /* restore invariant */+ else { /* sweep phase */+ lua_assert(issweepphase(g));+ makewhite(g, o); /* mark main obj. as white to avoid other barriers */+ }+}+++/*+** barrier that moves collector backward, that is, mark the black object+** pointing to a white object as gray again.+*/+void luaC_barrierback_ (lua_State *L, Table *t) {+ global_State *g = G(L);+ lua_assert(isblack(t) && !isdead(g, t));+ black2gray(t); /* make table gray (again) */+ linkgclist(t, g->grayagain);+}+++/*+** barrier for assignments to closed upvalues. Because upvalues are+** shared among closures, it is impossible to know the color of all+** closures pointing to it. So, we assume that the object being assigned+** must be marked.+*/+void luaC_upvalbarrier_ (lua_State *L, UpVal *uv) {+ global_State *g = G(L);+ GCObject *o = gcvalue(uv->v);+ lua_assert(!upisopen(uv)); /* ensured by macro luaC_upvalbarrier */+ if (keepinvariant(g))+ markobject(g, o);+}+++void luaC_fix (lua_State *L, GCObject *o) {+ global_State *g = G(L);+ lua_assert(g->allgc == o); /* object must be 1st in 'allgc' list! */+ white2gray(o); /* they will be gray forever */+ g->allgc = o->next; /* remove object from 'allgc' list */+ o->next = g->fixedgc; /* link it to 'fixedgc' list */+ g->fixedgc = o;+}+++/*+** create a new collectable object (with given type and size) and link+** it to 'allgc' list.+*/+GCObject *luaC_newobj (lua_State *L, int tt, size_t sz) {+ global_State *g = G(L);+ GCObject *o = cast(GCObject *, luaM_newobject(L, novariant(tt), sz));+ o->marked = luaC_white(g);+ o->tt = tt;+ o->next = g->allgc;+ g->allgc = o;+ return o;+}++/* }====================================================== */++++/*+** {======================================================+** Mark functions+** =======================================================+*/+++/*+** mark an object. Userdata, strings, and closed upvalues are visited+** and turned black here. Other objects are marked gray and added+** to appropriate list to be visited (and turned black) later. (Open+** upvalues are already linked in 'headuv' list.)+*/+static void reallymarkobject (global_State *g, GCObject *o) {+ reentry:+ white2gray(o);+ switch (o->tt) {+ case LUA_TSHRSTR: {+ gray2black(o);+ g->GCmemtrav += sizelstring(gco2ts(o)->shrlen);+ break;+ }+ case LUA_TLNGSTR: {+ gray2black(o);+ g->GCmemtrav += sizelstring(gco2ts(o)->u.lnglen);+ break;+ }+ case LUA_TUSERDATA: {+ TValue uvalue;+ markobjectN(g, gco2u(o)->metatable); /* mark its metatable */+ gray2black(o);+ g->GCmemtrav += sizeudata(gco2u(o));+ getuservalue(g->mainthread, gco2u(o), &uvalue);+ if (valiswhite(&uvalue)) { /* markvalue(g, &uvalue); */+ o = gcvalue(&uvalue);+ goto reentry;+ }+ break;+ }+ case LUA_TLCL: {+ linkgclist(gco2lcl(o), g->gray);+ break;+ }+ case LUA_TCCL: {+ linkgclist(gco2ccl(o), g->gray);+ break;+ }+ case LUA_TTABLE: {+ linkgclist(gco2t(o), g->gray);+ break;+ }+ case LUA_TTHREAD: {+ linkgclist(gco2th(o), g->gray);+ break;+ }+ case LUA_TPROTO: {+ linkgclist(gco2p(o), g->gray);+ break;+ }+ default: lua_assert(0); break;+ }+}+++/*+** mark metamethods for basic types+*/+static void markmt (global_State *g) {+ int i;+ for (i=0; i < LUA_NUMTAGS; i++)+ markobjectN(g, g->mt[i]);+}+++/*+** mark all objects in list of being-finalized+*/+static void markbeingfnz (global_State *g) {+ GCObject *o;+ for (o = g->tobefnz; o != NULL; o = o->next)+ markobject(g, o);+}+++/*+** Mark all values stored in marked open upvalues from non-marked threads.+** (Values from marked threads were already marked when traversing the+** thread.) Remove from the list threads that no longer have upvalues and+** not-marked threads.+*/+static void remarkupvals (global_State *g) {+ lua_State *thread;+ lua_State **p = &g->twups;+ while ((thread = *p) != NULL) {+ lua_assert(!isblack(thread)); /* threads are never black */+ if (isgray(thread) && thread->openupval != NULL)+ p = &thread->twups; /* keep marked thread with upvalues in the list */+ else { /* thread is not marked or without upvalues */+ UpVal *uv;+ *p = thread->twups; /* remove thread from the list */+ thread->twups = thread; /* mark that it is out of list */+ for (uv = thread->openupval; uv != NULL; uv = uv->u.open.next) {+ if (uv->u.open.touched) {+ markvalue(g, uv->v); /* remark upvalue's value */+ uv->u.open.touched = 0;+ }+ }+ }+ }+}+++/*+** mark root set and reset all gray lists, to start a new collection+*/+static void restartcollection (global_State *g) {+ g->gray = g->grayagain = NULL;+ g->weak = g->allweak = g->ephemeron = NULL;+ markobject(g, g->mainthread);+ markvalue(g, &g->l_registry);+ markmt(g);+ markbeingfnz(g); /* mark any finalizing object left from previous cycle */+}++/* }====================================================== */+++/*+** {======================================================+** Traverse functions+** =======================================================+*/++/*+** Traverse a table with weak values and link it to proper list. During+** propagate phase, keep it in 'grayagain' list, to be revisited in the+** atomic phase. In the atomic phase, if table has any white value,+** put it in 'weak' list, to be cleared.+*/+static void traverseweakvalue (global_State *g, Table *h) {+ Node *n, *limit = gnodelast(h);+ /* if there is array part, assume it may have white values (it is not+ worth traversing it now just to check) */+ int hasclears = (h->sizearray > 0);+ for (n = gnode(h, 0); n < limit; n++) { /* traverse hash part */+ checkdeadkey(n);+ if (ttisnil(gval(n))) /* entry is empty? */+ removeentry(n); /* remove it */+ else {+ lua_assert(!ttisnil(gkey(n)));+ markvalue(g, gkey(n)); /* mark key */+ if (!hasclears && iscleared(g, gval(n))) /* is there a white value? */+ hasclears = 1; /* table will have to be cleared */+ }+ }+ if (g->gcstate == GCSpropagate)+ linkgclist(h, g->grayagain); /* must retraverse it in atomic phase */+ else if (hasclears)+ linkgclist(h, g->weak); /* has to be cleared later */+}+++/*+** Traverse an ephemeron table and link it to proper list. Returns true+** iff any object was marked during this traversal (which implies that+** convergence has to continue). During propagation phase, keep table+** in 'grayagain' list, to be visited again in the atomic phase. In+** the atomic phase, if table has any white->white entry, it has to+** be revisited during ephemeron convergence (as that key may turn+** black). Otherwise, if it has any white key, table has to be cleared+** (in the atomic phase).+*/+static int traverseephemeron (global_State *g, Table *h) {+ int marked = 0; /* true if an object is marked in this traversal */+ int hasclears = 0; /* true if table has white keys */+ int hasww = 0; /* true if table has entry "white-key -> white-value" */+ Node *n, *limit = gnodelast(h);+ unsigned int i;+ /* traverse array part */+ for (i = 0; i < h->sizearray; i++) {+ if (valiswhite(&h->array[i])) {+ marked = 1;+ reallymarkobject(g, gcvalue(&h->array[i]));+ }+ }+ /* traverse hash part */+ for (n = gnode(h, 0); n < limit; n++) {+ checkdeadkey(n);+ if (ttisnil(gval(n))) /* entry is empty? */+ removeentry(n); /* remove it */+ else if (iscleared(g, gkey(n))) { /* key is not marked (yet)? */+ hasclears = 1; /* table must be cleared */+ if (valiswhite(gval(n))) /* value not marked yet? */+ hasww = 1; /* white-white entry */+ }+ else if (valiswhite(gval(n))) { /* value not marked yet? */+ marked = 1;+ reallymarkobject(g, gcvalue(gval(n))); /* mark it now */+ }+ }+ /* link table into proper list */+ if (g->gcstate == GCSpropagate)+ linkgclist(h, g->grayagain); /* must retraverse it in atomic phase */+ else if (hasww) /* table has white->white entries? */+ linkgclist(h, g->ephemeron); /* have to propagate again */+ else if (hasclears) /* table has white keys? */+ linkgclist(h, g->allweak); /* may have to clean white keys */+ return marked;+}+++static void traversestrongtable (global_State *g, Table *h) {+ Node *n, *limit = gnodelast(h);+ unsigned int i;+ for (i = 0; i < h->sizearray; i++) /* traverse array part */+ markvalue(g, &h->array[i]);+ for (n = gnode(h, 0); n < limit; n++) { /* traverse hash part */+ checkdeadkey(n);+ if (ttisnil(gval(n))) /* entry is empty? */+ removeentry(n); /* remove it */+ else {+ lua_assert(!ttisnil(gkey(n)));+ markvalue(g, gkey(n)); /* mark key */+ markvalue(g, gval(n)); /* mark value */+ }+ }+}+++static lu_mem traversetable (global_State *g, Table *h) {+ const char *weakkey, *weakvalue;+ const TValue *mode = gfasttm(g, h->metatable, TM_MODE);+ markobjectN(g, h->metatable);+ if (mode && ttisstring(mode) && /* is there a weak mode? */+ ((weakkey = strchr(svalue(mode), 'k')),+ (weakvalue = strchr(svalue(mode), 'v')),+ (weakkey || weakvalue))) { /* is really weak? */+ black2gray(h); /* keep table gray */+ if (!weakkey) /* strong keys? */+ traverseweakvalue(g, h);+ else if (!weakvalue) /* strong values? */+ traverseephemeron(g, h);+ else /* all weak */+ linkgclist(h, g->allweak); /* nothing to traverse now */+ }+ else /* not weak */+ traversestrongtable(g, h);+ return sizeof(Table) + sizeof(TValue) * h->sizearray ++ sizeof(Node) * cast(size_t, allocsizenode(h));+}+++/*+** Traverse a prototype. (While a prototype is being build, its+** arrays can be larger than needed; the extra slots are filled with+** NULL, so the use of 'markobjectN')+*/+static int traverseproto (global_State *g, Proto *f) {+ int i;+ if (f->cache && iswhite(f->cache))+ f->cache = NULL; /* allow cache to be collected */+ markobjectN(g, f->source);+ for (i = 0; i < f->sizek; i++) /* mark literals */+ markvalue(g, &f->k[i]);+ for (i = 0; i < f->sizeupvalues; i++) /* mark upvalue names */+ markobjectN(g, f->upvalues[i].name);+ for (i = 0; i < f->sizep; i++) /* mark nested protos */+ markobjectN(g, f->p[i]);+ for (i = 0; i < f->sizelocvars; i++) /* mark local-variable names */+ markobjectN(g, f->locvars[i].varname);+ return sizeof(Proto) + sizeof(Instruction) * f->sizecode ++ sizeof(Proto *) * f->sizep ++ sizeof(TValue) * f->sizek ++ sizeof(int) * f->sizelineinfo ++ sizeof(LocVar) * f->sizelocvars ++ sizeof(Upvaldesc) * f->sizeupvalues;+}+++static lu_mem traverseCclosure (global_State *g, CClosure *cl) {+ int i;+ for (i = 0; i < cl->nupvalues; i++) /* mark its upvalues */+ markvalue(g, &cl->upvalue[i]);+ return sizeCclosure(cl->nupvalues);+}++/*+** open upvalues point to values in a thread, so those values should+** be marked when the thread is traversed except in the atomic phase+** (because then the value cannot be changed by the thread and the+** thread may not be traversed again)+*/+static lu_mem traverseLclosure (global_State *g, LClosure *cl) {+ int i;+ markobjectN(g, cl->p); /* mark its prototype */+ for (i = 0; i < cl->nupvalues; i++) { /* mark its upvalues */+ UpVal *uv = cl->upvals[i];+ if (uv != NULL) {+ if (upisopen(uv) && g->gcstate != GCSinsideatomic)+ uv->u.open.touched = 1; /* can be marked in 'remarkupvals' */+ else+ markvalue(g, uv->v);+ }+ }+ return sizeLclosure(cl->nupvalues);+}+++static lu_mem traversethread (global_State *g, lua_State *th) {+ StkId o = th->stack;+ if (o == NULL)+ return 1; /* stack not completely built yet */+ lua_assert(g->gcstate == GCSinsideatomic ||+ th->openupval == NULL || isintwups(th));+ for (; o < th->top; o++) /* mark live elements in the stack */+ markvalue(g, o);+ if (g->gcstate == GCSinsideatomic) { /* final traversal? */+ StkId lim = th->stack + th->stacksize; /* real end of stack */+ for (; o < lim; o++) /* clear not-marked stack slice */+ setnilvalue(o);+ /* 'remarkupvals' may have removed thread from 'twups' list */+ if (!isintwups(th) && th->openupval != NULL) {+ th->twups = g->twups; /* link it back to the list */+ g->twups = th;+ }+ }+ else if (g->gckind != KGC_EMERGENCY)+ luaD_shrinkstack(th); /* do not change stack in emergency cycle */+ return (sizeof(lua_State) + sizeof(TValue) * th->stacksize ++ sizeof(CallInfo) * th->nci);+}+++/*+** traverse one gray object, turning it to black (except for threads,+** which are always gray).+*/+static void propagatemark (global_State *g) {+ lu_mem size;+ GCObject *o = g->gray;+ lua_assert(isgray(o));+ gray2black(o);+ switch (o->tt) {+ case LUA_TTABLE: {+ Table *h = gco2t(o);+ g->gray = h->gclist; /* remove from 'gray' list */+ size = traversetable(g, h);+ break;+ }+ case LUA_TLCL: {+ LClosure *cl = gco2lcl(o);+ g->gray = cl->gclist; /* remove from 'gray' list */+ size = traverseLclosure(g, cl);+ break;+ }+ case LUA_TCCL: {+ CClosure *cl = gco2ccl(o);+ g->gray = cl->gclist; /* remove from 'gray' list */+ size = traverseCclosure(g, cl);+ break;+ }+ case LUA_TTHREAD: {+ lua_State *th = gco2th(o);+ g->gray = th->gclist; /* remove from 'gray' list */+ linkgclist(th, g->grayagain); /* insert into 'grayagain' list */+ black2gray(o);+ size = traversethread(g, th);+ break;+ }+ case LUA_TPROTO: {+ Proto *p = gco2p(o);+ g->gray = p->gclist; /* remove from 'gray' list */+ size = traverseproto(g, p);+ break;+ }+ default: lua_assert(0); return;+ }+ g->GCmemtrav += size;+}+++static void propagateall (global_State *g) {+ while (g->gray) propagatemark(g);+}+++static void convergeephemerons (global_State *g) {+ int changed;+ do {+ GCObject *w;+ GCObject *next = g->ephemeron; /* get ephemeron list */+ g->ephemeron = NULL; /* tables may return to this list when traversed */+ changed = 0;+ while ((w = next) != NULL) {+ next = gco2t(w)->gclist;+ if (traverseephemeron(g, gco2t(w))) { /* traverse marked some value? */+ propagateall(g); /* propagate changes */+ changed = 1; /* will have to revisit all ephemeron tables */+ }+ }+ } while (changed);+}++/* }====================================================== */+++/*+** {======================================================+** Sweep Functions+** =======================================================+*/+++/*+** clear entries with unmarked keys from all weaktables in list 'l' up+** to element 'f'+*/+static void clearkeys (global_State *g, GCObject *l, GCObject *f) {+ for (; l != f; l = gco2t(l)->gclist) {+ Table *h = gco2t(l);+ Node *n, *limit = gnodelast(h);+ for (n = gnode(h, 0); n < limit; n++) {+ if (!ttisnil(gval(n)) && (iscleared(g, gkey(n)))) {+ setnilvalue(gval(n)); /* remove value ... */+ }+ if (ttisnil(gval(n))) /* is entry empty? */+ removeentry(n); /* remove entry from table */+ }+ }+}+++/*+** clear entries with unmarked values from all weaktables in list 'l' up+** to element 'f'+*/+static void clearvalues (global_State *g, GCObject *l, GCObject *f) {+ for (; l != f; l = gco2t(l)->gclist) {+ Table *h = gco2t(l);+ Node *n, *limit = gnodelast(h);+ unsigned int i;+ for (i = 0; i < h->sizearray; i++) {+ TValue *o = &h->array[i];+ if (iscleared(g, o)) /* value was collected? */+ setnilvalue(o); /* remove value */+ }+ for (n = gnode(h, 0); n < limit; n++) {+ if (!ttisnil(gval(n)) && iscleared(g, gval(n))) {+ setnilvalue(gval(n)); /* remove value ... */+ removeentry(n); /* and remove entry from table */+ }+ }+ }+}+++void luaC_upvdeccount (lua_State *L, UpVal *uv) {+ lua_assert(uv->refcount > 0);+ uv->refcount--;+ if (uv->refcount == 0 && !upisopen(uv))+ luaM_free(L, uv);+}+++static void freeLclosure (lua_State *L, LClosure *cl) {+ int i;+ for (i = 0; i < cl->nupvalues; i++) {+ UpVal *uv = cl->upvals[i];+ if (uv)+ luaC_upvdeccount(L, uv);+ }+ luaM_freemem(L, cl, sizeLclosure(cl->nupvalues));+}+++static void freeobj (lua_State *L, GCObject *o) {+ switch (o->tt) {+ case LUA_TPROTO: luaF_freeproto(L, gco2p(o)); break;+ case LUA_TLCL: {+ freeLclosure(L, gco2lcl(o));+ break;+ }+ case LUA_TCCL: {+ luaM_freemem(L, o, sizeCclosure(gco2ccl(o)->nupvalues));+ break;+ }+ case LUA_TTABLE: luaH_free(L, gco2t(o)); break;+ case LUA_TTHREAD: luaE_freethread(L, gco2th(o)); break;+ case LUA_TUSERDATA: luaM_freemem(L, o, sizeudata(gco2u(o))); break;+ case LUA_TSHRSTR:+ luaS_remove(L, gco2ts(o)); /* remove it from hash table */+ luaM_freemem(L, o, sizelstring(gco2ts(o)->shrlen));+ break;+ case LUA_TLNGSTR: {+ luaM_freemem(L, o, sizelstring(gco2ts(o)->u.lnglen));+ break;+ }+ default: lua_assert(0);+ }+}+++#define sweepwholelist(L,p) sweeplist(L,p,MAX_LUMEM)+static GCObject **sweeplist (lua_State *L, GCObject **p, lu_mem count);+++/*+** sweep at most 'count' elements from a list of GCObjects erasing dead+** objects, where a dead object is one marked with the old (non current)+** white; change all non-dead objects back to white, preparing for next+** collection cycle. Return where to continue the traversal or NULL if+** list is finished.+*/+static GCObject **sweeplist (lua_State *L, GCObject **p, lu_mem count) {+ global_State *g = G(L);+ int ow = otherwhite(g);+ int white = luaC_white(g); /* current white */+ while (*p != NULL && count-- > 0) {+ GCObject *curr = *p;+ int marked = curr->marked;+ if (isdeadm(ow, marked)) { /* is 'curr' dead? */+ *p = curr->next; /* remove 'curr' from list */+ freeobj(L, curr); /* erase 'curr' */+ }+ else { /* change mark to 'white' */+ curr->marked = cast_byte((marked & maskcolors) | white);+ p = &curr->next; /* go to next element */+ }+ }+ return (*p == NULL) ? NULL : p;+}+++/*+** sweep a list until a live object (or end of list)+*/+static GCObject **sweeptolive (lua_State *L, GCObject **p) {+ GCObject **old = p;+ do {+ p = sweeplist(L, p, 1);+ } while (p == old);+ return p;+}++/* }====================================================== */+++/*+** {======================================================+** Finalization+** =======================================================+*/++/*+** If possible, shrink string table+*/+static void checkSizes (lua_State *L, global_State *g) {+ if (g->gckind != KGC_EMERGENCY) {+ l_mem olddebt = g->GCdebt;+ if (g->strt.nuse < g->strt.size / 4) /* string table too big? */+ luaS_resize(L, g->strt.size / 2); /* shrink it a little */+ g->GCestimate += g->GCdebt - olddebt; /* update estimate */+ }+}+++static GCObject *udata2finalize (global_State *g) {+ GCObject *o = g->tobefnz; /* get first element */+ lua_assert(tofinalize(o));+ g->tobefnz = o->next; /* remove it from 'tobefnz' list */+ o->next = g->allgc; /* return it to 'allgc' list */+ g->allgc = o;+ resetbit(o->marked, FINALIZEDBIT); /* object is "normal" again */+ if (issweepphase(g))+ makewhite(g, o); /* "sweep" object */+ return o;+}+++static void dothecall (lua_State *L, void *ud) {+ UNUSED(ud);+ luaD_callnoyield(L, L->top - 2, 0);+}+++static void GCTM (lua_State *L, int propagateerrors) {+ global_State *g = G(L);+ const TValue *tm;+ TValue v;+ setgcovalue(L, &v, udata2finalize(g));+ tm = luaT_gettmbyobj(L, &v, TM_GC);+ if (tm != NULL && ttisfunction(tm)) { /* is there a finalizer? */+ int status;+ lu_byte oldah = L->allowhook;+ int running = g->gcrunning;+ L->allowhook = 0; /* stop debug hooks during GC metamethod */+ g->gcrunning = 0; /* avoid GC steps */+ setobj2s(L, L->top, tm); /* push finalizer... */+ setobj2s(L, L->top + 1, &v); /* ... and its argument */+ L->top += 2; /* and (next line) call the finalizer */+ L->ci->callstatus |= CIST_FIN; /* will run a finalizer */+ status = luaD_pcall(L, dothecall, NULL, savestack(L, L->top - 2), 0);+ L->ci->callstatus &= ~CIST_FIN; /* not running a finalizer anymore */+ L->allowhook = oldah; /* restore hooks */+ g->gcrunning = running; /* restore state */+ if (status != LUA_OK && propagateerrors) { /* error while running __gc? */+ if (status == LUA_ERRRUN) { /* is there an error object? */+ const char *msg = (ttisstring(L->top - 1))+ ? svalue(L->top - 1)+ : "no message";+ luaO_pushfstring(L, "error in __gc metamethod (%s)", msg);+ status = LUA_ERRGCMM; /* error in __gc metamethod */+ }+ luaD_throw(L, status); /* re-throw error */+ }+ }+}+++/*+** call a few (up to 'g->gcfinnum') finalizers+*/+static int runafewfinalizers (lua_State *L) {+ global_State *g = G(L);+ unsigned int i;+ lua_assert(!g->tobefnz || g->gcfinnum > 0);+ for (i = 0; g->tobefnz && i < g->gcfinnum; i++)+ GCTM(L, 1); /* call one finalizer */+ g->gcfinnum = (!g->tobefnz) ? 0 /* nothing more to finalize? */+ : g->gcfinnum * 2; /* else call a few more next time */+ return i;+}+++/*+** call all pending finalizers+*/+static void callallpendingfinalizers (lua_State *L) {+ global_State *g = G(L);+ while (g->tobefnz)+ GCTM(L, 0);+}+++/*+** find last 'next' field in list 'p' list (to add elements in its end)+*/+static GCObject **findlast (GCObject **p) {+ while (*p != NULL)+ p = &(*p)->next;+ return p;+}+++/*+** move all unreachable objects (or 'all' objects) that need+** finalization from list 'finobj' to list 'tobefnz' (to be finalized)+*/+static void separatetobefnz (global_State *g, int all) {+ GCObject *curr;+ GCObject **p = &g->finobj;+ GCObject **lastnext = findlast(&g->tobefnz);+ while ((curr = *p) != NULL) { /* traverse all finalizable objects */+ lua_assert(tofinalize(curr));+ if (!(iswhite(curr) || all)) /* not being collected? */+ p = &curr->next; /* don't bother with it */+ else {+ *p = curr->next; /* remove 'curr' from 'finobj' list */+ curr->next = *lastnext; /* link at the end of 'tobefnz' list */+ *lastnext = curr;+ lastnext = &curr->next;+ }+ }+}+++/*+** if object 'o' has a finalizer, remove it from 'allgc' list (must+** search the list to find it) and link it in 'finobj' list.+*/+void luaC_checkfinalizer (lua_State *L, GCObject *o, Table *mt) {+ global_State *g = G(L);+ if (tofinalize(o) || /* obj. is already marked... */+ gfasttm(g, mt, TM_GC) == NULL) /* or has no finalizer? */+ return; /* nothing to be done */+ else { /* move 'o' to 'finobj' list */+ GCObject **p;+ if (issweepphase(g)) {+ makewhite(g, o); /* "sweep" object 'o' */+ if (g->sweepgc == &o->next) /* should not remove 'sweepgc' object */+ g->sweepgc = sweeptolive(L, g->sweepgc); /* change 'sweepgc' */+ }+ /* search for pointer pointing to 'o' */+ for (p = &g->allgc; *p != o; p = &(*p)->next) { /* empty */ }+ *p = o->next; /* remove 'o' from 'allgc' list */+ o->next = g->finobj; /* link it in 'finobj' list */+ g->finobj = o;+ l_setbit(o->marked, FINALIZEDBIT); /* mark it as such */+ }+}++/* }====================================================== */++++/*+** {======================================================+** GC control+** =======================================================+*/+++/*+** Set a reasonable "time" to wait before starting a new GC cycle; cycle+** will start when memory use hits threshold. (Division by 'estimate'+** should be OK: it cannot be zero (because Lua cannot even start with+** less than PAUSEADJ bytes).+*/+static void setpause (global_State *g) {+ l_mem threshold, debt;+ l_mem estimate = g->GCestimate / PAUSEADJ; /* adjust 'estimate' */+ lua_assert(estimate > 0);+ threshold = (g->gcpause < MAX_LMEM / estimate) /* overflow? */+ ? estimate * g->gcpause /* no overflow */+ : MAX_LMEM; /* overflow; truncate to maximum */+ debt = gettotalbytes(g) - threshold;+ luaE_setdebt(g, debt);+}+++/*+** Enter first sweep phase.+** The call to 'sweeplist' tries to make pointer point to an object+** inside the list (instead of to the header), so that the real sweep do+** not need to skip objects created between "now" and the start of the+** real sweep.+*/+static void entersweep (lua_State *L) {+ global_State *g = G(L);+ g->gcstate = GCSswpallgc;+ lua_assert(g->sweepgc == NULL);+ g->sweepgc = sweeplist(L, &g->allgc, 1);+}+++void luaC_freeallobjects (lua_State *L) {+ global_State *g = G(L);+ separatetobefnz(g, 1); /* separate all objects with finalizers */+ lua_assert(g->finobj == NULL);+ callallpendingfinalizers(L);+ lua_assert(g->tobefnz == NULL);+ g->currentwhite = WHITEBITS; /* this "white" makes all objects look dead */+ g->gckind = KGC_NORMAL;+ sweepwholelist(L, &g->finobj);+ sweepwholelist(L, &g->allgc);+ sweepwholelist(L, &g->fixedgc); /* collect fixed objects */+ lua_assert(g->strt.nuse == 0);+}+++static l_mem atomic (lua_State *L) {+ global_State *g = G(L);+ l_mem work;+ GCObject *origweak, *origall;+ GCObject *grayagain = g->grayagain; /* save original list */+ lua_assert(g->ephemeron == NULL && g->weak == NULL);+ lua_assert(!iswhite(g->mainthread));+ g->gcstate = GCSinsideatomic;+ g->GCmemtrav = 0; /* start counting work */+ markobject(g, L); /* mark running thread */+ /* registry and global metatables may be changed by API */+ markvalue(g, &g->l_registry);+ markmt(g); /* mark global metatables */+ /* remark occasional upvalues of (maybe) dead threads */+ remarkupvals(g);+ propagateall(g); /* propagate changes */+ work = g->GCmemtrav; /* stop counting (do not recount 'grayagain') */+ g->gray = grayagain;+ propagateall(g); /* traverse 'grayagain' list */+ g->GCmemtrav = 0; /* restart counting */+ convergeephemerons(g);+ /* at this point, all strongly accessible objects are marked. */+ /* Clear values from weak tables, before checking finalizers */+ clearvalues(g, g->weak, NULL);+ clearvalues(g, g->allweak, NULL);+ origweak = g->weak; origall = g->allweak;+ work += g->GCmemtrav; /* stop counting (objects being finalized) */+ separatetobefnz(g, 0); /* separate objects to be finalized */+ g->gcfinnum = 1; /* there may be objects to be finalized */+ markbeingfnz(g); /* mark objects that will be finalized */+ propagateall(g); /* remark, to propagate 'resurrection' */+ g->GCmemtrav = 0; /* restart counting */+ convergeephemerons(g);+ /* at this point, all resurrected objects are marked. */+ /* remove dead objects from weak tables */+ clearkeys(g, g->ephemeron, NULL); /* clear keys from all ephemeron tables */+ clearkeys(g, g->allweak, NULL); /* clear keys from all 'allweak' tables */+ /* clear values from resurrected weak tables */+ clearvalues(g, g->weak, origweak);+ clearvalues(g, g->allweak, origall);+ luaS_clearcache(g);+ g->currentwhite = cast_byte(otherwhite(g)); /* flip current white */+ work += g->GCmemtrav; /* complete counting */+ return work; /* estimate of memory marked by 'atomic' */+}+++static lu_mem sweepstep (lua_State *L, global_State *g,+ int nextstate, GCObject **nextlist) {+ if (g->sweepgc) {+ l_mem olddebt = g->GCdebt;+ g->sweepgc = sweeplist(L, g->sweepgc, GCSWEEPMAX);+ g->GCestimate += g->GCdebt - olddebt; /* update estimate */+ if (g->sweepgc) /* is there still something to sweep? */+ return (GCSWEEPMAX * GCSWEEPCOST);+ }+ /* else enter next state */+ g->gcstate = nextstate;+ g->sweepgc = nextlist;+ return 0;+}+++static lu_mem singlestep (lua_State *L) {+ global_State *g = G(L);+ switch (g->gcstate) {+ case GCSpause: {+ g->GCmemtrav = g->strt.size * sizeof(GCObject*);+ restartcollection(g);+ g->gcstate = GCSpropagate;+ return g->GCmemtrav;+ }+ case GCSpropagate: {+ g->GCmemtrav = 0;+ lua_assert(g->gray);+ propagatemark(g);+ if (g->gray == NULL) /* no more gray objects? */+ g->gcstate = GCSatomic; /* finish propagate phase */+ return g->GCmemtrav; /* memory traversed in this step */+ }+ case GCSatomic: {+ lu_mem work;+ propagateall(g); /* make sure gray list is empty */+ work = atomic(L); /* work is what was traversed by 'atomic' */+ entersweep(L);+ g->GCestimate = gettotalbytes(g); /* first estimate */;+ return work;+ }+ case GCSswpallgc: { /* sweep "regular" objects */+ return sweepstep(L, g, GCSswpfinobj, &g->finobj);+ }+ case GCSswpfinobj: { /* sweep objects with finalizers */+ return sweepstep(L, g, GCSswptobefnz, &g->tobefnz);+ }+ case GCSswptobefnz: { /* sweep objects to be finalized */+ return sweepstep(L, g, GCSswpend, NULL);+ }+ case GCSswpend: { /* finish sweeps */+ makewhite(g, g->mainthread); /* sweep main thread */+ checkSizes(L, g);+ g->gcstate = GCScallfin;+ return 0;+ }+ case GCScallfin: { /* call remaining finalizers */+ if (g->tobefnz && g->gckind != KGC_EMERGENCY) {+ int n = runafewfinalizers(L);+ return (n * GCFINALIZECOST);+ }+ else { /* emergency mode or no more finalizers */+ g->gcstate = GCSpause; /* finish collection */+ return 0;+ }+ }+ default: lua_assert(0); return 0;+ }+}+++/*+** advances the garbage collector until it reaches a state allowed+** by 'statemask'+*/+void luaC_runtilstate (lua_State *L, int statesmask) {+ global_State *g = G(L);+ while (!testbit(statesmask, g->gcstate))+ singlestep(L);+}+++/*+** get GC debt and convert it from Kb to 'work units' (avoid zero debt+** and overflows)+*/+static l_mem getdebt (global_State *g) {+ l_mem debt = g->GCdebt;+ int stepmul = g->gcstepmul;+ if (debt <= 0) return 0; /* minimal debt */+ else {+ debt = (debt / STEPMULADJ) + 1;+ debt = (debt < MAX_LMEM / stepmul) ? debt * stepmul : MAX_LMEM;+ return debt;+ }+}++/*+** performs a basic GC step when collector is running+*/+void luaC_step (lua_State *L) {+ global_State *g = G(L);+ l_mem debt = getdebt(g); /* GC deficit (be paid now) */+ if (!g->gcrunning) { /* not running? */+ luaE_setdebt(g, -GCSTEPSIZE * 10); /* avoid being called too often */+ return;+ }+ do { /* repeat until pause or enough "credit" (negative debt) */+ lu_mem work = singlestep(L); /* perform one single step */+ debt -= work;+ } while (debt > -GCSTEPSIZE && g->gcstate != GCSpause);+ if (g->gcstate == GCSpause)+ setpause(g); /* pause until next cycle */+ else {+ debt = (debt / g->gcstepmul) * STEPMULADJ; /* convert 'work units' to Kb */+ luaE_setdebt(g, debt);+ runafewfinalizers(L);+ }+}+++/*+** Performs a full GC cycle; if 'isemergency', set a flag to avoid+** some operations which could change the interpreter state in some+** unexpected ways (running finalizers and shrinking some structures).+** Before running the collection, check 'keepinvariant'; if it is true,+** there may be some objects marked as black, so the collector has+** to sweep all objects to turn them back to white (as white has not+** changed, nothing will be collected).+*/+void luaC_fullgc (lua_State *L, int isemergency) {+ global_State *g = G(L);+ lua_assert(g->gckind == KGC_NORMAL);+ if (isemergency) g->gckind = KGC_EMERGENCY; /* set flag */+ if (keepinvariant(g)) { /* black objects? */+ entersweep(L); /* sweep everything to turn them back to white */+ }+ /* finish any pending sweep phase to start a new cycle */+ luaC_runtilstate(L, bitmask(GCSpause));+ luaC_runtilstate(L, ~bitmask(GCSpause)); /* start new collection */+ luaC_runtilstate(L, bitmask(GCScallfin)); /* run up to finalizers */+ /* estimate must be correct after a full GC cycle */+ lua_assert(g->GCestimate == gettotalbytes(g));+ luaC_runtilstate(L, bitmask(GCSpause)); /* finish collection */+ g->gckind = KGC_NORMAL;+ setpause(g);+}++/* }====================================================== */++
+ cbits/lua-5.3.6/lgc.h view
@@ -0,0 +1,147 @@+/*+** $Id: lgc.h,v 2.91.1.1 2017/04/19 17:39:34 roberto Exp $+** Garbage Collector+** See Copyright Notice in lua.h+*/++#ifndef lgc_h+#define lgc_h+++#include "lobject.h"+#include "lstate.h"++/*+** Collectable objects may have one of three colors: white, which+** means the object is not marked; gray, which means the+** object is marked, but its references may be not marked; and+** black, which means that the object and all its references are marked.+** The main invariant of the garbage collector, while marking objects,+** is that a black object can never point to a white one. Moreover,+** any gray object must be in a "gray list" (gray, grayagain, weak,+** allweak, ephemeron) so that it can be visited again before finishing+** the collection cycle. These lists have no meaning when the invariant+** is not being enforced (e.g., sweep phase).+*/++++/* how much to allocate before next GC step */+#if !defined(GCSTEPSIZE)+/* ~100 small strings */+#define GCSTEPSIZE (cast_int(100 * sizeof(TString)))+#endif+++/*+** Possible states of the Garbage Collector+*/+#define GCSpropagate 0+#define GCSatomic 1+#define GCSswpallgc 2+#define GCSswpfinobj 3+#define GCSswptobefnz 4+#define GCSswpend 5+#define GCScallfin 6+#define GCSpause 7+++#define issweepphase(g) \+ (GCSswpallgc <= (g)->gcstate && (g)->gcstate <= GCSswpend)+++/*+** macro to tell when main invariant (white objects cannot point to black+** ones) must be kept. During a collection, the sweep+** phase may break the invariant, as objects turned white may point to+** still-black objects. The invariant is restored when sweep ends and+** all objects are white again.+*/++#define keepinvariant(g) ((g)->gcstate <= GCSatomic)+++/*+** some useful bit tricks+*/+#define resetbits(x,m) ((x) &= cast(lu_byte, ~(m)))+#define setbits(x,m) ((x) |= (m))+#define testbits(x,m) ((x) & (m))+#define bitmask(b) (1<<(b))+#define bit2mask(b1,b2) (bitmask(b1) | bitmask(b2))+#define l_setbit(x,b) setbits(x, bitmask(b))+#define resetbit(x,b) resetbits(x, bitmask(b))+#define testbit(x,b) testbits(x, bitmask(b))+++/* Layout for bit use in 'marked' field: */+#define WHITE0BIT 0 /* object is white (type 0) */+#define WHITE1BIT 1 /* object is white (type 1) */+#define BLACKBIT 2 /* object is black */+#define FINALIZEDBIT 3 /* object has been marked for finalization */+/* bit 7 is currently used by tests (luaL_checkmemory) */++#define WHITEBITS bit2mask(WHITE0BIT, WHITE1BIT)+++#define iswhite(x) testbits((x)->marked, WHITEBITS)+#define isblack(x) testbit((x)->marked, BLACKBIT)+#define isgray(x) /* neither white nor black */ \+ (!testbits((x)->marked, WHITEBITS | bitmask(BLACKBIT)))++#define tofinalize(x) testbit((x)->marked, FINALIZEDBIT)++#define otherwhite(g) ((g)->currentwhite ^ WHITEBITS)+#define isdeadm(ow,m) (!(((m) ^ WHITEBITS) & (ow)))+#define isdead(g,v) isdeadm(otherwhite(g), (v)->marked)++#define changewhite(x) ((x)->marked ^= WHITEBITS)+#define gray2black(x) l_setbit((x)->marked, BLACKBIT)++#define luaC_white(g) cast(lu_byte, (g)->currentwhite & WHITEBITS)+++/*+** Does one step of collection when debt becomes positive. 'pre'/'pos'+** allows some adjustments to be done only when needed. macro+** 'condchangemem' is used only for heavy tests (forcing a full+** GC cycle on every opportunity)+*/+#define luaC_condGC(L,pre,pos) \+ { if (G(L)->GCdebt > 0) { pre; luaC_step(L); pos;}; \+ condchangemem(L,pre,pos); }++/* more often than not, 'pre'/'pos' are empty */+#define luaC_checkGC(L) luaC_condGC(L,(void)0,(void)0)+++#define luaC_barrier(L,p,v) ( \+ (iscollectable(v) && isblack(p) && iswhite(gcvalue(v))) ? \+ luaC_barrier_(L,obj2gco(p),gcvalue(v)) : cast_void(0))++#define luaC_barrierback(L,p,v) ( \+ (iscollectable(v) && isblack(p) && iswhite(gcvalue(v))) ? \+ luaC_barrierback_(L,p) : cast_void(0))++#define luaC_objbarrier(L,p,o) ( \+ (isblack(p) && iswhite(o)) ? \+ luaC_barrier_(L,obj2gco(p),obj2gco(o)) : cast_void(0))++#define luaC_upvalbarrier(L,uv) ( \+ (iscollectable((uv)->v) && !upisopen(uv)) ? \+ luaC_upvalbarrier_(L,uv) : cast_void(0))++LUAI_FUNC void luaC_fix (lua_State *L, GCObject *o);+LUAI_FUNC void luaC_freeallobjects (lua_State *L);+LUAI_FUNC void luaC_step (lua_State *L);+LUAI_FUNC void luaC_runtilstate (lua_State *L, int statesmask);+LUAI_FUNC void luaC_fullgc (lua_State *L, int isemergency);+LUAI_FUNC GCObject *luaC_newobj (lua_State *L, int tt, size_t sz);+LUAI_FUNC void luaC_barrier_ (lua_State *L, GCObject *o, GCObject *v);+LUAI_FUNC void luaC_barrierback_ (lua_State *L, Table *o);+LUAI_FUNC void luaC_upvalbarrier_ (lua_State *L, UpVal *uv);+LUAI_FUNC void luaC_checkfinalizer (lua_State *L, GCObject *o, Table *mt);+LUAI_FUNC void luaC_upvdeccount (lua_State *L, UpVal *uv);+++#endif
+ cbits/lua-5.3.6/linit.c view
@@ -0,0 +1,68 @@+/*+** $Id: linit.c,v 1.39.1.1 2017/04/19 17:20:42 roberto Exp $+** Initialization of libraries for lua.c and other clients+** See Copyright Notice in lua.h+*/+++#define linit_c+#define LUA_LIB++/*+** If you embed Lua in your program and need to open the standard+** libraries, call luaL_openlibs in your program. If you need a+** different set of libraries, copy this file to your project and edit+** it to suit your needs.+**+** You can also *preload* libraries, so that a later 'require' can+** open the library, which is already linked to the application.+** For that, do the following code:+**+** luaL_getsubtable(L, LUA_REGISTRYINDEX, LUA_PRELOAD_TABLE);+** lua_pushcfunction(L, luaopen_modname);+** lua_setfield(L, -2, modname);+** lua_pop(L, 1); // remove PRELOAD table+*/++#include "lprefix.h"+++#include <stddef.h>++#include "lua.h"++#include "lualib.h"+#include "lauxlib.h"+++/*+** these libs are loaded by lua.c and are readily available to any Lua+** program+*/+static const luaL_Reg loadedlibs[] = {+ {"_G", luaopen_base},+ {LUA_LOADLIBNAME, luaopen_package},+ {LUA_COLIBNAME, luaopen_coroutine},+ {LUA_TABLIBNAME, luaopen_table},+ {LUA_IOLIBNAME, luaopen_io},+ {LUA_OSLIBNAME, luaopen_os},+ {LUA_STRLIBNAME, luaopen_string},+ {LUA_MATHLIBNAME, luaopen_math},+ {LUA_UTF8LIBNAME, luaopen_utf8},+ {LUA_DBLIBNAME, luaopen_debug},+#if defined(LUA_COMPAT_BITLIB)+ {LUA_BITLIBNAME, luaopen_bit32},+#endif+ {NULL, NULL}+};+++LUALIB_API void luaL_openlibs (lua_State *L) {+ const luaL_Reg *lib;+ /* "require" functions from 'loadedlibs' and set results to global table */+ for (lib = loadedlibs; lib->func; lib++) {+ luaL_requiref(L, lib->name, lib->func, 1);+ lua_pop(L, 1); /* remove lib */+ }+}+
+ cbits/lua-5.3.6/liolib.c view
@@ -0,0 +1,778 @@+/*+** $Id: liolib.c,v 2.151.1.1 2017/04/19 17:29:57 roberto Exp $+** Standard I/O (and system) library+** See Copyright Notice in lua.h+*/++#define liolib_c+#define LUA_LIB++#include "lprefix.h"+++#include <ctype.h>+#include <errno.h>+#include <locale.h>+#include <stdio.h>+#include <stdlib.h>+#include <string.h>++#include "lua.h"++#include "lauxlib.h"+#include "lualib.h"+++++/*+** Change this macro to accept other modes for 'fopen' besides+** the standard ones.+*/+#if !defined(l_checkmode)++/* accepted extensions to 'mode' in 'fopen' */+#if !defined(L_MODEEXT)+#define L_MODEEXT "b"+#endif++/* Check whether 'mode' matches '[rwa]%+?[L_MODEEXT]*' */+static int l_checkmode (const char *mode) {+ return (*mode != '\0' && strchr("rwa", *(mode++)) != NULL &&+ (*mode != '+' || (++mode, 1)) && /* skip if char is '+' */+ (strspn(mode, L_MODEEXT) == strlen(mode))); /* check extensions */+}++#endif++/*+** {======================================================+** l_popen spawns a new process connected to the current+** one through the file streams.+** =======================================================+*/++#if !defined(l_popen) /* { */++#if defined(LUA_USE_POSIX) /* { */++#define l_popen(L,c,m) (fflush(NULL), popen(c,m))+#define l_pclose(L,file) (pclose(file))++#elif defined(LUA_USE_WINDOWS) /* }{ */++#define l_popen(L,c,m) (_popen(c,m))+#define l_pclose(L,file) (_pclose(file))++#else /* }{ */++/* ISO C definitions */+#define l_popen(L,c,m) \+ ((void)((void)c, m), \+ luaL_error(L, "'popen' not supported"), \+ (FILE*)0)+#define l_pclose(L,file) ((void)L, (void)file, -1)++#endif /* } */++#endif /* } */++/* }====================================================== */+++#if !defined(l_getc) /* { */++#if defined(LUA_USE_POSIX)+#define l_getc(f) getc_unlocked(f)+#define l_lockfile(f) flockfile(f)+#define l_unlockfile(f) funlockfile(f)+#else+#define l_getc(f) getc(f)+#define l_lockfile(f) ((void)0)+#define l_unlockfile(f) ((void)0)+#endif++#endif /* } */+++/*+** {======================================================+** l_fseek: configuration for longer offsets+** =======================================================+*/++#if !defined(l_fseek) /* { */++#if defined(LUA_USE_POSIX) /* { */++#include <sys/types.h>++#define l_fseek(f,o,w) fseeko(f,o,w)+#define l_ftell(f) ftello(f)+#define l_seeknum off_t++#elif defined(LUA_USE_WINDOWS) && !defined(_CRTIMP_TYPEINFO) \+ && defined(_MSC_VER) && (_MSC_VER >= 1400) /* }{ */++/* Windows (but not DDK) and Visual C++ 2005 or higher */+#define l_fseek(f,o,w) _fseeki64(f,o,w)+#define l_ftell(f) _ftelli64(f)+#define l_seeknum __int64++#else /* }{ */++/* ISO C definitions */+#define l_fseek(f,o,w) fseek(f,o,w)+#define l_ftell(f) ftell(f)+#define l_seeknum long++#endif /* } */++#endif /* } */++/* }====================================================== */+++#define IO_PREFIX "_IO_"+#define IOPREF_LEN (sizeof(IO_PREFIX)/sizeof(char) - 1)+#define IO_INPUT (IO_PREFIX "input")+#define IO_OUTPUT (IO_PREFIX "output")+++typedef luaL_Stream LStream;+++#define tolstream(L) ((LStream *)luaL_checkudata(L, 1, LUA_FILEHANDLE))++#define isclosed(p) ((p)->closef == NULL)+++static int io_type (lua_State *L) {+ LStream *p;+ luaL_checkany(L, 1);+ p = (LStream *)luaL_testudata(L, 1, LUA_FILEHANDLE);+ if (p == NULL)+ lua_pushnil(L); /* not a file */+ else if (isclosed(p))+ lua_pushliteral(L, "closed file");+ else+ lua_pushliteral(L, "file");+ return 1;+}+++static int f_tostring (lua_State *L) {+ LStream *p = tolstream(L);+ if (isclosed(p))+ lua_pushliteral(L, "file (closed)");+ else+ lua_pushfstring(L, "file (%p)", p->f);+ return 1;+}+++static FILE *tofile (lua_State *L) {+ LStream *p = tolstream(L);+ if (isclosed(p))+ luaL_error(L, "attempt to use a closed file");+ lua_assert(p->f);+ return p->f;+}+++/*+** When creating file handles, always creates a 'closed' file handle+** before opening the actual file; so, if there is a memory error, the+** handle is in a consistent state.+*/+static LStream *newprefile (lua_State *L) {+ LStream *p = (LStream *)lua_newuserdata(L, sizeof(LStream));+ p->closef = NULL; /* mark file handle as 'closed' */+ luaL_setmetatable(L, LUA_FILEHANDLE);+ return p;+}+++/*+** Calls the 'close' function from a file handle. The 'volatile' avoids+** a bug in some versions of the Clang compiler (e.g., clang 3.0 for+** 32 bits).+*/+static int aux_close (lua_State *L) {+ LStream *p = tolstream(L);+ volatile lua_CFunction cf = p->closef;+ p->closef = NULL; /* mark stream as closed */+ return (*cf)(L); /* close it */+}+++static int f_close (lua_State *L) {+ tofile(L); /* make sure argument is an open stream */+ return aux_close(L);+}+++static int io_close (lua_State *L) {+ if (lua_isnone(L, 1)) /* no argument? */+ lua_getfield(L, LUA_REGISTRYINDEX, IO_OUTPUT); /* use standard output */+ return f_close(L);+}+++static int f_gc (lua_State *L) {+ LStream *p = tolstream(L);+ if (!isclosed(p) && p->f != NULL)+ aux_close(L); /* ignore closed and incompletely open files */+ return 0;+}+++/*+** function to close regular files+*/+static int io_fclose (lua_State *L) {+ LStream *p = tolstream(L);+ int res = fclose(p->f);+ return luaL_fileresult(L, (res == 0), NULL);+}+++static LStream *newfile (lua_State *L) {+ LStream *p = newprefile(L);+ p->f = NULL;+ p->closef = &io_fclose;+ return p;+}+++static void opencheck (lua_State *L, const char *fname, const char *mode) {+ LStream *p = newfile(L);+ p->f = fopen(fname, mode);+ if (p->f == NULL)+ luaL_error(L, "cannot open file '%s' (%s)", fname, strerror(errno));+}+++static int io_open (lua_State *L) {+ const char *filename = luaL_checkstring(L, 1);+ const char *mode = luaL_optstring(L, 2, "r");+ LStream *p = newfile(L);+ const char *md = mode; /* to traverse/check mode */+ luaL_argcheck(L, l_checkmode(md), 2, "invalid mode");+ p->f = fopen(filename, mode);+ return (p->f == NULL) ? luaL_fileresult(L, 0, filename) : 1;+}+++/*+** function to close 'popen' files+*/+static int io_pclose (lua_State *L) {+ LStream *p = tolstream(L);+ return luaL_execresult(L, l_pclose(L, p->f));+}+++static int io_popen (lua_State *L) {+ const char *filename = luaL_checkstring(L, 1);+ const char *mode = luaL_optstring(L, 2, "r");+ LStream *p = newprefile(L);+ luaL_argcheck(L, ((mode[0] == 'r' || mode[0] == 'w') && mode[1] == '\0'),+ 2, "invalid mode");+ p->f = l_popen(L, filename, mode);+ p->closef = &io_pclose;+ return (p->f == NULL) ? luaL_fileresult(L, 0, filename) : 1;+}+++static int io_tmpfile (lua_State *L) {+ LStream *p = newfile(L);+ p->f = tmpfile();+ return (p->f == NULL) ? luaL_fileresult(L, 0, NULL) : 1;+}+++static FILE *getiofile (lua_State *L, const char *findex) {+ LStream *p;+ lua_getfield(L, LUA_REGISTRYINDEX, findex);+ p = (LStream *)lua_touserdata(L, -1);+ if (isclosed(p))+ luaL_error(L, "standard %s file is closed", findex + IOPREF_LEN);+ return p->f;+}+++static int g_iofile (lua_State *L, const char *f, const char *mode) {+ if (!lua_isnoneornil(L, 1)) {+ const char *filename = lua_tostring(L, 1);+ if (filename)+ opencheck(L, filename, mode);+ else {+ tofile(L); /* check that it's a valid file handle */+ lua_pushvalue(L, 1);+ }+ lua_setfield(L, LUA_REGISTRYINDEX, f);+ }+ /* return current value */+ lua_getfield(L, LUA_REGISTRYINDEX, f);+ return 1;+}+++static int io_input (lua_State *L) {+ return g_iofile(L, IO_INPUT, "r");+}+++static int io_output (lua_State *L) {+ return g_iofile(L, IO_OUTPUT, "w");+}+++static int io_readline (lua_State *L);+++/*+** maximum number of arguments to 'f:lines'/'io.lines' (it + 3 must fit+** in the limit for upvalues of a closure)+*/+#define MAXARGLINE 250++static void aux_lines (lua_State *L, int toclose) {+ int n = lua_gettop(L) - 1; /* number of arguments to read */+ luaL_argcheck(L, n <= MAXARGLINE, MAXARGLINE + 2, "too many arguments");+ lua_pushinteger(L, n); /* number of arguments to read */+ lua_pushboolean(L, toclose); /* close/not close file when finished */+ lua_rotate(L, 2, 2); /* move 'n' and 'toclose' to their positions */+ lua_pushcclosure(L, io_readline, 3 + n);+}+++static int f_lines (lua_State *L) {+ tofile(L); /* check that it's a valid file handle */+ aux_lines(L, 0);+ return 1;+}+++static int io_lines (lua_State *L) {+ int toclose;+ if (lua_isnone(L, 1)) lua_pushnil(L); /* at least one argument */+ if (lua_isnil(L, 1)) { /* no file name? */+ lua_getfield(L, LUA_REGISTRYINDEX, IO_INPUT); /* get default input */+ lua_replace(L, 1); /* put it at index 1 */+ tofile(L); /* check that it's a valid file handle */+ toclose = 0; /* do not close it after iteration */+ }+ else { /* open a new file */+ const char *filename = luaL_checkstring(L, 1);+ opencheck(L, filename, "r");+ lua_replace(L, 1); /* put file at index 1 */+ toclose = 1; /* close it after iteration */+ }+ aux_lines(L, toclose);+ return 1;+}+++/*+** {======================================================+** READ+** =======================================================+*/+++/* maximum length of a numeral */+#if !defined (L_MAXLENNUM)+#define L_MAXLENNUM 200+#endif+++/* auxiliary structure used by 'read_number' */+typedef struct {+ FILE *f; /* file being read */+ int c; /* current character (look ahead) */+ int n; /* number of elements in buffer 'buff' */+ char buff[L_MAXLENNUM + 1]; /* +1 for ending '\0' */+} RN;+++/*+** Add current char to buffer (if not out of space) and read next one+*/+static int nextc (RN *rn) {+ if (rn->n >= L_MAXLENNUM) { /* buffer overflow? */+ rn->buff[0] = '\0'; /* invalidate result */+ return 0; /* fail */+ }+ else {+ rn->buff[rn->n++] = rn->c; /* save current char */+ rn->c = l_getc(rn->f); /* read next one */+ return 1;+ }+}+++/*+** Accept current char if it is in 'set' (of size 2)+*/+static int test2 (RN *rn, const char *set) {+ if (rn->c == set[0] || rn->c == set[1])+ return nextc(rn);+ else return 0;+}+++/*+** Read a sequence of (hex)digits+*/+static int readdigits (RN *rn, int hex) {+ int count = 0;+ while ((hex ? isxdigit(rn->c) : isdigit(rn->c)) && nextc(rn))+ count++;+ return count;+}+++/*+** Read a number: first reads a valid prefix of a numeral into a buffer.+** Then it calls 'lua_stringtonumber' to check whether the format is+** correct and to convert it to a Lua number+*/+static int read_number (lua_State *L, FILE *f) {+ RN rn;+ int count = 0;+ int hex = 0;+ char decp[2];+ rn.f = f; rn.n = 0;+ decp[0] = lua_getlocaledecpoint(); /* get decimal point from locale */+ decp[1] = '.'; /* always accept a dot */+ l_lockfile(rn.f);+ do { rn.c = l_getc(rn.f); } while (isspace(rn.c)); /* skip spaces */+ test2(&rn, "-+"); /* optional signal */+ if (test2(&rn, "00")) {+ if (test2(&rn, "xX")) hex = 1; /* numeral is hexadecimal */+ else count = 1; /* count initial '0' as a valid digit */+ }+ count += readdigits(&rn, hex); /* integral part */+ if (test2(&rn, decp)) /* decimal point? */+ count += readdigits(&rn, hex); /* fractional part */+ if (count > 0 && test2(&rn, (hex ? "pP" : "eE"))) { /* exponent mark? */+ test2(&rn, "-+"); /* exponent signal */+ readdigits(&rn, 0); /* exponent digits */+ }+ ungetc(rn.c, rn.f); /* unread look-ahead char */+ l_unlockfile(rn.f);+ rn.buff[rn.n] = '\0'; /* finish string */+ if (lua_stringtonumber(L, rn.buff)) /* is this a valid number? */+ return 1; /* ok */+ else { /* invalid format */+ lua_pushnil(L); /* "result" to be removed */+ return 0; /* read fails */+ }+}+++static int test_eof (lua_State *L, FILE *f) {+ int c = getc(f);+ ungetc(c, f); /* no-op when c == EOF */+ lua_pushliteral(L, "");+ return (c != EOF);+}+++static int read_line (lua_State *L, FILE *f, int chop) {+ luaL_Buffer b;+ int c = '\0';+ luaL_buffinit(L, &b);+ while (c != EOF && c != '\n') { /* repeat until end of line */+ char *buff = luaL_prepbuffer(&b); /* preallocate buffer */+ int i = 0;+ l_lockfile(f); /* no memory errors can happen inside the lock */+ while (i < LUAL_BUFFERSIZE && (c = l_getc(f)) != EOF && c != '\n')+ buff[i++] = c;+ l_unlockfile(f);+ luaL_addsize(&b, i);+ }+ if (!chop && c == '\n') /* want a newline and have one? */+ luaL_addchar(&b, c); /* add ending newline to result */+ luaL_pushresult(&b); /* close buffer */+ /* return ok if read something (either a newline or something else) */+ return (c == '\n' || lua_rawlen(L, -1) > 0);+}+++static void read_all (lua_State *L, FILE *f) {+ size_t nr;+ luaL_Buffer b;+ luaL_buffinit(L, &b);+ do { /* read file in chunks of LUAL_BUFFERSIZE bytes */+ char *p = luaL_prepbuffer(&b);+ nr = fread(p, sizeof(char), LUAL_BUFFERSIZE, f);+ luaL_addsize(&b, nr);+ } while (nr == LUAL_BUFFERSIZE);+ luaL_pushresult(&b); /* close buffer */+}+++static int read_chars (lua_State *L, FILE *f, size_t n) {+ size_t nr; /* number of chars actually read */+ char *p;+ luaL_Buffer b;+ luaL_buffinit(L, &b);+ p = luaL_prepbuffsize(&b, n); /* prepare buffer to read whole block */+ nr = fread(p, sizeof(char), n, f); /* try to read 'n' chars */+ luaL_addsize(&b, nr);+ luaL_pushresult(&b); /* close buffer */+ return (nr > 0); /* true iff read something */+}+++static int g_read (lua_State *L, FILE *f, int first) {+ int nargs = lua_gettop(L) - 1;+ int success;+ int n;+ clearerr(f);+ if (nargs == 0) { /* no arguments? */+ success = read_line(L, f, 1);+ n = first+1; /* to return 1 result */+ }+ else { /* ensure stack space for all results and for auxlib's buffer */+ luaL_checkstack(L, nargs+LUA_MINSTACK, "too many arguments");+ success = 1;+ for (n = first; nargs-- && success; n++) {+ if (lua_type(L, n) == LUA_TNUMBER) {+ size_t l = (size_t)luaL_checkinteger(L, n);+ success = (l == 0) ? test_eof(L, f) : read_chars(L, f, l);+ }+ else {+ const char *p = luaL_checkstring(L, n);+ if (*p == '*') p++; /* skip optional '*' (for compatibility) */+ switch (*p) {+ case 'n': /* number */+ success = read_number(L, f);+ break;+ case 'l': /* line */+ success = read_line(L, f, 1);+ break;+ case 'L': /* line with end-of-line */+ success = read_line(L, f, 0);+ break;+ case 'a': /* file */+ read_all(L, f); /* read entire file */+ success = 1; /* always success */+ break;+ default:+ return luaL_argerror(L, n, "invalid format");+ }+ }+ }+ }+ if (ferror(f))+ return luaL_fileresult(L, 0, NULL);+ if (!success) {+ lua_pop(L, 1); /* remove last result */+ lua_pushnil(L); /* push nil instead */+ }+ return n - first;+}+++static int io_read (lua_State *L) {+ return g_read(L, getiofile(L, IO_INPUT), 1);+}+++static int f_read (lua_State *L) {+ return g_read(L, tofile(L), 2);+}+++static int io_readline (lua_State *L) {+ LStream *p = (LStream *)lua_touserdata(L, lua_upvalueindex(1));+ int i;+ int n = (int)lua_tointeger(L, lua_upvalueindex(2));+ if (isclosed(p)) /* file is already closed? */+ return luaL_error(L, "file is already closed");+ lua_settop(L , 1);+ luaL_checkstack(L, n, "too many arguments");+ for (i = 1; i <= n; i++) /* push arguments to 'g_read' */+ lua_pushvalue(L, lua_upvalueindex(3 + i));+ n = g_read(L, p->f, 2); /* 'n' is number of results */+ lua_assert(n > 0); /* should return at least a nil */+ if (lua_toboolean(L, -n)) /* read at least one value? */+ return n; /* return them */+ else { /* first result is nil: EOF or error */+ if (n > 1) { /* is there error information? */+ /* 2nd result is error message */+ return luaL_error(L, "%s", lua_tostring(L, -n + 1));+ }+ if (lua_toboolean(L, lua_upvalueindex(3))) { /* generator created file? */+ lua_settop(L, 0);+ lua_pushvalue(L, lua_upvalueindex(1));+ aux_close(L); /* close it */+ }+ return 0;+ }+}++/* }====================================================== */+++static int g_write (lua_State *L, FILE *f, int arg) {+ int nargs = lua_gettop(L) - arg;+ int status = 1;+ for (; nargs--; arg++) {+ if (lua_type(L, arg) == LUA_TNUMBER) {+ /* optimization: could be done exactly as for strings */+ int len = lua_isinteger(L, arg)+ ? fprintf(f, LUA_INTEGER_FMT,+ (LUAI_UACINT)lua_tointeger(L, arg))+ : fprintf(f, LUA_NUMBER_FMT,+ (LUAI_UACNUMBER)lua_tonumber(L, arg));+ status = status && (len > 0);+ }+ else {+ size_t l;+ const char *s = luaL_checklstring(L, arg, &l);+ status = status && (fwrite(s, sizeof(char), l, f) == l);+ }+ }+ if (status) return 1; /* file handle already on stack top */+ else return luaL_fileresult(L, status, NULL);+}+++static int io_write (lua_State *L) {+ return g_write(L, getiofile(L, IO_OUTPUT), 1);+}+++static int f_write (lua_State *L) {+ FILE *f = tofile(L);+ lua_pushvalue(L, 1); /* push file at the stack top (to be returned) */+ return g_write(L, f, 2);+}+++static int f_seek (lua_State *L) {+ static const int mode[] = {SEEK_SET, SEEK_CUR, SEEK_END};+ static const char *const modenames[] = {"set", "cur", "end", NULL};+ FILE *f = tofile(L);+ int op = luaL_checkoption(L, 2, "cur", modenames);+ lua_Integer p3 = luaL_optinteger(L, 3, 0);+ l_seeknum offset = (l_seeknum)p3;+ luaL_argcheck(L, (lua_Integer)offset == p3, 3,+ "not an integer in proper range");+ op = l_fseek(f, offset, mode[op]);+ if (op)+ return luaL_fileresult(L, 0, NULL); /* error */+ else {+ lua_pushinteger(L, (lua_Integer)l_ftell(f));+ return 1;+ }+}+++static int f_setvbuf (lua_State *L) {+ static const int mode[] = {_IONBF, _IOFBF, _IOLBF};+ static const char *const modenames[] = {"no", "full", "line", NULL};+ FILE *f = tofile(L);+ int op = luaL_checkoption(L, 2, NULL, modenames);+ lua_Integer sz = luaL_optinteger(L, 3, LUAL_BUFFERSIZE);+ int res = setvbuf(f, NULL, mode[op], (size_t)sz);+ return luaL_fileresult(L, res == 0, NULL);+}++++static int io_flush (lua_State *L) {+ return luaL_fileresult(L, fflush(getiofile(L, IO_OUTPUT)) == 0, NULL);+}+++static int f_flush (lua_State *L) {+ return luaL_fileresult(L, fflush(tofile(L)) == 0, NULL);+}+++/*+** functions for 'io' library+*/+static const luaL_Reg iolib[] = {+ {"close", io_close},+ {"flush", io_flush},+ {"input", io_input},+ {"lines", io_lines},+ {"open", io_open},+ {"output", io_output},+ {"popen", io_popen},+ {"read", io_read},+ {"tmpfile", io_tmpfile},+ {"type", io_type},+ {"write", io_write},+ {NULL, NULL}+};+++/*+** methods for file handles+*/+static const luaL_Reg flib[] = {+ {"close", f_close},+ {"flush", f_flush},+ {"lines", f_lines},+ {"read", f_read},+ {"seek", f_seek},+ {"setvbuf", f_setvbuf},+ {"write", f_write},+ {"__gc", f_gc},+ {"__tostring", f_tostring},+ {NULL, NULL}+};+++static void createmeta (lua_State *L) {+ luaL_newmetatable(L, LUA_FILEHANDLE); /* create metatable for file handles */+ lua_pushvalue(L, -1); /* push metatable */+ lua_setfield(L, -2, "__index"); /* metatable.__index = metatable */+ luaL_setfuncs(L, flib, 0); /* add file methods to new metatable */+ lua_pop(L, 1); /* pop new metatable */+}+++/*+** function to (not) close the standard files stdin, stdout, and stderr+*/+static int io_noclose (lua_State *L) {+ LStream *p = tolstream(L);+ p->closef = &io_noclose; /* keep file opened */+ lua_pushnil(L);+ lua_pushliteral(L, "cannot close standard file");+ return 2;+}+++static void createstdfile (lua_State *L, FILE *f, const char *k,+ const char *fname) {+ LStream *p = newprefile(L);+ p->f = f;+ p->closef = &io_noclose;+ if (k != NULL) {+ lua_pushvalue(L, -1);+ lua_setfield(L, LUA_REGISTRYINDEX, k); /* add file to registry */+ }+ lua_setfield(L, -2, fname); /* add file to module */+}+++LUAMOD_API int luaopen_io (lua_State *L) {+ luaL_newlib(L, iolib); /* new module */+ createmeta(L);+ /* create (and set) default files */+ createstdfile(L, stdin, IO_INPUT, "stdin");+ createstdfile(L, stdout, IO_OUTPUT, "stdout");+ createstdfile(L, stderr, NULL, "stderr");+ return 1;+}+
+ cbits/lua-5.3.6/llex.c view
@@ -0,0 +1,568 @@+/*+** $Id: llex.c,v 2.96.1.1 2017/04/19 17:20:42 roberto Exp $+** Lexical Analyzer+** See Copyright Notice in lua.h+*/++#define llex_c+#define LUA_CORE++#include "lprefix.h"+++#include <locale.h>+#include <string.h>++#include "lua.h"++#include "lctype.h"+#include "ldebug.h"+#include "ldo.h"+#include "lgc.h"+#include "llex.h"+#include "lobject.h"+#include "lparser.h"+#include "lstate.h"+#include "lstring.h"+#include "ltable.h"+#include "lzio.h"++++#define next(ls) (ls->current = zgetc(ls->z))++++#define currIsNewline(ls) (ls->current == '\n' || ls->current == '\r')+++/* ORDER RESERVED */+static const char *const luaX_tokens [] = {+ "and", "break", "do", "else", "elseif",+ "end", "false", "for", "function", "goto", "if",+ "in", "local", "nil", "not", "or", "repeat",+ "return", "then", "true", "until", "while",+ "//", "..", "...", "==", ">=", "<=", "~=",+ "<<", ">>", "::", "<eof>",+ "<number>", "<integer>", "<name>", "<string>"+};+++#define save_and_next(ls) (save(ls, ls->current), next(ls))+++static l_noret lexerror (LexState *ls, const char *msg, int token);+++static void save (LexState *ls, int c) {+ Mbuffer *b = ls->buff;+ if (luaZ_bufflen(b) + 1 > luaZ_sizebuffer(b)) {+ size_t newsize;+ if (luaZ_sizebuffer(b) >= MAX_SIZE/2)+ lexerror(ls, "lexical element too long", 0);+ newsize = luaZ_sizebuffer(b) * 2;+ luaZ_resizebuffer(ls->L, b, newsize);+ }+ b->buffer[luaZ_bufflen(b)++] = cast(char, c);+}+++void luaX_init (lua_State *L) {+ int i;+ TString *e = luaS_newliteral(L, LUA_ENV); /* create env name */+ luaC_fix(L, obj2gco(e)); /* never collect this name */+ for (i=0; i<NUM_RESERVED; i++) {+ TString *ts = luaS_new(L, luaX_tokens[i]);+ luaC_fix(L, obj2gco(ts)); /* reserved words are never collected */+ ts->extra = cast_byte(i+1); /* reserved word */+ }+}+++const char *luaX_token2str (LexState *ls, int token) {+ if (token < FIRST_RESERVED) { /* single-byte symbols? */+ lua_assert(token == cast_uchar(token));+ return luaO_pushfstring(ls->L, "'%c'", token);+ }+ else {+ const char *s = luaX_tokens[token - FIRST_RESERVED];+ if (token < TK_EOS) /* fixed format (symbols and reserved words)? */+ return luaO_pushfstring(ls->L, "'%s'", s);+ else /* names, strings, and numerals */+ return s;+ }+}+++static const char *txtToken (LexState *ls, int token) {+ switch (token) {+ case TK_NAME: case TK_STRING:+ case TK_FLT: case TK_INT:+ save(ls, '\0');+ return luaO_pushfstring(ls->L, "'%s'", luaZ_buffer(ls->buff));+ default:+ return luaX_token2str(ls, token);+ }+}+++static l_noret lexerror (LexState *ls, const char *msg, int token) {+ msg = luaG_addinfo(ls->L, msg, ls->source, ls->linenumber);+ if (token)+ luaO_pushfstring(ls->L, "%s near %s", msg, txtToken(ls, token));+ luaD_throw(ls->L, LUA_ERRSYNTAX);+}+++l_noret luaX_syntaxerror (LexState *ls, const char *msg) {+ lexerror(ls, msg, ls->t.token);+}+++/*+** creates a new string and anchors it in scanner's table so that+** it will not be collected until the end of the compilation+** (by that time it should be anchored somewhere)+*/+TString *luaX_newstring (LexState *ls, const char *str, size_t l) {+ lua_State *L = ls->L;+ TValue *o; /* entry for 'str' */+ TString *ts = luaS_newlstr(L, str, l); /* create new string */+ setsvalue2s(L, L->top++, ts); /* temporarily anchor it in stack */+ o = luaH_set(L, ls->h, L->top - 1);+ if (ttisnil(o)) { /* not in use yet? */+ /* boolean value does not need GC barrier;+ table has no metatable, so it does not need to invalidate cache */+ setbvalue(o, 1); /* t[string] = true */+ luaC_checkGC(L);+ }+ else { /* string already present */+ ts = tsvalue(keyfromval(o)); /* re-use value previously stored */+ }+ L->top--; /* remove string from stack */+ return ts;+}+++/*+** increment line number and skips newline sequence (any of+** \n, \r, \n\r, or \r\n)+*/+static void inclinenumber (LexState *ls) {+ int old = ls->current;+ lua_assert(currIsNewline(ls));+ next(ls); /* skip '\n' or '\r' */+ if (currIsNewline(ls) && ls->current != old)+ next(ls); /* skip '\n\r' or '\r\n' */+ if (++ls->linenumber >= MAX_INT)+ lexerror(ls, "chunk has too many lines", 0);+}+++void luaX_setinput (lua_State *L, LexState *ls, ZIO *z, TString *source,+ int firstchar) {+ ls->t.token = 0;+ ls->L = L;+ ls->current = firstchar;+ ls->lookahead.token = TK_EOS; /* no look-ahead token */+ ls->z = z;+ ls->fs = NULL;+ ls->linenumber = 1;+ ls->lastline = 1;+ ls->source = source;+ ls->envn = luaS_newliteral(L, LUA_ENV); /* get env name */+ luaZ_resizebuffer(ls->L, ls->buff, LUA_MINBUFFER); /* initialize buffer */+}++++/*+** =======================================================+** LEXICAL ANALYZER+** =======================================================+*/+++static int check_next1 (LexState *ls, int c) {+ if (ls->current == c) {+ next(ls);+ return 1;+ }+ else return 0;+}+++/*+** Check whether current char is in set 'set' (with two chars) and+** saves it+*/+static int check_next2 (LexState *ls, const char *set) {+ lua_assert(set[2] == '\0');+ if (ls->current == set[0] || ls->current == set[1]) {+ save_and_next(ls);+ return 1;+ }+ else return 0;+}+++/* LUA_NUMBER */+/*+** this function is quite liberal in what it accepts, as 'luaO_str2num'+** will reject ill-formed numerals.+*/+static int read_numeral (LexState *ls, SemInfo *seminfo) {+ TValue obj;+ const char *expo = "Ee";+ int first = ls->current;+ lua_assert(lisdigit(ls->current));+ save_and_next(ls);+ if (first == '0' && check_next2(ls, "xX")) /* hexadecimal? */+ expo = "Pp";+ for (;;) {+ if (check_next2(ls, expo)) /* exponent part? */+ check_next2(ls, "-+"); /* optional exponent sign */+ if (lisxdigit(ls->current))+ save_and_next(ls);+ else if (ls->current == '.')+ save_and_next(ls);+ else break;+ }+ save(ls, '\0');+ if (luaO_str2num(luaZ_buffer(ls->buff), &obj) == 0) /* format error? */+ lexerror(ls, "malformed number", TK_FLT);+ if (ttisinteger(&obj)) {+ seminfo->i = ivalue(&obj);+ return TK_INT;+ }+ else {+ lua_assert(ttisfloat(&obj));+ seminfo->r = fltvalue(&obj);+ return TK_FLT;+ }+}+++/*+** reads a sequence '[=*[' or ']=*]', leaving the last bracket.+** If sequence is well formed, return its number of '='s + 2; otherwise,+** return 1 if there is no '='s or 0 otherwise (an unfinished '[==...').+*/+static size_t skip_sep (LexState *ls) {+ size_t count = 0;+ int s = ls->current;+ lua_assert(s == '[' || s == ']');+ save_and_next(ls);+ while (ls->current == '=') {+ save_and_next(ls);+ count++;+ }+ return (ls->current == s) ? count + 2+ : (count == 0) ? 1+ : 0;++}+++static void read_long_string (LexState *ls, SemInfo *seminfo, size_t sep) {+ int line = ls->linenumber; /* initial line (for error message) */+ save_and_next(ls); /* skip 2nd '[' */+ if (currIsNewline(ls)) /* string starts with a newline? */+ inclinenumber(ls); /* skip it */+ for (;;) {+ switch (ls->current) {+ case EOZ: { /* error */+ const char *what = (seminfo ? "string" : "comment");+ const char *msg = luaO_pushfstring(ls->L,+ "unfinished long %s (starting at line %d)", what, line);+ lexerror(ls, msg, TK_EOS);+ break; /* to avoid warnings */+ }+ case ']': {+ if (skip_sep(ls) == sep) {+ save_and_next(ls); /* skip 2nd ']' */+ goto endloop;+ }+ break;+ }+ case '\n': case '\r': {+ save(ls, '\n');+ inclinenumber(ls);+ if (!seminfo) luaZ_resetbuffer(ls->buff); /* avoid wasting space */+ break;+ }+ default: {+ if (seminfo) save_and_next(ls);+ else next(ls);+ }+ }+ } endloop:+ if (seminfo)+ seminfo->ts = luaX_newstring(ls, luaZ_buffer(ls->buff) + sep,+ luaZ_bufflen(ls->buff) - 2 * sep);+}+++static void esccheck (LexState *ls, int c, const char *msg) {+ if (!c) {+ if (ls->current != EOZ)+ save_and_next(ls); /* add current to buffer for error message */+ lexerror(ls, msg, TK_STRING);+ }+}+++static int gethexa (LexState *ls) {+ save_and_next(ls);+ esccheck (ls, lisxdigit(ls->current), "hexadecimal digit expected");+ return luaO_hexavalue(ls->current);+}+++static int readhexaesc (LexState *ls) {+ int r = gethexa(ls);+ r = (r << 4) + gethexa(ls);+ luaZ_buffremove(ls->buff, 2); /* remove saved chars from buffer */+ return r;+}+++static unsigned long readutf8esc (LexState *ls) {+ unsigned long r;+ int i = 4; /* chars to be removed: '\', 'u', '{', and first digit */+ save_and_next(ls); /* skip 'u' */+ esccheck(ls, ls->current == '{', "missing '{'");+ r = gethexa(ls); /* must have at least one digit */+ while ((save_and_next(ls), lisxdigit(ls->current))) {+ i++;+ r = (r << 4) + luaO_hexavalue(ls->current);+ esccheck(ls, r <= 0x10FFFF, "UTF-8 value too large");+ }+ esccheck(ls, ls->current == '}', "missing '}'");+ next(ls); /* skip '}' */+ luaZ_buffremove(ls->buff, i); /* remove saved chars from buffer */+ return r;+}+++static void utf8esc (LexState *ls) {+ char buff[UTF8BUFFSZ];+ int n = luaO_utf8esc(buff, readutf8esc(ls));+ for (; n > 0; n--) /* add 'buff' to string */+ save(ls, buff[UTF8BUFFSZ - n]);+}+++static int readdecesc (LexState *ls) {+ int i;+ int r = 0; /* result accumulator */+ for (i = 0; i < 3 && lisdigit(ls->current); i++) { /* read up to 3 digits */+ r = 10*r + ls->current - '0';+ save_and_next(ls);+ }+ esccheck(ls, r <= UCHAR_MAX, "decimal escape too large");+ luaZ_buffremove(ls->buff, i); /* remove read digits from buffer */+ return r;+}+++static void read_string (LexState *ls, int del, SemInfo *seminfo) {+ save_and_next(ls); /* keep delimiter (for error messages) */+ while (ls->current != del) {+ switch (ls->current) {+ case EOZ:+ lexerror(ls, "unfinished string", TK_EOS);+ break; /* to avoid warnings */+ case '\n':+ case '\r':+ lexerror(ls, "unfinished string", TK_STRING);+ break; /* to avoid warnings */+ case '\\': { /* escape sequences */+ int c; /* final character to be saved */+ save_and_next(ls); /* keep '\\' for error messages */+ switch (ls->current) {+ case 'a': c = '\a'; goto read_save;+ case 'b': c = '\b'; goto read_save;+ case 'f': c = '\f'; goto read_save;+ case 'n': c = '\n'; goto read_save;+ case 'r': c = '\r'; goto read_save;+ case 't': c = '\t'; goto read_save;+ case 'v': c = '\v'; goto read_save;+ case 'x': c = readhexaesc(ls); goto read_save;+ case 'u': utf8esc(ls); goto no_save;+ case '\n': case '\r':+ inclinenumber(ls); c = '\n'; goto only_save;+ case '\\': case '\"': case '\'':+ c = ls->current; goto read_save;+ case EOZ: goto no_save; /* will raise an error next loop */+ case 'z': { /* zap following span of spaces */+ luaZ_buffremove(ls->buff, 1); /* remove '\\' */+ next(ls); /* skip the 'z' */+ while (lisspace(ls->current)) {+ if (currIsNewline(ls)) inclinenumber(ls);+ else next(ls);+ }+ goto no_save;+ }+ default: {+ esccheck(ls, lisdigit(ls->current), "invalid escape sequence");+ c = readdecesc(ls); /* digital escape '\ddd' */+ goto only_save;+ }+ }+ read_save:+ next(ls);+ /* go through */+ only_save:+ luaZ_buffremove(ls->buff, 1); /* remove '\\' */+ save(ls, c);+ /* go through */+ no_save: break;+ }+ default:+ save_and_next(ls);+ }+ }+ save_and_next(ls); /* skip delimiter */+ seminfo->ts = luaX_newstring(ls, luaZ_buffer(ls->buff) + 1,+ luaZ_bufflen(ls->buff) - 2);+}+++static int llex (LexState *ls, SemInfo *seminfo) {+ luaZ_resetbuffer(ls->buff);+ for (;;) {+ switch (ls->current) {+ case '\n': case '\r': { /* line breaks */+ inclinenumber(ls);+ break;+ }+ case ' ': case '\f': case '\t': case '\v': { /* spaces */+ next(ls);+ break;+ }+ case '-': { /* '-' or '--' (comment) */+ next(ls);+ if (ls->current != '-') return '-';+ /* else is a comment */+ next(ls);+ if (ls->current == '[') { /* long comment? */+ size_t sep = skip_sep(ls);+ luaZ_resetbuffer(ls->buff); /* 'skip_sep' may dirty the buffer */+ if (sep >= 2) {+ read_long_string(ls, NULL, sep); /* skip long comment */+ luaZ_resetbuffer(ls->buff); /* previous call may dirty the buff. */+ break;+ }+ }+ /* else short comment */+ while (!currIsNewline(ls) && ls->current != EOZ)+ next(ls); /* skip until end of line (or end of file) */+ break;+ }+ case '[': { /* long string or simply '[' */+ size_t sep = skip_sep(ls);+ if (sep >= 2) {+ read_long_string(ls, seminfo, sep);+ return TK_STRING;+ }+ else if (sep == 0) /* '[=...' missing second bracket */+ lexerror(ls, "invalid long string delimiter", TK_STRING);+ return '[';+ }+ case '=': {+ next(ls);+ if (check_next1(ls, '=')) return TK_EQ;+ else return '=';+ }+ case '<': {+ next(ls);+ if (check_next1(ls, '=')) return TK_LE;+ else if (check_next1(ls, '<')) return TK_SHL;+ else return '<';+ }+ case '>': {+ next(ls);+ if (check_next1(ls, '=')) return TK_GE;+ else if (check_next1(ls, '>')) return TK_SHR;+ else return '>';+ }+ case '/': {+ next(ls);+ if (check_next1(ls, '/')) return TK_IDIV;+ else return '/';+ }+ case '~': {+ next(ls);+ if (check_next1(ls, '=')) return TK_NE;+ else return '~';+ }+ case ':': {+ next(ls);+ if (check_next1(ls, ':')) return TK_DBCOLON;+ else return ':';+ }+ case '"': case '\'': { /* short literal strings */+ read_string(ls, ls->current, seminfo);+ return TK_STRING;+ }+ case '.': { /* '.', '..', '...', or number */+ save_and_next(ls);+ if (check_next1(ls, '.')) {+ if (check_next1(ls, '.'))+ return TK_DOTS; /* '...' */+ else return TK_CONCAT; /* '..' */+ }+ else if (!lisdigit(ls->current)) return '.';+ else return read_numeral(ls, seminfo);+ }+ case '0': case '1': case '2': case '3': case '4':+ case '5': case '6': case '7': case '8': case '9': {+ return read_numeral(ls, seminfo);+ }+ case EOZ: {+ return TK_EOS;+ }+ default: {+ if (lislalpha(ls->current)) { /* identifier or reserved word? */+ TString *ts;+ do {+ save_and_next(ls);+ } while (lislalnum(ls->current));+ ts = luaX_newstring(ls, luaZ_buffer(ls->buff),+ luaZ_bufflen(ls->buff));+ seminfo->ts = ts;+ if (isreserved(ts)) /* reserved word? */+ return ts->extra - 1 + FIRST_RESERVED;+ else {+ return TK_NAME;+ }+ }+ else { /* single-char tokens (+ - / ...) */+ int c = ls->current;+ next(ls);+ return c;+ }+ }+ }+ }+}+++void luaX_next (LexState *ls) {+ ls->lastline = ls->linenumber;+ if (ls->lookahead.token != TK_EOS) { /* is there a look-ahead token? */+ ls->t = ls->lookahead; /* use this one */+ ls->lookahead.token = TK_EOS; /* and discharge it */+ }+ else+ ls->t.token = llex(ls, &ls->t.seminfo); /* read next token */+}+++int luaX_lookahead (LexState *ls) {+ lua_assert(ls->lookahead.token == TK_EOS);+ ls->lookahead.token = llex(ls, &ls->lookahead.seminfo);+ return ls->lookahead.token;+}+
+ cbits/lua-5.3.6/llex.h view
@@ -0,0 +1,85 @@+/*+** $Id: llex.h,v 1.79.1.1 2017/04/19 17:20:42 roberto Exp $+** Lexical Analyzer+** See Copyright Notice in lua.h+*/++#ifndef llex_h+#define llex_h++#include "lobject.h"+#include "lzio.h"+++#define FIRST_RESERVED 257+++#if !defined(LUA_ENV)+#define LUA_ENV "_ENV"+#endif+++/*+* WARNING: if you change the order of this enumeration,+* grep "ORDER RESERVED"+*/+enum RESERVED {+ /* terminal symbols denoted by reserved words */+ TK_AND = FIRST_RESERVED, TK_BREAK,+ TK_DO, TK_ELSE, TK_ELSEIF, TK_END, TK_FALSE, TK_FOR, TK_FUNCTION,+ TK_GOTO, TK_IF, TK_IN, TK_LOCAL, TK_NIL, TK_NOT, TK_OR, TK_REPEAT,+ TK_RETURN, TK_THEN, TK_TRUE, TK_UNTIL, TK_WHILE,+ /* other terminal symbols */+ TK_IDIV, TK_CONCAT, TK_DOTS, TK_EQ, TK_GE, TK_LE, TK_NE,+ TK_SHL, TK_SHR,+ TK_DBCOLON, TK_EOS,+ TK_FLT, TK_INT, TK_NAME, TK_STRING+};++/* number of reserved words */+#define NUM_RESERVED (cast(int, TK_WHILE-FIRST_RESERVED+1))+++typedef union {+ lua_Number r;+ lua_Integer i;+ TString *ts;+} SemInfo; /* semantics information */+++typedef struct Token {+ int token;+ SemInfo seminfo;+} Token;+++/* state of the lexer plus state of the parser when shared by all+ functions */+typedef struct LexState {+ int current; /* current character (charint) */+ int linenumber; /* input line counter */+ int lastline; /* line of last token 'consumed' */+ Token t; /* current token */+ Token lookahead; /* look ahead token */+ struct FuncState *fs; /* current function (parser) */+ struct lua_State *L;+ ZIO *z; /* input stream */+ Mbuffer *buff; /* buffer for tokens */+ Table *h; /* to avoid collection/reuse strings */+ struct Dyndata *dyd; /* dynamic structures used by the parser */+ TString *source; /* current source name */+ TString *envn; /* environment variable name */+} LexState;+++LUAI_FUNC void luaX_init (lua_State *L);+LUAI_FUNC void luaX_setinput (lua_State *L, LexState *ls, ZIO *z,+ TString *source, int firstchar);+LUAI_FUNC TString *luaX_newstring (LexState *ls, const char *str, size_t l);+LUAI_FUNC void luaX_next (LexState *ls);+LUAI_FUNC int luaX_lookahead (LexState *ls);+LUAI_FUNC l_noret luaX_syntaxerror (LexState *ls, const char *s);+LUAI_FUNC const char *luaX_token2str (LexState *ls, int token);+++#endif
+ cbits/lua-5.3.6/llimits.h view
@@ -0,0 +1,323 @@+/*+** $Id: llimits.h,v 1.141.1.1 2017/04/19 17:20:42 roberto Exp $+** Limits, basic types, and some other 'installation-dependent' definitions+** See Copyright Notice in lua.h+*/++#ifndef llimits_h+#define llimits_h+++#include <limits.h>+#include <stddef.h>+++#include "lua.h"++/*+** 'lu_mem' and 'l_mem' are unsigned/signed integers big enough to count+** the total memory used by Lua (in bytes). Usually, 'size_t' and+** 'ptrdiff_t' should work, but we use 'long' for 16-bit machines.+*/+#if defined(LUAI_MEM) /* { external definitions? */+typedef LUAI_UMEM lu_mem;+typedef LUAI_MEM l_mem;+#elif LUAI_BITSINT >= 32 /* }{ */+typedef size_t lu_mem;+typedef ptrdiff_t l_mem;+#else /* 16-bit ints */ /* }{ */+typedef unsigned long lu_mem;+typedef long l_mem;+#endif /* } */+++/* chars used as small naturals (so that 'char' is reserved for characters) */+typedef unsigned char lu_byte;+++/* maximum value for size_t */+#define MAX_SIZET ((size_t)(~(size_t)0))++/* maximum size visible for Lua (must be representable in a lua_Integer */+#define MAX_SIZE (sizeof(size_t) < sizeof(lua_Integer) ? MAX_SIZET \+ : (size_t)(LUA_MAXINTEGER))+++#define MAX_LUMEM ((lu_mem)(~(lu_mem)0))++#define MAX_LMEM ((l_mem)(MAX_LUMEM >> 1))+++#define MAX_INT INT_MAX /* maximum value of an int */+++/*+** conversion of pointer to unsigned integer:+** this is for hashing only; there is no problem if the integer+** cannot hold the whole pointer value+*/+#define point2uint(p) ((unsigned int)((size_t)(p) & UINT_MAX))++++/* type to ensure maximum alignment */+#if defined(LUAI_USER_ALIGNMENT_T)+typedef LUAI_USER_ALIGNMENT_T L_Umaxalign;+#else+typedef union {+ lua_Number n;+ double u;+ void *s;+ lua_Integer i;+ long l;+} L_Umaxalign;+#endif++++/* types of 'usual argument conversions' for lua_Number and lua_Integer */+typedef LUAI_UACNUMBER l_uacNumber;+typedef LUAI_UACINT l_uacInt;+++/* internal assertions for in-house debugging */+#if defined(lua_assert)+#define check_exp(c,e) (lua_assert(c), (e))+/* to avoid problems with conditions too long */+#define lua_longassert(c) ((c) ? (void)0 : lua_assert(0))+#else+#define lua_assert(c) ((void)0)+#define check_exp(c,e) (e)+#define lua_longassert(c) ((void)0)+#endif++/*+** assertion for checking API calls+*/+#if !defined(luai_apicheck)+#define luai_apicheck(l,e) lua_assert(e)+#endif++#define api_check(l,e,msg) luai_apicheck(l,(e) && msg)+++/* macro to avoid warnings about unused variables */+#if !defined(UNUSED)+#define UNUSED(x) ((void)(x))+#endif+++/* type casts (a macro highlights casts in the code) */+#define cast(t, exp) ((t)(exp))++#define cast_void(i) cast(void, (i))+#define cast_byte(i) cast(lu_byte, (i))+#define cast_num(i) cast(lua_Number, (i))+#define cast_int(i) cast(int, (i))+#define cast_uchar(i) cast(unsigned char, (i))+++/* cast a signed lua_Integer to lua_Unsigned */+#if !defined(l_castS2U)+#define l_castS2U(i) ((lua_Unsigned)(i))+#endif++/*+** cast a lua_Unsigned to a signed lua_Integer; this cast is+** not strict ISO C, but two-complement architectures should+** work fine.+*/+#if !defined(l_castU2S)+#define l_castU2S(i) ((lua_Integer)(i))+#endif+++/*+** non-return type+*/+#if defined(__GNUC__)+#define l_noret void __attribute__((noreturn))+#elif defined(_MSC_VER) && _MSC_VER >= 1200+#define l_noret void __declspec(noreturn)+#else+#define l_noret void+#endif++++/*+** maximum depth for nested C calls and syntactical nested non-terminals+** in a program. (Value must fit in an unsigned short int.)+*/+#if !defined(LUAI_MAXCCALLS)+#define LUAI_MAXCCALLS 200+#endif++++/*+** type for virtual-machine instructions;+** must be an unsigned with (at least) 4 bytes (see details in lopcodes.h)+*/+#if LUAI_BITSINT >= 32+typedef unsigned int Instruction;+#else+typedef unsigned long Instruction;+#endif++++/*+** Maximum length for short strings, that is, strings that are+** internalized. (Cannot be smaller than reserved words or tags for+** metamethods, as these strings must be internalized;+** #("function") = 8, #("__newindex") = 10.)+*/+#if !defined(LUAI_MAXSHORTLEN)+#define LUAI_MAXSHORTLEN 40+#endif+++/*+** Initial size for the string table (must be power of 2).+** The Lua core alone registers ~50 strings (reserved words ++** metaevent keys + a few others). Libraries would typically add+** a few dozens more.+*/+#if !defined(MINSTRTABSIZE)+#define MINSTRTABSIZE 128+#endif+++/*+** Size of cache for strings in the API. 'N' is the number of+** sets (better be a prime) and "M" is the size of each set (M == 1+** makes a direct cache.)+*/+#if !defined(STRCACHE_N)+#define STRCACHE_N 53+#define STRCACHE_M 2+#endif+++/* minimum size for string buffer */+#if !defined(LUA_MINBUFFER)+#define LUA_MINBUFFER 32+#endif+++/*+** macros that are executed whenever program enters the Lua core+** ('lua_lock') and leaves the core ('lua_unlock')+*/+#if !defined(lua_lock)+#define lua_lock(L) ((void) 0)+#define lua_unlock(L) ((void) 0)+#endif++/*+** macro executed during Lua functions at points where the+** function can yield.+*/+#if !defined(luai_threadyield)+#define luai_threadyield(L) {lua_unlock(L); lua_lock(L);}+#endif+++/*+** these macros allow user-specific actions on threads when you defined+** LUAI_EXTRASPACE and need to do something extra when a thread is+** created/deleted/resumed/yielded.+*/+#if !defined(luai_userstateopen)+#define luai_userstateopen(L) ((void)L)+#endif++#if !defined(luai_userstateclose)+#define luai_userstateclose(L) ((void)L)+#endif++#if !defined(luai_userstatethread)+#define luai_userstatethread(L,L1) ((void)L)+#endif++#if !defined(luai_userstatefree)+#define luai_userstatefree(L,L1) ((void)L)+#endif++#if !defined(luai_userstateresume)+#define luai_userstateresume(L,n) ((void)L)+#endif++#if !defined(luai_userstateyield)+#define luai_userstateyield(L,n) ((void)L)+#endif++++/*+** The luai_num* macros define the primitive operations over numbers.+*/++/* floor division (defined as 'floor(a/b)') */+#if !defined(luai_numidiv)+#define luai_numidiv(L,a,b) ((void)L, l_floor(luai_numdiv(L,a,b)))+#endif++/* float division */+#if !defined(luai_numdiv)+#define luai_numdiv(L,a,b) ((a)/(b))+#endif++/*+** modulo: defined as 'a - floor(a/b)*b'; this definition gives NaN when+** 'b' is huge, but the result should be 'a'. 'fmod' gives the result of+** 'a - trunc(a/b)*b', and therefore must be corrected when 'trunc(a/b)+** ~= floor(a/b)'. That happens when the division has a non-integer+** negative result, which is equivalent to the test below.+*/+#if !defined(luai_nummod)+#define luai_nummod(L,a,b,m) \+ { (m) = l_mathop(fmod)(a,b); if ((m)*(b) < 0) (m) += (b); }+#endif++/* exponentiation */+#if !defined(luai_numpow)+#define luai_numpow(L,a,b) ((void)L, l_mathop(pow)(a,b))+#endif++/* the others are quite standard operations */+#if !defined(luai_numadd)+#define luai_numadd(L,a,b) ((a)+(b))+#define luai_numsub(L,a,b) ((a)-(b))+#define luai_nummul(L,a,b) ((a)*(b))+#define luai_numunm(L,a) (-(a))+#define luai_numeq(a,b) ((a)==(b))+#define luai_numlt(a,b) ((a)<(b))+#define luai_numle(a,b) ((a)<=(b))+#define luai_numisnan(a) (!luai_numeq((a), (a)))+#endif++++++/*+** macro to control inclusion of some hard tests on stack reallocation+*/+#if !defined(HARDSTACKTESTS)+#define condmovestack(L,pre,pos) ((void)0)+#else+/* realloc stack keeping its size */+#define condmovestack(L,pre,pos) \+ { int sz_ = (L)->stacksize; pre; luaD_reallocstack((L), sz_); pos; }+#endif++#if !defined(HARDMEMTESTS)+#define condchangemem(L,pre,pos) ((void)0)+#else+#define condchangemem(L,pre,pos) \+ { if (G(L)->gcrunning) { pre; luaC_fullgc(L, 0); pos; } }+#endif++#endif
+ cbits/lua-5.3.6/lmathlib.c view
@@ -0,0 +1,410 @@+/*+** $Id: lmathlib.c,v 1.119.1.1 2017/04/19 17:20:42 roberto Exp $+** Standard mathematical library+** See Copyright Notice in lua.h+*/++#define lmathlib_c+#define LUA_LIB++#include "lprefix.h"+++#include <stdlib.h>+#include <math.h>++#include "lua.h"++#include "lauxlib.h"+#include "lualib.h"+++#undef PI+#define PI (l_mathop(3.141592653589793238462643383279502884))+++#if !defined(l_rand) /* { */+#if defined(LUA_USE_POSIX)+#define l_rand() random()+#define l_srand(x) srandom(x)+#define L_RANDMAX 2147483647 /* (2^31 - 1), following POSIX */+#else+#define l_rand() rand()+#define l_srand(x) srand(x)+#define L_RANDMAX RAND_MAX+#endif+#endif /* } */+++static int math_abs (lua_State *L) {+ if (lua_isinteger(L, 1)) {+ lua_Integer n = lua_tointeger(L, 1);+ if (n < 0) n = (lua_Integer)(0u - (lua_Unsigned)n);+ lua_pushinteger(L, n);+ }+ else+ lua_pushnumber(L, l_mathop(fabs)(luaL_checknumber(L, 1)));+ return 1;+}++static int math_sin (lua_State *L) {+ lua_pushnumber(L, l_mathop(sin)(luaL_checknumber(L, 1)));+ return 1;+}++static int math_cos (lua_State *L) {+ lua_pushnumber(L, l_mathop(cos)(luaL_checknumber(L, 1)));+ return 1;+}++static int math_tan (lua_State *L) {+ lua_pushnumber(L, l_mathop(tan)(luaL_checknumber(L, 1)));+ return 1;+}++static int math_asin (lua_State *L) {+ lua_pushnumber(L, l_mathop(asin)(luaL_checknumber(L, 1)));+ return 1;+}++static int math_acos (lua_State *L) {+ lua_pushnumber(L, l_mathop(acos)(luaL_checknumber(L, 1)));+ return 1;+}++static int math_atan (lua_State *L) {+ lua_Number y = luaL_checknumber(L, 1);+ lua_Number x = luaL_optnumber(L, 2, 1);+ lua_pushnumber(L, l_mathop(atan2)(y, x));+ return 1;+}+++static int math_toint (lua_State *L) {+ int valid;+ lua_Integer n = lua_tointegerx(L, 1, &valid);+ if (valid)+ lua_pushinteger(L, n);+ else {+ luaL_checkany(L, 1);+ lua_pushnil(L); /* value is not convertible to integer */+ }+ return 1;+}+++static void pushnumint (lua_State *L, lua_Number d) {+ lua_Integer n;+ if (lua_numbertointeger(d, &n)) /* does 'd' fit in an integer? */+ lua_pushinteger(L, n); /* result is integer */+ else+ lua_pushnumber(L, d); /* result is float */+}+++static int math_floor (lua_State *L) {+ if (lua_isinteger(L, 1))+ lua_settop(L, 1); /* integer is its own floor */+ else {+ lua_Number d = l_mathop(floor)(luaL_checknumber(L, 1));+ pushnumint(L, d);+ }+ return 1;+}+++static int math_ceil (lua_State *L) {+ if (lua_isinteger(L, 1))+ lua_settop(L, 1); /* integer is its own ceil */+ else {+ lua_Number d = l_mathop(ceil)(luaL_checknumber(L, 1));+ pushnumint(L, d);+ }+ return 1;+}+++static int math_fmod (lua_State *L) {+ if (lua_isinteger(L, 1) && lua_isinteger(L, 2)) {+ lua_Integer d = lua_tointeger(L, 2);+ if ((lua_Unsigned)d + 1u <= 1u) { /* special cases: -1 or 0 */+ luaL_argcheck(L, d != 0, 2, "zero");+ lua_pushinteger(L, 0); /* avoid overflow with 0x80000... / -1 */+ }+ else+ lua_pushinteger(L, lua_tointeger(L, 1) % d);+ }+ else+ lua_pushnumber(L, l_mathop(fmod)(luaL_checknumber(L, 1),+ luaL_checknumber(L, 2)));+ return 1;+}+++/*+** next function does not use 'modf', avoiding problems with 'double*'+** (which is not compatible with 'float*') when lua_Number is not+** 'double'.+*/+static int math_modf (lua_State *L) {+ if (lua_isinteger(L ,1)) {+ lua_settop(L, 1); /* number is its own integer part */+ lua_pushnumber(L, 0); /* no fractional part */+ }+ else {+ lua_Number n = luaL_checknumber(L, 1);+ /* integer part (rounds toward zero) */+ lua_Number ip = (n < 0) ? l_mathop(ceil)(n) : l_mathop(floor)(n);+ pushnumint(L, ip);+ /* fractional part (test needed for inf/-inf) */+ lua_pushnumber(L, (n == ip) ? l_mathop(0.0) : (n - ip));+ }+ return 2;+}+++static int math_sqrt (lua_State *L) {+ lua_pushnumber(L, l_mathop(sqrt)(luaL_checknumber(L, 1)));+ return 1;+}+++static int math_ult (lua_State *L) {+ lua_Integer a = luaL_checkinteger(L, 1);+ lua_Integer b = luaL_checkinteger(L, 2);+ lua_pushboolean(L, (lua_Unsigned)a < (lua_Unsigned)b);+ return 1;+}++static int math_log (lua_State *L) {+ lua_Number x = luaL_checknumber(L, 1);+ lua_Number res;+ if (lua_isnoneornil(L, 2))+ res = l_mathop(log)(x);+ else {+ lua_Number base = luaL_checknumber(L, 2);+#if !defined(LUA_USE_C89)+ if (base == l_mathop(2.0))+ res = l_mathop(log2)(x); else+#endif+ if (base == l_mathop(10.0))+ res = l_mathop(log10)(x);+ else+ res = l_mathop(log)(x)/l_mathop(log)(base);+ }+ lua_pushnumber(L, res);+ return 1;+}++static int math_exp (lua_State *L) {+ lua_pushnumber(L, l_mathop(exp)(luaL_checknumber(L, 1)));+ return 1;+}++static int math_deg (lua_State *L) {+ lua_pushnumber(L, luaL_checknumber(L, 1) * (l_mathop(180.0) / PI));+ return 1;+}++static int math_rad (lua_State *L) {+ lua_pushnumber(L, luaL_checknumber(L, 1) * (PI / l_mathop(180.0)));+ return 1;+}+++static int math_min (lua_State *L) {+ int n = lua_gettop(L); /* number of arguments */+ int imin = 1; /* index of current minimum value */+ int i;+ luaL_argcheck(L, n >= 1, 1, "value expected");+ for (i = 2; i <= n; i++) {+ if (lua_compare(L, i, imin, LUA_OPLT))+ imin = i;+ }+ lua_pushvalue(L, imin);+ return 1;+}+++static int math_max (lua_State *L) {+ int n = lua_gettop(L); /* number of arguments */+ int imax = 1; /* index of current maximum value */+ int i;+ luaL_argcheck(L, n >= 1, 1, "value expected");+ for (i = 2; i <= n; i++) {+ if (lua_compare(L, imax, i, LUA_OPLT))+ imax = i;+ }+ lua_pushvalue(L, imax);+ return 1;+}++/*+** This function uses 'double' (instead of 'lua_Number') to ensure that+** all bits from 'l_rand' can be represented, and that 'RANDMAX + 1.0'+** will keep full precision (ensuring that 'r' is always less than 1.0.)+*/+static int math_random (lua_State *L) {+ lua_Integer low, up;+ double r = (double)l_rand() * (1.0 / ((double)L_RANDMAX + 1.0));+ switch (lua_gettop(L)) { /* check number of arguments */+ case 0: { /* no arguments */+ lua_pushnumber(L, (lua_Number)r); /* Number between 0 and 1 */+ return 1;+ }+ case 1: { /* only upper limit */+ low = 1;+ up = luaL_checkinteger(L, 1);+ break;+ }+ case 2: { /* lower and upper limits */+ low = luaL_checkinteger(L, 1);+ up = luaL_checkinteger(L, 2);+ break;+ }+ default: return luaL_error(L, "wrong number of arguments");+ }+ /* random integer in the interval [low, up] */+ luaL_argcheck(L, low <= up, 1, "interval is empty");+ luaL_argcheck(L, low >= 0 || up <= LUA_MAXINTEGER + low, 1,+ "interval too large");+ r *= (double)(up - low) + 1.0;+ lua_pushinteger(L, (lua_Integer)r + low);+ return 1;+}+++static int math_randomseed (lua_State *L) {+ l_srand((unsigned int)(lua_Integer)luaL_checknumber(L, 1));+ (void)l_rand(); /* discard first value to avoid undesirable correlations */+ return 0;+}+++static int math_type (lua_State *L) {+ if (lua_type(L, 1) == LUA_TNUMBER) {+ if (lua_isinteger(L, 1))+ lua_pushliteral(L, "integer");+ else+ lua_pushliteral(L, "float");+ }+ else {+ luaL_checkany(L, 1);+ lua_pushnil(L);+ }+ return 1;+}+++/*+** {==================================================================+** Deprecated functions (for compatibility only)+** ===================================================================+*/+#if defined(LUA_COMPAT_MATHLIB)++static int math_cosh (lua_State *L) {+ lua_pushnumber(L, l_mathop(cosh)(luaL_checknumber(L, 1)));+ return 1;+}++static int math_sinh (lua_State *L) {+ lua_pushnumber(L, l_mathop(sinh)(luaL_checknumber(L, 1)));+ return 1;+}++static int math_tanh (lua_State *L) {+ lua_pushnumber(L, l_mathop(tanh)(luaL_checknumber(L, 1)));+ return 1;+}++static int math_pow (lua_State *L) {+ lua_Number x = luaL_checknumber(L, 1);+ lua_Number y = luaL_checknumber(L, 2);+ lua_pushnumber(L, l_mathop(pow)(x, y));+ return 1;+}++static int math_frexp (lua_State *L) {+ int e;+ lua_pushnumber(L, l_mathop(frexp)(luaL_checknumber(L, 1), &e));+ lua_pushinteger(L, e);+ return 2;+}++static int math_ldexp (lua_State *L) {+ lua_Number x = luaL_checknumber(L, 1);+ int ep = (int)luaL_checkinteger(L, 2);+ lua_pushnumber(L, l_mathop(ldexp)(x, ep));+ return 1;+}++static int math_log10 (lua_State *L) {+ lua_pushnumber(L, l_mathop(log10)(luaL_checknumber(L, 1)));+ return 1;+}++#endif+/* }================================================================== */++++static const luaL_Reg mathlib[] = {+ {"abs", math_abs},+ {"acos", math_acos},+ {"asin", math_asin},+ {"atan", math_atan},+ {"ceil", math_ceil},+ {"cos", math_cos},+ {"deg", math_deg},+ {"exp", math_exp},+ {"tointeger", math_toint},+ {"floor", math_floor},+ {"fmod", math_fmod},+ {"ult", math_ult},+ {"log", math_log},+ {"max", math_max},+ {"min", math_min},+ {"modf", math_modf},+ {"rad", math_rad},+ {"random", math_random},+ {"randomseed", math_randomseed},+ {"sin", math_sin},+ {"sqrt", math_sqrt},+ {"tan", math_tan},+ {"type", math_type},+#if defined(LUA_COMPAT_MATHLIB)+ {"atan2", math_atan},+ {"cosh", math_cosh},+ {"sinh", math_sinh},+ {"tanh", math_tanh},+ {"pow", math_pow},+ {"frexp", math_frexp},+ {"ldexp", math_ldexp},+ {"log10", math_log10},+#endif+ /* placeholders */+ {"pi", NULL},+ {"huge", NULL},+ {"maxinteger", NULL},+ {"mininteger", NULL},+ {NULL, NULL}+};+++/*+** Open math library+*/+LUAMOD_API int luaopen_math (lua_State *L) {+ luaL_newlib(L, mathlib);+ lua_pushnumber(L, PI);+ lua_setfield(L, -2, "pi");+ lua_pushnumber(L, (lua_Number)HUGE_VAL);+ lua_setfield(L, -2, "huge");+ lua_pushinteger(L, LUA_MAXINTEGER);+ lua_setfield(L, -2, "maxinteger");+ lua_pushinteger(L, LUA_MININTEGER);+ lua_setfield(L, -2, "mininteger");+ return 1;+}+
+ cbits/lua-5.3.6/lmem.c view
@@ -0,0 +1,100 @@+/*+** $Id: lmem.c,v 1.91.1.1 2017/04/19 17:20:42 roberto Exp $+** Interface to Memory Manager+** See Copyright Notice in lua.h+*/++#define lmem_c+#define LUA_CORE++#include "lprefix.h"+++#include <stddef.h>++#include "lua.h"++#include "ldebug.h"+#include "ldo.h"+#include "lgc.h"+#include "lmem.h"+#include "lobject.h"+#include "lstate.h"++++/*+** About the realloc function:+** void * frealloc (void *ud, void *ptr, size_t osize, size_t nsize);+** ('osize' is the old size, 'nsize' is the new size)+**+** * frealloc(ud, NULL, x, s) creates a new block of size 's' (no+** matter 'x').+**+** * frealloc(ud, p, x, 0) frees the block 'p'+** (in this specific case, frealloc must return NULL);+** particularly, frealloc(ud, NULL, 0, 0) does nothing+** (which is equivalent to free(NULL) in ISO C)+**+** frealloc returns NULL if it cannot create or reallocate the area+** (any reallocation to an equal or smaller size cannot fail!)+*/++++#define MINSIZEARRAY 4+++void *luaM_growaux_ (lua_State *L, void *block, int *size, size_t size_elems,+ int limit, const char *what) {+ void *newblock;+ int newsize;+ if (*size >= limit/2) { /* cannot double it? */+ if (*size >= limit) /* cannot grow even a little? */+ luaG_runerror(L, "too many %s (limit is %d)", what, limit);+ newsize = limit; /* still have at least one free place */+ }+ else {+ newsize = (*size)*2;+ if (newsize < MINSIZEARRAY)+ newsize = MINSIZEARRAY; /* minimum size */+ }+ newblock = luaM_reallocv(L, block, *size, newsize, size_elems);+ *size = newsize; /* update only when everything else is OK */+ return newblock;+}+++l_noret luaM_toobig (lua_State *L) {+ luaG_runerror(L, "memory allocation error: block too big");+}++++/*+** generic allocation routine.+*/+void *luaM_realloc_ (lua_State *L, void *block, size_t osize, size_t nsize) {+ void *newblock;+ global_State *g = G(L);+ size_t realosize = (block) ? osize : 0;+ lua_assert((realosize == 0) == (block == NULL));+#if defined(HARDMEMTESTS)+ if (nsize > realosize && g->gcrunning)+ luaC_fullgc(L, 1); /* force a GC whenever possible */+#endif+ newblock = (*g->frealloc)(g->ud, block, osize, nsize);+ if (newblock == NULL && nsize > 0) {+ lua_assert(nsize > realosize); /* cannot fail when shrinking a block */+ if (g->version) { /* is state fully built? */+ luaC_fullgc(L, 1); /* try to free some memory... */+ newblock = (*g->frealloc)(g->ud, block, osize, nsize); /* try again */+ }+ if (newblock == NULL)+ luaD_throw(L, LUA_ERRMEM);+ }+ lua_assert((nsize == 0) == (newblock == NULL));+ g->GCdebt = (g->GCdebt + nsize) - realosize;+ return newblock;+}+
+ cbits/lua-5.3.6/lmem.h view
@@ -0,0 +1,69 @@+/*+** $Id: lmem.h,v 1.43.1.1 2017/04/19 17:20:42 roberto Exp $+** Interface to Memory Manager+** See Copyright Notice in lua.h+*/++#ifndef lmem_h+#define lmem_h+++#include <stddef.h>++#include "llimits.h"+#include "lua.h"+++/*+** This macro reallocs a vector 'b' from 'on' to 'n' elements, where+** each element has size 'e'. In case of arithmetic overflow of the+** product 'n'*'e', it raises an error (calling 'luaM_toobig'). Because+** 'e' is always constant, it avoids the runtime division MAX_SIZET/(e).+**+** (The macro is somewhat complex to avoid warnings: The 'sizeof'+** comparison avoids a runtime comparison when overflow cannot occur.+** The compiler should be able to optimize the real test by itself, but+** when it does it, it may give a warning about "comparison is always+** false due to limited range of data type"; the +1 tricks the compiler,+** avoiding this warning but also this optimization.)+*/+#define luaM_reallocv(L,b,on,n,e) \+ (((sizeof(n) >= sizeof(size_t) && cast(size_t, (n)) + 1 > MAX_SIZET/(e)) \+ ? luaM_toobig(L) : cast_void(0)) , \+ luaM_realloc_(L, (b), (on)*(e), (n)*(e)))++/*+** Arrays of chars do not need any test+*/+#define luaM_reallocvchar(L,b,on,n) \+ cast(char *, luaM_realloc_(L, (b), (on)*sizeof(char), (n)*sizeof(char)))++#define luaM_freemem(L, b, s) luaM_realloc_(L, (b), (s), 0)+#define luaM_free(L, b) luaM_realloc_(L, (b), sizeof(*(b)), 0)+#define luaM_freearray(L, b, n) luaM_realloc_(L, (b), (n)*sizeof(*(b)), 0)++#define luaM_malloc(L,s) luaM_realloc_(L, NULL, 0, (s))+#define luaM_new(L,t) cast(t *, luaM_malloc(L, sizeof(t)))+#define luaM_newvector(L,n,t) \+ cast(t *, luaM_reallocv(L, NULL, 0, n, sizeof(t)))++#define luaM_newobject(L,tag,s) luaM_realloc_(L, NULL, tag, (s))++#define luaM_growvector(L,v,nelems,size,t,limit,e) \+ if ((nelems)+1 > (size)) \+ ((v)=cast(t *, luaM_growaux_(L,v,&(size),sizeof(t),limit,e)))++#define luaM_reallocvector(L, v,oldn,n,t) \+ ((v)=cast(t *, luaM_reallocv(L, v, oldn, n, sizeof(t))))++LUAI_FUNC l_noret luaM_toobig (lua_State *L);++/* not to be called directly */+LUAI_FUNC void *luaM_realloc_ (lua_State *L, void *block, size_t oldsize,+ size_t size);+LUAI_FUNC void *luaM_growaux_ (lua_State *L, void *block, int *size,+ size_t size_elem, int limit,+ const char *what);++#endif+
+ cbits/lua-5.3.6/loadlib.c view
@@ -0,0 +1,790 @@+/*+** $Id: loadlib.c,v 1.130.1.1 2017/04/19 17:20:42 roberto Exp $+** Dynamic library loader for Lua+** See Copyright Notice in lua.h+**+** This module contains an implementation of loadlib for Unix systems+** that have dlfcn, an implementation for Windows, and a stub for other+** systems.+*/++#define loadlib_c+#define LUA_LIB++#include "lprefix.h"+++#include <stdio.h>+#include <stdlib.h>+#include <string.h>++#include "lua.h"++#include "lauxlib.h"+#include "lualib.h"+++/*+** LUA_IGMARK is a mark to ignore all before it when building the+** luaopen_ function name.+*/+#if !defined (LUA_IGMARK)+#define LUA_IGMARK "-"+#endif+++/*+** LUA_CSUBSEP is the character that replaces dots in submodule names+** when searching for a C loader.+** LUA_LSUBSEP is the character that replaces dots in submodule names+** when searching for a Lua loader.+*/+#if !defined(LUA_CSUBSEP)+#define LUA_CSUBSEP LUA_DIRSEP+#endif++#if !defined(LUA_LSUBSEP)+#define LUA_LSUBSEP LUA_DIRSEP+#endif+++/* prefix for open functions in C libraries */+#define LUA_POF "luaopen_"++/* separator for open functions in C libraries */+#define LUA_OFSEP "_"+++/*+** unique key for table in the registry that keeps handles+** for all loaded C libraries+*/+static const int CLIBS = 0;++#define LIB_FAIL "open"+++#define setprogdir(L) ((void)0)+++/*+** system-dependent functions+*/++/*+** unload library 'lib'+*/+static void lsys_unloadlib (void *lib);++/*+** load C library in file 'path'. If 'seeglb', load with all names in+** the library global.+** Returns the library; in case of error, returns NULL plus an+** error string in the stack.+*/+static void *lsys_load (lua_State *L, const char *path, int seeglb);++/*+** Try to find a function named 'sym' in library 'lib'.+** Returns the function; in case of error, returns NULL plus an+** error string in the stack.+*/+static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym);+++++#if defined(LUA_USE_DLOPEN) /* { */+/*+** {========================================================================+** This is an implementation of loadlib based on the dlfcn interface.+** The dlfcn interface is available in Linux, SunOS, Solaris, IRIX, FreeBSD,+** NetBSD, AIX 4.2, HPUX 11, and probably most other Unix flavors, at least+** as an emulation layer on top of native functions.+** =========================================================================+*/++#include <dlfcn.h>++/*+** Macro to convert pointer-to-void* to pointer-to-function. This cast+** is undefined according to ISO C, but POSIX assumes that it works.+** (The '__extension__' in gnu compilers is only to avoid warnings.)+*/+#if defined(__GNUC__)+#define cast_func(p) (__extension__ (lua_CFunction)(p))+#else+#define cast_func(p) ((lua_CFunction)(p))+#endif+++static void lsys_unloadlib (void *lib) {+ dlclose(lib);+}+++static void *lsys_load (lua_State *L, const char *path, int seeglb) {+ void *lib = dlopen(path, RTLD_NOW | (seeglb ? RTLD_GLOBAL : RTLD_LOCAL));+ if (lib == NULL) lua_pushstring(L, dlerror());+ return lib;+}+++static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym) {+ lua_CFunction f = cast_func(dlsym(lib, sym));+ if (f == NULL) lua_pushstring(L, dlerror());+ return f;+}++/* }====================================================== */++++#elif defined(LUA_DL_DLL) /* }{ */+/*+** {======================================================================+** This is an implementation of loadlib for Windows using native functions.+** =======================================================================+*/++#include <windows.h>+++/*+** optional flags for LoadLibraryEx+*/+#if !defined(LUA_LLE_FLAGS)+#define LUA_LLE_FLAGS 0+#endif+++#undef setprogdir+++/*+** Replace in the path (on the top of the stack) any occurrence+** of LUA_EXEC_DIR with the executable's path.+*/+static void setprogdir (lua_State *L) {+ char buff[MAX_PATH + 1];+ char *lb;+ DWORD nsize = sizeof(buff)/sizeof(char);+ DWORD n = GetModuleFileNameA(NULL, buff, nsize); /* get exec. name */+ if (n == 0 || n == nsize || (lb = strrchr(buff, '\\')) == NULL)+ luaL_error(L, "unable to get ModuleFileName");+ else {+ *lb = '\0'; /* cut name on the last '\\' to get the path */+ luaL_gsub(L, lua_tostring(L, -1), LUA_EXEC_DIR, buff);+ lua_remove(L, -2); /* remove original string */+ }+}+++++static void pusherror (lua_State *L) {+ int error = GetLastError();+ char buffer[128];+ if (FormatMessageA(FORMAT_MESSAGE_IGNORE_INSERTS | FORMAT_MESSAGE_FROM_SYSTEM,+ NULL, error, 0, buffer, sizeof(buffer)/sizeof(char), NULL))+ lua_pushstring(L, buffer);+ else+ lua_pushfstring(L, "system error %d\n", error);+}++static void lsys_unloadlib (void *lib) {+ FreeLibrary((HMODULE)lib);+}+++static void *lsys_load (lua_State *L, const char *path, int seeglb) {+ HMODULE lib = LoadLibraryExA(path, NULL, LUA_LLE_FLAGS);+ (void)(seeglb); /* not used: symbols are 'global' by default */+ if (lib == NULL) pusherror(L);+ return lib;+}+++static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym) {+ lua_CFunction f = (lua_CFunction)GetProcAddress((HMODULE)lib, sym);+ if (f == NULL) pusherror(L);+ return f;+}++/* }====================================================== */+++#else /* }{ */+/*+** {======================================================+** Fallback for other systems+** =======================================================+*/++#undef LIB_FAIL+#define LIB_FAIL "absent"+++#define DLMSG "dynamic libraries not enabled; check your Lua installation"+++static void lsys_unloadlib (void *lib) {+ (void)(lib); /* not used */+}+++static void *lsys_load (lua_State *L, const char *path, int seeglb) {+ (void)(path); (void)(seeglb); /* not used */+ lua_pushliteral(L, DLMSG);+ return NULL;+}+++static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym) {+ (void)(lib); (void)(sym); /* not used */+ lua_pushliteral(L, DLMSG);+ return NULL;+}++/* }====================================================== */+#endif /* } */+++/*+** {==================================================================+** Set Paths+** ===================================================================+*/++/*+** LUA_PATH_VAR and LUA_CPATH_VAR are the names of the environment+** variables that Lua check to set its paths.+*/+#if !defined(LUA_PATH_VAR)+#define LUA_PATH_VAR "LUA_PATH"+#endif++#if !defined(LUA_CPATH_VAR)+#define LUA_CPATH_VAR "LUA_CPATH"+#endif+++#define AUXMARK "\1" /* auxiliary mark */+++/*+** return registry.LUA_NOENV as a boolean+*/+static int noenv (lua_State *L) {+ int b;+ lua_getfield(L, LUA_REGISTRYINDEX, "LUA_NOENV");+ b = lua_toboolean(L, -1);+ lua_pop(L, 1); /* remove value */+ return b;+}+++/*+** Set a path+*/+static void setpath (lua_State *L, const char *fieldname,+ const char *envname,+ const char *dft) {+ const char *nver = lua_pushfstring(L, "%s%s", envname, LUA_VERSUFFIX);+ const char *path = getenv(nver); /* use versioned name */+ if (path == NULL) /* no environment variable? */+ path = getenv(envname); /* try unversioned name */+ if (path == NULL || noenv(L)) /* no environment variable? */+ lua_pushstring(L, dft); /* use default */+ else {+ /* replace ";;" by ";AUXMARK;" and then AUXMARK by default path */+ path = luaL_gsub(L, path, LUA_PATH_SEP LUA_PATH_SEP,+ LUA_PATH_SEP AUXMARK LUA_PATH_SEP);+ luaL_gsub(L, path, AUXMARK, dft);+ lua_remove(L, -2); /* remove result from 1st 'gsub' */+ }+ setprogdir(L);+ lua_setfield(L, -3, fieldname); /* package[fieldname] = path value */+ lua_pop(L, 1); /* pop versioned variable name */+}++/* }================================================================== */+++/*+** return registry.CLIBS[path]+*/+static void *checkclib (lua_State *L, const char *path) {+ void *plib;+ lua_rawgetp(L, LUA_REGISTRYINDEX, &CLIBS);+ lua_getfield(L, -1, path);+ plib = lua_touserdata(L, -1); /* plib = CLIBS[path] */+ lua_pop(L, 2); /* pop CLIBS table and 'plib' */+ return plib;+}+++/*+** registry.CLIBS[path] = plib -- for queries+** registry.CLIBS[#CLIBS + 1] = plib -- also keep a list of all libraries+*/+static void addtoclib (lua_State *L, const char *path, void *plib) {+ lua_rawgetp(L, LUA_REGISTRYINDEX, &CLIBS);+ lua_pushlightuserdata(L, plib);+ lua_pushvalue(L, -1);+ lua_setfield(L, -3, path); /* CLIBS[path] = plib */+ lua_rawseti(L, -2, luaL_len(L, -2) + 1); /* CLIBS[#CLIBS + 1] = plib */+ lua_pop(L, 1); /* pop CLIBS table */+}+++/*+** __gc tag method for CLIBS table: calls 'lsys_unloadlib' for all lib+** handles in list CLIBS+*/+static int gctm (lua_State *L) {+ lua_Integer n = luaL_len(L, 1);+ for (; n >= 1; n--) { /* for each handle, in reverse order */+ lua_rawgeti(L, 1, n); /* get handle CLIBS[n] */+ lsys_unloadlib(lua_touserdata(L, -1));+ lua_pop(L, 1); /* pop handle */+ }+ return 0;+}++++/* error codes for 'lookforfunc' */+#define ERRLIB 1+#define ERRFUNC 2++/*+** Look for a C function named 'sym' in a dynamically loaded library+** 'path'.+** First, check whether the library is already loaded; if not, try+** to load it.+** Then, if 'sym' is '*', return true (as library has been loaded).+** Otherwise, look for symbol 'sym' in the library and push a+** C function with that symbol.+** Return 0 and 'true' or a function in the stack; in case of+** errors, return an error code and an error message in the stack.+*/+static int lookforfunc (lua_State *L, const char *path, const char *sym) {+ void *reg = checkclib(L, path); /* check loaded C libraries */+ if (reg == NULL) { /* must load library? */+ reg = lsys_load(L, path, *sym == '*'); /* global symbols if 'sym'=='*' */+ if (reg == NULL) return ERRLIB; /* unable to load library */+ addtoclib(L, path, reg);+ }+ if (*sym == '*') { /* loading only library (no function)? */+ lua_pushboolean(L, 1); /* return 'true' */+ return 0; /* no errors */+ }+ else {+ lua_CFunction f = lsys_sym(L, reg, sym);+ if (f == NULL)+ return ERRFUNC; /* unable to find function */+ lua_pushcfunction(L, f); /* else create new function */+ return 0; /* no errors */+ }+}+++static int ll_loadlib (lua_State *L) {+ const char *path = luaL_checkstring(L, 1);+ const char *init = luaL_checkstring(L, 2);+ int stat = lookforfunc(L, path, init);+ if (stat == 0) /* no errors? */+ return 1; /* return the loaded function */+ else { /* error; error message is on stack top */+ lua_pushnil(L);+ lua_insert(L, -2);+ lua_pushstring(L, (stat == ERRLIB) ? LIB_FAIL : "init");+ return 3; /* return nil, error message, and where */+ }+}++++/*+** {======================================================+** 'require' function+** =======================================================+*/+++static int readable (const char *filename) {+ FILE *f = fopen(filename, "r"); /* try to open file */+ if (f == NULL) return 0; /* open failed */+ fclose(f);+ return 1;+}+++static const char *pushnexttemplate (lua_State *L, const char *path) {+ const char *l;+ while (*path == *LUA_PATH_SEP) path++; /* skip separators */+ if (*path == '\0') return NULL; /* no more templates */+ l = strchr(path, *LUA_PATH_SEP); /* find next separator */+ if (l == NULL) l = path + strlen(path);+ lua_pushlstring(L, path, l - path); /* template */+ return l;+}+++static const char *searchpath (lua_State *L, const char *name,+ const char *path,+ const char *sep,+ const char *dirsep) {+ luaL_Buffer msg; /* to build error message */+ luaL_buffinit(L, &msg);+ if (*sep != '\0') /* non-empty separator? */+ name = luaL_gsub(L, name, sep, dirsep); /* replace it by 'dirsep' */+ while ((path = pushnexttemplate(L, path)) != NULL) {+ const char *filename = luaL_gsub(L, lua_tostring(L, -1),+ LUA_PATH_MARK, name);+ lua_remove(L, -2); /* remove path template */+ if (readable(filename)) /* does file exist and is readable? */+ return filename; /* return that file name */+ lua_pushfstring(L, "\n\tno file '%s'", filename);+ lua_remove(L, -2); /* remove file name */+ luaL_addvalue(&msg); /* concatenate error msg. entry */+ }+ luaL_pushresult(&msg); /* create error message */+ return NULL; /* not found */+}+++static int ll_searchpath (lua_State *L) {+ const char *f = searchpath(L, luaL_checkstring(L, 1),+ luaL_checkstring(L, 2),+ luaL_optstring(L, 3, "."),+ luaL_optstring(L, 4, LUA_DIRSEP));+ if (f != NULL) return 1;+ else { /* error message is on top of the stack */+ lua_pushnil(L);+ lua_insert(L, -2);+ return 2; /* return nil + error message */+ }+}+++static const char *findfile (lua_State *L, const char *name,+ const char *pname,+ const char *dirsep) {+ const char *path;+ lua_getfield(L, lua_upvalueindex(1), pname);+ path = lua_tostring(L, -1);+ if (path == NULL)+ luaL_error(L, "'package.%s' must be a string", pname);+ return searchpath(L, name, path, ".", dirsep);+}+++static int checkload (lua_State *L, int stat, const char *filename) {+ if (stat) { /* module loaded successfully? */+ lua_pushstring(L, filename); /* will be 2nd argument to module */+ return 2; /* return open function and file name */+ }+ else+ return luaL_error(L, "error loading module '%s' from file '%s':\n\t%s",+ lua_tostring(L, 1), filename, lua_tostring(L, -1));+}+++static int searcher_Lua (lua_State *L) {+ const char *filename;+ const char *name = luaL_checkstring(L, 1);+ filename = findfile(L, name, "path", LUA_LSUBSEP);+ if (filename == NULL) return 1; /* module not found in this path */+ return checkload(L, (luaL_loadfile(L, filename) == LUA_OK), filename);+}+++/*+** Try to find a load function for module 'modname' at file 'filename'.+** First, change '.' to '_' in 'modname'; then, if 'modname' has+** the form X-Y (that is, it has an "ignore mark"), build a function+** name "luaopen_X" and look for it. (For compatibility, if that+** fails, it also tries "luaopen_Y".) If there is no ignore mark,+** look for a function named "luaopen_modname".+*/+static int loadfunc (lua_State *L, const char *filename, const char *modname) {+ const char *openfunc;+ const char *mark;+ modname = luaL_gsub(L, modname, ".", LUA_OFSEP);+ mark = strchr(modname, *LUA_IGMARK);+ if (mark) {+ int stat;+ openfunc = lua_pushlstring(L, modname, mark - modname);+ openfunc = lua_pushfstring(L, LUA_POF"%s", openfunc);+ stat = lookforfunc(L, filename, openfunc);+ if (stat != ERRFUNC) return stat;+ modname = mark + 1; /* else go ahead and try old-style name */+ }+ openfunc = lua_pushfstring(L, LUA_POF"%s", modname);+ return lookforfunc(L, filename, openfunc);+}+++static int searcher_C (lua_State *L) {+ const char *name = luaL_checkstring(L, 1);+ const char *filename = findfile(L, name, "cpath", LUA_CSUBSEP);+ if (filename == NULL) return 1; /* module not found in this path */+ return checkload(L, (loadfunc(L, filename, name) == 0), filename);+}+++static int searcher_Croot (lua_State *L) {+ const char *filename;+ const char *name = luaL_checkstring(L, 1);+ const char *p = strchr(name, '.');+ int stat;+ if (p == NULL) return 0; /* is root */+ lua_pushlstring(L, name, p - name);+ filename = findfile(L, lua_tostring(L, -1), "cpath", LUA_CSUBSEP);+ if (filename == NULL) return 1; /* root not found */+ if ((stat = loadfunc(L, filename, name)) != 0) {+ if (stat != ERRFUNC)+ return checkload(L, 0, filename); /* real error */+ else { /* open function not found */+ lua_pushfstring(L, "\n\tno module '%s' in file '%s'", name, filename);+ return 1;+ }+ }+ lua_pushstring(L, filename); /* will be 2nd argument to module */+ return 2;+}+++static int searcher_preload (lua_State *L) {+ const char *name = luaL_checkstring(L, 1);+ lua_getfield(L, LUA_REGISTRYINDEX, LUA_PRELOAD_TABLE);+ if (lua_getfield(L, -1, name) == LUA_TNIL) /* not found? */+ lua_pushfstring(L, "\n\tno field package.preload['%s']", name);+ return 1;+}+++static void findloader (lua_State *L, const char *name) {+ int i;+ luaL_Buffer msg; /* to build error message */+ luaL_buffinit(L, &msg);+ /* push 'package.searchers' to index 3 in the stack */+ if (lua_getfield(L, lua_upvalueindex(1), "searchers") != LUA_TTABLE)+ luaL_error(L, "'package.searchers' must be a table");+ /* iterate over available searchers to find a loader */+ for (i = 1; ; i++) {+ if (lua_rawgeti(L, 3, i) == LUA_TNIL) { /* no more searchers? */+ lua_pop(L, 1); /* remove nil */+ luaL_pushresult(&msg); /* create error message */+ luaL_error(L, "module '%s' not found:%s", name, lua_tostring(L, -1));+ }+ lua_pushstring(L, name);+ lua_call(L, 1, 2); /* call it */+ if (lua_isfunction(L, -2)) /* did it find a loader? */+ return; /* module loader found */+ else if (lua_isstring(L, -2)) { /* searcher returned error message? */+ lua_pop(L, 1); /* remove extra return */+ luaL_addvalue(&msg); /* concatenate error message */+ }+ else+ lua_pop(L, 2); /* remove both returns */+ }+}+++static int ll_require (lua_State *L) {+ const char *name = luaL_checkstring(L, 1);+ lua_settop(L, 1); /* LOADED table will be at index 2 */+ lua_getfield(L, LUA_REGISTRYINDEX, LUA_LOADED_TABLE);+ lua_getfield(L, 2, name); /* LOADED[name] */+ if (lua_toboolean(L, -1)) /* is it there? */+ return 1; /* package is already loaded */+ /* else must load package */+ lua_pop(L, 1); /* remove 'getfield' result */+ findloader(L, name);+ lua_pushstring(L, name); /* pass name as argument to module loader */+ lua_insert(L, -2); /* name is 1st argument (before search data) */+ lua_call(L, 2, 1); /* run loader to load module */+ if (!lua_isnil(L, -1)) /* non-nil return? */+ lua_setfield(L, 2, name); /* LOADED[name] = returned value */+ if (lua_getfield(L, 2, name) == LUA_TNIL) { /* module set no value? */+ lua_pushboolean(L, 1); /* use true as result */+ lua_pushvalue(L, -1); /* extra copy to be returned */+ lua_setfield(L, 2, name); /* LOADED[name] = true */+ }+ return 1;+}++/* }====================================================== */++++/*+** {======================================================+** 'module' function+** =======================================================+*/+#if defined(LUA_COMPAT_MODULE)++/*+** changes the environment variable of calling function+*/+static void set_env (lua_State *L) {+ lua_Debug ar;+ if (lua_getstack(L, 1, &ar) == 0 ||+ lua_getinfo(L, "f", &ar) == 0 || /* get calling function */+ lua_iscfunction(L, -1))+ luaL_error(L, "'module' not called from a Lua function");+ lua_pushvalue(L, -2); /* copy new environment table to top */+ lua_setupvalue(L, -2, 1);+ lua_pop(L, 1); /* remove function */+}+++static void dooptions (lua_State *L, int n) {+ int i;+ for (i = 2; i <= n; i++) {+ if (lua_isfunction(L, i)) { /* avoid 'calling' extra info. */+ lua_pushvalue(L, i); /* get option (a function) */+ lua_pushvalue(L, -2); /* module */+ lua_call(L, 1, 0);+ }+ }+}+++static void modinit (lua_State *L, const char *modname) {+ const char *dot;+ lua_pushvalue(L, -1);+ lua_setfield(L, -2, "_M"); /* module._M = module */+ lua_pushstring(L, modname);+ lua_setfield(L, -2, "_NAME");+ dot = strrchr(modname, '.'); /* look for last dot in module name */+ if (dot == NULL) dot = modname;+ else dot++;+ /* set _PACKAGE as package name (full module name minus last part) */+ lua_pushlstring(L, modname, dot - modname);+ lua_setfield(L, -2, "_PACKAGE");+}+++static int ll_module (lua_State *L) {+ const char *modname = luaL_checkstring(L, 1);+ int lastarg = lua_gettop(L); /* last parameter */+ luaL_pushmodule(L, modname, 1); /* get/create module table */+ /* check whether table already has a _NAME field */+ if (lua_getfield(L, -1, "_NAME") != LUA_TNIL)+ lua_pop(L, 1); /* table is an initialized module */+ else { /* no; initialize it */+ lua_pop(L, 1);+ modinit(L, modname);+ }+ lua_pushvalue(L, -1);+ set_env(L);+ dooptions(L, lastarg);+ return 1;+}+++static int ll_seeall (lua_State *L) {+ luaL_checktype(L, 1, LUA_TTABLE);+ if (!lua_getmetatable(L, 1)) {+ lua_createtable(L, 0, 1); /* create new metatable */+ lua_pushvalue(L, -1);+ lua_setmetatable(L, 1);+ }+ lua_pushglobaltable(L);+ lua_setfield(L, -2, "__index"); /* mt.__index = _G */+ return 0;+}++#endif+/* }====================================================== */++++static const luaL_Reg pk_funcs[] = {+ {"loadlib", ll_loadlib},+ {"searchpath", ll_searchpath},+#if defined(LUA_COMPAT_MODULE)+ {"seeall", ll_seeall},+#endif+ /* placeholders */+ {"preload", NULL},+ {"cpath", NULL},+ {"path", NULL},+ {"searchers", NULL},+ {"loaded", NULL},+ {NULL, NULL}+};+++static const luaL_Reg ll_funcs[] = {+#if defined(LUA_COMPAT_MODULE)+ {"module", ll_module},+#endif+ {"require", ll_require},+ {NULL, NULL}+};+++static void createsearcherstable (lua_State *L) {+ static const lua_CFunction searchers[] =+ {searcher_preload, searcher_Lua, searcher_C, searcher_Croot, NULL};+ int i;+ /* create 'searchers' table */+ lua_createtable(L, sizeof(searchers)/sizeof(searchers[0]) - 1, 0);+ /* fill it with predefined searchers */+ for (i=0; searchers[i] != NULL; i++) {+ lua_pushvalue(L, -2); /* set 'package' as upvalue for all searchers */+ lua_pushcclosure(L, searchers[i], 1);+ lua_rawseti(L, -2, i+1);+ }+#if defined(LUA_COMPAT_LOADERS)+ lua_pushvalue(L, -1); /* make a copy of 'searchers' table */+ lua_setfield(L, -3, "loaders"); /* put it in field 'loaders' */+#endif+ lua_setfield(L, -2, "searchers"); /* put it in field 'searchers' */+}+++/*+** create table CLIBS to keep track of loaded C libraries,+** setting a finalizer to close all libraries when closing state.+*/+static void createclibstable (lua_State *L) {+ lua_newtable(L); /* create CLIBS table */+ lua_createtable(L, 0, 1); /* create metatable for CLIBS */+ lua_pushcfunction(L, gctm);+ lua_setfield(L, -2, "__gc"); /* set finalizer for CLIBS table */+ lua_setmetatable(L, -2);+ lua_rawsetp(L, LUA_REGISTRYINDEX, &CLIBS); /* set CLIBS table in registry */+}+++LUAMOD_API int luaopen_package (lua_State *L) {+ createclibstable(L);+ luaL_newlib(L, pk_funcs); /* create 'package' table */+ createsearcherstable(L);+ /* set paths */+ setpath(L, "path", LUA_PATH_VAR, LUA_PATH_DEFAULT);+ setpath(L, "cpath", LUA_CPATH_VAR, LUA_CPATH_DEFAULT);+ /* store config information */+ lua_pushliteral(L, LUA_DIRSEP "\n" LUA_PATH_SEP "\n" LUA_PATH_MARK "\n"+ LUA_EXEC_DIR "\n" LUA_IGMARK "\n");+ lua_setfield(L, -2, "config");+ /* set field 'loaded' */+ luaL_getsubtable(L, LUA_REGISTRYINDEX, LUA_LOADED_TABLE);+ lua_setfield(L, -2, "loaded");+ /* set field 'preload' */+ luaL_getsubtable(L, LUA_REGISTRYINDEX, LUA_PRELOAD_TABLE);+ lua_setfield(L, -2, "preload");+ lua_pushglobaltable(L);+ lua_pushvalue(L, -2); /* set 'package' as upvalue for next lib */+ luaL_setfuncs(L, ll_funcs, 1); /* open lib into global table */+ lua_pop(L, 1); /* pop global table */+ return 1; /* return 'package' table */+}+
+ cbits/lua-5.3.6/lobject.c view
@@ -0,0 +1,522 @@+/*+** $Id: lobject.c,v 2.113.1.1 2017/04/19 17:29:57 roberto Exp $+** Some generic functions over Lua objects+** See Copyright Notice in lua.h+*/++#define lobject_c+#define LUA_CORE++#include "lprefix.h"+++#include <locale.h>+#include <math.h>+#include <stdarg.h>+#include <stdio.h>+#include <stdlib.h>+#include <string.h>++#include "lua.h"++#include "lctype.h"+#include "ldebug.h"+#include "ldo.h"+#include "lmem.h"+#include "lobject.h"+#include "lstate.h"+#include "lstring.h"+#include "lvm.h"++++LUAI_DDEF const TValue luaO_nilobject_ = {NILCONSTANT};+++/*+** converts an integer to a "floating point byte", represented as+** (eeeeexxx), where the real value is (1xxx) * 2^(eeeee - 1) if+** eeeee != 0 and (xxx) otherwise.+*/+int luaO_int2fb (unsigned int x) {+ int e = 0; /* exponent */+ if (x < 8) return x;+ while (x >= (8 << 4)) { /* coarse steps */+ x = (x + 0xf) >> 4; /* x = ceil(x / 16) */+ e += 4;+ }+ while (x >= (8 << 1)) { /* fine steps */+ x = (x + 1) >> 1; /* x = ceil(x / 2) */+ e++;+ }+ return ((e+1) << 3) | (cast_int(x) - 8);+}+++/* converts back */+int luaO_fb2int (int x) {+ return (x < 8) ? x : ((x & 7) + 8) << ((x >> 3) - 1);+}+++/*+** Computes ceil(log2(x))+*/+int luaO_ceillog2 (unsigned int x) {+ static const lu_byte log_2[256] = { /* log_2[i] = ceil(log2(i - 1)) */+ 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,+ 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,+ 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,+ 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,+ 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,+ 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,+ 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,+ 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+ };+ int l = 0;+ x--;+ while (x >= 256) { l += 8; x >>= 8; }+ return l + log_2[x];+}+++static lua_Integer intarith (lua_State *L, int op, lua_Integer v1,+ lua_Integer v2) {+ switch (op) {+ case LUA_OPADD: return intop(+, v1, v2);+ case LUA_OPSUB:return intop(-, v1, v2);+ case LUA_OPMUL:return intop(*, v1, v2);+ case LUA_OPMOD: return luaV_mod(L, v1, v2);+ case LUA_OPIDIV: return luaV_div(L, v1, v2);+ case LUA_OPBAND: return intop(&, v1, v2);+ case LUA_OPBOR: return intop(|, v1, v2);+ case LUA_OPBXOR: return intop(^, v1, v2);+ case LUA_OPSHL: return luaV_shiftl(v1, v2);+ case LUA_OPSHR: return luaV_shiftl(v1, -v2);+ case LUA_OPUNM: return intop(-, 0, v1);+ case LUA_OPBNOT: return intop(^, ~l_castS2U(0), v1);+ default: lua_assert(0); return 0;+ }+}+++static lua_Number numarith (lua_State *L, int op, lua_Number v1,+ lua_Number v2) {+ switch (op) {+ case LUA_OPADD: return luai_numadd(L, v1, v2);+ case LUA_OPSUB: return luai_numsub(L, v1, v2);+ case LUA_OPMUL: return luai_nummul(L, v1, v2);+ case LUA_OPDIV: return luai_numdiv(L, v1, v2);+ case LUA_OPPOW: return luai_numpow(L, v1, v2);+ case LUA_OPIDIV: return luai_numidiv(L, v1, v2);+ case LUA_OPUNM: return luai_numunm(L, v1);+ case LUA_OPMOD: {+ lua_Number m;+ luai_nummod(L, v1, v2, m);+ return m;+ }+ default: lua_assert(0); return 0;+ }+}+++void luaO_arith (lua_State *L, int op, const TValue *p1, const TValue *p2,+ TValue *res) {+ switch (op) {+ case LUA_OPBAND: case LUA_OPBOR: case LUA_OPBXOR:+ case LUA_OPSHL: case LUA_OPSHR:+ case LUA_OPBNOT: { /* operate only on integers */+ lua_Integer i1; lua_Integer i2;+ if (tointeger(p1, &i1) && tointeger(p2, &i2)) {+ setivalue(res, intarith(L, op, i1, i2));+ return;+ }+ else break; /* go to the end */+ }+ case LUA_OPDIV: case LUA_OPPOW: { /* operate only on floats */+ lua_Number n1; lua_Number n2;+ if (tonumber(p1, &n1) && tonumber(p2, &n2)) {+ setfltvalue(res, numarith(L, op, n1, n2));+ return;+ }+ else break; /* go to the end */+ }+ default: { /* other operations */+ lua_Number n1; lua_Number n2;+ if (ttisinteger(p1) && ttisinteger(p2)) {+ setivalue(res, intarith(L, op, ivalue(p1), ivalue(p2)));+ return;+ }+ else if (tonumber(p1, &n1) && tonumber(p2, &n2)) {+ setfltvalue(res, numarith(L, op, n1, n2));+ return;+ }+ else break; /* go to the end */+ }+ }+ /* could not perform raw operation; try metamethod */+ lua_assert(L != NULL); /* should not fail when folding (compile time) */+ luaT_trybinTM(L, p1, p2, res, cast(TMS, (op - LUA_OPADD) + TM_ADD));+}+++int luaO_hexavalue (int c) {+ if (lisdigit(c)) return c - '0';+ else return (ltolower(c) - 'a') + 10;+}+++static int isneg (const char **s) {+ if (**s == '-') { (*s)++; return 1; }+ else if (**s == '+') (*s)++;+ return 0;+}++++/*+** {==================================================================+** Lua's implementation for 'lua_strx2number'+** ===================================================================+*/++#if !defined(lua_strx2number)++/* maximum number of significant digits to read (to avoid overflows+ even with single floats) */+#define MAXSIGDIG 30++/*+** convert an hexadecimal numeric string to a number, following+** C99 specification for 'strtod'+*/+static lua_Number lua_strx2number (const char *s, char **endptr) {+ int dot = lua_getlocaledecpoint();+ lua_Number r = 0.0; /* result (accumulator) */+ int sigdig = 0; /* number of significant digits */+ int nosigdig = 0; /* number of non-significant digits */+ int e = 0; /* exponent correction */+ int neg; /* 1 if number is negative */+ int hasdot = 0; /* true after seen a dot */+ *endptr = cast(char *, s); /* nothing is valid yet */+ while (lisspace(cast_uchar(*s))) s++; /* skip initial spaces */+ neg = isneg(&s); /* check signal */+ if (!(*s == '0' && (*(s + 1) == 'x' || *(s + 1) == 'X'))) /* check '0x' */+ return 0.0; /* invalid format (no '0x') */+ for (s += 2; ; s++) { /* skip '0x' and read numeral */+ if (*s == dot) {+ if (hasdot) break; /* second dot? stop loop */+ else hasdot = 1;+ }+ else if (lisxdigit(cast_uchar(*s))) {+ if (sigdig == 0 && *s == '0') /* non-significant digit (zero)? */+ nosigdig++;+ else if (++sigdig <= MAXSIGDIG) /* can read it without overflow? */+ r = (r * cast_num(16.0)) + luaO_hexavalue(*s);+ else e++; /* too many digits; ignore, but still count for exponent */+ if (hasdot) e--; /* decimal digit? correct exponent */+ }+ else break; /* neither a dot nor a digit */+ }+ if (nosigdig + sigdig == 0) /* no digits? */+ return 0.0; /* invalid format */+ *endptr = cast(char *, s); /* valid up to here */+ e *= 4; /* each digit multiplies/divides value by 2^4 */+ if (*s == 'p' || *s == 'P') { /* exponent part? */+ int exp1 = 0; /* exponent value */+ int neg1; /* exponent signal */+ s++; /* skip 'p' */+ neg1 = isneg(&s); /* signal */+ if (!lisdigit(cast_uchar(*s)))+ return 0.0; /* invalid; must have at least one digit */+ while (lisdigit(cast_uchar(*s))) /* read exponent */+ exp1 = exp1 * 10 + *(s++) - '0';+ if (neg1) exp1 = -exp1;+ e += exp1;+ *endptr = cast(char *, s); /* valid up to here */+ }+ if (neg) r = -r;+ return l_mathop(ldexp)(r, e);+}++#endif+/* }====================================================== */+++/* maximum length of a numeral */+#if !defined (L_MAXLENNUM)+#define L_MAXLENNUM 200+#endif++static const char *l_str2dloc (const char *s, lua_Number *result, int mode) {+ char *endptr;+ *result = (mode == 'x') ? lua_strx2number(s, &endptr) /* try to convert */+ : lua_str2number(s, &endptr);+ if (endptr == s) return NULL; /* nothing recognized? */+ while (lisspace(cast_uchar(*endptr))) endptr++; /* skip trailing spaces */+ return (*endptr == '\0') ? endptr : NULL; /* OK if no trailing characters */+}+++/*+** Convert string 's' to a Lua number (put in 'result'). Return NULL+** on fail or the address of the ending '\0' on success.+** 'pmode' points to (and 'mode' contains) special things in the string:+** - 'x'/'X' means an hexadecimal numeral+** - 'n'/'N' means 'inf' or 'nan' (which should be rejected)+** - '.' just optimizes the search for the common case (nothing special)+** This function accepts both the current locale or a dot as the radix+** mark. If the conversion fails, it may mean number has a dot but+** locale accepts something else. In that case, the code copies 's'+** to a buffer (because 's' is read-only), changes the dot to the+** current locale radix mark, and tries to convert again.+*/+static const char *l_str2d (const char *s, lua_Number *result) {+ const char *endptr;+ const char *pmode = strpbrk(s, ".xXnN");+ int mode = pmode ? ltolower(cast_uchar(*pmode)) : 0;+ if (mode == 'n') /* reject 'inf' and 'nan' */+ return NULL;+ endptr = l_str2dloc(s, result, mode); /* try to convert */+ if (endptr == NULL) { /* failed? may be a different locale */+ char buff[L_MAXLENNUM + 1];+ const char *pdot = strchr(s, '.');+ if (strlen(s) > L_MAXLENNUM || pdot == NULL)+ return NULL; /* string too long or no dot; fail */+ strcpy(buff, s); /* copy string to buffer */+ buff[pdot - s] = lua_getlocaledecpoint(); /* correct decimal point */+ endptr = l_str2dloc(buff, result, mode); /* try again */+ if (endptr != NULL)+ endptr = s + (endptr - buff); /* make relative to 's' */+ }+ return endptr;+}+++#define MAXBY10 cast(lua_Unsigned, LUA_MAXINTEGER / 10)+#define MAXLASTD cast_int(LUA_MAXINTEGER % 10)++static const char *l_str2int (const char *s, lua_Integer *result) {+ lua_Unsigned a = 0;+ int empty = 1;+ int neg;+ while (lisspace(cast_uchar(*s))) s++; /* skip initial spaces */+ neg = isneg(&s);+ if (s[0] == '0' &&+ (s[1] == 'x' || s[1] == 'X')) { /* hex? */+ s += 2; /* skip '0x' */+ for (; lisxdigit(cast_uchar(*s)); s++) {+ a = a * 16 + luaO_hexavalue(*s);+ empty = 0;+ }+ }+ else { /* decimal */+ for (; lisdigit(cast_uchar(*s)); s++) {+ int d = *s - '0';+ if (a >= MAXBY10 && (a > MAXBY10 || d > MAXLASTD + neg)) /* overflow? */+ return NULL; /* do not accept it (as integer) */+ a = a * 10 + d;+ empty = 0;+ }+ }+ while (lisspace(cast_uchar(*s))) s++; /* skip trailing spaces */+ if (empty || *s != '\0') return NULL; /* something wrong in the numeral */+ else {+ *result = l_castU2S((neg) ? 0u - a : a);+ return s;+ }+}+++size_t luaO_str2num (const char *s, TValue *o) {+ lua_Integer i; lua_Number n;+ const char *e;+ if ((e = l_str2int(s, &i)) != NULL) { /* try as an integer */+ setivalue(o, i);+ }+ else if ((e = l_str2d(s, &n)) != NULL) { /* else try as a float */+ setfltvalue(o, n);+ }+ else+ return 0; /* conversion failed */+ return (e - s) + 1; /* success; return string size */+}+++int luaO_utf8esc (char *buff, unsigned long x) {+ int n = 1; /* number of bytes put in buffer (backwards) */+ lua_assert(x <= 0x10FFFF);+ if (x < 0x80) /* ascii? */+ buff[UTF8BUFFSZ - 1] = cast(char, x);+ else { /* need continuation bytes */+ unsigned int mfb = 0x3f; /* maximum that fits in first byte */+ do { /* add continuation bytes */+ buff[UTF8BUFFSZ - (n++)] = cast(char, 0x80 | (x & 0x3f));+ x >>= 6; /* remove added bits */+ mfb >>= 1; /* now there is one less bit available in first byte */+ } while (x > mfb); /* still needs continuation byte? */+ buff[UTF8BUFFSZ - n] = cast(char, (~mfb << 1) | x); /* add first byte */+ }+ return n;+}+++/* maximum length of the conversion of a number to a string */+#define MAXNUMBER2STR 50+++/*+** Convert a number object to a string+*/+void luaO_tostring (lua_State *L, StkId obj) {+ char buff[MAXNUMBER2STR];+ size_t len;+ lua_assert(ttisnumber(obj));+ if (ttisinteger(obj))+ len = lua_integer2str(buff, sizeof(buff), ivalue(obj));+ else {+ len = lua_number2str(buff, sizeof(buff), fltvalue(obj));+#if !defined(LUA_COMPAT_FLOATSTRING)+ if (buff[strspn(buff, "-0123456789")] == '\0') { /* looks like an int? */+ buff[len++] = lua_getlocaledecpoint();+ buff[len++] = '0'; /* adds '.0' to result */+ }+#endif+ }+ setsvalue2s(L, obj, luaS_newlstr(L, buff, len));+}+++static void pushstr (lua_State *L, const char *str, size_t l) {+ setsvalue2s(L, L->top, luaS_newlstr(L, str, l));+ luaD_inctop(L);+}+++/*+** this function handles only '%d', '%c', '%f', '%p', and '%s'+ conventional formats, plus Lua-specific '%I' and '%U'+*/+const char *luaO_pushvfstring (lua_State *L, const char *fmt, va_list argp) {+ int n = 0;+ for (;;) {+ const char *e = strchr(fmt, '%');+ if (e == NULL) break;+ pushstr(L, fmt, e - fmt);+ switch (*(e+1)) {+ case 's': { /* zero-terminated string */+ const char *s = va_arg(argp, char *);+ if (s == NULL) s = "(null)";+ pushstr(L, s, strlen(s));+ break;+ }+ case 'c': { /* an 'int' as a character */+ char buff = cast(char, va_arg(argp, int));+ if (lisprint(cast_uchar(buff)))+ pushstr(L, &buff, 1);+ else /* non-printable character; print its code */+ luaO_pushfstring(L, "<\\%d>", cast_uchar(buff));+ break;+ }+ case 'd': { /* an 'int' */+ setivalue(L->top, va_arg(argp, int));+ goto top2str;+ }+ case 'I': { /* a 'lua_Integer' */+ setivalue(L->top, cast(lua_Integer, va_arg(argp, l_uacInt)));+ goto top2str;+ }+ case 'f': { /* a 'lua_Number' */+ setfltvalue(L->top, cast_num(va_arg(argp, l_uacNumber)));+ top2str: /* convert the top element to a string */+ luaD_inctop(L);+ luaO_tostring(L, L->top - 1);+ break;+ }+ case 'p': { /* a pointer */+ char buff[4*sizeof(void *) + 8]; /* should be enough space for a '%p' */+ void *p = va_arg(argp, void *);+ int l = lua_pointer2str(buff, sizeof(buff), p);+ pushstr(L, buff, l);+ break;+ }+ case 'U': { /* an 'int' as a UTF-8 sequence */+ char buff[UTF8BUFFSZ];+ int l = luaO_utf8esc(buff, cast(long, va_arg(argp, long)));+ pushstr(L, buff + UTF8BUFFSZ - l, l);+ break;+ }+ case '%': {+ pushstr(L, "%", 1);+ break;+ }+ default: {+ luaG_runerror(L, "invalid option '%%%c' to 'lua_pushfstring'",+ *(e + 1));+ }+ }+ n += 2;+ fmt = e+2;+ }+ luaD_checkstack(L, 1);+ pushstr(L, fmt, strlen(fmt));+ if (n > 0) luaV_concat(L, n + 1);+ return svalue(L->top - 1);+}+++const char *luaO_pushfstring (lua_State *L, const char *fmt, ...) {+ const char *msg;+ va_list argp;+ va_start(argp, fmt);+ msg = luaO_pushvfstring(L, fmt, argp);+ va_end(argp);+ return msg;+}+++/* number of chars of a literal string without the ending \0 */+#define LL(x) (sizeof(x)/sizeof(char) - 1)++#define RETS "..."+#define PRE "[string \""+#define POS "\"]"++#define addstr(a,b,l) ( memcpy(a,b,(l) * sizeof(char)), a += (l) )++void luaO_chunkid (char *out, const char *source, size_t bufflen) {+ size_t l = strlen(source);+ if (*source == '=') { /* 'literal' source */+ if (l <= bufflen) /* small enough? */+ memcpy(out, source + 1, l * sizeof(char));+ else { /* truncate it */+ addstr(out, source + 1, bufflen - 1);+ *out = '\0';+ }+ }+ else if (*source == '@') { /* file name */+ if (l <= bufflen) /* small enough? */+ memcpy(out, source + 1, l * sizeof(char));+ else { /* add '...' before rest of name */+ addstr(out, RETS, LL(RETS));+ bufflen -= LL(RETS);+ memcpy(out, source + 1 + l - bufflen, bufflen * sizeof(char));+ }+ }+ else { /* string; format as [string "source"] */+ const char *nl = strchr(source, '\n'); /* find first new line (if any) */+ addstr(out, PRE, LL(PRE)); /* add prefix */+ bufflen -= LL(PRE RETS POS) + 1; /* save space for prefix+suffix+'\0' */+ if (l < bufflen && nl == NULL) { /* small one-line source? */+ addstr(out, source, l); /* keep it */+ }+ else {+ if (nl != NULL) l = nl - source; /* stop at first newline */+ if (l > bufflen) l = bufflen;+ addstr(out, source, l);+ addstr(out, RETS, LL(RETS));+ }+ memcpy(out, POS, (LL(POS) + 1) * sizeof(char));+ }+}+
+ cbits/lua-5.3.6/lobject.h view
@@ -0,0 +1,549 @@+/*+** $Id: lobject.h,v 2.117.1.1 2017/04/19 17:39:34 roberto Exp $+** Type definitions for Lua objects+** See Copyright Notice in lua.h+*/+++#ifndef lobject_h+#define lobject_h+++#include <stdarg.h>+++#include "llimits.h"+#include "lua.h"+++/*+** Extra tags for non-values+*/+#define LUA_TPROTO LUA_NUMTAGS /* function prototypes */+#define LUA_TDEADKEY (LUA_NUMTAGS+1) /* removed keys in tables */++/*+** number of all possible tags (including LUA_TNONE but excluding DEADKEY)+*/+#define LUA_TOTALTAGS (LUA_TPROTO + 2)+++/*+** tags for Tagged Values have the following use of bits:+** bits 0-3: actual tag (a LUA_T* value)+** bits 4-5: variant bits+** bit 6: whether value is collectable+*/+++/*+** LUA_TFUNCTION variants:+** 0 - Lua function+** 1 - light C function+** 2 - regular C function (closure)+*/++/* Variant tags for functions */+#define LUA_TLCL (LUA_TFUNCTION | (0 << 4)) /* Lua closure */+#define LUA_TLCF (LUA_TFUNCTION | (1 << 4)) /* light C function */+#define LUA_TCCL (LUA_TFUNCTION | (2 << 4)) /* C closure */+++/* Variant tags for strings */+#define LUA_TSHRSTR (LUA_TSTRING | (0 << 4)) /* short strings */+#define LUA_TLNGSTR (LUA_TSTRING | (1 << 4)) /* long strings */+++/* Variant tags for numbers */+#define LUA_TNUMFLT (LUA_TNUMBER | (0 << 4)) /* float numbers */+#define LUA_TNUMINT (LUA_TNUMBER | (1 << 4)) /* integer numbers */+++/* Bit mark for collectable types */+#define BIT_ISCOLLECTABLE (1 << 6)++/* mark a tag as collectable */+#define ctb(t) ((t) | BIT_ISCOLLECTABLE)+++/*+** Common type for all collectable objects+*/+typedef struct GCObject GCObject;+++/*+** Common Header for all collectable objects (in macro form, to be+** included in other objects)+*/+#define CommonHeader GCObject *next; lu_byte tt; lu_byte marked+++/*+** Common type has only the common header+*/+struct GCObject {+ CommonHeader;+};+++++/*+** Tagged Values. This is the basic representation of values in Lua,+** an actual value plus a tag with its type.+*/++/*+** Union of all Lua values+*/+typedef union Value {+ GCObject *gc; /* collectable objects */+ void *p; /* light userdata */+ int b; /* booleans */+ lua_CFunction f; /* light C functions */+ lua_Integer i; /* integer numbers */+ lua_Number n; /* float numbers */+} Value;+++#define TValuefields Value value_; int tt_+++typedef struct lua_TValue {+ TValuefields;+} TValue;++++/* macro defining a nil value */+#define NILCONSTANT {NULL}, LUA_TNIL+++#define val_(o) ((o)->value_)+++/* raw type tag of a TValue */+#define rttype(o) ((o)->tt_)++/* tag with no variants (bits 0-3) */+#define novariant(x) ((x) & 0x0F)++/* type tag of a TValue (bits 0-3 for tags + variant bits 4-5) */+#define ttype(o) (rttype(o) & 0x3F)++/* type tag of a TValue with no variants (bits 0-3) */+#define ttnov(o) (novariant(rttype(o)))+++/* Macros to test type */+#define checktag(o,t) (rttype(o) == (t))+#define checktype(o,t) (ttnov(o) == (t))+#define ttisnumber(o) checktype((o), LUA_TNUMBER)+#define ttisfloat(o) checktag((o), LUA_TNUMFLT)+#define ttisinteger(o) checktag((o), LUA_TNUMINT)+#define ttisnil(o) checktag((o), LUA_TNIL)+#define ttisboolean(o) checktag((o), LUA_TBOOLEAN)+#define ttislightuserdata(o) checktag((o), LUA_TLIGHTUSERDATA)+#define ttisstring(o) checktype((o), LUA_TSTRING)+#define ttisshrstring(o) checktag((o), ctb(LUA_TSHRSTR))+#define ttislngstring(o) checktag((o), ctb(LUA_TLNGSTR))+#define ttistable(o) checktag((o), ctb(LUA_TTABLE))+#define ttisfunction(o) checktype(o, LUA_TFUNCTION)+#define ttisclosure(o) ((rttype(o) & 0x1F) == LUA_TFUNCTION)+#define ttisCclosure(o) checktag((o), ctb(LUA_TCCL))+#define ttisLclosure(o) checktag((o), ctb(LUA_TLCL))+#define ttislcf(o) checktag((o), LUA_TLCF)+#define ttisfulluserdata(o) checktag((o), ctb(LUA_TUSERDATA))+#define ttisthread(o) checktag((o), ctb(LUA_TTHREAD))+#define ttisdeadkey(o) checktag((o), LUA_TDEADKEY)+++/* Macros to access values */+#define ivalue(o) check_exp(ttisinteger(o), val_(o).i)+#define fltvalue(o) check_exp(ttisfloat(o), val_(o).n)+#define nvalue(o) check_exp(ttisnumber(o), \+ (ttisinteger(o) ? cast_num(ivalue(o)) : fltvalue(o)))+#define gcvalue(o) check_exp(iscollectable(o), val_(o).gc)+#define pvalue(o) check_exp(ttislightuserdata(o), val_(o).p)+#define tsvalue(o) check_exp(ttisstring(o), gco2ts(val_(o).gc))+#define uvalue(o) check_exp(ttisfulluserdata(o), gco2u(val_(o).gc))+#define clvalue(o) check_exp(ttisclosure(o), gco2cl(val_(o).gc))+#define clLvalue(o) check_exp(ttisLclosure(o), gco2lcl(val_(o).gc))+#define clCvalue(o) check_exp(ttisCclosure(o), gco2ccl(val_(o).gc))+#define fvalue(o) check_exp(ttislcf(o), val_(o).f)+#define hvalue(o) check_exp(ttistable(o), gco2t(val_(o).gc))+#define bvalue(o) check_exp(ttisboolean(o), val_(o).b)+#define thvalue(o) check_exp(ttisthread(o), gco2th(val_(o).gc))+/* a dead value may get the 'gc' field, but cannot access its contents */+#define deadvalue(o) check_exp(ttisdeadkey(o), cast(void *, val_(o).gc))++#define l_isfalse(o) (ttisnil(o) || (ttisboolean(o) && bvalue(o) == 0))+++#define iscollectable(o) (rttype(o) & BIT_ISCOLLECTABLE)+++/* Macros for internal tests */+#define righttt(obj) (ttype(obj) == gcvalue(obj)->tt)++#define checkliveness(L,obj) \+ lua_longassert(!iscollectable(obj) || \+ (righttt(obj) && (L == NULL || !isdead(G(L),gcvalue(obj)))))+++/* Macros to set values */+#define settt_(o,t) ((o)->tt_=(t))++#define setfltvalue(obj,x) \+ { TValue *io=(obj); val_(io).n=(x); settt_(io, LUA_TNUMFLT); }++#define chgfltvalue(obj,x) \+ { TValue *io=(obj); lua_assert(ttisfloat(io)); val_(io).n=(x); }++#define setivalue(obj,x) \+ { TValue *io=(obj); val_(io).i=(x); settt_(io, LUA_TNUMINT); }++#define chgivalue(obj,x) \+ { TValue *io=(obj); lua_assert(ttisinteger(io)); val_(io).i=(x); }++#define setnilvalue(obj) settt_(obj, LUA_TNIL)++#define setfvalue(obj,x) \+ { TValue *io=(obj); val_(io).f=(x); settt_(io, LUA_TLCF); }++#define setpvalue(obj,x) \+ { TValue *io=(obj); val_(io).p=(x); settt_(io, LUA_TLIGHTUSERDATA); }++#define setbvalue(obj,x) \+ { TValue *io=(obj); val_(io).b=(x); settt_(io, LUA_TBOOLEAN); }++#define setgcovalue(L,obj,x) \+ { TValue *io = (obj); GCObject *i_g=(x); \+ val_(io).gc = i_g; settt_(io, ctb(i_g->tt)); }++#define setsvalue(L,obj,x) \+ { TValue *io = (obj); TString *x_ = (x); \+ val_(io).gc = obj2gco(x_); settt_(io, ctb(x_->tt)); \+ checkliveness(L,io); }++#define setuvalue(L,obj,x) \+ { TValue *io = (obj); Udata *x_ = (x); \+ val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_TUSERDATA)); \+ checkliveness(L,io); }++#define setthvalue(L,obj,x) \+ { TValue *io = (obj); lua_State *x_ = (x); \+ val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_TTHREAD)); \+ checkliveness(L,io); }++#define setclLvalue(L,obj,x) \+ { TValue *io = (obj); LClosure *x_ = (x); \+ val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_TLCL)); \+ checkliveness(L,io); }++#define setclCvalue(L,obj,x) \+ { TValue *io = (obj); CClosure *x_ = (x); \+ val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_TCCL)); \+ checkliveness(L,io); }++#define sethvalue(L,obj,x) \+ { TValue *io = (obj); Table *x_ = (x); \+ val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_TTABLE)); \+ checkliveness(L,io); }++#define setdeadvalue(obj) settt_(obj, LUA_TDEADKEY)++++#define setobj(L,obj1,obj2) \+ { TValue *io1=(obj1); *io1 = *(obj2); \+ (void)L; checkliveness(L,io1); }+++/*+** different types of assignments, according to destination+*/++/* from stack to (same) stack */+#define setobjs2s setobj+/* to stack (not from same stack) */+#define setobj2s setobj+#define setsvalue2s setsvalue+#define sethvalue2s sethvalue+#define setptvalue2s setptvalue+/* from table to same table */+#define setobjt2t setobj+/* to new object */+#define setobj2n setobj+#define setsvalue2n setsvalue++/* to table (define it as an expression to be used in macros) */+#define setobj2t(L,o1,o2) ((void)L, *(o1)=*(o2), checkliveness(L,(o1)))+++++/*+** {======================================================+** types and prototypes+** =======================================================+*/+++typedef TValue *StkId; /* index to stack elements */+++++/*+** Header for string value; string bytes follow the end of this structure+** (aligned according to 'UTString'; see next).+*/+typedef struct TString {+ CommonHeader;+ lu_byte extra; /* reserved words for short strings; "has hash" for longs */+ lu_byte shrlen; /* length for short strings */+ unsigned int hash;+ union {+ size_t lnglen; /* length for long strings */+ struct TString *hnext; /* linked list for hash table */+ } u;+} TString;+++/*+** Ensures that address after this type is always fully aligned.+*/+typedef union UTString {+ L_Umaxalign dummy; /* ensures maximum alignment for strings */+ TString tsv;+} UTString;+++/*+** Get the actual string (array of bytes) from a 'TString'.+** (Access to 'extra' ensures that value is really a 'TString'.)+*/+#define getstr(ts) \+ check_exp(sizeof((ts)->extra), cast(char *, (ts)) + sizeof(UTString))+++/* get the actual string (array of bytes) from a Lua value */+#define svalue(o) getstr(tsvalue(o))++/* get string length from 'TString *s' */+#define tsslen(s) ((s)->tt == LUA_TSHRSTR ? (s)->shrlen : (s)->u.lnglen)++/* get string length from 'TValue *o' */+#define vslen(o) tsslen(tsvalue(o))+++/*+** Header for userdata; memory area follows the end of this structure+** (aligned according to 'UUdata'; see next).+*/+typedef struct Udata {+ CommonHeader;+ lu_byte ttuv_; /* user value's tag */+ struct Table *metatable;+ size_t len; /* number of bytes */+ union Value user_; /* user value */+} Udata;+++/*+** Ensures that address after this type is always fully aligned.+*/+typedef union UUdata {+ L_Umaxalign dummy; /* ensures maximum alignment for 'local' udata */+ Udata uv;+} UUdata;+++/*+** Get the address of memory block inside 'Udata'.+** (Access to 'ttuv_' ensures that value is really a 'Udata'.)+*/+#define getudatamem(u) \+ check_exp(sizeof((u)->ttuv_), (cast(char*, (u)) + sizeof(UUdata)))++#define setuservalue(L,u,o) \+ { const TValue *io=(o); Udata *iu = (u); \+ iu->user_ = io->value_; iu->ttuv_ = rttype(io); \+ checkliveness(L,io); }+++#define getuservalue(L,u,o) \+ { TValue *io=(o); const Udata *iu = (u); \+ io->value_ = iu->user_; settt_(io, iu->ttuv_); \+ checkliveness(L,io); }+++/*+** Description of an upvalue for function prototypes+*/+typedef struct Upvaldesc {+ TString *name; /* upvalue name (for debug information) */+ lu_byte instack; /* whether it is in stack (register) */+ lu_byte idx; /* index of upvalue (in stack or in outer function's list) */+} Upvaldesc;+++/*+** Description of a local variable for function prototypes+** (used for debug information)+*/+typedef struct LocVar {+ TString *varname;+ int startpc; /* first point where variable is active */+ int endpc; /* first point where variable is dead */+} LocVar;+++/*+** Function Prototypes+*/+typedef struct Proto {+ CommonHeader;+ lu_byte numparams; /* number of fixed parameters */+ lu_byte is_vararg;+ lu_byte maxstacksize; /* number of registers needed by this function */+ int sizeupvalues; /* size of 'upvalues' */+ int sizek; /* size of 'k' */+ int sizecode;+ int sizelineinfo;+ int sizep; /* size of 'p' */+ int sizelocvars;+ int linedefined; /* debug information */+ int lastlinedefined; /* debug information */+ TValue *k; /* constants used by the function */+ Instruction *code; /* opcodes */+ struct Proto **p; /* functions defined inside the function */+ int *lineinfo; /* map from opcodes to source lines (debug information) */+ LocVar *locvars; /* information about local variables (debug information) */+ Upvaldesc *upvalues; /* upvalue information */+ struct LClosure *cache; /* last-created closure with this prototype */+ TString *source; /* used for debug information */+ GCObject *gclist;+} Proto;++++/*+** Lua Upvalues+*/+typedef struct UpVal UpVal;+++/*+** Closures+*/++#define ClosureHeader \+ CommonHeader; lu_byte nupvalues; GCObject *gclist++typedef struct CClosure {+ ClosureHeader;+ lua_CFunction f;+ TValue upvalue[1]; /* list of upvalues */+} CClosure;+++typedef struct LClosure {+ ClosureHeader;+ struct Proto *p;+ UpVal *upvals[1]; /* list of upvalues */+} LClosure;+++typedef union Closure {+ CClosure c;+ LClosure l;+} Closure;+++#define isLfunction(o) ttisLclosure(o)++#define getproto(o) (clLvalue(o)->p)+++/*+** Tables+*/++typedef union TKey {+ struct {+ TValuefields;+ int next; /* for chaining (offset for next node) */+ } nk;+ TValue tvk;+} TKey;+++/* copy a value into a key without messing up field 'next' */+#define setnodekey(L,key,obj) \+ { TKey *k_=(key); const TValue *io_=(obj); \+ k_->nk.value_ = io_->value_; k_->nk.tt_ = io_->tt_; \+ (void)L; checkliveness(L,io_); }+++typedef struct Node {+ TValue i_val;+ TKey i_key;+} Node;+++typedef struct Table {+ CommonHeader;+ lu_byte flags; /* 1<<p means tagmethod(p) is not present */+ lu_byte lsizenode; /* log2 of size of 'node' array */+ unsigned int sizearray; /* size of 'array' array */+ TValue *array; /* array part */+ Node *node;+ Node *lastfree; /* any free position is before this position */+ struct Table *metatable;+ GCObject *gclist;+} Table;++++/*+** 'module' operation for hashing (size is always a power of 2)+*/+#define lmod(s,size) \+ (check_exp((size&(size-1))==0, (cast(int, (s) & ((size)-1)))))+++#define twoto(x) (1<<(x))+#define sizenode(t) (twoto((t)->lsizenode))+++/*+** (address of) a fixed nil value+*/+#define luaO_nilobject (&luaO_nilobject_)+++LUAI_DDEC const TValue luaO_nilobject_;++/* size of buffer for 'luaO_utf8esc' function */+#define UTF8BUFFSZ 8++LUAI_FUNC int luaO_int2fb (unsigned int x);+LUAI_FUNC int luaO_fb2int (int x);+LUAI_FUNC int luaO_utf8esc (char *buff, unsigned long x);+LUAI_FUNC int luaO_ceillog2 (unsigned int x);+LUAI_FUNC void luaO_arith (lua_State *L, int op, const TValue *p1,+ const TValue *p2, TValue *res);+LUAI_FUNC size_t luaO_str2num (const char *s, TValue *o);+LUAI_FUNC int luaO_hexavalue (int c);+LUAI_FUNC void luaO_tostring (lua_State *L, StkId obj);+LUAI_FUNC const char *luaO_pushvfstring (lua_State *L, const char *fmt,+ va_list argp);+LUAI_FUNC const char *luaO_pushfstring (lua_State *L, const char *fmt, ...);+LUAI_FUNC void luaO_chunkid (char *out, const char *source, size_t len);+++#endif+
+ cbits/lua-5.3.6/lopcodes.c view
@@ -0,0 +1,124 @@+/*+** $Id: lopcodes.c,v 1.55.1.1 2017/04/19 17:20:42 roberto Exp $+** Opcodes for Lua virtual machine+** See Copyright Notice in lua.h+*/++#define lopcodes_c+#define LUA_CORE++#include "lprefix.h"+++#include <stddef.h>++#include "lopcodes.h"+++/* ORDER OP */++LUAI_DDEF const char *const luaP_opnames[NUM_OPCODES+1] = {+ "MOVE",+ "LOADK",+ "LOADKX",+ "LOADBOOL",+ "LOADNIL",+ "GETUPVAL",+ "GETTABUP",+ "GETTABLE",+ "SETTABUP",+ "SETUPVAL",+ "SETTABLE",+ "NEWTABLE",+ "SELF",+ "ADD",+ "SUB",+ "MUL",+ "MOD",+ "POW",+ "DIV",+ "IDIV",+ "BAND",+ "BOR",+ "BXOR",+ "SHL",+ "SHR",+ "UNM",+ "BNOT",+ "NOT",+ "LEN",+ "CONCAT",+ "JMP",+ "EQ",+ "LT",+ "LE",+ "TEST",+ "TESTSET",+ "CALL",+ "TAILCALL",+ "RETURN",+ "FORLOOP",+ "FORPREP",+ "TFORCALL",+ "TFORLOOP",+ "SETLIST",+ "CLOSURE",+ "VARARG",+ "EXTRAARG",+ NULL+};+++#define opmode(t,a,b,c,m) (((t)<<7) | ((a)<<6) | ((b)<<4) | ((c)<<2) | (m))++LUAI_DDEF const lu_byte luaP_opmodes[NUM_OPCODES] = {+/* T A B C mode opcode */+ opmode(0, 1, OpArgR, OpArgN, iABC) /* OP_MOVE */+ ,opmode(0, 1, OpArgK, OpArgN, iABx) /* OP_LOADK */+ ,opmode(0, 1, OpArgN, OpArgN, iABx) /* OP_LOADKX */+ ,opmode(0, 1, OpArgU, OpArgU, iABC) /* OP_LOADBOOL */+ ,opmode(0, 1, OpArgU, OpArgN, iABC) /* OP_LOADNIL */+ ,opmode(0, 1, OpArgU, OpArgN, iABC) /* OP_GETUPVAL */+ ,opmode(0, 1, OpArgU, OpArgK, iABC) /* OP_GETTABUP */+ ,opmode(0, 1, OpArgR, OpArgK, iABC) /* OP_GETTABLE */+ ,opmode(0, 0, OpArgK, OpArgK, iABC) /* OP_SETTABUP */+ ,opmode(0, 0, OpArgU, OpArgN, iABC) /* OP_SETUPVAL */+ ,opmode(0, 0, OpArgK, OpArgK, iABC) /* OP_SETTABLE */+ ,opmode(0, 1, OpArgU, OpArgU, iABC) /* OP_NEWTABLE */+ ,opmode(0, 1, OpArgR, OpArgK, iABC) /* OP_SELF */+ ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_ADD */+ ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_SUB */+ ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_MUL */+ ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_MOD */+ ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_POW */+ ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_DIV */+ ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_IDIV */+ ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_BAND */+ ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_BOR */+ ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_BXOR */+ ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_SHL */+ ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_SHR */+ ,opmode(0, 1, OpArgR, OpArgN, iABC) /* OP_UNM */+ ,opmode(0, 1, OpArgR, OpArgN, iABC) /* OP_BNOT */+ ,opmode(0, 1, OpArgR, OpArgN, iABC) /* OP_NOT */+ ,opmode(0, 1, OpArgR, OpArgN, iABC) /* OP_LEN */+ ,opmode(0, 1, OpArgR, OpArgR, iABC) /* OP_CONCAT */+ ,opmode(0, 0, OpArgR, OpArgN, iAsBx) /* OP_JMP */+ ,opmode(1, 0, OpArgK, OpArgK, iABC) /* OP_EQ */+ ,opmode(1, 0, OpArgK, OpArgK, iABC) /* OP_LT */+ ,opmode(1, 0, OpArgK, OpArgK, iABC) /* OP_LE */+ ,opmode(1, 0, OpArgN, OpArgU, iABC) /* OP_TEST */+ ,opmode(1, 1, OpArgR, OpArgU, iABC) /* OP_TESTSET */+ ,opmode(0, 1, OpArgU, OpArgU, iABC) /* OP_CALL */+ ,opmode(0, 1, OpArgU, OpArgU, iABC) /* OP_TAILCALL */+ ,opmode(0, 0, OpArgU, OpArgN, iABC) /* OP_RETURN */+ ,opmode(0, 1, OpArgR, OpArgN, iAsBx) /* OP_FORLOOP */+ ,opmode(0, 1, OpArgR, OpArgN, iAsBx) /* OP_FORPREP */+ ,opmode(0, 0, OpArgN, OpArgU, iABC) /* OP_TFORCALL */+ ,opmode(0, 1, OpArgR, OpArgN, iAsBx) /* OP_TFORLOOP */+ ,opmode(0, 0, OpArgU, OpArgU, iABC) /* OP_SETLIST */+ ,opmode(0, 1, OpArgU, OpArgN, iABx) /* OP_CLOSURE */+ ,opmode(0, 1, OpArgU, OpArgN, iABC) /* OP_VARARG */+ ,opmode(0, 0, OpArgU, OpArgU, iAx) /* OP_EXTRAARG */+};+
+ cbits/lua-5.3.6/lopcodes.h view
@@ -0,0 +1,297 @@+/*+** $Id: lopcodes.h,v 1.149.1.1 2017/04/19 17:20:42 roberto Exp $+** Opcodes for Lua virtual machine+** See Copyright Notice in lua.h+*/++#ifndef lopcodes_h+#define lopcodes_h++#include "llimits.h"+++/*===========================================================================+ We assume that instructions are unsigned numbers.+ All instructions have an opcode in the first 6 bits.+ Instructions can have the following fields:+ 'A' : 8 bits+ 'B' : 9 bits+ 'C' : 9 bits+ 'Ax' : 26 bits ('A', 'B', and 'C' together)+ 'Bx' : 18 bits ('B' and 'C' together)+ 'sBx' : signed Bx++ A signed argument is represented in excess K; that is, the number+ value is the unsigned value minus K. K is exactly the maximum value+ for that argument (so that -max is represented by 0, and +max is+ represented by 2*max), which is half the maximum for the corresponding+ unsigned argument.+===========================================================================*/+++enum OpMode {iABC, iABx, iAsBx, iAx}; /* basic instruction format */+++/*+** size and position of opcode arguments.+*/+#define SIZE_C 9+#define SIZE_B 9+#define SIZE_Bx (SIZE_C + SIZE_B)+#define SIZE_A 8+#define SIZE_Ax (SIZE_C + SIZE_B + SIZE_A)++#define SIZE_OP 6++#define POS_OP 0+#define POS_A (POS_OP + SIZE_OP)+#define POS_C (POS_A + SIZE_A)+#define POS_B (POS_C + SIZE_C)+#define POS_Bx POS_C+#define POS_Ax POS_A+++/*+** limits for opcode arguments.+** we use (signed) int to manipulate most arguments,+** so they must fit in LUAI_BITSINT-1 bits (-1 for sign)+*/+#if SIZE_Bx < LUAI_BITSINT-1+#define MAXARG_Bx ((1<<SIZE_Bx)-1)+#define MAXARG_sBx (MAXARG_Bx>>1) /* 'sBx' is signed */+#else+#define MAXARG_Bx MAX_INT+#define MAXARG_sBx MAX_INT+#endif++#if SIZE_Ax < LUAI_BITSINT-1+#define MAXARG_Ax ((1<<SIZE_Ax)-1)+#else+#define MAXARG_Ax MAX_INT+#endif+++#define MAXARG_A ((1<<SIZE_A)-1)+#define MAXARG_B ((1<<SIZE_B)-1)+#define MAXARG_C ((1<<SIZE_C)-1)+++/* creates a mask with 'n' 1 bits at position 'p' */+#define MASK1(n,p) ((~((~(Instruction)0)<<(n)))<<(p))++/* creates a mask with 'n' 0 bits at position 'p' */+#define MASK0(n,p) (~MASK1(n,p))++/*+** the following macros help to manipulate instructions+*/++#define GET_OPCODE(i) (cast(OpCode, ((i)>>POS_OP) & MASK1(SIZE_OP,0)))+#define SET_OPCODE(i,o) ((i) = (((i)&MASK0(SIZE_OP,POS_OP)) | \+ ((cast(Instruction, o)<<POS_OP)&MASK1(SIZE_OP,POS_OP))))++#define getarg(i,pos,size) (cast(int, ((i)>>pos) & MASK1(size,0)))+#define setarg(i,v,pos,size) ((i) = (((i)&MASK0(size,pos)) | \+ ((cast(Instruction, v)<<pos)&MASK1(size,pos))))++#define GETARG_A(i) getarg(i, POS_A, SIZE_A)+#define SETARG_A(i,v) setarg(i, v, POS_A, SIZE_A)++#define GETARG_B(i) getarg(i, POS_B, SIZE_B)+#define SETARG_B(i,v) setarg(i, v, POS_B, SIZE_B)++#define GETARG_C(i) getarg(i, POS_C, SIZE_C)+#define SETARG_C(i,v) setarg(i, v, POS_C, SIZE_C)++#define GETARG_Bx(i) getarg(i, POS_Bx, SIZE_Bx)+#define SETARG_Bx(i,v) setarg(i, v, POS_Bx, SIZE_Bx)++#define GETARG_Ax(i) getarg(i, POS_Ax, SIZE_Ax)+#define SETARG_Ax(i,v) setarg(i, v, POS_Ax, SIZE_Ax)++#define GETARG_sBx(i) (GETARG_Bx(i)-MAXARG_sBx)+#define SETARG_sBx(i,b) SETARG_Bx((i),cast(unsigned int, (b)+MAXARG_sBx))+++#define CREATE_ABC(o,a,b,c) ((cast(Instruction, o)<<POS_OP) \+ | (cast(Instruction, a)<<POS_A) \+ | (cast(Instruction, b)<<POS_B) \+ | (cast(Instruction, c)<<POS_C))++#define CREATE_ABx(o,a,bc) ((cast(Instruction, o)<<POS_OP) \+ | (cast(Instruction, a)<<POS_A) \+ | (cast(Instruction, bc)<<POS_Bx))++#define CREATE_Ax(o,a) ((cast(Instruction, o)<<POS_OP) \+ | (cast(Instruction, a)<<POS_Ax))+++/*+** Macros to operate RK indices+*/++/* this bit 1 means constant (0 means register) */+#define BITRK (1 << (SIZE_B - 1))++/* test whether value is a constant */+#define ISK(x) ((x) & BITRK)++/* gets the index of the constant */+#define INDEXK(r) ((int)(r) & ~BITRK)++#if !defined(MAXINDEXRK) /* (for debugging only) */+#define MAXINDEXRK (BITRK - 1)+#endif++/* code a constant index as a RK value */+#define RKASK(x) ((x) | BITRK)+++/*+** invalid register that fits in 8 bits+*/+#define NO_REG MAXARG_A+++/*+** R(x) - register+** Kst(x) - constant (in constant table)+** RK(x) == if ISK(x) then Kst(INDEXK(x)) else R(x)+*/+++/*+** grep "ORDER OP" if you change these enums+*/++typedef enum {+/*----------------------------------------------------------------------+name args description+------------------------------------------------------------------------*/+OP_MOVE,/* A B R(A) := R(B) */+OP_LOADK,/* A Bx R(A) := Kst(Bx) */+OP_LOADKX,/* A R(A) := Kst(extra arg) */+OP_LOADBOOL,/* A B C R(A) := (Bool)B; if (C) pc++ */+OP_LOADNIL,/* A B R(A), R(A+1), ..., R(A+B) := nil */+OP_GETUPVAL,/* A B R(A) := UpValue[B] */++OP_GETTABUP,/* A B C R(A) := UpValue[B][RK(C)] */+OP_GETTABLE,/* A B C R(A) := R(B)[RK(C)] */++OP_SETTABUP,/* A B C UpValue[A][RK(B)] := RK(C) */+OP_SETUPVAL,/* A B UpValue[B] := R(A) */+OP_SETTABLE,/* A B C R(A)[RK(B)] := RK(C) */++OP_NEWTABLE,/* A B C R(A) := {} (size = B,C) */++OP_SELF,/* A B C R(A+1) := R(B); R(A) := R(B)[RK(C)] */++OP_ADD,/* A B C R(A) := RK(B) + RK(C) */+OP_SUB,/* A B C R(A) := RK(B) - RK(C) */+OP_MUL,/* A B C R(A) := RK(B) * RK(C) */+OP_MOD,/* A B C R(A) := RK(B) % RK(C) */+OP_POW,/* A B C R(A) := RK(B) ^ RK(C) */+OP_DIV,/* A B C R(A) := RK(B) / RK(C) */+OP_IDIV,/* A B C R(A) := RK(B) // RK(C) */+OP_BAND,/* A B C R(A) := RK(B) & RK(C) */+OP_BOR,/* A B C R(A) := RK(B) | RK(C) */+OP_BXOR,/* A B C R(A) := RK(B) ~ RK(C) */+OP_SHL,/* A B C R(A) := RK(B) << RK(C) */+OP_SHR,/* A B C R(A) := RK(B) >> RK(C) */+OP_UNM,/* A B R(A) := -R(B) */+OP_BNOT,/* A B R(A) := ~R(B) */+OP_NOT,/* A B R(A) := not R(B) */+OP_LEN,/* A B R(A) := length of R(B) */++OP_CONCAT,/* A B C R(A) := R(B).. ... ..R(C) */++OP_JMP,/* A sBx pc+=sBx; if (A) close all upvalues >= R(A - 1) */+OP_EQ,/* A B C if ((RK(B) == RK(C)) ~= A) then pc++ */+OP_LT,/* A B C if ((RK(B) < RK(C)) ~= A) then pc++ */+OP_LE,/* A B C if ((RK(B) <= RK(C)) ~= A) then pc++ */++OP_TEST,/* A C if not (R(A) <=> C) then pc++ */+OP_TESTSET,/* A B C if (R(B) <=> C) then R(A) := R(B) else pc++ */++OP_CALL,/* A B C R(A), ... ,R(A+C-2) := R(A)(R(A+1), ... ,R(A+B-1)) */+OP_TAILCALL,/* A B C return R(A)(R(A+1), ... ,R(A+B-1)) */+OP_RETURN,/* A B return R(A), ... ,R(A+B-2) (see note) */++OP_FORLOOP,/* A sBx R(A)+=R(A+2);+ if R(A) <?= R(A+1) then { pc+=sBx; R(A+3)=R(A) }*/+OP_FORPREP,/* A sBx R(A)-=R(A+2); pc+=sBx */++OP_TFORCALL,/* A C R(A+3), ... ,R(A+2+C) := R(A)(R(A+1), R(A+2)); */+OP_TFORLOOP,/* A sBx if R(A+1) ~= nil then { R(A)=R(A+1); pc += sBx }*/++OP_SETLIST,/* A B C R(A)[(C-1)*FPF+i] := R(A+i), 1 <= i <= B */++OP_CLOSURE,/* A Bx R(A) := closure(KPROTO[Bx]) */++OP_VARARG,/* A B R(A), R(A+1), ..., R(A+B-2) = vararg */++OP_EXTRAARG/* Ax extra (larger) argument for previous opcode */+} OpCode;+++#define NUM_OPCODES (cast(int, OP_EXTRAARG) + 1)++++/*===========================================================================+ Notes:+ (*) In OP_CALL, if (B == 0) then B = top. If (C == 0), then 'top' is+ set to last_result+1, so next open instruction (OP_CALL, OP_RETURN,+ OP_SETLIST) may use 'top'.++ (*) In OP_VARARG, if (B == 0) then use actual number of varargs and+ set top (like in OP_CALL with C == 0).++ (*) In OP_RETURN, if (B == 0) then return up to 'top'.++ (*) In OP_SETLIST, if (B == 0) then B = 'top'; if (C == 0) then next+ 'instruction' is EXTRAARG(real C).++ (*) In OP_LOADKX, the next 'instruction' is always EXTRAARG.++ (*) For comparisons, A specifies what condition the test should accept+ (true or false).++ (*) All 'skips' (pc++) assume that next instruction is a jump.++===========================================================================*/+++/*+** masks for instruction properties. The format is:+** bits 0-1: op mode+** bits 2-3: C arg mode+** bits 4-5: B arg mode+** bit 6: instruction set register A+** bit 7: operator is a test (next instruction must be a jump)+*/++enum OpArgMask {+ OpArgN, /* argument is not used */+ OpArgU, /* argument is used */+ OpArgR, /* argument is a register or a jump offset */+ OpArgK /* argument is a constant or register/constant */+};++LUAI_DDEC const lu_byte luaP_opmodes[NUM_OPCODES];++#define getOpMode(m) (cast(enum OpMode, luaP_opmodes[m] & 3))+#define getBMode(m) (cast(enum OpArgMask, (luaP_opmodes[m] >> 4) & 3))+#define getCMode(m) (cast(enum OpArgMask, (luaP_opmodes[m] >> 2) & 3))+#define testAMode(m) (luaP_opmodes[m] & (1 << 6))+#define testTMode(m) (luaP_opmodes[m] & (1 << 7))+++LUAI_DDEC const char *const luaP_opnames[NUM_OPCODES+1]; /* opcode names */+++/* number of list items to accumulate before a SETLIST instruction */+#define LFIELDS_PER_FLUSH 50+++#endif
+ cbits/lua-5.3.6/loslib.c view
@@ -0,0 +1,409 @@+/*+** $Id: loslib.c,v 1.65.1.1 2017/04/19 17:29:57 roberto Exp $+** Standard Operating System library+** See Copyright Notice in lua.h+*/++#define loslib_c+#define LUA_LIB++#include "lprefix.h"+++#include <errno.h>+#include <locale.h>+#include <stdlib.h>+#include <string.h>+#include <time.h>++#include "lua.h"++#include "lauxlib.h"+#include "lualib.h"+++/*+** {==================================================================+** List of valid conversion specifiers for the 'strftime' function;+** options are grouped by length; group of length 2 start with '||'.+** ===================================================================+*/+#if !defined(LUA_STRFTIMEOPTIONS) /* { */++/* options for ANSI C 89 (only 1-char options) */+#define L_STRFTIMEC89 "aAbBcdHIjmMpSUwWxXyYZ%"++/* options for ISO C 99 and POSIX */+#define L_STRFTIMEC99 "aAbBcCdDeFgGhHIjmMnprRStTuUVwWxXyYzZ%" \+ "||" "EcECExEXEyEY" "OdOeOHOIOmOMOSOuOUOVOwOWOy" /* two-char options */++/* options for Windows */+#define L_STRFTIMEWIN "aAbBcdHIjmMpSUwWxXyYzZ%" \+ "||" "#c#x#d#H#I#j#m#M#S#U#w#W#y#Y" /* two-char options */++#if defined(LUA_USE_WINDOWS)+#define LUA_STRFTIMEOPTIONS L_STRFTIMEWIN+#elif defined(LUA_USE_C89)+#define LUA_STRFTIMEOPTIONS L_STRFTIMEC89+#else /* C99 specification */+#define LUA_STRFTIMEOPTIONS L_STRFTIMEC99+#endif++#endif /* } */+/* }================================================================== */+++/*+** {==================================================================+** Configuration for time-related stuff+** ===================================================================+*/++#if !defined(l_time_t) /* { */+/*+** type to represent time_t in Lua+*/+#define l_timet lua_Integer+#define l_pushtime(L,t) lua_pushinteger(L,(lua_Integer)(t))++static time_t l_checktime (lua_State *L, int arg) {+ lua_Integer t = luaL_checkinteger(L, arg);+ luaL_argcheck(L, (time_t)t == t, arg, "time out-of-bounds");+ return (time_t)t;+}++#endif /* } */+++#if !defined(l_gmtime) /* { */+/*+** By default, Lua uses gmtime/localtime, except when POSIX is available,+** where it uses gmtime_r/localtime_r+*/++#if defined(LUA_USE_POSIX) /* { */++#define l_gmtime(t,r) gmtime_r(t,r)+#define l_localtime(t,r) localtime_r(t,r)++#else /* }{ */++/* ISO C definitions */+#define l_gmtime(t,r) ((void)(r)->tm_sec, gmtime(t))+#define l_localtime(t,r) ((void)(r)->tm_sec, localtime(t))++#endif /* } */++#endif /* } */++/* }================================================================== */+++/*+** {==================================================================+** Configuration for 'tmpnam':+** By default, Lua uses tmpnam except when POSIX is available, where+** it uses mkstemp.+** ===================================================================+*/+#if !defined(lua_tmpnam) /* { */++#if defined(LUA_USE_POSIX) /* { */++#include <unistd.h>++#define LUA_TMPNAMBUFSIZE 32++#if !defined(LUA_TMPNAMTEMPLATE)+#define LUA_TMPNAMTEMPLATE "/tmp/lua_XXXXXX"+#endif++#define lua_tmpnam(b,e) { \+ strcpy(b, LUA_TMPNAMTEMPLATE); \+ e = mkstemp(b); \+ if (e != -1) close(e); \+ e = (e == -1); }++#else /* }{ */++/* ISO C definitions */+#define LUA_TMPNAMBUFSIZE L_tmpnam+#define lua_tmpnam(b,e) { e = (tmpnam(b) == NULL); }++#endif /* } */++#endif /* } */+/* }================================================================== */+++++static int os_execute (lua_State *L) {+ const char *cmd = luaL_optstring(L, 1, NULL);+ int stat = system(cmd);+ if (cmd != NULL)+ return luaL_execresult(L, stat);+ else {+ lua_pushboolean(L, stat); /* true if there is a shell */+ return 1;+ }+}+++static int os_remove (lua_State *L) {+ const char *filename = luaL_checkstring(L, 1);+ return luaL_fileresult(L, remove(filename) == 0, filename);+}+++static int os_rename (lua_State *L) {+ const char *fromname = luaL_checkstring(L, 1);+ const char *toname = luaL_checkstring(L, 2);+ return luaL_fileresult(L, rename(fromname, toname) == 0, NULL);+}+++static int os_tmpname (lua_State *L) {+ char buff[LUA_TMPNAMBUFSIZE];+ int err;+ lua_tmpnam(buff, err);+ if (err)+ return luaL_error(L, "unable to generate a unique filename");+ lua_pushstring(L, buff);+ return 1;+}+++static int os_getenv (lua_State *L) {+ lua_pushstring(L, getenv(luaL_checkstring(L, 1))); /* if NULL push nil */+ return 1;+}+++static int os_clock (lua_State *L) {+ lua_pushnumber(L, ((lua_Number)clock())/(lua_Number)CLOCKS_PER_SEC);+ return 1;+}+++/*+** {======================================================+** Time/Date operations+** { year=%Y, month=%m, day=%d, hour=%H, min=%M, sec=%S,+** wday=%w+1, yday=%j, isdst=? }+** =======================================================+*/++static void setfield (lua_State *L, const char *key, int value) {+ lua_pushinteger(L, value);+ lua_setfield(L, -2, key);+}++static void setboolfield (lua_State *L, const char *key, int value) {+ if (value < 0) /* undefined? */+ return; /* does not set field */+ lua_pushboolean(L, value);+ lua_setfield(L, -2, key);+}+++/*+** Set all fields from structure 'tm' in the table on top of the stack+*/+static void setallfields (lua_State *L, struct tm *stm) {+ setfield(L, "sec", stm->tm_sec);+ setfield(L, "min", stm->tm_min);+ setfield(L, "hour", stm->tm_hour);+ setfield(L, "day", stm->tm_mday);+ setfield(L, "month", stm->tm_mon + 1);+ setfield(L, "year", stm->tm_year + 1900);+ setfield(L, "wday", stm->tm_wday + 1);+ setfield(L, "yday", stm->tm_yday + 1);+ setboolfield(L, "isdst", stm->tm_isdst);+}+++static int getboolfield (lua_State *L, const char *key) {+ int res;+ res = (lua_getfield(L, -1, key) == LUA_TNIL) ? -1 : lua_toboolean(L, -1);+ lua_pop(L, 1);+ return res;+}+++/* maximum value for date fields (to avoid arithmetic overflows with 'int') */+#if !defined(L_MAXDATEFIELD)+#define L_MAXDATEFIELD (INT_MAX / 2)+#endif++static int getfield (lua_State *L, const char *key, int d, int delta) {+ int isnum;+ int t = lua_getfield(L, -1, key); /* get field and its type */+ lua_Integer res = lua_tointegerx(L, -1, &isnum);+ if (!isnum) { /* field is not an integer? */+ if (t != LUA_TNIL) /* some other value? */+ return luaL_error(L, "field '%s' is not an integer", key);+ else if (d < 0) /* absent field; no default? */+ return luaL_error(L, "field '%s' missing in date table", key);+ res = d;+ }+ else {+ if (!(-L_MAXDATEFIELD <= res && res <= L_MAXDATEFIELD))+ return luaL_error(L, "field '%s' is out-of-bound", key);+ res -= delta;+ }+ lua_pop(L, 1);+ return (int)res;+}+++static const char *checkoption (lua_State *L, const char *conv,+ ptrdiff_t convlen, char *buff) {+ const char *option = LUA_STRFTIMEOPTIONS;+ int oplen = 1; /* length of options being checked */+ for (; *option != '\0' && oplen <= convlen; option += oplen) {+ if (*option == '|') /* next block? */+ oplen++; /* will check options with next length (+1) */+ else if (memcmp(conv, option, oplen) == 0) { /* match? */+ memcpy(buff, conv, oplen); /* copy valid option to buffer */+ buff[oplen] = '\0';+ return conv + oplen; /* return next item */+ }+ }+ luaL_argerror(L, 1,+ lua_pushfstring(L, "invalid conversion specifier '%%%s'", conv));+ return conv; /* to avoid warnings */+}+++/* maximum size for an individual 'strftime' item */+#define SIZETIMEFMT 250+++static int os_date (lua_State *L) {+ size_t slen;+ const char *s = luaL_optlstring(L, 1, "%c", &slen);+ time_t t = luaL_opt(L, l_checktime, 2, time(NULL));+ const char *se = s + slen; /* 's' end */+ struct tm tmr, *stm;+ if (*s == '!') { /* UTC? */+ stm = l_gmtime(&t, &tmr);+ s++; /* skip '!' */+ }+ else+ stm = l_localtime(&t, &tmr);+ if (stm == NULL) /* invalid date? */+ return luaL_error(L,+ "time result cannot be represented in this installation");+ if (strcmp(s, "*t") == 0) {+ lua_createtable(L, 0, 9); /* 9 = number of fields */+ setallfields(L, stm);+ }+ else {+ char cc[4]; /* buffer for individual conversion specifiers */+ luaL_Buffer b;+ cc[0] = '%';+ luaL_buffinit(L, &b);+ while (s < se) {+ if (*s != '%') /* not a conversion specifier? */+ luaL_addchar(&b, *s++);+ else {+ size_t reslen;+ char *buff = luaL_prepbuffsize(&b, SIZETIMEFMT);+ s++; /* skip '%' */+ s = checkoption(L, s, se - s, cc + 1); /* copy specifier to 'cc' */+ reslen = strftime(buff, SIZETIMEFMT, cc, stm);+ luaL_addsize(&b, reslen);+ }+ }+ luaL_pushresult(&b);+ }+ return 1;+}+++static int os_time (lua_State *L) {+ time_t t;+ if (lua_isnoneornil(L, 1)) /* called without args? */+ t = time(NULL); /* get current time */+ else {+ struct tm ts;+ luaL_checktype(L, 1, LUA_TTABLE);+ lua_settop(L, 1); /* make sure table is at the top */+ ts.tm_sec = getfield(L, "sec", 0, 0);+ ts.tm_min = getfield(L, "min", 0, 0);+ ts.tm_hour = getfield(L, "hour", 12, 0);+ ts.tm_mday = getfield(L, "day", -1, 0);+ ts.tm_mon = getfield(L, "month", -1, 1);+ ts.tm_year = getfield(L, "year", -1, 1900);+ ts.tm_isdst = getboolfield(L, "isdst");+ t = mktime(&ts);+ setallfields(L, &ts); /* update fields with normalized values */+ }+ if (t != (time_t)(l_timet)t || t == (time_t)(-1))+ return luaL_error(L,+ "time result cannot be represented in this installation");+ l_pushtime(L, t);+ return 1;+}+++static int os_difftime (lua_State *L) {+ time_t t1 = l_checktime(L, 1);+ time_t t2 = l_checktime(L, 2);+ lua_pushnumber(L, (lua_Number)difftime(t1, t2));+ return 1;+}++/* }====================================================== */+++static int os_setlocale (lua_State *L) {+ static const int cat[] = {LC_ALL, LC_COLLATE, LC_CTYPE, LC_MONETARY,+ LC_NUMERIC, LC_TIME};+ static const char *const catnames[] = {"all", "collate", "ctype", "monetary",+ "numeric", "time", NULL};+ const char *l = luaL_optstring(L, 1, NULL);+ int op = luaL_checkoption(L, 2, "all", catnames);+ lua_pushstring(L, setlocale(cat[op], l));+ return 1;+}+++static int os_exit (lua_State *L) {+ int status;+ if (lua_isboolean(L, 1))+ status = (lua_toboolean(L, 1) ? EXIT_SUCCESS : EXIT_FAILURE);+ else+ status = (int)luaL_optinteger(L, 1, EXIT_SUCCESS);+ if (lua_toboolean(L, 2))+ lua_close(L);+ if (L) exit(status); /* 'if' to avoid warnings for unreachable 'return' */+ return 0;+}+++static const luaL_Reg syslib[] = {+ {"clock", os_clock},+ {"date", os_date},+ {"difftime", os_difftime},+ {"execute", os_execute},+ {"exit", os_exit},+ {"getenv", os_getenv},+ {"remove", os_remove},+ {"rename", os_rename},+ {"setlocale", os_setlocale},+ {"time", os_time},+ {"tmpname", os_tmpname},+ {NULL, NULL}+};++/* }====================================================== */++++LUAMOD_API int luaopen_os (lua_State *L) {+ luaL_newlib(L, syslib);+ return 1;+}+
+ cbits/lua-5.3.6/lparser.c view
@@ -0,0 +1,1653 @@+/*+** $Id: lparser.c,v 2.155.1.2 2017/04/29 18:11:40 roberto Exp $+** Lua Parser+** See Copyright Notice in lua.h+*/++#define lparser_c+#define LUA_CORE++#include "lprefix.h"+++#include <string.h>++#include "lua.h"++#include "lcode.h"+#include "ldebug.h"+#include "ldo.h"+#include "lfunc.h"+#include "llex.h"+#include "lmem.h"+#include "lobject.h"+#include "lopcodes.h"+#include "lparser.h"+#include "lstate.h"+#include "lstring.h"+#include "ltable.h"++++/* maximum number of local variables per function (must be smaller+ than 250, due to the bytecode format) */+#define MAXVARS 200+++#define hasmultret(k) ((k) == VCALL || (k) == VVARARG)+++/* because all strings are unified by the scanner, the parser+ can use pointer equality for string equality */+#define eqstr(a,b) ((a) == (b))+++/*+** nodes for block list (list of active blocks)+*/+typedef struct BlockCnt {+ struct BlockCnt *previous; /* chain */+ int firstlabel; /* index of first label in this block */+ int firstgoto; /* index of first pending goto in this block */+ lu_byte nactvar; /* # active locals outside the block */+ lu_byte upval; /* true if some variable in the block is an upvalue */+ lu_byte isloop; /* true if 'block' is a loop */+} BlockCnt;++++/*+** prototypes for recursive non-terminal functions+*/+static void statement (LexState *ls);+static void expr (LexState *ls, expdesc *v);+++/* semantic error */+static l_noret semerror (LexState *ls, const char *msg) {+ ls->t.token = 0; /* remove "near <token>" from final message */+ luaX_syntaxerror(ls, msg);+}+++static l_noret error_expected (LexState *ls, int token) {+ luaX_syntaxerror(ls,+ luaO_pushfstring(ls->L, "%s expected", luaX_token2str(ls, token)));+}+++static l_noret errorlimit (FuncState *fs, int limit, const char *what) {+ lua_State *L = fs->ls->L;+ const char *msg;+ int line = fs->f->linedefined;+ const char *where = (line == 0)+ ? "main function"+ : luaO_pushfstring(L, "function at line %d", line);+ msg = luaO_pushfstring(L, "too many %s (limit is %d) in %s",+ what, limit, where);+ luaX_syntaxerror(fs->ls, msg);+}+++static void checklimit (FuncState *fs, int v, int l, const char *what) {+ if (v > l) errorlimit(fs, l, what);+}+++static int testnext (LexState *ls, int c) {+ if (ls->t.token == c) {+ luaX_next(ls);+ return 1;+ }+ else return 0;+}+++static void check (LexState *ls, int c) {+ if (ls->t.token != c)+ error_expected(ls, c);+}+++static void checknext (LexState *ls, int c) {+ check(ls, c);+ luaX_next(ls);+}+++#define check_condition(ls,c,msg) { if (!(c)) luaX_syntaxerror(ls, msg); }++++static void check_match (LexState *ls, int what, int who, int where) {+ if (!testnext(ls, what)) {+ if (where == ls->linenumber)+ error_expected(ls, what);+ else {+ luaX_syntaxerror(ls, luaO_pushfstring(ls->L,+ "%s expected (to close %s at line %d)",+ luaX_token2str(ls, what), luaX_token2str(ls, who), where));+ }+ }+}+++static TString *str_checkname (LexState *ls) {+ TString *ts;+ check(ls, TK_NAME);+ ts = ls->t.seminfo.ts;+ luaX_next(ls);+ return ts;+}+++static void init_exp (expdesc *e, expkind k, int i) {+ e->f = e->t = NO_JUMP;+ e->k = k;+ e->u.info = i;+}+++static void codestring (LexState *ls, expdesc *e, TString *s) {+ init_exp(e, VK, luaK_stringK(ls->fs, s));+}+++static void checkname (LexState *ls, expdesc *e) {+ codestring(ls, e, str_checkname(ls));+}+++static int registerlocalvar (LexState *ls, TString *varname) {+ FuncState *fs = ls->fs;+ Proto *f = fs->f;+ int oldsize = f->sizelocvars;+ luaM_growvector(ls->L, f->locvars, fs->nlocvars, f->sizelocvars,+ LocVar, SHRT_MAX, "local variables");+ while (oldsize < f->sizelocvars)+ f->locvars[oldsize++].varname = NULL;+ f->locvars[fs->nlocvars].varname = varname;+ luaC_objbarrier(ls->L, f, varname);+ return fs->nlocvars++;+}+++static void new_localvar (LexState *ls, TString *name) {+ FuncState *fs = ls->fs;+ Dyndata *dyd = ls->dyd;+ int reg = registerlocalvar(ls, name);+ checklimit(fs, dyd->actvar.n + 1 - fs->firstlocal,+ MAXVARS, "local variables");+ luaM_growvector(ls->L, dyd->actvar.arr, dyd->actvar.n + 1,+ dyd->actvar.size, Vardesc, MAX_INT, "local variables");+ dyd->actvar.arr[dyd->actvar.n++].idx = cast(short, reg);+}+++static void new_localvarliteral_ (LexState *ls, const char *name, size_t sz) {+ new_localvar(ls, luaX_newstring(ls, name, sz));+}++#define new_localvarliteral(ls,v) \+ new_localvarliteral_(ls, "" v, (sizeof(v)/sizeof(char))-1)+++static LocVar *getlocvar (FuncState *fs, int i) {+ int idx = fs->ls->dyd->actvar.arr[fs->firstlocal + i].idx;+ lua_assert(idx < fs->nlocvars);+ return &fs->f->locvars[idx];+}+++static void adjustlocalvars (LexState *ls, int nvars) {+ FuncState *fs = ls->fs;+ fs->nactvar = cast_byte(fs->nactvar + nvars);+ for (; nvars; nvars--) {+ getlocvar(fs, fs->nactvar - nvars)->startpc = fs->pc;+ }+}+++static void removevars (FuncState *fs, int tolevel) {+ fs->ls->dyd->actvar.n -= (fs->nactvar - tolevel);+ while (fs->nactvar > tolevel)+ getlocvar(fs, --fs->nactvar)->endpc = fs->pc;+}+++static int searchupvalue (FuncState *fs, TString *name) {+ int i;+ Upvaldesc *up = fs->f->upvalues;+ for (i = 0; i < fs->nups; i++) {+ if (eqstr(up[i].name, name)) return i;+ }+ return -1; /* not found */+}+++static int newupvalue (FuncState *fs, TString *name, expdesc *v) {+ Proto *f = fs->f;+ int oldsize = f->sizeupvalues;+ checklimit(fs, fs->nups + 1, MAXUPVAL, "upvalues");+ luaM_growvector(fs->ls->L, f->upvalues, fs->nups, f->sizeupvalues,+ Upvaldesc, MAXUPVAL, "upvalues");+ while (oldsize < f->sizeupvalues)+ f->upvalues[oldsize++].name = NULL;+ f->upvalues[fs->nups].instack = (v->k == VLOCAL);+ f->upvalues[fs->nups].idx = cast_byte(v->u.info);+ f->upvalues[fs->nups].name = name;+ luaC_objbarrier(fs->ls->L, f, name);+ return fs->nups++;+}+++static int searchvar (FuncState *fs, TString *n) {+ int i;+ for (i = cast_int(fs->nactvar) - 1; i >= 0; i--) {+ if (eqstr(n, getlocvar(fs, i)->varname))+ return i;+ }+ return -1; /* not found */+}+++/*+ Mark block where variable at given level was defined+ (to emit close instructions later).+*/+static void markupval (FuncState *fs, int level) {+ BlockCnt *bl = fs->bl;+ while (bl->nactvar > level)+ bl = bl->previous;+ bl->upval = 1;+}+++/*+ Find variable with given name 'n'. If it is an upvalue, add this+ upvalue into all intermediate functions.+*/+static void singlevaraux (FuncState *fs, TString *n, expdesc *var, int base) {+ if (fs == NULL) /* no more levels? */+ init_exp(var, VVOID, 0); /* default is global */+ else {+ int v = searchvar(fs, n); /* look up locals at current level */+ if (v >= 0) { /* found? */+ init_exp(var, VLOCAL, v); /* variable is local */+ if (!base)+ markupval(fs, v); /* local will be used as an upval */+ }+ else { /* not found as local at current level; try upvalues */+ int idx = searchupvalue(fs, n); /* try existing upvalues */+ if (idx < 0) { /* not found? */+ singlevaraux(fs->prev, n, var, 0); /* try upper levels */+ if (var->k == VVOID) /* not found? */+ return; /* it is a global */+ /* else was LOCAL or UPVAL */+ idx = newupvalue(fs, n, var); /* will be a new upvalue */+ }+ init_exp(var, VUPVAL, idx); /* new or old upvalue */+ }+ }+}+++static void singlevar (LexState *ls, expdesc *var) {+ TString *varname = str_checkname(ls);+ FuncState *fs = ls->fs;+ singlevaraux(fs, varname, var, 1);+ if (var->k == VVOID) { /* global name? */+ expdesc key;+ singlevaraux(fs, ls->envn, var, 1); /* get environment variable */+ lua_assert(var->k != VVOID); /* this one must exist */+ codestring(ls, &key, varname); /* key is variable name */+ luaK_indexed(fs, var, &key); /* env[varname] */+ }+}+++static void adjust_assign (LexState *ls, int nvars, int nexps, expdesc *e) {+ FuncState *fs = ls->fs;+ int extra = nvars - nexps;+ if (hasmultret(e->k)) {+ extra++; /* includes call itself */+ if (extra < 0) extra = 0;+ luaK_setreturns(fs, e, extra); /* last exp. provides the difference */+ if (extra > 1) luaK_reserveregs(fs, extra-1);+ }+ else {+ if (e->k != VVOID) luaK_exp2nextreg(fs, e); /* close last expression */+ if (extra > 0) {+ int reg = fs->freereg;+ luaK_reserveregs(fs, extra);+ luaK_nil(fs, reg, extra);+ }+ }+ if (nexps > nvars)+ ls->fs->freereg -= nexps - nvars; /* remove extra values */+}+++static void enterlevel (LexState *ls) {+ lua_State *L = ls->L;+ ++L->nCcalls;+ checklimit(ls->fs, L->nCcalls, LUAI_MAXCCALLS, "C levels");+}+++#define leavelevel(ls) ((ls)->L->nCcalls--)+++static void closegoto (LexState *ls, int g, Labeldesc *label) {+ int i;+ FuncState *fs = ls->fs;+ Labellist *gl = &ls->dyd->gt;+ Labeldesc *gt = &gl->arr[g];+ lua_assert(eqstr(gt->name, label->name));+ if (gt->nactvar < label->nactvar) {+ TString *vname = getlocvar(fs, gt->nactvar)->varname;+ const char *msg = luaO_pushfstring(ls->L,+ "<goto %s> at line %d jumps into the scope of local '%s'",+ getstr(gt->name), gt->line, getstr(vname));+ semerror(ls, msg);+ }+ luaK_patchlist(fs, gt->pc, label->pc);+ /* remove goto from pending list */+ for (i = g; i < gl->n - 1; i++)+ gl->arr[i] = gl->arr[i + 1];+ gl->n--;+}+++/*+** try to close a goto with existing labels; this solves backward jumps+*/+static int findlabel (LexState *ls, int g) {+ int i;+ BlockCnt *bl = ls->fs->bl;+ Dyndata *dyd = ls->dyd;+ Labeldesc *gt = &dyd->gt.arr[g];+ /* check labels in current block for a match */+ for (i = bl->firstlabel; i < dyd->label.n; i++) {+ Labeldesc *lb = &dyd->label.arr[i];+ if (eqstr(lb->name, gt->name)) { /* correct label? */+ if (gt->nactvar > lb->nactvar &&+ (bl->upval || dyd->label.n > bl->firstlabel))+ luaK_patchclose(ls->fs, gt->pc, lb->nactvar);+ closegoto(ls, g, lb); /* close it */+ return 1;+ }+ }+ return 0; /* label not found; cannot close goto */+}+++static int newlabelentry (LexState *ls, Labellist *l, TString *name,+ int line, int pc) {+ int n = l->n;+ luaM_growvector(ls->L, l->arr, n, l->size,+ Labeldesc, SHRT_MAX, "labels/gotos");+ l->arr[n].name = name;+ l->arr[n].line = line;+ l->arr[n].nactvar = ls->fs->nactvar;+ l->arr[n].pc = pc;+ l->n = n + 1;+ return n;+}+++/*+** check whether new label 'lb' matches any pending gotos in current+** block; solves forward jumps+*/+static void findgotos (LexState *ls, Labeldesc *lb) {+ Labellist *gl = &ls->dyd->gt;+ int i = ls->fs->bl->firstgoto;+ while (i < gl->n) {+ if (eqstr(gl->arr[i].name, lb->name))+ closegoto(ls, i, lb);+ else+ i++;+ }+}+++/*+** export pending gotos to outer level, to check them against+** outer labels; if the block being exited has upvalues, and+** the goto exits the scope of any variable (which can be the+** upvalue), close those variables being exited.+*/+static void movegotosout (FuncState *fs, BlockCnt *bl) {+ int i = bl->firstgoto;+ Labellist *gl = &fs->ls->dyd->gt;+ /* correct pending gotos to current block and try to close it+ with visible labels */+ while (i < gl->n) {+ Labeldesc *gt = &gl->arr[i];+ if (gt->nactvar > bl->nactvar) {+ if (bl->upval)+ luaK_patchclose(fs, gt->pc, bl->nactvar);+ gt->nactvar = bl->nactvar;+ }+ if (!findlabel(fs->ls, i))+ i++; /* move to next one */+ }+}+++static void enterblock (FuncState *fs, BlockCnt *bl, lu_byte isloop) {+ bl->isloop = isloop;+ bl->nactvar = fs->nactvar;+ bl->firstlabel = fs->ls->dyd->label.n;+ bl->firstgoto = fs->ls->dyd->gt.n;+ bl->upval = 0;+ bl->previous = fs->bl;+ fs->bl = bl;+ lua_assert(fs->freereg == fs->nactvar);+}+++/*+** create a label named 'break' to resolve break statements+*/+static void breaklabel (LexState *ls) {+ TString *n = luaS_new(ls->L, "break");+ int l = newlabelentry(ls, &ls->dyd->label, n, 0, ls->fs->pc);+ findgotos(ls, &ls->dyd->label.arr[l]);+}++/*+** generates an error for an undefined 'goto'; choose appropriate+** message when label name is a reserved word (which can only be 'break')+*/+static l_noret undefgoto (LexState *ls, Labeldesc *gt) {+ const char *msg = isreserved(gt->name)+ ? "<%s> at line %d not inside a loop"+ : "no visible label '%s' for <goto> at line %d";+ msg = luaO_pushfstring(ls->L, msg, getstr(gt->name), gt->line);+ semerror(ls, msg);+}+++static void leaveblock (FuncState *fs) {+ BlockCnt *bl = fs->bl;+ LexState *ls = fs->ls;+ if (bl->previous && bl->upval) {+ /* create a 'jump to here' to close upvalues */+ int j = luaK_jump(fs);+ luaK_patchclose(fs, j, bl->nactvar);+ luaK_patchtohere(fs, j);+ }+ if (bl->isloop)+ breaklabel(ls); /* close pending breaks */+ fs->bl = bl->previous;+ removevars(fs, bl->nactvar);+ lua_assert(bl->nactvar == fs->nactvar);+ fs->freereg = fs->nactvar; /* free registers */+ ls->dyd->label.n = bl->firstlabel; /* remove local labels */+ if (bl->previous) /* inner block? */+ movegotosout(fs, bl); /* update pending gotos to outer block */+ else if (bl->firstgoto < ls->dyd->gt.n) /* pending gotos in outer block? */+ undefgoto(ls, &ls->dyd->gt.arr[bl->firstgoto]); /* error */+}+++/*+** adds a new prototype into list of prototypes+*/+static Proto *addprototype (LexState *ls) {+ Proto *clp;+ lua_State *L = ls->L;+ FuncState *fs = ls->fs;+ Proto *f = fs->f; /* prototype of current function */+ if (fs->np >= f->sizep) {+ int oldsize = f->sizep;+ luaM_growvector(L, f->p, fs->np, f->sizep, Proto *, MAXARG_Bx, "functions");+ while (oldsize < f->sizep)+ f->p[oldsize++] = NULL;+ }+ f->p[fs->np++] = clp = luaF_newproto(L);+ luaC_objbarrier(L, f, clp);+ return clp;+}+++/*+** codes instruction to create new closure in parent function.+** The OP_CLOSURE instruction must use the last available register,+** so that, if it invokes the GC, the GC knows which registers+** are in use at that time.+*/+static void codeclosure (LexState *ls, expdesc *v) {+ FuncState *fs = ls->fs->prev;+ init_exp(v, VRELOCABLE, luaK_codeABx(fs, OP_CLOSURE, 0, fs->np - 1));+ luaK_exp2nextreg(fs, v); /* fix it at the last register */+}+++static void open_func (LexState *ls, FuncState *fs, BlockCnt *bl) {+ Proto *f;+ fs->prev = ls->fs; /* linked list of funcstates */+ fs->ls = ls;+ ls->fs = fs;+ fs->pc = 0;+ fs->lasttarget = 0;+ fs->jpc = NO_JUMP;+ fs->freereg = 0;+ fs->nk = 0;+ fs->np = 0;+ fs->nups = 0;+ fs->nlocvars = 0;+ fs->nactvar = 0;+ fs->firstlocal = ls->dyd->actvar.n;+ fs->bl = NULL;+ f = fs->f;+ f->source = ls->source;+ luaC_objbarrier(ls->L, f, f->source);+ f->maxstacksize = 2; /* registers 0/1 are always valid */+ enterblock(fs, bl, 0);+}+++static void close_func (LexState *ls) {+ lua_State *L = ls->L;+ FuncState *fs = ls->fs;+ Proto *f = fs->f;+ luaK_ret(fs, 0, 0); /* final return */+ leaveblock(fs);+ luaM_reallocvector(L, f->code, f->sizecode, fs->pc, Instruction);+ f->sizecode = fs->pc;+ luaM_reallocvector(L, f->lineinfo, f->sizelineinfo, fs->pc, int);+ f->sizelineinfo = fs->pc;+ luaM_reallocvector(L, f->k, f->sizek, fs->nk, TValue);+ f->sizek = fs->nk;+ luaM_reallocvector(L, f->p, f->sizep, fs->np, Proto *);+ f->sizep = fs->np;+ luaM_reallocvector(L, f->locvars, f->sizelocvars, fs->nlocvars, LocVar);+ f->sizelocvars = fs->nlocvars;+ luaM_reallocvector(L, f->upvalues, f->sizeupvalues, fs->nups, Upvaldesc);+ f->sizeupvalues = fs->nups;+ lua_assert(fs->bl == NULL);+ ls->fs = fs->prev;+ luaC_checkGC(L);+}++++/*============================================================*/+/* GRAMMAR RULES */+/*============================================================*/+++/*+** check whether current token is in the follow set of a block.+** 'until' closes syntactical blocks, but do not close scope,+** so it is handled in separate.+*/+static int block_follow (LexState *ls, int withuntil) {+ switch (ls->t.token) {+ case TK_ELSE: case TK_ELSEIF:+ case TK_END: case TK_EOS:+ return 1;+ case TK_UNTIL: return withuntil;+ default: return 0;+ }+}+++static void statlist (LexState *ls) {+ /* statlist -> { stat [';'] } */+ while (!block_follow(ls, 1)) {+ if (ls->t.token == TK_RETURN) {+ statement(ls);+ return; /* 'return' must be last statement */+ }+ statement(ls);+ }+}+++static void fieldsel (LexState *ls, expdesc *v) {+ /* fieldsel -> ['.' | ':'] NAME */+ FuncState *fs = ls->fs;+ expdesc key;+ luaK_exp2anyregup(fs, v);+ luaX_next(ls); /* skip the dot or colon */+ checkname(ls, &key);+ luaK_indexed(fs, v, &key);+}+++static void yindex (LexState *ls, expdesc *v) {+ /* index -> '[' expr ']' */+ luaX_next(ls); /* skip the '[' */+ expr(ls, v);+ luaK_exp2val(ls->fs, v);+ checknext(ls, ']');+}+++/*+** {======================================================================+** Rules for Constructors+** =======================================================================+*/+++struct ConsControl {+ expdesc v; /* last list item read */+ expdesc *t; /* table descriptor */+ int nh; /* total number of 'record' elements */+ int na; /* total number of array elements */+ int tostore; /* number of array elements pending to be stored */+};+++static void recfield (LexState *ls, struct ConsControl *cc) {+ /* recfield -> (NAME | '['exp1']') = exp1 */+ FuncState *fs = ls->fs;+ int reg = ls->fs->freereg;+ expdesc key, val;+ int rkkey;+ if (ls->t.token == TK_NAME) {+ checklimit(fs, cc->nh, MAX_INT, "items in a constructor");+ checkname(ls, &key);+ }+ else /* ls->t.token == '[' */+ yindex(ls, &key);+ cc->nh++;+ checknext(ls, '=');+ rkkey = luaK_exp2RK(fs, &key);+ expr(ls, &val);+ luaK_codeABC(fs, OP_SETTABLE, cc->t->u.info, rkkey, luaK_exp2RK(fs, &val));+ fs->freereg = reg; /* free registers */+}+++static void closelistfield (FuncState *fs, struct ConsControl *cc) {+ if (cc->v.k == VVOID) return; /* there is no list item */+ luaK_exp2nextreg(fs, &cc->v);+ cc->v.k = VVOID;+ if (cc->tostore == LFIELDS_PER_FLUSH) {+ luaK_setlist(fs, cc->t->u.info, cc->na, cc->tostore); /* flush */+ cc->tostore = 0; /* no more items pending */+ }+}+++static void lastlistfield (FuncState *fs, struct ConsControl *cc) {+ if (cc->tostore == 0) return;+ if (hasmultret(cc->v.k)) {+ luaK_setmultret(fs, &cc->v);+ luaK_setlist(fs, cc->t->u.info, cc->na, LUA_MULTRET);+ cc->na--; /* do not count last expression (unknown number of elements) */+ }+ else {+ if (cc->v.k != VVOID)+ luaK_exp2nextreg(fs, &cc->v);+ luaK_setlist(fs, cc->t->u.info, cc->na, cc->tostore);+ }+}+++static void listfield (LexState *ls, struct ConsControl *cc) {+ /* listfield -> exp */+ expr(ls, &cc->v);+ checklimit(ls->fs, cc->na, MAX_INT, "items in a constructor");+ cc->na++;+ cc->tostore++;+}+++static void field (LexState *ls, struct ConsControl *cc) {+ /* field -> listfield | recfield */+ switch(ls->t.token) {+ case TK_NAME: { /* may be 'listfield' or 'recfield' */+ if (luaX_lookahead(ls) != '=') /* expression? */+ listfield(ls, cc);+ else+ recfield(ls, cc);+ break;+ }+ case '[': {+ recfield(ls, cc);+ break;+ }+ default: {+ listfield(ls, cc);+ break;+ }+ }+}+++static void constructor (LexState *ls, expdesc *t) {+ /* constructor -> '{' [ field { sep field } [sep] ] '}'+ sep -> ',' | ';' */+ FuncState *fs = ls->fs;+ int line = ls->linenumber;+ int pc = luaK_codeABC(fs, OP_NEWTABLE, 0, 0, 0);+ struct ConsControl cc;+ cc.na = cc.nh = cc.tostore = 0;+ cc.t = t;+ init_exp(t, VRELOCABLE, pc);+ init_exp(&cc.v, VVOID, 0); /* no value (yet) */+ luaK_exp2nextreg(ls->fs, t); /* fix it at stack top */+ checknext(ls, '{');+ do {+ lua_assert(cc.v.k == VVOID || cc.tostore > 0);+ if (ls->t.token == '}') break;+ closelistfield(fs, &cc);+ field(ls, &cc);+ } while (testnext(ls, ',') || testnext(ls, ';'));+ check_match(ls, '}', '{', line);+ lastlistfield(fs, &cc);+ SETARG_B(fs->f->code[pc], luaO_int2fb(cc.na)); /* set initial array size */+ SETARG_C(fs->f->code[pc], luaO_int2fb(cc.nh)); /* set initial table size */+}++/* }====================================================================== */++++static void parlist (LexState *ls) {+ /* parlist -> [ param { ',' param } ] */+ FuncState *fs = ls->fs;+ Proto *f = fs->f;+ int nparams = 0;+ f->is_vararg = 0;+ if (ls->t.token != ')') { /* is 'parlist' not empty? */+ do {+ switch (ls->t.token) {+ case TK_NAME: { /* param -> NAME */+ new_localvar(ls, str_checkname(ls));+ nparams++;+ break;+ }+ case TK_DOTS: { /* param -> '...' */+ luaX_next(ls);+ f->is_vararg = 1; /* declared vararg */+ break;+ }+ default: luaX_syntaxerror(ls, "<name> or '...' expected");+ }+ } while (!f->is_vararg && testnext(ls, ','));+ }+ adjustlocalvars(ls, nparams);+ f->numparams = cast_byte(fs->nactvar);+ luaK_reserveregs(fs, fs->nactvar); /* reserve register for parameters */+}+++static void body (LexState *ls, expdesc *e, int ismethod, int line) {+ /* body -> '(' parlist ')' block END */+ FuncState new_fs;+ BlockCnt bl;+ new_fs.f = addprototype(ls);+ new_fs.f->linedefined = line;+ open_func(ls, &new_fs, &bl);+ checknext(ls, '(');+ if (ismethod) {+ new_localvarliteral(ls, "self"); /* create 'self' parameter */+ adjustlocalvars(ls, 1);+ }+ parlist(ls);+ checknext(ls, ')');+ statlist(ls);+ new_fs.f->lastlinedefined = ls->linenumber;+ check_match(ls, TK_END, TK_FUNCTION, line);+ codeclosure(ls, e);+ close_func(ls);+}+++static int explist (LexState *ls, expdesc *v) {+ /* explist -> expr { ',' expr } */+ int n = 1; /* at least one expression */+ expr(ls, v);+ while (testnext(ls, ',')) {+ luaK_exp2nextreg(ls->fs, v);+ expr(ls, v);+ n++;+ }+ return n;+}+++static void funcargs (LexState *ls, expdesc *f, int line) {+ FuncState *fs = ls->fs;+ expdesc args;+ int base, nparams;+ switch (ls->t.token) {+ case '(': { /* funcargs -> '(' [ explist ] ')' */+ luaX_next(ls);+ if (ls->t.token == ')') /* arg list is empty? */+ args.k = VVOID;+ else {+ explist(ls, &args);+ luaK_setmultret(fs, &args);+ }+ check_match(ls, ')', '(', line);+ break;+ }+ case '{': { /* funcargs -> constructor */+ constructor(ls, &args);+ break;+ }+ case TK_STRING: { /* funcargs -> STRING */+ codestring(ls, &args, ls->t.seminfo.ts);+ luaX_next(ls); /* must use 'seminfo' before 'next' */+ break;+ }+ default: {+ luaX_syntaxerror(ls, "function arguments expected");+ }+ }+ lua_assert(f->k == VNONRELOC);+ base = f->u.info; /* base register for call */+ if (hasmultret(args.k))+ nparams = LUA_MULTRET; /* open call */+ else {+ if (args.k != VVOID)+ luaK_exp2nextreg(fs, &args); /* close last argument */+ nparams = fs->freereg - (base+1);+ }+ init_exp(f, VCALL, luaK_codeABC(fs, OP_CALL, base, nparams+1, 2));+ luaK_fixline(fs, line);+ fs->freereg = base+1; /* call remove function and arguments and leaves+ (unless changed) one result */+}+++++/*+** {======================================================================+** Expression parsing+** =======================================================================+*/+++static void primaryexp (LexState *ls, expdesc *v) {+ /* primaryexp -> NAME | '(' expr ')' */+ switch (ls->t.token) {+ case '(': {+ int line = ls->linenumber;+ luaX_next(ls);+ expr(ls, v);+ check_match(ls, ')', '(', line);+ luaK_dischargevars(ls->fs, v);+ return;+ }+ case TK_NAME: {+ singlevar(ls, v);+ return;+ }+ default: {+ luaX_syntaxerror(ls, "unexpected symbol");+ }+ }+}+++static void suffixedexp (LexState *ls, expdesc *v) {+ /* suffixedexp ->+ primaryexp { '.' NAME | '[' exp ']' | ':' NAME funcargs | funcargs } */+ FuncState *fs = ls->fs;+ int line = ls->linenumber;+ primaryexp(ls, v);+ for (;;) {+ switch (ls->t.token) {+ case '.': { /* fieldsel */+ fieldsel(ls, v);+ break;+ }+ case '[': { /* '[' exp1 ']' */+ expdesc key;+ luaK_exp2anyregup(fs, v);+ yindex(ls, &key);+ luaK_indexed(fs, v, &key);+ break;+ }+ case ':': { /* ':' NAME funcargs */+ expdesc key;+ luaX_next(ls);+ checkname(ls, &key);+ luaK_self(fs, v, &key);+ funcargs(ls, v, line);+ break;+ }+ case '(': case TK_STRING: case '{': { /* funcargs */+ luaK_exp2nextreg(fs, v);+ funcargs(ls, v, line);+ break;+ }+ default: return;+ }+ }+}+++static void simpleexp (LexState *ls, expdesc *v) {+ /* simpleexp -> FLT | INT | STRING | NIL | TRUE | FALSE | ... |+ constructor | FUNCTION body | suffixedexp */+ switch (ls->t.token) {+ case TK_FLT: {+ init_exp(v, VKFLT, 0);+ v->u.nval = ls->t.seminfo.r;+ break;+ }+ case TK_INT: {+ init_exp(v, VKINT, 0);+ v->u.ival = ls->t.seminfo.i;+ break;+ }+ case TK_STRING: {+ codestring(ls, v, ls->t.seminfo.ts);+ break;+ }+ case TK_NIL: {+ init_exp(v, VNIL, 0);+ break;+ }+ case TK_TRUE: {+ init_exp(v, VTRUE, 0);+ break;+ }+ case TK_FALSE: {+ init_exp(v, VFALSE, 0);+ break;+ }+ case TK_DOTS: { /* vararg */+ FuncState *fs = ls->fs;+ check_condition(ls, fs->f->is_vararg,+ "cannot use '...' outside a vararg function");+ init_exp(v, VVARARG, luaK_codeABC(fs, OP_VARARG, 0, 1, 0));+ break;+ }+ case '{': { /* constructor */+ constructor(ls, v);+ return;+ }+ case TK_FUNCTION: {+ luaX_next(ls);+ body(ls, v, 0, ls->linenumber);+ return;+ }+ default: {+ suffixedexp(ls, v);+ return;+ }+ }+ luaX_next(ls);+}+++static UnOpr getunopr (int op) {+ switch (op) {+ case TK_NOT: return OPR_NOT;+ case '-': return OPR_MINUS;+ case '~': return OPR_BNOT;+ case '#': return OPR_LEN;+ default: return OPR_NOUNOPR;+ }+}+++static BinOpr getbinopr (int op) {+ switch (op) {+ case '+': return OPR_ADD;+ case '-': return OPR_SUB;+ case '*': return OPR_MUL;+ case '%': return OPR_MOD;+ case '^': return OPR_POW;+ case '/': return OPR_DIV;+ case TK_IDIV: return OPR_IDIV;+ case '&': return OPR_BAND;+ case '|': return OPR_BOR;+ case '~': return OPR_BXOR;+ case TK_SHL: return OPR_SHL;+ case TK_SHR: return OPR_SHR;+ case TK_CONCAT: return OPR_CONCAT;+ case TK_NE: return OPR_NE;+ case TK_EQ: return OPR_EQ;+ case '<': return OPR_LT;+ case TK_LE: return OPR_LE;+ case '>': return OPR_GT;+ case TK_GE: return OPR_GE;+ case TK_AND: return OPR_AND;+ case TK_OR: return OPR_OR;+ default: return OPR_NOBINOPR;+ }+}+++static const struct {+ lu_byte left; /* left priority for each binary operator */+ lu_byte right; /* right priority */+} priority[] = { /* ORDER OPR */+ {10, 10}, {10, 10}, /* '+' '-' */+ {11, 11}, {11, 11}, /* '*' '%' */+ {14, 13}, /* '^' (right associative) */+ {11, 11}, {11, 11}, /* '/' '//' */+ {6, 6}, {4, 4}, {5, 5}, /* '&' '|' '~' */+ {7, 7}, {7, 7}, /* '<<' '>>' */+ {9, 8}, /* '..' (right associative) */+ {3, 3}, {3, 3}, {3, 3}, /* ==, <, <= */+ {3, 3}, {3, 3}, {3, 3}, /* ~=, >, >= */+ {2, 2}, {1, 1} /* and, or */+};++#define UNARY_PRIORITY 12 /* priority for unary operators */+++/*+** subexpr -> (simpleexp | unop subexpr) { binop subexpr }+** where 'binop' is any binary operator with a priority higher than 'limit'+*/+static BinOpr subexpr (LexState *ls, expdesc *v, int limit) {+ BinOpr op;+ UnOpr uop;+ enterlevel(ls);+ uop = getunopr(ls->t.token);+ if (uop != OPR_NOUNOPR) {+ int line = ls->linenumber;+ luaX_next(ls);+ subexpr(ls, v, UNARY_PRIORITY);+ luaK_prefix(ls->fs, uop, v, line);+ }+ else simpleexp(ls, v);+ /* expand while operators have priorities higher than 'limit' */+ op = getbinopr(ls->t.token);+ while (op != OPR_NOBINOPR && priority[op].left > limit) {+ expdesc v2;+ BinOpr nextop;+ int line = ls->linenumber;+ luaX_next(ls);+ luaK_infix(ls->fs, op, v);+ /* read sub-expression with higher priority */+ nextop = subexpr(ls, &v2, priority[op].right);+ luaK_posfix(ls->fs, op, v, &v2, line);+ op = nextop;+ }+ leavelevel(ls);+ return op; /* return first untreated operator */+}+++static void expr (LexState *ls, expdesc *v) {+ subexpr(ls, v, 0);+}++/* }==================================================================== */++++/*+** {======================================================================+** Rules for Statements+** =======================================================================+*/+++static void block (LexState *ls) {+ /* block -> statlist */+ FuncState *fs = ls->fs;+ BlockCnt bl;+ enterblock(fs, &bl, 0);+ statlist(ls);+ leaveblock(fs);+}+++/*+** structure to chain all variables in the left-hand side of an+** assignment+*/+struct LHS_assign {+ struct LHS_assign *prev;+ expdesc v; /* variable (global, local, upvalue, or indexed) */+};+++/*+** check whether, in an assignment to an upvalue/local variable, the+** upvalue/local variable is begin used in a previous assignment to a+** table. If so, save original upvalue/local value in a safe place and+** use this safe copy in the previous assignment.+*/+static void check_conflict (LexState *ls, struct LHS_assign *lh, expdesc *v) {+ FuncState *fs = ls->fs;+ int extra = fs->freereg; /* eventual position to save local variable */+ int conflict = 0;+ for (; lh; lh = lh->prev) { /* check all previous assignments */+ if (lh->v.k == VINDEXED) { /* assigning to a table? */+ /* table is the upvalue/local being assigned now? */+ if (lh->v.u.ind.vt == v->k && lh->v.u.ind.t == v->u.info) {+ conflict = 1;+ lh->v.u.ind.vt = VLOCAL;+ lh->v.u.ind.t = extra; /* previous assignment will use safe copy */+ }+ /* index is the local being assigned? (index cannot be upvalue) */+ if (v->k == VLOCAL && lh->v.u.ind.idx == v->u.info) {+ conflict = 1;+ lh->v.u.ind.idx = extra; /* previous assignment will use safe copy */+ }+ }+ }+ if (conflict) {+ /* copy upvalue/local value to a temporary (in position 'extra') */+ OpCode op = (v->k == VLOCAL) ? OP_MOVE : OP_GETUPVAL;+ luaK_codeABC(fs, op, extra, v->u.info, 0);+ luaK_reserveregs(fs, 1);+ }+}+++static void assignment (LexState *ls, struct LHS_assign *lh, int nvars) {+ expdesc e;+ check_condition(ls, vkisvar(lh->v.k), "syntax error");+ if (testnext(ls, ',')) { /* assignment -> ',' suffixedexp assignment */+ struct LHS_assign nv;+ nv.prev = lh;+ suffixedexp(ls, &nv.v);+ if (nv.v.k != VINDEXED)+ check_conflict(ls, lh, &nv.v);+ checklimit(ls->fs, nvars + ls->L->nCcalls, LUAI_MAXCCALLS,+ "C levels");+ assignment(ls, &nv, nvars+1);+ }+ else { /* assignment -> '=' explist */+ int nexps;+ checknext(ls, '=');+ nexps = explist(ls, &e);+ if (nexps != nvars)+ adjust_assign(ls, nvars, nexps, &e);+ else {+ luaK_setoneret(ls->fs, &e); /* close last expression */+ luaK_storevar(ls->fs, &lh->v, &e);+ return; /* avoid default */+ }+ }+ init_exp(&e, VNONRELOC, ls->fs->freereg-1); /* default assignment */+ luaK_storevar(ls->fs, &lh->v, &e);+}+++static int cond (LexState *ls) {+ /* cond -> exp */+ expdesc v;+ expr(ls, &v); /* read condition */+ if (v.k == VNIL) v.k = VFALSE; /* 'falses' are all equal here */+ luaK_goiftrue(ls->fs, &v);+ return v.f;+}+++static void gotostat (LexState *ls, int pc) {+ int line = ls->linenumber;+ TString *label;+ int g;+ if (testnext(ls, TK_GOTO))+ label = str_checkname(ls);+ else {+ luaX_next(ls); /* skip break */+ label = luaS_new(ls->L, "break");+ }+ g = newlabelentry(ls, &ls->dyd->gt, label, line, pc);+ findlabel(ls, g); /* close it if label already defined */+}+++/* check for repeated labels on the same block */+static void checkrepeated (FuncState *fs, Labellist *ll, TString *label) {+ int i;+ for (i = fs->bl->firstlabel; i < ll->n; i++) {+ if (eqstr(label, ll->arr[i].name)) {+ const char *msg = luaO_pushfstring(fs->ls->L,+ "label '%s' already defined on line %d",+ getstr(label), ll->arr[i].line);+ semerror(fs->ls, msg);+ }+ }+}+++/* skip no-op statements */+static void skipnoopstat (LexState *ls) {+ while (ls->t.token == ';' || ls->t.token == TK_DBCOLON)+ statement(ls);+}+++static void labelstat (LexState *ls, TString *label, int line) {+ /* label -> '::' NAME '::' */+ FuncState *fs = ls->fs;+ Labellist *ll = &ls->dyd->label;+ int l; /* index of new label being created */+ checkrepeated(fs, ll, label); /* check for repeated labels */+ checknext(ls, TK_DBCOLON); /* skip double colon */+ /* create new entry for this label */+ l = newlabelentry(ls, ll, label, line, luaK_getlabel(fs));+ skipnoopstat(ls); /* skip other no-op statements */+ if (block_follow(ls, 0)) { /* label is last no-op statement in the block? */+ /* assume that locals are already out of scope */+ ll->arr[l].nactvar = fs->bl->nactvar;+ }+ findgotos(ls, &ll->arr[l]);+}+++static void whilestat (LexState *ls, int line) {+ /* whilestat -> WHILE cond DO block END */+ FuncState *fs = ls->fs;+ int whileinit;+ int condexit;+ BlockCnt bl;+ luaX_next(ls); /* skip WHILE */+ whileinit = luaK_getlabel(fs);+ condexit = cond(ls);+ enterblock(fs, &bl, 1);+ checknext(ls, TK_DO);+ block(ls);+ luaK_jumpto(fs, whileinit);+ check_match(ls, TK_END, TK_WHILE, line);+ leaveblock(fs);+ luaK_patchtohere(fs, condexit); /* false conditions finish the loop */+}+++static void repeatstat (LexState *ls, int line) {+ /* repeatstat -> REPEAT block UNTIL cond */+ int condexit;+ FuncState *fs = ls->fs;+ int repeat_init = luaK_getlabel(fs);+ BlockCnt bl1, bl2;+ enterblock(fs, &bl1, 1); /* loop block */+ enterblock(fs, &bl2, 0); /* scope block */+ luaX_next(ls); /* skip REPEAT */+ statlist(ls);+ check_match(ls, TK_UNTIL, TK_REPEAT, line);+ condexit = cond(ls); /* read condition (inside scope block) */+ if (bl2.upval) /* upvalues? */+ luaK_patchclose(fs, condexit, bl2.nactvar);+ leaveblock(fs); /* finish scope */+ luaK_patchlist(fs, condexit, repeat_init); /* close the loop */+ leaveblock(fs); /* finish loop */+}+++static int exp1 (LexState *ls) {+ expdesc e;+ int reg;+ expr(ls, &e);+ luaK_exp2nextreg(ls->fs, &e);+ lua_assert(e.k == VNONRELOC);+ reg = e.u.info;+ return reg;+}+++static void forbody (LexState *ls, int base, int line, int nvars, int isnum) {+ /* forbody -> DO block */+ BlockCnt bl;+ FuncState *fs = ls->fs;+ int prep, endfor;+ adjustlocalvars(ls, 3); /* control variables */+ checknext(ls, TK_DO);+ prep = isnum ? luaK_codeAsBx(fs, OP_FORPREP, base, NO_JUMP) : luaK_jump(fs);+ enterblock(fs, &bl, 0); /* scope for declared variables */+ adjustlocalvars(ls, nvars);+ luaK_reserveregs(fs, nvars);+ block(ls);+ leaveblock(fs); /* end of scope for declared variables */+ luaK_patchtohere(fs, prep);+ if (isnum) /* numeric for? */+ endfor = luaK_codeAsBx(fs, OP_FORLOOP, base, NO_JUMP);+ else { /* generic for */+ luaK_codeABC(fs, OP_TFORCALL, base, 0, nvars);+ luaK_fixline(fs, line);+ endfor = luaK_codeAsBx(fs, OP_TFORLOOP, base + 2, NO_JUMP);+ }+ luaK_patchlist(fs, endfor, prep + 1);+ luaK_fixline(fs, line);+}+++static void fornum (LexState *ls, TString *varname, int line) {+ /* fornum -> NAME = exp1,exp1[,exp1] forbody */+ FuncState *fs = ls->fs;+ int base = fs->freereg;+ new_localvarliteral(ls, "(for index)");+ new_localvarliteral(ls, "(for limit)");+ new_localvarliteral(ls, "(for step)");+ new_localvar(ls, varname);+ checknext(ls, '=');+ exp1(ls); /* initial value */+ checknext(ls, ',');+ exp1(ls); /* limit */+ if (testnext(ls, ','))+ exp1(ls); /* optional step */+ else { /* default step = 1 */+ luaK_codek(fs, fs->freereg, luaK_intK(fs, 1));+ luaK_reserveregs(fs, 1);+ }+ forbody(ls, base, line, 1, 1);+}+++static void forlist (LexState *ls, TString *indexname) {+ /* forlist -> NAME {,NAME} IN explist forbody */+ FuncState *fs = ls->fs;+ expdesc e;+ int nvars = 4; /* gen, state, control, plus at least one declared var */+ int line;+ int base = fs->freereg;+ /* create control variables */+ new_localvarliteral(ls, "(for generator)");+ new_localvarliteral(ls, "(for state)");+ new_localvarliteral(ls, "(for control)");+ /* create declared variables */+ new_localvar(ls, indexname);+ while (testnext(ls, ',')) {+ new_localvar(ls, str_checkname(ls));+ nvars++;+ }+ checknext(ls, TK_IN);+ line = ls->linenumber;+ adjust_assign(ls, 3, explist(ls, &e), &e);+ luaK_checkstack(fs, 3); /* extra space to call generator */+ forbody(ls, base, line, nvars - 3, 0);+}+++static void forstat (LexState *ls, int line) {+ /* forstat -> FOR (fornum | forlist) END */+ FuncState *fs = ls->fs;+ TString *varname;+ BlockCnt bl;+ enterblock(fs, &bl, 1); /* scope for loop and control variables */+ luaX_next(ls); /* skip 'for' */+ varname = str_checkname(ls); /* first variable name */+ switch (ls->t.token) {+ case '=': fornum(ls, varname, line); break;+ case ',': case TK_IN: forlist(ls, varname); break;+ default: luaX_syntaxerror(ls, "'=' or 'in' expected");+ }+ check_match(ls, TK_END, TK_FOR, line);+ leaveblock(fs); /* loop scope ('break' jumps to this point) */+}+++static void test_then_block (LexState *ls, int *escapelist) {+ /* test_then_block -> [IF | ELSEIF] cond THEN block */+ BlockCnt bl;+ FuncState *fs = ls->fs;+ expdesc v;+ int jf; /* instruction to skip 'then' code (if condition is false) */+ luaX_next(ls); /* skip IF or ELSEIF */+ expr(ls, &v); /* read condition */+ checknext(ls, TK_THEN);+ if (ls->t.token == TK_GOTO || ls->t.token == TK_BREAK) {+ luaK_goiffalse(ls->fs, &v); /* will jump to label if condition is true */+ enterblock(fs, &bl, 0); /* must enter block before 'goto' */+ gotostat(ls, v.t); /* handle goto/break */+ while (testnext(ls, ';')) {} /* skip colons */+ if (block_follow(ls, 0)) { /* 'goto' is the entire block? */+ leaveblock(fs);+ return; /* and that is it */+ }+ else /* must skip over 'then' part if condition is false */+ jf = luaK_jump(fs);+ }+ else { /* regular case (not goto/break) */+ luaK_goiftrue(ls->fs, &v); /* skip over block if condition is false */+ enterblock(fs, &bl, 0);+ jf = v.f;+ }+ statlist(ls); /* 'then' part */+ leaveblock(fs);+ if (ls->t.token == TK_ELSE ||+ ls->t.token == TK_ELSEIF) /* followed by 'else'/'elseif'? */+ luaK_concat(fs, escapelist, luaK_jump(fs)); /* must jump over it */+ luaK_patchtohere(fs, jf);+}+++static void ifstat (LexState *ls, int line) {+ /* ifstat -> IF cond THEN block {ELSEIF cond THEN block} [ELSE block] END */+ FuncState *fs = ls->fs;+ int escapelist = NO_JUMP; /* exit list for finished parts */+ test_then_block(ls, &escapelist); /* IF cond THEN block */+ while (ls->t.token == TK_ELSEIF)+ test_then_block(ls, &escapelist); /* ELSEIF cond THEN block */+ if (testnext(ls, TK_ELSE))+ block(ls); /* 'else' part */+ check_match(ls, TK_END, TK_IF, line);+ luaK_patchtohere(fs, escapelist); /* patch escape list to 'if' end */+}+++static void localfunc (LexState *ls) {+ expdesc b;+ FuncState *fs = ls->fs;+ new_localvar(ls, str_checkname(ls)); /* new local variable */+ adjustlocalvars(ls, 1); /* enter its scope */+ body(ls, &b, 0, ls->linenumber); /* function created in next register */+ /* debug information will only see the variable after this point! */+ getlocvar(fs, b.u.info)->startpc = fs->pc;+}+++static void localstat (LexState *ls) {+ /* stat -> LOCAL NAME {',' NAME} ['=' explist] */+ int nvars = 0;+ int nexps;+ expdesc e;+ do {+ new_localvar(ls, str_checkname(ls));+ nvars++;+ } while (testnext(ls, ','));+ if (testnext(ls, '='))+ nexps = explist(ls, &e);+ else {+ e.k = VVOID;+ nexps = 0;+ }+ adjust_assign(ls, nvars, nexps, &e);+ adjustlocalvars(ls, nvars);+}+++static int funcname (LexState *ls, expdesc *v) {+ /* funcname -> NAME {fieldsel} [':' NAME] */+ int ismethod = 0;+ singlevar(ls, v);+ while (ls->t.token == '.')+ fieldsel(ls, v);+ if (ls->t.token == ':') {+ ismethod = 1;+ fieldsel(ls, v);+ }+ return ismethod;+}+++static void funcstat (LexState *ls, int line) {+ /* funcstat -> FUNCTION funcname body */+ int ismethod;+ expdesc v, b;+ luaX_next(ls); /* skip FUNCTION */+ ismethod = funcname(ls, &v);+ body(ls, &b, ismethod, line);+ luaK_storevar(ls->fs, &v, &b);+ luaK_fixline(ls->fs, line); /* definition "happens" in the first line */+}+++static void exprstat (LexState *ls) {+ /* stat -> func | assignment */+ FuncState *fs = ls->fs;+ struct LHS_assign v;+ suffixedexp(ls, &v.v);+ if (ls->t.token == '=' || ls->t.token == ',') { /* stat -> assignment ? */+ v.prev = NULL;+ assignment(ls, &v, 1);+ }+ else { /* stat -> func */+ check_condition(ls, v.v.k == VCALL, "syntax error");+ SETARG_C(getinstruction(fs, &v.v), 1); /* call statement uses no results */+ }+}+++static void retstat (LexState *ls) {+ /* stat -> RETURN [explist] [';'] */+ FuncState *fs = ls->fs;+ expdesc e;+ int first, nret; /* registers with returned values */+ if (block_follow(ls, 1) || ls->t.token == ';')+ first = nret = 0; /* return no values */+ else {+ nret = explist(ls, &e); /* optional return values */+ if (hasmultret(e.k)) {+ luaK_setmultret(fs, &e);+ if (e.k == VCALL && nret == 1) { /* tail call? */+ SET_OPCODE(getinstruction(fs,&e), OP_TAILCALL);+ lua_assert(GETARG_A(getinstruction(fs,&e)) == fs->nactvar);+ }+ first = fs->nactvar;+ nret = LUA_MULTRET; /* return all values */+ }+ else {+ if (nret == 1) /* only one single value? */+ first = luaK_exp2anyreg(fs, &e);+ else {+ luaK_exp2nextreg(fs, &e); /* values must go to the stack */+ first = fs->nactvar; /* return all active values */+ lua_assert(nret == fs->freereg - first);+ }+ }+ }+ luaK_ret(fs, first, nret);+ testnext(ls, ';'); /* skip optional semicolon */+}+++static void statement (LexState *ls) {+ int line = ls->linenumber; /* may be needed for error messages */+ enterlevel(ls);+ switch (ls->t.token) {+ case ';': { /* stat -> ';' (empty statement) */+ luaX_next(ls); /* skip ';' */+ break;+ }+ case TK_IF: { /* stat -> ifstat */+ ifstat(ls, line);+ break;+ }+ case TK_WHILE: { /* stat -> whilestat */+ whilestat(ls, line);+ break;+ }+ case TK_DO: { /* stat -> DO block END */+ luaX_next(ls); /* skip DO */+ block(ls);+ check_match(ls, TK_END, TK_DO, line);+ break;+ }+ case TK_FOR: { /* stat -> forstat */+ forstat(ls, line);+ break;+ }+ case TK_REPEAT: { /* stat -> repeatstat */+ repeatstat(ls, line);+ break;+ }+ case TK_FUNCTION: { /* stat -> funcstat */+ funcstat(ls, line);+ break;+ }+ case TK_LOCAL: { /* stat -> localstat */+ luaX_next(ls); /* skip LOCAL */+ if (testnext(ls, TK_FUNCTION)) /* local function? */+ localfunc(ls);+ else+ localstat(ls);+ break;+ }+ case TK_DBCOLON: { /* stat -> label */+ luaX_next(ls); /* skip double colon */+ labelstat(ls, str_checkname(ls), line);+ break;+ }+ case TK_RETURN: { /* stat -> retstat */+ luaX_next(ls); /* skip RETURN */+ retstat(ls);+ break;+ }+ case TK_BREAK: /* stat -> breakstat */+ case TK_GOTO: { /* stat -> 'goto' NAME */+ gotostat(ls, luaK_jump(ls->fs));+ break;+ }+ default: { /* stat -> func | assignment */+ exprstat(ls);+ break;+ }+ }+ lua_assert(ls->fs->f->maxstacksize >= ls->fs->freereg &&+ ls->fs->freereg >= ls->fs->nactvar);+ ls->fs->freereg = ls->fs->nactvar; /* free registers */+ leavelevel(ls);+}++/* }====================================================================== */+++/*+** compiles the main function, which is a regular vararg function with an+** upvalue named LUA_ENV+*/+static void mainfunc (LexState *ls, FuncState *fs) {+ BlockCnt bl;+ expdesc v;+ open_func(ls, fs, &bl);+ fs->f->is_vararg = 1; /* main function is always declared vararg */+ init_exp(&v, VLOCAL, 0); /* create and... */+ newupvalue(fs, ls->envn, &v); /* ...set environment upvalue */+ luaC_objbarrier(ls->L, fs->f, ls->envn);+ luaX_next(ls); /* read first token */+ statlist(ls); /* parse main body */+ check(ls, TK_EOS);+ close_func(ls);+}+++LClosure *luaY_parser (lua_State *L, ZIO *z, Mbuffer *buff,+ Dyndata *dyd, const char *name, int firstchar) {+ LexState lexstate;+ FuncState funcstate;+ LClosure *cl = luaF_newLclosure(L, 1); /* create main closure */+ setclLvalue(L, L->top, cl); /* anchor it (to avoid being collected) */+ luaD_inctop(L);+ lexstate.h = luaH_new(L); /* create table for scanner */+ sethvalue(L, L->top, lexstate.h); /* anchor it */+ luaD_inctop(L);+ funcstate.f = cl->p = luaF_newproto(L);+ luaC_objbarrier(L, cl, cl->p);+ funcstate.f->source = luaS_new(L, name); /* create and anchor TString */+ lua_assert(iswhite(funcstate.f)); /* do not need barrier here */+ lexstate.buff = buff;+ lexstate.dyd = dyd;+ dyd->actvar.n = dyd->gt.n = dyd->label.n = 0;+ luaX_setinput(L, &lexstate, z, funcstate.f->source, firstchar);+ mainfunc(&lexstate, &funcstate);+ lua_assert(!funcstate.prev && funcstate.nups == 1 && !lexstate.fs);+ /* all scopes should be correctly finished */+ lua_assert(dyd->actvar.n == 0 && dyd->gt.n == 0 && dyd->label.n == 0);+ L->top--; /* remove scanner's table */+ return cl; /* closure is on the stack, too */+}+
+ cbits/lua-5.3.6/lparser.h view
@@ -0,0 +1,133 @@+/*+** $Id: lparser.h,v 1.76.1.1 2017/04/19 17:20:42 roberto Exp $+** Lua Parser+** See Copyright Notice in lua.h+*/++#ifndef lparser_h+#define lparser_h++#include "llimits.h"+#include "lobject.h"+#include "lzio.h"+++/*+** Expression and variable descriptor.+** Code generation for variables and expressions can be delayed to allow+** optimizations; An 'expdesc' structure describes a potentially-delayed+** variable/expression. It has a description of its "main" value plus a+** list of conditional jumps that can also produce its value (generated+** by short-circuit operators 'and'/'or').+*/++/* kinds of variables/expressions */+typedef enum {+ VVOID, /* when 'expdesc' describes the last expression a list,+ this kind means an empty list (so, no expression) */+ VNIL, /* constant nil */+ VTRUE, /* constant true */+ VFALSE, /* constant false */+ VK, /* constant in 'k'; info = index of constant in 'k' */+ VKFLT, /* floating constant; nval = numerical float value */+ VKINT, /* integer constant; nval = numerical integer value */+ VNONRELOC, /* expression has its value in a fixed register;+ info = result register */+ VLOCAL, /* local variable; info = local register */+ VUPVAL, /* upvalue variable; info = index of upvalue in 'upvalues' */+ VINDEXED, /* indexed variable;+ ind.vt = whether 't' is register or upvalue;+ ind.t = table register or upvalue;+ ind.idx = key's R/K index */+ VJMP, /* expression is a test/comparison;+ info = pc of corresponding jump instruction */+ VRELOCABLE, /* expression can put result in any register;+ info = instruction pc */+ VCALL, /* expression is a function call; info = instruction pc */+ VVARARG /* vararg expression; info = instruction pc */+} expkind;+++#define vkisvar(k) (VLOCAL <= (k) && (k) <= VINDEXED)+#define vkisinreg(k) ((k) == VNONRELOC || (k) == VLOCAL)++typedef struct expdesc {+ expkind k;+ union {+ lua_Integer ival; /* for VKINT */+ lua_Number nval; /* for VKFLT */+ int info; /* for generic use */+ struct { /* for indexed variables (VINDEXED) */+ short idx; /* index (R/K) */+ lu_byte t; /* table (register or upvalue) */+ lu_byte vt; /* whether 't' is register (VLOCAL) or upvalue (VUPVAL) */+ } ind;+ } u;+ int t; /* patch list of 'exit when true' */+ int f; /* patch list of 'exit when false' */+} expdesc;+++/* description of active local variable */+typedef struct Vardesc {+ short idx; /* variable index in stack */+} Vardesc;+++/* description of pending goto statements and label statements */+typedef struct Labeldesc {+ TString *name; /* label identifier */+ int pc; /* position in code */+ int line; /* line where it appeared */+ lu_byte nactvar; /* local level where it appears in current block */+} Labeldesc;+++/* list of labels or gotos */+typedef struct Labellist {+ Labeldesc *arr; /* array */+ int n; /* number of entries in use */+ int size; /* array size */+} Labellist;+++/* dynamic structures used by the parser */+typedef struct Dyndata {+ struct { /* list of active local variables */+ Vardesc *arr;+ int n;+ int size;+ } actvar;+ Labellist gt; /* list of pending gotos */+ Labellist label; /* list of active labels */+} Dyndata;+++/* control of blocks */+struct BlockCnt; /* defined in lparser.c */+++/* state needed to generate code for a given function */+typedef struct FuncState {+ Proto *f; /* current function header */+ struct FuncState *prev; /* enclosing function */+ struct LexState *ls; /* lexical state */+ struct BlockCnt *bl; /* chain of current blocks */+ int pc; /* next position to code (equivalent to 'ncode') */+ int lasttarget; /* 'label' of last 'jump label' */+ int jpc; /* list of pending jumps to 'pc' */+ int nk; /* number of elements in 'k' */+ int np; /* number of elements in 'p' */+ int firstlocal; /* index of first local var (in Dyndata array) */+ short nlocvars; /* number of elements in 'f->locvars' */+ lu_byte nactvar; /* number of active local variables */+ lu_byte nups; /* number of upvalues */+ lu_byte freereg; /* first free register */+} FuncState;+++LUAI_FUNC LClosure *luaY_parser (lua_State *L, ZIO *z, Mbuffer *buff,+ Dyndata *dyd, const char *name, int firstchar);+++#endif
+ cbits/lua-5.3.6/lprefix.h view
@@ -0,0 +1,45 @@+/*+** $Id: lprefix.h,v 1.2.1.1 2017/04/19 17:20:42 roberto Exp $+** Definitions for Lua code that must come before any other header file+** See Copyright Notice in lua.h+*/++#ifndef lprefix_h+#define lprefix_h+++/*+** Allows POSIX/XSI stuff+*/+#if !defined(LUA_USE_C89) /* { */++#if !defined(_XOPEN_SOURCE)+#define _XOPEN_SOURCE 600+#elif _XOPEN_SOURCE == 0+#undef _XOPEN_SOURCE /* use -D_XOPEN_SOURCE=0 to undefine it */+#endif++/*+** Allows manipulation of large files in gcc and some other compilers+*/+#if !defined(LUA_32BITS) && !defined(_FILE_OFFSET_BITS)+#define _LARGEFILE_SOURCE 1+#define _FILE_OFFSET_BITS 64+#endif++#endif /* } */+++/*+** Windows stuff+*/+#if defined(_WIN32) /* { */++#if !defined(_CRT_SECURE_NO_WARNINGS)+#define _CRT_SECURE_NO_WARNINGS /* avoid warnings about ISO C functions */+#endif++#endif /* } */++#endif+
+ cbits/lua-5.3.6/lstate.c view
@@ -0,0 +1,347 @@+/*+** $Id: lstate.c,v 2.133.1.1 2017/04/19 17:39:34 roberto Exp $+** Global State+** See Copyright Notice in lua.h+*/++#define lstate_c+#define LUA_CORE++#include "lprefix.h"+++#include <stddef.h>+#include <string.h>++#include "lua.h"++#include "lapi.h"+#include "ldebug.h"+#include "ldo.h"+#include "lfunc.h"+#include "lgc.h"+#include "llex.h"+#include "lmem.h"+#include "lstate.h"+#include "lstring.h"+#include "ltable.h"+#include "ltm.h"+++#if !defined(LUAI_GCPAUSE)+#define LUAI_GCPAUSE 200 /* 200% */+#endif++#if !defined(LUAI_GCMUL)+#define LUAI_GCMUL 200 /* GC runs 'twice the speed' of memory allocation */+#endif+++/*+** a macro to help the creation of a unique random seed when a state is+** created; the seed is used to randomize hashes.+*/+#if !defined(luai_makeseed)+#include <time.h>+#define luai_makeseed() cast(unsigned int, time(NULL))+#endif++++/*+** thread state + extra space+*/+typedef struct LX {+ lu_byte extra_[LUA_EXTRASPACE];+ lua_State l;+} LX;+++/*+** Main thread combines a thread state and the global state+*/+typedef struct LG {+ LX l;+ global_State g;+} LG;++++#define fromstate(L) (cast(LX *, cast(lu_byte *, (L)) - offsetof(LX, l)))+++/*+** Compute an initial seed as random as possible. Rely on Address Space+** Layout Randomization (if present) to increase randomness..+*/+#define addbuff(b,p,e) \+ { size_t t = cast(size_t, e); \+ memcpy(b + p, &t, sizeof(t)); p += sizeof(t); }++static unsigned int makeseed (lua_State *L) {+ char buff[4 * sizeof(size_t)];+ unsigned int h = luai_makeseed();+ int p = 0;+ addbuff(buff, p, L); /* heap variable */+ addbuff(buff, p, &h); /* local variable */+ addbuff(buff, p, luaO_nilobject); /* global variable */+ addbuff(buff, p, &lua_newstate); /* public function */+ lua_assert(p == sizeof(buff));+ return luaS_hash(buff, p, h);+}+++/*+** set GCdebt to a new value keeping the value (totalbytes + GCdebt)+** invariant (and avoiding underflows in 'totalbytes')+*/+void luaE_setdebt (global_State *g, l_mem debt) {+ l_mem tb = gettotalbytes(g);+ lua_assert(tb > 0);+ if (debt < tb - MAX_LMEM)+ debt = tb - MAX_LMEM; /* will make 'totalbytes == MAX_LMEM' */+ g->totalbytes = tb - debt;+ g->GCdebt = debt;+}+++CallInfo *luaE_extendCI (lua_State *L) {+ CallInfo *ci = luaM_new(L, CallInfo);+ lua_assert(L->ci->next == NULL);+ L->ci->next = ci;+ ci->previous = L->ci;+ ci->next = NULL;+ L->nci++;+ return ci;+}+++/*+** free all CallInfo structures not in use by a thread+*/+void luaE_freeCI (lua_State *L) {+ CallInfo *ci = L->ci;+ CallInfo *next = ci->next;+ ci->next = NULL;+ while ((ci = next) != NULL) {+ next = ci->next;+ luaM_free(L, ci);+ L->nci--;+ }+}+++/*+** free half of the CallInfo structures not in use by a thread+*/+void luaE_shrinkCI (lua_State *L) {+ CallInfo *ci = L->ci;+ CallInfo *next2; /* next's next */+ /* while there are two nexts */+ while (ci->next != NULL && (next2 = ci->next->next) != NULL) {+ luaM_free(L, ci->next); /* free next */+ L->nci--;+ ci->next = next2; /* remove 'next' from the list */+ next2->previous = ci;+ ci = next2; /* keep next's next */+ }+}+++static void stack_init (lua_State *L1, lua_State *L) {+ int i; CallInfo *ci;+ /* initialize stack array */+ L1->stack = luaM_newvector(L, BASIC_STACK_SIZE, TValue);+ L1->stacksize = BASIC_STACK_SIZE;+ for (i = 0; i < BASIC_STACK_SIZE; i++)+ setnilvalue(L1->stack + i); /* erase new stack */+ L1->top = L1->stack;+ L1->stack_last = L1->stack + L1->stacksize - EXTRA_STACK;+ /* initialize first ci */+ ci = &L1->base_ci;+ ci->next = ci->previous = NULL;+ ci->callstatus = 0;+ ci->func = L1->top;+ setnilvalue(L1->top++); /* 'function' entry for this 'ci' */+ ci->top = L1->top + LUA_MINSTACK;+ L1->ci = ci;+}+++static void freestack (lua_State *L) {+ if (L->stack == NULL)+ return; /* stack not completely built yet */+ L->ci = &L->base_ci; /* free the entire 'ci' list */+ luaE_freeCI(L);+ lua_assert(L->nci == 0);+ luaM_freearray(L, L->stack, L->stacksize); /* free stack array */+}+++/*+** Create registry table and its predefined values+*/+static void init_registry (lua_State *L, global_State *g) {+ TValue temp;+ /* create registry */+ Table *registry = luaH_new(L);+ sethvalue(L, &g->l_registry, registry);+ luaH_resize(L, registry, LUA_RIDX_LAST, 0);+ /* registry[LUA_RIDX_MAINTHREAD] = L */+ setthvalue(L, &temp, L); /* temp = L */+ luaH_setint(L, registry, LUA_RIDX_MAINTHREAD, &temp);+ /* registry[LUA_RIDX_GLOBALS] = table of globals */+ sethvalue(L, &temp, luaH_new(L)); /* temp = new table (global table) */+ luaH_setint(L, registry, LUA_RIDX_GLOBALS, &temp);+}+++/*+** open parts of the state that may cause memory-allocation errors.+** ('g->version' != NULL flags that the state was completely build)+*/+static void f_luaopen (lua_State *L, void *ud) {+ global_State *g = G(L);+ UNUSED(ud);+ stack_init(L, L); /* init stack */+ init_registry(L, g);+ luaS_init(L);+ luaT_init(L);+ luaX_init(L);+ g->gcrunning = 1; /* allow gc */+ g->version = lua_version(NULL);+ luai_userstateopen(L);+}+++/*+** preinitialize a thread with consistent values without allocating+** any memory (to avoid errors)+*/+static void preinit_thread (lua_State *L, global_State *g) {+ G(L) = g;+ L->stack = NULL;+ L->ci = NULL;+ L->nci = 0;+ L->stacksize = 0;+ L->twups = L; /* thread has no upvalues */+ L->errorJmp = NULL;+ L->nCcalls = 0;+ L->hook = NULL;+ L->hookmask = 0;+ L->basehookcount = 0;+ L->allowhook = 1;+ resethookcount(L);+ L->openupval = NULL;+ L->nny = 1;+ L->status = LUA_OK;+ L->errfunc = 0;+}+++static void close_state (lua_State *L) {+ global_State *g = G(L);+ luaF_close(L, L->stack); /* close all upvalues for this thread */+ luaC_freeallobjects(L); /* collect all objects */+ if (g->version) /* closing a fully built state? */+ luai_userstateclose(L);+ luaM_freearray(L, G(L)->strt.hash, G(L)->strt.size);+ freestack(L);+ lua_assert(gettotalbytes(g) == sizeof(LG));+ (*g->frealloc)(g->ud, fromstate(L), sizeof(LG), 0); /* free main block */+}+++LUA_API lua_State *lua_newthread (lua_State *L) {+ global_State *g = G(L);+ lua_State *L1;+ lua_lock(L);+ luaC_checkGC(L);+ /* create new thread */+ L1 = &cast(LX *, luaM_newobject(L, LUA_TTHREAD, sizeof(LX)))->l;+ L1->marked = luaC_white(g);+ L1->tt = LUA_TTHREAD;+ /* link it on list 'allgc' */+ L1->next = g->allgc;+ g->allgc = obj2gco(L1);+ /* anchor it on L stack */+ setthvalue(L, L->top, L1);+ api_incr_top(L);+ preinit_thread(L1, g);+ L1->hookmask = L->hookmask;+ L1->basehookcount = L->basehookcount;+ L1->hook = L->hook;+ resethookcount(L1);+ /* initialize L1 extra space */+ memcpy(lua_getextraspace(L1), lua_getextraspace(g->mainthread),+ LUA_EXTRASPACE);+ luai_userstatethread(L, L1);+ stack_init(L1, L); /* init stack */+ lua_unlock(L);+ return L1;+}+++void luaE_freethread (lua_State *L, lua_State *L1) {+ LX *l = fromstate(L1);+ luaF_close(L1, L1->stack); /* close all upvalues for this thread */+ lua_assert(L1->openupval == NULL);+ luai_userstatefree(L, L1);+ freestack(L1);+ luaM_free(L, l);+}+++LUA_API lua_State *lua_newstate (lua_Alloc f, void *ud) {+ int i;+ lua_State *L;+ global_State *g;+ LG *l = cast(LG *, (*f)(ud, NULL, LUA_TTHREAD, sizeof(LG)));+ if (l == NULL) return NULL;+ L = &l->l.l;+ g = &l->g;+ L->next = NULL;+ L->tt = LUA_TTHREAD;+ g->currentwhite = bitmask(WHITE0BIT);+ L->marked = luaC_white(g);+ preinit_thread(L, g);+ g->frealloc = f;+ g->ud = ud;+ g->mainthread = L;+ g->seed = makeseed(L);+ g->gcrunning = 0; /* no GC while building state */+ g->GCestimate = 0;+ g->strt.size = g->strt.nuse = 0;+ g->strt.hash = NULL;+ setnilvalue(&g->l_registry);+ g->panic = NULL;+ g->version = NULL;+ g->gcstate = GCSpause;+ g->gckind = KGC_NORMAL;+ g->allgc = g->finobj = g->tobefnz = g->fixedgc = NULL;+ g->sweepgc = NULL;+ g->gray = g->grayagain = NULL;+ g->weak = g->ephemeron = g->allweak = NULL;+ g->twups = NULL;+ g->totalbytes = sizeof(LG);+ g->GCdebt = 0;+ g->gcfinnum = 0;+ g->gcpause = LUAI_GCPAUSE;+ g->gcstepmul = LUAI_GCMUL;+ for (i=0; i < LUA_NUMTAGS; i++) g->mt[i] = NULL;+ if (luaD_rawrunprotected(L, f_luaopen, NULL) != LUA_OK) {+ /* memory allocation error: free partial state */+ close_state(L);+ L = NULL;+ }+ return L;+}+++LUA_API void lua_close (lua_State *L) {+ L = G(L)->mainthread; /* only the main thread can be closed */+ lua_lock(L);+ close_state(L);+}++
+ cbits/lua-5.3.6/lstate.h view
@@ -0,0 +1,253 @@+/*+** $Id: lstate.h,v 2.133.1.1 2017/04/19 17:39:34 roberto Exp $+** Global State+** See Copyright Notice in lua.h+*/++#ifndef lstate_h+#define lstate_h++#include "lua.h"++#include "lobject.h"+#include "ltm.h"+#include "lzio.h"+++/*++** Some notes about garbage-collected objects: All objects in Lua must+** be kept somehow accessible until being freed, so all objects always+** belong to one (and only one) of these lists, using field 'next' of+** the 'CommonHeader' for the link:+**+** 'allgc': all objects not marked for finalization;+** 'finobj': all objects marked for finalization;+** 'tobefnz': all objects ready to be finalized;+** 'fixedgc': all objects that are not to be collected (currently+** only small strings, such as reserved words).+**+** Moreover, there is another set of lists that control gray objects.+** These lists are linked by fields 'gclist'. (All objects that+** can become gray have such a field. The field is not the same+** in all objects, but it always has this name.) Any gray object+** must belong to one of these lists, and all objects in these lists+** must be gray:+**+** 'gray': regular gray objects, still waiting to be visited.+** 'grayagain': objects that must be revisited at the atomic phase.+** That includes+** - black objects got in a write barrier;+** - all kinds of weak tables during propagation phase;+** - all threads.+** 'weak': tables with weak values to be cleared;+** 'ephemeron': ephemeron tables with white->white entries;+** 'allweak': tables with weak keys and/or weak values to be cleared.+** The last three lists are used only during the atomic phase.++*/+++struct lua_longjmp; /* defined in ldo.c */+++/*+** Atomic type (relative to signals) to better ensure that 'lua_sethook'+** is thread safe+*/+#if !defined(l_signalT)+#include <signal.h>+#define l_signalT sig_atomic_t+#endif+++/* extra stack space to handle TM calls and some other extras */+#define EXTRA_STACK 5+++#define BASIC_STACK_SIZE (2*LUA_MINSTACK)+++/* kinds of Garbage Collection */+#define KGC_NORMAL 0+#define KGC_EMERGENCY 1 /* gc was forced by an allocation failure */+++typedef struct stringtable {+ TString **hash;+ int nuse; /* number of elements */+ int size;+} stringtable;+++/*+** Information about a call.+** When a thread yields, 'func' is adjusted to pretend that the+** top function has only the yielded values in its stack; in that+** case, the actual 'func' value is saved in field 'extra'.+** When a function calls another with a continuation, 'extra' keeps+** the function index so that, in case of errors, the continuation+** function can be called with the correct top.+*/+typedef struct CallInfo {+ StkId func; /* function index in the stack */+ StkId top; /* top for this function */+ struct CallInfo *previous, *next; /* dynamic call link */+ union {+ struct { /* only for Lua functions */+ StkId base; /* base for this function */+ const Instruction *savedpc;+ } l;+ struct { /* only for C functions */+ lua_KFunction k; /* continuation in case of yields */+ ptrdiff_t old_errfunc;+ lua_KContext ctx; /* context info. in case of yields */+ } c;+ } u;+ ptrdiff_t extra;+ short nresults; /* expected number of results from this function */+ unsigned short callstatus;+} CallInfo;+++/*+** Bits in CallInfo status+*/+#define CIST_OAH (1<<0) /* original value of 'allowhook' */+#define CIST_LUA (1<<1) /* call is running a Lua function */+#define CIST_HOOKED (1<<2) /* call is running a debug hook */+#define CIST_FRESH (1<<3) /* call is running on a fresh invocation+ of luaV_execute */+#define CIST_YPCALL (1<<4) /* call is a yieldable protected call */+#define CIST_TAIL (1<<5) /* call was tail called */+#define CIST_HOOKYIELD (1<<6) /* last hook called yielded */+#define CIST_LEQ (1<<7) /* using __lt for __le */+#define CIST_FIN (1<<8) /* call is running a finalizer */++#define isLua(ci) ((ci)->callstatus & CIST_LUA)++/* assume that CIST_OAH has offset 0 and that 'v' is strictly 0/1 */+#define setoah(st,v) ((st) = ((st) & ~CIST_OAH) | (v))+#define getoah(st) ((st) & CIST_OAH)+++/*+** 'global state', shared by all threads of this state+*/+typedef struct global_State {+ lua_Alloc frealloc; /* function to reallocate memory */+ void *ud; /* auxiliary data to 'frealloc' */+ l_mem totalbytes; /* number of bytes currently allocated - GCdebt */+ l_mem GCdebt; /* bytes allocated not yet compensated by the collector */+ lu_mem GCmemtrav; /* memory traversed by the GC */+ lu_mem GCestimate; /* an estimate of the non-garbage memory in use */+ stringtable strt; /* hash table for strings */+ TValue l_registry;+ unsigned int seed; /* randomized seed for hashes */+ lu_byte currentwhite;+ lu_byte gcstate; /* state of garbage collector */+ lu_byte gckind; /* kind of GC running */+ lu_byte gcrunning; /* true if GC is running */+ GCObject *allgc; /* list of all collectable objects */+ GCObject **sweepgc; /* current position of sweep in list */+ GCObject *finobj; /* list of collectable objects with finalizers */+ GCObject *gray; /* list of gray objects */+ GCObject *grayagain; /* list of objects to be traversed atomically */+ GCObject *weak; /* list of tables with weak values */+ GCObject *ephemeron; /* list of ephemeron tables (weak keys) */+ GCObject *allweak; /* list of all-weak tables */+ GCObject *tobefnz; /* list of userdata to be GC */+ GCObject *fixedgc; /* list of objects not to be collected */+ struct lua_State *twups; /* list of threads with open upvalues */+ unsigned int gcfinnum; /* number of finalizers to call in each GC step */+ int gcpause; /* size of pause between successive GCs */+ int gcstepmul; /* GC 'granularity' */+ lua_CFunction panic; /* to be called in unprotected errors */+ struct lua_State *mainthread;+ const lua_Number *version; /* pointer to version number */+ TString *memerrmsg; /* memory-error message */+ TString *tmname[TM_N]; /* array with tag-method names */+ struct Table *mt[LUA_NUMTAGS]; /* metatables for basic types */+ TString *strcache[STRCACHE_N][STRCACHE_M]; /* cache for strings in API */+} global_State;+++/*+** 'per thread' state+*/+struct lua_State {+ CommonHeader;+ unsigned short nci; /* number of items in 'ci' list */+ lu_byte status;+ StkId top; /* first free slot in the stack */+ global_State *l_G;+ CallInfo *ci; /* call info for current function */+ const Instruction *oldpc; /* last pc traced */+ StkId stack_last; /* last free slot in the stack */+ StkId stack; /* stack base */+ UpVal *openupval; /* list of open upvalues in this stack */+ GCObject *gclist;+ struct lua_State *twups; /* list of threads with open upvalues */+ struct lua_longjmp *errorJmp; /* current error recover point */+ CallInfo base_ci; /* CallInfo for first level (C calling Lua) */+ volatile lua_Hook hook;+ ptrdiff_t errfunc; /* current error handling function (stack index) */+ int stacksize;+ int basehookcount;+ int hookcount;+ unsigned short nny; /* number of non-yieldable calls in stack */+ unsigned short nCcalls; /* number of nested C calls */+ l_signalT hookmask;+ lu_byte allowhook;+};+++#define G(L) (L->l_G)+++/*+** Union of all collectable objects (only for conversions)+*/+union GCUnion {+ GCObject gc; /* common header */+ struct TString ts;+ struct Udata u;+ union Closure cl;+ struct Table h;+ struct Proto p;+ struct lua_State th; /* thread */+};+++#define cast_u(o) cast(union GCUnion *, (o))++/* macros to convert a GCObject into a specific value */+#define gco2ts(o) \+ check_exp(novariant((o)->tt) == LUA_TSTRING, &((cast_u(o))->ts))+#define gco2u(o) check_exp((o)->tt == LUA_TUSERDATA, &((cast_u(o))->u))+#define gco2lcl(o) check_exp((o)->tt == LUA_TLCL, &((cast_u(o))->cl.l))+#define gco2ccl(o) check_exp((o)->tt == LUA_TCCL, &((cast_u(o))->cl.c))+#define gco2cl(o) \+ check_exp(novariant((o)->tt) == LUA_TFUNCTION, &((cast_u(o))->cl))+#define gco2t(o) check_exp((o)->tt == LUA_TTABLE, &((cast_u(o))->h))+#define gco2p(o) check_exp((o)->tt == LUA_TPROTO, &((cast_u(o))->p))+#define gco2th(o) check_exp((o)->tt == LUA_TTHREAD, &((cast_u(o))->th))+++/* macro to convert a Lua object into a GCObject */+#define obj2gco(v) \+ check_exp(novariant((v)->tt) < LUA_TDEADKEY, (&(cast_u(v)->gc)))+++/* actual number of total bytes allocated */+#define gettotalbytes(g) cast(lu_mem, (g)->totalbytes + (g)->GCdebt)++LUAI_FUNC void luaE_setdebt (global_State *g, l_mem debt);+LUAI_FUNC void luaE_freethread (lua_State *L, lua_State *L1);+LUAI_FUNC CallInfo *luaE_extendCI (lua_State *L);+LUAI_FUNC void luaE_freeCI (lua_State *L);+LUAI_FUNC void luaE_shrinkCI (lua_State *L);+++#endif+
+ cbits/lua-5.3.6/lstring.c view
@@ -0,0 +1,248 @@+/*+** $Id: lstring.c,v 2.56.1.1 2017/04/19 17:20:42 roberto Exp $+** String table (keeps all strings handled by Lua)+** See Copyright Notice in lua.h+*/++#define lstring_c+#define LUA_CORE++#include "lprefix.h"+++#include <string.h>++#include "lua.h"++#include "ldebug.h"+#include "ldo.h"+#include "lmem.h"+#include "lobject.h"+#include "lstate.h"+#include "lstring.h"+++#define MEMERRMSG "not enough memory"+++/*+** Lua will use at most ~(2^LUAI_HASHLIMIT) bytes from a string to+** compute its hash+*/+#if !defined(LUAI_HASHLIMIT)+#define LUAI_HASHLIMIT 5+#endif+++/*+** equality for long strings+*/+int luaS_eqlngstr (TString *a, TString *b) {+ size_t len = a->u.lnglen;+ lua_assert(a->tt == LUA_TLNGSTR && b->tt == LUA_TLNGSTR);+ return (a == b) || /* same instance or... */+ ((len == b->u.lnglen) && /* equal length and ... */+ (memcmp(getstr(a), getstr(b), len) == 0)); /* equal contents */+}+++unsigned int luaS_hash (const char *str, size_t l, unsigned int seed) {+ unsigned int h = seed ^ cast(unsigned int, l);+ size_t step = (l >> LUAI_HASHLIMIT) + 1;+ for (; l >= step; l -= step)+ h ^= ((h<<5) + (h>>2) + cast_byte(str[l - 1]));+ return h;+}+++unsigned int luaS_hashlongstr (TString *ts) {+ lua_assert(ts->tt == LUA_TLNGSTR);+ if (ts->extra == 0) { /* no hash? */+ ts->hash = luaS_hash(getstr(ts), ts->u.lnglen, ts->hash);+ ts->extra = 1; /* now it has its hash */+ }+ return ts->hash;+}+++/*+** resizes the string table+*/+void luaS_resize (lua_State *L, int newsize) {+ int i;+ stringtable *tb = &G(L)->strt;+ if (newsize > tb->size) { /* grow table if needed */+ luaM_reallocvector(L, tb->hash, tb->size, newsize, TString *);+ for (i = tb->size; i < newsize; i++)+ tb->hash[i] = NULL;+ }+ for (i = 0; i < tb->size; i++) { /* rehash */+ TString *p = tb->hash[i];+ tb->hash[i] = NULL;+ while (p) { /* for each node in the list */+ TString *hnext = p->u.hnext; /* save next */+ unsigned int h = lmod(p->hash, newsize); /* new position */+ p->u.hnext = tb->hash[h]; /* chain it */+ tb->hash[h] = p;+ p = hnext;+ }+ }+ if (newsize < tb->size) { /* shrink table if needed */+ /* vanishing slice should be empty */+ lua_assert(tb->hash[newsize] == NULL && tb->hash[tb->size - 1] == NULL);+ luaM_reallocvector(L, tb->hash, tb->size, newsize, TString *);+ }+ tb->size = newsize;+}+++/*+** Clear API string cache. (Entries cannot be empty, so fill them with+** a non-collectable string.)+*/+void luaS_clearcache (global_State *g) {+ int i, j;+ for (i = 0; i < STRCACHE_N; i++)+ for (j = 0; j < STRCACHE_M; j++) {+ if (iswhite(g->strcache[i][j])) /* will entry be collected? */+ g->strcache[i][j] = g->memerrmsg; /* replace it with something fixed */+ }+}+++/*+** Initialize the string table and the string cache+*/+void luaS_init (lua_State *L) {+ global_State *g = G(L);+ int i, j;+ luaS_resize(L, MINSTRTABSIZE); /* initial size of string table */+ /* pre-create memory-error message */+ g->memerrmsg = luaS_newliteral(L, MEMERRMSG);+ luaC_fix(L, obj2gco(g->memerrmsg)); /* it should never be collected */+ for (i = 0; i < STRCACHE_N; i++) /* fill cache with valid strings */+ for (j = 0; j < STRCACHE_M; j++)+ g->strcache[i][j] = g->memerrmsg;+}++++/*+** creates a new string object+*/+static TString *createstrobj (lua_State *L, size_t l, int tag, unsigned int h) {+ TString *ts;+ GCObject *o;+ size_t totalsize; /* total size of TString object */+ totalsize = sizelstring(l);+ o = luaC_newobj(L, tag, totalsize);+ ts = gco2ts(o);+ ts->hash = h;+ ts->extra = 0;+ getstr(ts)[l] = '\0'; /* ending 0 */+ return ts;+}+++TString *luaS_createlngstrobj (lua_State *L, size_t l) {+ TString *ts = createstrobj(L, l, LUA_TLNGSTR, G(L)->seed);+ ts->u.lnglen = l;+ return ts;+}+++void luaS_remove (lua_State *L, TString *ts) {+ stringtable *tb = &G(L)->strt;+ TString **p = &tb->hash[lmod(ts->hash, tb->size)];+ while (*p != ts) /* find previous element */+ p = &(*p)->u.hnext;+ *p = (*p)->u.hnext; /* remove element from its list */+ tb->nuse--;+}+++/*+** checks whether short string exists and reuses it or creates a new one+*/+static TString *internshrstr (lua_State *L, const char *str, size_t l) {+ TString *ts;+ global_State *g = G(L);+ unsigned int h = luaS_hash(str, l, g->seed);+ TString **list = &g->strt.hash[lmod(h, g->strt.size)];+ lua_assert(str != NULL); /* otherwise 'memcmp'/'memcpy' are undefined */+ for (ts = *list; ts != NULL; ts = ts->u.hnext) {+ if (l == ts->shrlen &&+ (memcmp(str, getstr(ts), l * sizeof(char)) == 0)) {+ /* found! */+ if (isdead(g, ts)) /* dead (but not collected yet)? */+ changewhite(ts); /* resurrect it */+ return ts;+ }+ }+ if (g->strt.nuse >= g->strt.size && g->strt.size <= MAX_INT/2) {+ luaS_resize(L, g->strt.size * 2);+ list = &g->strt.hash[lmod(h, g->strt.size)]; /* recompute with new size */+ }+ ts = createstrobj(L, l, LUA_TSHRSTR, h);+ memcpy(getstr(ts), str, l * sizeof(char));+ ts->shrlen = cast_byte(l);+ ts->u.hnext = *list;+ *list = ts;+ g->strt.nuse++;+ return ts;+}+++/*+** new string (with explicit length)+*/+TString *luaS_newlstr (lua_State *L, const char *str, size_t l) {+ if (l <= LUAI_MAXSHORTLEN) /* short string? */+ return internshrstr(L, str, l);+ else {+ TString *ts;+ if (l >= (MAX_SIZE - sizeof(TString))/sizeof(char))+ luaM_toobig(L);+ ts = luaS_createlngstrobj(L, l);+ memcpy(getstr(ts), str, l * sizeof(char));+ return ts;+ }+}+++/*+** Create or reuse a zero-terminated string, first checking in the+** cache (using the string address as a key). The cache can contain+** only zero-terminated strings, so it is safe to use 'strcmp' to+** check hits.+*/+TString *luaS_new (lua_State *L, const char *str) {+ unsigned int i = point2uint(str) % STRCACHE_N; /* hash */+ int j;+ TString **p = G(L)->strcache[i];+ for (j = 0; j < STRCACHE_M; j++) {+ if (strcmp(str, getstr(p[j])) == 0) /* hit? */+ return p[j]; /* that is it */+ }+ /* normal route */+ for (j = STRCACHE_M - 1; j > 0; j--)+ p[j] = p[j - 1]; /* move out last element */+ /* new element is first in the list */+ p[0] = luaS_newlstr(L, str, strlen(str));+ return p[0];+}+++Udata *luaS_newudata (lua_State *L, size_t s) {+ Udata *u;+ GCObject *o;+ if (s > MAX_SIZE - sizeof(Udata))+ luaM_toobig(L);+ o = luaC_newobj(L, LUA_TUSERDATA, sizeludata(s));+ u = gco2u(o);+ u->len = s;+ u->metatable = NULL;+ setuservalue(L, u, luaO_nilobject);+ return u;+}+
+ cbits/lua-5.3.6/lstring.h view
@@ -0,0 +1,49 @@+/*+** $Id: lstring.h,v 1.61.1.1 2017/04/19 17:20:42 roberto Exp $+** String table (keep all strings handled by Lua)+** See Copyright Notice in lua.h+*/++#ifndef lstring_h+#define lstring_h++#include "lgc.h"+#include "lobject.h"+#include "lstate.h"+++#define sizelstring(l) (sizeof(union UTString) + ((l) + 1) * sizeof(char))++#define sizeludata(l) (sizeof(union UUdata) + (l))+#define sizeudata(u) sizeludata((u)->len)++#define luaS_newliteral(L, s) (luaS_newlstr(L, "" s, \+ (sizeof(s)/sizeof(char))-1))+++/*+** test whether a string is a reserved word+*/+#define isreserved(s) ((s)->tt == LUA_TSHRSTR && (s)->extra > 0)+++/*+** equality for short strings, which are always internalized+*/+#define eqshrstr(a,b) check_exp((a)->tt == LUA_TSHRSTR, (a) == (b))+++LUAI_FUNC unsigned int luaS_hash (const char *str, size_t l, unsigned int seed);+LUAI_FUNC unsigned int luaS_hashlongstr (TString *ts);+LUAI_FUNC int luaS_eqlngstr (TString *a, TString *b);+LUAI_FUNC void luaS_resize (lua_State *L, int newsize);+LUAI_FUNC void luaS_clearcache (global_State *g);+LUAI_FUNC void luaS_init (lua_State *L);+LUAI_FUNC void luaS_remove (lua_State *L, TString *ts);+LUAI_FUNC Udata *luaS_newudata (lua_State *L, size_t s);+LUAI_FUNC TString *luaS_newlstr (lua_State *L, const char *str, size_t l);+LUAI_FUNC TString *luaS_new (lua_State *L, const char *str);+LUAI_FUNC TString *luaS_createlngstrobj (lua_State *L, size_t l);+++#endif
+ cbits/lua-5.3.6/lstrlib.c view
@@ -0,0 +1,1584 @@+/*+** $Id: lstrlib.c,v 1.254.1.1 2017/04/19 17:29:57 roberto Exp $+** Standard library for string operations and pattern-matching+** See Copyright Notice in lua.h+*/++#define lstrlib_c+#define LUA_LIB++#include "lprefix.h"+++#include <ctype.h>+#include <float.h>+#include <limits.h>+#include <locale.h>+#include <stddef.h>+#include <stdio.h>+#include <stdlib.h>+#include <string.h>++#include "lua.h"++#include "lauxlib.h"+#include "lualib.h"+++/*+** maximum number of captures that a pattern can do during+** pattern-matching. This limit is arbitrary, but must fit in+** an unsigned char.+*/+#if !defined(LUA_MAXCAPTURES)+#define LUA_MAXCAPTURES 32+#endif+++/* macro to 'unsign' a character */+#define uchar(c) ((unsigned char)(c))+++/*+** Some sizes are better limited to fit in 'int', but must also fit in+** 'size_t'. (We assume that 'lua_Integer' cannot be smaller than 'int'.)+*/+#define MAX_SIZET ((size_t)(~(size_t)0))++#define MAXSIZE \+ (sizeof(size_t) < sizeof(int) ? MAX_SIZET : (size_t)(INT_MAX))+++++static int str_len (lua_State *L) {+ size_t l;+ luaL_checklstring(L, 1, &l);+ lua_pushinteger(L, (lua_Integer)l);+ return 1;+}+++/* translate a relative string position: negative means back from end */+static lua_Integer posrelat (lua_Integer pos, size_t len) {+ if (pos >= 0) return pos;+ else if (0u - (size_t)pos > len) return 0;+ else return (lua_Integer)len + pos + 1;+}+++static int str_sub (lua_State *L) {+ size_t l;+ const char *s = luaL_checklstring(L, 1, &l);+ lua_Integer start = posrelat(luaL_checkinteger(L, 2), l);+ lua_Integer end = posrelat(luaL_optinteger(L, 3, -1), l);+ if (start < 1) start = 1;+ if (end > (lua_Integer)l) end = l;+ if (start <= end)+ lua_pushlstring(L, s + start - 1, (size_t)(end - start) + 1);+ else lua_pushliteral(L, "");+ return 1;+}+++static int str_reverse (lua_State *L) {+ size_t l, i;+ luaL_Buffer b;+ const char *s = luaL_checklstring(L, 1, &l);+ char *p = luaL_buffinitsize(L, &b, l);+ for (i = 0; i < l; i++)+ p[i] = s[l - i - 1];+ luaL_pushresultsize(&b, l);+ return 1;+}+++static int str_lower (lua_State *L) {+ size_t l;+ size_t i;+ luaL_Buffer b;+ const char *s = luaL_checklstring(L, 1, &l);+ char *p = luaL_buffinitsize(L, &b, l);+ for (i=0; i<l; i++)+ p[i] = tolower(uchar(s[i]));+ luaL_pushresultsize(&b, l);+ return 1;+}+++static int str_upper (lua_State *L) {+ size_t l;+ size_t i;+ luaL_Buffer b;+ const char *s = luaL_checklstring(L, 1, &l);+ char *p = luaL_buffinitsize(L, &b, l);+ for (i=0; i<l; i++)+ p[i] = toupper(uchar(s[i]));+ luaL_pushresultsize(&b, l);+ return 1;+}+++static int str_rep (lua_State *L) {+ size_t l, lsep;+ const char *s = luaL_checklstring(L, 1, &l);+ lua_Integer n = luaL_checkinteger(L, 2);+ const char *sep = luaL_optlstring(L, 3, "", &lsep);+ if (n <= 0) lua_pushliteral(L, "");+ else if (l + lsep < l || l + lsep > MAXSIZE / n) /* may overflow? */+ return luaL_error(L, "resulting string too large");+ else {+ size_t totallen = (size_t)n * l + (size_t)(n - 1) * lsep;+ luaL_Buffer b;+ char *p = luaL_buffinitsize(L, &b, totallen);+ while (n-- > 1) { /* first n-1 copies (followed by separator) */+ memcpy(p, s, l * sizeof(char)); p += l;+ if (lsep > 0) { /* empty 'memcpy' is not that cheap */+ memcpy(p, sep, lsep * sizeof(char));+ p += lsep;+ }+ }+ memcpy(p, s, l * sizeof(char)); /* last copy (not followed by separator) */+ luaL_pushresultsize(&b, totallen);+ }+ return 1;+}+++static int str_byte (lua_State *L) {+ size_t l;+ const char *s = luaL_checklstring(L, 1, &l);+ lua_Integer posi = posrelat(luaL_optinteger(L, 2, 1), l);+ lua_Integer pose = posrelat(luaL_optinteger(L, 3, posi), l);+ int n, i;+ if (posi < 1) posi = 1;+ if (pose > (lua_Integer)l) pose = l;+ if (posi > pose) return 0; /* empty interval; return no values */+ if (pose - posi >= INT_MAX) /* arithmetic overflow? */+ return luaL_error(L, "string slice too long");+ n = (int)(pose - posi) + 1;+ luaL_checkstack(L, n, "string slice too long");+ for (i=0; i<n; i++)+ lua_pushinteger(L, uchar(s[posi+i-1]));+ return n;+}+++static int str_char (lua_State *L) {+ int n = lua_gettop(L); /* number of arguments */+ int i;+ luaL_Buffer b;+ char *p = luaL_buffinitsize(L, &b, n);+ for (i=1; i<=n; i++) {+ lua_Integer c = luaL_checkinteger(L, i);+ luaL_argcheck(L, uchar(c) == c, i, "value out of range");+ p[i - 1] = uchar(c);+ }+ luaL_pushresultsize(&b, n);+ return 1;+}+++static int writer (lua_State *L, const void *b, size_t size, void *B) {+ (void)L;+ luaL_addlstring((luaL_Buffer *) B, (const char *)b, size);+ return 0;+}+++static int str_dump (lua_State *L) {+ luaL_Buffer b;+ int strip = lua_toboolean(L, 2);+ luaL_checktype(L, 1, LUA_TFUNCTION);+ lua_settop(L, 1);+ luaL_buffinit(L,&b);+ if (lua_dump(L, writer, &b, strip) != 0)+ return luaL_error(L, "unable to dump given function");+ luaL_pushresult(&b);+ return 1;+}++++/*+** {======================================================+** PATTERN MATCHING+** =======================================================+*/+++#define CAP_UNFINISHED (-1)+#define CAP_POSITION (-2)+++typedef struct MatchState {+ const char *src_init; /* init of source string */+ const char *src_end; /* end ('\0') of source string */+ const char *p_end; /* end ('\0') of pattern */+ lua_State *L;+ int matchdepth; /* control for recursive depth (to avoid C stack overflow) */+ unsigned char level; /* total number of captures (finished or unfinished) */+ struct {+ const char *init;+ ptrdiff_t len;+ } capture[LUA_MAXCAPTURES];+} MatchState;+++/* recursive function */+static const char *match (MatchState *ms, const char *s, const char *p);+++/* maximum recursion depth for 'match' */+#if !defined(MAXCCALLS)+#define MAXCCALLS 200+#endif+++#define L_ESC '%'+#define SPECIALS "^$*+?.([%-"+++static int check_capture (MatchState *ms, int l) {+ l -= '1';+ if (l < 0 || l >= ms->level || ms->capture[l].len == CAP_UNFINISHED)+ return luaL_error(ms->L, "invalid capture index %%%d", l + 1);+ return l;+}+++static int capture_to_close (MatchState *ms) {+ int level = ms->level;+ for (level--; level>=0; level--)+ if (ms->capture[level].len == CAP_UNFINISHED) return level;+ return luaL_error(ms->L, "invalid pattern capture");+}+++static const char *classend (MatchState *ms, const char *p) {+ switch (*p++) {+ case L_ESC: {+ if (p == ms->p_end)+ luaL_error(ms->L, "malformed pattern (ends with '%%')");+ return p+1;+ }+ case '[': {+ if (*p == '^') p++;+ do { /* look for a ']' */+ if (p == ms->p_end)+ luaL_error(ms->L, "malformed pattern (missing ']')");+ if (*(p++) == L_ESC && p < ms->p_end)+ p++; /* skip escapes (e.g. '%]') */+ } while (*p != ']');+ return p+1;+ }+ default: {+ return p;+ }+ }+}+++static int match_class (int c, int cl) {+ int res;+ switch (tolower(cl)) {+ case 'a' : res = isalpha(c); break;+ case 'c' : res = iscntrl(c); break;+ case 'd' : res = isdigit(c); break;+ case 'g' : res = isgraph(c); break;+ case 'l' : res = islower(c); break;+ case 'p' : res = ispunct(c); break;+ case 's' : res = isspace(c); break;+ case 'u' : res = isupper(c); break;+ case 'w' : res = isalnum(c); break;+ case 'x' : res = isxdigit(c); break;+ case 'z' : res = (c == 0); break; /* deprecated option */+ default: return (cl == c);+ }+ return (islower(cl) ? res : !res);+}+++static int matchbracketclass (int c, const char *p, const char *ec) {+ int sig = 1;+ if (*(p+1) == '^') {+ sig = 0;+ p++; /* skip the '^' */+ }+ while (++p < ec) {+ if (*p == L_ESC) {+ p++;+ if (match_class(c, uchar(*p)))+ return sig;+ }+ else if ((*(p+1) == '-') && (p+2 < ec)) {+ p+=2;+ if (uchar(*(p-2)) <= c && c <= uchar(*p))+ return sig;+ }+ else if (uchar(*p) == c) return sig;+ }+ return !sig;+}+++static int singlematch (MatchState *ms, const char *s, const char *p,+ const char *ep) {+ if (s >= ms->src_end)+ return 0;+ else {+ int c = uchar(*s);+ switch (*p) {+ case '.': return 1; /* matches any char */+ case L_ESC: return match_class(c, uchar(*(p+1)));+ case '[': return matchbracketclass(c, p, ep-1);+ default: return (uchar(*p) == c);+ }+ }+}+++static const char *matchbalance (MatchState *ms, const char *s,+ const char *p) {+ if (p >= ms->p_end - 1)+ luaL_error(ms->L, "malformed pattern (missing arguments to '%%b')");+ if (*s != *p) return NULL;+ else {+ int b = *p;+ int e = *(p+1);+ int cont = 1;+ while (++s < ms->src_end) {+ if (*s == e) {+ if (--cont == 0) return s+1;+ }+ else if (*s == b) cont++;+ }+ }+ return NULL; /* string ends out of balance */+}+++static const char *max_expand (MatchState *ms, const char *s,+ const char *p, const char *ep) {+ ptrdiff_t i = 0; /* counts maximum expand for item */+ while (singlematch(ms, s + i, p, ep))+ i++;+ /* keeps trying to match with the maximum repetitions */+ while (i>=0) {+ const char *res = match(ms, (s+i), ep+1);+ if (res) return res;+ i--; /* else didn't match; reduce 1 repetition to try again */+ }+ return NULL;+}+++static const char *min_expand (MatchState *ms, const char *s,+ const char *p, const char *ep) {+ for (;;) {+ const char *res = match(ms, s, ep+1);+ if (res != NULL)+ return res;+ else if (singlematch(ms, s, p, ep))+ s++; /* try with one more repetition */+ else return NULL;+ }+}+++static const char *start_capture (MatchState *ms, const char *s,+ const char *p, int what) {+ const char *res;+ int level = ms->level;+ if (level >= LUA_MAXCAPTURES) luaL_error(ms->L, "too many captures");+ ms->capture[level].init = s;+ ms->capture[level].len = what;+ ms->level = level+1;+ if ((res=match(ms, s, p)) == NULL) /* match failed? */+ ms->level--; /* undo capture */+ return res;+}+++static const char *end_capture (MatchState *ms, const char *s,+ const char *p) {+ int l = capture_to_close(ms);+ const char *res;+ ms->capture[l].len = s - ms->capture[l].init; /* close capture */+ if ((res = match(ms, s, p)) == NULL) /* match failed? */+ ms->capture[l].len = CAP_UNFINISHED; /* undo capture */+ return res;+}+++static const char *match_capture (MatchState *ms, const char *s, int l) {+ size_t len;+ l = check_capture(ms, l);+ len = ms->capture[l].len;+ if ((size_t)(ms->src_end-s) >= len &&+ memcmp(ms->capture[l].init, s, len) == 0)+ return s+len;+ else return NULL;+}+++static const char *match (MatchState *ms, const char *s, const char *p) {+ if (ms->matchdepth-- == 0)+ luaL_error(ms->L, "pattern too complex");+ init: /* using goto's to optimize tail recursion */+ if (p != ms->p_end) { /* end of pattern? */+ switch (*p) {+ case '(': { /* start capture */+ if (*(p + 1) == ')') /* position capture? */+ s = start_capture(ms, s, p + 2, CAP_POSITION);+ else+ s = start_capture(ms, s, p + 1, CAP_UNFINISHED);+ break;+ }+ case ')': { /* end capture */+ s = end_capture(ms, s, p + 1);+ break;+ }+ case '$': {+ if ((p + 1) != ms->p_end) /* is the '$' the last char in pattern? */+ goto dflt; /* no; go to default */+ s = (s == ms->src_end) ? s : NULL; /* check end of string */+ break;+ }+ case L_ESC: { /* escaped sequences not in the format class[*+?-]? */+ switch (*(p + 1)) {+ case 'b': { /* balanced string? */+ s = matchbalance(ms, s, p + 2);+ if (s != NULL) {+ p += 4; goto init; /* return match(ms, s, p + 4); */+ } /* else fail (s == NULL) */+ break;+ }+ case 'f': { /* frontier? */+ const char *ep; char previous;+ p += 2;+ if (*p != '[')+ luaL_error(ms->L, "missing '[' after '%%f' in pattern");+ ep = classend(ms, p); /* points to what is next */+ previous = (s == ms->src_init) ? '\0' : *(s - 1);+ if (!matchbracketclass(uchar(previous), p, ep - 1) &&+ matchbracketclass(uchar(*s), p, ep - 1)) {+ p = ep; goto init; /* return match(ms, s, ep); */+ }+ s = NULL; /* match failed */+ break;+ }+ case '0': case '1': case '2': case '3':+ case '4': case '5': case '6': case '7':+ case '8': case '9': { /* capture results (%0-%9)? */+ s = match_capture(ms, s, uchar(*(p + 1)));+ if (s != NULL) {+ p += 2; goto init; /* return match(ms, s, p + 2) */+ }+ break;+ }+ default: goto dflt;+ }+ break;+ }+ default: dflt: { /* pattern class plus optional suffix */+ const char *ep = classend(ms, p); /* points to optional suffix */+ /* does not match at least once? */+ if (!singlematch(ms, s, p, ep)) {+ if (*ep == '*' || *ep == '?' || *ep == '-') { /* accept empty? */+ p = ep + 1; goto init; /* return match(ms, s, ep + 1); */+ }+ else /* '+' or no suffix */+ s = NULL; /* fail */+ }+ else { /* matched once */+ switch (*ep) { /* handle optional suffix */+ case '?': { /* optional */+ const char *res;+ if ((res = match(ms, s + 1, ep + 1)) != NULL)+ s = res;+ else {+ p = ep + 1; goto init; /* else return match(ms, s, ep + 1); */+ }+ break;+ }+ case '+': /* 1 or more repetitions */+ s++; /* 1 match already done */+ /* FALLTHROUGH */+ case '*': /* 0 or more repetitions */+ s = max_expand(ms, s, p, ep);+ break;+ case '-': /* 0 or more repetitions (minimum) */+ s = min_expand(ms, s, p, ep);+ break;+ default: /* no suffix */+ s++; p = ep; goto init; /* return match(ms, s + 1, ep); */+ }+ }+ break;+ }+ }+ }+ ms->matchdepth++;+ return s;+}++++static const char *lmemfind (const char *s1, size_t l1,+ const char *s2, size_t l2) {+ if (l2 == 0) return s1; /* empty strings are everywhere */+ else if (l2 > l1) return NULL; /* avoids a negative 'l1' */+ else {+ const char *init; /* to search for a '*s2' inside 's1' */+ l2--; /* 1st char will be checked by 'memchr' */+ l1 = l1-l2; /* 's2' cannot be found after that */+ while (l1 > 0 && (init = (const char *)memchr(s1, *s2, l1)) != NULL) {+ init++; /* 1st char is already checked */+ if (memcmp(init, s2+1, l2) == 0)+ return init-1;+ else { /* correct 'l1' and 's1' to try again */+ l1 -= init-s1;+ s1 = init;+ }+ }+ return NULL; /* not found */+ }+}+++static void push_onecapture (MatchState *ms, int i, const char *s,+ const char *e) {+ if (i >= ms->level) {+ if (i == 0) /* ms->level == 0, too */+ lua_pushlstring(ms->L, s, e - s); /* add whole match */+ else+ luaL_error(ms->L, "invalid capture index %%%d", i + 1);+ }+ else {+ ptrdiff_t l = ms->capture[i].len;+ if (l == CAP_UNFINISHED) luaL_error(ms->L, "unfinished capture");+ if (l == CAP_POSITION)+ lua_pushinteger(ms->L, (ms->capture[i].init - ms->src_init) + 1);+ else+ lua_pushlstring(ms->L, ms->capture[i].init, l);+ }+}+++static int push_captures (MatchState *ms, const char *s, const char *e) {+ int i;+ int nlevels = (ms->level == 0 && s) ? 1 : ms->level;+ luaL_checkstack(ms->L, nlevels, "too many captures");+ for (i = 0; i < nlevels; i++)+ push_onecapture(ms, i, s, e);+ return nlevels; /* number of strings pushed */+}+++/* check whether pattern has no special characters */+static int nospecials (const char *p, size_t l) {+ size_t upto = 0;+ do {+ if (strpbrk(p + upto, SPECIALS))+ return 0; /* pattern has a special character */+ upto += strlen(p + upto) + 1; /* may have more after \0 */+ } while (upto <= l);+ return 1; /* no special chars found */+}+++static void prepstate (MatchState *ms, lua_State *L,+ const char *s, size_t ls, const char *p, size_t lp) {+ ms->L = L;+ ms->matchdepth = MAXCCALLS;+ ms->src_init = s;+ ms->src_end = s + ls;+ ms->p_end = p + lp;+}+++static void reprepstate (MatchState *ms) {+ ms->level = 0;+ lua_assert(ms->matchdepth == MAXCCALLS);+}+++static int str_find_aux (lua_State *L, int find) {+ size_t ls, lp;+ const char *s = luaL_checklstring(L, 1, &ls);+ const char *p = luaL_checklstring(L, 2, &lp);+ lua_Integer init = posrelat(luaL_optinteger(L, 3, 1), ls);+ if (init < 1) init = 1;+ else if (init > (lua_Integer)ls + 1) { /* start after string's end? */+ lua_pushnil(L); /* cannot find anything */+ return 1;+ }+ /* explicit request or no special characters? */+ if (find && (lua_toboolean(L, 4) || nospecials(p, lp))) {+ /* do a plain search */+ const char *s2 = lmemfind(s + init - 1, ls - (size_t)init + 1, p, lp);+ if (s2) {+ lua_pushinteger(L, (s2 - s) + 1);+ lua_pushinteger(L, (s2 - s) + lp);+ return 2;+ }+ }+ else {+ MatchState ms;+ const char *s1 = s + init - 1;+ int anchor = (*p == '^');+ if (anchor) {+ p++; lp--; /* skip anchor character */+ }+ prepstate(&ms, L, s, ls, p, lp);+ do {+ const char *res;+ reprepstate(&ms);+ if ((res=match(&ms, s1, p)) != NULL) {+ if (find) {+ lua_pushinteger(L, (s1 - s) + 1); /* start */+ lua_pushinteger(L, res - s); /* end */+ return push_captures(&ms, NULL, 0) + 2;+ }+ else+ return push_captures(&ms, s1, res);+ }+ } while (s1++ < ms.src_end && !anchor);+ }+ lua_pushnil(L); /* not found */+ return 1;+}+++static int str_find (lua_State *L) {+ return str_find_aux(L, 1);+}+++static int str_match (lua_State *L) {+ return str_find_aux(L, 0);+}+++/* state for 'gmatch' */+typedef struct GMatchState {+ const char *src; /* current position */+ const char *p; /* pattern */+ const char *lastmatch; /* end of last match */+ MatchState ms; /* match state */+} GMatchState;+++static int gmatch_aux (lua_State *L) {+ GMatchState *gm = (GMatchState *)lua_touserdata(L, lua_upvalueindex(3));+ const char *src;+ gm->ms.L = L;+ for (src = gm->src; src <= gm->ms.src_end; src++) {+ const char *e;+ reprepstate(&gm->ms);+ if ((e = match(&gm->ms, src, gm->p)) != NULL && e != gm->lastmatch) {+ gm->src = gm->lastmatch = e;+ return push_captures(&gm->ms, src, e);+ }+ }+ return 0; /* not found */+}+++static int gmatch (lua_State *L) {+ size_t ls, lp;+ const char *s = luaL_checklstring(L, 1, &ls);+ const char *p = luaL_checklstring(L, 2, &lp);+ GMatchState *gm;+ lua_settop(L, 2); /* keep them on closure to avoid being collected */+ gm = (GMatchState *)lua_newuserdata(L, sizeof(GMatchState));+ prepstate(&gm->ms, L, s, ls, p, lp);+ gm->src = s; gm->p = p; gm->lastmatch = NULL;+ lua_pushcclosure(L, gmatch_aux, 3);+ return 1;+}+++static void add_s (MatchState *ms, luaL_Buffer *b, const char *s,+ const char *e) {+ size_t l, i;+ lua_State *L = ms->L;+ const char *news = lua_tolstring(L, 3, &l);+ for (i = 0; i < l; i++) {+ if (news[i] != L_ESC)+ luaL_addchar(b, news[i]);+ else {+ i++; /* skip ESC */+ if (!isdigit(uchar(news[i]))) {+ if (news[i] != L_ESC)+ luaL_error(L, "invalid use of '%c' in replacement string", L_ESC);+ luaL_addchar(b, news[i]);+ }+ else if (news[i] == '0')+ luaL_addlstring(b, s, e - s);+ else {+ push_onecapture(ms, news[i] - '1', s, e);+ luaL_tolstring(L, -1, NULL); /* if number, convert it to string */+ lua_remove(L, -2); /* remove original value */+ luaL_addvalue(b); /* add capture to accumulated result */+ }+ }+ }+}+++static void add_value (MatchState *ms, luaL_Buffer *b, const char *s,+ const char *e, int tr) {+ lua_State *L = ms->L;+ switch (tr) {+ case LUA_TFUNCTION: {+ int n;+ lua_pushvalue(L, 3);+ n = push_captures(ms, s, e);+ lua_call(L, n, 1);+ break;+ }+ case LUA_TTABLE: {+ push_onecapture(ms, 0, s, e);+ lua_gettable(L, 3);+ break;+ }+ default: { /* LUA_TNUMBER or LUA_TSTRING */+ add_s(ms, b, s, e);+ return;+ }+ }+ if (!lua_toboolean(L, -1)) { /* nil or false? */+ lua_pop(L, 1);+ lua_pushlstring(L, s, e - s); /* keep original text */+ }+ else if (!lua_isstring(L, -1))+ luaL_error(L, "invalid replacement value (a %s)", luaL_typename(L, -1));+ luaL_addvalue(b); /* add result to accumulator */+}+++static int str_gsub (lua_State *L) {+ size_t srcl, lp;+ const char *src = luaL_checklstring(L, 1, &srcl); /* subject */+ const char *p = luaL_checklstring(L, 2, &lp); /* pattern */+ const char *lastmatch = NULL; /* end of last match */+ int tr = lua_type(L, 3); /* replacement type */+ lua_Integer max_s = luaL_optinteger(L, 4, srcl + 1); /* max replacements */+ int anchor = (*p == '^');+ lua_Integer n = 0; /* replacement count */+ MatchState ms;+ luaL_Buffer b;+ luaL_argcheck(L, tr == LUA_TNUMBER || tr == LUA_TSTRING ||+ tr == LUA_TFUNCTION || tr == LUA_TTABLE, 3,+ "string/function/table expected");+ luaL_buffinit(L, &b);+ if (anchor) {+ p++; lp--; /* skip anchor character */+ }+ prepstate(&ms, L, src, srcl, p, lp);+ while (n < max_s) {+ const char *e;+ reprepstate(&ms); /* (re)prepare state for new match */+ if ((e = match(&ms, src, p)) != NULL && e != lastmatch) { /* match? */+ n++;+ add_value(&ms, &b, src, e, tr); /* add replacement to buffer */+ src = lastmatch = e;+ }+ else if (src < ms.src_end) /* otherwise, skip one character */+ luaL_addchar(&b, *src++);+ else break; /* end of subject */+ if (anchor) break;+ }+ luaL_addlstring(&b, src, ms.src_end-src);+ luaL_pushresult(&b);+ lua_pushinteger(L, n); /* number of substitutions */+ return 2;+}++/* }====================================================== */++++/*+** {======================================================+** STRING FORMAT+** =======================================================+*/++#if !defined(lua_number2strx) /* { */++/*+** Hexadecimal floating-point formatter+*/++#include <math.h>++#define SIZELENMOD (sizeof(LUA_NUMBER_FRMLEN)/sizeof(char))+++/*+** Number of bits that goes into the first digit. It can be any value+** between 1 and 4; the following definition tries to align the number+** to nibble boundaries by making what is left after that first digit a+** multiple of 4.+*/+#define L_NBFD ((l_mathlim(MANT_DIG) - 1)%4 + 1)+++/*+** Add integer part of 'x' to buffer and return new 'x'+*/+static lua_Number adddigit (char *buff, int n, lua_Number x) {+ lua_Number dd = l_mathop(floor)(x); /* get integer part from 'x' */+ int d = (int)dd;+ buff[n] = (d < 10 ? d + '0' : d - 10 + 'a'); /* add to buffer */+ return x - dd; /* return what is left */+}+++static int num2straux (char *buff, int sz, lua_Number x) {+ /* if 'inf' or 'NaN', format it like '%g' */+ if (x != x || x == (lua_Number)HUGE_VAL || x == -(lua_Number)HUGE_VAL)+ return l_sprintf(buff, sz, LUA_NUMBER_FMT, (LUAI_UACNUMBER)x);+ else if (x == 0) { /* can be -0... */+ /* create "0" or "-0" followed by exponent */+ return l_sprintf(buff, sz, LUA_NUMBER_FMT "x0p+0", (LUAI_UACNUMBER)x);+ }+ else {+ int e;+ lua_Number m = l_mathop(frexp)(x, &e); /* 'x' fraction and exponent */+ int n = 0; /* character count */+ if (m < 0) { /* is number negative? */+ buff[n++] = '-'; /* add signal */+ m = -m; /* make it positive */+ }+ buff[n++] = '0'; buff[n++] = 'x'; /* add "0x" */+ m = adddigit(buff, n++, m * (1 << L_NBFD)); /* add first digit */+ e -= L_NBFD; /* this digit goes before the radix point */+ if (m > 0) { /* more digits? */+ buff[n++] = lua_getlocaledecpoint(); /* add radix point */+ do { /* add as many digits as needed */+ m = adddigit(buff, n++, m * 16);+ } while (m > 0);+ }+ n += l_sprintf(buff + n, sz - n, "p%+d", e); /* add exponent */+ lua_assert(n < sz);+ return n;+ }+}+++static int lua_number2strx (lua_State *L, char *buff, int sz,+ const char *fmt, lua_Number x) {+ int n = num2straux(buff, sz, x);+ if (fmt[SIZELENMOD] == 'A') {+ int i;+ for (i = 0; i < n; i++)+ buff[i] = toupper(uchar(buff[i]));+ }+ else if (fmt[SIZELENMOD] != 'a')+ return luaL_error(L, "modifiers for format '%%a'/'%%A' not implemented");+ return n;+}++#endif /* } */+++/*+** Maximum size of each formatted item. This maximum size is produced+** by format('%.99f', -maxfloat), and is equal to 99 + 3 ('-', '.',+** and '\0') + number of decimal digits to represent maxfloat (which+** is maximum exponent + 1). (99+3+1 then rounded to 120 for "extra+** expenses", such as locale-dependent stuff)+*/+#define MAX_ITEM (120 + l_mathlim(MAX_10_EXP))+++/* valid flags in a format specification */+#define FLAGS "-+ #0"++/*+** maximum size of each format specification (such as "%-099.99d")+*/+#define MAX_FORMAT 32+++static void addquoted (luaL_Buffer *b, const char *s, size_t len) {+ luaL_addchar(b, '"');+ while (len--) {+ if (*s == '"' || *s == '\\' || *s == '\n') {+ luaL_addchar(b, '\\');+ luaL_addchar(b, *s);+ }+ else if (iscntrl(uchar(*s))) {+ char buff[10];+ if (!isdigit(uchar(*(s+1))))+ l_sprintf(buff, sizeof(buff), "\\%d", (int)uchar(*s));+ else+ l_sprintf(buff, sizeof(buff), "\\%03d", (int)uchar(*s));+ luaL_addstring(b, buff);+ }+ else+ luaL_addchar(b, *s);+ s++;+ }+ luaL_addchar(b, '"');+}+++/*+** Ensures the 'buff' string uses a dot as the radix character.+*/+static void checkdp (char *buff, int nb) {+ if (memchr(buff, '.', nb) == NULL) { /* no dot? */+ char point = lua_getlocaledecpoint(); /* try locale point */+ char *ppoint = (char *)memchr(buff, point, nb);+ if (ppoint) *ppoint = '.'; /* change it to a dot */+ }+}+++static void addliteral (lua_State *L, luaL_Buffer *b, int arg) {+ switch (lua_type(L, arg)) {+ case LUA_TSTRING: {+ size_t len;+ const char *s = lua_tolstring(L, arg, &len);+ addquoted(b, s, len);+ break;+ }+ case LUA_TNUMBER: {+ char *buff = luaL_prepbuffsize(b, MAX_ITEM);+ int nb;+ if (!lua_isinteger(L, arg)) { /* float? */+ lua_Number n = lua_tonumber(L, arg); /* write as hexa ('%a') */+ nb = lua_number2strx(L, buff, MAX_ITEM, "%" LUA_NUMBER_FRMLEN "a", n);+ checkdp(buff, nb); /* ensure it uses a dot */+ }+ else { /* integers */+ lua_Integer n = lua_tointeger(L, arg);+ const char *format = (n == LUA_MININTEGER) /* corner case? */+ ? "0x%" LUA_INTEGER_FRMLEN "x" /* use hexa */+ : LUA_INTEGER_FMT; /* else use default format */+ nb = l_sprintf(buff, MAX_ITEM, format, (LUAI_UACINT)n);+ }+ luaL_addsize(b, nb);+ break;+ }+ case LUA_TNIL: case LUA_TBOOLEAN: {+ luaL_tolstring(L, arg, NULL);+ luaL_addvalue(b);+ break;+ }+ default: {+ luaL_argerror(L, arg, "value has no literal form");+ }+ }+}+++static const char *scanformat (lua_State *L, const char *strfrmt, char *form) {+ const char *p = strfrmt;+ while (*p != '\0' && strchr(FLAGS, *p) != NULL) p++; /* skip flags */+ if ((size_t)(p - strfrmt) >= sizeof(FLAGS)/sizeof(char))+ luaL_error(L, "invalid format (repeated flags)");+ if (isdigit(uchar(*p))) p++; /* skip width */+ if (isdigit(uchar(*p))) p++; /* (2 digits at most) */+ if (*p == '.') {+ p++;+ if (isdigit(uchar(*p))) p++; /* skip precision */+ if (isdigit(uchar(*p))) p++; /* (2 digits at most) */+ }+ if (isdigit(uchar(*p)))+ luaL_error(L, "invalid format (width or precision too long)");+ *(form++) = '%';+ memcpy(form, strfrmt, ((p - strfrmt) + 1) * sizeof(char));+ form += (p - strfrmt) + 1;+ *form = '\0';+ return p;+}+++/*+** add length modifier into formats+*/+static void addlenmod (char *form, const char *lenmod) {+ size_t l = strlen(form);+ size_t lm = strlen(lenmod);+ char spec = form[l - 1];+ strcpy(form + l - 1, lenmod);+ form[l + lm - 1] = spec;+ form[l + lm] = '\0';+}+++static int str_format (lua_State *L) {+ int top = lua_gettop(L);+ int arg = 1;+ size_t sfl;+ const char *strfrmt = luaL_checklstring(L, arg, &sfl);+ const char *strfrmt_end = strfrmt+sfl;+ luaL_Buffer b;+ luaL_buffinit(L, &b);+ while (strfrmt < strfrmt_end) {+ if (*strfrmt != L_ESC)+ luaL_addchar(&b, *strfrmt++);+ else if (*++strfrmt == L_ESC)+ luaL_addchar(&b, *strfrmt++); /* %% */+ else { /* format item */+ char form[MAX_FORMAT]; /* to store the format ('%...') */+ char *buff = luaL_prepbuffsize(&b, MAX_ITEM); /* to put formatted item */+ int nb = 0; /* number of bytes in added item */+ if (++arg > top)+ luaL_argerror(L, arg, "no value");+ strfrmt = scanformat(L, strfrmt, form);+ switch (*strfrmt++) {+ case 'c': {+ nb = l_sprintf(buff, MAX_ITEM, form, (int)luaL_checkinteger(L, arg));+ break;+ }+ case 'd': case 'i':+ case 'o': case 'u': case 'x': case 'X': {+ lua_Integer n = luaL_checkinteger(L, arg);+ addlenmod(form, LUA_INTEGER_FRMLEN);+ nb = l_sprintf(buff, MAX_ITEM, form, (LUAI_UACINT)n);+ break;+ }+ case 'a': case 'A':+ addlenmod(form, LUA_NUMBER_FRMLEN);+ nb = lua_number2strx(L, buff, MAX_ITEM, form,+ luaL_checknumber(L, arg));+ break;+ case 'e': case 'E': case 'f':+ case 'g': case 'G': {+ lua_Number n = luaL_checknumber(L, arg);+ addlenmod(form, LUA_NUMBER_FRMLEN);+ nb = l_sprintf(buff, MAX_ITEM, form, (LUAI_UACNUMBER)n);+ break;+ }+ case 'q': {+ addliteral(L, &b, arg);+ break;+ }+ case 's': {+ size_t l;+ const char *s = luaL_tolstring(L, arg, &l);+ if (form[2] == '\0') /* no modifiers? */+ luaL_addvalue(&b); /* keep entire string */+ else {+ luaL_argcheck(L, l == strlen(s), arg, "string contains zeros");+ if (!strchr(form, '.') && l >= 100) {+ /* no precision and string is too long to be formatted */+ luaL_addvalue(&b); /* keep entire string */+ }+ else { /* format the string into 'buff' */+ nb = l_sprintf(buff, MAX_ITEM, form, s);+ lua_pop(L, 1); /* remove result from 'luaL_tolstring' */+ }+ }+ break;+ }+ default: { /* also treat cases 'pnLlh' */+ return luaL_error(L, "invalid option '%%%c' to 'format'",+ *(strfrmt - 1));+ }+ }+ lua_assert(nb < MAX_ITEM);+ luaL_addsize(&b, nb);+ }+ }+ luaL_pushresult(&b);+ return 1;+}++/* }====================================================== */+++/*+** {======================================================+** PACK/UNPACK+** =======================================================+*/+++/* value used for padding */+#if !defined(LUAL_PACKPADBYTE)+#define LUAL_PACKPADBYTE 0x00+#endif++/* maximum size for the binary representation of an integer */+#define MAXINTSIZE 16++/* number of bits in a character */+#define NB CHAR_BIT++/* mask for one character (NB 1's) */+#define MC ((1 << NB) - 1)++/* size of a lua_Integer */+#define SZINT ((int)sizeof(lua_Integer))+++/* dummy union to get native endianness */+static const union {+ int dummy;+ char little; /* true iff machine is little endian */+} nativeendian = {1};+++/* dummy structure to get native alignment requirements */+struct cD {+ char c;+ union { double d; void *p; lua_Integer i; lua_Number n; } u;+};++#define MAXALIGN (offsetof(struct cD, u))+++/*+** Union for serializing floats+*/+typedef union Ftypes {+ float f;+ double d;+ lua_Number n;+ char buff[5 * sizeof(lua_Number)]; /* enough for any float type */+} Ftypes;+++/*+** information to pack/unpack stuff+*/+typedef struct Header {+ lua_State *L;+ int islittle;+ int maxalign;+} Header;+++/*+** options for pack/unpack+*/+typedef enum KOption {+ Kint, /* signed integers */+ Kuint, /* unsigned integers */+ Kfloat, /* floating-point numbers */+ Kchar, /* fixed-length strings */+ Kstring, /* strings with prefixed length */+ Kzstr, /* zero-terminated strings */+ Kpadding, /* padding */+ Kpaddalign, /* padding for alignment */+ Knop /* no-op (configuration or spaces) */+} KOption;+++/*+** Read an integer numeral from string 'fmt' or return 'df' if+** there is no numeral+*/+static int digit (int c) { return '0' <= c && c <= '9'; }++static int getnum (const char **fmt, int df) {+ if (!digit(**fmt)) /* no number? */+ return df; /* return default value */+ else {+ int a = 0;+ do {+ a = a*10 + (*((*fmt)++) - '0');+ } while (digit(**fmt) && a <= ((int)MAXSIZE - 9)/10);+ return a;+ }+}+++/*+** Read an integer numeral and raises an error if it is larger+** than the maximum size for integers.+*/+static int getnumlimit (Header *h, const char **fmt, int df) {+ int sz = getnum(fmt, df);+ if (sz > MAXINTSIZE || sz <= 0)+ return luaL_error(h->L, "integral size (%d) out of limits [1,%d]",+ sz, MAXINTSIZE);+ return sz;+}+++/*+** Initialize Header+*/+static void initheader (lua_State *L, Header *h) {+ h->L = L;+ h->islittle = nativeendian.little;+ h->maxalign = 1;+}+++/*+** Read and classify next option. 'size' is filled with option's size.+*/+static KOption getoption (Header *h, const char **fmt, int *size) {+ int opt = *((*fmt)++);+ *size = 0; /* default */+ switch (opt) {+ case 'b': *size = sizeof(char); return Kint;+ case 'B': *size = sizeof(char); return Kuint;+ case 'h': *size = sizeof(short); return Kint;+ case 'H': *size = sizeof(short); return Kuint;+ case 'l': *size = sizeof(long); return Kint;+ case 'L': *size = sizeof(long); return Kuint;+ case 'j': *size = sizeof(lua_Integer); return Kint;+ case 'J': *size = sizeof(lua_Integer); return Kuint;+ case 'T': *size = sizeof(size_t); return Kuint;+ case 'f': *size = sizeof(float); return Kfloat;+ case 'd': *size = sizeof(double); return Kfloat;+ case 'n': *size = sizeof(lua_Number); return Kfloat;+ case 'i': *size = getnumlimit(h, fmt, sizeof(int)); return Kint;+ case 'I': *size = getnumlimit(h, fmt, sizeof(int)); return Kuint;+ case 's': *size = getnumlimit(h, fmt, sizeof(size_t)); return Kstring;+ case 'c':+ *size = getnum(fmt, -1);+ if (*size == -1)+ luaL_error(h->L, "missing size for format option 'c'");+ return Kchar;+ case 'z': return Kzstr;+ case 'x': *size = 1; return Kpadding;+ case 'X': return Kpaddalign;+ case ' ': break;+ case '<': h->islittle = 1; break;+ case '>': h->islittle = 0; break;+ case '=': h->islittle = nativeendian.little; break;+ case '!': h->maxalign = getnumlimit(h, fmt, MAXALIGN); break;+ default: luaL_error(h->L, "invalid format option '%c'", opt);+ }+ return Knop;+}+++/*+** Read, classify, and fill other details about the next option.+** 'psize' is filled with option's size, 'notoalign' with its+** alignment requirements.+** Local variable 'size' gets the size to be aligned. (Kpadal option+** always gets its full alignment, other options are limited by+** the maximum alignment ('maxalign'). Kchar option needs no alignment+** despite its size.+*/+static KOption getdetails (Header *h, size_t totalsize,+ const char **fmt, int *psize, int *ntoalign) {+ KOption opt = getoption(h, fmt, psize);+ int align = *psize; /* usually, alignment follows size */+ if (opt == Kpaddalign) { /* 'X' gets alignment from following option */+ if (**fmt == '\0' || getoption(h, fmt, &align) == Kchar || align == 0)+ luaL_argerror(h->L, 1, "invalid next option for option 'X'");+ }+ if (align <= 1 || opt == Kchar) /* need no alignment? */+ *ntoalign = 0;+ else {+ if (align > h->maxalign) /* enforce maximum alignment */+ align = h->maxalign;+ if ((align & (align - 1)) != 0) /* is 'align' not a power of 2? */+ luaL_argerror(h->L, 1, "format asks for alignment not power of 2");+ *ntoalign = (align - (int)(totalsize & (align - 1))) & (align - 1);+ }+ return opt;+}+++/*+** Pack integer 'n' with 'size' bytes and 'islittle' endianness.+** The final 'if' handles the case when 'size' is larger than+** the size of a Lua integer, correcting the extra sign-extension+** bytes if necessary (by default they would be zeros).+*/+static void packint (luaL_Buffer *b, lua_Unsigned n,+ int islittle, int size, int neg) {+ char *buff = luaL_prepbuffsize(b, size);+ int i;+ buff[islittle ? 0 : size - 1] = (char)(n & MC); /* first byte */+ for (i = 1; i < size; i++) {+ n >>= NB;+ buff[islittle ? i : size - 1 - i] = (char)(n & MC);+ }+ if (neg && size > SZINT) { /* negative number need sign extension? */+ for (i = SZINT; i < size; i++) /* correct extra bytes */+ buff[islittle ? i : size - 1 - i] = (char)MC;+ }+ luaL_addsize(b, size); /* add result to buffer */+}+++/*+** Copy 'size' bytes from 'src' to 'dest', correcting endianness if+** given 'islittle' is different from native endianness.+*/+static void copywithendian (volatile char *dest, volatile const char *src,+ int size, int islittle) {+ if (islittle == nativeendian.little) {+ while (size-- != 0)+ *(dest++) = *(src++);+ }+ else {+ dest += size - 1;+ while (size-- != 0)+ *(dest--) = *(src++);+ }+}+++static int str_pack (lua_State *L) {+ luaL_Buffer b;+ Header h;+ const char *fmt = luaL_checkstring(L, 1); /* format string */+ int arg = 1; /* current argument to pack */+ size_t totalsize = 0; /* accumulate total size of result */+ initheader(L, &h);+ lua_pushnil(L); /* mark to separate arguments from string buffer */+ luaL_buffinit(L, &b);+ while (*fmt != '\0') {+ int size, ntoalign;+ KOption opt = getdetails(&h, totalsize, &fmt, &size, &ntoalign);+ totalsize += ntoalign + size;+ while (ntoalign-- > 0)+ luaL_addchar(&b, LUAL_PACKPADBYTE); /* fill alignment */+ arg++;+ switch (opt) {+ case Kint: { /* signed integers */+ lua_Integer n = luaL_checkinteger(L, arg);+ if (size < SZINT) { /* need overflow check? */+ lua_Integer lim = (lua_Integer)1 << ((size * NB) - 1);+ luaL_argcheck(L, -lim <= n && n < lim, arg, "integer overflow");+ }+ packint(&b, (lua_Unsigned)n, h.islittle, size, (n < 0));+ break;+ }+ case Kuint: { /* unsigned integers */+ lua_Integer n = luaL_checkinteger(L, arg);+ if (size < SZINT) /* need overflow check? */+ luaL_argcheck(L, (lua_Unsigned)n < ((lua_Unsigned)1 << (size * NB)),+ arg, "unsigned overflow");+ packint(&b, (lua_Unsigned)n, h.islittle, size, 0);+ break;+ }+ case Kfloat: { /* floating-point options */+ volatile Ftypes u;+ char *buff = luaL_prepbuffsize(&b, size);+ lua_Number n = luaL_checknumber(L, arg); /* get argument */+ if (size == sizeof(u.f)) u.f = (float)n; /* copy it into 'u' */+ else if (size == sizeof(u.d)) u.d = (double)n;+ else u.n = n;+ /* move 'u' to final result, correcting endianness if needed */+ copywithendian(buff, u.buff, size, h.islittle);+ luaL_addsize(&b, size);+ break;+ }+ case Kchar: { /* fixed-size string */+ size_t len;+ const char *s = luaL_checklstring(L, arg, &len);+ luaL_argcheck(L, len <= (size_t)size, arg,+ "string longer than given size");+ luaL_addlstring(&b, s, len); /* add string */+ while (len++ < (size_t)size) /* pad extra space */+ luaL_addchar(&b, LUAL_PACKPADBYTE);+ break;+ }+ case Kstring: { /* strings with length count */+ size_t len;+ const char *s = luaL_checklstring(L, arg, &len);+ luaL_argcheck(L, size >= (int)sizeof(size_t) ||+ len < ((size_t)1 << (size * NB)),+ arg, "string length does not fit in given size");+ packint(&b, (lua_Unsigned)len, h.islittle, size, 0); /* pack length */+ luaL_addlstring(&b, s, len);+ totalsize += len;+ break;+ }+ case Kzstr: { /* zero-terminated string */+ size_t len;+ const char *s = luaL_checklstring(L, arg, &len);+ luaL_argcheck(L, strlen(s) == len, arg, "string contains zeros");+ luaL_addlstring(&b, s, len);+ luaL_addchar(&b, '\0'); /* add zero at the end */+ totalsize += len + 1;+ break;+ }+ case Kpadding: luaL_addchar(&b, LUAL_PACKPADBYTE); /* FALLTHROUGH */+ case Kpaddalign: case Knop:+ arg--; /* undo increment */+ break;+ }+ }+ luaL_pushresult(&b);+ return 1;+}+++static int str_packsize (lua_State *L) {+ Header h;+ const char *fmt = luaL_checkstring(L, 1); /* format string */+ size_t totalsize = 0; /* accumulate total size of result */+ initheader(L, &h);+ while (*fmt != '\0') {+ int size, ntoalign;+ KOption opt = getdetails(&h, totalsize, &fmt, &size, &ntoalign);+ size += ntoalign; /* total space used by option */+ luaL_argcheck(L, totalsize <= MAXSIZE - size, 1,+ "format result too large");+ totalsize += size;+ switch (opt) {+ case Kstring: /* strings with length count */+ case Kzstr: /* zero-terminated string */+ luaL_argerror(L, 1, "variable-length format");+ /* call never return, but to avoid warnings: *//* FALLTHROUGH */+ default: break;+ }+ }+ lua_pushinteger(L, (lua_Integer)totalsize);+ return 1;+}+++/*+** Unpack an integer with 'size' bytes and 'islittle' endianness.+** If size is smaller than the size of a Lua integer and integer+** is signed, must do sign extension (propagating the sign to the+** higher bits); if size is larger than the size of a Lua integer,+** it must check the unread bytes to see whether they do not cause an+** overflow.+*/+static lua_Integer unpackint (lua_State *L, const char *str,+ int islittle, int size, int issigned) {+ lua_Unsigned res = 0;+ int i;+ int limit = (size <= SZINT) ? size : SZINT;+ for (i = limit - 1; i >= 0; i--) {+ res <<= NB;+ res |= (lua_Unsigned)(unsigned char)str[islittle ? i : size - 1 - i];+ }+ if (size < SZINT) { /* real size smaller than lua_Integer? */+ if (issigned) { /* needs sign extension? */+ lua_Unsigned mask = (lua_Unsigned)1 << (size*NB - 1);+ res = ((res ^ mask) - mask); /* do sign extension */+ }+ }+ else if (size > SZINT) { /* must check unread bytes */+ int mask = (!issigned || (lua_Integer)res >= 0) ? 0 : MC;+ for (i = limit; i < size; i++) {+ if ((unsigned char)str[islittle ? i : size - 1 - i] != mask)+ luaL_error(L, "%d-byte integer does not fit into Lua Integer", size);+ }+ }+ return (lua_Integer)res;+}+++static int str_unpack (lua_State *L) {+ Header h;+ const char *fmt = luaL_checkstring(L, 1);+ size_t ld;+ const char *data = luaL_checklstring(L, 2, &ld);+ size_t pos = (size_t)posrelat(luaL_optinteger(L, 3, 1), ld) - 1;+ int n = 0; /* number of results */+ luaL_argcheck(L, pos <= ld, 3, "initial position out of string");+ initheader(L, &h);+ while (*fmt != '\0') {+ int size, ntoalign;+ KOption opt = getdetails(&h, pos, &fmt, &size, &ntoalign);+ if ((size_t)ntoalign + size > ~pos || pos + ntoalign + size > ld)+ luaL_argerror(L, 2, "data string too short");+ pos += ntoalign; /* skip alignment */+ /* stack space for item + next position */+ luaL_checkstack(L, 2, "too many results");+ n++;+ switch (opt) {+ case Kint:+ case Kuint: {+ lua_Integer res = unpackint(L, data + pos, h.islittle, size,+ (opt == Kint));+ lua_pushinteger(L, res);+ break;+ }+ case Kfloat: {+ volatile Ftypes u;+ lua_Number num;+ copywithendian(u.buff, data + pos, size, h.islittle);+ if (size == sizeof(u.f)) num = (lua_Number)u.f;+ else if (size == sizeof(u.d)) num = (lua_Number)u.d;+ else num = u.n;+ lua_pushnumber(L, num);+ break;+ }+ case Kchar: {+ lua_pushlstring(L, data + pos, size);+ break;+ }+ case Kstring: {+ size_t len = (size_t)unpackint(L, data + pos, h.islittle, size, 0);+ luaL_argcheck(L, pos + len + size <= ld, 2, "data string too short");+ lua_pushlstring(L, data + pos + size, len);+ pos += len; /* skip string */+ break;+ }+ case Kzstr: {+ size_t len = (int)strlen(data + pos);+ lua_pushlstring(L, data + pos, len);+ pos += len + 1; /* skip string plus final '\0' */+ break;+ }+ case Kpaddalign: case Kpadding: case Knop:+ n--; /* undo increment */+ break;+ }+ pos += size;+ }+ lua_pushinteger(L, pos + 1); /* next position */+ return n + 1;+}++/* }====================================================== */+++static const luaL_Reg strlib[] = {+ {"byte", str_byte},+ {"char", str_char},+ {"dump", str_dump},+ {"find", str_find},+ {"format", str_format},+ {"gmatch", gmatch},+ {"gsub", str_gsub},+ {"len", str_len},+ {"lower", str_lower},+ {"match", str_match},+ {"rep", str_rep},+ {"reverse", str_reverse},+ {"sub", str_sub},+ {"upper", str_upper},+ {"pack", str_pack},+ {"packsize", str_packsize},+ {"unpack", str_unpack},+ {NULL, NULL}+};+++static void createmetatable (lua_State *L) {+ lua_createtable(L, 0, 1); /* table to be metatable for strings */+ lua_pushliteral(L, ""); /* dummy string */+ lua_pushvalue(L, -2); /* copy table */+ lua_setmetatable(L, -2); /* set table as metatable for strings */+ lua_pop(L, 1); /* pop dummy string */+ lua_pushvalue(L, -2); /* get string library */+ lua_setfield(L, -2, "__index"); /* metatable.__index = string */+ lua_pop(L, 1); /* pop metatable */+}+++/*+** Open string library+*/+LUAMOD_API int luaopen_string (lua_State *L) {+ luaL_newlib(L, strlib);+ createmetatable(L);+ return 1;+}+
+ cbits/lua-5.3.6/ltable.c view
@@ -0,0 +1,688 @@+/*+** $Id: ltable.c,v 2.118.1.4 2018/06/08 16:22:51 roberto Exp $+** Lua tables (hash)+** See Copyright Notice in lua.h+*/++#define ltable_c+#define LUA_CORE++#include "lprefix.h"+++/*+** Implementation of tables (aka arrays, objects, or hash tables).+** Tables keep its elements in two parts: an array part and a hash part.+** Non-negative integer keys are all candidates to be kept in the array+** part. The actual size of the array is the largest 'n' such that+** more than half the slots between 1 and n are in use.+** Hash uses a mix of chained scatter table with Brent's variation.+** A main invariant of these tables is that, if an element is not+** in its main position (i.e. the 'original' position that its hash gives+** to it), then the colliding element is in its own main position.+** Hence even when the load factor reaches 100%, performance remains good.+*/++#include <math.h>+#include <limits.h>++#include "lua.h"++#include "ldebug.h"+#include "ldo.h"+#include "lgc.h"+#include "lmem.h"+#include "lobject.h"+#include "lstate.h"+#include "lstring.h"+#include "ltable.h"+#include "lvm.h"+++/*+** Maximum size of array part (MAXASIZE) is 2^MAXABITS. MAXABITS is+** the largest integer such that MAXASIZE fits in an unsigned int.+*/+#define MAXABITS cast_int(sizeof(int) * CHAR_BIT - 1)+#define MAXASIZE (1u << MAXABITS)++/*+** Maximum size of hash part is 2^MAXHBITS. MAXHBITS is the largest+** integer such that 2^MAXHBITS fits in a signed int. (Note that the+** maximum number of elements in a table, 2^MAXABITS + 2^MAXHBITS, still+** fits comfortably in an unsigned int.)+*/+#define MAXHBITS (MAXABITS - 1)+++#define hashpow2(t,n) (gnode(t, lmod((n), sizenode(t))))++#define hashstr(t,str) hashpow2(t, (str)->hash)+#define hashboolean(t,p) hashpow2(t, p)+#define hashint(t,i) hashpow2(t, i)+++/*+** for some types, it is better to avoid modulus by power of 2, as+** they tend to have many 2 factors.+*/+#define hashmod(t,n) (gnode(t, ((n) % ((sizenode(t)-1)|1))))+++#define hashpointer(t,p) hashmod(t, point2uint(p))+++#define dummynode (&dummynode_)++static const Node dummynode_ = {+ {NILCONSTANT}, /* value */+ {{NILCONSTANT, 0}} /* key */+};+++/*+** Hash for floating-point numbers.+** The main computation should be just+** n = frexp(n, &i); return (n * INT_MAX) + i+** but there are some numerical subtleties.+** In a two-complement representation, INT_MAX does not has an exact+** representation as a float, but INT_MIN does; because the absolute+** value of 'frexp' is smaller than 1 (unless 'n' is inf/NaN), the+** absolute value of the product 'frexp * -INT_MIN' is smaller or equal+** to INT_MAX. Next, the use of 'unsigned int' avoids overflows when+** adding 'i'; the use of '~u' (instead of '-u') avoids problems with+** INT_MIN.+*/+#if !defined(l_hashfloat)+static int l_hashfloat (lua_Number n) {+ int i;+ lua_Integer ni;+ n = l_mathop(frexp)(n, &i) * -cast_num(INT_MIN);+ if (!lua_numbertointeger(n, &ni)) { /* is 'n' inf/-inf/NaN? */+ lua_assert(luai_numisnan(n) || l_mathop(fabs)(n) == cast_num(HUGE_VAL));+ return 0;+ }+ else { /* normal case */+ unsigned int u = cast(unsigned int, i) + cast(unsigned int, ni);+ return cast_int(u <= cast(unsigned int, INT_MAX) ? u : ~u);+ }+}+#endif+++/*+** returns the 'main' position of an element in a table (that is, the index+** of its hash value)+*/+static Node *mainposition (const Table *t, const TValue *key) {+ switch (ttype(key)) {+ case LUA_TNUMINT:+ return hashint(t, ivalue(key));+ case LUA_TNUMFLT:+ return hashmod(t, l_hashfloat(fltvalue(key)));+ case LUA_TSHRSTR:+ return hashstr(t, tsvalue(key));+ case LUA_TLNGSTR:+ return hashpow2(t, luaS_hashlongstr(tsvalue(key)));+ case LUA_TBOOLEAN:+ return hashboolean(t, bvalue(key));+ case LUA_TLIGHTUSERDATA:+ return hashpointer(t, pvalue(key));+ case LUA_TLCF:+ return hashpointer(t, fvalue(key));+ default:+ lua_assert(!ttisdeadkey(key));+ return hashpointer(t, gcvalue(key));+ }+}+++/*+** returns the index for 'key' if 'key' is an appropriate key to live in+** the array part of the table, 0 otherwise.+*/+static unsigned int arrayindex (const TValue *key) {+ if (ttisinteger(key)) {+ lua_Integer k = ivalue(key);+ if (0 < k && (lua_Unsigned)k <= MAXASIZE)+ return cast(unsigned int, k); /* 'key' is an appropriate array index */+ }+ return 0; /* 'key' did not match some condition */+}+++/*+** returns the index of a 'key' for table traversals. First goes all+** elements in the array part, then elements in the hash part. The+** beginning of a traversal is signaled by 0.+*/+static unsigned int findindex (lua_State *L, Table *t, StkId key) {+ unsigned int i;+ if (ttisnil(key)) return 0; /* first iteration */+ i = arrayindex(key);+ if (i != 0 && i <= t->sizearray) /* is 'key' inside array part? */+ return i; /* yes; that's the index */+ else {+ int nx;+ Node *n = mainposition(t, key);+ for (;;) { /* check whether 'key' is somewhere in the chain */+ /* key may be dead already, but it is ok to use it in 'next' */+ if (luaV_rawequalobj(gkey(n), key) ||+ (ttisdeadkey(gkey(n)) && iscollectable(key) &&+ deadvalue(gkey(n)) == gcvalue(key))) {+ i = cast_int(n - gnode(t, 0)); /* key index in hash table */+ /* hash elements are numbered after array ones */+ return (i + 1) + t->sizearray;+ }+ nx = gnext(n);+ if (nx == 0)+ luaG_runerror(L, "invalid key to 'next'"); /* key not found */+ else n += nx;+ }+ }+}+++int luaH_next (lua_State *L, Table *t, StkId key) {+ unsigned int i = findindex(L, t, key); /* find original element */+ for (; i < t->sizearray; i++) { /* try first array part */+ if (!ttisnil(&t->array[i])) { /* a non-nil value? */+ setivalue(key, i + 1);+ setobj2s(L, key+1, &t->array[i]);+ return 1;+ }+ }+ for (i -= t->sizearray; cast_int(i) < sizenode(t); i++) { /* hash part */+ if (!ttisnil(gval(gnode(t, i)))) { /* a non-nil value? */+ setobj2s(L, key, gkey(gnode(t, i)));+ setobj2s(L, key+1, gval(gnode(t, i)));+ return 1;+ }+ }+ return 0; /* no more elements */+}+++/*+** {=============================================================+** Rehash+** ==============================================================+*/++/*+** Compute the optimal size for the array part of table 't'. 'nums' is a+** "count array" where 'nums[i]' is the number of integers in the table+** between 2^(i - 1) + 1 and 2^i. 'pna' enters with the total number of+** integer keys in the table and leaves with the number of keys that+** will go to the array part; return the optimal size.+*/+static unsigned int computesizes (unsigned int nums[], unsigned int *pna) {+ int i;+ unsigned int twotoi; /* 2^i (candidate for optimal size) */+ unsigned int a = 0; /* number of elements smaller than 2^i */+ unsigned int na = 0; /* number of elements to go to array part */+ unsigned int optimal = 0; /* optimal size for array part */+ /* loop while keys can fill more than half of total size */+ for (i = 0, twotoi = 1;+ twotoi > 0 && *pna > twotoi / 2;+ i++, twotoi *= 2) {+ if (nums[i] > 0) {+ a += nums[i];+ if (a > twotoi/2) { /* more than half elements present? */+ optimal = twotoi; /* optimal size (till now) */+ na = a; /* all elements up to 'optimal' will go to array part */+ }+ }+ }+ lua_assert((optimal == 0 || optimal / 2 < na) && na <= optimal);+ *pna = na;+ return optimal;+}+++static int countint (const TValue *key, unsigned int *nums) {+ unsigned int k = arrayindex(key);+ if (k != 0) { /* is 'key' an appropriate array index? */+ nums[luaO_ceillog2(k)]++; /* count as such */+ return 1;+ }+ else+ return 0;+}+++/*+** Count keys in array part of table 't': Fill 'nums[i]' with+** number of keys that will go into corresponding slice and return+** total number of non-nil keys.+*/+static unsigned int numusearray (const Table *t, unsigned int *nums) {+ int lg;+ unsigned int ttlg; /* 2^lg */+ unsigned int ause = 0; /* summation of 'nums' */+ unsigned int i = 1; /* count to traverse all array keys */+ /* traverse each slice */+ for (lg = 0, ttlg = 1; lg <= MAXABITS; lg++, ttlg *= 2) {+ unsigned int lc = 0; /* counter */+ unsigned int lim = ttlg;+ if (lim > t->sizearray) {+ lim = t->sizearray; /* adjust upper limit */+ if (i > lim)+ break; /* no more elements to count */+ }+ /* count elements in range (2^(lg - 1), 2^lg] */+ for (; i <= lim; i++) {+ if (!ttisnil(&t->array[i-1]))+ lc++;+ }+ nums[lg] += lc;+ ause += lc;+ }+ return ause;+}+++static int numusehash (const Table *t, unsigned int *nums, unsigned int *pna) {+ int totaluse = 0; /* total number of elements */+ int ause = 0; /* elements added to 'nums' (can go to array part) */+ int i = sizenode(t);+ while (i--) {+ Node *n = &t->node[i];+ if (!ttisnil(gval(n))) {+ ause += countint(gkey(n), nums);+ totaluse++;+ }+ }+ *pna += ause;+ return totaluse;+}+++static void setarrayvector (lua_State *L, Table *t, unsigned int size) {+ unsigned int i;+ luaM_reallocvector(L, t->array, t->sizearray, size, TValue);+ for (i=t->sizearray; i<size; i++)+ setnilvalue(&t->array[i]);+ t->sizearray = size;+}+++static void setnodevector (lua_State *L, Table *t, unsigned int size) {+ if (size == 0) { /* no elements to hash part? */+ t->node = cast(Node *, dummynode); /* use common 'dummynode' */+ t->lsizenode = 0;+ t->lastfree = NULL; /* signal that it is using dummy node */+ }+ else {+ int i;+ int lsize = luaO_ceillog2(size);+ if (lsize > MAXHBITS)+ luaG_runerror(L, "table overflow");+ size = twoto(lsize);+ t->node = luaM_newvector(L, size, Node);+ for (i = 0; i < (int)size; i++) {+ Node *n = gnode(t, i);+ gnext(n) = 0;+ setnilvalue(wgkey(n));+ setnilvalue(gval(n));+ }+ t->lsizenode = cast_byte(lsize);+ t->lastfree = gnode(t, size); /* all positions are free */+ }+}+++typedef struct {+ Table *t;+ unsigned int nhsize;+} AuxsetnodeT;+++static void auxsetnode (lua_State *L, void *ud) {+ AuxsetnodeT *asn = cast(AuxsetnodeT *, ud);+ setnodevector(L, asn->t, asn->nhsize);+}+++void luaH_resize (lua_State *L, Table *t, unsigned int nasize,+ unsigned int nhsize) {+ unsigned int i;+ int j;+ AuxsetnodeT asn;+ unsigned int oldasize = t->sizearray;+ int oldhsize = allocsizenode(t);+ Node *nold = t->node; /* save old hash ... */+ if (nasize > oldasize) /* array part must grow? */+ setarrayvector(L, t, nasize);+ /* create new hash part with appropriate size */+ asn.t = t; asn.nhsize = nhsize;+ if (luaD_rawrunprotected(L, auxsetnode, &asn) != LUA_OK) { /* mem. error? */+ setarrayvector(L, t, oldasize); /* array back to its original size */+ luaD_throw(L, LUA_ERRMEM); /* rethrow memory error */+ }+ if (nasize < oldasize) { /* array part must shrink? */+ t->sizearray = nasize;+ /* re-insert elements from vanishing slice */+ for (i=nasize; i<oldasize; i++) {+ if (!ttisnil(&t->array[i]))+ luaH_setint(L, t, i + 1, &t->array[i]);+ }+ /* shrink array */+ luaM_reallocvector(L, t->array, oldasize, nasize, TValue);+ }+ /* re-insert elements from hash part */+ for (j = oldhsize - 1; j >= 0; j--) {+ Node *old = nold + j;+ if (!ttisnil(gval(old))) {+ /* doesn't need barrier/invalidate cache, as entry was+ already present in the table */+ setobjt2t(L, luaH_set(L, t, gkey(old)), gval(old));+ }+ }+ if (oldhsize > 0) /* not the dummy node? */+ luaM_freearray(L, nold, cast(size_t, oldhsize)); /* free old hash */+}+++void luaH_resizearray (lua_State *L, Table *t, unsigned int nasize) {+ int nsize = allocsizenode(t);+ luaH_resize(L, t, nasize, nsize);+}++/*+** nums[i] = number of keys 'k' where 2^(i - 1) < k <= 2^i+*/+static void rehash (lua_State *L, Table *t, const TValue *ek) {+ unsigned int asize; /* optimal size for array part */+ unsigned int na; /* number of keys in the array part */+ unsigned int nums[MAXABITS + 1];+ int i;+ int totaluse;+ for (i = 0; i <= MAXABITS; i++) nums[i] = 0; /* reset counts */+ na = numusearray(t, nums); /* count keys in array part */+ totaluse = na; /* all those keys are integer keys */+ totaluse += numusehash(t, nums, &na); /* count keys in hash part */+ /* count extra key */+ na += countint(ek, nums);+ totaluse++;+ /* compute new size for array part */+ asize = computesizes(nums, &na);+ /* resize the table to new computed sizes */+ luaH_resize(L, t, asize, totaluse - na);+}++++/*+** }=============================================================+*/+++Table *luaH_new (lua_State *L) {+ GCObject *o = luaC_newobj(L, LUA_TTABLE, sizeof(Table));+ Table *t = gco2t(o);+ t->metatable = NULL;+ t->flags = cast_byte(~0);+ t->array = NULL;+ t->sizearray = 0;+ setnodevector(L, t, 0);+ return t;+}+++void luaH_free (lua_State *L, Table *t) {+ if (!isdummy(t))+ luaM_freearray(L, t->node, cast(size_t, sizenode(t)));+ luaM_freearray(L, t->array, t->sizearray);+ luaM_free(L, t);+}+++static Node *getfreepos (Table *t) {+ if (!isdummy(t)) {+ while (t->lastfree > t->node) {+ t->lastfree--;+ if (ttisnil(gkey(t->lastfree)))+ return t->lastfree;+ }+ }+ return NULL; /* could not find a free place */+}++++/*+** inserts a new key into a hash table; first, check whether key's main+** position is free. If not, check whether colliding node is in its main+** position or not: if it is not, move colliding node to an empty place and+** put new key in its main position; otherwise (colliding node is in its main+** position), new key goes to an empty position.+*/+TValue *luaH_newkey (lua_State *L, Table *t, const TValue *key) {+ Node *mp;+ TValue aux;+ if (ttisnil(key)) luaG_runerror(L, "table index is nil");+ else if (ttisfloat(key)) {+ lua_Integer k;+ if (luaV_tointeger(key, &k, 0)) { /* does index fit in an integer? */+ setivalue(&aux, k);+ key = &aux; /* insert it as an integer */+ }+ else if (luai_numisnan(fltvalue(key)))+ luaG_runerror(L, "table index is NaN");+ }+ mp = mainposition(t, key);+ if (!ttisnil(gval(mp)) || isdummy(t)) { /* main position is taken? */+ Node *othern;+ Node *f = getfreepos(t); /* get a free place */+ if (f == NULL) { /* cannot find a free place? */+ rehash(L, t, key); /* grow table */+ /* whatever called 'newkey' takes care of TM cache */+ return luaH_set(L, t, key); /* insert key into grown table */+ }+ lua_assert(!isdummy(t));+ othern = mainposition(t, gkey(mp));+ if (othern != mp) { /* is colliding node out of its main position? */+ /* yes; move colliding node into free position */+ while (othern + gnext(othern) != mp) /* find previous */+ othern += gnext(othern);+ gnext(othern) = cast_int(f - othern); /* rechain to point to 'f' */+ *f = *mp; /* copy colliding node into free pos. (mp->next also goes) */+ if (gnext(mp) != 0) {+ gnext(f) += cast_int(mp - f); /* correct 'next' */+ gnext(mp) = 0; /* now 'mp' is free */+ }+ setnilvalue(gval(mp));+ }+ else { /* colliding node is in its own main position */+ /* new node will go into free position */+ if (gnext(mp) != 0)+ gnext(f) = cast_int((mp + gnext(mp)) - f); /* chain new position */+ else lua_assert(gnext(f) == 0);+ gnext(mp) = cast_int(f - mp);+ mp = f;+ }+ }+ setnodekey(L, &mp->i_key, key);+ luaC_barrierback(L, t, key);+ lua_assert(ttisnil(gval(mp)));+ return gval(mp);+}+++/*+** search function for integers+*/+const TValue *luaH_getint (Table *t, lua_Integer key) {+ /* (1 <= key && key <= t->sizearray) */+ if (l_castS2U(key) - 1 < t->sizearray)+ return &t->array[key - 1];+ else {+ Node *n = hashint(t, key);+ for (;;) { /* check whether 'key' is somewhere in the chain */+ if (ttisinteger(gkey(n)) && ivalue(gkey(n)) == key)+ return gval(n); /* that's it */+ else {+ int nx = gnext(n);+ if (nx == 0) break;+ n += nx;+ }+ }+ return luaO_nilobject;+ }+}+++/*+** search function for short strings+*/+const TValue *luaH_getshortstr (Table *t, TString *key) {+ Node *n = hashstr(t, key);+ lua_assert(key->tt == LUA_TSHRSTR);+ for (;;) { /* check whether 'key' is somewhere in the chain */+ const TValue *k = gkey(n);+ if (ttisshrstring(k) && eqshrstr(tsvalue(k), key))+ return gval(n); /* that's it */+ else {+ int nx = gnext(n);+ if (nx == 0)+ return luaO_nilobject; /* not found */+ n += nx;+ }+ }+}+++/*+** "Generic" get version. (Not that generic: not valid for integers,+** which may be in array part, nor for floats with integral values.)+*/+static const TValue *getgeneric (Table *t, const TValue *key) {+ Node *n = mainposition(t, key);+ for (;;) { /* check whether 'key' is somewhere in the chain */+ if (luaV_rawequalobj(gkey(n), key))+ return gval(n); /* that's it */+ else {+ int nx = gnext(n);+ if (nx == 0)+ return luaO_nilobject; /* not found */+ n += nx;+ }+ }+}+++const TValue *luaH_getstr (Table *t, TString *key) {+ if (key->tt == LUA_TSHRSTR)+ return luaH_getshortstr(t, key);+ else { /* for long strings, use generic case */+ TValue ko;+ setsvalue(cast(lua_State *, NULL), &ko, key);+ return getgeneric(t, &ko);+ }+}+++/*+** main search function+*/+const TValue *luaH_get (Table *t, const TValue *key) {+ switch (ttype(key)) {+ case LUA_TSHRSTR: return luaH_getshortstr(t, tsvalue(key));+ case LUA_TNUMINT: return luaH_getint(t, ivalue(key));+ case LUA_TNIL: return luaO_nilobject;+ case LUA_TNUMFLT: {+ lua_Integer k;+ if (luaV_tointeger(key, &k, 0)) /* index is int? */+ return luaH_getint(t, k); /* use specialized version */+ /* else... */+ } /* FALLTHROUGH */+ default:+ return getgeneric(t, key);+ }+}+++/*+** beware: when using this function you probably need to check a GC+** barrier and invalidate the TM cache.+*/+TValue *luaH_set (lua_State *L, Table *t, const TValue *key) {+ const TValue *p = luaH_get(t, key);+ if (p != luaO_nilobject)+ return cast(TValue *, p);+ else return luaH_newkey(L, t, key);+}+++void luaH_setint (lua_State *L, Table *t, lua_Integer key, TValue *value) {+ const TValue *p = luaH_getint(t, key);+ TValue *cell;+ if (p != luaO_nilobject)+ cell = cast(TValue *, p);+ else {+ TValue k;+ setivalue(&k, key);+ cell = luaH_newkey(L, t, &k);+ }+ setobj2t(L, cell, value);+}+++static lua_Unsigned unbound_search (Table *t, lua_Unsigned j) {+ lua_Unsigned i = j; /* i is zero or a present index */+ j++;+ /* find 'i' and 'j' such that i is present and j is not */+ while (!ttisnil(luaH_getint(t, j))) {+ i = j;+ if (j > l_castS2U(LUA_MAXINTEGER) / 2) { /* overflow? */+ /* table was built with bad purposes: resort to linear search */+ i = 1;+ while (!ttisnil(luaH_getint(t, i))) i++;+ return i - 1;+ }+ j *= 2;+ }+ /* now do a binary search between them */+ while (j - i > 1) {+ lua_Unsigned m = (i+j)/2;+ if (ttisnil(luaH_getint(t, m))) j = m;+ else i = m;+ }+ return i;+}+++/*+** Try to find a boundary in table 't'. A 'boundary' is an integer index+** such that t[i] is non-nil and t[i+1] is nil (and 0 if t[1] is nil).+*/+lua_Unsigned luaH_getn (Table *t) {+ unsigned int j = t->sizearray;+ if (j > 0 && ttisnil(&t->array[j - 1])) {+ /* there is a boundary in the array part: (binary) search for it */+ unsigned int i = 0;+ while (j - i > 1) {+ unsigned int m = (i+j)/2;+ if (ttisnil(&t->array[m - 1])) j = m;+ else i = m;+ }+ return i;+ }+ /* else must find a boundary in hash part */+ else if (isdummy(t)) /* hash part is empty? */+ return j; /* that is easy... */+ else return unbound_search(t, j);+}++++#if defined(LUA_DEBUG)++Node *luaH_mainposition (const Table *t, const TValue *key) {+ return mainposition(t, key);+}++int luaH_isdummy (const Table *t) { return isdummy(t); }++#endif
+ cbits/lua-5.3.6/ltable.h view
@@ -0,0 +1,66 @@+/*+** $Id: ltable.h,v 2.23.1.2 2018/05/24 19:39:05 roberto Exp $+** Lua tables (hash)+** See Copyright Notice in lua.h+*/++#ifndef ltable_h+#define ltable_h++#include "lobject.h"+++#define gnode(t,i) (&(t)->node[i])+#define gval(n) (&(n)->i_val)+#define gnext(n) ((n)->i_key.nk.next)+++/* 'const' to avoid wrong writings that can mess up field 'next' */+#define gkey(n) cast(const TValue*, (&(n)->i_key.tvk))++/*+** writable version of 'gkey'; allows updates to individual fields,+** but not to the whole (which has incompatible type)+*/+#define wgkey(n) (&(n)->i_key.nk)++#define invalidateTMcache(t) ((t)->flags = 0)+++/* true when 't' is using 'dummynode' as its hash part */+#define isdummy(t) ((t)->lastfree == NULL)+++/* allocated size for hash nodes */+#define allocsizenode(t) (isdummy(t) ? 0 : sizenode(t))+++/* returns the key, given the value of a table entry */+#define keyfromval(v) \+ (gkey(cast(Node *, cast(char *, (v)) - offsetof(Node, i_val))))+++LUAI_FUNC const TValue *luaH_getint (Table *t, lua_Integer key);+LUAI_FUNC void luaH_setint (lua_State *L, Table *t, lua_Integer key,+ TValue *value);+LUAI_FUNC const TValue *luaH_getshortstr (Table *t, TString *key);+LUAI_FUNC const TValue *luaH_getstr (Table *t, TString *key);+LUAI_FUNC const TValue *luaH_get (Table *t, const TValue *key);+LUAI_FUNC TValue *luaH_newkey (lua_State *L, Table *t, const TValue *key);+LUAI_FUNC TValue *luaH_set (lua_State *L, Table *t, const TValue *key);+LUAI_FUNC Table *luaH_new (lua_State *L);+LUAI_FUNC void luaH_resize (lua_State *L, Table *t, unsigned int nasize,+ unsigned int nhsize);+LUAI_FUNC void luaH_resizearray (lua_State *L, Table *t, unsigned int nasize);+LUAI_FUNC void luaH_free (lua_State *L, Table *t);+LUAI_FUNC int luaH_next (lua_State *L, Table *t, StkId key);+LUAI_FUNC lua_Unsigned luaH_getn (Table *t);+++#if defined(LUA_DEBUG)+LUAI_FUNC Node *luaH_mainposition (const Table *t, const TValue *key);+LUAI_FUNC int luaH_isdummy (const Table *t);+#endif+++#endif
+ cbits/lua-5.3.6/ltablib.c view
@@ -0,0 +1,450 @@+/*+** $Id: ltablib.c,v 1.93.1.1 2017/04/19 17:20:42 roberto Exp $+** Library for Table Manipulation+** See Copyright Notice in lua.h+*/++#define ltablib_c+#define LUA_LIB++#include "lprefix.h"+++#include <limits.h>+#include <stddef.h>+#include <string.h>++#include "lua.h"++#include "lauxlib.h"+#include "lualib.h"+++/*+** Operations that an object must define to mimic a table+** (some functions only need some of them)+*/+#define TAB_R 1 /* read */+#define TAB_W 2 /* write */+#define TAB_L 4 /* length */+#define TAB_RW (TAB_R | TAB_W) /* read/write */+++#define aux_getn(L,n,w) (checktab(L, n, (w) | TAB_L), luaL_len(L, n))+++static int checkfield (lua_State *L, const char *key, int n) {+ lua_pushstring(L, key);+ return (lua_rawget(L, -n) != LUA_TNIL);+}+++/*+** Check that 'arg' either is a table or can behave like one (that is,+** has a metatable with the required metamethods)+*/+static void checktab (lua_State *L, int arg, int what) {+ if (lua_type(L, arg) != LUA_TTABLE) { /* is it not a table? */+ int n = 1; /* number of elements to pop */+ if (lua_getmetatable(L, arg) && /* must have metatable */+ (!(what & TAB_R) || checkfield(L, "__index", ++n)) &&+ (!(what & TAB_W) || checkfield(L, "__newindex", ++n)) &&+ (!(what & TAB_L) || checkfield(L, "__len", ++n))) {+ lua_pop(L, n); /* pop metatable and tested metamethods */+ }+ else+ luaL_checktype(L, arg, LUA_TTABLE); /* force an error */+ }+}+++#if defined(LUA_COMPAT_MAXN)+static int maxn (lua_State *L) {+ lua_Number max = 0;+ luaL_checktype(L, 1, LUA_TTABLE);+ lua_pushnil(L); /* first key */+ while (lua_next(L, 1)) {+ lua_pop(L, 1); /* remove value */+ if (lua_type(L, -1) == LUA_TNUMBER) {+ lua_Number v = lua_tonumber(L, -1);+ if (v > max) max = v;+ }+ }+ lua_pushnumber(L, max);+ return 1;+}+#endif+++static int tinsert (lua_State *L) {+ lua_Integer e = aux_getn(L, 1, TAB_RW) + 1; /* first empty element */+ lua_Integer pos; /* where to insert new element */+ switch (lua_gettop(L)) {+ case 2: { /* called with only 2 arguments */+ pos = e; /* insert new element at the end */+ break;+ }+ case 3: {+ lua_Integer i;+ pos = luaL_checkinteger(L, 2); /* 2nd argument is the position */+ luaL_argcheck(L, 1 <= pos && pos <= e, 2, "position out of bounds");+ for (i = e; i > pos; i--) { /* move up elements */+ lua_geti(L, 1, i - 1);+ lua_seti(L, 1, i); /* t[i] = t[i - 1] */+ }+ break;+ }+ default: {+ return luaL_error(L, "wrong number of arguments to 'insert'");+ }+ }+ lua_seti(L, 1, pos); /* t[pos] = v */+ return 0;+}+++static int tremove (lua_State *L) {+ lua_Integer size = aux_getn(L, 1, TAB_RW);+ lua_Integer pos = luaL_optinteger(L, 2, size);+ if (pos != size) /* validate 'pos' if given */+ luaL_argcheck(L, 1 <= pos && pos <= size + 1, 1, "position out of bounds");+ lua_geti(L, 1, pos); /* result = t[pos] */+ for ( ; pos < size; pos++) {+ lua_geti(L, 1, pos + 1);+ lua_seti(L, 1, pos); /* t[pos] = t[pos + 1] */+ }+ lua_pushnil(L);+ lua_seti(L, 1, pos); /* t[pos] = nil */+ return 1;+}+++/*+** Copy elements (1[f], ..., 1[e]) into (tt[t], tt[t+1], ...). Whenever+** possible, copy in increasing order, which is better for rehashing.+** "possible" means destination after original range, or smaller+** than origin, or copying to another table.+*/+static int tmove (lua_State *L) {+ lua_Integer f = luaL_checkinteger(L, 2);+ lua_Integer e = luaL_checkinteger(L, 3);+ lua_Integer t = luaL_checkinteger(L, 4);+ int tt = !lua_isnoneornil(L, 5) ? 5 : 1; /* destination table */+ checktab(L, 1, TAB_R);+ checktab(L, tt, TAB_W);+ if (e >= f) { /* otherwise, nothing to move */+ lua_Integer n, i;+ luaL_argcheck(L, f > 0 || e < LUA_MAXINTEGER + f, 3,+ "too many elements to move");+ n = e - f + 1; /* number of elements to move */+ luaL_argcheck(L, t <= LUA_MAXINTEGER - n + 1, 4,+ "destination wrap around");+ if (t > e || t <= f || (tt != 1 && !lua_compare(L, 1, tt, LUA_OPEQ))) {+ for (i = 0; i < n; i++) {+ lua_geti(L, 1, f + i);+ lua_seti(L, tt, t + i);+ }+ }+ else {+ for (i = n - 1; i >= 0; i--) {+ lua_geti(L, 1, f + i);+ lua_seti(L, tt, t + i);+ }+ }+ }+ lua_pushvalue(L, tt); /* return destination table */+ return 1;+}+++static void addfield (lua_State *L, luaL_Buffer *b, lua_Integer i) {+ lua_geti(L, 1, i);+ if (!lua_isstring(L, -1))+ luaL_error(L, "invalid value (%s) at index %d in table for 'concat'",+ luaL_typename(L, -1), i);+ luaL_addvalue(b);+}+++static int tconcat (lua_State *L) {+ luaL_Buffer b;+ lua_Integer last = aux_getn(L, 1, TAB_R);+ size_t lsep;+ const char *sep = luaL_optlstring(L, 2, "", &lsep);+ lua_Integer i = luaL_optinteger(L, 3, 1);+ last = luaL_optinteger(L, 4, last);+ luaL_buffinit(L, &b);+ for (; i < last; i++) {+ addfield(L, &b, i);+ luaL_addlstring(&b, sep, lsep);+ }+ if (i == last) /* add last value (if interval was not empty) */+ addfield(L, &b, i);+ luaL_pushresult(&b);+ return 1;+}+++/*+** {======================================================+** Pack/unpack+** =======================================================+*/++static int pack (lua_State *L) {+ int i;+ int n = lua_gettop(L); /* number of elements to pack */+ lua_createtable(L, n, 1); /* create result table */+ lua_insert(L, 1); /* put it at index 1 */+ for (i = n; i >= 1; i--) /* assign elements */+ lua_seti(L, 1, i);+ lua_pushinteger(L, n);+ lua_setfield(L, 1, "n"); /* t.n = number of elements */+ return 1; /* return table */+}+++static int unpack (lua_State *L) {+ lua_Unsigned n;+ lua_Integer i = luaL_optinteger(L, 2, 1);+ lua_Integer e = luaL_opt(L, luaL_checkinteger, 3, luaL_len(L, 1));+ if (i > e) return 0; /* empty range */+ n = (lua_Unsigned)e - i; /* number of elements minus 1 (avoid overflows) */+ if (n >= (unsigned int)INT_MAX || !lua_checkstack(L, (int)(++n)))+ return luaL_error(L, "too many results to unpack");+ for (; i < e; i++) { /* push arg[i..e - 1] (to avoid overflows) */+ lua_geti(L, 1, i);+ }+ lua_geti(L, 1, e); /* push last element */+ return (int)n;+}++/* }====================================================== */++++/*+** {======================================================+** Quicksort+** (based on 'Algorithms in MODULA-3', Robert Sedgewick;+** Addison-Wesley, 1993.)+** =======================================================+*/+++/* type for array indices */+typedef unsigned int IdxT;+++/*+** Produce a "random" 'unsigned int' to randomize pivot choice. This+** macro is used only when 'sort' detects a big imbalance in the result+** of a partition. (If you don't want/need this "randomness", ~0 is a+** good choice.)+*/+#if !defined(l_randomizePivot) /* { */++#include <time.h>++/* size of 'e' measured in number of 'unsigned int's */+#define sof(e) (sizeof(e) / sizeof(unsigned int))++/*+** Use 'time' and 'clock' as sources of "randomness". Because we don't+** know the types 'clock_t' and 'time_t', we cannot cast them to+** anything without risking overflows. A safe way to use their values+** is to copy them to an array of a known type and use the array values.+*/+static unsigned int l_randomizePivot (void) {+ clock_t c = clock();+ time_t t = time(NULL);+ unsigned int buff[sof(c) + sof(t)];+ unsigned int i, rnd = 0;+ memcpy(buff, &c, sof(c) * sizeof(unsigned int));+ memcpy(buff + sof(c), &t, sof(t) * sizeof(unsigned int));+ for (i = 0; i < sof(buff); i++)+ rnd += buff[i];+ return rnd;+}++#endif /* } */+++/* arrays larger than 'RANLIMIT' may use randomized pivots */+#define RANLIMIT 100u+++static void set2 (lua_State *L, IdxT i, IdxT j) {+ lua_seti(L, 1, i);+ lua_seti(L, 1, j);+}+++/*+** Return true iff value at stack index 'a' is less than the value at+** index 'b' (according to the order of the sort).+*/+static int sort_comp (lua_State *L, int a, int b) {+ if (lua_isnil(L, 2)) /* no function? */+ return lua_compare(L, a, b, LUA_OPLT); /* a < b */+ else { /* function */+ int res;+ lua_pushvalue(L, 2); /* push function */+ lua_pushvalue(L, a-1); /* -1 to compensate function */+ lua_pushvalue(L, b-2); /* -2 to compensate function and 'a' */+ lua_call(L, 2, 1); /* call function */+ res = lua_toboolean(L, -1); /* get result */+ lua_pop(L, 1); /* pop result */+ return res;+ }+}+++/*+** Does the partition: Pivot P is at the top of the stack.+** precondition: a[lo] <= P == a[up-1] <= a[up],+** so it only needs to do the partition from lo + 1 to up - 2.+** Pos-condition: a[lo .. i - 1] <= a[i] == P <= a[i + 1 .. up]+** returns 'i'.+*/+static IdxT partition (lua_State *L, IdxT lo, IdxT up) {+ IdxT i = lo; /* will be incremented before first use */+ IdxT j = up - 1; /* will be decremented before first use */+ /* loop invariant: a[lo .. i] <= P <= a[j .. up] */+ for (;;) {+ /* next loop: repeat ++i while a[i] < P */+ while (lua_geti(L, 1, ++i), sort_comp(L, -1, -2)) {+ if (i == up - 1) /* a[i] < P but a[up - 1] == P ?? */+ luaL_error(L, "invalid order function for sorting");+ lua_pop(L, 1); /* remove a[i] */+ }+ /* after the loop, a[i] >= P and a[lo .. i - 1] < P */+ /* next loop: repeat --j while P < a[j] */+ while (lua_geti(L, 1, --j), sort_comp(L, -3, -1)) {+ if (j < i) /* j < i but a[j] > P ?? */+ luaL_error(L, "invalid order function for sorting");+ lua_pop(L, 1); /* remove a[j] */+ }+ /* after the loop, a[j] <= P and a[j + 1 .. up] >= P */+ if (j < i) { /* no elements out of place? */+ /* a[lo .. i - 1] <= P <= a[j + 1 .. i .. up] */+ lua_pop(L, 1); /* pop a[j] */+ /* swap pivot (a[up - 1]) with a[i] to satisfy pos-condition */+ set2(L, up - 1, i);+ return i;+ }+ /* otherwise, swap a[i] - a[j] to restore invariant and repeat */+ set2(L, i, j);+ }+}+++/*+** Choose an element in the middle (2nd-3th quarters) of [lo,up]+** "randomized" by 'rnd'+*/+static IdxT choosePivot (IdxT lo, IdxT up, unsigned int rnd) {+ IdxT r4 = (up - lo) / 4; /* range/4 */+ IdxT p = rnd % (r4 * 2) + (lo + r4);+ lua_assert(lo + r4 <= p && p <= up - r4);+ return p;+}+++/*+** QuickSort algorithm (recursive function)+*/+static void auxsort (lua_State *L, IdxT lo, IdxT up,+ unsigned int rnd) {+ while (lo < up) { /* loop for tail recursion */+ IdxT p; /* Pivot index */+ IdxT n; /* to be used later */+ /* sort elements 'lo', 'p', and 'up' */+ lua_geti(L, 1, lo);+ lua_geti(L, 1, up);+ if (sort_comp(L, -1, -2)) /* a[up] < a[lo]? */+ set2(L, lo, up); /* swap a[lo] - a[up] */+ else+ lua_pop(L, 2); /* remove both values */+ if (up - lo == 1) /* only 2 elements? */+ return; /* already sorted */+ if (up - lo < RANLIMIT || rnd == 0) /* small interval or no randomize? */+ p = (lo + up)/2; /* middle element is a good pivot */+ else /* for larger intervals, it is worth a random pivot */+ p = choosePivot(lo, up, rnd);+ lua_geti(L, 1, p);+ lua_geti(L, 1, lo);+ if (sort_comp(L, -2, -1)) /* a[p] < a[lo]? */+ set2(L, p, lo); /* swap a[p] - a[lo] */+ else {+ lua_pop(L, 1); /* remove a[lo] */+ lua_geti(L, 1, up);+ if (sort_comp(L, -1, -2)) /* a[up] < a[p]? */+ set2(L, p, up); /* swap a[up] - a[p] */+ else+ lua_pop(L, 2);+ }+ if (up - lo == 2) /* only 3 elements? */+ return; /* already sorted */+ lua_geti(L, 1, p); /* get middle element (Pivot) */+ lua_pushvalue(L, -1); /* push Pivot */+ lua_geti(L, 1, up - 1); /* push a[up - 1] */+ set2(L, p, up - 1); /* swap Pivot (a[p]) with a[up - 1] */+ p = partition(L, lo, up);+ /* a[lo .. p - 1] <= a[p] == P <= a[p + 1 .. up] */+ if (p - lo < up - p) { /* lower interval is smaller? */+ auxsort(L, lo, p - 1, rnd); /* call recursively for lower interval */+ n = p - lo; /* size of smaller interval */+ lo = p + 1; /* tail call for [p + 1 .. up] (upper interval) */+ }+ else {+ auxsort(L, p + 1, up, rnd); /* call recursively for upper interval */+ n = up - p; /* size of smaller interval */+ up = p - 1; /* tail call for [lo .. p - 1] (lower interval) */+ }+ if ((up - lo) / 128 > n) /* partition too imbalanced? */+ rnd = l_randomizePivot(); /* try a new randomization */+ } /* tail call auxsort(L, lo, up, rnd) */+}+++static int sort (lua_State *L) {+ lua_Integer n = aux_getn(L, 1, TAB_RW);+ if (n > 1) { /* non-trivial interval? */+ luaL_argcheck(L, n < INT_MAX, 1, "array too big");+ if (!lua_isnoneornil(L, 2)) /* is there a 2nd argument? */+ luaL_checktype(L, 2, LUA_TFUNCTION); /* must be a function */+ lua_settop(L, 2); /* make sure there are two arguments */+ auxsort(L, 1, (IdxT)n, 0);+ }+ return 0;+}++/* }====================================================== */+++static const luaL_Reg tab_funcs[] = {+ {"concat", tconcat},+#if defined(LUA_COMPAT_MAXN)+ {"maxn", maxn},+#endif+ {"insert", tinsert},+ {"pack", pack},+ {"unpack", unpack},+ {"remove", tremove},+ {"move", tmove},+ {"sort", sort},+ {NULL, NULL}+};+++LUAMOD_API int luaopen_table (lua_State *L) {+ luaL_newlib(L, tab_funcs);+#if defined(LUA_COMPAT_UNPACK)+ /* _G.unpack = table.unpack */+ lua_getfield(L, -1, "unpack");+ lua_setglobal(L, "unpack");+#endif+ return 1;+}+
+ cbits/lua-5.3.6/ltm.c view
@@ -0,0 +1,165 @@+/*+** $Id: ltm.c,v 2.38.1.1 2017/04/19 17:39:34 roberto Exp $+** Tag methods+** See Copyright Notice in lua.h+*/++#define ltm_c+#define LUA_CORE++#include "lprefix.h"+++#include <string.h>++#include "lua.h"++#include "ldebug.h"+#include "ldo.h"+#include "lobject.h"+#include "lstate.h"+#include "lstring.h"+#include "ltable.h"+#include "ltm.h"+#include "lvm.h"+++static const char udatatypename[] = "userdata";++LUAI_DDEF const char *const luaT_typenames_[LUA_TOTALTAGS] = {+ "no value",+ "nil", "boolean", udatatypename, "number",+ "string", "table", "function", udatatypename, "thread",+ "proto" /* this last case is used for tests only */+};+++void luaT_init (lua_State *L) {+ static const char *const luaT_eventname[] = { /* ORDER TM */+ "__index", "__newindex",+ "__gc", "__mode", "__len", "__eq",+ "__add", "__sub", "__mul", "__mod", "__pow",+ "__div", "__idiv",+ "__band", "__bor", "__bxor", "__shl", "__shr",+ "__unm", "__bnot", "__lt", "__le",+ "__concat", "__call"+ };+ int i;+ for (i=0; i<TM_N; i++) {+ G(L)->tmname[i] = luaS_new(L, luaT_eventname[i]);+ luaC_fix(L, obj2gco(G(L)->tmname[i])); /* never collect these names */+ }+}+++/*+** function to be used with macro "fasttm": optimized for absence of+** tag methods+*/+const TValue *luaT_gettm (Table *events, TMS event, TString *ename) {+ const TValue *tm = luaH_getshortstr(events, ename);+ lua_assert(event <= TM_EQ);+ if (ttisnil(tm)) { /* no tag method? */+ events->flags |= cast_byte(1u<<event); /* cache this fact */+ return NULL;+ }+ else return tm;+}+++const TValue *luaT_gettmbyobj (lua_State *L, const TValue *o, TMS event) {+ Table *mt;+ switch (ttnov(o)) {+ case LUA_TTABLE:+ mt = hvalue(o)->metatable;+ break;+ case LUA_TUSERDATA:+ mt = uvalue(o)->metatable;+ break;+ default:+ mt = G(L)->mt[ttnov(o)];+ }+ return (mt ? luaH_getshortstr(mt, G(L)->tmname[event]) : luaO_nilobject);+}+++/*+** Return the name of the type of an object. For tables and userdata+** with metatable, use their '__name' metafield, if present.+*/+const char *luaT_objtypename (lua_State *L, const TValue *o) {+ Table *mt;+ if ((ttistable(o) && (mt = hvalue(o)->metatable) != NULL) ||+ (ttisfulluserdata(o) && (mt = uvalue(o)->metatable) != NULL)) {+ const TValue *name = luaH_getshortstr(mt, luaS_new(L, "__name"));+ if (ttisstring(name)) /* is '__name' a string? */+ return getstr(tsvalue(name)); /* use it as type name */+ }+ return ttypename(ttnov(o)); /* else use standard type name */+}+++void luaT_callTM (lua_State *L, const TValue *f, const TValue *p1,+ const TValue *p2, TValue *p3, int hasres) {+ ptrdiff_t result = savestack(L, p3);+ StkId func = L->top;+ setobj2s(L, func, f); /* push function (assume EXTRA_STACK) */+ setobj2s(L, func + 1, p1); /* 1st argument */+ setobj2s(L, func + 2, p2); /* 2nd argument */+ L->top += 3;+ if (!hasres) /* no result? 'p3' is third argument */+ setobj2s(L, L->top++, p3); /* 3rd argument */+ /* metamethod may yield only when called from Lua code */+ if (isLua(L->ci))+ luaD_call(L, func, hasres);+ else+ luaD_callnoyield(L, func, hasres);+ if (hasres) { /* if has result, move it to its place */+ p3 = restorestack(L, result);+ setobjs2s(L, p3, --L->top);+ }+}+++int luaT_callbinTM (lua_State *L, const TValue *p1, const TValue *p2,+ StkId res, TMS event) {+ const TValue *tm = luaT_gettmbyobj(L, p1, event); /* try first operand */+ if (ttisnil(tm))+ tm = luaT_gettmbyobj(L, p2, event); /* try second operand */+ if (ttisnil(tm)) return 0;+ luaT_callTM(L, tm, p1, p2, res, 1);+ return 1;+}+++void luaT_trybinTM (lua_State *L, const TValue *p1, const TValue *p2,+ StkId res, TMS event) {+ if (!luaT_callbinTM(L, p1, p2, res, event)) {+ switch (event) {+ case TM_CONCAT:+ luaG_concaterror(L, p1, p2);+ /* call never returns, but to avoid warnings: *//* FALLTHROUGH */+ case TM_BAND: case TM_BOR: case TM_BXOR:+ case TM_SHL: case TM_SHR: case TM_BNOT: {+ lua_Number dummy;+ if (tonumber(p1, &dummy) && tonumber(p2, &dummy))+ luaG_tointerror(L, p1, p2);+ else+ luaG_opinterror(L, p1, p2, "perform bitwise operation on");+ }+ /* calls never return, but to avoid warnings: *//* FALLTHROUGH */+ default:+ luaG_opinterror(L, p1, p2, "perform arithmetic on");+ }+ }+}+++int luaT_callorderTM (lua_State *L, const TValue *p1, const TValue *p2,+ TMS event) {+ if (!luaT_callbinTM(L, p1, p2, L->top, event))+ return -1; /* no metamethod */+ else+ return !l_isfalse(L->top);+}+
+ cbits/lua-5.3.6/ltm.h view
@@ -0,0 +1,76 @@+/*+** $Id: ltm.h,v 2.22.1.1 2017/04/19 17:20:42 roberto Exp $+** Tag methods+** See Copyright Notice in lua.h+*/++#ifndef ltm_h+#define ltm_h+++#include "lobject.h"+++/*+* WARNING: if you change the order of this enumeration,+* grep "ORDER TM" and "ORDER OP"+*/+typedef enum {+ TM_INDEX,+ TM_NEWINDEX,+ TM_GC,+ TM_MODE,+ TM_LEN,+ TM_EQ, /* last tag method with fast access */+ TM_ADD,+ TM_SUB,+ TM_MUL,+ TM_MOD,+ TM_POW,+ TM_DIV,+ TM_IDIV,+ TM_BAND,+ TM_BOR,+ TM_BXOR,+ TM_SHL,+ TM_SHR,+ TM_UNM,+ TM_BNOT,+ TM_LT,+ TM_LE,+ TM_CONCAT,+ TM_CALL,+ TM_N /* number of elements in the enum */+} TMS;++++#define gfasttm(g,et,e) ((et) == NULL ? NULL : \+ ((et)->flags & (1u<<(e))) ? NULL : luaT_gettm(et, e, (g)->tmname[e]))++#define fasttm(l,et,e) gfasttm(G(l), et, e)++#define ttypename(x) luaT_typenames_[(x) + 1]++LUAI_DDEC const char *const luaT_typenames_[LUA_TOTALTAGS];+++LUAI_FUNC const char *luaT_objtypename (lua_State *L, const TValue *o);++LUAI_FUNC const TValue *luaT_gettm (Table *events, TMS event, TString *ename);+LUAI_FUNC const TValue *luaT_gettmbyobj (lua_State *L, const TValue *o,+ TMS event);+LUAI_FUNC void luaT_init (lua_State *L);++LUAI_FUNC void luaT_callTM (lua_State *L, const TValue *f, const TValue *p1,+ const TValue *p2, TValue *p3, int hasres);+LUAI_FUNC int luaT_callbinTM (lua_State *L, const TValue *p1, const TValue *p2,+ StkId res, TMS event);+LUAI_FUNC void luaT_trybinTM (lua_State *L, const TValue *p1, const TValue *p2,+ StkId res, TMS event);+LUAI_FUNC int luaT_callorderTM (lua_State *L, const TValue *p1,+ const TValue *p2, TMS event);++++#endif
+ cbits/lua-5.3.6/lua.h view
@@ -0,0 +1,485 @@+/*+** Lua - A Scripting Language+** Lua.org, PUC-Rio, Brazil (http://www.lua.org)+** See Copyright Notice at the end of this file+*/+++#ifndef lua_h+#define lua_h++#include <stdarg.h>+#include <stddef.h>+++#include "luaconf.h"+++#define LUA_VERSION_MAJOR "5"+#define LUA_VERSION_MINOR "3"+#define LUA_VERSION_NUM 503+#define LUA_VERSION_RELEASE "6"++#define LUA_VERSION "Lua " LUA_VERSION_MAJOR "." LUA_VERSION_MINOR+#define LUA_RELEASE LUA_VERSION "." LUA_VERSION_RELEASE+#define LUA_COPYRIGHT LUA_RELEASE " Copyright (C) 1994-2020 Lua.org, PUC-Rio"+#define LUA_AUTHORS "R. Ierusalimschy, L. H. de Figueiredo, W. Celes"+++/* mark for precompiled code ('<esc>Lua') */+#define LUA_SIGNATURE "\x1bLua"++/* option for multiple returns in 'lua_pcall' and 'lua_call' */+#define LUA_MULTRET (-1)+++/*+** Pseudo-indices+** (-LUAI_MAXSTACK is the minimum valid index; we keep some free empty+** space after that to help overflow detection)+*/+#define LUA_REGISTRYINDEX (-LUAI_MAXSTACK - 1000)+#define lua_upvalueindex(i) (LUA_REGISTRYINDEX - (i))+++/* thread status */+#define LUA_OK 0+#define LUA_YIELD 1+#define LUA_ERRRUN 2+#define LUA_ERRSYNTAX 3+#define LUA_ERRMEM 4+#define LUA_ERRGCMM 5+#define LUA_ERRERR 6+++typedef struct lua_State lua_State;+++/*+** basic types+*/+#define LUA_TNONE (-1)++#define LUA_TNIL 0+#define LUA_TBOOLEAN 1+#define LUA_TLIGHTUSERDATA 2+#define LUA_TNUMBER 3+#define LUA_TSTRING 4+#define LUA_TTABLE 5+#define LUA_TFUNCTION 6+#define LUA_TUSERDATA 7+#define LUA_TTHREAD 8++#define LUA_NUMTAGS 9++++/* minimum Lua stack available to a C function */+#define LUA_MINSTACK 20+++/* predefined values in the registry */+#define LUA_RIDX_MAINTHREAD 1+#define LUA_RIDX_GLOBALS 2+#define LUA_RIDX_LAST LUA_RIDX_GLOBALS+++/* type of numbers in Lua */+typedef LUA_NUMBER lua_Number;+++/* type for integer functions */+typedef LUA_INTEGER lua_Integer;++/* unsigned integer type */+typedef LUA_UNSIGNED lua_Unsigned;++/* type for continuation-function contexts */+typedef LUA_KCONTEXT lua_KContext;+++/*+** Type for C functions registered with Lua+*/+typedef int (*lua_CFunction) (lua_State *L);++/*+** Type for continuation functions+*/+typedef int (*lua_KFunction) (lua_State *L, int status, lua_KContext ctx);+++/*+** Type for functions that read/write blocks when loading/dumping Lua chunks+*/+typedef const char * (*lua_Reader) (lua_State *L, void *ud, size_t *sz);++typedef int (*lua_Writer) (lua_State *L, const void *p, size_t sz, void *ud);+++/*+** Type for memory-allocation functions+*/+typedef void * (*lua_Alloc) (void *ud, void *ptr, size_t osize, size_t nsize);++++/*+** generic extra include file+*/+#if defined(LUA_USER_H)+#include LUA_USER_H+#endif+++/*+** RCS ident string+*/+extern const char lua_ident[];+++/*+** state manipulation+*/+LUA_API lua_State *(lua_newstate) (lua_Alloc f, void *ud);+LUA_API void (lua_close) (lua_State *L);+LUA_API lua_State *(lua_newthread) (lua_State *L);++LUA_API lua_CFunction (lua_atpanic) (lua_State *L, lua_CFunction panicf);+++LUA_API const lua_Number *(lua_version) (lua_State *L);+++/*+** basic stack manipulation+*/+LUA_API int (lua_absindex) (lua_State *L, int idx);+LUA_API int (lua_gettop) (lua_State *L);+LUA_API void (lua_settop) (lua_State *L, int idx);+LUA_API void (lua_pushvalue) (lua_State *L, int idx);+LUA_API void (lua_rotate) (lua_State *L, int idx, int n);+LUA_API void (lua_copy) (lua_State *L, int fromidx, int toidx);+LUA_API int (lua_checkstack) (lua_State *L, int n);++LUA_API void (lua_xmove) (lua_State *from, lua_State *to, int n);+++/*+** access functions (stack -> C)+*/++LUA_API int (lua_isnumber) (lua_State *L, int idx);+LUA_API int (lua_isstring) (lua_State *L, int idx);+LUA_API int (lua_iscfunction) (lua_State *L, int idx);+LUA_API int (lua_isinteger) (lua_State *L, int idx);+LUA_API int (lua_isuserdata) (lua_State *L, int idx);+LUA_API int (lua_type) (lua_State *L, int idx);+LUA_API const char *(lua_typename) (lua_State *L, int tp);++LUA_API lua_Number (lua_tonumberx) (lua_State *L, int idx, int *isnum);+LUA_API lua_Integer (lua_tointegerx) (lua_State *L, int idx, int *isnum);+LUA_API int (lua_toboolean) (lua_State *L, int idx);+LUA_API const char *(lua_tolstring) (lua_State *L, int idx, size_t *len);+LUA_API size_t (lua_rawlen) (lua_State *L, int idx);+LUA_API lua_CFunction (lua_tocfunction) (lua_State *L, int idx);+LUA_API void *(lua_touserdata) (lua_State *L, int idx);+LUA_API lua_State *(lua_tothread) (lua_State *L, int idx);+LUA_API const void *(lua_topointer) (lua_State *L, int idx);+++/*+** Comparison and arithmetic functions+*/++#define LUA_OPADD 0 /* ORDER TM, ORDER OP */+#define LUA_OPSUB 1+#define LUA_OPMUL 2+#define LUA_OPMOD 3+#define LUA_OPPOW 4+#define LUA_OPDIV 5+#define LUA_OPIDIV 6+#define LUA_OPBAND 7+#define LUA_OPBOR 8+#define LUA_OPBXOR 9+#define LUA_OPSHL 10+#define LUA_OPSHR 11+#define LUA_OPUNM 12+#define LUA_OPBNOT 13++LUA_API void (lua_arith) (lua_State *L, int op);++#define LUA_OPEQ 0+#define LUA_OPLT 1+#define LUA_OPLE 2++LUA_API int (lua_rawequal) (lua_State *L, int idx1, int idx2);+LUA_API int (lua_compare) (lua_State *L, int idx1, int idx2, int op);+++/*+** push functions (C -> stack)+*/+LUA_API void (lua_pushnil) (lua_State *L);+LUA_API void (lua_pushnumber) (lua_State *L, lua_Number n);+LUA_API void (lua_pushinteger) (lua_State *L, lua_Integer n);+LUA_API const char *(lua_pushlstring) (lua_State *L, const char *s, size_t len);+LUA_API const char *(lua_pushstring) (lua_State *L, const char *s);+LUA_API const char *(lua_pushvfstring) (lua_State *L, const char *fmt,+ va_list argp);+LUA_API const char *(lua_pushfstring) (lua_State *L, const char *fmt, ...);+LUA_API void (lua_pushcclosure) (lua_State *L, lua_CFunction fn, int n);+LUA_API void (lua_pushboolean) (lua_State *L, int b);+LUA_API void (lua_pushlightuserdata) (lua_State *L, void *p);+LUA_API int (lua_pushthread) (lua_State *L);+++/*+** get functions (Lua -> stack)+*/+LUA_API int (lua_getglobal) (lua_State *L, const char *name);+LUA_API int (lua_gettable) (lua_State *L, int idx);+LUA_API int (lua_getfield) (lua_State *L, int idx, const char *k);+LUA_API int (lua_geti) (lua_State *L, int idx, lua_Integer n);+LUA_API int (lua_rawget) (lua_State *L, int idx);+LUA_API int (lua_rawgeti) (lua_State *L, int idx, lua_Integer n);+LUA_API int (lua_rawgetp) (lua_State *L, int idx, const void *p);++LUA_API void (lua_createtable) (lua_State *L, int narr, int nrec);+LUA_API void *(lua_newuserdata) (lua_State *L, size_t sz);+LUA_API int (lua_getmetatable) (lua_State *L, int objindex);+LUA_API int (lua_getuservalue) (lua_State *L, int idx);+++/*+** set functions (stack -> Lua)+*/+LUA_API void (lua_setglobal) (lua_State *L, const char *name);+LUA_API void (lua_settable) (lua_State *L, int idx);+LUA_API void (lua_setfield) (lua_State *L, int idx, const char *k);+LUA_API void (lua_seti) (lua_State *L, int idx, lua_Integer n);+LUA_API void (lua_rawset) (lua_State *L, int idx);+LUA_API void (lua_rawseti) (lua_State *L, int idx, lua_Integer n);+LUA_API void (lua_rawsetp) (lua_State *L, int idx, const void *p);+LUA_API int (lua_setmetatable) (lua_State *L, int objindex);+LUA_API void (lua_setuservalue) (lua_State *L, int idx);+++/*+** 'load' and 'call' functions (load and run Lua code)+*/+LUA_API void (lua_callk) (lua_State *L, int nargs, int nresults,+ lua_KContext ctx, lua_KFunction k);+#define lua_call(L,n,r) lua_callk(L, (n), (r), 0, NULL)++LUA_API int (lua_pcallk) (lua_State *L, int nargs, int nresults, int errfunc,+ lua_KContext ctx, lua_KFunction k);+#define lua_pcall(L,n,r,f) lua_pcallk(L, (n), (r), (f), 0, NULL)++LUA_API int (lua_load) (lua_State *L, lua_Reader reader, void *dt,+ const char *chunkname, const char *mode);++LUA_API int (lua_dump) (lua_State *L, lua_Writer writer, void *data, int strip);+++/*+** coroutine functions+*/+LUA_API int (lua_yieldk) (lua_State *L, int nresults, lua_KContext ctx,+ lua_KFunction k);+LUA_API int (lua_resume) (lua_State *L, lua_State *from, int narg);+LUA_API int (lua_status) (lua_State *L);+LUA_API int (lua_isyieldable) (lua_State *L);++#define lua_yield(L,n) lua_yieldk(L, (n), 0, NULL)+++/*+** garbage-collection function and options+*/++#define LUA_GCSTOP 0+#define LUA_GCRESTART 1+#define LUA_GCCOLLECT 2+#define LUA_GCCOUNT 3+#define LUA_GCCOUNTB 4+#define LUA_GCSTEP 5+#define LUA_GCSETPAUSE 6+#define LUA_GCSETSTEPMUL 7+#define LUA_GCISRUNNING 9++LUA_API int (lua_gc) (lua_State *L, int what, int data);+++/*+** miscellaneous functions+*/++LUA_API int (lua_error) (lua_State *L);++LUA_API int (lua_next) (lua_State *L, int idx);++LUA_API void (lua_concat) (lua_State *L, int n);+LUA_API void (lua_len) (lua_State *L, int idx);++LUA_API size_t (lua_stringtonumber) (lua_State *L, const char *s);++LUA_API lua_Alloc (lua_getallocf) (lua_State *L, void **ud);+LUA_API void (lua_setallocf) (lua_State *L, lua_Alloc f, void *ud);++++/*+** {==============================================================+** some useful macros+** ===============================================================+*/++#define lua_getextraspace(L) ((void *)((char *)(L) - LUA_EXTRASPACE))++#define lua_tonumber(L,i) lua_tonumberx(L,(i),NULL)+#define lua_tointeger(L,i) lua_tointegerx(L,(i),NULL)++#define lua_pop(L,n) lua_settop(L, -(n)-1)++#define lua_newtable(L) lua_createtable(L, 0, 0)++#define lua_register(L,n,f) (lua_pushcfunction(L, (f)), lua_setglobal(L, (n)))++#define lua_pushcfunction(L,f) lua_pushcclosure(L, (f), 0)++#define lua_isfunction(L,n) (lua_type(L, (n)) == LUA_TFUNCTION)+#define lua_istable(L,n) (lua_type(L, (n)) == LUA_TTABLE)+#define lua_islightuserdata(L,n) (lua_type(L, (n)) == LUA_TLIGHTUSERDATA)+#define lua_isnil(L,n) (lua_type(L, (n)) == LUA_TNIL)+#define lua_isboolean(L,n) (lua_type(L, (n)) == LUA_TBOOLEAN)+#define lua_isthread(L,n) (lua_type(L, (n)) == LUA_TTHREAD)+#define lua_isnone(L,n) (lua_type(L, (n)) == LUA_TNONE)+#define lua_isnoneornil(L, n) (lua_type(L, (n)) <= 0)++#define lua_pushliteral(L, s) lua_pushstring(L, "" s)++#define lua_pushglobaltable(L) \+ ((void)lua_rawgeti(L, LUA_REGISTRYINDEX, LUA_RIDX_GLOBALS))++#define lua_tostring(L,i) lua_tolstring(L, (i), NULL)+++#define lua_insert(L,idx) lua_rotate(L, (idx), 1)++#define lua_remove(L,idx) (lua_rotate(L, (idx), -1), lua_pop(L, 1))++#define lua_replace(L,idx) (lua_copy(L, -1, (idx)), lua_pop(L, 1))++/* }============================================================== */+++/*+** {==============================================================+** compatibility macros for unsigned conversions+** ===============================================================+*/+#if defined(LUA_COMPAT_APIINTCASTS)++#define lua_pushunsigned(L,n) lua_pushinteger(L, (lua_Integer)(n))+#define lua_tounsignedx(L,i,is) ((lua_Unsigned)lua_tointegerx(L,i,is))+#define lua_tounsigned(L,i) lua_tounsignedx(L,(i),NULL)++#endif+/* }============================================================== */++/*+** {======================================================================+** Debug API+** =======================================================================+*/+++/*+** Event codes+*/+#define LUA_HOOKCALL 0+#define LUA_HOOKRET 1+#define LUA_HOOKLINE 2+#define LUA_HOOKCOUNT 3+#define LUA_HOOKTAILCALL 4+++/*+** Event masks+*/+#define LUA_MASKCALL (1 << LUA_HOOKCALL)+#define LUA_MASKRET (1 << LUA_HOOKRET)+#define LUA_MASKLINE (1 << LUA_HOOKLINE)+#define LUA_MASKCOUNT (1 << LUA_HOOKCOUNT)++typedef struct lua_Debug lua_Debug; /* activation record */+++/* Functions to be called by the debugger in specific events */+typedef void (*lua_Hook) (lua_State *L, lua_Debug *ar);+++LUA_API int (lua_getstack) (lua_State *L, int level, lua_Debug *ar);+LUA_API int (lua_getinfo) (lua_State *L, const char *what, lua_Debug *ar);+LUA_API const char *(lua_getlocal) (lua_State *L, const lua_Debug *ar, int n);+LUA_API const char *(lua_setlocal) (lua_State *L, const lua_Debug *ar, int n);+LUA_API const char *(lua_getupvalue) (lua_State *L, int funcindex, int n);+LUA_API const char *(lua_setupvalue) (lua_State *L, int funcindex, int n);++LUA_API void *(lua_upvalueid) (lua_State *L, int fidx, int n);+LUA_API void (lua_upvaluejoin) (lua_State *L, int fidx1, int n1,+ int fidx2, int n2);++LUA_API void (lua_sethook) (lua_State *L, lua_Hook func, int mask, int count);+LUA_API lua_Hook (lua_gethook) (lua_State *L);+LUA_API int (lua_gethookmask) (lua_State *L);+LUA_API int (lua_gethookcount) (lua_State *L);+++struct lua_Debug {+ int event;+ const char *name; /* (n) */+ const char *namewhat; /* (n) 'global', 'local', 'field', 'method' */+ const char *what; /* (S) 'Lua', 'C', 'main', 'tail' */+ const char *source; /* (S) */+ int currentline; /* (l) */+ int linedefined; /* (S) */+ int lastlinedefined; /* (S) */+ unsigned char nups; /* (u) number of upvalues */+ unsigned char nparams;/* (u) number of parameters */+ char isvararg; /* (u) */+ char istailcall; /* (t) */+ char short_src[LUA_IDSIZE]; /* (S) */+ /* private part */+ struct CallInfo *i_ci; /* active function */+};++/* }====================================================================== */+++/******************************************************************************+* Copyright (C) 1994-2020 Lua.org, PUC-Rio.+*+* Permission is hereby granted, free of charge, to any person obtaining+* a copy of this software and associated documentation files (the+* "Software"), to deal in the Software without restriction, including+* without limitation the rights to use, copy, modify, merge, publish,+* distribute, sublicense, and/or sell copies of the Software, and to+* permit persons to whom the Software is furnished to do so, subject to+* the following conditions:+*+* The above copyright notice and this permission notice shall be+* included in all copies or substantial portions of the Software.+*+* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+* EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+* MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+* IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+* CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+* TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+* SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.+******************************************************************************/+++#endif
+ cbits/lua-5.3.6/luaconf.h view
@@ -0,0 +1,790 @@+/*+** $Id: luaconf.h,v 1.259.1.1 2017/04/19 17:29:57 roberto Exp $+** Configuration file for Lua+** See Copyright Notice in lua.h+*/+++#ifndef luaconf_h+#define luaconf_h++#include <limits.h>+#include <stddef.h>+++/*+** ===================================================================+** Search for "@@" to find all configurable definitions.+** ===================================================================+*/+++/*+** {====================================================================+** System Configuration: macros to adapt (if needed) Lua to some+** particular platform, for instance compiling it with 32-bit numbers or+** restricting it to C89.+** =====================================================================+*/++/*+@@ LUA_32BITS enables Lua with 32-bit integers and 32-bit floats. You+** can also define LUA_32BITS in the make file, but changing here you+** ensure that all software connected to Lua will be compiled with the+** same configuration.+*/+/* #define LUA_32BITS */+++/*+@@ LUA_USE_C89 controls the use of non-ISO-C89 features.+** Define it if you want Lua to avoid the use of a few C99 features+** or Windows-specific features on Windows.+*/+/* #define LUA_USE_C89 */+++/*+** By default, Lua on Windows use (some) specific Windows features+*/+#if !defined(LUA_USE_C89) && defined(_WIN32) && !defined(_WIN32_WCE)+#define LUA_USE_WINDOWS /* enable goodies for regular Windows */+#endif+++#if defined(LUA_USE_WINDOWS)+#define LUA_DL_DLL /* enable support for DLL */+#define LUA_USE_C89 /* broadly, Windows is C89 */+#endif+++#if defined(LUA_USE_LINUX)+#define LUA_USE_POSIX+#define LUA_USE_DLOPEN /* needs an extra library: -ldl */+#define LUA_USE_READLINE /* needs some extra libraries */+#endif+++#if defined(LUA_USE_MACOSX)+#define LUA_USE_POSIX+#define LUA_USE_DLOPEN /* MacOS does not need -ldl */+#define LUA_USE_READLINE /* needs an extra library: -lreadline */+#endif+++/*+@@ LUA_C89_NUMBERS ensures that Lua uses the largest types available for+** C89 ('long' and 'double'); Windows always has '__int64', so it does+** not need to use this case.+*/+#if defined(LUA_USE_C89) && !defined(LUA_USE_WINDOWS)+#define LUA_C89_NUMBERS+#endif++++/*+@@ LUAI_BITSINT defines the (minimum) number of bits in an 'int'.+*/+/* avoid undefined shifts */+#if ((INT_MAX >> 15) >> 15) >= 1+#define LUAI_BITSINT 32+#else+/* 'int' always must have at least 16 bits */+#define LUAI_BITSINT 16+#endif+++/*+@@ LUA_INT_TYPE defines the type for Lua integers.+@@ LUA_FLOAT_TYPE defines the type for Lua floats.+** Lua should work fine with any mix of these options (if supported+** by your C compiler). The usual configurations are 64-bit integers+** and 'double' (the default), 32-bit integers and 'float' (for+** restricted platforms), and 'long'/'double' (for C compilers not+** compliant with C99, which may not have support for 'long long').+*/++/* predefined options for LUA_INT_TYPE */+#define LUA_INT_INT 1+#define LUA_INT_LONG 2+#define LUA_INT_LONGLONG 3++/* predefined options for LUA_FLOAT_TYPE */+#define LUA_FLOAT_FLOAT 1+#define LUA_FLOAT_DOUBLE 2+#define LUA_FLOAT_LONGDOUBLE 3++#if defined(LUA_32BITS) /* { */+/*+** 32-bit integers and 'float'+*/+#if LUAI_BITSINT >= 32 /* use 'int' if big enough */+#define LUA_INT_TYPE LUA_INT_INT+#else /* otherwise use 'long' */+#define LUA_INT_TYPE LUA_INT_LONG+#endif+#define LUA_FLOAT_TYPE LUA_FLOAT_FLOAT++#elif defined(LUA_C89_NUMBERS) /* }{ */+/*+** largest types available for C89 ('long' and 'double')+*/+#define LUA_INT_TYPE LUA_INT_LONG+#define LUA_FLOAT_TYPE LUA_FLOAT_DOUBLE++#endif /* } */+++/*+** default configuration for 64-bit Lua ('long long' and 'double')+*/+#if !defined(LUA_INT_TYPE)+#define LUA_INT_TYPE LUA_INT_LONGLONG+#endif++#if !defined(LUA_FLOAT_TYPE)+#define LUA_FLOAT_TYPE LUA_FLOAT_DOUBLE+#endif++/* }================================================================== */+++++/*+** {==================================================================+** Configuration for Paths.+** ===================================================================+*/++/*+** LUA_PATH_SEP is the character that separates templates in a path.+** LUA_PATH_MARK is the string that marks the substitution points in a+** template.+** LUA_EXEC_DIR in a Windows path is replaced by the executable's+** directory.+*/+#define LUA_PATH_SEP ";"+#define LUA_PATH_MARK "?"+#define LUA_EXEC_DIR "!"+++/*+@@ LUA_PATH_DEFAULT is the default path that Lua uses to look for+** Lua libraries.+@@ LUA_CPATH_DEFAULT is the default path that Lua uses to look for+** C libraries.+** CHANGE them if your machine has a non-conventional directory+** hierarchy or if you want to install your libraries in+** non-conventional directories.+*/+#define LUA_VDIR LUA_VERSION_MAJOR "." LUA_VERSION_MINOR+#if defined(_WIN32) /* { */+/*+** In Windows, any exclamation mark ('!') in the path is replaced by the+** path of the directory of the executable file of the current process.+*/+#define LUA_LDIR "!\\lua\\"+#define LUA_CDIR "!\\"+#define LUA_SHRDIR "!\\..\\share\\lua\\" LUA_VDIR "\\"+#define LUA_PATH_DEFAULT \+ LUA_LDIR"?.lua;" LUA_LDIR"?\\init.lua;" \+ LUA_CDIR"?.lua;" LUA_CDIR"?\\init.lua;" \+ LUA_SHRDIR"?.lua;" LUA_SHRDIR"?\\init.lua;" \+ ".\\?.lua;" ".\\?\\init.lua"+#define LUA_CPATH_DEFAULT \+ LUA_CDIR"?.dll;" \+ LUA_CDIR"..\\lib\\lua\\" LUA_VDIR "\\?.dll;" \+ LUA_CDIR"loadall.dll;" ".\\?.dll"++#else /* }{ */++#define LUA_ROOT "/usr/local/"+#define LUA_LDIR LUA_ROOT "share/lua/" LUA_VDIR "/"+#define LUA_CDIR LUA_ROOT "lib/lua/" LUA_VDIR "/"+#define LUA_PATH_DEFAULT \+ LUA_LDIR"?.lua;" LUA_LDIR"?/init.lua;" \+ LUA_CDIR"?.lua;" LUA_CDIR"?/init.lua;" \+ "./?.lua;" "./?/init.lua"+#define LUA_CPATH_DEFAULT \+ LUA_CDIR"?.so;" LUA_CDIR"loadall.so;" "./?.so"+#endif /* } */+++/*+@@ LUA_DIRSEP is the directory separator (for submodules).+** CHANGE it if your machine does not use "/" as the directory separator+** and is not Windows. (On Windows Lua automatically uses "\".)+*/+#if defined(_WIN32)+#define LUA_DIRSEP "\\"+#else+#define LUA_DIRSEP "/"+#endif++/* }================================================================== */+++/*+** {==================================================================+** Marks for exported symbols in the C code+** ===================================================================+*/++/*+@@ LUA_API is a mark for all core API functions.+@@ LUALIB_API is a mark for all auxiliary library functions.+@@ LUAMOD_API is a mark for all standard library opening functions.+** CHANGE them if you need to define those functions in some special way.+** For instance, if you want to create one Windows DLL with the core and+** the libraries, you may want to use the following definition (define+** LUA_BUILD_AS_DLL to get it).+*/+#if defined(LUA_BUILD_AS_DLL) /* { */++#if defined(LUA_CORE) || defined(LUA_LIB) /* { */+#define LUA_API __declspec(dllexport)+#else /* }{ */+#define LUA_API __declspec(dllimport)+#endif /* } */++#else /* }{ */++#define LUA_API extern++#endif /* } */+++/* more often than not the libs go together with the core */+#define LUALIB_API LUA_API+#define LUAMOD_API LUALIB_API+++/*+@@ LUAI_FUNC is a mark for all extern functions that are not to be+** exported to outside modules.+@@ LUAI_DDEF and LUAI_DDEC are marks for all extern (const) variables+** that are not to be exported to outside modules (LUAI_DDEF for+** definitions and LUAI_DDEC for declarations).+** CHANGE them if you need to mark them in some special way. Elf/gcc+** (versions 3.2 and later) mark them as "hidden" to optimize access+** when Lua is compiled as a shared library. Not all elf targets support+** this attribute. Unfortunately, gcc does not offer a way to check+** whether the target offers that support, and those without support+** give a warning about it. To avoid these warnings, change to the+** default definition.+*/+#if defined(__GNUC__) && ((__GNUC__*100 + __GNUC_MINOR__) >= 302) && \+ defined(__ELF__) /* { */+#define LUAI_FUNC __attribute__((visibility("hidden"))) extern+#else /* }{ */+#define LUAI_FUNC extern+#endif /* } */++#define LUAI_DDEC LUAI_FUNC+#define LUAI_DDEF /* empty */++/* }================================================================== */+++/*+** {==================================================================+** Compatibility with previous versions+** ===================================================================+*/++/*+@@ LUA_COMPAT_5_2 controls other macros for compatibility with Lua 5.2.+@@ LUA_COMPAT_5_1 controls other macros for compatibility with Lua 5.1.+** You can define it to get all options, or change specific options+** to fit your specific needs.+*/+#if defined(LUA_COMPAT_5_2) /* { */++/*+@@ LUA_COMPAT_MATHLIB controls the presence of several deprecated+** functions in the mathematical library.+*/+#define LUA_COMPAT_MATHLIB++/*+@@ LUA_COMPAT_BITLIB controls the presence of library 'bit32'.+*/+#define LUA_COMPAT_BITLIB++/*+@@ LUA_COMPAT_IPAIRS controls the effectiveness of the __ipairs metamethod.+*/+#define LUA_COMPAT_IPAIRS++/*+@@ LUA_COMPAT_APIINTCASTS controls the presence of macros for+** manipulating other integer types (lua_pushunsigned, lua_tounsigned,+** luaL_checkint, luaL_checklong, etc.)+*/+#define LUA_COMPAT_APIINTCASTS++#endif /* } */+++#if defined(LUA_COMPAT_5_1) /* { */++/* Incompatibilities from 5.2 -> 5.3 */+#define LUA_COMPAT_MATHLIB+#define LUA_COMPAT_APIINTCASTS++/*+@@ LUA_COMPAT_UNPACK controls the presence of global 'unpack'.+** You can replace it with 'table.unpack'.+*/+#define LUA_COMPAT_UNPACK++/*+@@ LUA_COMPAT_LOADERS controls the presence of table 'package.loaders'.+** You can replace it with 'package.searchers'.+*/+#define LUA_COMPAT_LOADERS++/*+@@ macro 'lua_cpcall' emulates deprecated function lua_cpcall.+** You can call your C function directly (with light C functions).+*/+#define lua_cpcall(L,f,u) \+ (lua_pushcfunction(L, (f)), \+ lua_pushlightuserdata(L,(u)), \+ lua_pcall(L,1,0,0))+++/*+@@ LUA_COMPAT_LOG10 defines the function 'log10' in the math library.+** You can rewrite 'log10(x)' as 'log(x, 10)'.+*/+#define LUA_COMPAT_LOG10++/*+@@ LUA_COMPAT_LOADSTRING defines the function 'loadstring' in the base+** library. You can rewrite 'loadstring(s)' as 'load(s)'.+*/+#define LUA_COMPAT_LOADSTRING++/*+@@ LUA_COMPAT_MAXN defines the function 'maxn' in the table library.+*/+#define LUA_COMPAT_MAXN++/*+@@ The following macros supply trivial compatibility for some+** changes in the API. The macros themselves document how to+** change your code to avoid using them.+*/+#define lua_strlen(L,i) lua_rawlen(L, (i))++#define lua_objlen(L,i) lua_rawlen(L, (i))++#define lua_equal(L,idx1,idx2) lua_compare(L,(idx1),(idx2),LUA_OPEQ)+#define lua_lessthan(L,idx1,idx2) lua_compare(L,(idx1),(idx2),LUA_OPLT)++/*+@@ LUA_COMPAT_MODULE controls compatibility with previous+** module functions 'module' (Lua) and 'luaL_register' (C).+*/+#define LUA_COMPAT_MODULE++#endif /* } */+++/*+@@ LUA_COMPAT_FLOATSTRING makes Lua format integral floats without a+@@ a float mark ('.0').+** This macro is not on by default even in compatibility mode,+** because this is not really an incompatibility.+*/+/* #define LUA_COMPAT_FLOATSTRING */++/* }================================================================== */++++/*+** {==================================================================+** Configuration for Numbers.+** Change these definitions if no predefined LUA_FLOAT_* / LUA_INT_*+** satisfy your needs.+** ===================================================================+*/++/*+@@ LUA_NUMBER is the floating-point type used by Lua.+@@ LUAI_UACNUMBER is the result of a 'default argument promotion'+@@ over a floating number.+@@ l_mathlim(x) corrects limit name 'x' to the proper float type+** by prefixing it with one of FLT/DBL/LDBL.+@@ LUA_NUMBER_FRMLEN is the length modifier for writing floats.+@@ LUA_NUMBER_FMT is the format for writing floats.+@@ lua_number2str converts a float to a string.+@@ l_mathop allows the addition of an 'l' or 'f' to all math operations.+@@ l_floor takes the floor of a float.+@@ lua_str2number converts a decimal numeric string to a number.+*/+++/* The following definitions are good for most cases here */++#define l_floor(x) (l_mathop(floor)(x))++#define lua_number2str(s,sz,n) \+ l_sprintf((s), sz, LUA_NUMBER_FMT, (LUAI_UACNUMBER)(n))++/*+@@ lua_numbertointeger converts a float number to an integer, or+** returns 0 if float is not within the range of a lua_Integer.+** (The range comparisons are tricky because of rounding. The tests+** here assume a two-complement representation, where MININTEGER always+** has an exact representation as a float; MAXINTEGER may not have one,+** and therefore its conversion to float may have an ill-defined value.)+*/+#define lua_numbertointeger(n,p) \+ ((n) >= (LUA_NUMBER)(LUA_MININTEGER) && \+ (n) < -(LUA_NUMBER)(LUA_MININTEGER) && \+ (*(p) = (LUA_INTEGER)(n), 1))+++/* now the variable definitions */++#if LUA_FLOAT_TYPE == LUA_FLOAT_FLOAT /* { single float */++#define LUA_NUMBER float++#define l_mathlim(n) (FLT_##n)++#define LUAI_UACNUMBER double++#define LUA_NUMBER_FRMLEN ""+#define LUA_NUMBER_FMT "%.7g"++#define l_mathop(op) op##f++#define lua_str2number(s,p) strtof((s), (p))+++#elif LUA_FLOAT_TYPE == LUA_FLOAT_LONGDOUBLE /* }{ long double */++#define LUA_NUMBER long double++#define l_mathlim(n) (LDBL_##n)++#define LUAI_UACNUMBER long double++#define LUA_NUMBER_FRMLEN "L"+#define LUA_NUMBER_FMT "%.19Lg"++#define l_mathop(op) op##l++#define lua_str2number(s,p) strtold((s), (p))++#elif LUA_FLOAT_TYPE == LUA_FLOAT_DOUBLE /* }{ double */++#define LUA_NUMBER double++#define l_mathlim(n) (DBL_##n)++#define LUAI_UACNUMBER double++#define LUA_NUMBER_FRMLEN ""+#define LUA_NUMBER_FMT "%.14g"++#define l_mathop(op) op++#define lua_str2number(s,p) strtod((s), (p))++#else /* }{ */++#error "numeric float type not defined"++#endif /* } */++++/*+@@ LUA_INTEGER is the integer type used by Lua.+**+@@ LUA_UNSIGNED is the unsigned version of LUA_INTEGER.+**+@@ LUAI_UACINT is the result of a 'default argument promotion'+@@ over a lUA_INTEGER.+@@ LUA_INTEGER_FRMLEN is the length modifier for reading/writing integers.+@@ LUA_INTEGER_FMT is the format for writing integers.+@@ LUA_MAXINTEGER is the maximum value for a LUA_INTEGER.+@@ LUA_MININTEGER is the minimum value for a LUA_INTEGER.+@@ lua_integer2str converts an integer to a string.+*/+++/* The following definitions are good for most cases here */++#define LUA_INTEGER_FMT "%" LUA_INTEGER_FRMLEN "d"++#define LUAI_UACINT LUA_INTEGER++#define lua_integer2str(s,sz,n) \+ l_sprintf((s), sz, LUA_INTEGER_FMT, (LUAI_UACINT)(n))++/*+** use LUAI_UACINT here to avoid problems with promotions (which+** can turn a comparison between unsigneds into a signed comparison)+*/+#define LUA_UNSIGNED unsigned LUAI_UACINT+++/* now the variable definitions */++#if LUA_INT_TYPE == LUA_INT_INT /* { int */++#define LUA_INTEGER int+#define LUA_INTEGER_FRMLEN ""++#define LUA_MAXINTEGER INT_MAX+#define LUA_MININTEGER INT_MIN++#elif LUA_INT_TYPE == LUA_INT_LONG /* }{ long */++#define LUA_INTEGER long+#define LUA_INTEGER_FRMLEN "l"++#define LUA_MAXINTEGER LONG_MAX+#define LUA_MININTEGER LONG_MIN++#elif LUA_INT_TYPE == LUA_INT_LONGLONG /* }{ long long */++/* use presence of macro LLONG_MAX as proxy for C99 compliance */+#if defined(LLONG_MAX) /* { */+/* use ISO C99 stuff */++#define LUA_INTEGER long long+#define LUA_INTEGER_FRMLEN "ll"++#define LUA_MAXINTEGER LLONG_MAX+#define LUA_MININTEGER LLONG_MIN++#elif defined(LUA_USE_WINDOWS) /* }{ */+/* in Windows, can use specific Windows types */++#define LUA_INTEGER __int64+#define LUA_INTEGER_FRMLEN "I64"++#define LUA_MAXINTEGER _I64_MAX+#define LUA_MININTEGER _I64_MIN++#else /* }{ */++#error "Compiler does not support 'long long'. Use option '-DLUA_32BITS' \+ or '-DLUA_C89_NUMBERS' (see file 'luaconf.h' for details)"++#endif /* } */++#else /* }{ */++#error "numeric integer type not defined"++#endif /* } */++/* }================================================================== */+++/*+** {==================================================================+** Dependencies with C99 and other C details+** ===================================================================+*/++/*+@@ l_sprintf is equivalent to 'snprintf' or 'sprintf' in C89.+** (All uses in Lua have only one format item.)+*/+#if !defined(LUA_USE_C89)+#define l_sprintf(s,sz,f,i) snprintf(s,sz,f,i)+#else+#define l_sprintf(s,sz,f,i) ((void)(sz), sprintf(s,f,i))+#endif+++/*+@@ lua_strx2number converts an hexadecimal numeric string to a number.+** In C99, 'strtod' does that conversion. Otherwise, you can+** leave 'lua_strx2number' undefined and Lua will provide its own+** implementation.+*/+#if !defined(LUA_USE_C89)+#define lua_strx2number(s,p) lua_str2number(s,p)+#endif+++/*+@@ lua_pointer2str converts a pointer to a readable string in a+** non-specified way.+*/+#define lua_pointer2str(buff,sz,p) l_sprintf(buff,sz,"%p",p)+++/*+@@ lua_number2strx converts a float to an hexadecimal numeric string.+** In C99, 'sprintf' (with format specifiers '%a'/'%A') does that.+** Otherwise, you can leave 'lua_number2strx' undefined and Lua will+** provide its own implementation.+*/+#if !defined(LUA_USE_C89)+#define lua_number2strx(L,b,sz,f,n) \+ ((void)L, l_sprintf(b,sz,f,(LUAI_UACNUMBER)(n)))+#endif+++/*+** 'strtof' and 'opf' variants for math functions are not valid in+** C89. Otherwise, the macro 'HUGE_VALF' is a good proxy for testing the+** availability of these variants. ('math.h' is already included in+** all files that use these macros.)+*/+#if defined(LUA_USE_C89) || (defined(HUGE_VAL) && !defined(HUGE_VALF))+#undef l_mathop /* variants not available */+#undef lua_str2number+#define l_mathop(op) (lua_Number)op /* no variant */+#define lua_str2number(s,p) ((lua_Number)strtod((s), (p)))+#endif+++/*+@@ LUA_KCONTEXT is the type of the context ('ctx') for continuation+** functions. It must be a numerical type; Lua will use 'intptr_t' if+** available, otherwise it will use 'ptrdiff_t' (the nearest thing to+** 'intptr_t' in C89)+*/+#define LUA_KCONTEXT ptrdiff_t++#if !defined(LUA_USE_C89) && defined(__STDC_VERSION__) && \+ __STDC_VERSION__ >= 199901L+#include <stdint.h>+#if defined(INTPTR_MAX) /* even in C99 this type is optional */+#undef LUA_KCONTEXT+#define LUA_KCONTEXT intptr_t+#endif+#endif+++/*+@@ lua_getlocaledecpoint gets the locale "radix character" (decimal point).+** Change that if you do not want to use C locales. (Code using this+** macro must include header 'locale.h'.)+*/+#if !defined(lua_getlocaledecpoint)+#define lua_getlocaledecpoint() (localeconv()->decimal_point[0])+#endif++/* }================================================================== */+++/*+** {==================================================================+** Language Variations+** =====================================================================+*/++/*+@@ LUA_NOCVTN2S/LUA_NOCVTS2N control how Lua performs some+** coercions. Define LUA_NOCVTN2S to turn off automatic coercion from+** numbers to strings. Define LUA_NOCVTS2N to turn off automatic+** coercion from strings to numbers.+*/+/* #define LUA_NOCVTN2S */+/* #define LUA_NOCVTS2N */+++/*+@@ LUA_USE_APICHECK turns on several consistency checks on the C API.+** Define it as a help when debugging C code.+*/+#if defined(LUA_USE_APICHECK)+#include <assert.h>+#define luai_apicheck(l,e) assert(e)+#endif++/* }================================================================== */+++/*+** {==================================================================+** Macros that affect the API and must be stable (that is, must be the+** same when you compile Lua and when you compile code that links to+** Lua). You probably do not want/need to change them.+** =====================================================================+*/++/*+@@ LUAI_MAXSTACK limits the size of the Lua stack.+** CHANGE it if you need a different limit. This limit is arbitrary;+** its only purpose is to stop Lua from consuming unlimited stack+** space (and to reserve some numbers for pseudo-indices).+*/+#if LUAI_BITSINT >= 32+#define LUAI_MAXSTACK 1000000+#else+#define LUAI_MAXSTACK 15000+#endif+++/*+@@ LUA_EXTRASPACE defines the size of a raw memory area associated with+** a Lua state with very fast access.+** CHANGE it if you need a different size.+*/+#define LUA_EXTRASPACE (sizeof(void *))+++/*+@@ LUA_IDSIZE gives the maximum size for the description of the source+@@ of a function in debug information.+** CHANGE it if you want a different size.+*/+#define LUA_IDSIZE 60+++/*+@@ LUAL_BUFFERSIZE is the buffer size used by the lauxlib buffer system.+** CHANGE it if it uses too much C-stack space. (For long double,+** 'string.format("%.99f", -1e4932)' needs 5034 bytes, so a+** smaller buffer would force a memory allocation for each call to+** 'string.format'.)+*/+#if LUA_FLOAT_TYPE == LUA_FLOAT_LONGDOUBLE+#define LUAL_BUFFERSIZE 8192+#else+#define LUAL_BUFFERSIZE ((int)(0x80 * sizeof(void*) * sizeof(lua_Integer)))+#endif++/* }================================================================== */+++/*+@@ LUA_QL describes how error messages quote program elements.+** Lua does not use these macros anymore; they are here for+** compatibility only.+*/+#define LUA_QL(x) "'" x "'"+#define LUA_QS LUA_QL("%s")+++++/* =================================================================== */++/*+** Local configuration. You can use this space to add your redefinitions+** without modifying the main part of the file.+*/++++++#endif+
+ cbits/lua-5.3.6/lualib.h view
@@ -0,0 +1,61 @@+/*+** $Id: lualib.h,v 1.45.1.1 2017/04/19 17:20:42 roberto Exp $+** Lua standard libraries+** See Copyright Notice in lua.h+*/+++#ifndef lualib_h+#define lualib_h++#include "lua.h"+++/* version suffix for environment variable names */+#define LUA_VERSUFFIX "_" LUA_VERSION_MAJOR "_" LUA_VERSION_MINOR+++LUAMOD_API int (luaopen_base) (lua_State *L);++#define LUA_COLIBNAME "coroutine"+LUAMOD_API int (luaopen_coroutine) (lua_State *L);++#define LUA_TABLIBNAME "table"+LUAMOD_API int (luaopen_table) (lua_State *L);++#define LUA_IOLIBNAME "io"+LUAMOD_API int (luaopen_io) (lua_State *L);++#define LUA_OSLIBNAME "os"+LUAMOD_API int (luaopen_os) (lua_State *L);++#define LUA_STRLIBNAME "string"+LUAMOD_API int (luaopen_string) (lua_State *L);++#define LUA_UTF8LIBNAME "utf8"+LUAMOD_API int (luaopen_utf8) (lua_State *L);++#define LUA_BITLIBNAME "bit32"+LUAMOD_API int (luaopen_bit32) (lua_State *L);++#define LUA_MATHLIBNAME "math"+LUAMOD_API int (luaopen_math) (lua_State *L);++#define LUA_DBLIBNAME "debug"+LUAMOD_API int (luaopen_debug) (lua_State *L);++#define LUA_LOADLIBNAME "package"+LUAMOD_API int (luaopen_package) (lua_State *L);+++/* open all previous libraries */+LUALIB_API void (luaL_openlibs) (lua_State *L);++++#if !defined(lua_assert)+#define lua_assert(x) ((void)0)+#endif+++#endif
+ cbits/lua-5.3.6/lundump.c view
@@ -0,0 +1,287 @@+/*+** $Id: lundump.c,v 2.44.1.1 2017/04/19 17:20:42 roberto Exp $+** load precompiled Lua chunks+** See Copyright Notice in lua.h+*/++#define lundump_c+#define LUA_CORE++#include "lprefix.h"+++#include <string.h>++#include "lua.h"++#include "ldebug.h"+#include "ldo.h"+#include "lfunc.h"+#include "lmem.h"+#include "lobject.h"+#include "lstring.h"+#include "lundump.h"+#include "lzio.h"+++#if !defined(luai_verifycode)+#define luai_verifycode(L,b,f) /* empty */+#endif+++typedef struct {+ lua_State *L;+ ZIO *Z;+ const char *name;+} LoadState;+++static l_noret error(LoadState *S, const char *why) {+ luaO_pushfstring(S->L, "%s: %s precompiled chunk", S->name, why);+ luaD_throw(S->L, LUA_ERRSYNTAX);+}+++/*+** All high-level loads go through LoadVector; you can change it to+** adapt to the endianness of the input+*/+#define LoadVector(S,b,n) LoadBlock(S,b,(n)*sizeof((b)[0]))++static void LoadBlock (LoadState *S, void *b, size_t size) {+ if (luaZ_read(S->Z, b, size) != 0)+ error(S, "truncated");+}+++#define LoadVar(S,x) LoadVector(S,&x,1)+++static lu_byte LoadByte (LoadState *S) {+ lu_byte x;+ LoadVar(S, x);+ return x;+}+++static int LoadInt (LoadState *S) {+ int x;+ LoadVar(S, x);+ return x;+}+++static lua_Number LoadNumber (LoadState *S) {+ lua_Number x;+ LoadVar(S, x);+ return x;+}+++static lua_Integer LoadInteger (LoadState *S) {+ lua_Integer x;+ LoadVar(S, x);+ return x;+}+++static TString *LoadString (LoadState *S, Proto *p) {+ lua_State *L = S->L;+ size_t size = LoadByte(S);+ TString *ts;+ if (size == 0xFF)+ LoadVar(S, size);+ if (size == 0)+ return NULL;+ else if (--size <= LUAI_MAXSHORTLEN) { /* short string? */+ char buff[LUAI_MAXSHORTLEN];+ LoadVector(S, buff, size);+ ts = luaS_newlstr(L, buff, size);+ }+ else { /* long string */+ ts = luaS_createlngstrobj(L, size);+ setsvalue2s(L, L->top, ts); /* anchor it ('loadVector' can GC) */+ luaD_inctop(L);+ LoadVector(S, getstr(ts), size); /* load directly in final place */+ L->top--; /* pop string */+ }+ luaC_objbarrier(L, p, ts);+ return ts;+}+++static void LoadCode (LoadState *S, Proto *f) {+ int n = LoadInt(S);+ f->code = luaM_newvector(S->L, n, Instruction);+ f->sizecode = n;+ LoadVector(S, f->code, n);+}+++static void LoadFunction(LoadState *S, Proto *f, TString *psource);+++static void LoadConstants (LoadState *S, Proto *f) {+ int i;+ int n = LoadInt(S);+ f->k = luaM_newvector(S->L, n, TValue);+ f->sizek = n;+ for (i = 0; i < n; i++)+ setnilvalue(&f->k[i]);+ for (i = 0; i < n; i++) {+ TValue *o = &f->k[i];+ int t = LoadByte(S);+ switch (t) {+ case LUA_TNIL:+ setnilvalue(o);+ break;+ case LUA_TBOOLEAN:+ setbvalue(o, LoadByte(S));+ break;+ case LUA_TNUMFLT:+ setfltvalue(o, LoadNumber(S));+ break;+ case LUA_TNUMINT:+ setivalue(o, LoadInteger(S));+ break;+ case LUA_TSHRSTR:+ case LUA_TLNGSTR:+ setsvalue2n(S->L, o, LoadString(S, f));+ break;+ default:+ lua_assert(0);+ }+ }+}+++static void LoadProtos (LoadState *S, Proto *f) {+ int i;+ int n = LoadInt(S);+ f->p = luaM_newvector(S->L, n, Proto *);+ f->sizep = n;+ for (i = 0; i < n; i++)+ f->p[i] = NULL;+ for (i = 0; i < n; i++) {+ f->p[i] = luaF_newproto(S->L);+ luaC_objbarrier(S->L, f, f->p[i]);+ LoadFunction(S, f->p[i], f->source);+ }+}+++static void LoadUpvalues (LoadState *S, Proto *f) {+ int i, n;+ n = LoadInt(S);+ f->upvalues = luaM_newvector(S->L, n, Upvaldesc);+ f->sizeupvalues = n;+ for (i = 0; i < n; i++)+ f->upvalues[i].name = NULL;+ for (i = 0; i < n; i++) {+ f->upvalues[i].instack = LoadByte(S);+ f->upvalues[i].idx = LoadByte(S);+ }+}+++static void LoadDebug (LoadState *S, Proto *f) {+ int i, n;+ n = LoadInt(S);+ f->lineinfo = luaM_newvector(S->L, n, int);+ f->sizelineinfo = n;+ LoadVector(S, f->lineinfo, n);+ n = LoadInt(S);+ f->locvars = luaM_newvector(S->L, n, LocVar);+ f->sizelocvars = n;+ for (i = 0; i < n; i++)+ f->locvars[i].varname = NULL;+ for (i = 0; i < n; i++) {+ f->locvars[i].varname = LoadString(S, f);+ f->locvars[i].startpc = LoadInt(S);+ f->locvars[i].endpc = LoadInt(S);+ }+ n = LoadInt(S);+ for (i = 0; i < n; i++)+ f->upvalues[i].name = LoadString(S, f);+}+++static void LoadFunction (LoadState *S, Proto *f, TString *psource) {+ f->source = LoadString(S, f);+ if (f->source == NULL) /* no source in dump? */+ f->source = psource; /* reuse parent's source */+ f->linedefined = LoadInt(S);+ f->lastlinedefined = LoadInt(S);+ f->numparams = LoadByte(S);+ f->is_vararg = LoadByte(S);+ f->maxstacksize = LoadByte(S);+ LoadCode(S, f);+ LoadConstants(S, f);+ LoadUpvalues(S, f);+ LoadProtos(S, f);+ LoadDebug(S, f);+}+++static void checkliteral (LoadState *S, const char *s, const char *msg) {+ char buff[sizeof(LUA_SIGNATURE) + sizeof(LUAC_DATA)]; /* larger than both */+ size_t len = strlen(s);+ LoadVector(S, buff, len);+ if (memcmp(s, buff, len) != 0)+ error(S, msg);+}+++static void fchecksize (LoadState *S, size_t size, const char *tname) {+ if (LoadByte(S) != size)+ error(S, luaO_pushfstring(S->L, "%s size mismatch in", tname));+}+++#define checksize(S,t) fchecksize(S,sizeof(t),#t)++static void checkHeader (LoadState *S) {+ checkliteral(S, LUA_SIGNATURE + 1, "not a"); /* 1st char already checked */+ if (LoadByte(S) != LUAC_VERSION)+ error(S, "version mismatch in");+ if (LoadByte(S) != LUAC_FORMAT)+ error(S, "format mismatch in");+ checkliteral(S, LUAC_DATA, "corrupted");+ checksize(S, int);+ checksize(S, size_t);+ checksize(S, Instruction);+ checksize(S, lua_Integer);+ checksize(S, lua_Number);+ if (LoadInteger(S) != LUAC_INT)+ error(S, "endianness mismatch in");+ if (LoadNumber(S) != LUAC_NUM)+ error(S, "float format mismatch in");+}+++/*+** load precompiled chunk+*/+LClosure *luaU_undump(lua_State *L, ZIO *Z, const char *name) {+ LoadState S;+ LClosure *cl;+ if (*name == '@' || *name == '=')+ S.name = name + 1;+ else if (*name == LUA_SIGNATURE[0])+ S.name = "binary string";+ else+ S.name = name;+ S.L = L;+ S.Z = Z;+ checkHeader(&S);+ cl = luaF_newLclosure(L, LoadByte(&S));+ setclLvalue(L, L->top, cl);+ luaD_inctop(L);+ cl->p = luaF_newproto(L);+ luaC_objbarrier(L, cl, cl->p);+ LoadFunction(&S, cl->p, NULL);+ lua_assert(cl->nupvalues == cl->p->sizeupvalues);+ luai_verifycode(L, buff, cl->p);+ return cl;+}+
+ cbits/lua-5.3.6/lundump.h view
@@ -0,0 +1,32 @@+/*+** $Id: lundump.h,v 1.45.1.1 2017/04/19 17:20:42 roberto Exp $+** load precompiled Lua chunks+** See Copyright Notice in lua.h+*/++#ifndef lundump_h+#define lundump_h++#include "llimits.h"+#include "lobject.h"+#include "lzio.h"+++/* data to catch conversion errors */+#define LUAC_DATA "\x19\x93\r\n\x1a\n"++#define LUAC_INT 0x5678+#define LUAC_NUM cast_num(370.5)++#define MYINT(s) (s[0]-'0')+#define LUAC_VERSION (MYINT(LUA_VERSION_MAJOR)*16+MYINT(LUA_VERSION_MINOR))+#define LUAC_FORMAT 0 /* this is the official format */++/* load one chunk; from lundump.c */+LUAI_FUNC LClosure* luaU_undump (lua_State* L, ZIO* Z, const char* name);++/* dump one chunk; from ldump.c */+LUAI_FUNC int luaU_dump (lua_State* L, const Proto* f, lua_Writer w,+ void* data, int strip);++#endif
+ cbits/lua-5.3.6/lutf8lib.c view
@@ -0,0 +1,256 @@+/*+** $Id: lutf8lib.c,v 1.16.1.1 2017/04/19 17:29:57 roberto Exp $+** Standard library for UTF-8 manipulation+** See Copyright Notice in lua.h+*/++#define lutf8lib_c+#define LUA_LIB++#include "lprefix.h"+++#include <assert.h>+#include <limits.h>+#include <stdlib.h>+#include <string.h>++#include "lua.h"++#include "lauxlib.h"+#include "lualib.h"++#define MAXUNICODE 0x10FFFF++#define iscont(p) ((*(p) & 0xC0) == 0x80)+++/* from strlib */+/* translate a relative string position: negative means back from end */+static lua_Integer u_posrelat (lua_Integer pos, size_t len) {+ if (pos >= 0) return pos;+ else if (0u - (size_t)pos > len) return 0;+ else return (lua_Integer)len + pos + 1;+}+++/*+** Decode one UTF-8 sequence, returning NULL if byte sequence is invalid.+*/+static const char *utf8_decode (const char *o, int *val) {+ static const unsigned int limits[] = {0xFF, 0x7F, 0x7FF, 0xFFFF};+ const unsigned char *s = (const unsigned char *)o;+ unsigned int c = s[0];+ unsigned int res = 0; /* final result */+ if (c < 0x80) /* ascii? */+ res = c;+ else {+ int count = 0; /* to count number of continuation bytes */+ while (c & 0x40) { /* still have continuation bytes? */+ int cc = s[++count]; /* read next byte */+ if ((cc & 0xC0) != 0x80) /* not a continuation byte? */+ return NULL; /* invalid byte sequence */+ res = (res << 6) | (cc & 0x3F); /* add lower 6 bits from cont. byte */+ c <<= 1; /* to test next bit */+ }+ res |= ((c & 0x7F) << (count * 5)); /* add first byte */+ if (count > 3 || res > MAXUNICODE || res <= limits[count])+ return NULL; /* invalid byte sequence */+ s += count; /* skip continuation bytes read */+ }+ if (val) *val = res;+ return (const char *)s + 1; /* +1 to include first byte */+}+++/*+** utf8len(s [, i [, j]]) --> number of characters that start in the+** range [i,j], or nil + current position if 's' is not well formed in+** that interval+*/+static int utflen (lua_State *L) {+ int n = 0;+ size_t len;+ const char *s = luaL_checklstring(L, 1, &len);+ lua_Integer posi = u_posrelat(luaL_optinteger(L, 2, 1), len);+ lua_Integer posj = u_posrelat(luaL_optinteger(L, 3, -1), len);+ luaL_argcheck(L, 1 <= posi && --posi <= (lua_Integer)len, 2,+ "initial position out of string");+ luaL_argcheck(L, --posj < (lua_Integer)len, 3,+ "final position out of string");+ while (posi <= posj) {+ const char *s1 = utf8_decode(s + posi, NULL);+ if (s1 == NULL) { /* conversion error? */+ lua_pushnil(L); /* return nil ... */+ lua_pushinteger(L, posi + 1); /* ... and current position */+ return 2;+ }+ posi = s1 - s;+ n++;+ }+ lua_pushinteger(L, n);+ return 1;+}+++/*+** codepoint(s, [i, [j]]) -> returns codepoints for all characters+** that start in the range [i,j]+*/+static int codepoint (lua_State *L) {+ size_t len;+ const char *s = luaL_checklstring(L, 1, &len);+ lua_Integer posi = u_posrelat(luaL_optinteger(L, 2, 1), len);+ lua_Integer pose = u_posrelat(luaL_optinteger(L, 3, posi), len);+ int n;+ const char *se;+ luaL_argcheck(L, posi >= 1, 2, "out of range");+ luaL_argcheck(L, pose <= (lua_Integer)len, 3, "out of range");+ if (posi > pose) return 0; /* empty interval; return no values */+ if (pose - posi >= INT_MAX) /* (lua_Integer -> int) overflow? */+ return luaL_error(L, "string slice too long");+ n = (int)(pose - posi) + 1;+ luaL_checkstack(L, n, "string slice too long");+ n = 0;+ se = s + pose;+ for (s += posi - 1; s < se;) {+ int code;+ s = utf8_decode(s, &code);+ if (s == NULL)+ return luaL_error(L, "invalid UTF-8 code");+ lua_pushinteger(L, code);+ n++;+ }+ return n;+}+++static void pushutfchar (lua_State *L, int arg) {+ lua_Integer code = luaL_checkinteger(L, arg);+ luaL_argcheck(L, 0 <= code && code <= MAXUNICODE, arg, "value out of range");+ lua_pushfstring(L, "%U", (long)code);+}+++/*+** utfchar(n1, n2, ...) -> char(n1)..char(n2)...+*/+static int utfchar (lua_State *L) {+ int n = lua_gettop(L); /* number of arguments */+ if (n == 1) /* optimize common case of single char */+ pushutfchar(L, 1);+ else {+ int i;+ luaL_Buffer b;+ luaL_buffinit(L, &b);+ for (i = 1; i <= n; i++) {+ pushutfchar(L, i);+ luaL_addvalue(&b);+ }+ luaL_pushresult(&b);+ }+ return 1;+}+++/*+** offset(s, n, [i]) -> index where n-th character counting from+** position 'i' starts; 0 means character at 'i'.+*/+static int byteoffset (lua_State *L) {+ size_t len;+ const char *s = luaL_checklstring(L, 1, &len);+ lua_Integer n = luaL_checkinteger(L, 2);+ lua_Integer posi = (n >= 0) ? 1 : len + 1;+ posi = u_posrelat(luaL_optinteger(L, 3, posi), len);+ luaL_argcheck(L, 1 <= posi && --posi <= (lua_Integer)len, 3,+ "position out of range");+ if (n == 0) {+ /* find beginning of current byte sequence */+ while (posi > 0 && iscont(s + posi)) posi--;+ }+ else {+ if (iscont(s + posi))+ return luaL_error(L, "initial position is a continuation byte");+ if (n < 0) {+ while (n < 0 && posi > 0) { /* move back */+ do { /* find beginning of previous character */+ posi--;+ } while (posi > 0 && iscont(s + posi));+ n++;+ }+ }+ else {+ n--; /* do not move for 1st character */+ while (n > 0 && posi < (lua_Integer)len) {+ do { /* find beginning of next character */+ posi++;+ } while (iscont(s + posi)); /* (cannot pass final '\0') */+ n--;+ }+ }+ }+ if (n == 0) /* did it find given character? */+ lua_pushinteger(L, posi + 1);+ else /* no such character */+ lua_pushnil(L);+ return 1;+}+++static int iter_aux (lua_State *L) {+ size_t len;+ const char *s = luaL_checklstring(L, 1, &len);+ lua_Integer n = lua_tointeger(L, 2) - 1;+ if (n < 0) /* first iteration? */+ n = 0; /* start from here */+ else if (n < (lua_Integer)len) {+ n++; /* skip current byte */+ while (iscont(s + n)) n++; /* and its continuations */+ }+ if (n >= (lua_Integer)len)+ return 0; /* no more codepoints */+ else {+ int code;+ const char *next = utf8_decode(s + n, &code);+ if (next == NULL || iscont(next))+ return luaL_error(L, "invalid UTF-8 code");+ lua_pushinteger(L, n + 1);+ lua_pushinteger(L, code);+ return 2;+ }+}+++static int iter_codes (lua_State *L) {+ luaL_checkstring(L, 1);+ lua_pushcfunction(L, iter_aux);+ lua_pushvalue(L, 1);+ lua_pushinteger(L, 0);+ return 3;+}+++/* pattern to match a single UTF-8 character */+#define UTF8PATT "[\0-\x7F\xC2-\xF4][\x80-\xBF]*"+++static const luaL_Reg funcs[] = {+ {"offset", byteoffset},+ {"codepoint", codepoint},+ {"char", utfchar},+ {"len", utflen},+ {"codes", iter_codes},+ /* placeholders */+ {"charpattern", NULL},+ {NULL, NULL}+};+++LUAMOD_API int luaopen_utf8 (lua_State *L) {+ luaL_newlib(L, funcs);+ lua_pushlstring(L, UTF8PATT, sizeof(UTF8PATT)/sizeof(char) - 1);+ lua_setfield(L, -2, "charpattern");+ return 1;+}+
+ cbits/lua-5.3.6/lvm.c view
@@ -0,0 +1,1322 @@+/*+** $Id: lvm.c,v 2.268.1.1 2017/04/19 17:39:34 roberto Exp $+** Lua virtual machine+** See Copyright Notice in lua.h+*/++#define lvm_c+#define LUA_CORE++#include "lprefix.h"++#include <float.h>+#include <limits.h>+#include <math.h>+#include <stdio.h>+#include <stdlib.h>+#include <string.h>++#include "lua.h"++#include "ldebug.h"+#include "ldo.h"+#include "lfunc.h"+#include "lgc.h"+#include "lobject.h"+#include "lopcodes.h"+#include "lstate.h"+#include "lstring.h"+#include "ltable.h"+#include "ltm.h"+#include "lvm.h"+++/* limit for table tag-method chains (to avoid loops) */+#define MAXTAGLOOP 2000++++/*+** 'l_intfitsf' checks whether a given integer can be converted to a+** float without rounding. Used in comparisons. Left undefined if+** all integers fit in a float precisely.+*/+#if !defined(l_intfitsf)++/* number of bits in the mantissa of a float */+#define NBM (l_mathlim(MANT_DIG))++/*+** Check whether some integers may not fit in a float, that is, whether+** (maxinteger >> NBM) > 0 (that implies (1 << NBM) <= maxinteger).+** (The shifts are done in parts to avoid shifting by more than the size+** of an integer. In a worst case, NBM == 113 for long double and+** sizeof(integer) == 32.)+*/+#if ((((LUA_MAXINTEGER >> (NBM / 4)) >> (NBM / 4)) >> (NBM / 4)) \+ >> (NBM - (3 * (NBM / 4)))) > 0++#define l_intfitsf(i) \+ (-((lua_Integer)1 << NBM) <= (i) && (i) <= ((lua_Integer)1 << NBM))++#endif++#endif++++/*+** Try to convert a value to a float. The float case is already handled+** by the macro 'tonumber'.+*/+int luaV_tonumber_ (const TValue *obj, lua_Number *n) {+ TValue v;+ if (ttisinteger(obj)) {+ *n = cast_num(ivalue(obj));+ return 1;+ }+ else if (cvt2num(obj) && /* string convertible to number? */+ luaO_str2num(svalue(obj), &v) == vslen(obj) + 1) {+ *n = nvalue(&v); /* convert result of 'luaO_str2num' to a float */+ return 1;+ }+ else+ return 0; /* conversion failed */+}+++/*+** try to convert a value to an integer, rounding according to 'mode':+** mode == 0: accepts only integral values+** mode == 1: takes the floor of the number+** mode == 2: takes the ceil of the number+*/+int luaV_tointeger (const TValue *obj, lua_Integer *p, int mode) {+ TValue v;+ again:+ if (ttisfloat(obj)) {+ lua_Number n = fltvalue(obj);+ lua_Number f = l_floor(n);+ if (n != f) { /* not an integral value? */+ if (mode == 0) return 0; /* fails if mode demands integral value */+ else if (mode > 1) /* needs ceil? */+ f += 1; /* convert floor to ceil (remember: n != f) */+ }+ return lua_numbertointeger(f, p);+ }+ else if (ttisinteger(obj)) {+ *p = ivalue(obj);+ return 1;+ }+ else if (cvt2num(obj) &&+ luaO_str2num(svalue(obj), &v) == vslen(obj) + 1) {+ obj = &v;+ goto again; /* convert result from 'luaO_str2num' to an integer */+ }+ return 0; /* conversion failed */+}+++/*+** Try to convert a 'for' limit to an integer, preserving the+** semantics of the loop.+** (The following explanation assumes a non-negative step; it is valid+** for negative steps mutatis mutandis.)+** If the limit can be converted to an integer, rounding down, that is+** it.+** Otherwise, check whether the limit can be converted to a number. If+** the number is too large, it is OK to set the limit as LUA_MAXINTEGER,+** which means no limit. If the number is too negative, the loop+** should not run, because any initial integer value is larger than the+** limit. So, it sets the limit to LUA_MININTEGER. 'stopnow' corrects+** the extreme case when the initial value is LUA_MININTEGER, in which+** case the LUA_MININTEGER limit would still run the loop once.+*/+static int forlimit (const TValue *obj, lua_Integer *p, lua_Integer step,+ int *stopnow) {+ *stopnow = 0; /* usually, let loops run */+ if (!luaV_tointeger(obj, p, (step < 0 ? 2 : 1))) { /* not fit in integer? */+ lua_Number n; /* try to convert to float */+ if (!tonumber(obj, &n)) /* cannot convert to float? */+ return 0; /* not a number */+ if (luai_numlt(0, n)) { /* if true, float is larger than max integer */+ *p = LUA_MAXINTEGER;+ if (step < 0) *stopnow = 1;+ }+ else { /* float is smaller than min integer */+ *p = LUA_MININTEGER;+ if (step >= 0) *stopnow = 1;+ }+ }+ return 1;+}+++/*+** Finish the table access 'val = t[key]'.+** if 'slot' is NULL, 't' is not a table; otherwise, 'slot' points to+** t[k] entry (which must be nil).+*/+void luaV_finishget (lua_State *L, const TValue *t, TValue *key, StkId val,+ const TValue *slot) {+ int loop; /* counter to avoid infinite loops */+ const TValue *tm; /* metamethod */+ for (loop = 0; loop < MAXTAGLOOP; loop++) {+ if (slot == NULL) { /* 't' is not a table? */+ lua_assert(!ttistable(t));+ tm = luaT_gettmbyobj(L, t, TM_INDEX);+ if (ttisnil(tm))+ luaG_typeerror(L, t, "index"); /* no metamethod */+ /* else will try the metamethod */+ }+ else { /* 't' is a table */+ lua_assert(ttisnil(slot));+ tm = fasttm(L, hvalue(t)->metatable, TM_INDEX); /* table's metamethod */+ if (tm == NULL) { /* no metamethod? */+ setnilvalue(val); /* result is nil */+ return;+ }+ /* else will try the metamethod */+ }+ if (ttisfunction(tm)) { /* is metamethod a function? */+ luaT_callTM(L, tm, t, key, val, 1); /* call it */+ return;+ }+ t = tm; /* else try to access 'tm[key]' */+ if (luaV_fastget(L,t,key,slot,luaH_get)) { /* fast track? */+ setobj2s(L, val, slot); /* done */+ return;+ }+ /* else repeat (tail call 'luaV_finishget') */+ }+ luaG_runerror(L, "'__index' chain too long; possible loop");+}+++/*+** Finish a table assignment 't[key] = val'.+** If 'slot' is NULL, 't' is not a table. Otherwise, 'slot' points+** to the entry 't[key]', or to 'luaO_nilobject' if there is no such+** entry. (The value at 'slot' must be nil, otherwise 'luaV_fastset'+** would have done the job.)+*/+void luaV_finishset (lua_State *L, const TValue *t, TValue *key,+ StkId val, const TValue *slot) {+ int loop; /* counter to avoid infinite loops */+ for (loop = 0; loop < MAXTAGLOOP; loop++) {+ const TValue *tm; /* '__newindex' metamethod */+ if (slot != NULL) { /* is 't' a table? */+ Table *h = hvalue(t); /* save 't' table */+ lua_assert(ttisnil(slot)); /* old value must be nil */+ tm = fasttm(L, h->metatable, TM_NEWINDEX); /* get metamethod */+ if (tm == NULL) { /* no metamethod? */+ if (slot == luaO_nilobject) /* no previous entry? */+ slot = luaH_newkey(L, h, key); /* create one */+ /* no metamethod and (now) there is an entry with given key */+ setobj2t(L, cast(TValue *, slot), val); /* set its new value */+ invalidateTMcache(h);+ luaC_barrierback(L, h, val);+ return;+ }+ /* else will try the metamethod */+ }+ else { /* not a table; check metamethod */+ if (ttisnil(tm = luaT_gettmbyobj(L, t, TM_NEWINDEX)))+ luaG_typeerror(L, t, "index");+ }+ /* try the metamethod */+ if (ttisfunction(tm)) {+ luaT_callTM(L, tm, t, key, val, 0);+ return;+ }+ t = tm; /* else repeat assignment over 'tm' */+ if (luaV_fastset(L, t, key, slot, luaH_get, val))+ return; /* done */+ /* else loop */+ }+ luaG_runerror(L, "'__newindex' chain too long; possible loop");+}+++/*+** Compare two strings 'ls' x 'rs', returning an integer smaller-equal-+** -larger than zero if 'ls' is smaller-equal-larger than 'rs'.+** The code is a little tricky because it allows '\0' in the strings+** and it uses 'strcoll' (to respect locales) for each segments+** of the strings.+*/+static int l_strcmp (const TString *ls, const TString *rs) {+ const char *l = getstr(ls);+ size_t ll = tsslen(ls);+ const char *r = getstr(rs);+ size_t lr = tsslen(rs);+ for (;;) { /* for each segment */+ int temp = strcoll(l, r);+ if (temp != 0) /* not equal? */+ return temp; /* done */+ else { /* strings are equal up to a '\0' */+ size_t len = strlen(l); /* index of first '\0' in both strings */+ if (len == lr) /* 'rs' is finished? */+ return (len == ll) ? 0 : 1; /* check 'ls' */+ else if (len == ll) /* 'ls' is finished? */+ return -1; /* 'ls' is smaller than 'rs' ('rs' is not finished) */+ /* both strings longer than 'len'; go on comparing after the '\0' */+ len++;+ l += len; ll -= len; r += len; lr -= len;+ }+ }+}+++/*+** Check whether integer 'i' is less than float 'f'. If 'i' has an+** exact representation as a float ('l_intfitsf'), compare numbers as+** floats. Otherwise, if 'f' is outside the range for integers, result+** is trivial. Otherwise, compare them as integers. (When 'i' has no+** float representation, either 'f' is "far away" from 'i' or 'f' has+** no precision left for a fractional part; either way, how 'f' is+** truncated is irrelevant.) When 'f' is NaN, comparisons must result+** in false.+*/+static int LTintfloat (lua_Integer i, lua_Number f) {+#if defined(l_intfitsf)+ if (!l_intfitsf(i)) {+ if (f >= -cast_num(LUA_MININTEGER)) /* -minint == maxint + 1 */+ return 1; /* f >= maxint + 1 > i */+ else if (f > cast_num(LUA_MININTEGER)) /* minint < f <= maxint ? */+ return (i < cast(lua_Integer, f)); /* compare them as integers */+ else /* f <= minint <= i (or 'f' is NaN) --> not(i < f) */+ return 0;+ }+#endif+ return luai_numlt(cast_num(i), f); /* compare them as floats */+}+++/*+** Check whether integer 'i' is less than or equal to float 'f'.+** See comments on previous function.+*/+static int LEintfloat (lua_Integer i, lua_Number f) {+#if defined(l_intfitsf)+ if (!l_intfitsf(i)) {+ if (f >= -cast_num(LUA_MININTEGER)) /* -minint == maxint + 1 */+ return 1; /* f >= maxint + 1 > i */+ else if (f >= cast_num(LUA_MININTEGER)) /* minint <= f <= maxint ? */+ return (i <= cast(lua_Integer, f)); /* compare them as integers */+ else /* f < minint <= i (or 'f' is NaN) --> not(i <= f) */+ return 0;+ }+#endif+ return luai_numle(cast_num(i), f); /* compare them as floats */+}+++/*+** Return 'l < r', for numbers.+*/+static int LTnum (const TValue *l, const TValue *r) {+ if (ttisinteger(l)) {+ lua_Integer li = ivalue(l);+ if (ttisinteger(r))+ return li < ivalue(r); /* both are integers */+ else /* 'l' is int and 'r' is float */+ return LTintfloat(li, fltvalue(r)); /* l < r ? */+ }+ else {+ lua_Number lf = fltvalue(l); /* 'l' must be float */+ if (ttisfloat(r))+ return luai_numlt(lf, fltvalue(r)); /* both are float */+ else if (luai_numisnan(lf)) /* 'r' is int and 'l' is float */+ return 0; /* NaN < i is always false */+ else /* without NaN, (l < r) <--> not(r <= l) */+ return !LEintfloat(ivalue(r), lf); /* not (r <= l) ? */+ }+}+++/*+** Return 'l <= r', for numbers.+*/+static int LEnum (const TValue *l, const TValue *r) {+ if (ttisinteger(l)) {+ lua_Integer li = ivalue(l);+ if (ttisinteger(r))+ return li <= ivalue(r); /* both are integers */+ else /* 'l' is int and 'r' is float */+ return LEintfloat(li, fltvalue(r)); /* l <= r ? */+ }+ else {+ lua_Number lf = fltvalue(l); /* 'l' must be float */+ if (ttisfloat(r))+ return luai_numle(lf, fltvalue(r)); /* both are float */+ else if (luai_numisnan(lf)) /* 'r' is int and 'l' is float */+ return 0; /* NaN <= i is always false */+ else /* without NaN, (l <= r) <--> not(r < l) */+ return !LTintfloat(ivalue(r), lf); /* not (r < l) ? */+ }+}+++/*+** Main operation less than; return 'l < r'.+*/+int luaV_lessthan (lua_State *L, const TValue *l, const TValue *r) {+ int res;+ if (ttisnumber(l) && ttisnumber(r)) /* both operands are numbers? */+ return LTnum(l, r);+ else if (ttisstring(l) && ttisstring(r)) /* both are strings? */+ return l_strcmp(tsvalue(l), tsvalue(r)) < 0;+ else if ((res = luaT_callorderTM(L, l, r, TM_LT)) < 0) /* no metamethod? */+ luaG_ordererror(L, l, r); /* error */+ return res;+}+++/*+** Main operation less than or equal to; return 'l <= r'. If it needs+** a metamethod and there is no '__le', try '__lt', based on+** l <= r iff !(r < l) (assuming a total order). If the metamethod+** yields during this substitution, the continuation has to know+** about it (to negate the result of r<l); bit CIST_LEQ in the call+** status keeps that information.+*/+int luaV_lessequal (lua_State *L, const TValue *l, const TValue *r) {+ int res;+ if (ttisnumber(l) && ttisnumber(r)) /* both operands are numbers? */+ return LEnum(l, r);+ else if (ttisstring(l) && ttisstring(r)) /* both are strings? */+ return l_strcmp(tsvalue(l), tsvalue(r)) <= 0;+ else if ((res = luaT_callorderTM(L, l, r, TM_LE)) >= 0) /* try 'le' */+ return res;+ else { /* try 'lt': */+ L->ci->callstatus |= CIST_LEQ; /* mark it is doing 'lt' for 'le' */+ res = luaT_callorderTM(L, r, l, TM_LT);+ L->ci->callstatus ^= CIST_LEQ; /* clear mark */+ if (res < 0)+ luaG_ordererror(L, l, r);+ return !res; /* result is negated */+ }+}+++/*+** Main operation for equality of Lua values; return 't1 == t2'.+** L == NULL means raw equality (no metamethods)+*/+int luaV_equalobj (lua_State *L, const TValue *t1, const TValue *t2) {+ const TValue *tm;+ if (ttype(t1) != ttype(t2)) { /* not the same variant? */+ if (ttnov(t1) != ttnov(t2) || ttnov(t1) != LUA_TNUMBER)+ return 0; /* only numbers can be equal with different variants */+ else { /* two numbers with different variants */+ lua_Integer i1, i2; /* compare them as integers */+ return (tointeger(t1, &i1) && tointeger(t2, &i2) && i1 == i2);+ }+ }+ /* values have same type and same variant */+ switch (ttype(t1)) {+ case LUA_TNIL: return 1;+ case LUA_TNUMINT: return (ivalue(t1) == ivalue(t2));+ case LUA_TNUMFLT: return luai_numeq(fltvalue(t1), fltvalue(t2));+ case LUA_TBOOLEAN: return bvalue(t1) == bvalue(t2); /* true must be 1 !! */+ case LUA_TLIGHTUSERDATA: return pvalue(t1) == pvalue(t2);+ case LUA_TLCF: return fvalue(t1) == fvalue(t2);+ case LUA_TSHRSTR: return eqshrstr(tsvalue(t1), tsvalue(t2));+ case LUA_TLNGSTR: return luaS_eqlngstr(tsvalue(t1), tsvalue(t2));+ case LUA_TUSERDATA: {+ if (uvalue(t1) == uvalue(t2)) return 1;+ else if (L == NULL) return 0;+ tm = fasttm(L, uvalue(t1)->metatable, TM_EQ);+ if (tm == NULL)+ tm = fasttm(L, uvalue(t2)->metatable, TM_EQ);+ break; /* will try TM */+ }+ case LUA_TTABLE: {+ if (hvalue(t1) == hvalue(t2)) return 1;+ else if (L == NULL) return 0;+ tm = fasttm(L, hvalue(t1)->metatable, TM_EQ);+ if (tm == NULL)+ tm = fasttm(L, hvalue(t2)->metatable, TM_EQ);+ break; /* will try TM */+ }+ default:+ return gcvalue(t1) == gcvalue(t2);+ }+ if (tm == NULL) /* no TM? */+ return 0; /* objects are different */+ luaT_callTM(L, tm, t1, t2, L->top, 1); /* call TM */+ return !l_isfalse(L->top);+}+++/* macro used by 'luaV_concat' to ensure that element at 'o' is a string */+#define tostring(L,o) \+ (ttisstring(o) || (cvt2str(o) && (luaO_tostring(L, o), 1)))++#define isemptystr(o) (ttisshrstring(o) && tsvalue(o)->shrlen == 0)++/* copy strings in stack from top - n up to top - 1 to buffer */+static void copy2buff (StkId top, int n, char *buff) {+ size_t tl = 0; /* size already copied */+ do {+ size_t l = vslen(top - n); /* length of string being copied */+ memcpy(buff + tl, svalue(top - n), l * sizeof(char));+ tl += l;+ } while (--n > 0);+}+++/*+** Main operation for concatenation: concat 'total' values in the stack,+** from 'L->top - total' up to 'L->top - 1'.+*/+void luaV_concat (lua_State *L, int total) {+ lua_assert(total >= 2);+ do {+ StkId top = L->top;+ int n = 2; /* number of elements handled in this pass (at least 2) */+ if (!(ttisstring(top-2) || cvt2str(top-2)) || !tostring(L, top-1))+ luaT_trybinTM(L, top-2, top-1, top-2, TM_CONCAT);+ else if (isemptystr(top - 1)) /* second operand is empty? */+ cast_void(tostring(L, top - 2)); /* result is first operand */+ else if (isemptystr(top - 2)) { /* first operand is an empty string? */+ setobjs2s(L, top - 2, top - 1); /* result is second op. */+ }+ else {+ /* at least two non-empty string values; get as many as possible */+ size_t tl = vslen(top - 1);+ TString *ts;+ /* collect total length and number of strings */+ for (n = 1; n < total && tostring(L, top - n - 1); n++) {+ size_t l = vslen(top - n - 1);+ if (l >= (MAX_SIZE/sizeof(char)) - tl)+ luaG_runerror(L, "string length overflow");+ tl += l;+ }+ if (tl <= LUAI_MAXSHORTLEN) { /* is result a short string? */+ char buff[LUAI_MAXSHORTLEN];+ copy2buff(top, n, buff); /* copy strings to buffer */+ ts = luaS_newlstr(L, buff, tl);+ }+ else { /* long string; copy strings directly to final result */+ ts = luaS_createlngstrobj(L, tl);+ copy2buff(top, n, getstr(ts));+ }+ setsvalue2s(L, top - n, ts); /* create result */+ }+ total -= n-1; /* got 'n' strings to create 1 new */+ L->top -= n-1; /* popped 'n' strings and pushed one */+ } while (total > 1); /* repeat until only 1 result left */+}+++/*+** Main operation 'ra' = #rb'.+*/+void luaV_objlen (lua_State *L, StkId ra, const TValue *rb) {+ const TValue *tm;+ switch (ttype(rb)) {+ case LUA_TTABLE: {+ Table *h = hvalue(rb);+ tm = fasttm(L, h->metatable, TM_LEN);+ if (tm) break; /* metamethod? break switch to call it */+ setivalue(ra, luaH_getn(h)); /* else primitive len */+ return;+ }+ case LUA_TSHRSTR: {+ setivalue(ra, tsvalue(rb)->shrlen);+ return;+ }+ case LUA_TLNGSTR: {+ setivalue(ra, tsvalue(rb)->u.lnglen);+ return;+ }+ default: { /* try metamethod */+ tm = luaT_gettmbyobj(L, rb, TM_LEN);+ if (ttisnil(tm)) /* no metamethod? */+ luaG_typeerror(L, rb, "get length of");+ break;+ }+ }+ luaT_callTM(L, tm, rb, rb, ra, 1);+}+++/*+** Integer division; return 'm // n', that is, floor(m/n).+** C division truncates its result (rounds towards zero).+** 'floor(q) == trunc(q)' when 'q >= 0' or when 'q' is integer,+** otherwise 'floor(q) == trunc(q) - 1'.+*/+lua_Integer luaV_div (lua_State *L, lua_Integer m, lua_Integer n) {+ if (l_castS2U(n) + 1u <= 1u) { /* special cases: -1 or 0 */+ if (n == 0)+ luaG_runerror(L, "attempt to divide by zero");+ return intop(-, 0, m); /* n==-1; avoid overflow with 0x80000...//-1 */+ }+ else {+ lua_Integer q = m / n; /* perform C division */+ if ((m ^ n) < 0 && m % n != 0) /* 'm/n' would be negative non-integer? */+ q -= 1; /* correct result for different rounding */+ return q;+ }+}+++/*+** Integer modulus; return 'm % n'. (Assume that C '%' with+** negative operands follows C99 behavior. See previous comment+** about luaV_div.)+*/+lua_Integer luaV_mod (lua_State *L, lua_Integer m, lua_Integer n) {+ if (l_castS2U(n) + 1u <= 1u) { /* special cases: -1 or 0 */+ if (n == 0)+ luaG_runerror(L, "attempt to perform 'n%%0'");+ return 0; /* m % -1 == 0; avoid overflow with 0x80000...%-1 */+ }+ else {+ lua_Integer r = m % n;+ if (r != 0 && (m ^ n) < 0) /* 'm/n' would be non-integer negative? */+ r += n; /* correct result for different rounding */+ return r;+ }+}+++/* number of bits in an integer */+#define NBITS cast_int(sizeof(lua_Integer) * CHAR_BIT)++/*+** Shift left operation. (Shift right just negates 'y'.)+*/+lua_Integer luaV_shiftl (lua_Integer x, lua_Integer y) {+ if (y < 0) { /* shift right? */+ if (y <= -NBITS) return 0;+ else return intop(>>, x, -y);+ }+ else { /* shift left */+ if (y >= NBITS) return 0;+ else return intop(<<, x, y);+ }+}+++/*+** check whether cached closure in prototype 'p' may be reused, that is,+** whether there is a cached closure with the same upvalues needed by+** new closure to be created.+*/+static LClosure *getcached (Proto *p, UpVal **encup, StkId base) {+ LClosure *c = p->cache;+ if (c != NULL) { /* is there a cached closure? */+ int nup = p->sizeupvalues;+ Upvaldesc *uv = p->upvalues;+ int i;+ for (i = 0; i < nup; i++) { /* check whether it has right upvalues */+ TValue *v = uv[i].instack ? base + uv[i].idx : encup[uv[i].idx]->v;+ if (c->upvals[i]->v != v)+ return NULL; /* wrong upvalue; cannot reuse closure */+ }+ }+ return c; /* return cached closure (or NULL if no cached closure) */+}+++/*+** create a new Lua closure, push it in the stack, and initialize+** its upvalues. Note that the closure is not cached if prototype is+** already black (which means that 'cache' was already cleared by the+** GC).+*/+static void pushclosure (lua_State *L, Proto *p, UpVal **encup, StkId base,+ StkId ra) {+ int nup = p->sizeupvalues;+ Upvaldesc *uv = p->upvalues;+ int i;+ LClosure *ncl = luaF_newLclosure(L, nup);+ ncl->p = p;+ setclLvalue(L, ra, ncl); /* anchor new closure in stack */+ for (i = 0; i < nup; i++) { /* fill in its upvalues */+ if (uv[i].instack) /* upvalue refers to local variable? */+ ncl->upvals[i] = luaF_findupval(L, base + uv[i].idx);+ else /* get upvalue from enclosing function */+ ncl->upvals[i] = encup[uv[i].idx];+ ncl->upvals[i]->refcount++;+ /* new closure is white, so we do not need a barrier here */+ }+ if (!isblack(p)) /* cache will not break GC invariant? */+ p->cache = ncl; /* save it on cache for reuse */+}+++/*+** finish execution of an opcode interrupted by an yield+*/+void luaV_finishOp (lua_State *L) {+ CallInfo *ci = L->ci;+ StkId base = ci->u.l.base;+ Instruction inst = *(ci->u.l.savedpc - 1); /* interrupted instruction */+ OpCode op = GET_OPCODE(inst);+ switch (op) { /* finish its execution */+ case OP_ADD: case OP_SUB: case OP_MUL: case OP_DIV: case OP_IDIV:+ case OP_BAND: case OP_BOR: case OP_BXOR: case OP_SHL: case OP_SHR:+ case OP_MOD: case OP_POW:+ case OP_UNM: case OP_BNOT: case OP_LEN:+ case OP_GETTABUP: case OP_GETTABLE: case OP_SELF: {+ setobjs2s(L, base + GETARG_A(inst), --L->top);+ break;+ }+ case OP_LE: case OP_LT: case OP_EQ: {+ int res = !l_isfalse(L->top - 1);+ L->top--;+ if (ci->callstatus & CIST_LEQ) { /* "<=" using "<" instead? */+ lua_assert(op == OP_LE);+ ci->callstatus ^= CIST_LEQ; /* clear mark */+ res = !res; /* negate result */+ }+ lua_assert(GET_OPCODE(*ci->u.l.savedpc) == OP_JMP);+ if (res != GETARG_A(inst)) /* condition failed? */+ ci->u.l.savedpc++; /* skip jump instruction */+ break;+ }+ case OP_CONCAT: {+ StkId top = L->top - 1; /* top when 'luaT_trybinTM' was called */+ int b = GETARG_B(inst); /* first element to concatenate */+ int total = cast_int(top - 1 - (base + b)); /* yet to concatenate */+ setobj2s(L, top - 2, top); /* put TM result in proper position */+ if (total > 1) { /* are there elements to concat? */+ L->top = top - 1; /* top is one after last element (at top-2) */+ luaV_concat(L, total); /* concat them (may yield again) */+ }+ /* move final result to final position */+ setobj2s(L, ci->u.l.base + GETARG_A(inst), L->top - 1);+ L->top = ci->top; /* restore top */+ break;+ }+ case OP_TFORCALL: {+ lua_assert(GET_OPCODE(*ci->u.l.savedpc) == OP_TFORLOOP);+ L->top = ci->top; /* correct top */+ break;+ }+ case OP_CALL: {+ if (GETARG_C(inst) - 1 >= 0) /* nresults >= 0? */+ L->top = ci->top; /* adjust results */+ break;+ }+ case OP_TAILCALL: case OP_SETTABUP: case OP_SETTABLE:+ break;+ default: lua_assert(0);+ }+}+++++/*+** {==================================================================+** Function 'luaV_execute': main interpreter loop+** ===================================================================+*/+++/*+** some macros for common tasks in 'luaV_execute'+*/+++#define RA(i) (base+GETARG_A(i))+#define RB(i) check_exp(getBMode(GET_OPCODE(i)) == OpArgR, base+GETARG_B(i))+#define RC(i) check_exp(getCMode(GET_OPCODE(i)) == OpArgR, base+GETARG_C(i))+#define RKB(i) check_exp(getBMode(GET_OPCODE(i)) == OpArgK, \+ ISK(GETARG_B(i)) ? k+INDEXK(GETARG_B(i)) : base+GETARG_B(i))+#define RKC(i) check_exp(getCMode(GET_OPCODE(i)) == OpArgK, \+ ISK(GETARG_C(i)) ? k+INDEXK(GETARG_C(i)) : base+GETARG_C(i))+++/* execute a jump instruction */+#define dojump(ci,i,e) \+ { int a = GETARG_A(i); \+ if (a != 0) luaF_close(L, ci->u.l.base + a - 1); \+ ci->u.l.savedpc += GETARG_sBx(i) + e; }++/* for test instructions, execute the jump instruction that follows it */+#define donextjump(ci) { i = *ci->u.l.savedpc; dojump(ci, i, 1); }+++#define Protect(x) { {x;}; base = ci->u.l.base; }++#define checkGC(L,c) \+ { luaC_condGC(L, L->top = (c), /* limit of live values */ \+ Protect(L->top = ci->top)); /* restore top */ \+ luai_threadyield(L); }+++/* fetch an instruction and prepare its execution */+#define vmfetch() { \+ i = *(ci->u.l.savedpc++); \+ if (L->hookmask & (LUA_MASKLINE | LUA_MASKCOUNT)) \+ Protect(luaG_traceexec(L)); \+ ra = RA(i); /* WARNING: any stack reallocation invalidates 'ra' */ \+ lua_assert(base == ci->u.l.base); \+ lua_assert(base <= L->top && L->top < L->stack + L->stacksize); \+}++#define vmdispatch(o) switch(o)+#define vmcase(l) case l:+#define vmbreak break+++/*+** copy of 'luaV_gettable', but protecting the call to potential+** metamethod (which can reallocate the stack)+*/+#define gettableProtected(L,t,k,v) { const TValue *slot; \+ if (luaV_fastget(L,t,k,slot,luaH_get)) { setobj2s(L, v, slot); } \+ else Protect(luaV_finishget(L,t,k,v,slot)); }+++/* same for 'luaV_settable' */+#define settableProtected(L,t,k,v) { const TValue *slot; \+ if (!luaV_fastset(L,t,k,slot,luaH_get,v)) \+ Protect(luaV_finishset(L,t,k,v,slot)); }++++void luaV_execute (lua_State *L) {+ CallInfo *ci = L->ci;+ LClosure *cl;+ TValue *k;+ StkId base;+ ci->callstatus |= CIST_FRESH; /* fresh invocation of 'luaV_execute" */+ newframe: /* reentry point when frame changes (call/return) */+ lua_assert(ci == L->ci);+ cl = clLvalue(ci->func); /* local reference to function's closure */+ k = cl->p->k; /* local reference to function's constant table */+ base = ci->u.l.base; /* local copy of function's base */+ /* main loop of interpreter */+ for (;;) {+ Instruction i;+ StkId ra;+ vmfetch();+ vmdispatch (GET_OPCODE(i)) {+ vmcase(OP_MOVE) {+ setobjs2s(L, ra, RB(i));+ vmbreak;+ }+ vmcase(OP_LOADK) {+ TValue *rb = k + GETARG_Bx(i);+ setobj2s(L, ra, rb);+ vmbreak;+ }+ vmcase(OP_LOADKX) {+ TValue *rb;+ lua_assert(GET_OPCODE(*ci->u.l.savedpc) == OP_EXTRAARG);+ rb = k + GETARG_Ax(*ci->u.l.savedpc++);+ setobj2s(L, ra, rb);+ vmbreak;+ }+ vmcase(OP_LOADBOOL) {+ setbvalue(ra, GETARG_B(i));+ if (GETARG_C(i)) ci->u.l.savedpc++; /* skip next instruction (if C) */+ vmbreak;+ }+ vmcase(OP_LOADNIL) {+ int b = GETARG_B(i);+ do {+ setnilvalue(ra++);+ } while (b--);+ vmbreak;+ }+ vmcase(OP_GETUPVAL) {+ int b = GETARG_B(i);+ setobj2s(L, ra, cl->upvals[b]->v);+ vmbreak;+ }+ vmcase(OP_GETTABUP) {+ TValue *upval = cl->upvals[GETARG_B(i)]->v;+ TValue *rc = RKC(i);+ gettableProtected(L, upval, rc, ra);+ vmbreak;+ }+ vmcase(OP_GETTABLE) {+ StkId rb = RB(i);+ TValue *rc = RKC(i);+ gettableProtected(L, rb, rc, ra);+ vmbreak;+ }+ vmcase(OP_SETTABUP) {+ TValue *upval = cl->upvals[GETARG_A(i)]->v;+ TValue *rb = RKB(i);+ TValue *rc = RKC(i);+ settableProtected(L, upval, rb, rc);+ vmbreak;+ }+ vmcase(OP_SETUPVAL) {+ UpVal *uv = cl->upvals[GETARG_B(i)];+ setobj(L, uv->v, ra);+ luaC_upvalbarrier(L, uv);+ vmbreak;+ }+ vmcase(OP_SETTABLE) {+ TValue *rb = RKB(i);+ TValue *rc = RKC(i);+ settableProtected(L, ra, rb, rc);+ vmbreak;+ }+ vmcase(OP_NEWTABLE) {+ int b = GETARG_B(i);+ int c = GETARG_C(i);+ Table *t = luaH_new(L);+ sethvalue(L, ra, t);+ if (b != 0 || c != 0)+ luaH_resize(L, t, luaO_fb2int(b), luaO_fb2int(c));+ checkGC(L, ra + 1);+ vmbreak;+ }+ vmcase(OP_SELF) {+ const TValue *aux;+ StkId rb = RB(i);+ TValue *rc = RKC(i);+ TString *key = tsvalue(rc); /* key must be a string */+ setobjs2s(L, ra + 1, rb);+ if (luaV_fastget(L, rb, key, aux, luaH_getstr)) {+ setobj2s(L, ra, aux);+ }+ else Protect(luaV_finishget(L, rb, rc, ra, aux));+ vmbreak;+ }+ vmcase(OP_ADD) {+ TValue *rb = RKB(i);+ TValue *rc = RKC(i);+ lua_Number nb; lua_Number nc;+ if (ttisinteger(rb) && ttisinteger(rc)) {+ lua_Integer ib = ivalue(rb); lua_Integer ic = ivalue(rc);+ setivalue(ra, intop(+, ib, ic));+ }+ else if (tonumber(rb, &nb) && tonumber(rc, &nc)) {+ setfltvalue(ra, luai_numadd(L, nb, nc));+ }+ else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_ADD)); }+ vmbreak;+ }+ vmcase(OP_SUB) {+ TValue *rb = RKB(i);+ TValue *rc = RKC(i);+ lua_Number nb; lua_Number nc;+ if (ttisinteger(rb) && ttisinteger(rc)) {+ lua_Integer ib = ivalue(rb); lua_Integer ic = ivalue(rc);+ setivalue(ra, intop(-, ib, ic));+ }+ else if (tonumber(rb, &nb) && tonumber(rc, &nc)) {+ setfltvalue(ra, luai_numsub(L, nb, nc));+ }+ else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_SUB)); }+ vmbreak;+ }+ vmcase(OP_MUL) {+ TValue *rb = RKB(i);+ TValue *rc = RKC(i);+ lua_Number nb; lua_Number nc;+ if (ttisinteger(rb) && ttisinteger(rc)) {+ lua_Integer ib = ivalue(rb); lua_Integer ic = ivalue(rc);+ setivalue(ra, intop(*, ib, ic));+ }+ else if (tonumber(rb, &nb) && tonumber(rc, &nc)) {+ setfltvalue(ra, luai_nummul(L, nb, nc));+ }+ else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_MUL)); }+ vmbreak;+ }+ vmcase(OP_DIV) { /* float division (always with floats) */+ TValue *rb = RKB(i);+ TValue *rc = RKC(i);+ lua_Number nb; lua_Number nc;+ if (tonumber(rb, &nb) && tonumber(rc, &nc)) {+ setfltvalue(ra, luai_numdiv(L, nb, nc));+ }+ else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_DIV)); }+ vmbreak;+ }+ vmcase(OP_BAND) {+ TValue *rb = RKB(i);+ TValue *rc = RKC(i);+ lua_Integer ib; lua_Integer ic;+ if (tointeger(rb, &ib) && tointeger(rc, &ic)) {+ setivalue(ra, intop(&, ib, ic));+ }+ else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_BAND)); }+ vmbreak;+ }+ vmcase(OP_BOR) {+ TValue *rb = RKB(i);+ TValue *rc = RKC(i);+ lua_Integer ib; lua_Integer ic;+ if (tointeger(rb, &ib) && tointeger(rc, &ic)) {+ setivalue(ra, intop(|, ib, ic));+ }+ else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_BOR)); }+ vmbreak;+ }+ vmcase(OP_BXOR) {+ TValue *rb = RKB(i);+ TValue *rc = RKC(i);+ lua_Integer ib; lua_Integer ic;+ if (tointeger(rb, &ib) && tointeger(rc, &ic)) {+ setivalue(ra, intop(^, ib, ic));+ }+ else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_BXOR)); }+ vmbreak;+ }+ vmcase(OP_SHL) {+ TValue *rb = RKB(i);+ TValue *rc = RKC(i);+ lua_Integer ib; lua_Integer ic;+ if (tointeger(rb, &ib) && tointeger(rc, &ic)) {+ setivalue(ra, luaV_shiftl(ib, ic));+ }+ else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_SHL)); }+ vmbreak;+ }+ vmcase(OP_SHR) {+ TValue *rb = RKB(i);+ TValue *rc = RKC(i);+ lua_Integer ib; lua_Integer ic;+ if (tointeger(rb, &ib) && tointeger(rc, &ic)) {+ setivalue(ra, luaV_shiftl(ib, -ic));+ }+ else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_SHR)); }+ vmbreak;+ }+ vmcase(OP_MOD) {+ TValue *rb = RKB(i);+ TValue *rc = RKC(i);+ lua_Number nb; lua_Number nc;+ if (ttisinteger(rb) && ttisinteger(rc)) {+ lua_Integer ib = ivalue(rb); lua_Integer ic = ivalue(rc);+ setivalue(ra, luaV_mod(L, ib, ic));+ }+ else if (tonumber(rb, &nb) && tonumber(rc, &nc)) {+ lua_Number m;+ luai_nummod(L, nb, nc, m);+ setfltvalue(ra, m);+ }+ else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_MOD)); }+ vmbreak;+ }+ vmcase(OP_IDIV) { /* floor division */+ TValue *rb = RKB(i);+ TValue *rc = RKC(i);+ lua_Number nb; lua_Number nc;+ if (ttisinteger(rb) && ttisinteger(rc)) {+ lua_Integer ib = ivalue(rb); lua_Integer ic = ivalue(rc);+ setivalue(ra, luaV_div(L, ib, ic));+ }+ else if (tonumber(rb, &nb) && tonumber(rc, &nc)) {+ setfltvalue(ra, luai_numidiv(L, nb, nc));+ }+ else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_IDIV)); }+ vmbreak;+ }+ vmcase(OP_POW) {+ TValue *rb = RKB(i);+ TValue *rc = RKC(i);+ lua_Number nb; lua_Number nc;+ if (tonumber(rb, &nb) && tonumber(rc, &nc)) {+ setfltvalue(ra, luai_numpow(L, nb, nc));+ }+ else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_POW)); }+ vmbreak;+ }+ vmcase(OP_UNM) {+ TValue *rb = RB(i);+ lua_Number nb;+ if (ttisinteger(rb)) {+ lua_Integer ib = ivalue(rb);+ setivalue(ra, intop(-, 0, ib));+ }+ else if (tonumber(rb, &nb)) {+ setfltvalue(ra, luai_numunm(L, nb));+ }+ else {+ Protect(luaT_trybinTM(L, rb, rb, ra, TM_UNM));+ }+ vmbreak;+ }+ vmcase(OP_BNOT) {+ TValue *rb = RB(i);+ lua_Integer ib;+ if (tointeger(rb, &ib)) {+ setivalue(ra, intop(^, ~l_castS2U(0), ib));+ }+ else {+ Protect(luaT_trybinTM(L, rb, rb, ra, TM_BNOT));+ }+ vmbreak;+ }+ vmcase(OP_NOT) {+ TValue *rb = RB(i);+ int res = l_isfalse(rb); /* next assignment may change this value */+ setbvalue(ra, res);+ vmbreak;+ }+ vmcase(OP_LEN) {+ Protect(luaV_objlen(L, ra, RB(i)));+ vmbreak;+ }+ vmcase(OP_CONCAT) {+ int b = GETARG_B(i);+ int c = GETARG_C(i);+ StkId rb;+ L->top = base + c + 1; /* mark the end of concat operands */+ Protect(luaV_concat(L, c - b + 1));+ ra = RA(i); /* 'luaV_concat' may invoke TMs and move the stack */+ rb = base + b;+ setobjs2s(L, ra, rb);+ checkGC(L, (ra >= rb ? ra + 1 : rb));+ L->top = ci->top; /* restore top */+ vmbreak;+ }+ vmcase(OP_JMP) {+ dojump(ci, i, 0);+ vmbreak;+ }+ vmcase(OP_EQ) {+ TValue *rb = RKB(i);+ TValue *rc = RKC(i);+ Protect(+ if (luaV_equalobj(L, rb, rc) != GETARG_A(i))+ ci->u.l.savedpc++;+ else+ donextjump(ci);+ )+ vmbreak;+ }+ vmcase(OP_LT) {+ Protect(+ if (luaV_lessthan(L, RKB(i), RKC(i)) != GETARG_A(i))+ ci->u.l.savedpc++;+ else+ donextjump(ci);+ )+ vmbreak;+ }+ vmcase(OP_LE) {+ Protect(+ if (luaV_lessequal(L, RKB(i), RKC(i)) != GETARG_A(i))+ ci->u.l.savedpc++;+ else+ donextjump(ci);+ )+ vmbreak;+ }+ vmcase(OP_TEST) {+ if (GETARG_C(i) ? l_isfalse(ra) : !l_isfalse(ra))+ ci->u.l.savedpc++;+ else+ donextjump(ci);+ vmbreak;+ }+ vmcase(OP_TESTSET) {+ TValue *rb = RB(i);+ if (GETARG_C(i) ? l_isfalse(rb) : !l_isfalse(rb))+ ci->u.l.savedpc++;+ else {+ setobjs2s(L, ra, rb);+ donextjump(ci);+ }+ vmbreak;+ }+ vmcase(OP_CALL) {+ int b = GETARG_B(i);+ int nresults = GETARG_C(i) - 1;+ if (b != 0) L->top = ra+b; /* else previous instruction set top */+ if (luaD_precall(L, ra, nresults)) { /* C function? */+ if (nresults >= 0)+ L->top = ci->top; /* adjust results */+ Protect((void)0); /* update 'base' */+ }+ else { /* Lua function */+ ci = L->ci;+ goto newframe; /* restart luaV_execute over new Lua function */+ }+ vmbreak;+ }+ vmcase(OP_TAILCALL) {+ int b = GETARG_B(i);+ if (b != 0) L->top = ra+b; /* else previous instruction set top */+ lua_assert(GETARG_C(i) - 1 == LUA_MULTRET);+ if (luaD_precall(L, ra, LUA_MULTRET)) { /* C function? */+ Protect((void)0); /* update 'base' */+ }+ else {+ /* tail call: put called frame (n) in place of caller one (o) */+ CallInfo *nci = L->ci; /* called frame */+ CallInfo *oci = nci->previous; /* caller frame */+ StkId nfunc = nci->func; /* called function */+ StkId ofunc = oci->func; /* caller function */+ /* last stack slot filled by 'precall' */+ StkId lim = nci->u.l.base + getproto(nfunc)->numparams;+ int aux;+ /* close all upvalues from previous call */+ if (cl->p->sizep > 0) luaF_close(L, oci->u.l.base);+ /* move new frame into old one */+ for (aux = 0; nfunc + aux < lim; aux++)+ setobjs2s(L, ofunc + aux, nfunc + aux);+ oci->u.l.base = ofunc + (nci->u.l.base - nfunc); /* correct base */+ oci->top = L->top = ofunc + (L->top - nfunc); /* correct top */+ oci->u.l.savedpc = nci->u.l.savedpc;+ oci->callstatus |= CIST_TAIL; /* function was tail called */+ ci = L->ci = oci; /* remove new frame */+ lua_assert(L->top == oci->u.l.base + getproto(ofunc)->maxstacksize);+ goto newframe; /* restart luaV_execute over new Lua function */+ }+ vmbreak;+ }+ vmcase(OP_RETURN) {+ int b = GETARG_B(i);+ if (cl->p->sizep > 0) luaF_close(L, base);+ b = luaD_poscall(L, ci, ra, (b != 0 ? b - 1 : cast_int(L->top - ra)));+ if (ci->callstatus & CIST_FRESH) /* local 'ci' still from callee */+ return; /* external invocation: return */+ else { /* invocation via reentry: continue execution */+ ci = L->ci;+ if (b) L->top = ci->top;+ lua_assert(isLua(ci));+ lua_assert(GET_OPCODE(*((ci)->u.l.savedpc - 1)) == OP_CALL);+ goto newframe; /* restart luaV_execute over new Lua function */+ }+ }+ vmcase(OP_FORLOOP) {+ if (ttisinteger(ra)) { /* integer loop? */+ lua_Integer step = ivalue(ra + 2);+ lua_Integer idx = intop(+, ivalue(ra), step); /* increment index */+ lua_Integer limit = ivalue(ra + 1);+ if ((0 < step) ? (idx <= limit) : (limit <= idx)) {+ ci->u.l.savedpc += GETARG_sBx(i); /* jump back */+ chgivalue(ra, idx); /* update internal index... */+ setivalue(ra + 3, idx); /* ...and external index */+ }+ }+ else { /* floating loop */+ lua_Number step = fltvalue(ra + 2);+ lua_Number idx = luai_numadd(L, fltvalue(ra), step); /* inc. index */+ lua_Number limit = fltvalue(ra + 1);+ if (luai_numlt(0, step) ? luai_numle(idx, limit)+ : luai_numle(limit, idx)) {+ ci->u.l.savedpc += GETARG_sBx(i); /* jump back */+ chgfltvalue(ra, idx); /* update internal index... */+ setfltvalue(ra + 3, idx); /* ...and external index */+ }+ }+ vmbreak;+ }+ vmcase(OP_FORPREP) {+ TValue *init = ra;+ TValue *plimit = ra + 1;+ TValue *pstep = ra + 2;+ lua_Integer ilimit;+ int stopnow;+ if (ttisinteger(init) && ttisinteger(pstep) &&+ forlimit(plimit, &ilimit, ivalue(pstep), &stopnow)) {+ /* all values are integer */+ lua_Integer initv = (stopnow ? 0 : ivalue(init));+ setivalue(plimit, ilimit);+ setivalue(init, intop(-, initv, ivalue(pstep)));+ }+ else { /* try making all values floats */+ lua_Number ninit; lua_Number nlimit; lua_Number nstep;+ if (!tonumber(plimit, &nlimit))+ luaG_runerror(L, "'for' limit must be a number");+ setfltvalue(plimit, nlimit);+ if (!tonumber(pstep, &nstep))+ luaG_runerror(L, "'for' step must be a number");+ setfltvalue(pstep, nstep);+ if (!tonumber(init, &ninit))+ luaG_runerror(L, "'for' initial value must be a number");+ setfltvalue(init, luai_numsub(L, ninit, nstep));+ }+ ci->u.l.savedpc += GETARG_sBx(i);+ vmbreak;+ }+ vmcase(OP_TFORCALL) {+ StkId cb = ra + 3; /* call base */+ setobjs2s(L, cb+2, ra+2);+ setobjs2s(L, cb+1, ra+1);+ setobjs2s(L, cb, ra);+ L->top = cb + 3; /* func. + 2 args (state and index) */+ Protect(luaD_call(L, cb, GETARG_C(i)));+ L->top = ci->top;+ i = *(ci->u.l.savedpc++); /* go to next instruction */+ ra = RA(i);+ lua_assert(GET_OPCODE(i) == OP_TFORLOOP);+ goto l_tforloop;+ }+ vmcase(OP_TFORLOOP) {+ l_tforloop:+ if (!ttisnil(ra + 1)) { /* continue loop? */+ setobjs2s(L, ra, ra + 1); /* save control variable */+ ci->u.l.savedpc += GETARG_sBx(i); /* jump back */+ }+ vmbreak;+ }+ vmcase(OP_SETLIST) {+ int n = GETARG_B(i);+ int c = GETARG_C(i);+ unsigned int last;+ Table *h;+ if (n == 0) n = cast_int(L->top - ra) - 1;+ if (c == 0) {+ lua_assert(GET_OPCODE(*ci->u.l.savedpc) == OP_EXTRAARG);+ c = GETARG_Ax(*ci->u.l.savedpc++);+ }+ h = hvalue(ra);+ last = ((c-1)*LFIELDS_PER_FLUSH) + n;+ if (last > h->sizearray) /* needs more space? */+ luaH_resizearray(L, h, last); /* preallocate it at once */+ for (; n > 0; n--) {+ TValue *val = ra+n;+ luaH_setint(L, h, last--, val);+ luaC_barrierback(L, h, val);+ }+ L->top = ci->top; /* correct top (in case of previous open call) */+ vmbreak;+ }+ vmcase(OP_CLOSURE) {+ Proto *p = cl->p->p[GETARG_Bx(i)];+ LClosure *ncl = getcached(p, cl->upvals, base); /* cached closure */+ if (ncl == NULL) /* no match? */+ pushclosure(L, p, cl->upvals, base, ra); /* create a new one */+ else+ setclLvalue(L, ra, ncl); /* push cashed closure */+ checkGC(L, ra + 1);+ vmbreak;+ }+ vmcase(OP_VARARG) {+ int b = GETARG_B(i) - 1; /* required results */+ int j;+ int n = cast_int(base - ci->func) - cl->p->numparams - 1;+ if (n < 0) /* less arguments than parameters? */+ n = 0; /* no vararg arguments */+ if (b < 0) { /* B == 0? */+ b = n; /* get all var. arguments */+ Protect(luaD_checkstack(L, n));+ ra = RA(i); /* previous call may change the stack */+ L->top = ra + n;+ }+ for (j = 0; j < b && j < n; j++)+ setobjs2s(L, ra + j, base - n + j);+ for (; j < b; j++) /* complete required results with nil */+ setnilvalue(ra + j);+ vmbreak;+ }+ vmcase(OP_EXTRAARG) {+ lua_assert(0);+ vmbreak;+ }+ }+ }+}++/* }================================================================== */+
+ cbits/lua-5.3.6/lvm.h view
@@ -0,0 +1,113 @@+/*+** $Id: lvm.h,v 2.41.1.1 2017/04/19 17:20:42 roberto Exp $+** Lua virtual machine+** See Copyright Notice in lua.h+*/++#ifndef lvm_h+#define lvm_h+++#include "ldo.h"+#include "lobject.h"+#include "ltm.h"+++#if !defined(LUA_NOCVTN2S)+#define cvt2str(o) ttisnumber(o)+#else+#define cvt2str(o) 0 /* no conversion from numbers to strings */+#endif+++#if !defined(LUA_NOCVTS2N)+#define cvt2num(o) ttisstring(o)+#else+#define cvt2num(o) 0 /* no conversion from strings to numbers */+#endif+++/*+** You can define LUA_FLOORN2I if you want to convert floats to integers+** by flooring them (instead of raising an error if they are not+** integral values)+*/+#if !defined(LUA_FLOORN2I)+#define LUA_FLOORN2I 0+#endif+++#define tonumber(o,n) \+ (ttisfloat(o) ? (*(n) = fltvalue(o), 1) : luaV_tonumber_(o,n))++#define tointeger(o,i) \+ (ttisinteger(o) ? (*(i) = ivalue(o), 1) : luaV_tointeger(o,i,LUA_FLOORN2I))++#define intop(op,v1,v2) l_castU2S(l_castS2U(v1) op l_castS2U(v2))++#define luaV_rawequalobj(t1,t2) luaV_equalobj(NULL,t1,t2)+++/*+** fast track for 'gettable': if 't' is a table and 't[k]' is not nil,+** return 1 with 'slot' pointing to 't[k]' (final result). Otherwise,+** return 0 (meaning it will have to check metamethod) with 'slot'+** pointing to a nil 't[k]' (if 't' is a table) or NULL (otherwise).+** 'f' is the raw get function to use.+*/+#define luaV_fastget(L,t,k,slot,f) \+ (!ttistable(t) \+ ? (slot = NULL, 0) /* not a table; 'slot' is NULL and result is 0 */ \+ : (slot = f(hvalue(t), k), /* else, do raw access */ \+ !ttisnil(slot))) /* result not nil? */++/*+** standard implementation for 'gettable'+*/+#define luaV_gettable(L,t,k,v) { const TValue *slot; \+ if (luaV_fastget(L,t,k,slot,luaH_get)) { setobj2s(L, v, slot); } \+ else luaV_finishget(L,t,k,v,slot); }+++/*+** Fast track for set table. If 't' is a table and 't[k]' is not nil,+** call GC barrier, do a raw 't[k]=v', and return true; otherwise,+** return false with 'slot' equal to NULL (if 't' is not a table) or+** 'nil'. (This is needed by 'luaV_finishget'.) Note that, if the macro+** returns true, there is no need to 'invalidateTMcache', because the+** call is not creating a new entry.+*/+#define luaV_fastset(L,t,k,slot,f,v) \+ (!ttistable(t) \+ ? (slot = NULL, 0) \+ : (slot = f(hvalue(t), k), \+ ttisnil(slot) ? 0 \+ : (luaC_barrierback(L, hvalue(t), v), \+ setobj2t(L, cast(TValue *,slot), v), \+ 1)))+++#define luaV_settable(L,t,k,v) { const TValue *slot; \+ if (!luaV_fastset(L,t,k,slot,luaH_get,v)) \+ luaV_finishset(L,t,k,v,slot); }++++LUAI_FUNC int luaV_equalobj (lua_State *L, const TValue *t1, const TValue *t2);+LUAI_FUNC int luaV_lessthan (lua_State *L, const TValue *l, const TValue *r);+LUAI_FUNC int luaV_lessequal (lua_State *L, const TValue *l, const TValue *r);+LUAI_FUNC int luaV_tonumber_ (const TValue *obj, lua_Number *n);+LUAI_FUNC int luaV_tointeger (const TValue *obj, lua_Integer *p, int mode);+LUAI_FUNC void luaV_finishget (lua_State *L, const TValue *t, TValue *key,+ StkId val, const TValue *slot);+LUAI_FUNC void luaV_finishset (lua_State *L, const TValue *t, TValue *key,+ StkId val, const TValue *slot);+LUAI_FUNC void luaV_finishOp (lua_State *L);+LUAI_FUNC void luaV_execute (lua_State *L);+LUAI_FUNC void luaV_concat (lua_State *L, int total);+LUAI_FUNC lua_Integer luaV_div (lua_State *L, lua_Integer x, lua_Integer y);+LUAI_FUNC lua_Integer luaV_mod (lua_State *L, lua_Integer x, lua_Integer y);+LUAI_FUNC lua_Integer luaV_shiftl (lua_Integer x, lua_Integer y);+LUAI_FUNC void luaV_objlen (lua_State *L, StkId ra, const TValue *rb);++#endif
+ cbits/lua-5.3.6/lzio.c view
@@ -0,0 +1,68 @@+/*+** $Id: lzio.c,v 1.37.1.1 2017/04/19 17:20:42 roberto Exp $+** Buffered streams+** See Copyright Notice in lua.h+*/++#define lzio_c+#define LUA_CORE++#include "lprefix.h"+++#include <string.h>++#include "lua.h"++#include "llimits.h"+#include "lmem.h"+#include "lstate.h"+#include "lzio.h"+++int luaZ_fill (ZIO *z) {+ size_t size;+ lua_State *L = z->L;+ const char *buff;+ lua_unlock(L);+ buff = z->reader(L, z->data, &size);+ lua_lock(L);+ if (buff == NULL || size == 0)+ return EOZ;+ z->n = size - 1; /* discount char being returned */+ z->p = buff;+ return cast_uchar(*(z->p++));+}+++void luaZ_init (lua_State *L, ZIO *z, lua_Reader reader, void *data) {+ z->L = L;+ z->reader = reader;+ z->data = data;+ z->n = 0;+ z->p = NULL;+}+++/* --------------------------------------------------------------- read --- */+size_t luaZ_read (ZIO *z, void *b, size_t n) {+ while (n) {+ size_t m;+ if (z->n == 0) { /* no bytes in buffer? */+ if (luaZ_fill(z) == EOZ) /* try to read more */+ return n; /* no more input; return number of missing bytes */+ else {+ z->n++; /* luaZ_fill consumed first byte; put it back */+ z->p--;+ }+ }+ m = (n <= z->n) ? n : z->n; /* min. between n and z->n */+ memcpy(b, z->p, m);+ z->n -= m;+ z->p += m;+ b = (char *)b + m;+ n -= m;+ }+ return 0;+}+
+ cbits/lua-5.3.6/lzio.h view
@@ -0,0 +1,66 @@+/*+** $Id: lzio.h,v 1.31.1.1 2017/04/19 17:20:42 roberto Exp $+** Buffered streams+** See Copyright Notice in lua.h+*/+++#ifndef lzio_h+#define lzio_h++#include "lua.h"++#include "lmem.h"+++#define EOZ (-1) /* end of stream */++typedef struct Zio ZIO;++#define zgetc(z) (((z)->n--)>0 ? cast_uchar(*(z)->p++) : luaZ_fill(z))+++typedef struct Mbuffer {+ char *buffer;+ size_t n;+ size_t buffsize;+} Mbuffer;++#define luaZ_initbuffer(L, buff) ((buff)->buffer = NULL, (buff)->buffsize = 0)++#define luaZ_buffer(buff) ((buff)->buffer)+#define luaZ_sizebuffer(buff) ((buff)->buffsize)+#define luaZ_bufflen(buff) ((buff)->n)++#define luaZ_buffremove(buff,i) ((buff)->n -= (i))+#define luaZ_resetbuffer(buff) ((buff)->n = 0)+++#define luaZ_resizebuffer(L, buff, size) \+ ((buff)->buffer = luaM_reallocvchar(L, (buff)->buffer, \+ (buff)->buffsize, size), \+ (buff)->buffsize = size)++#define luaZ_freebuffer(L, buff) luaZ_resizebuffer(L, buff, 0)+++LUAI_FUNC void luaZ_init (lua_State *L, ZIO *z, lua_Reader reader,+ void *data);+LUAI_FUNC size_t luaZ_read (ZIO* z, void *b, size_t n); /* read next n bytes */++++/* --------- Private Part ------------------ */++struct Zio {+ size_t n; /* bytes still unread */+ const char *p; /* current position in buffer */+ lua_Reader reader; /* reader function */+ void *data; /* additional data */+ lua_State *L; /* Lua state (for reader) */+};+++LUAI_FUNC int luaZ_fill (ZIO *z);++#endif
+ lua.cabal view
@@ -0,0 +1,200 @@+cabal-version: 2.2+name: lua+version: 1.0.0+synopsis: Lua, an embeddable scripting language+description: This package provides bindings and types to bridge+ Haskell and <https://www.lua.org/ Lua>.+ .+ The full Lua interpreter version 5.3.6 is included.+ Alternatively, a system-wide Lua installation can be+ linked instead.+homepage: https://hslua.github.io/+bug-reports: https://github.com/hslua/hslua/issues+license: MIT+license-file: LICENSE+author: Albert Krewinkel+maintainer: Albert Krewinkel <albert+hslua@zeitkraut.de>+copyright: © 2007–2012 Gracjan Polak;+ © 2012–2016 Ömer Sinan Ağacan;+ © 2017-2021 Albert Krewinkel+category: Foreign+build-type: Simple+extra-source-files: cbits/lua-5.3.6/*.h+ , cbits/hslua/*.h+ , README.md+ , CHANGELOG.md+tested-with: GHC == 8.0.2+ , GHC == 8.2.2+ , GHC == 8.4.4+ , GHC == 8.6.5+ , GHC == 8.8.4+ , GHC == 8.10.2++source-repository head+ type: git+ location: https://github.com/hslua/hslua.git+ subdir: lua++flag system-lua+ default: False+ manual: True+ description: Use the system-wide Lua instead of the bundled copy.++flag apicheck+ default: False+ manual: True+ description: Compile Lua with -DLUA_USE_APICHECK.++flag lua_32bits+ default: False+ manual: True+ description: Compile Lua with -DLUA_32BITS++flag allow-unsafe-gc+ default: True+ manual: True+ description: Allow optimizations which make Lua's garbage collection+ potentially unsafe; enabling this should be safe if+ there are no callbacks into Haskell during Lua garbage+ collection cycles. The flag should be *disabled* if Lua+ objects can have Haskell finalizers, i.e., @__gc@+ metamethods that call Haskell function.++flag export-dynamic+ default: True+ manual: True+ description: Add all symbols to dynamic symbol table; disabling this+ will make it possible to create fully static binaries,+ but renders loading of dynamic C libraries impossible.++flag pkg-config+ default: False+ manual: True+ description: Use @pkg-config@ to discover library and include paths.+ Setting this flag implies `system-lua`.++flag hardcode-reg-keys+ default: True+ manual: True+ description: Don't use CAPI to determine the names of certain+ registry key names but use hard coded values instead.+ This flag is required when compiling against Lua 5.3.3+ or earlier, as those versions do not expose the+ necessary information in the @lauxlib.h@ header file.+ Setting this flag should usually be unproblematic,+ except if the used Lua version has been patched+ heavily.++common common-options+ default-language: Haskell2010+ build-depends: base >= 4.8 && < 5+ , bytestring >= 0.10.2 && < 0.11+ ghc-options: -Wall+ -Wincomplete-record-updates+ -Wnoncanonical-monad-instances+ -Wredundant-constraints+ if impl(ghc >= 8.2)+ ghc-options: -Wcpp-undef+ -Werror=missing-home-modules+ if impl(ghc >= 8.4)+ ghc-options: -Widentities+ -Wincomplete-uni-patterns+ -Wpartial-fields+ -fhide-source-paths++library+ import: common-options+ exposed-modules: Foreign.Lua.Raw.Auxiliary+ , Foreign.Lua.Raw.Call+ , Foreign.Lua.Raw.Constants+ , Foreign.Lua.Raw.Error+ , Foreign.Lua.Raw.Functions+ , Foreign.Lua.Raw.Types+ , Foreign.Lua.Raw.Userdata+ hs-source-dirs: src+ default-extensions: CApiFFI+ , ForeignFunctionInterface+ , LambdaCase+ other-extensions: CPP+ , DeriveGeneric+ , GeneralizedNewtypeDeriving+ c-sources: cbits/hslua/hsludata.c+ , cbits/hslua/hslcall.c+ , cbits/hslua/hslua.c+ include-dirs: cbits/hslua+ if flag(system-lua) || flag(pkg-config)+ if flag(pkg-config)+ pkgconfig-depends: lua5.3+ else+ extra-libraries: lua+ includes: lua.h+ else+ include-dirs: cbits/lua-5.3.6+ c-sources: cbits/lua-5.3.6/lapi.c+ , cbits/lua-5.3.6/lcode.c+ , cbits/lua-5.3.6/lctype.c+ , cbits/lua-5.3.6/ldebug.c+ , cbits/lua-5.3.6/ldo.c+ , cbits/lua-5.3.6/ldump.c+ , cbits/lua-5.3.6/lfunc.c+ , cbits/lua-5.3.6/lgc.c+ , cbits/lua-5.3.6/llex.c+ , cbits/lua-5.3.6/lmem.c+ , cbits/lua-5.3.6/lobject.c+ , cbits/lua-5.3.6/lopcodes.c+ , cbits/lua-5.3.6/lparser.c+ , cbits/lua-5.3.6/lstate.c+ , cbits/lua-5.3.6/lstring.c+ , cbits/lua-5.3.6/ltable.c+ , cbits/lua-5.3.6/ltm.c+ , cbits/lua-5.3.6/lundump.c+ , cbits/lua-5.3.6/lvm.c+ , cbits/lua-5.3.6/lzio.c++ , cbits/lua-5.3.6/lauxlib.c+ , cbits/lua-5.3.6/lbaselib.c+ , cbits/lua-5.3.6/lbitlib.c+ , cbits/lua-5.3.6/lcorolib.c+ , cbits/lua-5.3.6/ldblib.c+ , cbits/lua-5.3.6/liolib.c+ , cbits/lua-5.3.6/lmathlib.c+ , cbits/lua-5.3.6/lstrlib.c+ , cbits/lua-5.3.6/loslib.c+ , cbits/lua-5.3.6/ltablib.c+ , cbits/lua-5.3.6/lutf8lib.c+ , cbits/lua-5.3.6/loadlib.c+ , cbits/lua-5.3.6/linit.c++ if os(linux)+ cc-options: -DLUA_USE_LINUX+ if flag(export-dynamic)+ ld-options: -Wl,-E++ if os(darwin)+ cc-options: -DLUA_USE_MACOSX++ if os(freebsd)+ cc-options: -DLUA_USE_POSIX+ if flag(export-dynamic)+ ld-options: -Wl,-E++ if flag(lua_32bits)+ cc-options: -DLUA_32BITS++ if flag(apicheck)+ cc-options: -DLUA_USE_APICHECK++ if flag(allow-unsafe-gc)+ cpp-options: -DALLOW_UNSAFE_GC++ if flag(hardcode-reg-keys)+ cpp-options: -DHARDCODE_REG_KEYS++test-suite test-lua+ import: common-options+ type: exitcode-stdio-1.0+ main-is: test-lua.hs+ hs-source-dirs: test+ build-depends: lua+ , tasty >= 0.11+ , tasty-hunit >= 0.9
+ src/Foreign/Lua/Raw/Auxiliary.hs view
@@ -0,0 +1,133 @@+{-# LANGUAGE CPP #-}+{-|+Module : Foreign.Lua.Raw.Auxiliary+Copyright : © 2007–2012 Gracjan Polak;+ © 2012–2016 Ömer Sinan Ağacan;+ © 2017-2021 Albert Krewinkel+License : MIT+Maintainer : Albert Krewinkel <tarleb+hslua@zeitkraut.de>+Stability : beta+Portability : non-portable (depends on GHC)++Raw bindings to functions and constants of the auxiliary library.+-}+module Foreign.Lua.Raw.Auxiliary+ ( hsluaL_newstate+ , hsluaL_tolstring+ , luaL_getmetafield+ , luaL_getmetatable+ , luaL_loadbuffer+ , luaL_newmetatable+ , luaL_ref+ , luaL_testudata+ , luaL_traceback+ , luaL_unref+ -- * Registry fields+ , loadedTableRegistryField+ , preloadTableRegistryField+ -- * References+ , Reference (..)+ , fromReference+ , toReference+ ) where++import Foreign.C (CChar, CInt (CInt), CSize (CSize), CString)+import Foreign.Lua.Raw.Types (StackIndex)+import Foreign.Ptr+import qualified Foreign.Lua.Raw.Types as Lua++#ifndef HARDCODE_REG_KEYS+import System.IO.Unsafe (unsafePerformIO)+import qualified Foreign.C as C+#endif++#ifdef ALLOW_UNSAFE_GC+#define SAFTY unsafe+#else+#define SAFTY safe+#endif++-- * The Auxiliary Library++-- | Key, in the registry, for table of loaded modules.+loadedTableRegistryField :: String+#ifdef HARDCODE_REG_KEYS+loadedTableRegistryField = "_LOADED"+#else+loadedTableRegistryField = unsafePerformIO (C.peekCString c_loaded_table)+{-# NOINLINE loadedTableRegistryField #-}++foreign import capi unsafe "lauxlib.h value LUA_LOADED_TABLE"+ c_loaded_table :: CString+#endif++-- | Key, in the registry, for table of preloaded loaders.+preloadTableRegistryField :: String+#ifdef HARDCODE_REG_KEYS+preloadTableRegistryField = "_PRELOAD"+#else+preloadTableRegistryField = unsafePerformIO (C.peekCString c_preload_table)+{-# NOINLINE preloadTableRegistryField #-}++foreign import capi unsafe "lauxlib.h value LUA_PRELOAD_TABLE"+ c_preload_table :: CString+#endif++foreign import capi SAFTY "lauxlib.h luaL_getmetafield"+ luaL_getmetafield :: Lua.State -> StackIndex -> CString -> IO Lua.TypeCode++foreign import capi SAFTY "lauxlib.h luaL_getmetatable"+ luaL_getmetatable :: Lua.State -> CString -> IO Lua.TypeCode++foreign import capi SAFTY "lauxlib.h luaL_loadbuffer"+ luaL_loadbuffer :: Lua.State -> Ptr CChar -> CSize -> CString+ -> IO Lua.StatusCode++foreign import ccall SAFTY "lauxlib.h luaL_newmetatable"+ luaL_newmetatable :: Lua.State -> CString -> IO Lua.LuaBool++foreign import ccall unsafe "lauxlib.h hsluaL_newstate"+ hsluaL_newstate :: IO Lua.State++foreign import ccall SAFTY "lauxlib.h luaL_ref"+ luaL_ref :: Lua.State -> StackIndex -> IO CInt++foreign import ccall safe "hslua.h hsluaL_tolstring"+ hsluaL_tolstring :: Lua.State -> StackIndex -> Ptr CSize -> IO (Ptr CChar)++foreign import capi SAFTY "lauxlib.h luaL_traceback"+ luaL_traceback :: Lua.State -> Lua.State -> CString -> CInt -> IO ()++foreign import ccall SAFTY "lauxlib.h luaL_unref"+ luaL_unref :: Lua.State -> StackIndex -> CInt -> IO ()++-- | See+-- <https://www.lua.org/manual/5.3/manual.html#luaL_testudata luaL_testudata>+foreign import capi SAFTY "lauxlib.h luaL_testudata"+ luaL_testudata :: Lua.State -> StackIndex -> CString -> IO (Ptr ())++--+-- References+--++-- | Reference to a stored value.+data Reference =+ Reference CInt -- ^ Reference to a stored value+ | RefNil -- ^ Reference to a nil value+ deriving (Eq, Show)++foreign import capi SAFTY "lauxlib.h value LUA_REFNIL"+ refnil :: CInt++-- | Convert a reference to its C representation.+fromReference :: Reference -> CInt+fromReference = \case+ Reference x -> x+ RefNil -> refnil++-- | Create a reference from its C representation.+toReference :: CInt -> Reference+toReference x =+ if x == refnil+ then RefNil+ else Reference x
+ src/Foreign/Lua/Raw/Call.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE CPP #-}+{-|+Module : Foreign.Lua.Raw.Call+Copyright : © 2007–2012 Gracjan Polak;+ © 2012–2016 Ömer Sinan Ağacan;+ © 2017-2021 Albert Krewinkel+License : MIT+Maintainer : Albert Krewinkel <tarleb+hslua@zeitkraut.de>+Stability : beta+Portability : non-portable (depends on GHC)++Raw bindings to function call helpers.+-}+module Foreign.Lua.Raw.Call+ ( HsFunction+ , hslua_newhsfunction+ , hslua_pushhsfunction+ ) where++import Foreign.C (CInt (CInt))+import Foreign.Ptr (Ptr, castPtr, nullPtr)+import Foreign.StablePtr (StablePtr, deRefStablePtr, newStablePtr)+import Foreign.Storable (peek)+import Foreign.Lua.Raw.Types+ ( NumResults (NumResults)+ , State (State)+ )++#ifdef ALLOW_UNSAFE_GC+#define SAFTY unsafe+#else+#define SAFTY safe+#endif++-- | Type of raw Haskell functions that can be made into+-- 'CFunction's.+type HsFunction = State -> IO NumResults++-- | Retrieve the pointer to a Haskell function from the wrapping+-- userdata object.+foreign import ccall SAFTY "hslua.h hslua_hs_fun_ptr"+ hslua_hs_fun_ptr :: State -> IO (Ptr ())++-- | Pushes a new C function created from an 'HsFunction'.+foreign import ccall SAFTY "hslua.h hslua_newhsfunction"+ hslua_newhsfunction :: State -> StablePtr a -> IO ()++hslua_pushhsfunction :: State -> HsFunction -> IO ()+hslua_pushhsfunction l preCFn =+ newStablePtr preCFn >>= hslua_newhsfunction l+{-# INLINABLE hslua_pushhsfunction #-}++-- | Call the Haskell function stored in the userdata. This+-- function is exported as a C function, as the C code uses it as+-- the @__call@ value of the wrapping userdata metatable.+hslua_call_wrapped_hs_fun :: HsFunction+hslua_call_wrapped_hs_fun l = do+ udPtr <- hslua_hs_fun_ptr l+ if udPtr == nullPtr+ then error "Cannot call function; corrupted Lua object!"+ else do+ fn <- peek (castPtr udPtr) >>= deRefStablePtr+ fn l++foreign export ccall hslua_call_wrapped_hs_fun :: HsFunction
+ src/Foreign/Lua/Raw/Constants.hs view
@@ -0,0 +1,39 @@+{-|+Module : Foreign.Lua.Raw.Constants+Copyright : © 2007–2012 Gracjan Polak;+ © 2012–2016 Ömer Sinan Ağacan;+ © 2017-2021 Albert Krewinkel+License : MIT+Maintainer : Albert Krewinkel <tarleb+hslua@zeitkraut.de>+Stability : beta+Portability : ForeignFunctionInterface++Lua constants+-}+module Foreign.Lua.Raw.Constants+ ( multret+ , registryindex+ , refnil+ , noref+ ) where++import Foreign.C (CInt (..))+import Foreign.Lua.Raw.Types++-- | Alias for C constant @LUA_MULTRET@. See+-- <https://www.lua.org/manual/5.3/#lua_call lua_call>.+foreign import capi unsafe "lua.h value LUA_MULTRET"+ multret :: NumResults++-- | Alias for C constant @LUA_REGISTRYINDEX@. See+-- <https://www.lua.org/manual/5.3/#3.5 Lua registry>.+foreign import capi unsafe "lua.h value LUA_REGISTRYINDEX"+ registryindex :: StackIndex++-- | Value signaling that no reference was created.+foreign import capi unsafe "lauxlib.h value LUA_REFNIL"+ refnil :: Int++-- | Value signaling that no reference was found.+foreign import capi unsafe "lauxlib.h value LUA_NOREF"+ noref :: Int
+ src/Foreign/Lua/Raw/Error.hs view
@@ -0,0 +1,40 @@+{-|+Module : Foreign.Lua.Raw.Error+Copyright : © 2017-2021 Albert Krewinkel+License : MIT+Maintainer : Albert Krewinkel <tarleb+hslua@zeitkraut.de>+Stability : beta+Portability : portable++Lua exceptions and exception handling.+-}+module Foreign.Lua.Raw.Error+ ( -- * Passing Lua errors to Haskell+ errorMessage+ ) where++import Data.ByteString (ByteString)+import Foreign.Lua.Raw.Auxiliary (hsluaL_tolstring)+import Foreign.Lua.Raw.Functions (lua_pop)+import Foreign.Marshal.Alloc (alloca)+import Foreign.Ptr (nullPtr)++import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as Char8+import qualified Foreign.Storable as Storable+import qualified Foreign.Lua.Raw.Types as Lua++-- | Retrieve and pop the top object as an error message. This is very similar+-- to tostring', but ensures that we don't recurse if getting the message+-- failed.+errorMessage :: Lua.State -> IO ByteString+errorMessage l = alloca $ \lenPtr -> do+ cstr <- hsluaL_tolstring l (-1) lenPtr+ if cstr == nullPtr+ then return $ Char8.pack ("An error occurred, but the error object " +++ "cannot be converted into a string.")+ else do+ cstrLen <- Storable.peek lenPtr+ msg <- B.packCStringLen (cstr, fromIntegral cstrLen)+ lua_pop l 2+ return msg
+ src/Foreign/Lua/Raw/Functions.hs view
@@ -0,0 +1,403 @@+{-# LANGUAGE CPP #-}+{-|+Module : Foreign.Lua.Raw.Functions+Copyright : © 2007–2012 Gracjan Polak;+ © 2012–2016 Ömer Sinan Ağacan;+ © 2017-2021 Albert Krewinkel+License : MIT+Maintainer : Albert Krewinkel <tarleb+hslua@zeitkraut.de>+Stability : beta+Portability : ForeignFunctionInterface, CPP++Haskell bindings to Lua C API functions.++The exposed functions correspond closely to the respective C Lua API+functions. However, C API functions which can throw Lua errors are not+exported directly, as any errors would crash the program. Non-error+throwing @hslua_@ versions are provided instead. The @hslua@ ersatz+functions have worse performance than the original.++Some of the Lua functions may, directly or indirectly, call a Haskell+function, and trigger garbage collection, rescheduling etc. These+functions are always imported safely (i.e., with the @safe@ keyword).++However, all function can trigger garbage collection. If that can lead+to problems, then the package should be configured without flag+@allow-unsafe-gc@.+-}+module Foreign.Lua.Raw.Functions where++import Foreign.C+import Foreign.Lua.Raw.Types as Lua+import Foreign.Ptr++#ifdef ALLOW_UNSAFE_GC+#define SAFTY unsafe+#else+#define SAFTY safe+#endif++-- * State manipulation++-- | Wrapper of @lua_close@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_close>.+foreign import ccall safe "lua.h lua_close"+ lua_close :: Lua.State -> IO ()+++-- * Basic stack manipulation++-- | Wrapper of @lua_absindex@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_absindex>.+foreign import ccall SAFTY "lua.h lua_absindex"+ lua_absindex :: Lua.State -> StackIndex -> IO StackIndex++-- | Wrapper of @lua_gettop@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_gettop>.+foreign import ccall SAFTY "lua.h lua_gettop"+ lua_gettop :: Lua.State -> IO StackIndex++-- | Wrapper of @lua_settop@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_settop>.+foreign import ccall SAFTY "lua.h lua_settop"+ lua_settop :: Lua.State -> StackIndex -> IO ()++-- | Wrapper of @lua_pushvalue@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_pushvalue>.+foreign import ccall SAFTY "lua.h lua_pushvalue"+ lua_pushvalue :: Lua.State -> StackIndex -> IO ()++-- | Wrapper of @lua_pop@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_pop>.+foreign import capi SAFTY "lua.h lua_pop"+ lua_pop :: Lua.State -> StackIndex -> IO ()++-- | Wrapper of @lua_copy@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_copy>.+foreign import ccall SAFTY "lua.h lua_copy"+ lua_copy :: Lua.State -> StackIndex -> StackIndex -> IO ()++-- | Wrapper of @lua_remove@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_remove>.+foreign import capi SAFTY "lua.h lua_remove"+ lua_remove :: Lua.State -> StackIndex -> IO ()++-- | Wrapper of @lua_insert@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_insert>.+foreign import capi SAFTY "lua.h lua_insert"+ lua_insert :: Lua.State -> StackIndex -> IO ()++-- | Wrapper of @lua_replace@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_replace>.+foreign import capi SAFTY "lua.h lua_replace"+ lua_replace :: Lua.State -> StackIndex -> IO ()++-- | Wrapper of @lua_checkstack@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_checkstack>.+foreign import capi SAFTY "lua.h lua_checkstack"+ lua_checkstack :: Lua.State -> CInt -> IO LuaBool+++-- * Access functions (stack -> Haskell)++-- | Wrapper of @lua_isnumber@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_isnumber>.+foreign import ccall SAFTY "lua.h lua_isnumber"+ lua_isnumber :: Lua.State -> StackIndex -> IO LuaBool++-- | Wrapper of @lua_isinteger@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_isinteger>.+foreign import ccall SAFTY "lua.h lua_isinteger"+ lua_isinteger :: Lua.State -> StackIndex -> IO LuaBool++-- | Wrapper of @lua_isstring@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_isstring>.+foreign import ccall SAFTY "lua.h lua_isstring"+ lua_isstring :: Lua.State -> StackIndex -> IO LuaBool++-- | Wrapper of @lua_iscfunction@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_iscfunction>.+foreign import ccall SAFTY "lua.h lua_iscfunction"+ lua_iscfunction :: Lua.State -> StackIndex -> IO LuaBool++-- | Wrapper of @lua_isuserdata@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_isuserdata>.+foreign import ccall SAFTY "lua.h lua_isuserdata"+ lua_isuserdata :: Lua.State -> StackIndex -> IO LuaBool++-- | Wrapper of @lua_type@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_type>.+foreign import ccall SAFTY "lua.h lua_type"+ lua_type :: Lua.State -> StackIndex -> IO TypeCode++-- | Wrapper of @lua_typename@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_typename>.+foreign import ccall SAFTY "lua.h lua_typename"+ lua_typename :: Lua.State -> TypeCode -> IO CString++-- | Wrapper around <https://lua.org/manual/5.3/manual.html#lua_compare \+-- @lua_compare@> which catches any Lua errors.+foreign import capi safe "hslua.h hslua_compare"+ hslua_compare :: Lua.State+ -> StackIndex -> StackIndex -> CInt+ -> Ptr StatusCode -> IO LuaBool++-- | Wrapper of @lua_rawequal@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_rawequal>.+foreign import ccall SAFTY "lua.h lua_rawequal"+ lua_rawequal :: Lua.State -> StackIndex -> StackIndex -> IO LuaBool+++-- | Wrapper of @lua_toboolean@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_toboolean>.+foreign import capi SAFTY "lua.h lua_toboolean"+ lua_toboolean :: Lua.State -> StackIndex -> IO LuaBool++-- | Wrapper of @lua_tocfunction@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_tocfunction>.+foreign import ccall SAFTY "lua.h lua_tocfunction"+ lua_tocfunction :: Lua.State -> StackIndex -> IO CFunction++-- | Wrapper of @lua_tointegerx@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_tointegerx>.+foreign import ccall SAFTY "lua.h lua_tointegerx"+ lua_tointegerx :: Lua.State -> StackIndex -> Ptr LuaBool -> IO Lua.Integer++-- | Wrapper of @lua_tonumberx@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_tonumberx>.+foreign import ccall SAFTY "lua.h lua_tonumberx"+ lua_tonumberx :: Lua.State -> StackIndex -> Ptr LuaBool -> IO Lua.Number++-- | Wrapper of @lua_tolstring@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_tolstring>.+foreign import ccall SAFTY "lua.h lua_tolstring"+ lua_tolstring :: Lua.State -> StackIndex -> Ptr CSize -> IO (Ptr CChar)++-- | Wrapper of @lua_topointer@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_topointer>.+foreign import ccall SAFTY "lua.h lua_topointer"+ lua_topointer :: Lua.State -> StackIndex -> IO (Ptr ())++-- | Wrapper of @lua_tothread@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_tothread>.+foreign import ccall SAFTY "lua.h lua_tothread"+ lua_tothread :: Lua.State -> StackIndex -> IO Lua.State++-- | Wrapper of @lua_touserdata@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_touserdata>.+foreign import ccall SAFTY "lua.h lua_touserdata"+ lua_touserdata :: Lua.State -> StackIndex -> IO (Ptr a)+++-- | Wrapper of @lua_rawlen@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_rawlen>.+foreign import ccall SAFTY "lua.h lua_rawlen"+ lua_rawlen :: Lua.State -> StackIndex -> IO CSize+++-- * Push functions (Haskell -> stack)++-- | Wrapper of @lua_pushnil@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_pushnil>.+foreign import ccall SAFTY "lua.h lua_pushnil"+ lua_pushnil :: Lua.State -> IO ()++-- | Wrapper of @lua_pushnumber@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_pushnumber>.+foreign import ccall SAFTY "lua.h lua_pushnumber"+ lua_pushnumber :: Lua.State -> Lua.Number -> IO ()++-- | Wrapper of @lua_pushinteger@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_pushinteger>.+foreign import ccall SAFTY "lua.h lua_pushinteger"+ lua_pushinteger :: Lua.State -> Lua.Integer -> IO ()++-- | Wrapper of @lua_pushlstring@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_pushlstring>.+foreign import ccall SAFTY "lua.h lua_pushlstring"+ lua_pushlstring :: Lua.State -> Ptr CChar -> CSize -> IO ()++-- | Wrapper of @lua_pushcclosure@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_pushcclosure>.+foreign import ccall SAFTY "lua.h lua_pushcclosure"+ lua_pushcclosure :: Lua.State -> CFunction -> NumArgs -> IO ()++-- | Wrapper of @lua_pushboolean@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_pushboolean>.+foreign import ccall SAFTY "lua.h lua_pushboolean"+ lua_pushboolean :: Lua.State -> LuaBool -> IO ()++-- | Wrapper of @lua_pushlightuserdata@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_pushlightuserdata>.+foreign import ccall SAFTY "lua.h lua_pushlightuserdata"+ lua_pushlightuserdata :: Lua.State -> Ptr a -> IO ()++-- | Wrapper of @lua_pushthread@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_pushthread>.+foreign import ccall SAFTY "lua.h lua_pushthread"+ lua_pushthread :: Lua.State -> IO CInt+++-- * Get functions (Lua -> stack)++-- | Wrapper around+-- <https://lua.org/manual/5.3/manual.html#lua_gettable lua_gettable>.+-- which catches any Lua errors.+foreign import ccall safe "hslua.h hslua_gettable"+ hslua_gettable :: Lua.State -> StackIndex -> Ptr StatusCode -> IO ()++-- | Wrapper of @lua_rawget@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_rawget>.+foreign import ccall SAFTY "lua.h lua_rawget"+ lua_rawget :: Lua.State -> StackIndex -> IO ()++-- | Wrapper of @lua_rawgeti@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_rawgeti>.+foreign import ccall SAFTY "lua.h lua_rawgeti"+ lua_rawgeti :: Lua.State -> StackIndex -> Lua.Integer -> IO ()++-- | Wrapper of @lua_createtable@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_createtable>.+foreign import ccall SAFTY "lua.h lua_createtable"+ lua_createtable :: Lua.State -> CInt -> CInt -> IO ()++-- | Wrapper of @lua_newuserdata@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_newuserdata>.+foreign import ccall SAFTY "lua.h lua_newuserdata"+ lua_newuserdata :: Lua.State -> CSize -> IO (Ptr ())++-- | Wrapper of @lua_getmetatable@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_getmetatable>.+foreign import ccall SAFTY "lua.h lua_getmetatable"+ lua_getmetatable :: Lua.State -> StackIndex -> IO LuaBool++-- | Wrapper around+-- <https://lua.org/manual/5.3/manual.html#lua_getglobal lua_getglobal>+-- which catches any Lua errors.+foreign import ccall safe "hslua.h hslua_getglobal"+ hslua_getglobal :: Lua.State -> CString -> CSize -> Ptr StatusCode -> IO ()+++-- * Set functions (stack -> Lua)++-- | Wrapper around <https://lua.org/manual/5.3/manual.html#lua_settable \+-- @lua_settable@> which catches any Lua errors.+foreign import ccall safe "hslua.h hslua_settable"+ hslua_settable :: Lua.State -> StackIndex -> Ptr StatusCode -> IO ()++-- | Wrapper of @lua_rawset@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_rawset>.+foreign import ccall SAFTY "lua.h lua_rawset"+ lua_rawset :: Lua.State -> StackIndex -> IO ()++-- | Wrapper of @lua_rawseti@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_rawseti>.+foreign import ccall SAFTY "lua.h lua_rawseti"+ lua_rawseti :: Lua.State -> StackIndex -> Lua.Integer -> IO ()++-- | Wrapper of @lua_setmetatable@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_setmetatable>.+foreign import ccall SAFTY "lua.h lua_setmetatable"+ lua_setmetatable :: Lua.State -> StackIndex -> IO ()++-- | Wrapper around <https://lua.org/manual/5.3/manual.html#lua_setglobal \+-- @lua_setglobal@> which catches any Lua errors.+foreign import ccall safe "hslua.h hslua_setglobal"+ hslua_setglobal :: Lua.State -> CString -> CSize -> Ptr StatusCode -> IO ()+++-- * \'load\' and \'call\' functions (load and run Lua code)++-- | Wrapper of @lua_pcall@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_pcall>.+foreign import capi safe "lua.h lua_pcall"+ lua_pcall :: Lua.State -> NumArgs -> NumResults -> StackIndex+ -> IO StatusCode++-- | Wrapper of @lua_load@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_load>.+foreign import ccall safe "lua.h lua_load"+ lua_load :: Lua.State -> Lua.Reader -> Ptr () -> CString -> CString+ -> IO StatusCode+++-- * Coroutine functions++-- | Wrapper of @lua_status@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_status>.+foreign import ccall SAFTY "lua.h lua_status"+ lua_status :: Lua.State -> IO StatusCode+++-- * Garbage-collection functions and options++-- | Wrapper of @lua_gc@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_gc>.+foreign import ccall safe "lua.h lua_gc"+ lua_gc :: Lua.State -> CInt -> CInt -> IO CInt+++-- * Miscellaneous functions++-- | Replacement for+-- <https://lua.org/manual/5.3/manual.html#lua_error lua_error>; it uses+-- the HsLua error signaling convention instead of raw Lua errors.+foreign import ccall SAFTY "hslua.h hslua_error"+ hslua_error :: Lua.State -> IO NumResults++-- | Wrapper around+-- <https://lua.org/manual/5.3/manual.html#lua_next lua_next> which+-- catches any Lua errors.+foreign import ccall safe "hslua.h hslua_next"+ hslua_next :: Lua.State -> StackIndex -> Ptr StatusCode -> IO LuaBool++-- | Wrapper around+-- <https://lua.org/manual/5.3/manual.html#lua_concat lua_concat>+-- which catches any Lua errors.+foreign import ccall safe "hslua.h hslua_concat"+ hslua_concat :: Lua.State -> NumArgs -> Ptr StatusCode -> IO ()++-- | Wrapper of @lua_pushglobaltable@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#lua_pushglobaltable>.+foreign import capi SAFTY "lua.h lua_pushglobaltable"+ lua_pushglobaltable :: Lua.State -> IO ()+++-- * Lua Libraries++-- | Wrapper of @luaL_openlibs@. See the Lua docs at+-- <https://www.lua.org/manual/5.3/manual.html#luaL_openlibs>.+foreign import ccall unsafe "lualib.h luaL_openlibs"+ luaL_openlibs :: Lua.State -> IO ()++-- | Point to function opening the base library.+foreign import ccall unsafe "lualib.h &luaopen_base"+ lua_open_base_ptr :: CFunction++-- | Point to function opening the table library.+foreign import ccall unsafe "lualib.h &luaopen_table"+ lua_open_table_ptr :: CFunction++-- | Point to function opening the io library.+foreign import ccall unsafe "lualib.h &luaopen_io"+ lua_open_io_ptr :: CFunction++-- | Point to function opening the os library.+foreign import ccall unsafe "lualib.h &luaopen_os"+ lua_open_os_ptr :: CFunction++-- | Point to function opening the string library.+foreign import ccall unsafe "lualib.h &luaopen_string"+ lua_open_string_ptr :: CFunction++-- | Point to function opening the math library.+foreign import ccall unsafe "lualib.h &luaopen_math"+ lua_open_math_ptr :: CFunction++-- | Point to function opening the debug library.+foreign import ccall unsafe "lualib.h &luaopen_debug"+ lua_open_debug_ptr :: CFunction++-- | Point to function opening the package library.+foreign import ccall unsafe "lualib.h &luaopen_package"+ lua_open_package_ptr :: CFunction
+ src/Foreign/Lua/Raw/Types.hsc view
@@ -0,0 +1,281 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-|+Module : Foreign.Lua.Raw.Types+Copyright : © 2007–2012 Gracjan Polak;+ © 2012–2016 Ömer Sinan Ağacan;+ © 2017-2021 Albert Krewinkel+License : MIT+Maintainer : Albert Krewinkel <tarleb+hslua@zeitkraut.de>+Stability : beta+Portability : non-portable (depends on GHC)++The core Lua types, including mappings of Lua types to Haskell.+-}+module Foreign.Lua.Raw.Types+ ( State (..)+ , Reader+ , GCCONTROL (..)+ , Type (..)+ , TypeCode (..)+ , fromType+ , toType+ , CFunction+ , LuaBool (..)+ , false+ , true+ , fromLuaBool+ , toLuaBool+ , Integer (..)+ , Number (..)+ , StackIndex (..)+ , NumArgs (..)+ , NumResults (..)+ , RelationalOperator (..)+ , fromRelationalOperator+ , Status (..)+ , StatusCode (..)+ , toStatus+ ) where++#include "lua.h"+-- required only for LUA_ERRFILE+#include "lauxlib.h"++import Prelude hiding (Integer, EQ, LT)++import Data.Int (#{type LUA_INTEGER})+import Foreign.C (CChar, CInt, CSize)+import Foreign.Ptr (FunPtr, Ptr)+import Foreign.Storable (Storable)+import GHC.Generics (Generic)++-- | An opaque structure that points to a thread and indirectly (through the+-- thread) to the whole state of a Lua interpreter. The Lua library is fully+-- reentrant: it has no global variables. All information about a state is+-- accessible through this structure.+--+-- Synonym for @lua_State *@. See <https://www.lua.org/manual/5.3/#lua_State lua_State>.+newtype State = State (Ptr ()) deriving (Eq, Generic)++-- | Type for C functions.+--+-- In order to communicate properly with Lua, a C function must use the+-- following protocol, which defines the way parameters and results are+-- passed: a C function receives its arguments from Lua in its stack in+-- direct order (the first argument is pushed first). So, when the+-- function starts, @'Foreign.Lua.Core.Functions.gettop'@ returns the+-- number of arguments received by the function. The first argument (if+-- any) is at index 1 and its last argument is at index+-- @'Foreign.Lua.Core.Functions.gettop'@. To return values to Lua, a C+-- function just pushes them onto the stack, in direct order (the first+-- result is pushed first), and returns the number of results. Any other+-- value in the stack below the results will be properly discarded by+-- Lua. Like a Lua function, a C function called by Lua can also return+-- many results.+--+-- See <https://www.lua.org/manual/5.3/manual.html#lua_CFunction lua_CFunction>.+type CFunction = FunPtr (State -> IO NumResults)++-- | The reader function used by @'Foreign.Lua.Core.Functions.load'@.+-- Every time it needs another piece of the chunk, lua_load calls the+-- reader, passing along its data parameter. The reader must return a+-- pointer to a block of memory with a new piece of the chunk and set+-- size to the block size. The block must exist until the reader+-- function is called again. To signal the end of the chunk, the reader+-- must return @NULL@ or set size to zero. The reader function may+-- return pieces of any size greater than zero.+--+-- See <https://www.lua.org/manual/5.3/manual.html#lua_Reader lua_Reader>.+type Reader = FunPtr (State -> Ptr () -> Ptr CSize -> IO (Ptr CChar))++-- | The type of integers in Lua.+--+-- By default this type is @'Int64'@, but that can be changed to different+-- values in lua. (See @LUA_INT_TYPE@ in @luaconf.h@.)+--+-- See <https://www.lua.org/manual/5.3/manual.html#lua_Integer lua_Integer>.+newtype Integer = Integer #{type LUA_INTEGER}+ deriving (Bounded, Enum, Eq, Integral, Num, Ord, Real, Show)++-- | The type of floats in Lua.+--+-- By default this type is @'Double'@, but that can be changed in Lua to a+-- single float or a long double. (See @LUA_FLOAT_TYPE@ in @luaconf.h@.)+--+-- See <https://www.lua.org/manual/5.3/manual.html#lua_Number lua_Number>.+newtype Number = Number #{type LUA_NUMBER}+ deriving (Eq, Floating, Fractional, Num, Ord, Real, RealFloat, RealFrac, Show)+++--+-- LuaBool+--++-- | Boolean value returned by a Lua C API function. This is a @'CInt'@ and+-- interpreted as @'False'@ iff the value is @0@, @'True'@ otherwise.+newtype LuaBool = LuaBool CInt+ deriving (Eq, Storable, Show)++-- | Generic Lua representation of a value interpreted as being true.+true :: LuaBool+true = LuaBool 1++-- | Lua representation of the value interpreted as false.+false :: LuaBool+false = LuaBool 0++-- | Convert a @'LuaBool'@ to a Haskell @'Bool'@.+fromLuaBool :: LuaBool -> Bool+fromLuaBool (LuaBool 0) = False+fromLuaBool _ = True+{-# INLINABLE fromLuaBool #-}++-- | Convert a Haskell @'Bool'@ to a @'LuaBool'@.+toLuaBool :: Bool -> LuaBool+toLuaBool True = true+toLuaBool False = false+{-# INLINABLE toLuaBool #-}+++--+-- * Type of Lua values+--++-- | Enumeration used as type tag.+-- See <https://www.lua.org/manual/5.3/manual.html#lua_type lua_type>.+data Type+ = TypeNone -- ^ non-valid stack index+ | TypeNil -- ^ type of lua's @nil@ value+ | TypeBoolean -- ^ type of lua booleans+ | TypeLightUserdata -- ^ type of light userdata+ | TypeNumber -- ^ type of lua numbers. See @'Lua.Number'@+ | TypeString -- ^ type of lua string values+ | TypeTable -- ^ type of lua tables+ | TypeFunction -- ^ type of functions, either normal or @'CFunction'@+ | TypeUserdata -- ^ type of full user data+ | TypeThread -- ^ type of lua threads+ deriving (Bounded, Eq, Ord, Show)++-- | Integer code used to encode the type of a lua value.+newtype TypeCode = TypeCode { fromTypeCode :: CInt }+ deriving (Eq, Ord, Show)++instance Enum Type where+ fromEnum = fromIntegral . fromTypeCode . fromType+ toEnum = toType . TypeCode . fromIntegral++-- | Convert a lua Type to a type code which can be passed to the C API.+fromType :: Type -> TypeCode+fromType tp = TypeCode $ case tp of+ TypeNone -> #{const LUA_TNONE}+ TypeNil -> #{const LUA_TNIL}+ TypeBoolean -> #{const LUA_TBOOLEAN}+ TypeLightUserdata -> #{const LUA_TLIGHTUSERDATA}+ TypeNumber -> #{const LUA_TNUMBER}+ TypeString -> #{const LUA_TSTRING}+ TypeTable -> #{const LUA_TTABLE}+ TypeFunction -> #{const LUA_TFUNCTION}+ TypeUserdata -> #{const LUA_TUSERDATA}+ TypeThread -> #{const LUA_TTHREAD}++-- | Convert numerical code to lua type.+toType :: TypeCode -> Type+toType (TypeCode c) = case c of+ #{const LUA_TNONE} -> TypeNone+ #{const LUA_TNIL} -> TypeNil+ #{const LUA_TBOOLEAN} -> TypeBoolean+ #{const LUA_TLIGHTUSERDATA} -> TypeLightUserdata+ #{const LUA_TNUMBER} -> TypeNumber+ #{const LUA_TSTRING} -> TypeString+ #{const LUA_TTABLE} -> TypeTable+ #{const LUA_TFUNCTION} -> TypeFunction+ #{const LUA_TUSERDATA} -> TypeUserdata+ #{const LUA_TTHREAD} -> TypeThread+ _ -> error ("No Type corresponding to " ++ show c)++--+-- * Relational Operator+--++-- | Lua comparison operations.+data RelationalOperator+ = EQ -- ^ Correponds to lua's equality (==) operator.+ | LT -- ^ Correponds to lua's strictly-lesser-than (<) operator+ | LE -- ^ Correponds to lua's lesser-or-equal (<=) operator+ deriving (Eq, Ord, Show)++-- | Convert relation operator to its C representation.+fromRelationalOperator :: RelationalOperator -> CInt+fromRelationalOperator EQ = #{const LUA_OPEQ}+fromRelationalOperator LT = #{const LUA_OPLT}+fromRelationalOperator LE = #{const LUA_OPLE}+{-# INLINABLE fromRelationalOperator #-}+++--+-- * Status+--++-- | Lua status values.+data Status+ = OK -- ^ success+ | Yield -- ^ yielding / suspended coroutine+ | ErrRun -- ^ a runtime rror+ | ErrSyntax -- ^ syntax error during precompilation+ | ErrMem -- ^ memory allocation (out-of-memory) error.+ | ErrErr -- ^ error while running the message handler.+ | ErrGcmm -- ^ error while running a @__gc@ metamethod.+ | ErrFile -- ^ opening or reading a file failed.+ deriving (Eq, Show)++-- | Convert C integer constant to @'Status'@.+toStatus :: StatusCode -> Status+toStatus (StatusCode c) = case c of+ #{const LUA_OK} -> OK+ #{const LUA_YIELD} -> Yield+ #{const LUA_ERRRUN} -> ErrRun+ #{const LUA_ERRSYNTAX} -> ErrSyntax+ #{const LUA_ERRMEM} -> ErrMem+ #{const LUA_ERRGCMM} -> ErrGcmm+ #{const LUA_ERRERR} -> ErrErr+ #{const LUA_ERRFILE} -> ErrFile+ n -> error $ "Cannot convert (" ++ show n ++ ") to Status"+{-# INLINABLE toStatus #-}++-- | Integer code used to signal the status of a thread or computation.+-- See @'Status'@.+newtype StatusCode = StatusCode CInt deriving (Eq, Storable)+++--+-- * Gargabe Collection Control+--++-- | Enumeration used by @gc@ function.+data GCCONTROL+ = GCSTOP+ | GCRESTART+ | GCCOLLECT+ | GCCOUNT+ | GCCOUNTB+ | GCSTEP+ | GCSETPAUSE+ | GCSETSTEPMUL+ deriving (Enum, Eq, Ord, Show)++-- | A stack index+newtype StackIndex = StackIndex { fromStackIndex :: CInt }+ deriving (Enum, Eq, Num, Ord, Show)++--+-- Number of arguments and return values+--++-- | The number of arguments consumed curing a function call.+newtype NumArgs = NumArgs { fromNumArgs :: CInt }+ deriving (Eq, Num, Ord, Show)++-- | The number of results returned by a function call.+newtype NumResults = NumResults { fromNumResults :: CInt }+ deriving (Eq, Num, Ord, Show)
+ src/Foreign/Lua/Raw/Userdata.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE CPP #-}+{-|+Module : Foreign.Lua.Raw.Userdata+Copyright : © 2017-2021 Albert Krewinkel+License : MIT+Maintainer : Albert Krewinkel <tarleb+hslua@zeitkraut.de>+Stability : beta+Portability : ForeignFunctionInterface++Bindings to HsLua-specific functions used to push Haskell values+as userdata.+-}+module Foreign.Lua.Raw.Userdata+ ( hslua_fromuserdata+ , hslua_newhsuserdata+ , hslua_newudmetatable+ ) where++import Foreign.C (CInt (CInt), CString)+import Foreign.Lua.Raw.Auxiliary (luaL_testudata)+import Foreign.Lua.Raw.Functions (lua_newuserdata)+import Foreign.Lua.Raw.Types+ ( LuaBool (..)+ , StackIndex (..)+ , State (..)+ )+import Foreign.Ptr (castPtr, nullPtr)+import Foreign.StablePtr (newStablePtr, deRefStablePtr)+import Foreign.Storable (peek, poke, sizeOf)++#ifdef ALLOW_UNSAFE_GC+#define SAFTY unsafe+#else+#define SAFTY safe+#endif++-- | Creates and registers a new metatable for a userdata-wrapped+-- Haskell value; checks whether a metatable of that name has been+-- registered yet and uses the registered table if possible.+foreign import ccall SAFTY "hsludata.h hslua_newudmetatable"+ hslua_newudmetatable :: State -- ^ Lua state+ -> CString -- ^ Userdata name (__name)+ -> IO LuaBool -- ^ True iff new metatable+ -- was created.++-- | Creates a new userdata wrapping the given Haskell object.+hslua_newhsuserdata :: State -> a -> IO ()+hslua_newhsuserdata l x = do+ xPtr <- newStablePtr x+ udPtr <- lua_newuserdata l (fromIntegral $ sizeOf xPtr)+ poke (castPtr udPtr) xPtr+{-# INLINABLE hslua_newhsuserdata #-}++-- | Retrieves a Haskell object from userdata at the given index.+-- The userdata /must/ have the given name.+hslua_fromuserdata :: State+ -> StackIndex -- ^ userdata index+ -> CString -- ^ name+ -> IO (Maybe a)+hslua_fromuserdata l idx name = do+ udPtr <- luaL_testudata l idx name+ if udPtr == nullPtr+ then return Nothing+ else Just <$> (peek (castPtr udPtr) >>= deRefStablePtr)+{-# INLINABLE hslua_fromuserdata #-}
+ test/test-lua.hs view
@@ -0,0 +1,93 @@+{-|+Module : Main+Copyright : © 2021 Albert Krewinkel+License : MIT+Maintainer : Albert Krewinkel <tarleb+hslua@zeitkraut.de>+Stability : beta++Tests for the raw Lua bindings.+-}+module Main (main) where++import Foreign.C.String (peekCString, withCStringLen)+import Foreign.Ptr (nullPtr)+import Foreign.Lua.Raw.Auxiliary+import Foreign.Lua.Raw.Functions+import Foreign.Lua.Raw.Types+import Test.Tasty (TestTree, defaultMain, testGroup)+import Test.Tasty.HUnit ( Assertion, testCase, (@=?) )++-- | Runs tests.+main :: IO ()+main = defaultMain tests++-- | Specifications for Attributes parsing functions.+tests :: TestTree+tests = testGroup "lua"+ [ testGroup "state"+ [ "create and close" =: do+ l <- hsluaL_newstate+ lua_close l+ ]++ , testGroup "booleans"+ [ "push and retrieve" =: do+ l <- hsluaL_newstate+ lua_pushboolean l true+ b <- lua_toboolean l (-1)+ lua_close l+ true @=? b++ , "type" =: do+ l <- hsluaL_newstate+ lua_pushboolean l false+ ty <- lua_type l (-1)+ lua_close l+ TypeBoolean @=? toType ty+ ]++ , testGroup "numbers"+ [ "push and retrieve" =: do+ l <- hsluaL_newstate+ lua_pushinteger l 5+ i <- lua_tointegerx l (-1) nullPtr+ lua_close l+ 5 @=? i++ , "type" =: do+ l <- hsluaL_newstate+ lua_pushinteger l 0+ ty <- lua_type l (-1)+ lua_close l+ TypeNumber @=? toType ty+ ]++ , testGroup "strings"+ [ "push and retrieve" =: do+ l <- hsluaL_newstate+ withCStringLen "testing" $ \(ptr, len) ->+ lua_pushlstring l ptr (fromIntegral len)+ str <- peekCString =<< lua_tolstring l (-1) nullPtr+ lua_close l+ "testing" @=? str++ , "type" =: do+ l <- hsluaL_newstate+ withCStringLen "Olsen Olsen" $ \(ptr, len) ->+ lua_pushlstring l ptr (fromIntegral len)+ ty <- lua_type l (-1)+ lua_close l+ TypeString @=? toType ty+ ]++ , testGroup "constants"+ [ "loadedTableRegistryField" =:+ ("_LOADED" @=? loadedTableRegistryField)+ , "preloadTableRegistryField" =:+ ("_PRELOAD" @=? preloadTableRegistryField)+ ]+ ]++infix 3 =:+(=:) :: String -> Assertion -> TestTree+(=:) = testCase