Mercurial > vba-clojure

     1 /*

     2 ** $Id: lauxlib.c,v 1.159.1.3 2008/01/21 13:20:51 roberto Exp $

     3 ** Auxiliary functions for building Lua libraries

     4 ** See Copyright Notice in lua.h

     5 */

     6 

     7 

     8 #include <ctype.h>

     9 #include <errno.h>

    10 #include <stdarg.h>

    11 #include <stdio.h>

    12 #include <stdlib.h>

    13 #include <string.h>

    14 

    15 

    16 /* This file uses only the official API of Lua.

    17 ** Any function declared here could be written as an application function.

    18 */

    19 

    20 #define lauxlib_c

    21 #define LUA_LIB

    22 

    23 #include "lua.h"

    24 

    25 #include "lauxlib.h"

    26 

    27 

    28 #define FREELIST_REF	0	/* free list of references */

    29 

    30 

    31 /* convert a stack index to positive */

    32 #define abs_index(L, i)		((i) > 0 || (i) <= LUA_REGISTRYINDEX ? (i) : \

    33 					lua_gettop(L) + (i) + 1)

    34 

    35 

    36 /*

    37 ** {======================================================

    38 ** Error-report functions

    39 ** =======================================================

    40 */

    41 

    42 

    43 LUALIB_API int luaL_argerror (lua_State *L, int narg, const char *extramsg) {

    44   lua_Debug ar;

    45   if (!lua_getstack(L, 0, &ar))  /* no stack frame? */

    46     return luaL_error(L, "bad argument #%d (%s)", narg, extramsg);

    47   lua_getinfo(L, "n", &ar);

    48   if (strcmp(ar.namewhat, "method") == 0) {

    49     narg--;  /* do not count `self' */

    50     if (narg == 0)  /* error is in the self argument itself? */

    51       return luaL_error(L, "calling " LUA_QS " on bad self (%s)",

    52                            ar.name, extramsg);

    53   }

    54   if (ar.name == NULL)

    55     ar.name = "?";

    56   return luaL_error(L, "bad argument #%d to " LUA_QS " (%s)",

    57                         narg, ar.name, extramsg);

    58 }

    59 

    60 

    61 LUALIB_API int luaL_typerror (lua_State *L, int narg, const char *tname) {

    62   const char *msg = lua_pushfstring(L, "%s expected, got %s",

    63                                     tname, luaL_typename(L, narg));

    64   return luaL_argerror(L, narg, msg);

    65 }

    66 

    67 

    68 static void tag_error (lua_State *L, int narg, int tag) {

    69   luaL_typerror(L, narg, lua_typename(L, tag));

    70 }

    71 

    72 

    73 LUALIB_API void luaL_where (lua_State *L, int level) {

    74   lua_Debug ar;

    75   if (lua_getstack(L, level, &ar)) {  /* check function at level */

    76     lua_getinfo(L, "Sl", &ar);  /* get info about it */

    77     if (ar.currentline > 0) {  /* is there info? */

    78       lua_pushfstring(L, "%s:%d: ", ar.short_src, ar.currentline);

    79       return;

    80     }

    81   }

    82   lua_pushliteral(L, "");  /* else, no information available... */

    83 }

    84 

    85 

    86 LUALIB_API int luaL_error (lua_State *L, const char *fmt, ...) {

    87   va_list argp;

    88   va_start(argp, fmt);

    89   luaL_where(L, 1);

    90   lua_pushvfstring(L, fmt, argp);

    91   va_end(argp);

    92   lua_concat(L, 2);

    93   return lua_error(L);

    94 }

    95 

    96 /* }====================================================== */

    97 

    98 

    99 LUALIB_API int luaL_checkoption (lua_State *L, int narg, const char *def,

   100                                  const char *const lst[]) {

   101   const char *name = (def) ? luaL_optstring(L, narg, def) :

   102                              luaL_checkstring(L, narg);

   103   int i;

   104   for (i=0; lst[i]; i++)

   105     if (strcmp(lst[i], name) == 0)

   106       return i;

   107   return luaL_argerror(L, narg,

   108                        lua_pushfstring(L, "invalid option " LUA_QS, name));

   109 }

   110 

   111 

   112 LUALIB_API int luaL_newmetatable (lua_State *L, const char *tname) {

   113   lua_getfield(L, LUA_REGISTRYINDEX, tname);  /* get registry.name */

   114   if (!lua_isnil(L, -1))  /* name already in use? */

   115     return 0;  /* leave previous value on top, but return 0 */

   116   lua_pop(L, 1);

   117   lua_newtable(L);  /* create metatable */

   118   lua_pushvalue(L, -1);

   119   lua_setfield(L, LUA_REGISTRYINDEX, tname);  /* registry.name = metatable */

   120   return 1;

   121 }

   122 

   123 

   124 LUALIB_API void *luaL_checkudata (lua_State *L, int ud, const char *tname) {

   125   void *p = lua_touserdata(L, ud);

   126   if (p != NULL) {  /* value is a userdata? */

   127     if (lua_getmetatable(L, ud)) {  /* does it have a metatable? */

   128       lua_getfield(L, LUA_REGISTRYINDEX, tname);  /* get correct metatable */

   129       if (lua_rawequal(L, -1, -2)) {  /* does it have the correct mt? */

   130         lua_pop(L, 2);  /* remove both metatables */

   131         return p;

   132       }

   133     }

   134   }

   135   luaL_typerror(L, ud, tname);  /* else error */

   136   return NULL;  /* to avoid warnings */

   137 }

   138 

   139 

   140 LUALIB_API void luaL_checkstack (lua_State *L, int space, const char *mes) {

   141   if (!lua_checkstack(L, space))

   142     luaL_error(L, "stack overflow (%s)", mes);

   143 }

   144 

   145 

   146 LUALIB_API void luaL_checktype (lua_State *L, int narg, int t) {

   147   if (lua_type(L, narg) != t)

   148     tag_error(L, narg, t);

   149 }

   150 

   151 

   152 LUALIB_API void luaL_checkany (lua_State *L, int narg) {

   153   if (lua_type(L, narg) == LUA_TNONE)

   154     luaL_argerror(L, narg, "value expected");

   155 }

   156 

   157 

   158 LUALIB_API const char *luaL_checklstring (lua_State *L, int narg, size_t *len) {

   159   const char *s = lua_tolstring(L, narg, len);

   160   if (!s) tag_error(L, narg, LUA_TSTRING);

   161   return s;

   162 }

   163 

   164 

   165 LUALIB_API const char *luaL_optlstring (lua_State *L, int narg,

   166                                         const char *def, size_t *len) {

   167   if (lua_isnoneornil(L, narg)) {

   168     if (len)

   169       *len = (def ? strlen(def) : 0);

   170     return def;

   171   }

   172   else return luaL_checklstring(L, narg, len);

   173 }

   174 

   175 

   176 LUALIB_API lua_Number luaL_checknumber (lua_State *L, int narg) {

   177   lua_Number d = lua_tonumber(L, narg);

   178   if (d == 0 && !lua_isnumber(L, narg))  /* avoid extra test when d is not 0 */

   179     tag_error(L, narg, LUA_TNUMBER);

   180   return d;

   181 }

   182 

   183 

   184 LUALIB_API lua_Number luaL_optnumber (lua_State *L, int narg, lua_Number def) {

   185   return luaL_opt(L, luaL_checknumber, narg, def);

   186 }

   187 

   188 

   189 LUALIB_API lua_Integer luaL_checkinteger (lua_State *L, int narg) {

   190   lua_Integer d = lua_tointeger(L, narg);

   191   if (d == 0 && !lua_isnumber(L, narg))  /* avoid extra test when d is not 0 */

   192     tag_error(L, narg, LUA_TNUMBER);

   193   return d;

   194 }

   195 

   196 

   197 LUALIB_API lua_Integer luaL_optinteger (lua_State *L, int narg,

   198                                                       lua_Integer def) {

   199   return luaL_opt(L, luaL_checkinteger, narg, def);

   200 }

   201 

   202 

   203 LUALIB_API int luaL_getmetafield (lua_State *L, int obj, const char *event) {

   204   if (!lua_getmetatable(L, obj))  /* no metatable? */

   205     return 0;

   206   lua_pushstring(L, event);

   207   lua_rawget(L, -2);

   208   if (lua_isnil(L, -1)) {

   209     lua_pop(L, 2);  /* remove metatable and metafield */

   210     return 0;

   211   }

   212   else {

   213     lua_remove(L, -2);  /* remove only metatable */

   214     return 1;

   215   }

   216 }

   217 

   218 

   219 LUALIB_API int luaL_callmeta (lua_State *L, int obj, const char *event) {

   220   obj = abs_index(L, obj);

   221   if (!luaL_getmetafield(L, obj, event))  /* no metafield? */

   222     return 0;

   223   lua_pushvalue(L, obj);

   224   lua_call(L, 1, 1);

   225   return 1;

   226 }

   227 

   228 

   229 LUALIB_API void (luaL_register) (lua_State *L, const char *libname,

   230                                 const luaL_Reg *l) {

   231   luaI_openlib(L, libname, l, 0);

   232 }

   233 

   234 

   235 static int libsize (const luaL_Reg *l) {

   236   int size = 0;

   237   for (; l->name; l++) size++;

   238   return size;

   239 }

   240 

   241 

   242 LUALIB_API void luaI_openlib (lua_State *L, const char *libname,

   243                               const luaL_Reg *l, int nup) {

   244   if (libname) {

   245     int size = libsize(l);

   246     /* check whether lib already exists */

   247     luaL_findtable(L, LUA_REGISTRYINDEX, "_LOADED", 1);

   248     lua_getfield(L, -1, libname);  /* get _LOADED[libname] */

   249     if (!lua_istable(L, -1)) {  /* not found? */

   250       lua_pop(L, 1);  /* remove previous result */

   251       /* try global variable (and create one if it does not exist) */

   252       if (luaL_findtable(L, LUA_GLOBALSINDEX, libname, size) != NULL)

   253         luaL_error(L, "name conflict for module " LUA_QS, libname);

   254       lua_pushvalue(L, -1);

   255       lua_setfield(L, -3, libname);  /* _LOADED[libname] = new table */

   256     }

   257     lua_remove(L, -2);  /* remove _LOADED table */

   258     lua_insert(L, -(nup+1));  /* move library table to below upvalues */

   259   }

   260   for (; l->name; l++) {

   261     int i;

   262     for (i=0; i<nup; i++)  /* copy upvalues to the top */

   263       lua_pushvalue(L, -nup);

   264     lua_pushcclosure(L, l->func, nup);

   265     lua_setfield(L, -(nup+2), l->name);

   266   }

   267   lua_pop(L, nup);  /* remove upvalues */

   268 }

   269 

   270 

   271 

   272 /*

   273 ** {======================================================

   274 ** getn-setn: size for arrays

   275 ** =======================================================

   276 */

   277 

   278 #if defined(LUA_COMPAT_GETN)

   279 

   280 static int checkint (lua_State *L, int topop) {

   281   int n = (lua_type(L, -1) == LUA_TNUMBER) ? lua_tointeger(L, -1) : -1;

   282   lua_pop(L, topop);

   283   return n;

   284 }

   285 

   286 

   287 static void getsizes (lua_State *L) {

   288   lua_getfield(L, LUA_REGISTRYINDEX, "LUA_SIZES");

   289   if (lua_isnil(L, -1)) {  /* no `size' table? */

   290     lua_pop(L, 1);  /* remove nil */

   291     lua_newtable(L);  /* create it */

   292     lua_pushvalue(L, -1);  /* `size' will be its own metatable */

   293     lua_setmetatable(L, -2);

   294     lua_pushliteral(L, "kv");

   295     lua_setfield(L, -2, "__mode");  /* metatable(N).__mode = "kv" */

   296     lua_pushvalue(L, -1);

   297     lua_setfield(L, LUA_REGISTRYINDEX, "LUA_SIZES");  /* store in register */

   298   }

   299 }

   300 

   301 

   302 LUALIB_API void luaL_setn (lua_State *L, int t, int n) {

   303   t = abs_index(L, t);

   304   lua_pushliteral(L, "n");

   305   lua_rawget(L, t);

   306   if (checkint(L, 1) >= 0) {  /* is there a numeric field `n'? */

   307     lua_pushliteral(L, "n");  /* use it */

   308     lua_pushinteger(L, n);

   309     lua_rawset(L, t);

   310   }

   311   else {  /* use `sizes' */

   312     getsizes(L);

   313     lua_pushvalue(L, t);

   314     lua_pushinteger(L, n);

   315     lua_rawset(L, -3);  /* sizes[t] = n */

   316     lua_pop(L, 1);  /* remove `sizes' */

   317   }

   318 }

   319 

   320 

   321 LUALIB_API int luaL_getn (lua_State *L, int t) {

   322   int n;

   323   t = abs_index(L, t);

   324   lua_pushliteral(L, "n");  /* try t.n */

   325   lua_rawget(L, t);

   326   if ((n = checkint(L, 1)) >= 0) return n;

   327   getsizes(L);  /* else try sizes[t] */

   328   lua_pushvalue(L, t);

   329   lua_rawget(L, -2);

   330   if ((n = checkint(L, 2)) >= 0) return n;

   331   return (int)lua_objlen(L, t);

   332 }

   333 

   334 #endif

   335 

   336 /* }====================================================== */

   337 

   338 

   339 

   340 LUALIB_API const char *luaL_gsub (lua_State *L, const char *s, const char *p,

   341                                                                const char *r) {

   342   const char *wild;

   343   size_t l = strlen(p);

   344   luaL_Buffer b;

   345   luaL_buffinit(L, &b);

   346   while ((wild = strstr(s, p)) != NULL) {

   347     luaL_addlstring(&b, s, wild - s);  /* push prefix */

   348     luaL_addstring(&b, r);  /* push replacement in place of pattern */

   349     s = wild + l;  /* continue after `p' */

   350   }

   351   luaL_addstring(&b, s);  /* push last suffix */

   352   luaL_pushresult(&b);

   353   return lua_tostring(L, -1);

   354 }

   355 

   356 

   357 LUALIB_API const char *luaL_findtable (lua_State *L, int idx,

   358                                        const char *fname, int szhint) {

   359   const char *e;

   360   lua_pushvalue(L, idx);

   361   do {

   362     e = strchr(fname, '.');

   363     if (e == NULL) e = fname + strlen(fname);

   364     lua_pushlstring(L, fname, e - fname);

   365     lua_rawget(L, -2);

   366     if (lua_isnil(L, -1)) {  /* no such field? */

   367       lua_pop(L, 1);  /* remove this nil */

   368       lua_createtable(L, 0, (*e == '.' ? 1 : szhint)); /* new table for field */

   369       lua_pushlstring(L, fname, e - fname);

   370       lua_pushvalue(L, -2);

   371       lua_settable(L, -4);  /* set new table into field */

   372     }

   373     else if (!lua_istable(L, -1)) {  /* field has a non-table value? */

   374       lua_pop(L, 2);  /* remove table and value */

   375       return fname;  /* return problematic part of the name */

   376     }

   377     lua_remove(L, -2);  /* remove previous table */

   378     fname = e + 1;

   379   } while (*e == '.');

   380   return NULL;

   381 }

   382 

   383 

   384 

   385 /*

   386 ** {======================================================

   387 ** Generic Buffer manipulation

   388 ** =======================================================

   389 */

   390 

   391 

   392 #define bufflen(B)	((B)->p - (B)->buffer)

   393 #define bufffree(B)	((size_t)(LUAL_BUFFERSIZE - bufflen(B)))

   394 

   395 #define LIMIT	(LUA_MINSTACK/2)

   396 

   397 

   398 static int emptybuffer (luaL_Buffer *B) {

   399   size_t l = bufflen(B);

   400   if (l == 0) return 0;  /* put nothing on stack */

   401   else {

   402     lua_pushlstring(B->L, B->buffer, l);

   403     B->p = B->buffer;

   404     B->lvl++;

   405     return 1;

   406   }

   407 }

   408 

   409 

   410 static void adjuststack (luaL_Buffer *B) {

   411   if (B->lvl > 1) {

   412     lua_State *L = B->L;

   413     int toget = 1;  /* number of levels to concat */

   414     size_t toplen = lua_strlen(L, -1);

   415     do {

   416       size_t l = lua_strlen(L, -(toget+1));

   417       if (B->lvl - toget + 1 >= LIMIT || toplen > l) {

   418         toplen += l;

   419         toget++;

   420       }

   421       else break;

   422     } while (toget < B->lvl);

   423     lua_concat(L, toget);

   424     B->lvl = B->lvl - toget + 1;

   425   }

   426 }

   427 

   428 

   429 LUALIB_API char *luaL_prepbuffer (luaL_Buffer *B) {

   430   if (emptybuffer(B))

   431     adjuststack(B);

   432   return B->buffer;

   433 }

   434 

   435 

   436 LUALIB_API void luaL_addlstring (luaL_Buffer *B, const char *s, size_t l) {

   437   while (l--)

   438     luaL_addchar(B, *s++);

   439 }

   440 

   441 

   442 LUALIB_API void luaL_addstring (luaL_Buffer *B, const char *s) {

   443   luaL_addlstring(B, s, strlen(s));

   444 }

   445 

   446 

   447 LUALIB_API void luaL_pushresult (luaL_Buffer *B) {

   448   emptybuffer(B);

   449   lua_concat(B->L, B->lvl);

   450   B->lvl = 1;

   451 }

   452 

   453 

   454 LUALIB_API void luaL_addvalue (luaL_Buffer *B) {

   455   lua_State *L = B->L;

   456   size_t vl;

   457   const char *s = lua_tolstring(L, -1, &vl);

   458   if (vl <= bufffree(B)) {  /* fit into buffer? */

   459     memcpy(B->p, s, vl);  /* put it there */

   460     B->p += vl;

   461     lua_pop(L, 1);  /* remove from stack */

   462   }

   463   else {

   464     if (emptybuffer(B))

   465       lua_insert(L, -2);  /* put buffer before new value */

   466     B->lvl++;  /* add new value into B stack */

   467     adjuststack(B);

   468   }

   469 }

   470 

   471 

   472 LUALIB_API void luaL_buffinit (lua_State *L, luaL_Buffer *B) {

   473   B->L = L;

   474   B->p = B->buffer;

   475   B->lvl = 0;

   476 }

   477 

   478 /* }====================================================== */

   479 

   480 

   481 LUALIB_API int luaL_ref (lua_State *L, int t) {

   482   int ref;

   483   t = abs_index(L, t);

   484   if (lua_isnil(L, -1)) {

   485     lua_pop(L, 1);  /* remove from stack */

   486     return LUA_REFNIL;  /* `nil' has a unique fixed reference */

   487   }

   488   lua_rawgeti(L, t, FREELIST_REF);  /* get first free element */

   489   ref = (int)lua_tointeger(L, -1);  /* ref = t[FREELIST_REF] */

   490   lua_pop(L, 1);  /* remove it from stack */

   491   if (ref != 0) {  /* any free element? */

   492     lua_rawgeti(L, t, ref);  /* remove it from list */

   493     lua_rawseti(L, t, FREELIST_REF);  /* (t[FREELIST_REF] = t[ref]) */

   494   }

   495   else {  /* no free elements */

   496     ref = (int)lua_objlen(L, t);

   497     ref++;  /* create new reference */

   498   }

   499   lua_rawseti(L, t, ref);

   500   return ref;

   501 }

   502 

   503 

   504 LUALIB_API void luaL_unref (lua_State *L, int t, int ref) {

   505   if (ref >= 0) {

   506     t = abs_index(L, t);

   507     lua_rawgeti(L, t, FREELIST_REF);

   508     lua_rawseti(L, t, ref);  /* t[ref] = t[FREELIST_REF] */

   509     lua_pushinteger(L, ref);

   510     lua_rawseti(L, t, FREELIST_REF);  /* t[FREELIST_REF] = ref */

   511   }

   512 }

   513 

   514 

   515 

   516 /*

   517 ** {======================================================

   518 ** Load functions

   519 ** =======================================================

   520 */

   521 

   522 typedef struct LoadF {

   523   int extraline;

   524   FILE *f;

   525   char buff[LUAL_BUFFERSIZE];

   526 } LoadF;

   527 

   528 

   529 static const char *getF (lua_State *L, void *ud, size_t *size) {

   530   LoadF *lf = (LoadF *)ud;

   531   (void)L;

   532   if (lf->extraline) {

   533     lf->extraline = 0;

   534     *size = 1;

   535     return "\n";

   536   }

   537   if (feof(lf->f)) return NULL;

   538   *size = fread(lf->buff, 1, sizeof(lf->buff), lf->f);

   539   return (*size > 0) ? lf->buff : NULL;

   540 }

   541 

   542 

   543 static int errfile (lua_State *L, const char *what, int fnameindex) {

   544   const char *serr = strerror(errno);

   545   const char *filename = lua_tostring(L, fnameindex) + 1;

   546   lua_pushfstring(L, "cannot %s %s: %s", what, filename, serr);

   547   lua_remove(L, fnameindex);

   548   return LUA_ERRFILE;

   549 }

   550 

   551 

   552 LUALIB_API int luaL_loadfile (lua_State *L, const char *filename) {

   553   LoadF lf;

   554   int status, readstatus;

   555   int c;

   556   int fnameindex = lua_gettop(L) + 1;  /* index of filename on the stack */

   557   lf.extraline = 0;

   558   if (filename == NULL) {

   559     lua_pushliteral(L, "=stdin");

   560     lf.f = stdin;

   561   }

   562   else {

   563     lua_pushfstring(L, "@%s", filename);

   564     lf.f = fopen(filename, "r");

   565     if (lf.f == NULL) return errfile(L, "open", fnameindex);

   566   }

   567   c = getc(lf.f);

   568   if (c == '#') {  /* Unix exec. file? */

   569     lf.extraline = 1;

   570     while ((c = getc(lf.f)) != EOF && c != '\n') ;  /* skip first line */

   571     if (c == '\n') c = getc(lf.f);

   572   }

   573   if (c == LUA_SIGNATURE[0] && filename) {  /* binary file? */

   574     lf.f = freopen(filename, "rb", lf.f);  /* reopen in binary mode */

   575     if (lf.f == NULL) return errfile(L, "reopen", fnameindex);

   576     /* skip eventual `#!...' */

   577    while ((c = getc(lf.f)) != EOF && c != LUA_SIGNATURE[0]) ;

   578     lf.extraline = 0;

   579   }

   580   ungetc(c, lf.f);

   581   status = lua_load(L, getF, &lf, lua_tostring(L, -1));

   582   readstatus = ferror(lf.f);

   583   if (filename) fclose(lf.f);  /* close file (even in case of errors) */

   584   if (readstatus) {

   585     lua_settop(L, fnameindex);  /* ignore results from `lua_load' */

   586     return errfile(L, "read", fnameindex);

   587   }

   588   lua_remove(L, fnameindex);

   589   return status;

   590 }

   591 

   592 

   593 typedef struct LoadS {

   594   const char *s;

   595   size_t size;

   596 } LoadS;

   597 

   598 

   599 static const char *getS (lua_State *L, void *ud, size_t *size) {

   600   LoadS *ls = (LoadS *)ud;

   601   (void)L;

   602   if (ls->size == 0) return NULL;

   603   *size = ls->size;

   604   ls->size = 0;

   605   return ls->s;

   606 }

   607 

   608 

   609 LUALIB_API int luaL_loadbuffer (lua_State *L, const char *buff, size_t size,

   610                                 const char *name) {

   611   LoadS ls;

   612   ls.s = buff;

   613   ls.size = size;

   614   return lua_load(L, getS, &ls, name);

   615 }

   616 

   617 

   618 LUALIB_API int (luaL_loadstring) (lua_State *L, const char *s) {

   619   return luaL_loadbuffer(L, s, strlen(s), s);

   620 }

   621 

   622 

   623 

   624 /* }====================================================== */

   625 

   626 

   627 static void *l_alloc (void *ud, void *ptr, size_t osize, size_t nsize) {

   628   (void)ud;

   629   (void)osize;

   630   if (nsize == 0) {

   631     free(ptr);

   632     return NULL;

   633   }

   634   else

   635     return realloc(ptr, nsize);

   636 }

   637 

   638 

   639 static int panic (lua_State *L) {

   640   (void)L;  /* to avoid warnings */

   641   fprintf(stderr, "PANIC: unprotected error in call to Lua API (%s)\n",

   642                    lua_tostring(L, -1));

   643   return 0;

   644 }

   645 

   646 

   647 LUALIB_API lua_State *luaL_newstate (void) {

   648   lua_State *L = lua_newstate(l_alloc, NULL);

   649   if (L) lua_atpanic(L, &panic);

   650   return L;

   651 }

   652
author	Robert McIntyre <rlm@mit.edu>
date	Tue, 03 Apr 2012 23:17:33 -0500
parents	27763b933818
children