l4/pkg/l4re-core/lua/lib/contrib/src/lauxlib.c

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