Mercurial > vba-clojure

annotate src/lua/loadlib.c @ 16:9e598342e182

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
clean up lua Makefile.am
author Robert McIntyre <rlm@mit.edu>
date Sat, 03 Mar 2012 11:38:28 -0600
parents 27763b933818
children 44974c3e093b
rev   line source
rlm@1 1 /*
rlm@1 2 ** $Id: loadlib.c,v 1.52.1.3 2008/08/06 13:29:28 roberto Exp $
rlm@1 3 ** Dynamic library loader for Lua
rlm@1 4 ** See Copyright Notice in lua.h
rlm@1 5 **
rlm@1 6 ** This module contains an implementation of loadlib for Unix systems
rlm@1 7 ** that have dlfcn, an implementation for Darwin (Mac OS X), an
rlm@1 8 ** implementation for Windows, and a stub for other systems.
rlm@1 9 */
rlm@1 10
rlm@1 11
rlm@1 12 #include <stdlib.h>
rlm@1 13 #include <string.h>
rlm@1 14
rlm@1 15
rlm@1 16 #define loadlib_c
rlm@1 17 #define LUA_LIB
rlm@1 18
rlm@1 19 #include "lua.h"
rlm@1 20
rlm@1 21 #include "lauxlib.h"
rlm@1 22 #include "lualib.h"
rlm@1 23
rlm@1 24
rlm@1 25 /* prefix for open functions in C libraries */
rlm@1 26 #define LUA_POF "luaopen_"
rlm@1 27
rlm@1 28 /* separator for open functions in C libraries */
rlm@1 29 #define LUA_OFSEP "_"
rlm@1 30
rlm@1 31
rlm@1 32 #define LIBPREFIX "LOADLIB: "
rlm@1 33
rlm@1 34 #define POF LUA_POF
rlm@1 35 #define LIB_FAIL "open"
rlm@1 36
rlm@1 37
rlm@1 38 /* error codes for ll_loadfunc */
rlm@1 39 #define ERRLIB 1
rlm@1 40 #define ERRFUNC 2
rlm@1 41
rlm@1 42 #define setprogdir(L) ((void)0)
rlm@1 43
rlm@1 44
rlm@1 45 static void ll_unloadlib (void *lib);
rlm@1 46 static void *ll_load (lua_State *L, const char *path);
rlm@1 47 static lua_CFunction ll_sym (lua_State *L, void *lib, const char *sym);
rlm@1 48
rlm@1 49
rlm@1 50
rlm@1 51 #if defined(LUA_DL_DLOPEN)
rlm@1 52 /*
rlm@1 53 ** {========================================================================
rlm@1 54 ** This is an implementation of loadlib based on the dlfcn interface.
rlm@1 55 ** The dlfcn interface is available in Linux, SunOS, Solaris, IRIX, FreeBSD,
rlm@1 56 ** NetBSD, AIX 4.2, HPUX 11, and probably most other Unix flavors, at least
rlm@1 57 ** as an emulation layer on top of native functions.
rlm@1 58 ** =========================================================================
rlm@1 59 */
rlm@1 60
rlm@1 61 #include <dlfcn.h>
rlm@1 62
rlm@1 63 static void ll_unloadlib (void *lib) {
rlm@1 64 dlclose(lib);
rlm@1 65 }
rlm@1 66
rlm@1 67
rlm@1 68 static void *ll_load (lua_State *L, const char *path) {
rlm@1 69 void *lib = dlopen(path, RTLD_NOW);
rlm@1 70 if (lib == NULL) lua_pushstring(L, dlerror());
rlm@1 71 return lib;
rlm@1 72 }
rlm@1 73
rlm@1 74
rlm@1 75 static lua_CFunction ll_sym (lua_State *L, void *lib, const char *sym) {
rlm@1 76 lua_CFunction f = (lua_CFunction)dlsym(lib, sym);
rlm@1 77 if (f == NULL) lua_pushstring(L, dlerror());
rlm@1 78 return f;
rlm@1 79 }
rlm@1 80
rlm@1 81 /* }====================================================== */
rlm@1 82
rlm@1 83
rlm@1 84
rlm@1 85 #elif defined(LUA_DL_DLL)
rlm@1 86 /*
rlm@1 87 ** {======================================================================
rlm@1 88 ** This is an implementation of loadlib for Windows using native functions.
rlm@1 89 ** =======================================================================
rlm@1 90 */
rlm@1 91
rlm@1 92 #include <windows.h>
rlm@1 93
rlm@1 94
rlm@1 95 #undef setprogdir
rlm@1 96
rlm@1 97 static void setprogdir (lua_State *L) {
rlm@1 98 char buff[MAX_PATH + 1];
rlm@1 99 char *lb;
rlm@1 100 DWORD nsize = sizeof(buff)/sizeof(char);
rlm@1 101 DWORD n = GetModuleFileNameA(NULL, buff, nsize);
rlm@1 102 if (n == 0 || n == nsize || (lb = strrchr(buff, '\\')) == NULL)
rlm@1 103 luaL_error(L, "unable to get ModuleFileName");
rlm@1 104 else {
rlm@1 105 *lb = '\0';
rlm@1 106 luaL_gsub(L, lua_tostring(L, -1), LUA_EXECDIR, buff);
rlm@1 107 lua_remove(L, -2); /* remove original string */
rlm@1 108 }
rlm@1 109 }
rlm@1 110
rlm@1 111
rlm@1 112 static void pusherror (lua_State *L) {
rlm@1 113 int error = GetLastError();
rlm@1 114 char buffer[128];
rlm@1 115 if (FormatMessageA(FORMAT_MESSAGE_IGNORE_INSERTS | FORMAT_MESSAGE_FROM_SYSTEM,
rlm@1 116 NULL, error, 0, buffer, sizeof(buffer), NULL))
rlm@1 117 lua_pushstring(L, buffer);
rlm@1 118 else
rlm@1 119 lua_pushfstring(L, "system error %d\n", error);
rlm@1 120 }
rlm@1 121
rlm@1 122 static void ll_unloadlib (void *lib) {
rlm@1 123 FreeLibrary((HINSTANCE)lib);
rlm@1 124 }
rlm@1 125
rlm@1 126
rlm@1 127 static void *ll_load (lua_State *L, const char *path) {
rlm@1 128 HINSTANCE lib = LoadLibraryA(path);
rlm@1 129 if (lib == NULL) pusherror(L);
rlm@1 130 return lib;
rlm@1 131 }
rlm@1 132
rlm@1 133
rlm@1 134 static lua_CFunction ll_sym (lua_State *L, void *lib, const char *sym) {
rlm@1 135 lua_CFunction f = (lua_CFunction)GetProcAddress((HINSTANCE)lib, sym);
rlm@1 136 if (f == NULL) pusherror(L);
rlm@1 137 return f;
rlm@1 138 }
rlm@1 139
rlm@1 140 /* }====================================================== */
rlm@1 141
rlm@1 142
rlm@1 143
rlm@1 144 #elif defined(LUA_DL_DYLD)
rlm@1 145 /*
rlm@1 146 ** {======================================================================
rlm@1 147 ** Native Mac OS X / Darwin Implementation
rlm@1 148 ** =======================================================================
rlm@1 149 */
rlm@1 150
rlm@1 151 #include <mach-o/dyld.h>
rlm@1 152
rlm@1 153
rlm@1 154 /* Mac appends a `_' before C function names */
rlm@1 155 #undef POF
rlm@1 156 #define POF "_" LUA_POF
rlm@1 157
rlm@1 158
rlm@1 159 static void pusherror (lua_State *L) {
rlm@1 160 const char *err_str;
rlm@1 161 const char *err_file;
rlm@1 162 NSLinkEditErrors err;
rlm@1 163 int err_num;
rlm@1 164 NSLinkEditError(&err, &err_num, &err_file, &err_str);
rlm@1 165 lua_pushstring(L, err_str);
rlm@1 166 }
rlm@1 167
rlm@1 168
rlm@1 169 static const char *errorfromcode (NSObjectFileImageReturnCode ret) {
rlm@1 170 switch (ret) {
rlm@1 171 case NSObjectFileImageInappropriateFile:
rlm@1 172 return "file is not a bundle";
rlm@1 173 case NSObjectFileImageArch:
rlm@1 174 return "library is for wrong CPU type";
rlm@1 175 case NSObjectFileImageFormat:
rlm@1 176 return "bad format";
rlm@1 177 case NSObjectFileImageAccess:
rlm@1 178 return "cannot access file";
rlm@1 179 case NSObjectFileImageFailure:
rlm@1 180 default:
rlm@1 181 return "unable to load library";
rlm@1 182 }
rlm@1 183 }
rlm@1 184
rlm@1 185
rlm@1 186 static void ll_unloadlib (void *lib) {
rlm@1 187 NSUnLinkModule((NSModule)lib, NSUNLINKMODULE_OPTION_RESET_LAZY_REFERENCES);
rlm@1 188 }
rlm@1 189
rlm@1 190
rlm@1 191 static void *ll_load (lua_State *L, const char *path) {
rlm@1 192 NSObjectFileImage img;
rlm@1 193 NSObjectFileImageReturnCode ret;
rlm@1 194 /* this would be a rare case, but prevents crashing if it happens */
rlm@1 195 if(!_dyld_present()) {
rlm@1 196 lua_pushliteral(L, "dyld not present");
rlm@1 197 return NULL;
rlm@1 198 }
rlm@1 199 ret = NSCreateObjectFileImageFromFile(path, &img);
rlm@1 200 if (ret == NSObjectFileImageSuccess) {
rlm@1 201 NSModule mod = NSLinkModule(img, path, NSLINKMODULE_OPTION_PRIVATE |
rlm@1 202 NSLINKMODULE_OPTION_RETURN_ON_ERROR);
rlm@1 203 NSDestroyObjectFileImage(img);
rlm@1 204 if (mod == NULL) pusherror(L);
rlm@1 205 return mod;
rlm@1 206 }
rlm@1 207 lua_pushstring(L, errorfromcode(ret));
rlm@1 208 return NULL;
rlm@1 209 }
rlm@1 210
rlm@1 211
rlm@1 212 static lua_CFunction ll_sym (lua_State *L, void *lib, const char *sym) {
rlm@1 213 NSSymbol nss = NSLookupSymbolInModule((NSModule)lib, sym);
rlm@1 214 if (nss == NULL) {
rlm@1 215 lua_pushfstring(L, "symbol " LUA_QS " not found", sym);
rlm@1 216 return NULL;
rlm@1 217 }
rlm@1 218 return (lua_CFunction)NSAddressOfSymbol(nss);
rlm@1 219 }
rlm@1 220
rlm@1 221 /* }====================================================== */
rlm@1 222
rlm@1 223
rlm@1 224
rlm@1 225 #else
rlm@1 226 /*
rlm@1 227 ** {======================================================
rlm@1 228 ** Fallback for other systems
rlm@1 229 ** =======================================================
rlm@1 230 */
rlm@1 231
rlm@1 232 #undef LIB_FAIL
rlm@1 233 #define LIB_FAIL "absent"
rlm@1 234
rlm@1 235
rlm@1 236 #define DLMSG "dynamic libraries not enabled; check your Lua installation"
rlm@1 237
rlm@1 238
rlm@1 239 static void ll_unloadlib (void *lib) {
rlm@1 240 (void)lib; /* to avoid warnings */
rlm@1 241 }
rlm@1 242
rlm@1 243
rlm@1 244 static void *ll_load (lua_State *L, const char *path) {
rlm@1 245 (void)path; /* to avoid warnings */
rlm@1 246 lua_pushliteral(L, DLMSG);
rlm@1 247 return NULL;
rlm@1 248 }
rlm@1 249
rlm@1 250
rlm@1 251 static lua_CFunction ll_sym (lua_State *L, void *lib, const char *sym) {
rlm@1 252 (void)lib; (void)sym; /* to avoid warnings */
rlm@1 253 lua_pushliteral(L, DLMSG);
rlm@1 254 return NULL;
rlm@1 255 }
rlm@1 256
rlm@1 257 /* }====================================================== */
rlm@1 258 #endif
rlm@1 259
rlm@1 260
rlm@1 261
rlm@1 262 static void **ll_register (lua_State *L, const char *path) {
rlm@1 263 void **plib;
rlm@1 264 lua_pushfstring(L, "%s%s", LIBPREFIX, path);
rlm@1 265 lua_gettable(L, LUA_REGISTRYINDEX); /* check library in registry? */
rlm@1 266 if (!lua_isnil(L, -1)) /* is there an entry? */
rlm@1 267 plib = (void **)lua_touserdata(L, -1);
rlm@1 268 else { /* no entry yet; create one */
rlm@1 269 lua_pop(L, 1);
rlm@1 270 plib = (void **)lua_newuserdata(L, sizeof(const void *));
rlm@1 271 *plib = NULL;
rlm@1 272 luaL_getmetatable(L, "_LOADLIB");
rlm@1 273 lua_setmetatable(L, -2);
rlm@1 274 lua_pushfstring(L, "%s%s", LIBPREFIX, path);
rlm@1 275 lua_pushvalue(L, -2);
rlm@1 276 lua_settable(L, LUA_REGISTRYINDEX);
rlm@1 277 }
rlm@1 278 return plib;
rlm@1 279 }
rlm@1 280
rlm@1 281
rlm@1 282 /*
rlm@1 283 ** __gc tag method: calls library's `ll_unloadlib' function with the lib
rlm@1 284 ** handle
rlm@1 285 */
rlm@1 286 static int gctm (lua_State *L) {
rlm@1 287 void **lib = (void **)luaL_checkudata(L, 1, "_LOADLIB");
rlm@1 288 if (*lib) ll_unloadlib(*lib);
rlm@1 289 *lib = NULL; /* mark library as closed */
rlm@1 290 return 0;
rlm@1 291 }
rlm@1 292
rlm@1 293
rlm@1 294 static int ll_loadfunc (lua_State *L, const char *path, const char *sym) {
rlm@1 295 void **reg = ll_register(L, path);
rlm@1 296 if (*reg == NULL) *reg = ll_load(L, path);
rlm@1 297 if (*reg == NULL)
rlm@1 298 return ERRLIB; /* unable to load library */
rlm@1 299 else {
rlm@1 300 lua_CFunction f = ll_sym(L, *reg, sym);
rlm@1 301 if (f == NULL)
rlm@1 302 return ERRFUNC; /* unable to find function */
rlm@1 303 lua_pushcfunction(L, f);
rlm@1 304 return 0; /* return function */
rlm@1 305 }
rlm@1 306 }
rlm@1 307
rlm@1 308
rlm@1 309 static int ll_loadlib (lua_State *L) {
rlm@1 310 const char *path = luaL_checkstring(L, 1);
rlm@1 311 const char *init = luaL_checkstring(L, 2);
rlm@1 312 int stat = ll_loadfunc(L, path, init);
rlm@1 313 if (stat == 0) /* no errors? */
rlm@1 314 return 1; /* return the loaded function */
rlm@1 315 else { /* error; error message is on stack top */
rlm@1 316 lua_pushnil(L);
rlm@1 317 lua_insert(L, -2);
rlm@1 318 lua_pushstring(L, (stat == ERRLIB) ? LIB_FAIL : "init");
rlm@1 319 return 3; /* return nil, error message, and where */
rlm@1 320 }
rlm@1 321 }
rlm@1 322
rlm@1 323
rlm@1 324
rlm@1 325 /*
rlm@1 326 ** {======================================================
rlm@1 327 ** 'require' function
rlm@1 328 ** =======================================================
rlm@1 329 */
rlm@1 330
rlm@1 331
rlm@1 332 static int readable (const char *filename) {
rlm@1 333 FILE *f = fopen(filename, "r"); /* try to open file */
rlm@1 334 if (f == NULL) return 0; /* open failed */
rlm@1 335 fclose(f);
rlm@1 336 return 1;
rlm@1 337 }
rlm@1 338
rlm@1 339
rlm@1 340 static const char *pushnexttemplate (lua_State *L, const char *path) {
rlm@1 341 const char *l;
rlm@1 342 while (*path == *LUA_PATHSEP) path++; /* skip separators */
rlm@1 343 if (*path == '\0') return NULL; /* no more templates */
rlm@1 344 l = strchr(path, *LUA_PATHSEP); /* find next separator */
rlm@1 345 if (l == NULL) l = path + strlen(path);
rlm@1 346 lua_pushlstring(L, path, l - path); /* template */
rlm@1 347 return l;
rlm@1 348 }
rlm@1 349
rlm@1 350
rlm@1 351 static const char *findfile (lua_State *L, const char *name,
rlm@1 352 const char *pname) {
rlm@1 353 const char *path;
rlm@1 354 name = luaL_gsub(L, name, ".", LUA_DIRSEP);
rlm@1 355 lua_getfield(L, LUA_ENVIRONINDEX, pname);
rlm@1 356 path = lua_tostring(L, -1);
rlm@1 357 if (path == NULL)
rlm@1 358 luaL_error(L, LUA_QL("package.%s") " must be a string", pname);
rlm@1 359 lua_pushliteral(L, ""); /* error accumulator */
rlm@1 360 while ((path = pushnexttemplate(L, path)) != NULL) {
rlm@1 361 const char *filename;
rlm@1 362 filename = luaL_gsub(L, lua_tostring(L, -1), LUA_PATH_MARK, name);
rlm@1 363 lua_remove(L, -2); /* remove path template */
rlm@1 364 if (readable(filename)) /* does file exist and is readable? */
rlm@1 365 return filename; /* return that file name */
rlm@1 366 lua_pushfstring(L, "\n\tno file " LUA_QS, filename);
rlm@1 367 lua_remove(L, -2); /* remove file name */
rlm@1 368 lua_concat(L, 2); /* add entry to possible error message */
rlm@1 369 }
rlm@1 370 return NULL; /* not found */
rlm@1 371 }
rlm@1 372
rlm@1 373
rlm@1 374 static void loaderror (lua_State *L, const char *filename) {
rlm@1 375 luaL_error(L, "error loading module " LUA_QS " from file " LUA_QS ":\n\t%s",
rlm@1 376 lua_tostring(L, 1), filename, lua_tostring(L, -1));
rlm@1 377 }
rlm@1 378
rlm@1 379
rlm@1 380 static int loader_Lua (lua_State *L) {
rlm@1 381 const char *filename;
rlm@1 382 const char *name = luaL_checkstring(L, 1);
rlm@1 383 filename = findfile(L, name, "path");
rlm@1 384 if (filename == NULL) return 1; /* library not found in this path */
rlm@1 385 if (luaL_loadfile(L, filename) != 0)
rlm@1 386 loaderror(L, filename);
rlm@1 387 return 1; /* library loaded successfully */
rlm@1 388 }
rlm@1 389
rlm@1 390
rlm@1 391 static const char *mkfuncname (lua_State *L, const char *modname) {
rlm@1 392 const char *funcname;
rlm@1 393 const char *mark = strchr(modname, *LUA_IGMARK);
rlm@1 394 if (mark) modname = mark + 1;
rlm@1 395 funcname = luaL_gsub(L, modname, ".", LUA_OFSEP);
rlm@1 396 funcname = lua_pushfstring(L, POF"%s", funcname);
rlm@1 397 lua_remove(L, -2); /* remove 'gsub' result */
rlm@1 398 return funcname;
rlm@1 399 }
rlm@1 400
rlm@1 401
rlm@1 402 static int loader_C (lua_State *L) {
rlm@1 403 const char *funcname;
rlm@1 404 const char *name = luaL_checkstring(L, 1);
rlm@1 405 const char *filename = findfile(L, name, "cpath");
rlm@1 406 if (filename == NULL) return 1; /* library not found in this path */
rlm@1 407 funcname = mkfuncname(L, name);
rlm@1 408 if (ll_loadfunc(L, filename, funcname) != 0)
rlm@1 409 loaderror(L, filename);
rlm@1 410 return 1; /* library loaded successfully */
rlm@1 411 }
rlm@1 412
rlm@1 413
rlm@1 414 static int loader_Croot (lua_State *L) {
rlm@1 415 const char *funcname;
rlm@1 416 const char *filename;
rlm@1 417 const char *name = luaL_checkstring(L, 1);
rlm@1 418 const char *p = strchr(name, '.');
rlm@1 419 int stat;
rlm@1 420 if (p == NULL) return 0; /* is root */
rlm@1 421 lua_pushlstring(L, name, p - name);
rlm@1 422 filename = findfile(L, lua_tostring(L, -1), "cpath");
rlm@1 423 if (filename == NULL) return 1; /* root not found */
rlm@1 424 funcname = mkfuncname(L, name);
rlm@1 425 if ((stat = ll_loadfunc(L, filename, funcname)) != 0) {
rlm@1 426 if (stat != ERRFUNC) loaderror(L, filename); /* real error */
rlm@1 427 lua_pushfstring(L, "\n\tno module " LUA_QS " in file " LUA_QS,
rlm@1 428 name, filename);
rlm@1 429 return 1; /* function not found */
rlm@1 430 }
rlm@1 431 return 1;
rlm@1 432 }
rlm@1 433
rlm@1 434
rlm@1 435 static int loader_preload (lua_State *L) {
rlm@1 436 const char *name = luaL_checkstring(L, 1);
rlm@1 437 lua_getfield(L, LUA_ENVIRONINDEX, "preload");
rlm@1 438 if (!lua_istable(L, -1))
rlm@1 439 luaL_error(L, LUA_QL("package.preload") " must be a table");
rlm@1 440 lua_getfield(L, -1, name);
rlm@1 441 if (lua_isnil(L, -1)) /* not found? */
rlm@1 442 lua_pushfstring(L, "\n\tno field package.preload['%s']", name);
rlm@1 443 return 1;
rlm@1 444 }
rlm@1 445
rlm@1 446
rlm@1 447 static const int sentinel_ = 0;
rlm@1 448 #define sentinel ((void *)&sentinel_)
rlm@1 449
rlm@1 450
rlm@1 451 static int ll_require (lua_State *L) {
rlm@1 452 const char *name = luaL_checkstring(L, 1);
rlm@1 453 int i;
rlm@1 454 lua_settop(L, 1); /* _LOADED table will be at index 2 */
rlm@1 455 lua_getfield(L, LUA_REGISTRYINDEX, "_LOADED");
rlm@1 456 lua_getfield(L, 2, name);
rlm@1 457 if (lua_toboolean(L, -1)) { /* is it there? */
rlm@1 458 if (lua_touserdata(L, -1) == sentinel) /* check loops */
rlm@1 459 luaL_error(L, "loop or previous error loading module " LUA_QS, name);
rlm@1 460 return 1; /* package is already loaded */
rlm@1 461 }
rlm@1 462 /* else must load it; iterate over available loaders */
rlm@1 463 lua_getfield(L, LUA_ENVIRONINDEX, "loaders");
rlm@1 464 if (!lua_istable(L, -1))
rlm@1 465 luaL_error(L, LUA_QL("package.loaders") " must be a table");
rlm@1 466 lua_pushliteral(L, ""); /* error message accumulator */
rlm@1 467 for (i=1; ; i++) {
rlm@1 468 lua_rawgeti(L, -2, i); /* get a loader */
rlm@1 469 if (lua_isnil(L, -1))
rlm@1 470 luaL_error(L, "module " LUA_QS " not found:%s",
rlm@1 471 name, lua_tostring(L, -2));
rlm@1 472 lua_pushstring(L, name);
rlm@1 473 lua_call(L, 1, 1); /* call it */
rlm@1 474 if (lua_isfunction(L, -1)) /* did it find module? */
rlm@1 475 break; /* module loaded successfully */
rlm@1 476 else if (lua_isstring(L, -1)) /* loader returned error message? */
rlm@1 477 lua_concat(L, 2); /* accumulate it */
rlm@1 478 else
rlm@1 479 lua_pop(L, 1);
rlm@1 480 }
rlm@1 481 lua_pushlightuserdata(L, sentinel);
rlm@1 482 lua_setfield(L, 2, name); /* _LOADED[name] = sentinel */
rlm@1 483 lua_pushstring(L, name); /* pass name as argument to module */
rlm@1 484 lua_call(L, 1, 1); /* run loaded module */
rlm@1 485 if (!lua_isnil(L, -1)) /* non-nil return? */
rlm@1 486 lua_setfield(L, 2, name); /* _LOADED[name] = returned value */
rlm@1 487 lua_getfield(L, 2, name);
rlm@1 488 if (lua_touserdata(L, -1) == sentinel) { /* module did not set a value? */
rlm@1 489 lua_pushboolean(L, 1); /* use true as result */
rlm@1 490 lua_pushvalue(L, -1); /* extra copy to be returned */
rlm@1 491 lua_setfield(L, 2, name); /* _LOADED[name] = true */
rlm@1 492 }
rlm@1 493 return 1;
rlm@1 494 }
rlm@1 495
rlm@1 496 /* }====================================================== */
rlm@1 497
rlm@1 498
rlm@1 499
rlm@1 500 /*
rlm@1 501 ** {======================================================
rlm@1 502 ** 'module' function
rlm@1 503 ** =======================================================
rlm@1 504 */
rlm@1 505
rlm@1 506
rlm@1 507 static void setfenv (lua_State *L) {
rlm@1 508 lua_Debug ar;
rlm@1 509 if (lua_getstack(L, 1, &ar) == 0 ||
rlm@1 510 lua_getinfo(L, "f", &ar) == 0 || /* get calling function */
rlm@1 511 lua_iscfunction(L, -1))
rlm@1 512 luaL_error(L, LUA_QL("module") " not called from a Lua function");
rlm@1 513 lua_pushvalue(L, -2);
rlm@1 514 lua_setfenv(L, -2);
rlm@1 515 lua_pop(L, 1);
rlm@1 516 }
rlm@1 517
rlm@1 518
rlm@1 519 static void dooptions (lua_State *L, int n) {
rlm@1 520 int i;
rlm@1 521 for (i = 2; i <= n; i++) {
rlm@1 522 lua_pushvalue(L, i); /* get option (a function) */
rlm@1 523 lua_pushvalue(L, -2); /* module */
rlm@1 524 lua_call(L, 1, 0);
rlm@1 525 }
rlm@1 526 }
rlm@1 527
rlm@1 528
rlm@1 529 static void modinit (lua_State *L, const char *modname) {
rlm@1 530 const char *dot;
rlm@1 531 lua_pushvalue(L, -1);
rlm@1 532 lua_setfield(L, -2, "_M"); /* module._M = module */
rlm@1 533 lua_pushstring(L, modname);
rlm@1 534 lua_setfield(L, -2, "_NAME");
rlm@1 535 dot = strrchr(modname, '.'); /* look for last dot in module name */
rlm@1 536 if (dot == NULL) dot = modname;
rlm@1 537 else dot++;
rlm@1 538 /* set _PACKAGE as package name (full module name minus last part) */
rlm@1 539 lua_pushlstring(L, modname, dot - modname);
rlm@1 540 lua_setfield(L, -2, "_PACKAGE");
rlm@1 541 }
rlm@1 542
rlm@1 543
rlm@1 544 static int ll_module (lua_State *L) {
rlm@1 545 const char *modname = luaL_checkstring(L, 1);
rlm@1 546 int loaded = lua_gettop(L) + 1; /* index of _LOADED table */
rlm@1 547 lua_getfield(L, LUA_REGISTRYINDEX, "_LOADED");
rlm@1 548 lua_getfield(L, loaded, modname); /* get _LOADED[modname] */
rlm@1 549 if (!lua_istable(L, -1)) { /* not found? */
rlm@1 550 lua_pop(L, 1); /* remove previous result */
rlm@1 551 /* try global variable (and create one if it does not exist) */
rlm@1 552 if (luaL_findtable(L, LUA_GLOBALSINDEX, modname, 1) != NULL)
rlm@1 553 return luaL_error(L, "name conflict for module " LUA_QS, modname);
rlm@1 554 lua_pushvalue(L, -1);
rlm@1 555 lua_setfield(L, loaded, modname); /* _LOADED[modname] = new table */
rlm@1 556 }
rlm@1 557 /* check whether table already has a _NAME field */
rlm@1 558 lua_getfield(L, -1, "_NAME");
rlm@1 559 if (!lua_isnil(L, -1)) /* is table an initialized module? */
rlm@1 560 lua_pop(L, 1);
rlm@1 561 else { /* no; initialize it */
rlm@1 562 lua_pop(L, 1);
rlm@1 563 modinit(L, modname);
rlm@1 564 }
rlm@1 565 lua_pushvalue(L, -1);
rlm@1 566 setfenv(L);
rlm@1 567 dooptions(L, loaded - 1);
rlm@1 568 return 0;
rlm@1 569 }
rlm@1 570
rlm@1 571
rlm@1 572 static int ll_seeall (lua_State *L) {
rlm@1 573 luaL_checktype(L, 1, LUA_TTABLE);
rlm@1 574 if (!lua_getmetatable(L, 1)) {
rlm@1 575 lua_createtable(L, 0, 1); /* create new metatable */
rlm@1 576 lua_pushvalue(L, -1);
rlm@1 577 lua_setmetatable(L, 1);
rlm@1 578 }
rlm@1 579 lua_pushvalue(L, LUA_GLOBALSINDEX);
rlm@1 580 lua_setfield(L, -2, "__index"); /* mt.__index = _G */
rlm@1 581 return 0;
rlm@1 582 }
rlm@1 583
rlm@1 584
rlm@1 585 /* }====================================================== */
rlm@1 586
rlm@1 587
rlm@1 588
rlm@1 589 /* auxiliary mark (for internal use) */
rlm@1 590 #define AUXMARK "\1"
rlm@1 591
rlm@1 592 static void setpath (lua_State *L, const char *fieldname, const char *envname,
rlm@1 593 const char *def) {
rlm@1 594 const char *path = getenv(envname);
rlm@1 595 if (path == NULL) /* no environment variable? */
rlm@1 596 lua_pushstring(L, def); /* use default */
rlm@1 597 else {
rlm@1 598 /* replace ";;" by ";AUXMARK;" and then AUXMARK by default path */
rlm@1 599 path = luaL_gsub(L, path, LUA_PATHSEP LUA_PATHSEP,
rlm@1 600 LUA_PATHSEP AUXMARK LUA_PATHSEP);
rlm@1 601 luaL_gsub(L, path, AUXMARK, def);
rlm@1 602 lua_remove(L, -2);
rlm@1 603 }
rlm@1 604 setprogdir(L);
rlm@1 605 lua_setfield(L, -2, fieldname);
rlm@1 606 }
rlm@1 607
rlm@1 608
rlm@1 609 static const luaL_Reg pk_funcs[] = {
rlm@1 610 {"loadlib", ll_loadlib},
rlm@1 611 {"seeall", ll_seeall},
rlm@1 612 {NULL, NULL}
rlm@1 613 };
rlm@1 614
rlm@1 615
rlm@1 616 static const luaL_Reg ll_funcs[] = {
rlm@1 617 {"module", ll_module},
rlm@1 618 {"require", ll_require},
rlm@1 619 {NULL, NULL}
rlm@1 620 };
rlm@1 621
rlm@1 622
rlm@1 623 static const lua_CFunction loaders[] =
rlm@1 624 {loader_preload, loader_Lua, loader_C, loader_Croot, NULL};
rlm@1 625
rlm@1 626
rlm@1 627 LUALIB_API int luaopen_package (lua_State *L) {
rlm@1 628 int i;
rlm@1 629 /* create new type _LOADLIB */
rlm@1 630 luaL_newmetatable(L, "_LOADLIB");
rlm@1 631 lua_pushcfunction(L, gctm);
rlm@1 632 lua_setfield(L, -2, "__gc");
rlm@1 633 /* create `package' table */
rlm@1 634 luaL_register(L, LUA_LOADLIBNAME, pk_funcs);
rlm@1 635 #if defined(LUA_COMPAT_LOADLIB)
rlm@1 636 lua_getfield(L, -1, "loadlib");
rlm@1 637 lua_setfield(L, LUA_GLOBALSINDEX, "loadlib");
rlm@1 638 #endif
rlm@1 639 lua_pushvalue(L, -1);
rlm@1 640 lua_replace(L, LUA_ENVIRONINDEX);
rlm@1 641 /* create `loaders' table */
rlm@1 642 lua_createtable(L, 0, sizeof(loaders)/sizeof(loaders[0]) - 1);
rlm@1 643 /* fill it with pre-defined loaders */
rlm@1 644 for (i=0; loaders[i] != NULL; i++) {
rlm@1 645 lua_pushcfunction(L, loaders[i]);
rlm@1 646 lua_rawseti(L, -2, i+1);
rlm@1 647 }
rlm@1 648 lua_setfield(L, -2, "loaders"); /* put it in field `loaders' */
rlm@1 649 setpath(L, "path", LUA_PATH, LUA_PATH_DEFAULT); /* set field `path' */
rlm@1 650 setpath(L, "cpath", LUA_CPATH, LUA_CPATH_DEFAULT); /* set field `cpath' */
rlm@1 651 /* store config information */
rlm@1 652 lua_pushliteral(L, LUA_DIRSEP "\n" LUA_PATHSEP "\n" LUA_PATH_MARK "\n"
rlm@1 653 LUA_EXECDIR "\n" LUA_IGMARK);
rlm@1 654 lua_setfield(L, -2, "config");
rlm@1 655 /* set field `loaded' */
rlm@1 656 luaL_findtable(L, LUA_REGISTRYINDEX, "_LOADED", 2);
rlm@1 657 lua_setfield(L, -2, "loaded");
rlm@1 658 /* set field `preload' */
rlm@1 659 lua_newtable(L);
rlm@1 660 lua_setfield(L, -2, "preload");
rlm@1 661 lua_pushvalue(L, LUA_GLOBALSINDEX);
rlm@1 662 luaL_register(L, NULL, ll_funcs); /* open lib into global table */
rlm@1 663 lua_pop(L, 1);
rlm@1 664 return 1; /* return 'package' table */
rlm@1 665 }
rlm@1 666