lmtluaclib.c /size: 18 Kb    last modification: 2024-01-16 10:22
1/*
2    See license.txt in the root of this project. Most code here is from the luac program by the
3    official Lua project developers.
4*/
5
6# include "luametatex.h"
7
8/*
9
10    This is a slightly adapted version of luac which is not in the library but a separate program.
11    We keep a copy around in order to check changes. The version below doesn't load files nor saves
12    one. It is derived from:
13
14    $Id: luac.c $
15    Lua compiler (saves bytecodes to files; also lists bytecodes)
16    See Copyright Notice in lua.h
17
18    I added this helper because I wanted to look to what extend constants were resolved beforehand
19    but in the end that was seldom the case because we get them from tables and that bit of code is
20    not resolved at bytecode compile time (so in the end macros made more sense, although the gain
21    is very little).
22
23    I considered replacing the print with writing to a buffer so that we can deal with it later but
24    it is not worth the effort.
25
26*/
27
28# include "ldebug.h"
29# include "lopcodes.h"
30# include "lopnames.h"
31
32static TString **tmname = NULL;
33
34# define toproto(L,i) getproto(s2v(L->top.p+(i)))
35# define UPVALNAME(x) ((f->upvalues[x].name) ? getstr(f->upvalues[x].name) : "-")
36# define LUACVOID(p)  ((const void*)(p))
37# define eventname(i) (getstr(tmname[i]))
38
39static void luaclib_aux_print_string(const TString* ts)
40{
41    const char* s = getstr(ts);
42    size_t n = tsslen(ts);
43    printf("\"");
44    for (size_t i = 0; i < n; i++) {
45        int c = (int) (unsigned char) s[i];
46        switch (c) {
47            case '"':
48                printf("\\\"");
49                break;
50            case '\\':
51                printf("\\\\");
52                break;
53            case '\a':
54                printf("\\a");
55                break;
56            case '\b':
57                printf("\\b");
58                break;
59            case '\f':
60                printf("\\f");
61                break;
62            case '\n':
63                printf("\\n");
64                break;
65            case '\r':
66                printf("\\r");
67                break;
68            case '\t':
69                printf("\\t");
70                break;
71            case '\v':
72                printf("\\v");
73                break;
74            default:
75                printf(isprint(c) ? "%c" : "\\%03d", c);
76                break;
77        }
78    }
79    printf("\"");
80}
81
82static void PrintType(const Proto* f, int i)
83{
84    const TValue* o = &f->k[i];
85    switch (ttypetag(o)) {
86        case LUA_VNIL:
87            printf("N");
88            break;
89        case LUA_VFALSE:
90        case LUA_VTRUE:
91            printf("B");
92            break;
93        case LUA_VNUMFLT:
94            printf("F");
95            break;
96        case LUA_VNUMINT:
97            printf("I");
98            break;
99        case LUA_VSHRSTR:
100        case LUA_VLNGSTR:
101            printf("S");
102            break;
103        default:
104            /* cannot happen */
105            printf("?%d", ttypetag(o));
106            break;
107    }
108    printf("\t");
109}
110
111static void PrintConstant(const Proto* f, int i)
112{
113    const TValue* o = &f->k[i];
114    switch (ttypetag(o)) {
115        case LUA_VNIL:
116            printf("nil");
117            break;
118        case LUA_VFALSE:
119            printf("false");
120            break;
121        case LUA_VTRUE:
122            printf("true");
123            break;
124        case LUA_VNUMFLT:
125            {
126                char buff[100];
127                sprintf(buff,"%.14g", fltvalue(o)); /* LUA_NUMBER_FMT */
128                printf("%s", buff);
129                if (buff[strspn(buff, "-0123456789")] == '\0') {
130                    printf(".0");
131                }
132                break;
133            }
134        case LUA_VNUMINT:
135            printf("%lli", ivalue(o)); /* LUA_INTEGER_FMT */
136            break;
137        case LUA_VSHRSTR:
138        case LUA_VLNGSTR:
139            luaclib_aux_print_string(tsvalue(o));
140            break;
141        default:
142            /* cannot happen */
143            printf("?%d", ttypetag(o));
144            break;
145    }
146}
147
148#define COMMENT	   "\t; "
149#define EXTRAARG   GETARG_Ax(code[pc+1])
150#define EXTRAARGC  (EXTRAARG*(MAXARG_C+1))
151#define ISK        (isk ? "k" : "")
152
153static void luaclib_aux_print_code(const Proto* f)
154{
155    const Instruction* code = f->code;
156    int n = f->sizecode;
157    for (int pc = 0; pc < n; pc++) {
158        Instruction i = code[pc];
159        OpCode o = GET_OPCODE(i);
160        int a = GETARG_A(i);
161        int b = GETARG_B(i);
162        int c = GETARG_C(i);
163        int ax = GETARG_Ax(i);
164        int bx = GETARG_Bx(i);
165        int sb = GETARG_sB(i);
166        int sc = GETARG_sC(i);
167        int sbx = GETARG_sBx(i);
168        int isk = GETARG_k(i);
169        int line = luaG_getfuncline(f, pc);
170        printf("\t%d\t", pc + 1);
171        if (line > 0) {
172            printf("[%d]\t", line);
173        } else {
174            printf("[-]\t");
175        }
176        printf("%-9s\t", opnames[o]);
177        switch (o) {
178            case OP_MOVE:
179                printf("%d %d", a, b);
180                break;
181            case OP_LOADI:
182                printf("%d %d", a, sbx);
183                break;
184            case OP_LOADF:
185                printf("%d %d", a, sbx);
186                break;
187            case OP_LOADK:
188                printf("%d %d", a, bx);
189                printf(COMMENT);
190                PrintConstant(f, bx);
191                break;
192            case OP_LOADKX:
193                printf("%d", a);
194                printf(COMMENT);
195                PrintConstant(f, EXTRAARG);
196                break;
197            case OP_LOADFALSE:
198                printf("%d", a);
199                break;
200            case OP_LFALSESKIP:
201                printf("%d", a);
202                break;
203            case OP_LOADTRUE:
204                printf("%d", a);
205                break;
206            case OP_LOADNIL:
207                printf("%d %d", a, b);
208                printf(COMMENT "%d out", b + 1);
209                break;
210            case OP_GETUPVAL:
211                printf("%d %d", a, b);
212                printf(COMMENT "%s", UPVALNAME(b));
213                break;
214            case OP_SETUPVAL:
215                printf("%d %d", a, b);
216                printf(COMMENT "%s", UPVALNAME(b));
217                break;
218            case OP_GETTABUP:
219                printf("%d %d %d", a, b, c);
220                printf(COMMENT "%s", UPVALNAME(b));
221                printf(" ");
222                PrintConstant(f, c);
223                break;
224            case OP_GETTABLE:
225                printf("%d %d %d", a, b, c);
226                break;
227            case OP_GETI:
228                printf("%d %d %d", a, b, c);
229                break;
230            case OP_GETFIELD:
231                printf("%d %d %d", a, b, c);
232                printf(COMMENT);
233                PrintConstant(f, c);
234                break;
235            case OP_SETTABUP:
236                printf("%d %d %d%s", a, b, c, ISK);
237                printf(COMMENT "%s", UPVALNAME(a));
238                printf(" ");
239                PrintConstant(f, b);
240                if (isk) {
241                    printf(" ");
242                    PrintConstant(f, c);
243                }
244                break;
245            case OP_SETTABLE:
246                printf("%d %d %d%s", a, b, c, ISK);
247                if (isk) {
248                    printf(COMMENT);
249                    PrintConstant(f, c);
250                }
251                break;
252            case OP_SETI:
253                printf("%d %d %d%s", a, b, c, ISK);
254                if (isk) {
255                    printf(COMMENT);
256                    PrintConstant(f, c);
257                }
258                break;
259            case OP_SETFIELD:
260                printf("%d %d %d%s", a, b, c, ISK);
261                printf(COMMENT);
262                PrintConstant(f, b);
263                if (isk) {
264                    printf(" ");
265                    PrintConstant(f, c);
266                }
267                break;
268            case OP_NEWTABLE:
269                printf("%d %d %d", a, b, c);
270                printf(COMMENT "%d", c + EXTRAARGC);
271                break;
272            case OP_SELF:
273                printf("%d %d %d%s", a, b, c, ISK);
274                if (isk) {
275                    printf(COMMENT);
276                    PrintConstant(f, c);
277                }
278                break;
279            case OP_ADDI:
280                printf("%d %d %d", a, b, sc);
281                break;
282            case OP_ADDK:
283                printf("%d %d %d", a, b, c);
284                printf(COMMENT);
285                PrintConstant(f, c);
286                break;
287            case OP_SUBK:
288                printf("%d %d %d", a, b, c);
289                printf(COMMENT);
290                PrintConstant(f, c);
291                break;
292            case OP_MULK:
293                printf("%d %d %d", a, b, c);
294                printf(COMMENT);
295                PrintConstant(f, c);
296                break;
297            case OP_MODK:
298                printf("%d %d %d", a, b, c);
299                printf(COMMENT);
300                PrintConstant(f, c);
301                break;
302            case OP_POWK:
303                printf("%d %d %d", a, b, c);
304                printf(COMMENT);
305                PrintConstant(f, c);
306                break;
307            case OP_DIVK:
308                printf("%d %d %d", a, b, c);
309                printf(COMMENT);
310                PrintConstant(f, c);
311                break;
312            case OP_IDIVK:
313                printf("%d %d %d", a, b, c);
314                printf(COMMENT);
315                PrintConstant(f, c);
316                break;
317            case OP_BANDK:
318                printf("%d %d %d", a, b, c);
319                printf(COMMENT);
320                PrintConstant(f, c);
321                break;
322            case OP_BORK:
323                printf("%d %d %d", a, b, c);
324                printf(COMMENT);
325                PrintConstant(f, c);
326                break;
327            case OP_BXORK:
328                printf("%d %d %d", a, b, c);
329                printf(COMMENT);
330                PrintConstant(f, c);
331                break;
332            case OP_SHRI:
333                printf("%d %d %d", a, b, sc);
334                break;
335            case OP_SHLI:
336                printf("%d %d %d", a, b, sc);
337                break;
338            case OP_ADD:
339                printf("%d %d %d", a, b, c);
340                break;
341            case OP_SUB:
342                printf("%d %d %d", a, b, c);
343                break;
344            case OP_MUL:
345                printf("%d %d %d", a, b, c);
346                break;
347            case OP_MOD:
348                printf("%d %d %d", a, b, c);
349                break;
350            case OP_POW:
351                printf("%d %d %d", a, b, c);
352                break;
353            case OP_DIV:
354                printf("%d %d %d", a, b, c);
355                break;
356            case OP_IDIV:
357                printf("%d %d %d", a, b, c);
358                break;
359            case OP_BAND:
360                printf("%d %d %d", a, b, c);
361                break;
362            case OP_BOR:
363                printf("%d %d %d", a, b, c);
364                break;
365            case OP_BXOR:
366                printf("%d %d %d", a, b, c);
367                break;
368            case OP_SHL:
369                printf("%d %d %d", a, b, c);
370                break;
371            case OP_SHR:
372                printf("%d %d %d", a, b, c);
373                break;
374            case OP_MMBIN:
375                printf("%d %d %d", a, b, c);
376                printf(COMMENT "%s", eventname(c));
377                break;
378            case OP_MMBINI:
379                printf("%d %d %d %d", a, sb, c, isk);
380                printf(COMMENT "%s", eventname(c));
381                if (isk) {
382                    printf(" flip");
383                }
384                break;
385            case OP_MMBINK:
386                printf("%d %d %d %d", a, b, c, isk);
387                printf(COMMENT "%s ", eventname(c));
388                PrintConstant(f, b);
389                if (isk) {
390                    printf(" flip");
391                }
392                break;
393            case OP_UNM:
394                printf("%d %d", a, b);
395                break;
396            case OP_BNOT:
397                printf("%d %d", a, b);
398                break;
399            case OP_NOT:
400                printf("%d %d", a, b);
401                break;
402            case OP_LEN:
403                printf("%d %d", a, b);
404                break;
405            case OP_CONCAT:
406                printf("%d %d", a, b);
407                break;
408            case OP_CLOSE:
409                printf("%d", a);
410                break;
411            case OP_TBC:
412                printf("%d", a);
413                break;
414            case OP_JMP:
415                printf("%d", GETARG_sJ(i));
416                printf(COMMENT "to %d", GETARG_sJ(i) + pc + 2);
417                break;
418            case OP_EQ:
419                printf("%d %d %d", a, b, isk);
420                break;
421            case OP_LT:
422                printf("%d %d %d", a, b, isk);
423                break;
424            case OP_LE:
425                printf("%d %d %d", a, b, isk);
426                break;
427            case OP_EQK:
428                printf("%d %d %d", a, b, isk);
429                printf(COMMENT);
430                PrintConstant(f, b);
431                break;
432            case OP_EQI:
433                printf("%d %d %d", a, sb, isk);
434                break;
435            case OP_LTI:
436                printf("%d %d %d", a, sb, isk);
437                break;
438            case OP_LEI:
439                printf("%d %d %d", a, sb, isk);
440                break;
441            case OP_GTI:
442                printf("%d %d %d", a, sb, isk);
443                break;
444            case OP_GEI:
445                printf("%d %d %d", a, sb, isk);
446                break;
447            case OP_TEST:
448                printf("%d %d", a, isk);
449                break;
450            case OP_TESTSET:
451                printf("%d %d %d", a, b, isk);
452                break;
453            case OP_CALL:
454                printf("%d %d %d", a, b, c);
455                printf(COMMENT);
456                if (b==0) {
457                    printf("all in ");
458                } else {
459                    printf("%d in ", b - 1);
460                }
461                if (c==0) {
462                    printf("all out");
463                } else {
464                    printf("%d out", c- 1 );
465                }
466                break;
467            case OP_TAILCALL:
468                printf("%d %d %d", a, b, c);
469                printf(COMMENT "%d in", b - 1);
470                break;
471            case OP_RETURN:
472                printf("%d %d %d", a, b, c);
473                printf(COMMENT);
474                if (b == 0) {
475                    printf("all out");
476                } else {
477                    printf("%d out", b - 1);
478                }
479                break;
480            case OP_RETURN0:
481                break;
482            case OP_RETURN1:
483                printf("%d", a);
484                break;
485            case OP_FORLOOP:
486                printf("%d %d", a, bx);
487                printf(COMMENT "to %d", pc - bx + 2);
488                break;
489            case OP_FORPREP:
490                printf("%d %d", a, bx);
491                printf(COMMENT "to %d", pc + bx + 2);
492                break;
493            case OP_TFORPREP:
494                printf("%d %d", a, bx);
495                printf(COMMENT "to %d", pc + bx + 2);
496                break;
497            case OP_TFORCALL:
498                printf("%d %d", a, c);
499                break;
500            case OP_TFORLOOP:
501                printf("%d %d", a, bx);
502                printf(COMMENT "to %d", pc - bx + 2);
503                break;
504            case OP_SETLIST:
505                printf("%d %d %d", a, b, c);
506                if (isk) {
507                    printf(COMMENT "%d", c + EXTRAARGC);
508                }
509                break;
510            case OP_CLOSURE:
511                printf("%d %d",a,bx);
512                printf(COMMENT "%p", LUACVOID(f->p[bx]));
513                break;
514            case OP_VARARG:
515                printf("%d %d", a, c);
516                printf(COMMENT);
517                if (c == 0) {
518                    printf("all out");
519                } else {
520                    printf("%d out", c-1);
521                }
522                break;
523            case OP_VARARGPREP:
524                printf("%d",a);
525                break;
526            case OP_EXTRAARG:
527                printf("%d", ax);
528                break;
529         // default:
530         //     printf("%d %d %d", a, b, c);
531         //     printf(COMMENT "not handled");
532         //     break;
533        }
534        printf("\n");
535    }
536}
537
538# define SS(x) ((x == 1) ? "" : "s")
539# define S(x)  (int)(x),SS(x)
540
541static void luaclib_aux_print_header(const Proto* f)
542{
543    const char* s = f->source ? getstr(f->source) : "=?";
544    if (*s == '@' || *s == '=') {
545        s++;
546    } else if (*s == LUA_SIGNATURE[0]) {
547        s = "(bstring)";
548    } else {
549        s = "(string)";
550    }
551    printf("\n%s <%s:%d,%d> (%d instruction%s at %p)\n",
552        (f->linedefined == 0) ? "main" : "function",
553        s,
554        f->linedefined,f->lastlinedefined,
555        S(f->sizecode),LUACVOID(f)
556    );
557    printf("%d%s param%s, %d slot%s, %d upvalue%s, ",
558        (int)(f->numparams),
559        f->is_vararg?"+":"",
560        SS(f->numparams),
561        S(f->maxstacksize),
562        S(f->sizeupvalues)
563    );
564    printf("%d local%s, %d constant%s, %d function%s\n",
565        S(f->sizelocvars),
566        S(f->sizek),
567        S(f->sizep)
568    );
569}
570
571static void luaclib_aux_print_debug(const Proto* f)
572{
573    {
574        int n = f->sizek;
575        printf("constants (%d) for %p:\n", n, LUACVOID(f));
576        for (int i = 0; i < n; i++) {
577            printf("\t%d\t", i);
578            PrintType(f, i);
579            PrintConstant(f, i);
580            printf("\n");
581        }
582    }
583    {
584        int n = f->sizelocvars;
585        printf("locals (%d) for %p:\n", n, LUACVOID(f));
586        for (int i = 0; i < n; i++) {
587            printf("\t%d\t%s\t%d\t%d\n",
588                i,
589                getstr(f->locvars[i].varname),
590                f->locvars[i].startpc+1,
591                f->locvars[i].endpc+1
592            );
593        }
594    }
595    {
596        int n = f->sizeupvalues;
597        printf("upvalues (%d) for %p:\n", n, LUACVOID(f));
598        for (int i = 0; i < n; i++) {
599            printf("\t%d\t%s\t%d\t%d\n",
600                i,
601                UPVALNAME(i),
602                f->upvalues[i].instack,
603                f->upvalues[i].idx
604            );
605        }
606    }
607}
608
609/* We only have one (needs checking). */
610
611static void luaclib_aux_print_function(const Proto* f, int full)
612{
613    int n = f->sizep;
614    luaclib_aux_print_header(f);
615    luaclib_aux_print_code(f);
616    if (full) {
617        luaclib_aux_print_debug(f);
618    }
619    for (int i = 0; i < n; i++) {
620        luaclib_aux_print_function(f->p[i], full);
621    }
622}
623
624static int luaclib_print(lua_State *L)
625{
626    int full = lua_toboolean(L, 2);
627    size_t len = 0;
628    const char *str = lua_tolstring(L, 1, &len);
629    if (len > 0 && luaL_loadbuffer(L, str, len, str) == LUA_OK) {
630        const Proto *f = toproto(L, -1);
631        if (f) {
632            tmname = G(L)->tmname;
633            luaclib_aux_print_function(f, full);
634        }
635    }
636    return 0;
637}
638
639/* So far for the adapted rip-off. */
640
641void lmt_luaclib_initialize(void)
642{
643    /* not used yet */
644}
645
646static const struct luaL_Reg luaclib_function_list[] = {
647    { "print", luaclib_print },
648    { NULL,    NULL          },
649};
650
651int luaopen_luac(lua_State *L)
652{
653    lua_newtable(L);
654    luaL_setfuncs(L, luaclib_function_list, 0);
655    return 1;
656}
657