libs/lua/lua-5.3.3/lauxlib.c

   1 /*
   2 ** $Id: lauxlib.c,v 1.286 2016/01/08 15:33:09 roberto Exp $
   3 ** Auxiliary functions for building Lua libraries
   4 ** See Copyright Notice in lua.h
   5 */
   6
   7 #define lauxlib_c
   8 #define LUA_LIB
   9
  10 #include "lprefix.h"
  11
  12
  13 #include <errno.h>
  14 #include <stdarg.h>
  15 #include <stdio.h>
  16 #include <stdlib.h>
  17 #include <string.h>
  18
  19
  20 /*
  21 ** This file uses only the official API of Lua.
  22 ** Any function declared here could be written as an application function.
  23 */
  24
  25 #include "lua.h"
  26
  27 #include "lauxlib.h"
  28
  29
  30 /*
  31 ** {======================================================
  32 ** Traceback
  33 ** =======================================================
  34 */
  35
  36
  37 #define LEVELS1 10      /* size of the first part of the stack */
  38 #define LEVELS2 11      /* size of the second part of the stack */
  39
  40
  41
  42 /*
  43 ** search for 'objidx' in table at index -1.
  44 ** return 1 + string at top if find a good name.
  45 */
  46 static int findfield (lua_State *L, int objidx, int level) {
  47   if (level == 0 || !lua_istable(L, -1))
  48     return 0;  /* not found */
  49   lua_pushnil(L);  /* start 'next' loop */
  50   while (lua_next(L, -2)) {  /* for each pair in table */
  51     if (lua_type(L, -2) == LUA_TSTRING) {  /* ignore non-string keys */
  52       if (lua_rawequal(L, objidx, -1)) {  /* found object? */
  53         lua_pop(L, 1);  /* remove value (but keep name) */
  54         return 1;
  55       }
  56       else if (findfield(L, objidx, level - 1)) {  /* try recursively */
  57         lua_remove(L, -2);  /* remove table (but keep name) */
  58         lua_pushliteral(L, ".");
  59         lua_insert(L, -2);  /* place '.' between the two names */
  60         lua_concat(L, 3);
  61         return 1;
  62       }
  63     }
  64     lua_pop(L, 1);  /* remove value */
  65   }
  66   return 0;  /* not found */
  67 }
  68
  69
  70 /*
  71 ** Search for a name for a function in all loaded modules
  72 ** (registry._LOADED).
  73 */
  74 static int pushglobalfuncname (lua_State *L, lua_Debug *ar) {
  75   int top = lua_gettop(L);
  76   lua_getinfo(L, "f", ar);  /* push function */
  77   lua_getfield(L, LUA_REGISTRYINDEX, "_LOADED");
  78   if (findfield(L, top + 1, 2)) {
  79     const char *name = lua_tostring(L, -1);
  80     if (strncmp(name, "_G.", 3) == 0) {  /* name start with '_G.'? */
  81       lua_pushstring(L, name + 3);  /* push name without prefix */
  82       lua_remove(L, -2);  /* remove original name */
  83     }
  84     lua_copy(L, -1, top + 1);  /* move name to proper place */
  85     lua_pop(L, 2);  /* remove pushed values */
  86     return 1;
  87   }
  88   else {
  89     lua_settop(L, top);  /* remove function and global table */
  90     return 0;
  91   }
  92 }
  93
  94
  95 static void pushfuncname (lua_State *L, lua_Debug *ar) {
  96   if (pushglobalfuncname(L, ar)) {  /* try first a global name */
  97     lua_pushfstring(L, "function '%s'", lua_tostring(L, -1));
  98     lua_remove(L, -2);  /* remove name */
  99   }
 100   else if (*ar->namewhat != '\0')  /* is there a name from code? */
 101     lua_pushfstring(L, "%s '%s'", ar->namewhat, ar->name);  /* use it */
 102   else if (*ar->what == 'm')  /* main? */
 103       lua_pushliteral(L, "main chunk");
 104   else if (*ar->what != 'C')  /* for Lua functions, use <file:line> */
 105     lua_pushfstring(L, "function <%s:%d>", ar->short_src, ar->linedefined);
 106   else  /* nothing left... */
 107     lua_pushliteral(L, "?");
 108 }
 109
 110
 111 static int lastlevel (lua_State *L) {
 112   lua_Debug ar;
 113   int li = 1, le = 1;
 114   /* find an upper bound */
 115   while (lua_getstack(L, le, &ar)) { li = le; le *= 2; }
 116   /* do a binary search */
 117   while (li < le) {
 118     int m = (li + le)/2;
 119     if (lua_getstack(L, m, &ar)) li = m + 1;
 120     else le = m;
 121   }
 122   return le - 1;
 123 }
 124
 125
 126 LUALIB_API void luaL_traceback (lua_State *L, lua_State *L1,
 127                                 const char *msg, int level) {
 128   lua_Debug ar;
 129   int top = lua_gettop(L);
 130   int last = lastlevel(L1);
 131   int n1 = (last - level > LEVELS1 + LEVELS2) ? LEVELS1 : -1;
 132   if (msg)
 133     lua_pushfstring(L, "%s\n", msg);
 134   luaL_checkstack(L, 10, NULL);
 135   lua_pushliteral(L, "stack traceback:");
 136   while (lua_getstack(L1, level++, &ar)) {
 137     if (n1-- == 0) {  /* too many levels? */
 138       lua_pushliteral(L, "\n\t...");  /* add a '...' */
 139       level = last - LEVELS2 + 1;  /* and skip to last ones */
 140     }
 141     else {
 142       lua_getinfo(L1, "Slnt", &ar);
 143       lua_pushfstring(L, "\n\t%s:", ar.short_src);
 144       if (ar.currentline > 0)
 145         lua_pushfstring(L, "%d:", ar.currentline);
 146       lua_pushliteral(L, " in ");
 147       pushfuncname(L, &ar);
 148       if (ar.istailcall)
 149         lua_pushliteral(L, "\n\t(...tail calls...)");
 150       lua_concat(L, lua_gettop(L) - top);
 151     }
 152   }
 153   lua_concat(L, lua_gettop(L) - top);
 154 }
 155
 156 /* }====================================================== */
 157
 158
 159 /*
 160 ** {======================================================
 161 ** Error-report functions
 162 ** =======================================================
 163 */
 164
 165 LUALIB_API int luaL_argerror (lua_State *L, int arg, const char *extramsg) {
 166   lua_Debug ar;
 167   if (!lua_getstack(L, 0, &ar))  /* no stack frame? */
 168     return luaL_error(L, "bad argument #%d (%s)", arg, extramsg);
 169   lua_getinfo(L, "n", &ar);
 170   if (strcmp(ar.namewhat, "method") == 0) {
 171     arg--;  /* do not count 'self' */
 172     if (arg == 0)  /* error is in the self argument itself? */
 173       return luaL_error(L, "calling '%s' on bad self (%s)",
 174                            ar.name, extramsg);
 175   }
 176   if (ar.name == NULL)
 177     ar.name = (pushglobalfuncname(L, &ar)) ? lua_tostring(L, -1) : "?";
 178   return luaL_error(L, "bad argument #%d to '%s' (%s)",
 179                         arg, ar.name, extramsg);
 180 }
 181
 182
 183 static int typeerror (lua_State *L, int arg, const char *tname) {
 184   const char *msg;
 185   const char *typearg;  /* name for the type of the actual argument */
 186   if (luaL_getmetafield(L, arg, "__name") == LUA_TSTRING)
 187     typearg = lua_tostring(L, -1);  /* use the given type name */
 188   else if (lua_type(L, arg) == LUA_TLIGHTUSERDATA)
 189     typearg = "light userdata";  /* special name for messages */
 190   else
 191     typearg = luaL_typename(L, arg);  /* standard name */
 192   msg = lua_pushfstring(L, "%s expected, got %s", tname, typearg);
 193   return luaL_argerror(L, arg, msg);
 194 }
 195
 196
 197 static void tag_error (lua_State *L, int arg, int tag) {
 198   typeerror(L, arg, lua_typename(L, tag));
 199 }
 200
 201
 202 /*
 203 ** The use of 'lua_pushfstring' ensures this function does not
 204 ** need reserved stack space when called.
 205 */
 206 LUALIB_API void luaL_where (lua_State *L, int level) {
 207   lua_Debug ar;
 208   if (lua_getstack(L, level, &ar)) {  /* check function at level */
 209     lua_getinfo(L, "Sl", &ar);  /* get info about it */
 210     if (ar.currentline > 0) {  /* is there info? */
 211       lua_pushfstring(L, "%s:%d: ", ar.short_src, ar.currentline);
 212       return;
 213     }
 214   }
 215   lua_pushfstring(L, "");  /* else, no information available... */
 216 }
 217
 218
 219 /*
 220 ** Again, the use of 'lua_pushvfstring' ensures this function does
 221 ** not need reserved stack space when called. (At worst, it generates
 222 ** an error with "stack overflow" instead of the given message.)
 223 */
 224 LUALIB_API int luaL_error (lua_State *L, const char *fmt, ...) {
 225   va_list argp;
 226   va_start(argp, fmt);
 227   luaL_where(L, 1);
 228   lua_pushvfstring(L, fmt, argp);
 229   va_end(argp);
 230   lua_concat(L, 2);
 231   return lua_error(L);
 232 }
 233
 234
 235 LUALIB_API int luaL_fileresult (lua_State *L, int stat, const char *fname) {
 236   int en = errno;  /* calls to Lua API may change this value */
 237   if (stat) {
 238     lua_pushboolean(L, 1);
 239     return 1;
 240   }
 241   else {
 242     lua_pushnil(L);
 243     if (fname)
 244       lua_pushfstring(L, "%s: %s", fname, strerror(en));
 245     else
 246       lua_pushstring(L, strerror(en));
 247     lua_pushinteger(L, en);
 248     return 3;
 249   }
 250 }
 251
 252
 253 #if !defined(l_inspectstat)     /* { */
 254
 255 #if defined(LUA_USE_POSIX)
 256
 257 #include <sys/wait.h>
 258
 259 /*
 260 ** use appropriate macros to interpret 'pclose' return status
 261 */
 262 #define l_inspectstat(stat,what)  \
 263    if (WIFEXITED(stat)) { stat = WEXITSTATUS(stat); } \
 264    else if (WIFSIGNALED(stat)) { stat = WTERMSIG(stat); what = "signal"; }
 265
 266 #else
 267
 268 #define l_inspectstat(stat,what)  /* no op */
 269
 270 #endif
 271
 272 #endif                          /* } */
 273
 274
 275 LUALIB_API int luaL_execresult (lua_State *L, int stat) {
 276   const char *what = "exit";  /* type of termination */
 277   if (stat == -1)  /* error? */
 278     return luaL_fileresult(L, 0, NULL);
 279   else {
 280     l_inspectstat(stat, what);  /* interpret result */
 281     if (*what == 'e' && stat == 0)  /* successful termination? */
 282       lua_pushboolean(L, 1);
 283     else
 284       lua_pushnil(L);
 285     lua_pushstring(L, what);
 286     lua_pushinteger(L, stat);
 287     return 3;  /* return true/nil,what,code */
 288   }
 289 }
 290
 291 /* }====================================================== */
 292
 293
 294 /*
 295 ** {======================================================
 296 ** Userdata's metatable manipulation
 297 ** =======================================================
 298 */
 299
 300 LUALIB_API int luaL_newmetatable (lua_State *L, const char *tname) {
 301   if (luaL_getmetatable(L, tname) != LUA_TNIL)  /* name already in use? */
 302     return 0;  /* leave previous value on top, but return 0 */
 303   lua_pop(L, 1);
 304   lua_createtable(L, 0, 2);  /* create metatable */
 305   lua_pushstring(L, tname);
 306   lua_setfield(L, -2, "__name");  /* metatable.__name = tname */
 307   lua_pushvalue(L, -1);
 308   lua_setfield(L, LUA_REGISTRYINDEX, tname);  /* registry.name = metatable */
 309   return 1;
 310 }
 311
 312
 313 LUALIB_API void luaL_setmetatable (lua_State *L, const char *tname) {
 314   luaL_getmetatable(L, tname);
 315   lua_setmetatable(L, -2);
 316 }
 317
 318
 319 LUALIB_API void *luaL_testudata (lua_State *L, int ud, const char *tname) {
 320   void *p = lua_touserdata(L, ud);
 321   if (p != NULL) {  /* value is a userdata? */
 322     if (lua_getmetatable(L, ud)) {  /* does it have a metatable? */
 323       luaL_getmetatable(L, tname);  /* get correct metatable */
 324       if (!lua_rawequal(L, -1, -2))  /* not the same? */
 325         p = NULL;  /* value is a userdata with wrong metatable */
 326       lua_pop(L, 2);  /* remove both metatables */
 327       return p;
 328     }
 329   }
 330   return NULL;  /* value is not a userdata with a metatable */
 331 }
 332
 333
 334 LUALIB_API void *luaL_checkudata (lua_State *L, int ud, const char *tname) {
 335   void *p = luaL_testudata(L, ud, tname);
 336   if (p == NULL) typeerror(L, ud, tname);
 337   return p;
 338 }
 339
 340 /* }====================================================== */
 341
 342
 343 /*
 344 ** {======================================================
 345 ** Argument check functions
 346 ** =======================================================
 347 */
 348
 349 LUALIB_API int luaL_checkoption (lua_State *L, int arg, const char *def,
 350                                  const char *const lst[]) {
 351   const char *name = (def) ? luaL_optstring(L, arg, def) :
 352                              luaL_checkstring(L, arg);
 353   int i;
 354   for (i=0; lst[i]; i++)
 355     if (strcmp(lst[i], name) == 0)
 356       return i;
 357   return luaL_argerror(L, arg,
 358                        lua_pushfstring(L, "invalid option '%s'", name));
 359 }
 360
 361
 362 /*
 363 ** Ensures the stack has at least 'space' extra slots, raising an error
 364 ** if it cannot fulfill the request. (The error handling needs a few
 365 ** extra slots to format the error message. In case of an error without
 366 ** this extra space, Lua will generate the same 'stack overflow' error,
 367 ** but without 'msg'.)
 368 */
 369 LUALIB_API void luaL_checkstack (lua_State *L, int space, const char *msg) {
 370   if (!lua_checkstack(L, space)) {
 371     if (msg)
 372       luaL_error(L, "stack overflow (%s)", msg);
 373     else
 374       luaL_error(L, "stack overflow");
 375   }
 376 }
 377
 378
 379 LUALIB_API void luaL_checktype (lua_State *L, int arg, int t) {
 380   if (lua_type(L, arg) != t)
 381     tag_error(L, arg, t);
 382 }
 383
 384
 385 LUALIB_API void luaL_checkany (lua_State *L, int arg) {
 386   if (lua_type(L, arg) == LUA_TNONE)
 387     luaL_argerror(L, arg, "value expected");
 388 }
 389
 390
 391 LUALIB_API const char *luaL_checklstring (lua_State *L, int arg, size_t *len) {
 392   const char *s = lua_tolstring(L, arg, len);
 393   if (!s) tag_error(L, arg, LUA_TSTRING);
 394   return s;
 395 }
 396
 397
 398 LUALIB_API const char *luaL_optlstring (lua_State *L, int arg,
 399                                         const char *def, size_t *len) {
 400   if (lua_isnoneornil(L, arg)) {
 401     if (len)
 402       *len = (def ? strlen(def) : 0);
 403     return def;
 404   }
 405   else return luaL_checklstring(L, arg, len);
 406 }
 407
 408
 409 LUALIB_API lua_Number luaL_checknumber (lua_State *L, int arg) {
 410   int isnum;
 411   lua_Number d = lua_tonumberx(L, arg, &isnum);
 412   if (!isnum)
 413     tag_error(L, arg, LUA_TNUMBER);
 414   return d;
 415 }
 416
 417
 418 LUALIB_API lua_Number luaL_optnumber (lua_State *L, int arg, lua_Number def) {
 419   return luaL_opt(L, luaL_checknumber, arg, def);
 420 }
 421
 422
 423 static void interror (lua_State *L, int arg) {
 424   if (lua_isnumber(L, arg))
 425     luaL_argerror(L, arg, "number has no integer representation");
 426   else
 427     tag_error(L, arg, LUA_TNUMBER);
 428 }
 429
 430
 431 LUALIB_API lua_Integer luaL_checkinteger (lua_State *L, int arg) {
 432   int isnum;
 433   lua_Integer d = lua_tointegerx(L, arg, &isnum);
 434   if (!isnum) {
 435     interror(L, arg);
 436   }
 437   return d;
 438 }
 439
 440
 441 LUALIB_API lua_Integer luaL_optinteger (lua_State *L, int arg,
 442                                                       lua_Integer def) {
 443   return luaL_opt(L, luaL_checkinteger, arg, def);
 444 }
 445
 446 /* }====================================================== */
 447
 448
 449 /*
 450 ** {======================================================
 451 ** Generic Buffer manipulation
 452 ** =======================================================
 453 */
 454
 455 /* userdata to box arbitrary data */
 456 typedef struct UBox {
 457   void *box;
 458   size_t bsize;
 459 } UBox;
 460
 461
 462 static void *resizebox (lua_State *L, int idx, size_t newsize) {
 463   void *ud;
 464   lua_Alloc allocf = lua_getallocf(L, &ud);
 465   UBox *box = (UBox *)lua_touserdata(L, idx);
 466   void *temp = allocf(ud, box->box, box->bsize, newsize);
 467   if (temp == NULL && newsize > 0) {  /* allocation error? */
 468     resizebox(L, idx, 0);  /* free buffer */
 469     luaL_error(L, "not enough memory for buffer allocation");
 470   }
 471   box->box = temp;
 472   box->bsize = newsize;
 473   return temp;
 474 }
 475
 476
 477 static int boxgc (lua_State *L) {
 478   resizebox(L, 1, 0);
 479   return 0;
 480 }
 481
 482
 483 static void *newbox (lua_State *L, size_t newsize) {
 484   UBox *box = (UBox *)lua_newuserdata(L, sizeof(UBox));
 485   box->box = NULL;
 486   box->bsize = 0;
 487   if (luaL_newmetatable(L, "LUABOX")) {  /* creating metatable? */
 488     lua_pushcfunction(L, boxgc);
 489     lua_setfield(L, -2, "__gc");  /* metatable.__gc = boxgc */
 490   }
 491   lua_setmetatable(L, -2);
 492   return resizebox(L, -1, newsize);
 493 }
 494
 495
 496 /*
 497 ** check whether buffer is using a userdata on the stack as a temporary
 498 ** buffer
 499 */
 500 #define buffonstack(B)  ((B)->b != (B)->initb)
 501
 502
 503 /*
 504 ** returns a pointer to a free area with at least 'sz' bytes
 505 */
 506 LUALIB_API char *luaL_prepbuffsize (luaL_Buffer *B, size_t sz) {
 507   lua_State *L = B->L;
 508   if (B->size - B->n < sz) {  /* not enough space? */
 509     char *newbuff;
 510     size_t newsize = B->size * 2;  /* double buffer size */
 511     if (newsize - B->n < sz)  /* not big enough? */
 512       newsize = B->n + sz;
 513     if (newsize < B->n || newsize - B->n < sz)
 514       luaL_error(L, "buffer too large");
 515     /* create larger buffer */
 516     if (buffonstack(B))
 517       newbuff = (char *)resizebox(L, -1, newsize);
 518     else {  /* no buffer yet */
 519       newbuff = (char *)newbox(L, newsize);
 520       memcpy(newbuff, B->b, B->n * sizeof(char));  /* copy original content */
 521     }
 522     B->b = newbuff;
 523     B->size = newsize;
 524   }
 525   return &B->b[B->n];
 526 }
 527
 528
 529 LUALIB_API void luaL_addlstring (luaL_Buffer *B, const char *s, size_t l) {
 530   if (l > 0) {  /* avoid 'memcpy' when 's' can be NULL */
 531     char *b = luaL_prepbuffsize(B, l);
 532     memcpy(b, s, l * sizeof(char));
 533     luaL_addsize(B, l);
 534   }
 535 }
 536
 537
 538 LUALIB_API void luaL_addstring (luaL_Buffer *B, const char *s) {
 539   luaL_addlstring(B, s, strlen(s));
 540 }
 541
 542
 543 LUALIB_API void luaL_pushresult (luaL_Buffer *B) {
 544   lua_State *L = B->L;
 545   lua_pushlstring(L, B->b, B->n);
 546   if (buffonstack(B)) {
 547     resizebox(L, -2, 0);  /* delete old buffer */
 548     lua_remove(L, -2);  /* remove its header from the stack */
 549   }
 550 }
 551
 552
 553 LUALIB_API void luaL_pushresultsize (luaL_Buffer *B, size_t sz) {
 554   luaL_addsize(B, sz);
 555   luaL_pushresult(B);
 556 }
 557
 558
 559 LUALIB_API void luaL_addvalue (luaL_Buffer *B) {
 560   lua_State *L = B->L;
 561   size_t l;
 562   const char *s = lua_tolstring(L, -1, &l);
 563   if (buffonstack(B))
 564     lua_insert(L, -2);  /* put value below buffer */
 565   luaL_addlstring(B, s, l);
 566   lua_remove(L, (buffonstack(B)) ? -2 : -1);  /* remove value */
 567 }
 568
 569
 570 LUALIB_API void luaL_buffinit (lua_State *L, luaL_Buffer *B) {
 571   B->L = L;
 572   B->b = B->initb;
 573   B->n = 0;
 574   B->size = LUAL_BUFFERSIZE;
 575 }
 576
 577
 578 LUALIB_API char *luaL_buffinitsize (lua_State *L, luaL_Buffer *B, size_t sz) {
 579   luaL_buffinit(L, B);
 580   return luaL_prepbuffsize(B, sz);
 581 }
 582
 583 /* }====================================================== */
 584
 585
 586 /*
 587 ** {======================================================
 588 ** Reference system
 589 ** =======================================================
 590 */
 591
 592 /* index of free-list header */
 593 #define freelist        0
 594
 595
 596 LUALIB_API int luaL_ref (lua_State *L, int t) {
 597   int ref;
 598   if (lua_isnil(L, -1)) {
 599     lua_pop(L, 1);  /* remove from stack */
 600     return LUA_REFNIL;  /* 'nil' has a unique fixed reference */
 601   }
 602   t = lua_absindex(L, t);
 603   lua_rawgeti(L, t, freelist);  /* get first free element */
 604   ref = (int)lua_tointeger(L, -1);  /* ref = t[freelist] */
 605   lua_pop(L, 1);  /* remove it from stack */
 606   if (ref != 0) {  /* any free element? */
 607     lua_rawgeti(L, t, ref);  /* remove it from list */
 608     lua_rawseti(L, t, freelist);  /* (t[freelist] = t[ref]) */
 609   }
 610   else  /* no free elements */
 611     ref = (int)lua_rawlen(L, t) + 1;  /* get a new reference */
 612   lua_rawseti(L, t, ref);
 613   return ref;
 614 }
 615
 616
 617 LUALIB_API void luaL_unref (lua_State *L, int t, int ref) {
 618   if (ref >= 0) {
 619     t = lua_absindex(L, t);
 620     lua_rawgeti(L, t, freelist);
 621     lua_rawseti(L, t, ref);  /* t[ref] = t[freelist] */
 622     lua_pushinteger(L, ref);
 623     lua_rawseti(L, t, freelist);  /* t[freelist] = ref */
 624   }
 625 }
 626
 627 /* }====================================================== */
 628
 629
 630 /*
 631 ** {======================================================
 632 ** Load functions
 633 ** =======================================================
 634 */
 635
 636 typedef struct LoadF {
 637   int n;  /* number of pre-read characters */
 638   FILE *f;  /* file being read */
 639   char buff[BUFSIZ];  /* area for reading file */
 640 } LoadF;
 641
 642
 643 static const char *getF (lua_State *L, void *ud, size_t *size) {
 644   LoadF *lf = (LoadF *)ud;
 645   (void)L;  /* not used */
 646   if (lf->n > 0) {  /* are there pre-read characters to be read? */
 647     *size = lf->n;  /* return them (chars already in buffer) */
 648     lf->n = 0;  /* no more pre-read characters */
 649   }
 650   else {  /* read a block from file */
 651     /* 'fread' can return > 0 *and* set the EOF flag. If next call to
 652        'getF' called 'fread', it might still wait for user input.
 653        The next check avoids this problem. */
 654     if (feof(lf->f)) return NULL;
 655     *size = fread(lf->buff, 1, sizeof(lf->buff), lf->f);  /* read block */
 656   }
 657   return lf->buff;
 658 }
 659
 660
 661 static int errfile (lua_State *L, const char *what, int fnameindex) {
 662   const char *serr = strerror(errno);
 663   const char *filename = lua_tostring(L, fnameindex) + 1;
 664   lua_pushfstring(L, "cannot %s %s: %s", what, filename, serr);
 665   lua_remove(L, fnameindex);
 666   return LUA_ERRFILE;
 667 }
 668
 669
 670 static int skipBOM (LoadF *lf) {
 671   const char *p = "\xEF\xBB\xBF";  /* UTF-8 BOM mark */
 672   int c;
 673   lf->n = 0;
 674   do {
 675     c = getc(lf->f);
 676     if (c == EOF || c != *(const unsigned char *)p++) return c;
 677     lf->buff[lf->n++] = c;  /* to be read by the parser */
 678   } while (*p != '\0');
 679   lf->n = 0;  /* prefix matched; discard it */
 680   return getc(lf->f);  /* return next character */
 681 }
 682
 683
 684 /*
 685 ** reads the first character of file 'f' and skips an optional BOM mark
 686 ** in its beginning plus its first line if it starts with '#'. Returns
 687 ** true if it skipped the first line.  In any case, '*cp' has the
 688 ** first "valid" character of the file (after the optional BOM and
 689 ** a first-line comment).
 690 */
 691 static int skipcomment (LoadF *lf, int *cp) {
 692   int c = *cp = skipBOM(lf);
 693   if (c == '#') {  /* first line is a comment (Unix exec. file)? */
 694     do {  /* skip first line */
 695       c = getc(lf->f);
 696     } while (c != EOF && c != '\n');
 697     *cp = getc(lf->f);  /* skip end-of-line, if present */
 698     return 1;  /* there was a comment */
 699   }
 700   else return 0;  /* no comment */
 701 }
 702
 703
 704 LUALIB_API int luaL_loadfilex (lua_State *L, const char *filename,
 705                                              const char *mode) {
 706   LoadF lf;
 707   int status, readstatus;
 708   int c;
 709   int fnameindex = lua_gettop(L) + 1;  /* index of filename on the stack */
 710   if (filename == NULL) {
 711     lua_pushliteral(L, "=stdin");
 712     lf.f = stdin;
 713   }
 714   else {
 715     lua_pushfstring(L, "@%s", filename);
 716     lf.f = fopen(filename, "r");
 717     if (lf.f == NULL) return errfile(L, "open", fnameindex);
 718   }
 719   if (skipcomment(&lf, &c))  /* read initial portion */
 720     lf.buff[lf.n++] = '\n';  /* add line to correct line numbers */
 721   if (c == LUA_SIGNATURE[0] && filename) {  /* binary file? */
 722     lf.f = freopen(filename, "rb", lf.f);  /* reopen in binary mode */
 723     if (lf.f == NULL) return errfile(L, "reopen", fnameindex);
 724     skipcomment(&lf, &c);  /* re-read initial portion */
 725   }
 726   if (c != EOF)
 727     lf.buff[lf.n++] = c;  /* 'c' is the first character of the stream */
 728   status = lua_load(L, getF, &lf, lua_tostring(L, -1), mode);
 729   readstatus = ferror(lf.f);
 730   if (filename) fclose(lf.f);  /* close file (even in case of errors) */
 731   if (readstatus) {
 732     lua_settop(L, fnameindex);  /* ignore results from 'lua_load' */
 733     return errfile(L, "read", fnameindex);
 734   }
 735   lua_remove(L, fnameindex);
 736   return status;
 737 }
 738
 739
 740 typedef struct LoadS {
 741   const char *s;
 742   size_t size;
 743 } LoadS;
 744
 745
 746 static const char *getS (lua_State *L, void *ud, size_t *size) {
 747   LoadS *ls = (LoadS *)ud;
 748   (void)L;  /* not used */
 749   if (ls->size == 0) return NULL;
 750   *size = ls->size;
 751   ls->size = 0;
 752   return ls->s;
 753 }
 754
 755
 756 LUALIB_API int luaL_loadbufferx (lua_State *L, const char *buff, size_t size,
 757                                  const char *name, const char *mode) {
 758   LoadS ls;
 759   ls.s = buff;
 760   ls.size = size;
 761   return lua_load(L, getS, &ls, name, mode);
 762 }
 763
 764
 765 LUALIB_API int luaL_loadstring (lua_State *L, const char *s) {
 766   return luaL_loadbuffer(L, s, strlen(s), s);
 767 }
 768
 769 /* }====================================================== */
 770
 771
 772
 773 LUALIB_API int luaL_getmetafield (lua_State *L, int obj, const char *event) {
 774   if (!lua_getmetatable(L, obj))  /* no metatable? */
 775     return LUA_TNIL;
 776   else {
 777     int tt;
 778     lua_pushstring(L, event);
 779     tt = lua_rawget(L, -2);
 780     if (tt == LUA_TNIL)  /* is metafield nil? */
 781       lua_pop(L, 2);  /* remove metatable and metafield */
 782     else
 783       lua_remove(L, -2);  /* remove only metatable */
 784     return tt;  /* return metafield type */
 785   }
 786 }
 787
 788
 789 LUALIB_API int luaL_callmeta (lua_State *L, int obj, const char *event) {
 790   obj = lua_absindex(L, obj);
 791   if (luaL_getmetafield(L, obj, event) == LUA_TNIL)  /* no metafield? */
 792     return 0;
 793   lua_pushvalue(L, obj);
 794   lua_call(L, 1, 1);
 795   return 1;
 796 }
 797
 798
 799 LUALIB_API lua_Integer luaL_len (lua_State *L, int idx) {
 800   lua_Integer l;
 801   int isnum;
 802   lua_len(L, idx);
 803   l = lua_tointegerx(L, -1, &isnum);
 804   if (!isnum)
 805     luaL_error(L, "object length is not an integer");
 806   lua_pop(L, 1);  /* remove object */
 807   return l;
 808 }
 809
 810
 811 LUALIB_API const char *luaL_tolstring (lua_State *L, int idx, size_t *len) {
 812   if (!luaL_callmeta(L, idx, "__tostring")) {  /* no metafield? */
 813     switch (lua_type(L, idx)) {
 814       case LUA_TNUMBER: {
 815         if (lua_isinteger(L, idx))
 816           lua_pushfstring(L, "%I", lua_tointeger(L, idx));
 817         else
 818           lua_pushfstring(L, "%f", lua_tonumber(L, idx));
 819         break;
 820       }
 821       case LUA_TSTRING:
 822         lua_pushvalue(L, idx);
 823         break;
 824       case LUA_TBOOLEAN:
 825         lua_pushstring(L, (lua_toboolean(L, idx) ? "true" : "false"));
 826         break;
 827       case LUA_TNIL:
 828         lua_pushliteral(L, "nil");
 829         break;
 830       default:
 831         lua_pushfstring(L, "%s: %p", luaL_typename(L, idx),
 832                                             lua_topointer(L, idx));
 833         break;
 834     }
 835   }
 836   return lua_tolstring(L, -1, len);
 837 }
 838
 839
 840 /*
 841 ** {======================================================
 842 ** Compatibility with 5.1 module functions
 843 ** =======================================================
 844 */
 845 #if defined(LUA_COMPAT_MODULE)
 846
 847 static const char *luaL_findtable (lua_State *L, int idx,
 848                                    const char *fname, int szhint) {
 849   const char *e;
 850   if (idx) lua_pushvalue(L, idx);
 851   do {
 852     e = strchr(fname, '.');
 853     if (e == NULL) e = fname + strlen(fname);
 854     lua_pushlstring(L, fname, e - fname);
 855     if (lua_rawget(L, -2) == LUA_TNIL) {  /* no such field? */
 856       lua_pop(L, 1);  /* remove this nil */
 857       lua_createtable(L, 0, (*e == '.' ? 1 : szhint)); /* new table for field */
 858       lua_pushlstring(L, fname, e - fname);
 859       lua_pushvalue(L, -2);
 860       lua_settable(L, -4);  /* set new table into field */
 861     }
 862     else if (!lua_istable(L, -1)) {  /* field has a non-table value? */
 863       lua_pop(L, 2);  /* remove table and value */
 864       return fname;  /* return problematic part of the name */
 865     }
 866     lua_remove(L, -2);  /* remove previous table */
 867     fname = e + 1;
 868   } while (*e == '.');
 869   return NULL;
 870 }
 871
 872
 873 /*
 874 ** Count number of elements in a luaL_Reg list.
 875 */
 876 static int libsize (const luaL_Reg *l) {
 877   int size = 0;
 878   for (; l && l->name; l++) size++;
 879   return size;
 880 }
 881
 882
 883 /*
 884 ** Find or create a module table with a given name. The function
 885 ** first looks at the _LOADED table and, if that fails, try a
 886 ** global variable with that name. In any case, leaves on the stack
 887 ** the module table.
 888 */
 889 LUALIB_API void luaL_pushmodule (lua_State *L, const char *modname,
 890                                  int sizehint) {
 891   luaL_findtable(L, LUA_REGISTRYINDEX, "_LOADED", 1);  /* get _LOADED table */
 892   if (lua_getfield(L, -1, modname) != LUA_TTABLE) {  /* no _LOADED[modname]? */
 893     lua_pop(L, 1);  /* remove previous result */
 894     /* try global variable (and create one if it does not exist) */
 895     lua_pushglobaltable(L);
 896     if (luaL_findtable(L, 0, modname, sizehint) != NULL)
 897       luaL_error(L, "name conflict for module '%s'", modname);
 898     lua_pushvalue(L, -1);
 899     lua_setfield(L, -3, modname);  /* _LOADED[modname] = new table */
 900   }
 901   lua_remove(L, -2);  /* remove _LOADED table */
 902 }
 903
 904
 905 LUALIB_API void luaL_openlib (lua_State *L, const char *libname,
 906                                const luaL_Reg *l, int nup) {
 907   luaL_checkversion(L);
 908   if (libname) {
 909     luaL_pushmodule(L, libname, libsize(l));  /* get/create library table */
 910     lua_insert(L, -(nup + 1));  /* move library table to below upvalues */
 911   }
 912   if (l)
 913     luaL_setfuncs(L, l, nup);
 914   else
 915     lua_pop(L, nup);  /* remove upvalues */
 916 }
 917
 918 #endif
 919 /* }====================================================== */
 920
 921 /*
 922 ** set functions from list 'l' into table at top - 'nup'; each
 923 ** function gets the 'nup' elements at the top as upvalues.
 924 ** Returns with only the table at the stack.
 925 */
 926 LUALIB_API void luaL_setfuncs (lua_State *L, const luaL_Reg *l, int nup) {
 927   luaL_checkstack(L, nup, "too many upvalues");
 928   for (; l->name != NULL; l++) {  /* fill the table with given functions */
 929     int i;
 930     for (i = 0; i < nup; i++)  /* copy upvalues to the top */
 931       lua_pushvalue(L, -nup);
 932     lua_pushcclosure(L, l->func, nup);  /* closure with those upvalues */
 933     lua_setfield(L, -(nup + 2), l->name);
 934   }
 935   lua_pop(L, nup);  /* remove upvalues */
 936 }
 937
 938
 939 /*
 940 ** ensure that stack[idx][fname] has a table and push that table
 941 ** into the stack
 942 */
 943 LUALIB_API int luaL_getsubtable (lua_State *L, int idx, const char *fname) {
 944   if (lua_getfield(L, idx, fname) == LUA_TTABLE)
 945     return 1;  /* table already there */
 946   else {
 947     lua_pop(L, 1);  /* remove previous result */
 948     idx = lua_absindex(L, idx);
 949     lua_newtable(L);
 950     lua_pushvalue(L, -1);  /* copy to be left at top */
 951     lua_setfield(L, idx, fname);  /* assign new table to field */
 952     return 0;  /* false, because did not find table there */
 953   }
 954 }
 955
 956
 957 /*
 958 ** Stripped-down 'require': After checking "loaded" table, calls 'openf'
 959 ** to open a module, registers the result in 'package.loaded' table and,
 960 ** if 'glb' is true, also registers the result in the global table.
 961 ** Leaves resulting module on the top.
 962 */
 963 LUALIB_API void luaL_requiref (lua_State *L, const char *modname,
 964                                lua_CFunction openf, int glb) {
 965   luaL_getsubtable(L, LUA_REGISTRYINDEX, "_LOADED");
 966   lua_getfield(L, -1, modname);  /* _LOADED[modname] */
 967   if (!lua_toboolean(L, -1)) {  /* package not already loaded? */
 968     lua_pop(L, 1);  /* remove field */
 969     lua_pushcfunction(L, openf);
 970     lua_pushstring(L, modname);  /* argument to open function */
 971     lua_call(L, 1, 1);  /* call 'openf' to open module */
 972     lua_pushvalue(L, -1);  /* make copy of module (call result) */
 973     lua_setfield(L, -3, modname);  /* _LOADED[modname] = module */
 974   }
 975   lua_remove(L, -2);  /* remove _LOADED table */
 976   if (glb) {
 977     lua_pushvalue(L, -1);  /* copy of module */
 978     lua_setglobal(L, modname);  /* _G[modname] = module */
 979   }
 980 }
 981
 982
 983 LUALIB_API const char *luaL_gsub (lua_State *L, const char *s, const char *p,
 984                                                                const char *r) {
 985   const char *wild;
 986   size_t l = strlen(p);
 987   luaL_Buffer b;
 988   luaL_buffinit(L, &b);
 989   while ((wild = strstr(s, p)) != NULL) {
 990     luaL_addlstring(&b, s, wild - s);  /* push prefix */
 991     luaL_addstring(&b, r);  /* push replacement in place of pattern */
 992     s = wild + l;  /* continue after 'p' */
 993   }
 994   luaL_addstring(&b, s);  /* push last suffix */
 995   luaL_pushresult(&b);
 996   return lua_tostring(L, -1);
 997 }
 998
 999
