source/texk/web2c/luatexdir/lua/luastuff.w

   1 % luastuff.w
   2 %
   3 % Copyright 2006-2013 Taco Hoekwater <taco@@luatex.org>
   4 %
   5 % This file is part of LuaTeX.
   6 %
   7 % LuaTeX is free software; you can redistribute it and/or modify it under
   8 % the terms of the GNU General Public License as published by the Free
   9 % Software Foundation; either version 2 of the License, or (at your
  10 % option) any later version.
  11 %
  12 % LuaTeX is distributed in the hope that it will be useful, but WITHOUT
  13 % ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14 % FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
  15 % License for more details.
  16 %
  17 % You should have received a copy of the GNU General Public License along
  18 % with LuaTeX; if not, see <http://www.gnu.org/licenses/>.
  19
  20 @ @c
  21 #include "ptexlib.h"
  22 #include "lua/luatex-api.h"
  23
  24 @ @c
  25 lua_State *Luas = NULL;
  26
  27 int luastate_bytes = 0;
  28 int lua_active = 0;
  29
  30 @ @c
  31 void make_table(lua_State * L, const char *tab, const char *mttab, const char *getfunc,
  32                 const char *setfunc)
  33 {
  34     /* make the table *//* |[{<tex>}]| */
  35     lua_pushstring(L, tab);     /* |[{<tex>},"dimen"]| */
  36     lua_newtable(L);            /* |[{<tex>},"dimen",{}]| */
  37     lua_settable(L, -3);        /* |[{<tex>}]| */
  38     /* fetch it back */
  39     lua_pushstring(L, tab);     /* |[{<tex>},"dimen"]| */
  40     lua_gettable(L, -2);        /* |[{<tex>},{<dimen>}]| */
  41     /* make the meta entries */
  42     luaL_newmetatable(L, mttab);  /* |[{<tex>},{<dimen>},{<dimen_m>}]| */
  43     lua_pushstring(L, "__index");       /* |[{<tex>},{<dimen>},{<dimen_m>},"__index"]| */
  44     lua_pushstring(L, getfunc); /* |[{<tex>},{<dimen>},{<dimen_m>},"__index","getdimen"]| */
  45     lua_gettable(L, -5);        /* |[{<tex>},{<dimen>},{<dimen_m>},"__index",<tex.getdimen>]| */
  46     lua_settable(L, -3);        /* |[{<tex>},{<dimen>},{<dimen_m>}]|  */
  47     lua_pushstring(L, "__newindex");    /* |[{<tex>},{<dimen>},{<dimen_m>},"__newindex"]| */
  48     lua_pushstring(L, setfunc); /* |[{<tex>},{<dimen>},{<dimen_m>},"__newindex","setdimen"]| */
  49     lua_gettable(L, -5);        /* |[{<tex>},{<dimen>},{<dimen_m>},"__newindex",<tex.setdimen>]| */
  50     lua_settable(L, -3);        /* |[{<tex>},{<dimen>},{<dimen_m>}]| */
  51     lua_setmetatable(L, -2);    /* |[{<tex>},{<dimen>}]| : assign the metatable */
  52     lua_pop(L, 1);              /* |[{<tex>}]| : clean the stack */
  53 }
  54
  55 @ @c
  56 static const char *getS(lua_State * L, void *ud, size_t * size)
  57 {
  58     LoadS *ls = (LoadS *) ud;
  59     (void) L;
  60     if (ls->size == 0)
  61         return NULL;
  62     *size = ls->size;
  63     ls->size = 0;
  64     return ls->s;
  65 }
  66
  67 @ @c
  68 static void *my_luaalloc(void *ud, void *ptr, size_t osize, size_t nsize)
  69 {
  70     void *ret = NULL;
  71     (void) ud;                  /* for -Wunused */
  72     if (nsize == 0)
  73         free(ptr);
  74     else
  75         ret = realloc(ptr, nsize);
  76     luastate_bytes += (int) (nsize - osize);
  77     return ret;
  78 }
  79
  80 @ @c
  81 static int my_luapanic(lua_State * L)
  82 {
  83     (void) L;                   /* to avoid warnings */
  84     fprintf(stderr, "PANIC: unprotected error in call to Lua API (%s)\n", lua_tostring(L, -1));
  85     return 0;
  86 }
  87
  88 @ @c
  89 void luafunctioncall(int slot)
  90 {
  91     int i ;
  92     int stacktop = lua_gettop(Luas);
  93     lua_active++;
  94     lua_rawgeti(Luas, LUA_REGISTRYINDEX, lua_key_index(lua_functions));
  95     lua_gettable(Luas, LUA_REGISTRYINDEX);
  96     lua_rawgeti(Luas, -1,slot);
  97     if (lua_isfunction(Luas,-1)) {
  98         int base = lua_gettop(Luas); /* function index */
  99         lua_pushinteger(Luas, slot);
 100         lua_pushcfunction(Luas, lua_traceback); /* push traceback function */
 101         lua_insert(Luas, base); /* put it under chunk  */
 102         i = lua_pcall(Luas, 1, 0, base);
 103         lua_remove(Luas, base); /* remove traceback function */
 104         if (i != 0) {
 105             lua_gc(Luas, LUA_GCCOLLECT, 0);
 106             Luas = luatex_error(Luas, (i == LUA_ERRRUN ? 0 : 1));
 107         }
 108     }
 109     lua_settop(Luas,stacktop);
 110     lua_active--;
 111 }
 112
 113 @ @c
 114 static const luaL_Reg lualibs[] = {
 115     {"", luaopen_base},
 116     {"package", luaopen_package},
 117     {"coroutine", luaopen_coroutine},
 118     {"table", luaopen_table},
 119     {"io", open_iolibext},
 120     {"os", luaopen_os},
 121     {"string", luaopen_string},
 122     {"math", luaopen_math},
 123     {"debug", luaopen_debug},
 124     {"unicode", luaopen_unicode},
 125     {"zip", luaopen_zip},
 126     {"bit32", luaopen_bit32},
 127     {"md5", luaopen_md5},
 128     {"lfs", luaopen_lfs},
 129     {"profiler", luaopen_profiler},
 130     {"lpeg", luaopen_lpeg},
 131     {NULL, NULL}
 132 };
 133
 134 @ @c
 135 static void do_openlibs(lua_State * L)
 136 {
 137     const luaL_Reg *lib;
 138     for (lib = lualibs; lib->func; lib++) {
 139         luaL_requiref(L, lib->name, lib->func, 1);
 140         lua_pop(L, 1);  /* remove lib */
 141     }
 142 }
 143
 144 @ @c
 145 static int load_aux (lua_State *L, int status) {
 146   if (status == 0)  /* OK? */
 147     return 1;
 148   else {
 149     lua_pushnil(L);
 150     lua_insert(L, -2);  /* put before error message */
 151     return 2;  /* return nil plus error message */
 152   }
 153 }
 154
 155 @ @c
 156 static int luatex_loadfile (lua_State *L) {
 157   int status = 0;
 158   const char *fname = luaL_optstring(L, 1, NULL);
 159   const char *mode = luaL_optstring(L, 2, NULL);
 160   int env = !lua_isnone(L, 3);  /* 'env' parameter? */
 161   if (!lua_only && !fname && interaction == batch_mode) {
 162      lua_pushnil(L);
 163      lua_pushstring(L, "reading from stdin is disabled in batch mode");
 164      return 2;  /* return nil plus error message */
 165   }
 166   status = luaL_loadfilex(L, fname, mode);
 167   if (status == LUA_OK) {
 168     recorder_record_input(fname);
 169     if (env) {  /* 'env' parameter? */
 170       lua_pushvalue(L, 3);
 171       lua_setupvalue(L, -2, 1);  /* set it as 1st upvalue of loaded chunk */
 172     }
 173   }
 174   return load_aux(L, status);
 175 }
 176
 177 @ @c
 178 static int luatex_dofile (lua_State *L) {
 179   const char *fname = luaL_optstring(L, 1, NULL);
 180   int n = lua_gettop(L);
 181   if (!lua_only && !fname) {
 182       if (interaction == batch_mode) {
 183           lua_pushnil(L);
 184           lua_pushstring(L, "reading from stdin is disabled in batch mode");
 185           return 2;  /* return nil plus error message */
 186       } else {
 187           tprint_nl("lua> ");
 188       }
 189   }
 190   if (luaL_loadfile(L, fname) != 0) lua_error(L);
 191   recorder_record_input(fname);
 192   lua_call(L, 0, LUA_MULTRET);
 193   return lua_gettop(L) - n;
 194 }
 195
 196 @ @c
 197 void luainterpreter(void)
 198 {
 199     lua_State *L;
 200     L = lua_newstate(my_luaalloc, NULL);
 201     if (L == NULL) {
 202         fprintf(stderr, "Can't create the Lua state.\n");
 203         return;
 204     }
 205     lua_atpanic(L, &my_luapanic);
 206
 207     do_openlibs(L);             /* does all the 'simple' libraries */
 208
 209     lua_pushcfunction(L,luatex_dofile);
 210     lua_setglobal(L, "dofile");
 211     lua_pushcfunction(L,luatex_loadfile);
 212     lua_setglobal(L, "loadfile");
 213
 214     luatex_md5_lua_open(L);
 215
 216     open_oslibext(L, safer_option);
 217 /*
 218     open_iolibext(L);
 219 */
 220     open_strlibext(L);
 221     open_lfslibext(L);
 222
 223     /* luasockets */
 224     /* socket and mime are a bit tricky to open because
 225      they use a load-time  dependency that has to be
 226      worked around for luatex, where the C module is
 227      loaded way before the lua module.
 228      */
 229     if (!nosocket_option) {
 230         lua_getglobal(L, "package");
 231         lua_getfield(L, -1, "loaded");
 232         if (!lua_istable(L, -1)) {
 233             lua_newtable(L);
 234             lua_setfield(L, -2, "loaded");
 235             lua_getfield(L, -1, "loaded");
 236         }
 237         luaopen_socket_core(L);
 238         lua_setfield(L, -2, "socket.core");
 239         lua_pushnil(L);
 240         lua_setfield(L, -2, "socket");  /* package.loaded.socket = nil */
 241
 242         luaopen_mime_core(L);
 243         lua_setfield(L, -2, "mime.core");
 244         lua_pushnil(L);
 245         lua_setfield(L, -2, "mime");    /* package.loaded.mime = nil */
 246         lua_pop(L, 2);          /* pop the tables */
 247
 248         luatex_socketlua_open(L);       /* preload the pure lua modules */
 249     }
 250     /* zlib. slightly odd calling convention */
 251     luaopen_zlib(L);
 252     lua_setglobal(L, "zlib");
 253     luaopen_gzip(L);
 254
 255     /* our own libraries */
 256     luaopen_ff(L);
 257     luaopen_tex(L);
 258     luaopen_token(L);
 259     luaopen_node(L);
 260     luaopen_texio(L);
 261     luaopen_kpse(L);
 262     luaopen_callback(L);
 263     luaopen_lua(L, startup_filename);
 264     luaopen_stats(L);
 265     luaopen_font(L);
 266     luaopen_lang(L);
 267     luaopen_mplib(L);
 268     luaopen_vf(L);
 269
 270     /* |luaopen_pdf(L);| */
 271     /* environment table at |LUA_ENVIRONINDEX| needs to load this way: */
 272     lua_pushcfunction(L, luaopen_pdf);
 273     lua_pushstring(L, "pdf");
 274     lua_call(L, 1, 0);
 275
 276     if (!lua_only) {
 277         luaL_requiref(L, "img", luaopen_img, 1);
 278         lua_pop(L, 1);
 279     }
 280
 281     luaL_requiref(L, "epdf", luaopen_epdf, 1);
 282     lua_pop(L, 1);
 283
 284     /* |luaopen_pdfscanner(L);| */
 285     lua_pushcfunction(L, luaopen_pdfscanner);
 286     lua_pushstring(L, "pdfscanner");
 287     lua_call(L, 1, 0);
 288
 289     lua_createtable(L, 0, 0);
 290     lua_setglobal(L, "texconfig");
 291
 292     if (safer_option) {
 293         /* disable some stuff if --safer */
 294         (void) hide_lua_value(L, "os", "execute");
 295         (void) hide_lua_value(L, "os", "rename");
 296         (void) hide_lua_value(L, "os", "remove");
 297         (void) hide_lua_value(L, "io", "popen");
 298         /* make io.open only read files */
 299         luaL_checkstack(L, 2, "out of stack space");
 300         lua_getglobal(L, "io");
 301         lua_getfield(L, -1, "open_ro");
 302         lua_setfield(L, -2, "open");
 303         (void) hide_lua_value(L, "io", "tmpfile");
 304         (void) hide_lua_value(L, "io", "output");
 305         (void) hide_lua_value(L, "lfs", "chdir");
 306         (void) hide_lua_value(L, "lfs", "lock");
 307         (void) hide_lua_value(L, "lfs", "touch");
 308         (void) hide_lua_value(L, "lfs", "rmdir");
 309         (void) hide_lua_value(L, "lfs", "mkdir");
 310     }
 311     Luas = L;
 312 }
 313
 314 @ @c
 315 int hide_lua_table(lua_State * L, const char *name)
 316 {
 317     int r = 0;
 318     lua_getglobal(L, name);
 319     if (lua_istable(L, -1)) {
 320         r = luaL_ref(L, LUA_REGISTRYINDEX);
 321         lua_pushnil(L);
 322         lua_setglobal(L, name);
 323     }
 324     return r;
 325 }
 326
 327 @ @c
 328 void unhide_lua_table(lua_State * L, const char *name, int r)
 329 {
 330     lua_rawgeti(L, LUA_REGISTRYINDEX, r);
 331     lua_setglobal(L, name);
 332     luaL_unref(L, LUA_REGISTRYINDEX, r);
 333 }
 334
 335 @ @c
 336 int hide_lua_value(lua_State * L, const char *name, const char *item)
 337 {
 338     int r = 0;
 339     lua_getglobal(L, name);
 340     if (lua_istable(L, -1)) {
 341         lua_getfield(L, -1, item);
 342         r = luaL_ref(L, LUA_REGISTRYINDEX);
 343         lua_pushnil(L);
 344         lua_setfield(L, -2, item);
 345     }
 346     return r;
 347 }
 348
 349 @ @c
 350 void unhide_lua_value(lua_State * L, const char *name, const char *item, int r)
 351 {
 352     lua_getglobal(L, name);
 353     if (lua_istable(L, -1)) {
 354         lua_rawgeti(L, LUA_REGISTRYINDEX, r);
 355         lua_setfield(L, -2, item);
 356         luaL_unref(L, LUA_REGISTRYINDEX, r);
 357     }
 358 }
 359
 360 @ @c
 361 int lua_traceback(lua_State * L)
 362 {
 363     lua_getglobal(L, "debug");
 364     if (!lua_istable(L, -1)) {
 365         lua_pop(L, 1);
 366         return 1;
 367     }
 368     lua_getfield(L, -1, "traceback");
 369     if (!lua_isfunction(L, -1)) {
 370         lua_pop(L, 2);
 371         return 1;
 372     }
 373     lua_pushvalue(L, 1);        /* pass error message */
 374     lua_pushinteger(L, 2);      /* skip this function and traceback */
 375     lua_call(L, 2, 1);          /* call debug.traceback */
 376     return 1;
 377 }
 378
 379 @ @c
 380 static void luacall(int p, int nameptr, boolean is_string) /* hh-ls: optimized lua_id resolving */
 381 {
 382     LoadS ls;
 383     int i;
 384     size_t ll = 0;
 385     char *lua_id;
 386     char *s = NULL;
 387
 388     if (Luas == NULL) {
 389         luainterpreter();
 390     }
 391     lua_active++;
 392     if (is_string) {
 393         const char *ss = NULL;
 394         lua_rawgeti(Luas, LUA_REGISTRYINDEX, p);
 395         if (lua_isfunction(Luas,-1)) {
 396             int base = lua_gettop(Luas);        /* function index */
 397             lua_checkstack(Luas, 1);
 398             lua_pushcfunction(Luas, lua_traceback);     /* push traceback function */
 399             lua_insert(Luas, base);     /* put it under chunk  */
 400             i = lua_pcall(Luas, 0, 0, base);
 401             lua_remove(Luas, base);     /* remove traceback function */
 402             if (i != 0) {
 403                 lua_gc(Luas, LUA_GCCOLLECT, 0);
 404                 Luas = luatex_error(Luas, (i == LUA_ERRRUN ? 0 : 1));
 405             }
 406             lua_active--;
 407             return ;
 408         }
 409         ss = lua_tolstring(Luas, -1, &ll);
 410         s = xmalloc(ll+1);
 411         memcpy(s,ss,ll+1);
 412         lua_pop(Luas,1);
 413     } else {
 414         int l = 0;
 415         s = tokenlist_to_cstring(p, 1, &l);
 416         ll = (size_t)l;
 417     }
 418     ls.s = s;
 419     ls.size = ll;
 420     if (ls.size > 0) {
 421         if (nameptr > 0) {
 422             int l = 0; /* not used */
 423             lua_id = tokenlist_to_cstring(nameptr, 1, &l);
 424             i = lua_load(Luas, getS, &ls, lua_id, NULL);
 425             xfree(lua_id);
 426         } else if (nameptr < 0) {
 427             lua_id = get_lua_name((nameptr + 65536));
 428             if (lua_id != NULL) {
 429                 i = lua_load(Luas, getS, &ls, lua_id, NULL);
 430             } else {
 431                 i = lua_load(Luas, getS, &ls, "=[\\latelua]", NULL);
 432             }
 433         } else {
 434             i = lua_load(Luas, getS, &ls, "=[\\latelua]", NULL);
 435         }
 436         if (i != 0) {
 437             Luas = luatex_error(Luas, (i == LUA_ERRSYNTAX ? 0 : 1));
 438         } else {
 439             int base = lua_gettop(Luas);        /* function index */
 440             lua_checkstack(Luas, 1);
 441             lua_pushcfunction(Luas, lua_traceback);     /* push traceback function */
 442             lua_insert(Luas, base);     /* put it under chunk  */
 443             i = lua_pcall(Luas, 0, 0, base);
 444             lua_remove(Luas, base);     /* remove traceback function */
 445             if (i != 0) {
 446                 lua_gc(Luas, LUA_GCCOLLECT, 0);
 447                 Luas = luatex_error(Luas, (i == LUA_ERRRUN ? 0 : 1));
 448             }
 449         }
 450         xfree(ls.s);
 451     }
 452     lua_active--;
 453 }
 454
 455 @ @c
 456 void late_lua(PDF pdf, halfword p)
 457 {
 458     (void) pdf;
 459     if (late_lua_type(p)==normal) {
 460         expand_macros_in_tokenlist(p);      /* sets |def_ref| */
 461         luacall(def_ref, late_lua_name(p), false);
 462         flush_list(def_ref);
 463     } else {
 464         luacall(late_lua_data(p), late_lua_name(p), true);
 465     }
 466 }
 467
 468 @ @c
 469 void luatokencall(int p, int nameptr) /* hh-ls: optimized lua_id resolving */
 470 {
 471     LoadS ls;
 472     int i, l;
 473     char *s = NULL;
 474     char *lua_id;
 475     assert(Luas);
 476     l = 0;
 477     lua_active++;
 478     s = tokenlist_to_cstring(p, 1, &l);
 479     ls.s = s;
 480     ls.size = (size_t) l;
 481     if (ls.size > 0) {
 482         if (nameptr > 0) {
 483             lua_id = tokenlist_to_cstring(nameptr, 1, &l);
 484             i = lua_load(Luas, getS, &ls, lua_id, NULL);
 485             xfree(lua_id);
 486         } else if (nameptr < 0) {
 487             lua_id = get_lua_name((nameptr + 65536));
 488             if (lua_id != NULL) {
 489                 i = lua_load(Luas, getS, &ls, lua_id, NULL);
 490             } else {
 491                 i = lua_load(Luas, getS, &ls, "=[\\directlua]", NULL);
 492             }
 493         } else {
 494             i = lua_load(Luas, getS, &ls, "=[\\directlua]", NULL);
 495         }
 496         xfree(s);
 497         if (i != 0) {
 498             Luas = luatex_error(Luas, (i == LUA_ERRSYNTAX ? 0 : 1));
 499         } else {
 500             int base = lua_gettop(Luas);        /* function index */
 501             lua_checkstack(Luas, 1);
 502             lua_pushcfunction(Luas, lua_traceback);     /* push traceback function */
 503             lua_insert(Luas, base);     /* put it under chunk  */
 504             i = lua_pcall(Luas, 0, 0, base);
 505             lua_remove(Luas, base);     /* remove traceback function */
 506             if (i != 0) {
 507                 lua_gc(Luas, LUA_GCCOLLECT, 0);
 508                 Luas = luatex_error(Luas, (i == LUA_ERRRUN ? 0 : 1));
 509             }
 510         }
 511     }
 512     lua_active--;
 513 }
 514
 515 @ @c
 516 lua_State *luatex_error(lua_State * L, int is_fatal)
 517 {
 518
 519     const_lstring luaerr;
 520     char *err = NULL;
 521     if (lua_type(L, -1) == LUA_TSTRING) {
 522         luaerr.s = lua_tolstring(L, -1, &luaerr.l);
 523         /* free last one ? */
 524         err = (char *) xmalloc((unsigned) (luaerr.l + 1));
 525         snprintf(err, (luaerr.l + 1), "%s", luaerr.s);
 526         last_lua_error = err; /* hm, what if we have several .. not freed */
 527     }
 528     if (is_fatal > 0) {
 529         /* Normally a memory error from lua.
 530            The pool may overflow during the |maketexlstring()|, but we
 531            are crashing anyway so we may as well abort on the pool size */
 532         normal_error("lua",err);
 533         /* never reached */
 534         lua_close(L);
 535         return (lua_State *) NULL;
 536     } else {
 537         normal_warning("lua",err);
 538         return L;
 539     }
 540 }
 541
 542 @ @c
 543 void preset_environment(lua_State * L, const parm_struct * p, const char *s)
 544 {
 545     int i;
 546     assert(L != NULL);
 547     /* double call with same s gives assert(0) */
 548     lua_pushstring(L, s);       /* s */
 549     lua_gettable(L, LUA_REGISTRYINDEX); /* t */
 550     assert(lua_isnil(L, -1));
 551     lua_pop(L, 1);              /* - */
 552     lua_pushstring(L, s);       /* s */
 553     lua_newtable(L);            /* t s */
 554     for (i = 1, ++p; p->name != NULL; i++, p++) {
 555         assert(i == p->idx);
 556         lua_pushstring(L, p->name);     /* k t s */
 557         lua_pushinteger(L, p->idx);     /* v k t s */
 558         lua_settable(L, -3);    /* t s */
 559     }
 560     lua_settable(L, LUA_REGISTRYINDEX); /* - */
 561 }