libs/lua/lua-5.3.2/loadlib.c

   1 /*
   2 ** $Id: loadlib.c,v 1.127 2015/11/23 11:30:45 roberto Exp $
   3 ** Dynamic library loader for Lua
   4 ** See Copyright Notice in lua.h
   5 **
   6 ** This module contains an implementation of loadlib for Unix systems
   7 ** that have dlfcn, an implementation for Windows, and a stub for other
   8 ** systems.
   9 */
  10
  11 #define loadlib_c
  12 #define LUA_LIB
  13
  14 #include "lprefix.h"
  15
  16
  17 #include <stdio.h>
  18 #include <stdlib.h>
  19 #include <string.h>
  20
  21 #include "lua.h"
  22
  23 #include "lauxlib.h"
  24 #include "lualib.h"
  25
  26
  27 /*
  28 ** LUA_PATH_VAR and LUA_CPATH_VAR are the names of the environment
  29 ** variables that Lua check to set its paths.
  30 */
  31 #if !defined(LUA_PATH_VAR)
  32 #define LUA_PATH_VAR    "LUA_PATH"
  33 #endif
  34
  35 #if !defined(LUA_CPATH_VAR)
  36 #define LUA_CPATH_VAR   "LUA_CPATH"
  37 #endif
  38
  39 #define LUA_PATHSUFFIX          "_" LUA_VERSION_MAJOR "_" LUA_VERSION_MINOR
  40
  41 #define LUA_PATHVARVERSION              LUA_PATH_VAR LUA_PATHSUFFIX
  42 #define LUA_CPATHVARVERSION             LUA_CPATH_VAR LUA_PATHSUFFIX
  43
  44 /*
  45 ** LUA_PATH_SEP is the character that separates templates in a path.
  46 ** LUA_PATH_MARK is the string that marks the substitution points in a
  47 ** template.
  48 ** LUA_EXEC_DIR in a Windows path is replaced by the executable's
  49 ** directory.
  50 ** LUA_IGMARK is a mark to ignore all before it when building the
  51 ** luaopen_ function name.
  52 */
  53 #if !defined (LUA_PATH_SEP)
  54 #define LUA_PATH_SEP            ";"
  55 #endif
  56 #if !defined (LUA_PATH_MARK)
  57 #define LUA_PATH_MARK           "?"
  58 #endif
  59 #if !defined (LUA_EXEC_DIR)
  60 #define LUA_EXEC_DIR            "!"
  61 #endif
  62 #if !defined (LUA_IGMARK)
  63 #define LUA_IGMARK              "-"
  64 #endif
  65
  66
  67 /*
  68 ** LUA_CSUBSEP is the character that replaces dots in submodule names
  69 ** when searching for a C loader.
  70 ** LUA_LSUBSEP is the character that replaces dots in submodule names
  71 ** when searching for a Lua loader.
  72 */
  73 #if !defined(LUA_CSUBSEP)
  74 #define LUA_CSUBSEP             LUA_DIRSEP
  75 #endif
  76
  77 #if !defined(LUA_LSUBSEP)
  78 #define LUA_LSUBSEP             LUA_DIRSEP
  79 #endif
  80
  81
  82 /* prefix for open functions in C libraries */
  83 #define LUA_POF         "luaopen_"
  84
  85 /* separator for open functions in C libraries */
  86 #define LUA_OFSEP       "_"
  87
  88
  89 /*
  90 ** unique key for table in the registry that keeps handles
  91 ** for all loaded C libraries
  92 */
  93 static const int CLIBS = 0;
  94
  95 #define LIB_FAIL        "open"
  96
  97 #define setprogdir(L)           ((void)0)
  98
  99
 100 /*
 101 ** system-dependent functions
 102 */
 103
 104 /*
 105 ** unload library 'lib'
 106 */
 107 static void lsys_unloadlib (void *lib);
 108
 109 /*
 110 ** load C library in file 'path'. If 'seeglb', load with all names in
 111 ** the library global.
 112 ** Returns the library; in case of error, returns NULL plus an
 113 ** error string in the stack.
 114 */
 115 static void *lsys_load (lua_State *L, const char *path, int seeglb);
 116
 117 /*
 118 ** Try to find a function named 'sym' in library 'lib'.
 119 ** Returns the function; in case of error, returns NULL plus an
 120 ** error string in the stack.
 121 */
 122 static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym);
 123
 124
 125
 126
 127 #if defined(LUA_USE_DLOPEN)     /* { */
 128 /*
 129 ** {========================================================================
 130 ** This is an implementation of loadlib based on the dlfcn interface.
 131 ** The dlfcn interface is available in Linux, SunOS, Solaris, IRIX, FreeBSD,
 132 ** NetBSD, AIX 4.2, HPUX 11, and  probably most other Unix flavors, at least
 133 ** as an emulation layer on top of native functions.
 134 ** =========================================================================
 135 */
 136
 137 #include <dlfcn.h>
 138
 139 /*
 140 ** Macro to convert pointer-to-void* to pointer-to-function. This cast
 141 ** is undefined according to ISO C, but POSIX assumes that it works.
 142 ** (The '__extension__' in gnu compilers is only to avoid warnings.)
 143 */
 144 #if defined(__GNUC__)
 145 #define cast_func(p) (__extension__ (lua_CFunction)(p))
 146 #else
 147 #define cast_func(p) ((lua_CFunction)(p))
 148 #endif
 149
 150
 151 static void lsys_unloadlib (void *lib) {
 152   dlclose(lib);
 153 }
 154
 155
 156 static void *lsys_load (lua_State *L, const char *path, int seeglb) {
 157   void *lib = dlopen(path, RTLD_NOW | (seeglb ? RTLD_GLOBAL : RTLD_LOCAL));
 158   if (lib == NULL) lua_pushstring(L, dlerror());
 159   return lib;
 160 }
 161
 162
 163 static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym) {
 164   lua_CFunction f = cast_func(dlsym(lib, sym));
 165   if (f == NULL) lua_pushstring(L, dlerror());
 166   return f;
 167 }
 168
 169 /* }====================================================== */
 170
 171
 172
 173 #elif defined(LUA_DL_DLL)       /* }{ */
 174 /*
 175 ** {======================================================================
 176 ** This is an implementation of loadlib for Windows using native functions.
 177 ** =======================================================================
 178 */
 179
 180 #include <windows.h>
 181
 182 #undef setprogdir
 183
 184 /*
 185 ** optional flags for LoadLibraryEx
 186 */
 187 #if !defined(LUA_LLE_FLAGS)
 188 #define LUA_LLE_FLAGS   0
 189 #endif
 190
 191
 192 static void setprogdir (lua_State *L) {
 193   char buff[MAX_PATH + 1];
 194   char *lb;
 195   DWORD nsize = sizeof(buff)/sizeof(char);
 196   DWORD n = GetModuleFileNameA(NULL, buff, nsize);
 197   if (n == 0 || n == nsize || (lb = strrchr(buff, '\\')) == NULL)
 198     luaL_error(L, "unable to get ModuleFileName");
 199   else {
 200     *lb = '\0';
 201     luaL_gsub(L, lua_tostring(L, -1), LUA_EXEC_DIR, buff);
 202     lua_remove(L, -2);  /* remove original string */
 203   }
 204 }
 205
 206
 207 static void pusherror (lua_State *L) {
 208   int error = GetLastError();
 209   char buffer[128];
 210   if (FormatMessageA(FORMAT_MESSAGE_IGNORE_INSERTS | FORMAT_MESSAGE_FROM_SYSTEM,
 211       NULL, error, 0, buffer, sizeof(buffer)/sizeof(char), NULL))
 212     lua_pushstring(L, buffer);
 213   else
 214     lua_pushfstring(L, "system error %d\n", error);
 215 }
 216
 217 static void lsys_unloadlib (void *lib) {
 218   FreeLibrary((HMODULE)lib);
 219 }
 220
 221
 222 static void *lsys_load (lua_State *L, const char *path, int seeglb) {
 223   HMODULE lib = LoadLibraryExA(path, NULL, LUA_LLE_FLAGS);
 224   (void)(seeglb);  /* not used: symbols are 'global' by default */
 225   if (lib == NULL) pusherror(L);
 226   return lib;
 227 }
 228
 229
 230 static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym) {
 231   lua_CFunction f = (lua_CFunction)GetProcAddress((HMODULE)lib, sym);
 232   if (f == NULL) pusherror(L);
 233   return f;
 234 }
 235
 236 /* }====================================================== */
 237
 238
 239 #else                           /* }{ */
 240 /*
 241 ** {======================================================
 242 ** Fallback for other systems
 243 ** =======================================================
 244 */
 245
 246 #undef LIB_FAIL
 247 #define LIB_FAIL        "absent"
 248
 249
 250 #define DLMSG   "dynamic libraries not enabled; check your Lua installation"
 251
 252
 253 static void lsys_unloadlib (void *lib) {
 254   (void)(lib);  /* not used */
 255 }
 256
 257
 258 static void *lsys_load (lua_State *L, const char *path, int seeglb) {
 259   (void)(path); (void)(seeglb);  /* not used */
 260   lua_pushliteral(L, DLMSG);
 261   return NULL;
 262 }
 263
 264
 265 static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym) {
 266   (void)(lib); (void)(sym);  /* not used */
 267   lua_pushliteral(L, DLMSG);
 268   return NULL;
 269 }
 270
 271 /* }====================================================== */
 272 #endif                          /* } */
 273
 274
 275 /*
 276 ** return registry.CLIBS[path]
 277 */
 278 static void *checkclib (lua_State *L, const char *path) {
 279   void *plib;
 280   lua_rawgetp(L, LUA_REGISTRYINDEX, &CLIBS);
 281   lua_getfield(L, -1, path);
 282   plib = lua_touserdata(L, -1);  /* plib = CLIBS[path] */
 283   lua_pop(L, 2);  /* pop CLIBS table and 'plib' */
 284   return plib;
 285 }
 286
 287
 288 /*
 289 ** registry.CLIBS[path] = plib        -- for queries
 290 ** registry.CLIBS[#CLIBS + 1] = plib  -- also keep a list of all libraries
 291 */
 292 static void addtoclib (lua_State *L, const char *path, void *plib) {
 293   lua_rawgetp(L, LUA_REGISTRYINDEX, &CLIBS);
 294   lua_pushlightuserdata(L, plib);
 295   lua_pushvalue(L, -1);
 296   lua_setfield(L, -3, path);  /* CLIBS[path] = plib */
 297   lua_rawseti(L, -2, luaL_len(L, -2) + 1);  /* CLIBS[#CLIBS + 1] = plib */
 298   lua_pop(L, 1);  /* pop CLIBS table */
 299 }
 300
 301
 302 /*
 303 ** __gc tag method for CLIBS table: calls 'lsys_unloadlib' for all lib
 304 ** handles in list CLIBS
 305 */
 306 static int gctm (lua_State *L) {
 307   lua_Integer n = luaL_len(L, 1);
 308   for (; n >= 1; n--) {  /* for each handle, in reverse order */
 309     lua_rawgeti(L, 1, n);  /* get handle CLIBS[n] */
 310     lsys_unloadlib(lua_touserdata(L, -1));
 311     lua_pop(L, 1);  /* pop handle */
 312   }
 313   return 0;
 314 }
 315
 316
 317
 318 /* error codes for 'lookforfunc' */
 319 #define ERRLIB          1
 320 #define ERRFUNC         2
 321
 322 /*
 323 ** Look for a C function named 'sym' in a dynamically loaded library
 324 ** 'path'.
 325 ** First, check whether the library is already loaded; if not, try
 326 ** to load it.
 327 ** Then, if 'sym' is '*', return true (as library has been loaded).
 328 ** Otherwise, look for symbol 'sym' in the library and push a
 329 ** C function with that symbol.
 330 ** Return 0 and 'true' or a function in the stack; in case of
 331 ** errors, return an error code and an error message in the stack.
 332 */
 333 static int lookforfunc (lua_State *L, const char *path, const char *sym) {
 334   void *reg = checkclib(L, path);  /* check loaded C libraries */
 335   if (reg == NULL) {  /* must load library? */
 336     reg = lsys_load(L, path, *sym == '*');  /* global symbols if 'sym'=='*' */
 337     if (reg == NULL) return ERRLIB;  /* unable to load library */
 338     addtoclib(L, path, reg);
 339   }
 340   if (*sym == '*') {  /* loading only library (no function)? */
 341     lua_pushboolean(L, 1);  /* return 'true' */
 342     return 0;  /* no errors */
 343   }
 344   else {
 345     lua_CFunction f = lsys_sym(L, reg, sym);
 346     if (f == NULL)
 347       return ERRFUNC;  /* unable to find function */
 348     lua_pushcfunction(L, f);  /* else create new function */
 349     return 0;  /* no errors */
 350   }
 351 }
 352
 353
 354 static int ll_loadlib (lua_State *L) {
 355   const char *path = luaL_checkstring(L, 1);
 356   const char *init = luaL_checkstring(L, 2);
 357   int stat = lookforfunc(L, path, init);
 358   if (stat == 0)  /* no errors? */
 359     return 1;  /* return the loaded function */
 360   else {  /* error; error message is on stack top */
 361     lua_pushnil(L);
 362     lua_insert(L, -2);
 363     lua_pushstring(L, (stat == ERRLIB) ?  LIB_FAIL : "init");
 364     return 3;  /* return nil, error message, and where */
 365   }
 366 }
 367
 368
 369
 370 /*
 371 ** {======================================================
 372 ** 'require' function
 373 ** =======================================================
 374 */
 375
 376
 377 static int readable (const char *filename) {
 378   FILE *f = fopen(filename, "r");  /* try to open file */
 379   if (f == NULL) return 0;  /* open failed */
 380   fclose(f);
 381   return 1;
 382 }
 383
 384
 385 static const char *pushnexttemplate (lua_State *L, const char *path) {
 386   const char *l;
 387   while (*path == *LUA_PATH_SEP) path++;  /* skip separators */
 388   if (*path == '\0') return NULL;  /* no more templates */
 389   l = strchr(path, *LUA_PATH_SEP);  /* find next separator */
 390   if (l == NULL) l = path + strlen(path);
 391   lua_pushlstring(L, path, l - path);  /* template */
 392   return l;
 393 }
 394
 395
 396 static const char *searchpath (lua_State *L, const char *name,
 397                                              const char *path,
 398                                              const char *sep,
 399                                              const char *dirsep) {
 400   luaL_Buffer msg;  /* to build error message */
 401   luaL_buffinit(L, &msg);
 402   if (*sep != '\0')  /* non-empty separator? */
 403     name = luaL_gsub(L, name, sep, dirsep);  /* replace it by 'dirsep' */
 404   while ((path = pushnexttemplate(L, path)) != NULL) {
 405     const char *filename = luaL_gsub(L, lua_tostring(L, -1),
 406                                      LUA_PATH_MARK, name);
 407     lua_remove(L, -2);  /* remove path template */
 408     if (readable(filename))  /* does file exist and is readable? */
 409       return filename;  /* return that file name */
 410     lua_pushfstring(L, "\n\tno file '%s'", filename);
 411     lua_remove(L, -2);  /* remove file name */
 412     luaL_addvalue(&msg);  /* concatenate error msg. entry */
 413   }
 414   luaL_pushresult(&msg);  /* create error message */
 415   return NULL;  /* not found */
 416 }
 417
 418
 419 static int ll_searchpath (lua_State *L) {
 420   const char *f = searchpath(L, luaL_checkstring(L, 1),
 421                                 luaL_checkstring(L, 2),
 422                                 luaL_optstring(L, 3, "."),
 423                                 luaL_optstring(L, 4, LUA_DIRSEP));
 424   if (f != NULL) return 1;
 425   else {  /* error message is on top of the stack */
 426     lua_pushnil(L);
 427     lua_insert(L, -2);
 428     return 2;  /* return nil + error message */
 429   }
 430 }
 431
 432
 433 static const char *findfile (lua_State *L, const char *name,
 434                                            const char *pname,
 435                                            const char *dirsep) {
 436   const char *path;
 437   lua_getfield(L, lua_upvalueindex(1), pname);
 438   path = lua_tostring(L, -1);
 439   if (path == NULL)
 440     luaL_error(L, "'package.%s' must be a string", pname);
 441   return searchpath(L, name, path, ".", dirsep);
 442 }
 443
 444
 445 static int checkload (lua_State *L, int stat, const char *filename) {
 446   if (stat) {  /* module loaded successfully? */
 447     lua_pushstring(L, filename);  /* will be 2nd argument to module */
 448     return 2;  /* return open function and file name */
 449   }
 450   else
 451     return luaL_error(L, "error loading module '%s' from file '%s':\n\t%s",
 452                           lua_tostring(L, 1), filename, lua_tostring(L, -1));
 453 }
 454
 455
 456 static int searcher_Lua (lua_State *L) {
 457   const char *filename;
 458   const char *name = luaL_checkstring(L, 1);
 459   filename = findfile(L, name, "path", LUA_LSUBSEP);
 460   if (filename == NULL) return 1;  /* module not found in this path */
 461   return checkload(L, (luaL_loadfile(L, filename) == LUA_OK), filename);
 462 }
 463
 464
 465 /*
 466 ** Try to find a load function for module 'modname' at file 'filename'.
 467 ** First, change '.' to '_' in 'modname'; then, if 'modname' has
 468 ** the form X-Y (that is, it has an "ignore mark"), build a function
 469 ** name "luaopen_X" and look for it. (For compatibility, if that
 470 ** fails, it also tries "luaopen_Y".) If there is no ignore mark,
 471 ** look for a function named "luaopen_modname".
 472 */
 473 static int loadfunc (lua_State *L, const char *filename, const char *modname) {
 474   const char *openfunc;
 475   const char *mark;
 476   modname = luaL_gsub(L, modname, ".", LUA_OFSEP);
 477   mark = strchr(modname, *LUA_IGMARK);
 478   if (mark) {
 479     int stat;
 480     openfunc = lua_pushlstring(L, modname, mark - modname);
 481     openfunc = lua_pushfstring(L, LUA_POF"%s", openfunc);
 482     stat = lookforfunc(L, filename, openfunc);
 483     if (stat != ERRFUNC) return stat;
 484     modname = mark + 1;  /* else go ahead and try old-style name */
 485   }
 486   openfunc = lua_pushfstring(L, LUA_POF"%s", modname);
 487   return lookforfunc(L, filename, openfunc);
 488 }
 489
 490
 491 static int searcher_C (lua_State *L) {
 492   const char *name = luaL_checkstring(L, 1);
 493   const char *filename = findfile(L, name, "cpath", LUA_CSUBSEP);
 494   if (filename == NULL) return 1;  /* module not found in this path */
 495   return checkload(L, (loadfunc(L, filename, name) == 0), filename);
 496 }
 497
 498
 499 static int searcher_Croot (lua_State *L) {
 500   const char *filename;
 501   const char *name = luaL_checkstring(L, 1);
 502   const char *p = strchr(name, '.');
 503   int stat;
 504   if (p == NULL) return 0;  /* is root */
 505   lua_pushlstring(L, name, p - name);
 506   filename = findfile(L, lua_tostring(L, -1), "cpath", LUA_CSUBSEP);
 507   if (filename == NULL) return 1;  /* root not found */
 508   if ((stat = loadfunc(L, filename, name)) != 0) {
 509     if (stat != ERRFUNC)
 510       return checkload(L, 0, filename);  /* real error */
 511     else {  /* open function not found */
 512       lua_pushfstring(L, "\n\tno module '%s' in file '%s'", name, filename);
 513       return 1;
 514     }
 515   }
 516   lua_pushstring(L, filename);  /* will be 2nd argument to module */
 517   return 2;
 518 }
 519
 520
 521 static int searcher_preload (lua_State *L) {
 522   const char *name = luaL_checkstring(L, 1);
 523   lua_getfield(L, LUA_REGISTRYINDEX, "_PRELOAD");
 524   if (lua_getfield(L, -1, name) == LUA_TNIL)  /* not found? */
 525     lua_pushfstring(L, "\n\tno field package.preload['%s']", name);
 526   return 1;
 527 }
 528
 529
 530 static void findloader (lua_State *L, const char *name) {
 531   int i;
 532   luaL_Buffer msg;  /* to build error message */
 533   luaL_buffinit(L, &msg);
 534   /* push 'package.searchers' to index 3 in the stack */
 535   if (lua_getfield(L, lua_upvalueindex(1), "searchers") != LUA_TTABLE)
 536     luaL_error(L, "'package.searchers' must be a table");
 537   /*  iterate over available searchers to find a loader */
 538   for (i = 1; ; i++) {
 539     if (lua_rawgeti(L, 3, i) == LUA_TNIL) {  /* no more searchers? */
 540       lua_pop(L, 1);  /* remove nil */
 541       luaL_pushresult(&msg);  /* create error message */
 542       luaL_error(L, "module '%s' not found:%s", name, lua_tostring(L, -1));
 543     }
 544     lua_pushstring(L, name);
 545     lua_call(L, 1, 2);  /* call it */
 546     if (lua_isfunction(L, -2))  /* did it find a loader? */
 547       return;  /* module loader found */
 548     else if (lua_isstring(L, -2)) {  /* searcher returned error message? */
 549       lua_pop(L, 1);  /* remove extra return */
 550       luaL_addvalue(&msg);  /* concatenate error message */
 551     }
 552     else
 553       lua_pop(L, 2);  /* remove both returns */
 554   }
 555 }
 556
 557
 558 static int ll_require (lua_State *L) {
 559   const char *name = luaL_checkstring(L, 1);
 560   lua_settop(L, 1);  /* _LOADED table will be at index 2 */
 561   lua_getfield(L, LUA_REGISTRYINDEX, "_LOADED");
 562   lua_getfield(L, 2, name);  /* _LOADED[name] */
 563   if (lua_toboolean(L, -1))  /* is it there? */
 564     return 1;  /* package is already loaded */
 565   /* else must load package */
 566   lua_pop(L, 1);  /* remove 'getfield' result */
 567   findloader(L, name);
 568   lua_pushstring(L, name);  /* pass name as argument to module loader */
 569   lua_insert(L, -2);  /* name is 1st argument (before search data) */
 570   lua_call(L, 2, 1);  /* run loader to load module */
 571   if (!lua_isnil(L, -1))  /* non-nil return? */
 572     lua_setfield(L, 2, name);  /* _LOADED[name] = returned value */
 573   if (lua_getfield(L, 2, name) == LUA_TNIL) {   /* module set no value? */
 574     lua_pushboolean(L, 1);  /* use true as result */
 575     lua_pushvalue(L, -1);  /* extra copy to be returned */
 576     lua_setfield(L, 2, name);  /* _LOADED[name] = true */
 577   }
 578   return 1;
 579 }
 580
 581 /* }====================================================== */
 582
 583
 584
 585 /*
 586 ** {======================================================
 587 ** 'module' function
 588 ** =======================================================
 589 */
 590 #if defined(LUA_COMPAT_MODULE)
 591
 592 /*
 593 ** changes the environment variable of calling function
 594 */
 595 static void set_env (lua_State *L) {
 596   lua_Debug ar;
 597   if (lua_getstack(L, 1, &ar) == 0 ||
 598       lua_getinfo(L, "f", &ar) == 0 ||  /* get calling function */
 599       lua_iscfunction(L, -1))
 600     luaL_error(L, "'module' not called from a Lua function");
 601   lua_pushvalue(L, -2);  /* copy new environment table to top */
 602   lua_setupvalue(L, -2, 1);
 603   lua_pop(L, 1);  /* remove function */
 604 }
 605
 606
 607 static void dooptions (lua_State *L, int n) {
 608   int i;
 609   for (i = 2; i <= n; i++) {
 610     if (lua_isfunction(L, i)) {  /* avoid 'calling' extra info. */
 611       lua_pushvalue(L, i);  /* get option (a function) */
 612       lua_pushvalue(L, -2);  /* module */
 613       lua_call(L, 1, 0);
 614     }
 615   }
 616 }
 617
 618
 619 static void modinit (lua_State *L, const char *modname) {
 620   const char *dot;
 621   lua_pushvalue(L, -1);
 622   lua_setfield(L, -2, "_M");  /* module._M = module */
 623   lua_pushstring(L, modname);
 624   lua_setfield(L, -2, "_NAME");
 625   dot = strrchr(modname, '.');  /* look for last dot in module name */
 626   if (dot == NULL) dot = modname;
 627   else dot++;
 628   /* set _PACKAGE as package name (full module name minus last part) */
 629   lua_pushlstring(L, modname, dot - modname);
 630   lua_setfield(L, -2, "_PACKAGE");
 631 }
 632
 633
 634 static int ll_module (lua_State *L) {
 635   const char *modname = luaL_checkstring(L, 1);
 636   int lastarg = lua_gettop(L);  /* last parameter */
 637   luaL_pushmodule(L, modname, 1);  /* get/create module table */
 638   /* check whether table already has a _NAME field */
 639   if (lua_getfield(L, -1, "_NAME") != LUA_TNIL)
 640     lua_pop(L, 1);  /* table is an initialized module */
 641   else {  /* no; initialize it */
 642     lua_pop(L, 1);
 643     modinit(L, modname);
 644   }
 645   lua_pushvalue(L, -1);
 646   set_env(L);
 647   dooptions(L, lastarg);
 648   return 1;
 649 }
 650
 651
 652 static int ll_seeall (lua_State *L) {
 653   luaL_checktype(L, 1, LUA_TTABLE);
 654   if (!lua_getmetatable(L, 1)) {
 655     lua_createtable(L, 0, 1); /* create new metatable */
 656     lua_pushvalue(L, -1);
 657     lua_setmetatable(L, 1);
 658   }
 659   lua_pushglobaltable(L);
 660   lua_setfield(L, -2, "__index");  /* mt.__index = _G */
 661   return 0;
 662 }
 663
 664 #endif
 665 /* }====================================================== */
 666
 667
 668
 669 /* auxiliary mark (for internal use) */
 670 #define AUXMARK         "\1"
 671
 672
 673 /*
 674 ** return registry.LUA_NOENV as a boolean
 675 */
 676 static int noenv (lua_State *L) {
 677   int b;
 678   lua_getfield(L, LUA_REGISTRYINDEX, "LUA_NOENV");
 679   b = lua_toboolean(L, -1);
 680   lua_pop(L, 1);  /* remove value */
 681   return b;
 682 }
 683
 684
 685 static void setpath (lua_State *L, const char *fieldname, const char *envname1,
 686                                    const char *envname2, const char *def) {
 687   const char *path = getenv(envname1);
 688   if (path == NULL)  /* no environment variable? */
 689     path = getenv(envname2);  /* try alternative name */
 690   if (path == NULL || noenv(L))  /* no environment variable? */
 691     lua_pushstring(L, def);  /* use default */
 692   else {
 693     /* replace ";;" by ";AUXMARK;" and then AUXMARK by default path */
 694     path = luaL_gsub(L, path, LUA_PATH_SEP LUA_PATH_SEP,
 695                               LUA_PATH_SEP AUXMARK LUA_PATH_SEP);
 696     luaL_gsub(L, path, AUXMARK, def);
 697     lua_remove(L, -2);
 698   }
 699   setprogdir(L);
 700   lua_setfield(L, -2, fieldname);
 701 }
 702
 703
 704 static const luaL_Reg pk_funcs[] = {
 705   {"loadlib", ll_loadlib},
 706   {"searchpath", ll_searchpath},
 707 #if defined(LUA_COMPAT_MODULE)
 708   {"seeall", ll_seeall},
 709 #endif
 710   /* placeholders */
 711   {"preload", NULL},
 712   {"cpath", NULL},
 713   {"path", NULL},
 714   {"searchers", NULL},
 715   {"loaded", NULL},
 716   {NULL, NULL}
 717 };
 718
 719
 720 static const luaL_Reg ll_funcs[] = {
 721 #if defined(LUA_COMPAT_MODULE)
 722   {"module", ll_module},
 723 #endif
 724   {"require", ll_require},
 725   {NULL, NULL}
 726 };
 727
 728
 729 static void createsearcherstable (lua_State *L) {
 730   static const lua_CFunction searchers[] =
 731     {searcher_preload, searcher_Lua, searcher_C, searcher_Croot, NULL};
 732   int i;
 733   /* create 'searchers' table */
 734   lua_createtable(L, sizeof(searchers)/sizeof(searchers[0]) - 1, 0);
 735   /* fill it with predefined searchers */
 736   for (i=0; searchers[i] != NULL; i++) {
 737     lua_pushvalue(L, -2);  /* set 'package' as upvalue for all searchers */
 738     lua_pushcclosure(L, searchers[i], 1);
 739     lua_rawseti(L, -2, i+1);
 740   }
 741 #if defined(LUA_COMPAT_LOADERS)
 742   lua_pushvalue(L, -1);  /* make a copy of 'searchers' table */
 743   lua_setfield(L, -3, "loaders");  /* put it in field 'loaders' */
 744 #endif
 745   lua_setfield(L, -2, "searchers");  /* put it in field 'searchers' */
 746 }
 747
 748
 749 /*
 750 ** create table CLIBS to keep track of loaded C libraries,
 751 ** setting a finalizer to close all libraries when closing state.
 752 */
 753 static void createclibstable (lua_State *L) {
 754   lua_newtable(L);  /* create CLIBS table */
 755   lua_createtable(L, 0, 1);  /* create metatable for CLIBS */
 756   lua_pushcfunction(L, gctm);
 757   lua_setfield(L, -2, "__gc");  /* set finalizer for CLIBS table */
 758   lua_setmetatable(L, -2);
 759   lua_rawsetp(L, LUA_REGISTRYINDEX, &CLIBS);  /* set CLIBS table in registry */
 760 }
 761
 762
 763 LUAMOD_API int luaopen_package (lua_State *L) {
 764   createclibstable(L);
 765   luaL_newlib(L, pk_funcs);  /* create 'package' table */
 766   createsearcherstable(L);
 767   /* set field 'path' */
 768   setpath(L, "path", LUA_PATHVARVERSION, LUA_PATH_VAR, LUA_PATH_DEFAULT);
 769   /* set field 'cpath' */
 770   setpath(L, "cpath", LUA_CPATHVARVERSION, LUA_CPATH_VAR, LUA_CPATH_DEFAULT);
 771   /* store config information */
 772   lua_pushliteral(L, LUA_DIRSEP "\n" LUA_PATH_SEP "\n" LUA_PATH_MARK "\n"
 773                      LUA_EXEC_DIR "\n" LUA_IGMARK "\n");
 774   lua_setfield(L, -2, "config");
 775   /* set field 'loaded' */
 776   luaL_getsubtable(L, LUA_REGISTRYINDEX, "_LOADED");
 777   lua_setfield(L, -2, "loaded");
 778   /* set field 'preload' */
 779   luaL_getsubtable(L, LUA_REGISTRYINDEX, "_PRELOAD");
 780   lua_setfield(L, -2, "preload");
 781   lua_pushglobaltable(L);
 782   lua_pushvalue(L, -2);  /* set 'package' as upvalue for next lib */
 783   luaL_setfuncs(L, ll_funcs, 1);  /* open lib into global table */
 784   lua_pop(L, 1);  /* pop global table */
 785   return 1;  /* return 'package' table */
 786 }
 787