1000 static void *l_alloc (void *ud, void *ptr, size_t osize, size_t nsize) {
1001   (void)ud; (void)osize;  /* not used */
1002   if (nsize == 0) {
1003     free(ptr);
1004     return NULL;
1005   }
1006   else
1007     return realloc(ptr, nsize);
1008 }
1009
1010
1011 static int panic (lua_State *L) {
1012   lua_writestringerror("PANIC: unprotected error in call to Lua API (%s)\n",
1013                         lua_tostring(L, -1));
1014   return 0;  /* return to Lua to abort */
1015 }
1016
1017
1018 LUALIB_API lua_State *luaL_newstate (void) {
1019   lua_State *L = lua_newstate(l_alloc, NULL);
1020   if (L) lua_atpanic(L, &panic);
1021   return L;
1022 }
1023
1024
1025 LUALIB_API void luaL_checkversion_ (lua_State *L, lua_Number ver, size_t sz) {
1026   const lua_Number *v = lua_version(L);
1027   if (sz != LUAL_NUMSIZES)  /* check numeric types */
1028     luaL_error(L, "core and library have incompatible numeric types");
1029   if (v != lua_version(NULL))
1030     luaL_error(L, "multiple Lua VMs detected");
1031   else if (*v != ver)
1032     luaL_error(L, "version mismatch: app. needs %f, Lua core provides %f",
1033                   ver, *v);
1034 }
1035