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