* added -Wbad-function-cast
[olsrd.git] / lib / tas / src / lua / lbaselib.c
1 /*
2 ** $Id: lbaselib.c,v 1.3 2007/11/16 19:34:26 bernd67 Exp $
3 ** Basic library
4 ** See Copyright Notice in lua.h
5 */
6
7
8
9 #include <ctype.h>
10 #include <stdio.h>
11 #include <stdlib.h>
12 #include <string.h>
13
14 #define lbaselib_c
15
16 #include "lua.h"
17
18 #include "lauxlib.h"
19 #include "lualib.h"
20
21
22
23
24 /*
25 ** If your system does not support `stdout', you can just remove this function.
26 ** If you need, you can define your own `print' function, following this
27 ** model but changing `fputs' to put the strings at a proper place
28 ** (a console window or a log file, for instance).
29 */
30 static int luaB_print (lua_State *L) {
31   int n = lua_gettop(L);  /* number of arguments */
32   int i;
33   lua_getglobal(L, "tostring");
34   for (i=1; i<=n; i++) {
35     const char *s;
36     lua_pushvalue(L, -1);  /* function to be called */
37     lua_pushvalue(L, i);   /* value to print */
38     lua_call(L, 1, 1);
39     s = lua_tostring(L, -1);  /* get result */
40     if (s == NULL)
41       return luaL_error(L, "`tostring' must return a string to `print'");
42     if (i>1) fputs("\t", stdout);
43     fputs(s, stdout);
44     lua_pop(L, 1);  /* pop result */
45   }
46   fputs("\n", stdout);
47   return 0;
48 }
49
50
51 static int luaB_tonumber (lua_State *L) {
52   int base = luaL_optint(L, 2, 10);
53   if (base == 10) {  /* standard conversion */
54     luaL_checkany(L, 1);
55     if (lua_isnumber(L, 1)) {
56       lua_pushnumber(L, lua_tonumber(L, 1));
57       return 1;
58     }
59   }
60   else {
61     const char *s1 = luaL_checkstring(L, 1);
62     char *s2;
63     unsigned long n;
64     luaL_argcheck(L, 2 <= base && base <= 36, 2, "base out of range");
65     n = strtoul(s1, &s2, base);
66     if (s1 != s2) {  /* at least one valid digit? */
67       while (isspace((unsigned char)(*s2))) s2++;  /* skip trailing spaces */
68       if (*s2 == '\0') {  /* no invalid trailing characters? */
69         lua_pushnumber(L, (lua_Number)n);
70         return 1;
71       }
72     }
73   }
74   lua_pushnil(L);  /* else not a number */
75   return 1;
76 }
77
78 static int luaB_error (lua_State *L)  __attribute__((noreturn));
79 static int luaB_error (lua_State *L) {
80   int level = luaL_optint(L, 2, 1);
81   luaL_checkany(L, 1);
82   if (!lua_isstring(L, 1) || level == 0)
83     lua_pushvalue(L, 1);  /* propagate error message without changes */
84   else {  /* add extra information */
85     luaL_where(L, level);
86     lua_pushvalue(L, 1);
87     lua_concat(L, 2);
88   }
89   lua_error(L);
90 }
91
92
93 static int luaB_getmetatable (lua_State *L) {
94   luaL_checkany(L, 1);
95   if (!lua_getmetatable(L, 1)) {
96     lua_pushnil(L);
97     return 1;  /* no metatable */
98   }
99   luaL_getmetafield(L, 1, "__metatable");
100   return 1;  /* returns either __metatable field (if present) or metatable */
101 }
102
103
104 static int luaB_setmetatable (lua_State *L) {
105   int t = lua_type(L, 2);
106   luaL_checktype(L, 1, LUA_TTABLE);
107   luaL_argcheck(L, t == LUA_TNIL || t == LUA_TTABLE, 2,
108                     "nil or table expected");
109   if (luaL_getmetafield(L, 1, "__metatable"))
110     luaL_error(L, "cannot change a protected metatable");
111   lua_settop(L, 2);
112   lua_setmetatable(L, 1);
113   return 1;
114 }
115
116
117 static void getfunc (lua_State *L) {
118   if (lua_isfunction(L, 1)) lua_pushvalue(L, 1);
119   else {
120     lua_Debug ar;
121     int level = luaL_optint(L, 1, 1);
122     luaL_argcheck(L, level >= 0, 1, "level must be non-negative");
123     if (lua_getstack(L, level, &ar) == 0)
124       luaL_argerror(L, 1, "invalid level");
125     lua_getinfo(L, "f", &ar);
126     if (lua_isnil(L, -1))
127       luaL_error(L, "no function environment for tail call at level %d",
128                     level);
129   }
130 }
131
132
133 static int aux_getfenv (lua_State *L) {
134   lua_getfenv(L, -1);
135   lua_pushliteral(L, "__fenv");
136   lua_rawget(L, -2);
137   return !lua_isnil(L, -1);
138 }
139
140
141 static int luaB_getfenv (lua_State *L) {
142   getfunc(L);
143   if (!aux_getfenv(L))  /* __fenv not defined? */
144     lua_pop(L, 1);  /* remove it, to return real environment */
145   return 1;
146 }
147
148
149 static int luaB_setfenv (lua_State *L) {
150   luaL_checktype(L, 2, LUA_TTABLE);
151   getfunc(L);
152   if (aux_getfenv(L))  /* __fenv defined? */
153     luaL_error(L, "`setfenv' cannot change a protected environment");
154   else
155     lua_pop(L, 2);  /* remove __fenv and real environment table */
156   lua_pushvalue(L, 2);
157   if (lua_isnumber(L, 1) && lua_tonumber(L, 1) == 0)
158     lua_replace(L, LUA_GLOBALSINDEX);
159   else if (lua_setfenv(L, -2) == 0)
160     luaL_error(L, "`setfenv' cannot change environment of given function");
161   return 0;
162 }
163
164
165 static int luaB_rawequal (lua_State *L) {
166   luaL_checkany(L, 1);
167   luaL_checkany(L, 2);
168   lua_pushboolean(L, lua_rawequal(L, 1, 2));
169   return 1;
170 }
171
172
173 static int luaB_rawget (lua_State *L) {
174   luaL_checktype(L, 1, LUA_TTABLE);
175   luaL_checkany(L, 2);
176   lua_rawget(L, 1);
177   return 1;
178 }
179
180 static int luaB_rawset (lua_State *L) {
181   luaL_checktype(L, 1, LUA_TTABLE);
182   luaL_checkany(L, 2);
183   luaL_checkany(L, 3);
184   lua_rawset(L, 1);
185   return 1;
186 }
187
188
189 static int luaB_gcinfo (lua_State *L) {
190   lua_pushnumber(L, lua_getgccount(L));
191   lua_pushnumber(L, lua_getgcthreshold(L));
192   return 2;
193 }
194
195
196 static int luaB_collectgarbage (lua_State *L) {
197   lua_setgcthreshold(L, luaL_optint(L, 1, 0));
198   return 0;
199 }
200
201
202 static int luaB_type (lua_State *L) {
203   luaL_checkany(L, 1);
204   lua_pushstring(L, lua_typename(L, lua_type(L, 1)));
205   return 1;
206 }
207
208
209 static int luaB_next (lua_State *L) {
210   luaL_checktype(L, 1, LUA_TTABLE);
211   lua_settop(L, 2);  /* create a 2nd argument if there isn't one */
212   if (lua_next(L, 1))
213     return 2;
214   else {
215     lua_pushnil(L);
216     return 1;
217   }
218 }
219
220
221 static int luaB_pairs (lua_State *L) {
222   luaL_checktype(L, 1, LUA_TTABLE);
223   lua_pushliteral(L, "next");
224   lua_rawget(L, LUA_GLOBALSINDEX);  /* return generator, */
225   lua_pushvalue(L, 1);  /* state, */
226   lua_pushnil(L);  /* and initial value */
227   return 3;
228 }
229
230
231 static int luaB_ipairs (lua_State *L) {
232   lua_Number i = lua_tonumber(L, 2);
233   luaL_checktype(L, 1, LUA_TTABLE);
234   if (i == 0 && lua_isnone(L, 2)) {  /* `for' start? */
235     lua_pushliteral(L, "ipairs");
236     lua_rawget(L, LUA_GLOBALSINDEX);  /* return generator, */
237     lua_pushvalue(L, 1);  /* state, */
238     lua_pushnumber(L, 0);  /* and initial value */
239     return 3;
240   }
241   else {  /* `for' step */
242     i++;  /* next value */
243     lua_pushnumber(L, i);
244     lua_rawgeti(L, 1, (int)i);
245     return (lua_isnil(L, -1)) ? 0 : 2;
246   }
247 }
248
249
250 static int load_aux (lua_State *L, int status) {
251   if (status == 0)  /* OK? */
252     return 1;
253   else {
254     lua_pushnil(L);
255     lua_insert(L, -2);  /* put before error message */
256     return 2;  /* return nil plus error message */
257   }
258 }
259
260
261 static int luaB_loadstring (lua_State *L) {
262   size_t l;
263   const char *s = luaL_checklstring(L, 1, &l);
264   const char *chunkname = luaL_optstring(L, 2, s);
265   return load_aux(L, luaL_loadbuffer(L, s, l, chunkname));
266 }
267
268
269 static int luaB_loadfile (lua_State *L) {
270   const char *fname = luaL_optstring(L, 1, NULL);
271   return load_aux(L, luaL_loadfile(L, fname));
272 }
273
274
275 static int luaB_dofile (lua_State *L) {
276   const char *fname = luaL_optstring(L, 1, NULL);
277   int n = lua_gettop(L);
278   int status = luaL_loadfile(L, fname);
279   if (status != 0) lua_error(L);
280   lua_call(L, 0, LUA_MULTRET);
281   return lua_gettop(L) - n;
282 }
283
284
285 static int luaB_assert (lua_State *L) {
286   luaL_checkany(L, 1);
287   if (!lua_toboolean(L, 1))
288     return luaL_error(L, "%s", luaL_optstring(L, 2, "assertion failed!"));
289   lua_settop(L, 1);
290   return 1;
291 }
292
293
294 static int luaB_unpack (lua_State *L) {
295   int n, i;
296   luaL_checktype(L, 1, LUA_TTABLE);
297   n = luaL_getn(L, 1);
298   luaL_checkstack(L, n, "table too big to unpack");
299   for (i=1; i<=n; i++)  /* push arg[1...n] */
300     lua_rawgeti(L, 1, i);
301   return n;
302 }
303
304
305 static int luaB_pcall (lua_State *L) {
306   int status;
307   luaL_checkany(L, 1);
308   status = lua_pcall(L, lua_gettop(L) - 1, LUA_MULTRET, 0);
309   lua_pushboolean(L, (status == 0));
310   lua_insert(L, 1);
311   return lua_gettop(L);  /* return status + all results */
312 }
313
314
315 static int luaB_xpcall (lua_State *L) {
316   int status;
317   luaL_checkany(L, 2);
318   lua_settop(L, 2);
319   lua_insert(L, 1);  /* put error function under function to be called */
320   status = lua_pcall(L, 0, LUA_MULTRET, 1);
321   lua_pushboolean(L, (status == 0));
322   lua_replace(L, 1);
323   return lua_gettop(L);  /* return status + all results */
324 }
325
326
327 static int luaB_tostring (lua_State *L) {
328   char buff[128];
329   luaL_checkany(L, 1);
330   if (luaL_callmeta(L, 1, "__tostring"))  /* is there a metafield? */
331     return 1;  /* use its value */
332   switch (lua_type(L, 1)) {
333     case LUA_TNUMBER:
334       lua_pushstring(L, lua_tostring(L, 1));
335       return 1;
336     case LUA_TSTRING:
337       lua_pushvalue(L, 1);
338       return 1;
339     case LUA_TBOOLEAN:
340       lua_pushstring(L, (lua_toboolean(L, 1) ? "true" : "false"));
341       return 1;
342     case LUA_TTABLE:
343       sprintf(buff, "table: %p", lua_topointer(L, 1));
344       break;
345     case LUA_TFUNCTION:
346       sprintf(buff, "function: %p", lua_topointer(L, 1));
347       break;
348     case LUA_TUSERDATA:
349     case LUA_TLIGHTUSERDATA:
350       sprintf(buff, "userdata: %p", lua_touserdata(L, 1));
351       break;
352     case LUA_TTHREAD:
353       sprintf(buff, "thread: %p", (void *)lua_tothread(L, 1));
354       break;
355     case LUA_TNIL:
356       lua_pushliteral(L, "nil");
357       return 1;
358   }
359   lua_pushstring(L, buff);
360   return 1;
361 }
362
363
364 static int luaB_newproxy (lua_State *L) {
365   lua_settop(L, 1);
366   lua_newuserdata(L, 0);  /* create proxy */
367   if (lua_toboolean(L, 1) == 0)
368     return 1;  /* no metatable */
369   else if (lua_isboolean(L, 1)) {
370     lua_newtable(L);  /* create a new metatable `m' ... */
371     lua_pushvalue(L, -1);  /* ... and mark `m' as a valid metatable */
372     lua_pushboolean(L, 1);
373     lua_rawset(L, lua_upvalueindex(1));  /* weaktable[m] = true */
374   }
375   else {
376     int validproxy = 0;  /* to check if weaktable[metatable(u)] == true */
377     if (lua_getmetatable(L, 1)) {
378       lua_rawget(L, lua_upvalueindex(1));
379       validproxy = lua_toboolean(L, -1);
380       lua_pop(L, 1);  /* remove value */
381     }
382     luaL_argcheck(L, validproxy, 1, "boolean or proxy expected");
383     lua_getmetatable(L, 1);  /* metatable is valid; get it */
384   }
385   lua_setmetatable(L, 2);
386   return 1;
387 }
388
389
390 /*
391 ** {======================================================
392 ** `require' function
393 ** =======================================================
394 */
395
396
397 /* name of global that holds table with loaded packages */
398 #define REQTAB          "_LOADED"
399
400 /* name of global that holds the search path for packages */
401 #define LUA_PATH        "LUA_PATH"
402
403 #ifndef LUA_PATH_SEP
404 #define LUA_PATH_SEP    ';'
405 #endif
406
407 #ifndef LUA_PATH_MARK
408 #define LUA_PATH_MARK   '?'
409 #endif
410
411 #ifndef LUA_PATH_DEFAULT
412 #define LUA_PATH_DEFAULT        "?;?.lua"
413 #endif
414
415
416 static const char *getpath (lua_State *L) {
417   const char *path;
418   lua_getglobal(L, LUA_PATH);  /* try global variable */
419   path = lua_tostring(L, -1);
420   lua_pop(L, 1);
421   if (path) return path;
422   path = getenv(LUA_PATH);  /* else try environment variable */
423   if (path) return path;
424   return LUA_PATH_DEFAULT;  /* else use default */
425 }
426
427
428 static const char *pushnextpath (lua_State *L, const char *path) {
429   const char *l;
430   if (*path == '\0') return NULL;  /* no more paths */
431   if (*path == LUA_PATH_SEP) path++;  /* skip separator */
432   l = strchr(path, LUA_PATH_SEP);  /* find next separator */
433   if (l == NULL) l = path+strlen(path);
434   lua_pushlstring(L, path, l - path);  /* directory name */
435   return l;
436 }
437
438
439 static void pushcomposename (lua_State *L) {
440   const char *path = lua_tostring(L, -1);
441   const char *wild;
442   int n = 1;
443   while ((wild = strchr(path, LUA_PATH_MARK)) != NULL) {
444     /* is there stack space for prefix, name, and eventual last sufix? */
445     luaL_checkstack(L, 3, "too many marks in a path component");
446     lua_pushlstring(L, path, wild - path);  /* push prefix */
447     lua_pushvalue(L, 1);  /* push package name (in place of MARK) */
448     path = wild + 1;  /* continue after MARK */
449     n += 2;
450   }
451   lua_pushstring(L, path);  /* push last sufix (`n' already includes this) */
452   lua_concat(L, n);
453 }
454
455
456 static int luaB_require (lua_State *L) {
457   const char *path;
458   int status = LUA_ERRFILE;  /* not found (yet) */
459   luaL_checkstring(L, 1);
460   lua_settop(L, 1);
461   lua_getglobal(L, REQTAB);
462   if (!lua_istable(L, 2)) return luaL_error(L, "`" REQTAB "' is not a table");
463   path = getpath(L);
464   lua_pushvalue(L, 1);  /* check package's name in book-keeping table */
465   lua_rawget(L, 2);
466   if (lua_toboolean(L, -1))  /* is it there? */
467     return 1;  /* package is already loaded; return its result */
468   else {  /* must load it */
469     while (status == LUA_ERRFILE) {
470       lua_settop(L, 3);  /* reset stack position */
471       if ((path = pushnextpath(L, path)) == NULL) break;
472       pushcomposename(L);
473       status = luaL_loadfile(L, lua_tostring(L, -1));  /* try to load it */
474     }
475   }
476   switch (status) {
477     case 0: {
478       lua_getglobal(L, "_REQUIREDNAME");  /* save previous name */
479       lua_insert(L, -2);  /* put it below function */
480       lua_pushvalue(L, 1);
481       lua_setglobal(L, "_REQUIREDNAME");  /* set new name */
482       lua_call(L, 0, 1);  /* run loaded module */
483       lua_insert(L, -2);  /* put result below previous name */
484       lua_setglobal(L, "_REQUIREDNAME");  /* reset to previous name */
485       if (lua_isnil(L, -1)) {  /* no/nil return? */
486         lua_pushboolean(L, 1);
487         lua_replace(L, -2);  /* replace to true */
488       }
489       lua_pushvalue(L, 1);
490       lua_pushvalue(L, -2);
491       lua_rawset(L, 2);  /* mark it as loaded */
492       return 1;  /* return value */
493     }
494     case LUA_ERRFILE: {  /* file not found */
495       return luaL_error(L, "could not load package `%s' from path `%s'",
496                             lua_tostring(L, 1), getpath(L));
497     }
498     default: {
499       return luaL_error(L, "error loading package `%s' (%s)",
500                            lua_tostring(L, 1), lua_tostring(L, -1));
501     }
502   }
503 }
504
505 /* }====================================================== */
506
507
508 static const luaL_reg base_funcs[] = {
509   {"error", luaB_error},
510   {"getmetatable", luaB_getmetatable},
511   {"setmetatable", luaB_setmetatable},
512   {"getfenv", luaB_getfenv},
513   {"setfenv", luaB_setfenv},
514   {"next", luaB_next},
515   {"ipairs", luaB_ipairs},
516   {"pairs", luaB_pairs},
517   {"print", luaB_print},
518   {"tonumber", luaB_tonumber},
519   {"tostring", luaB_tostring},
520   {"type", luaB_type},
521   {"assert", luaB_assert},
522   {"unpack", luaB_unpack},
523   {"rawequal", luaB_rawequal},
524   {"rawget", luaB_rawget},
525   {"rawset", luaB_rawset},
526   {"pcall", luaB_pcall},
527   {"xpcall", luaB_xpcall},
528   {"collectgarbage", luaB_collectgarbage},
529   {"gcinfo", luaB_gcinfo},
530   {"loadfile", luaB_loadfile},
531   {"dofile", luaB_dofile},
532   {"loadstring", luaB_loadstring},
533   {"require", luaB_require},
534   {NULL, NULL}
535 };
536
537
538 /*
539 ** {======================================================
540 ** Coroutine library
541 ** =======================================================
542 */
543
544 static int auxresume (lua_State *L, lua_State *co, int narg) {
545   int status;
546   if (!lua_checkstack(co, narg))
547     luaL_error(L, "too many arguments to resume");
548   lua_xmove(L, co, narg);
549   status = lua_resume(co, narg);
550   if (status == 0) {
551     int nres = lua_gettop(co);
552     if (!lua_checkstack(L, nres))
553       luaL_error(L, "too many results to resume");
554     lua_xmove(co, L, nres);  /* move yielded values */
555     return nres;
556   }
557   else {
558     lua_xmove(co, L, 1);  /* move error message */
559     return -1;  /* error flag */
560   }
561 }
562
563
564 static int luaB_coresume (lua_State *L) {
565   lua_State *co = lua_tothread(L, 1);
566   int r;
567   luaL_argcheck(L, co, 1, "coroutine expected");
568   r = auxresume(L, co, lua_gettop(L) - 1);
569   if (r < 0) {
570     lua_pushboolean(L, 0);
571     lua_insert(L, -2);
572     return 2;  /* return false + error message */
573   }
574   else {
575     lua_pushboolean(L, 1);
576     lua_insert(L, -(r + 1));
577     return r + 1;  /* return true + `resume' returns */
578   }
579 }
580
581
582 static int luaB_auxwrap (lua_State *L) {
583   lua_State *co = lua_tothread(L, lua_upvalueindex(1));
584   int r = auxresume(L, co, lua_gettop(L));
585   if (r < 0) {
586     if (lua_isstring(L, -1)) {  /* error object is a string? */
587       luaL_where(L, 1);  /* add extra info */
588       lua_insert(L, -2);
589       lua_concat(L, 2);
590     }
591     lua_error(L);  /* propagate error */
592   }
593   return r;
594 }
595
596
597 static int luaB_cocreate (lua_State *L) {
598   lua_State *NL = lua_newthread(L);
599   luaL_argcheck(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1), 1,
600     "Lua function expected");
601   lua_pushvalue(L, 1);  /* move function to top */
602   lua_xmove(L, NL, 1);  /* move function from L to NL */
603   return 1;
604 }
605
606
607 static int luaB_cowrap (lua_State *L) {
608   luaB_cocreate(L);
609   lua_pushcclosure(L, luaB_auxwrap, 1);
610   return 1;
611 }
612
613
614 static int luaB_yield (lua_State *L) {
615   return lua_yield(L, lua_gettop(L));
616 }
617
618
619 static int luaB_costatus (lua_State *L) {
620   lua_State *co = lua_tothread(L, 1);
621   luaL_argcheck(L, co, 1, "coroutine expected");
622   if (L == co) lua_pushliteral(L, "running");
623   else {
624     lua_Debug ar;
625     if (lua_getstack(co, 0, &ar) == 0 && lua_gettop(co) == 0)
626       lua_pushliteral(L, "dead");
627     else
628       lua_pushliteral(L, "suspended");
629   }
630   return 1;
631 }
632
633
634 static const luaL_reg co_funcs[] = {
635   {"create", luaB_cocreate},
636   {"wrap", luaB_cowrap},
637   {"resume", luaB_coresume},
638   {"yield", luaB_yield},
639   {"status", luaB_costatus},
640   {NULL, NULL}
641 };
642
643 /* }====================================================== */
644
645
646
647 static void base_open (lua_State *L) {
648   lua_pushliteral(L, "_G");
649   lua_pushvalue(L, LUA_GLOBALSINDEX);
650   luaL_openlib(L, NULL, base_funcs, 0);  /* open lib into global table */
651   lua_pushliteral(L, "_VERSION");
652   lua_pushliteral(L, LUA_VERSION);
653   lua_rawset(L, -3);  /* set global _VERSION */
654   /* `newproxy' needs a weaktable as upvalue */
655   lua_pushliteral(L, "newproxy");
656   lua_newtable(L);  /* new table `w' */
657   lua_pushvalue(L, -1);  /* `w' will be its own metatable */
658   lua_setmetatable(L, -2);
659   lua_pushliteral(L, "__mode");
660   lua_pushliteral(L, "k");
661   lua_rawset(L, -3);  /* metatable(w).__mode = "k" */
662   lua_pushcclosure(L, luaB_newproxy, 1);
663   lua_rawset(L, -3);  /* set global `newproxy' */
664   lua_rawset(L, -1);  /* set global _G */
665 }
666
667
668 LUALIB_API int luaopen_base (lua_State *L) {
669   base_open(L);
670   luaL_openlib(L, LUA_COLIBNAME, co_funcs, 0);
671   lua_newtable(L);
672   lua_setglobal(L, REQTAB);
673   return 0;
674 }
675