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