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