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