summaryrefslogtreecommitdiff
path: root/source/luametatex/source/lua/lmtluaclib.c
diff options
context:
space:
mode:
Diffstat (limited to 'source/luametatex/source/lua/lmtluaclib.c')
-rw-r--r--source/luametatex/source/lua/lmtluaclib.c660
1 files changed, 660 insertions, 0 deletions
diff --git a/source/luametatex/source/lua/lmtluaclib.c b/source/luametatex/source/lua/lmtluaclib.c
new file mode 100644
index 000000000..797585aba
--- /dev/null
+++ b/source/luametatex/source/lua/lmtluaclib.c
@@ -0,0 +1,660 @@
+/*
+ See license.txt in the root of this project. Most code here is from the luac program by the
+ official Lua project developers.
+*/
+
+# include "luametatex.h"
+
+/*
+
+ This is a slightly adapted version of luac which is not in the library but a separate program.
+ We keep a copy around in order to check changes. The version below doesn't load files nor saves
+ one. It is derived from:
+
+ $Id: luac.c $
+ Lua compiler (saves bytecodes to files; also lists bytecodes)
+ See Copyright Notice in lua.h
+
+ I added this helper because I wanted to look to what extend constants were resolved beforehand
+ but in the end that was seldom the case because we get them from tables and that bit of code is
+ not resolved at bytecode compile time (so in the end macros made more sense, although the gain
+ is very little).
+
+ I considered replacing the print with writing to a buffer so that we can deal with it later but
+ it is not worth the effort.
+
+*/
+
+# include "ldebug.h"
+# include "lopcodes.h"
+# include "lopnames.h"
+
+static TString **tmname = NULL;
+
+# define toproto(L,i) getproto(s2v(L->top+(i)))
+# define UPVALNAME(x) ((f->upvalues[x].name) ? getstr(f->upvalues[x].name) : "-")
+# define LUACVOID(p) ((const void*)(p))
+# define eventname(i) (getstr(tmname[i]))
+
+static void luaclib_aux_print_string(const TString* ts)
+{
+ const char* s = getstr(ts);
+ size_t n = tsslen(ts);
+ printf("\"");
+ for (size_t i = 0; i < n; i++) {
+ int c = (int) (unsigned char) s[i];
+ switch (c) {
+ case '"':
+ printf("\\\"");
+ break;
+ case '\\':
+ printf("\\\\");
+ break;
+ case '\a':
+ printf("\\a");
+ break;
+ case '\b':
+ printf("\\b");
+ break;
+ case '\f':
+ printf("\\f");
+ break;
+ case '\n':
+ printf("\\n");
+ break;
+ case '\r':
+ printf("\\r");
+ break;
+ case '\t':
+ printf("\\t");
+ break;
+ case '\v':
+ printf("\\v");
+ break;
+ default:
+ printf(isprint(c) ? "%c" : "\\%03d", c);
+ break;
+ }
+ }
+ printf("\"");
+}
+
+static void PrintType(const Proto* f, int i)
+{
+ const TValue* o = &f->k[i];
+ switch (ttypetag(o)) {
+ case LUA_VNIL:
+ printf("N");
+ break;
+ case LUA_VFALSE:
+ case LUA_VTRUE:
+ printf("B");
+ break;
+ case LUA_VNUMFLT:
+ printf("F");
+ break;
+ case LUA_VNUMINT:
+ printf("I");
+ break;
+ case LUA_VSHRSTR:
+ case LUA_VLNGSTR:
+ printf("S");
+ break;
+ default:
+ /* cannot happen */
+ printf("?%d", ttypetag(o));
+ break;
+ }
+ printf("\t");
+}
+
+static void PrintConstant(const Proto* f, int i)
+{
+ const TValue* o = &f->k[i];
+ switch (ttypetag(o)) {
+ case LUA_VNIL:
+ printf("nil");
+ break;
+ case LUA_VFALSE:
+ printf("false");
+ break;
+ case LUA_VTRUE:
+ printf("true");
+ break;
+ case LUA_VNUMFLT:
+ {
+ char buff[100];
+ sprintf(buff,"%.14g", fltvalue(o)); /* LUA_NUMBER_FMT */
+ printf("%s", buff);
+ if (buff[strspn(buff, "-0123456789")] == '\0') {
+ printf(".0");
+ }
+ break;
+ }
+ case LUA_VNUMINT:
+# if defined(__MINGW64__) || defined(__MINGW32__)
+ printf("%I64i", ivalue(o)); /* LUA_INTEGER_FMT */
+# else
+ printf("%lli", ivalue(o)); /* LUA_INTEGER_FMT */
+# endif
+ break;
+ case LUA_VSHRSTR:
+ case LUA_VLNGSTR:
+ luaclib_aux_print_string(tsvalue(o));
+ break;
+ default:
+ /* cannot happen */
+ printf("?%d", ttypetag(o));
+ break;
+ }
+}
+
+#define COMMENT "\t; "
+#define EXTRAARG GETARG_Ax(code[pc+1])
+#define EXTRAARGC (EXTRAARG*(MAXARG_C+1))
+#define ISK (isk ? "k" : "")
+
+static void luaclib_aux_print_code(const Proto* f)
+{
+ const Instruction* code = f->code;
+ int n = f->sizecode;
+ for (int pc = 0; pc < n; pc++) {
+ Instruction i = code[pc];
+ OpCode o = GET_OPCODE(i);
+ int a = GETARG_A(i);
+ int b = GETARG_B(i);
+ int c = GETARG_C(i);
+ int ax = GETARG_Ax(i);
+ int bx = GETARG_Bx(i);
+ int sb = GETARG_sB(i);
+ int sc = GETARG_sC(i);
+ int sbx = GETARG_sBx(i);
+ int isk = GETARG_k(i);
+ int line = luaG_getfuncline(f, pc);
+ printf("\t%d\t", pc + 1);
+ if (line > 0) {
+ printf("[%d]\t", line);
+ } else {
+ printf("[-]\t");
+ }
+ printf("%-9s\t", opnames[o]);
+ switch (o) {
+ case OP_MOVE:
+ printf("%d %d", a, b);
+ break;
+ case OP_LOADI:
+ printf("%d %d", a, sbx);
+ break;
+ case OP_LOADF:
+ printf("%d %d", a, sbx);
+ break;
+ case OP_LOADK:
+ printf("%d %d", a, bx);
+ printf(COMMENT);
+ PrintConstant(f, bx);
+ break;
+ case OP_LOADKX:
+ printf("%d", a);
+ printf(COMMENT);
+ PrintConstant(f, EXTRAARG);
+ break;
+ case OP_LOADFALSE:
+ printf("%d", a);
+ break;
+ case OP_LFALSESKIP:
+ printf("%d", a);
+ break;
+ case OP_LOADTRUE:
+ printf("%d", a);
+ break;
+ case OP_LOADNIL:
+ printf("%d %d", a, b);
+ printf(COMMENT "%d out", b + 1);
+ break;
+ case OP_GETUPVAL:
+ printf("%d %d", a, b);
+ printf(COMMENT "%s", UPVALNAME(b));
+ break;
+ case OP_SETUPVAL:
+ printf("%d %d", a, b);
+ printf(COMMENT "%s", UPVALNAME(b));
+ break;
+ case OP_GETTABUP:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT "%s", UPVALNAME(b));
+ printf(" ");
+ PrintConstant(f, c);
+ break;
+ case OP_GETTABLE:
+ printf("%d %d %d", a, b, c);
+ break;
+ case OP_GETI:
+ printf("%d %d %d", a, b, c);
+ break;
+ case OP_GETFIELD:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT);
+ PrintConstant(f, c);
+ break;
+ case OP_SETTABUP:
+ printf("%d %d %d%s", a, b, c, ISK);
+ printf(COMMENT "%s", UPVALNAME(a));
+ printf(" ");
+ PrintConstant(f, b);
+ if (isk) {
+ printf(" ");
+ PrintConstant(f, c);
+ }
+ break;
+ case OP_SETTABLE:
+ printf("%d %d %d%s", a, b, c, ISK);
+ if (isk) {
+ printf(COMMENT);
+ PrintConstant(f, c);
+ }
+ break;
+ case OP_SETI:
+ printf("%d %d %d%s", a, b, c, ISK);
+ if (isk) {
+ printf(COMMENT);
+ PrintConstant(f, c);
+ }
+ break;
+ case OP_SETFIELD:
+ printf("%d %d %d%s", a, b, c, ISK);
+ printf(COMMENT);
+ PrintConstant(f, b);
+ if (isk) {
+ printf(" ");
+ PrintConstant(f, c);
+ }
+ break;
+ case OP_NEWTABLE:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT "%d", c + EXTRAARGC);
+ break;
+ case OP_SELF:
+ printf("%d %d %d%s", a, b, c, ISK);
+ if (isk) {
+ printf(COMMENT);
+ PrintConstant(f, c);
+ }
+ break;
+ case OP_ADDI:
+ printf("%d %d %d", a, b, sc);
+ break;
+ case OP_ADDK:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT);
+ PrintConstant(f, c);
+ break;
+ case OP_SUBK:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT);
+ PrintConstant(f, c);
+ break;
+ case OP_MULK:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT);
+ PrintConstant(f, c);
+ break;
+ case OP_MODK:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT);
+ PrintConstant(f, c);
+ break;
+ case OP_POWK:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT);
+ PrintConstant(f, c);
+ break;
+ case OP_DIVK:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT);
+ PrintConstant(f, c);
+ break;
+ case OP_IDIVK:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT);
+ PrintConstant(f, c);
+ break;
+ case OP_BANDK:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT);
+ PrintConstant(f, c);
+ break;
+ case OP_BORK:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT);
+ PrintConstant(f, c);
+ break;
+ case OP_BXORK:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT);
+ PrintConstant(f, c);
+ break;
+ case OP_SHRI:
+ printf("%d %d %d", a, b, sc);
+ break;
+ case OP_SHLI:
+ printf("%d %d %d", a, b, sc);
+ break;
+ case OP_ADD:
+ printf("%d %d %d", a, b, c);
+ break;
+ case OP_SUB:
+ printf("%d %d %d", a, b, c);
+ break;
+ case OP_MUL:
+ printf("%d %d %d", a, b, c);
+ break;
+ case OP_MOD:
+ printf("%d %d %d", a, b, c);
+ break;
+ case OP_POW:
+ printf("%d %d %d", a, b, c);
+ break;
+ case OP_DIV:
+ printf("%d %d %d", a, b, c);
+ break;
+ case OP_IDIV:
+ printf("%d %d %d", a, b, c);
+ break;
+ case OP_BAND:
+ printf("%d %d %d", a, b, c);
+ break;
+ case OP_BOR:
+ printf("%d %d %d", a, b, c);
+ break;
+ case OP_BXOR:
+ printf("%d %d %d", a, b, c);
+ break;
+ case OP_SHL:
+ printf("%d %d %d", a, b, c);
+ break;
+ case OP_SHR:
+ printf("%d %d %d", a, b, c);
+ break;
+ case OP_MMBIN:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT "%s", eventname(c));
+ break;
+ case OP_MMBINI:
+ printf("%d %d %d %d", a, sb, c, isk);
+ printf(COMMENT "%s", eventname(c));
+ if (isk) {
+ printf(" flip");
+ }
+ break;
+ case OP_MMBINK:
+ printf("%d %d %d %d", a, b, c, isk);
+ printf(COMMENT "%s ", eventname(c));
+ PrintConstant(f, b);
+ if (isk) {
+ printf(" flip");
+ }
+ break;
+ case OP_UNM:
+ printf("%d %d", a, b);
+ break;
+ case OP_BNOT:
+ printf("%d %d", a, b);
+ break;
+ case OP_NOT:
+ printf("%d %d", a, b);
+ break;
+ case OP_LEN:
+ printf("%d %d", a, b);
+ break;
+ case OP_CONCAT:
+ printf("%d %d", a, b);
+ break;
+ case OP_CLOSE:
+ printf("%d", a);
+ break;
+ case OP_TBC:
+ printf("%d", a);
+ break;
+ case OP_JMP:
+ printf("%d", GETARG_sJ(i));
+ printf(COMMENT "to %d", GETARG_sJ(i) + pc + 2);
+ break;
+ case OP_EQ:
+ printf("%d %d %d", a, b, isk);
+ break;
+ case OP_LT:
+ printf("%d %d %d", a, b, isk);
+ break;
+ case OP_LE:
+ printf("%d %d %d", a, b, isk);
+ break;
+ case OP_EQK:
+ printf("%d %d %d", a, b, isk);
+ printf(COMMENT);
+ PrintConstant(f, b);
+ break;
+ case OP_EQI:
+ printf("%d %d %d", a, sb, isk);
+ break;
+ case OP_LTI:
+ printf("%d %d %d", a, sb, isk);
+ break;
+ case OP_LEI:
+ printf("%d %d %d", a, sb, isk);
+ break;
+ case OP_GTI:
+ printf("%d %d %d", a, sb, isk);
+ break;
+ case OP_GEI:
+ printf("%d %d %d", a, sb, isk);
+ break;
+ case OP_TEST:
+ printf("%d %d", a, isk);
+ break;
+ case OP_TESTSET:
+ printf("%d %d %d", a, b, isk);
+ break;
+ case OP_CALL:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT);
+ if (b==0) {
+ printf("all in ");
+ } else {
+ printf("%d in ", b - 1);
+ }
+ if (c==0) {
+ printf("all out");
+ } else {
+ printf("%d out", c- 1 );
+ }
+ break;
+ case OP_TAILCALL:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT "%d in", b - 1);
+ break;
+ case OP_RETURN:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT);
+ if (b == 0) {
+ printf("all out");
+ } else {
+ printf("%d out", b - 1);
+ }
+ break;
+ case OP_RETURN0:
+ break;
+ case OP_RETURN1:
+ printf("%d", a);
+ break;
+ case OP_FORLOOP:
+ printf("%d %d", a, bx);
+ printf(COMMENT "to %d", pc - bx + 2);
+ break;
+ case OP_FORPREP:
+ printf("%d %d", a, bx);
+ printf(COMMENT "to %d", pc + bx + 2);
+ break;
+ case OP_TFORPREP:
+ printf("%d %d", a, bx);
+ printf(COMMENT "to %d", pc + bx + 2);
+ break;
+ case OP_TFORCALL:
+ printf("%d %d", a, c);
+ break;
+ case OP_TFORLOOP:
+ printf("%d %d", a, bx);
+ printf(COMMENT "to %d", pc - bx + 2);
+ break;
+ case OP_SETLIST:
+ printf("%d %d %d", a, b, c);
+ if (isk) {
+ printf(COMMENT "%d", c + EXTRAARGC);
+ }
+ break;
+ case OP_CLOSURE:
+ printf("%d %d",a,bx);
+ printf(COMMENT "%p", LUACVOID(f->p[bx]));
+ break;
+ case OP_VARARG:
+ printf("%d %d", a, c);
+ printf(COMMENT);
+ if (c == 0) {
+ printf("all out");
+ } else {
+ printf("%d out", c-1);
+ }
+ break;
+ case OP_VARARGPREP:
+ printf("%d",a);
+ break;
+ case OP_EXTRAARG:
+ printf("%d", ax);
+ break;
+ default:
+ printf("%d %d %d", a, b, c);
+ printf(COMMENT "not handled");
+ break;
+ }
+ printf("\n");
+ }
+}
+
+# define SS(x) ((x == 1) ? "" : "s")
+# define S(x) (int)(x),SS(x)
+
+static void luaclib_aux_print_header(const Proto* f)
+{
+ const char* s = f->source ? getstr(f->source) : "=?";
+ if (*s == '@' || *s == '=') {
+ s++;
+ } else if (*s == LUA_SIGNATURE[0]) {
+ s = "(bstring)";
+ } else {
+ s = "(string)";
+ }
+ printf("\n%s <%s:%d,%d> (%d instruction%s at %p)\n",
+ (f->linedefined == 0) ? "main" : "function",
+ s,
+ f->linedefined,f->lastlinedefined,
+ S(f->sizecode),LUACVOID(f)
+ );
+ printf("%d%s param%s, %d slot%s, %d upvalue%s, ",
+ (int)(f->numparams),
+ f->is_vararg?"+":"",
+ SS(f->numparams),
+ S(f->maxstacksize),
+ S(f->sizeupvalues)
+ );
+ printf("%d local%s, %d constant%s, %d function%s\n",
+ S(f->sizelocvars),
+ S(f->sizek),
+ S(f->sizep)
+ );
+}
+
+static void luaclib_aux_print_debug(const Proto* f)
+{
+ {
+ int n = f->sizek;
+ printf("constants (%d) for %p:\n", n, LUACVOID(f));
+ for (int i = 0; i < n; i++) {
+ printf("\t%d\t", i);
+ PrintType(f, i);
+ PrintConstant(f, i);
+ printf("\n");
+ }
+ }
+ {
+ int n = f->sizelocvars;
+ printf("locals (%d) for %p:\n", n, LUACVOID(f));
+ for (int i = 0; i < n; i++) {
+ printf("\t%d\t%s\t%d\t%d\n",
+ i,
+ getstr(f->locvars[i].varname),
+ f->locvars[i].startpc+1,
+ f->locvars[i].endpc+1
+ );
+ }
+ }
+ {
+ int n = f->sizeupvalues;
+ printf("upvalues (%d) for %p:\n", n, LUACVOID(f));
+ for (int i = 0; i < n; i++) {
+ printf("\t%d\t%s\t%d\t%d\n",
+ i,
+ UPVALNAME(i),
+ f->upvalues[i].instack,
+ f->upvalues[i].idx
+ );
+ }
+ }
+}
+
+/* We only have one (needs checking). */
+
+static void luaclib_aux_print_function(const Proto* f, int full)
+{
+ int n = f->sizep;
+ luaclib_aux_print_header(f);
+ luaclib_aux_print_code(f);
+ if (full) {
+ luaclib_aux_print_debug(f);
+ }
+ for (int i = 0; i < n; i++) {
+ luaclib_aux_print_function(f->p[i], full);
+ }
+}
+
+static int luaclib_print(lua_State *L)
+{
+ int full = lua_toboolean(L, 2);
+ size_t len = 0;
+ const char *str = lua_tolstring(L, 1, &len);
+ if (len > 0 && luaL_loadbuffer(L, str, len, str) == LUA_OK) {
+ const Proto *f = toproto(L, -1);
+ if (f) {
+ tmname = G(L)->tmname;
+ luaclib_aux_print_function(f, full);
+ }
+ }
+ return 0;
+}
+
+/* So far for the adapted rip-off. */
+
+void lmt_luaclib_initialize(void)
+{
+ /* not used yet */
+}
+
+static const struct luaL_Reg luaclib_function_list[] = {
+ { "print", luaclib_print },
+ { NULL, NULL },
+};
+
+int luaopen_luac(lua_State *L)
+{
+ lua_newtable(L);
+ luaL_setfuncs(L, luaclib_function_list, 0);
+ return 1;
+}
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-15 04:31:30 +0000