]> rtime.felk.cvut.cz Git - l4.git/blob - l4/pkg/lua/lib/contrib/src/lbaselib.c
update
[l4.git] / l4 / pkg / lua / lib / contrib / src / lbaselib.c
1 /*
2 ** $Id: lbaselib.c,v 1.191.1.6 2008/02/14 16:46:22 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 #define LUA_LIB
16
17 #include "lua.h"
18
19 #include "lauxlib.h"
20 #include "lualib.h"
21 #include "llimits.h"
22 #include "lobject.h"
23 #include "lapi.h"
24
25
26
27 /*
28 ** If your system does not support `stdout', you can just remove this function.
29 ** If you need, you can define your own `print' function, following this
30 ** model but changing `fputs' to put the strings at a proper place
31 ** (a console window or a log file, for instance).
32 */
33 static int luaB_print (lua_State *L) {
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, LUA_QL("tostring") " must return a string to "
45                            LUA_QL("print"));
46     if (i>1) 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 luaB_tonumber (lua_State *L) {
56   int base = luaL_optint(L, 2, 10);
57   if (base == 10) {  /* standard conversion */
58     luaL_checkany(L, 1);
59     if (lua_isnumber(L, 1)) {       /* numeric string, or a number */
60 #ifdef LUA_TINT
61       lua_pushvalue_as_number(L,1);     /* API extension (not to lose accuracy here) */
62 #else
63       lua_pushnumber(L, lua_tonumber(L, 1));
64 #endif
65       return 1;
66         }
67   }
68   else {
69     const char *s1 = luaL_checkstring(L, 1);
70     char *s2;
71     unsigned LUA_INTEGER n;
72     luaL_argcheck(L, 2 <= base && base <= 36, 2, "base out of range");
73     n = lua_str2ul(s1, &s2, base);
74     if (s1 != s2) {  /* at least one valid digit? */
75       while (isspace((unsigned char)(*s2))) s2++;  /* skip trailing spaces */
76       if (*s2 == '\0') {  /* no invalid trailing characters? */
77           
78                 /* Push as number, there needs to be separate 'luaB_tointeger' for
79                  * when the caller wants to preserve the bits (matters if unsigned
80                  * values are used).
81                  */
82         lua_pushnumber(L, cast_num(n));
83         return 1;
84       }
85     }
86   }
87   lua_pushnil(L);  /* else not a number */
88   return 1;
89 }
90
91
92 static int luaB_error (lua_State *L) {
93   int level = luaL_optint(L, 2, 1);
94   lua_settop(L, 1);
95   if (lua_isstring(L, 1) && level > 0) {  /* add extra information? */
96     luaL_where(L, level);
97     lua_pushvalue(L, 1);
98     lua_concat(L, 2);
99   }
100   return lua_error(L);
101 }
102
103
104 static int luaB_getmetatable (lua_State *L) {
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 luaB_setmetatable (lua_State *L) {
116   int t = lua_type(L, 2);
117   luaL_checktype(L, 1, LUA_TTABLE);
118   luaL_argcheck(L, t == LUA_TNIL || t == LUA_TTABLE, 2,
119                     "nil or table expected");
120   if (luaL_getmetafield(L, 1, "__metatable"))
121     luaL_error(L, "cannot change a protected metatable");
122   lua_settop(L, 2);
123   lua_setmetatable(L, 1);
124   return 1;
125 }
126
127
128 static void getfunc (lua_State *L, int opt) {
129   if (lua_isfunction(L, 1)) lua_pushvalue(L, 1);
130   else {
131     lua_Debug ar;
132     int level = opt ? luaL_optint(L, 1, 1) : luaL_checkint(L, 1);
133     luaL_argcheck(L, level >= 0, 1, "level must be non-negative");
134     if (lua_getstack(L, level, &ar) == 0)
135       luaL_argerror(L, 1, "invalid level");
136     lua_getinfo(L, "f", &ar);
137     if (lua_isnil(L, -1))
138       luaL_error(L, "no function environment for tail call at level %d",
139                     level);
140   }
141 }
142
143
144 static int luaB_getfenv (lua_State *L) {
145   getfunc(L, 1);
146   if (lua_iscfunction(L, -1))  /* is a C function? */
147     lua_pushvalue(L, LUA_GLOBALSINDEX);  /* return the thread's global env. */
148   else
149     lua_getfenv(L, -1);
150   return 1;
151 }
152
153
154 static int luaB_setfenv (lua_State *L) {
155   luaL_checktype(L, 2, LUA_TTABLE);
156   getfunc(L, 0);
157   lua_pushvalue(L, 2);
158   if (lua_isnumber(L, 1) && lua_tointeger(L, 1) == 0) {
159     /* change environment of current thread */
160     lua_pushthread(L);
161     lua_insert(L, -2);
162     lua_setfenv(L, -2);
163     return 0;
164   }
165   else if (lua_iscfunction(L, -2) || lua_setfenv(L, -2) == 0)
166     luaL_error(L,
167           LUA_QL("setfenv") " cannot change environment of given object");
168   return 1;
169 }
170
171
172 static int luaB_rawequal (lua_State *L) {
173   luaL_checkany(L, 1);
174   luaL_checkany(L, 2);
175   lua_pushboolean(L, lua_rawequal(L, 1, 2));
176   return 1;
177 }
178
179
180 static int luaB_rawget (lua_State *L) {
181   luaL_checktype(L, 1, LUA_TTABLE);
182   luaL_checkany(L, 2);
183   lua_settop(L, 2);
184   lua_rawget(L, 1);
185   return 1;
186 }
187
188 static int luaB_rawset (lua_State *L) {
189   luaL_checktype(L, 1, LUA_TTABLE);
190   luaL_checkany(L, 2);
191   luaL_checkany(L, 3);
192   lua_settop(L, 3);
193   lua_rawset(L, 1);
194   return 1;
195 }
196
197
198 static int luaB_gcinfo (lua_State *L) {
199   lua_pushinteger(L, lua_getgccount(L));
200   return 1;
201 }
202
203
204 static int luaB_collectgarbage (lua_State *L) {
205   static const char *const opts[] = {"stop", "restart", "collect",
206     "count", "step", "setpause", "setstepmul", NULL};
207   static const int optsnum[] = {LUA_GCSTOP, LUA_GCRESTART, LUA_GCCOLLECT,
208     LUA_GCCOUNT, LUA_GCSTEP, LUA_GCSETPAUSE, LUA_GCSETSTEPMUL};
209   int o = luaL_checkoption(L, 1, "collect", opts);
210   int ex = luaL_optint(L, 2, 0);
211   int res = lua_gc(L, optsnum[o], ex);
212   switch (optsnum[o]) {
213     case LUA_GCCOUNT: {
214       int b = lua_gc(L, LUA_GCCOUNTB, 0);
215       lua_pushnumber(L, res + (cast_num(b)/1024));
216       return 1;
217     }
218     case LUA_GCSTEP: {
219       lua_pushboolean(L, res);
220       return 1;
221     }
222     default: {
223       lua_pushinteger(L, res);
224       return 1;
225     }
226   }
227 }
228
229
230 static int luaB_type (lua_State *L) {
231   luaL_checkany(L, 1);
232   lua_pushstring(L, luaL_typename(L, 1));
233   return 1;
234 }
235
236
237 static int luaB_next (lua_State *L) {
238   luaL_checktype(L, 1, LUA_TTABLE);
239   lua_settop(L, 2);  /* create a 2nd argument if there isn't one */
240   if (lua_next(L, 1))
241     return 2;
242   else {
243     lua_pushnil(L);
244     return 1;
245   }
246 }
247
248
249 static int luaB_pairs (lua_State *L) {
250   luaL_checktype(L, 1, LUA_TTABLE);
251   lua_pushvalue(L, lua_upvalueindex(1));  /* return generator, */
252   lua_pushvalue(L, 1);  /* state, */
253   lua_pushnil(L);  /* and initial value */
254   return 3;
255 }
256
257
258 static int ipairsaux (lua_State *L) {
259   int i = luaL_checkint(L, 2);
260   luaL_checktype(L, 1, LUA_TTABLE);
261   i++;  /* next value */
262   lua_pushinteger(L, i);
263   lua_rawgeti(L, 1, i);
264   return (lua_isnil(L, -1)) ? 0 : 2;
265 }
266
267
268 static int luaB_ipairs (lua_State *L) {
269   luaL_checktype(L, 1, LUA_TTABLE);
270   lua_pushvalue(L, lua_upvalueindex(1));  /* return generator, */
271   lua_pushvalue(L, 1);  /* state, */
272   lua_pushinteger(L, 0);  /* and initial value */
273   return 3;
274 }
275
276
277 static int load_aux (lua_State *L, int status) {
278   if (status == 0)  /* OK? */
279     return 1;
280   else {
281     lua_pushnil(L);
282     lua_insert(L, -2);  /* put before error message */
283     return 2;  /* return nil plus error message */
284   }
285 }
286
287
288 static int luaB_loadstring (lua_State *L) {
289   size_t l;
290   const char *s = luaL_checklstring(L, 1, &l);
291   const char *chunkname = luaL_optstring(L, 2, s);
292   return load_aux(L, luaL_loadbuffer(L, s, l, chunkname));
293 }
294
295
296 static int luaB_loadfile (lua_State *L) {
297   const char *fname = luaL_optstring(L, 1, NULL);
298   return load_aux(L, luaL_loadfile(L, fname));
299 }
300
301
302 /*
303 ** Reader for generic `load' function: `lua_load' uses the
304 ** stack for internal stuff, so the reader cannot change the
305 ** stack top. Instead, it keeps its resulting string in a
306 ** reserved slot inside the stack.
307 */
308 static const char *generic_reader (lua_State *L, void *ud, size_t *size) {
309   (void)ud;  /* to avoid warnings */
310   luaL_checkstack(L, 2, "too many nested functions");
311   lua_pushvalue(L, 1);  /* get function */
312   lua_call(L, 0, 1);  /* call it */
313   if (lua_isnil(L, -1)) {
314     *size = 0;
315     return NULL;
316   }
317   else if (lua_isstring(L, -1)) {
318     lua_replace(L, 3);  /* save string in a reserved stack slot */
319     return lua_tolstring(L, 3, size);
320   }
321   else luaL_error(L, "reader function must return a string");
322   return NULL;  /* to avoid warnings */
323 }
324
325
326 static int luaB_load (lua_State *L) {
327   int status;
328   const char *cname = luaL_optstring(L, 2, "=(load)");
329   luaL_checktype(L, 1, LUA_TFUNCTION);
330   lua_settop(L, 3);  /* function, eventual name, plus one reserved slot */
331   status = lua_load(L, generic_reader, NULL, cname);
332   return load_aux(L, status);
333 }
334
335
336 static int luaB_dofile (lua_State *L) {
337   const char *fname = luaL_optstring(L, 1, NULL);
338   int n = lua_gettop(L);
339   if (luaL_loadfile(L, fname) != 0) lua_error(L);
340   lua_call(L, 0, LUA_MULTRET);
341   return lua_gettop(L) - n;
342 }
343
344
345 static int luaB_assert (lua_State *L) {
346   luaL_checkany(L, 1);
347   if (!lua_toboolean(L, 1))
348     return luaL_error(L, "%s", luaL_optstring(L, 2, "assertion failed!"));
349   return lua_gettop(L);
350 }
351
352
353 static int luaB_unpack (lua_State *L) {
354   int i, e, n;
355   luaL_checktype(L, 1, LUA_TTABLE);
356   i = luaL_optint(L, 2, 1);
357   e = luaL_opt(L, luaL_checkint, 3, luaL_getn(L, 1));
358   if (i > e) return 0;  /* empty range */
359   n = e - i + 1;  /* number of elements */
360   if (n <= 0 || !lua_checkstack(L, n))  /* n <= 0 means arith. overflow */
361     return luaL_error(L, "too many results to unpack");
362   lua_rawgeti(L, 1, i);  /* push arg[i] (avoiding overflow problems) */
363   while (i++ < e)  /* push arg[i + 1...e] */
364     lua_rawgeti(L, 1, i);
365   return n;
366 }
367
368
369 static int luaB_select (lua_State *L) {
370   int n = lua_gettop(L);
371   if (lua_type(L, 1) == LUA_TSTRING && *lua_tostring(L, 1) == '#') {
372     lua_pushinteger(L, n-1);
373     return 1;
374   }
375   else {
376     int i = luaL_checkint(L, 1);
377     if (i < 0) i = n + i;
378     else if (i > n) i = n;
379     luaL_argcheck(L, 1 <= i, 1, "index out of range");
380     return n - i;
381   }
382 }
383
384
385 static int luaB_pcall (lua_State *L) {
386   int status;
387   luaL_checkany(L, 1);
388   status = lua_pcall(L, lua_gettop(L) - 1, LUA_MULTRET, 0);
389   lua_pushboolean(L, (status == 0));
390   lua_insert(L, 1);
391   return lua_gettop(L);  /* return status + all results */
392 }
393
394
395 static int luaB_xpcall (lua_State *L) {
396   int status;
397   luaL_checkany(L, 2);
398   lua_settop(L, 2);
399   lua_insert(L, 1);  /* put error function under function to be called */
400   status = lua_pcall(L, 0, LUA_MULTRET, 1);
401   lua_pushboolean(L, (status == 0));
402   lua_replace(L, 1);
403   return lua_gettop(L);  /* return status + all results */
404 }
405
406
407 static int luaB_tostring (lua_State *L) {
408   luaL_checkany(L, 1);
409   if (luaL_callmeta(L, 1, "__tostring"))  /* is there a metafield? */
410     return 1;  /* use its value */
411   switch (lua_type(L, 1)) {
412     case LUA_TNUMBER:
413       lua_pushstring(L, lua_tostring(L, 1));
414       break;
415     case LUA_TSTRING:
416       lua_pushvalue(L, 1);
417       break;
418     case LUA_TBOOLEAN:
419       lua_pushstring(L, (lua_toboolean(L, 1) ? "true" : "false"));
420       break;
421     case LUA_TNIL:
422       lua_pushliteral(L, "nil");
423       break;
424     default:
425       lua_pushfstring(L, "%s: %p", luaL_typename(L, 1), lua_topointer(L, 1));
426       break;
427   }
428   return 1;
429 }
430
431
432 static int luaB_newproxy (lua_State *L) {
433   lua_settop(L, 1);
434   lua_newuserdata(L, 0);  /* create proxy */
435   if (lua_toboolean(L, 1) == 0)
436     return 1;  /* no metatable */
437   else if (lua_isboolean(L, 1)) {
438     lua_newtable(L);  /* create a new metatable `m' ... */
439     lua_pushvalue(L, -1);  /* ... and mark `m' as a valid metatable */
440     lua_pushboolean(L, 1);
441     lua_rawset(L, lua_upvalueindex(1));  /* weaktable[m] = true */
442   }
443   else {
444     int validproxy = 0;  /* to check if weaktable[metatable(u)] == true */
445     if (lua_getmetatable(L, 1)) {
446       lua_rawget(L, lua_upvalueindex(1));
447       validproxy = lua_toboolean(L, -1);
448       lua_pop(L, 1);  /* remove value */
449     }
450     luaL_argcheck(L, validproxy, 1, "boolean or proxy expected");
451     lua_getmetatable(L, 1);  /* metatable is valid; get it */
452   }
453   lua_setmetatable(L, 2);
454   return 1;
455 }
456
457
458 static const luaL_Reg base_funcs[] = {
459   {"assert", luaB_assert},
460   {"collectgarbage", luaB_collectgarbage},
461   {"dofile", luaB_dofile},
462   {"error", luaB_error},
463   {"gcinfo", luaB_gcinfo},
464   {"getfenv", luaB_getfenv},
465   {"getmetatable", luaB_getmetatable},
466   {"loadfile", luaB_loadfile},
467   {"load", luaB_load},
468   {"loadstring", luaB_loadstring},
469   {"next", luaB_next},
470   {"pcall", luaB_pcall},
471   {"print", luaB_print},
472   {"rawequal", luaB_rawequal},
473   {"rawget", luaB_rawget},
474   {"rawset", luaB_rawset},
475   {"select", luaB_select},
476   {"setfenv", luaB_setfenv},
477   {"setmetatable", luaB_setmetatable},
478   {"tonumber", luaB_tonumber},
479   {"tostring", luaB_tostring},
480   {"type", luaB_type},
481   {"unpack", luaB_unpack},
482   {"xpcall", luaB_xpcall},
483   {NULL, NULL}
484 };
485
486
487 /*
488 ** {======================================================
489 ** Coroutine library
490 ** =======================================================
491 */
492
493 #define CO_RUN  0       /* running */
494 #define CO_SUS  1       /* suspended */
495 #define CO_NOR  2       /* 'normal' (it resumed another coroutine) */
496 #define CO_DEAD 3
497
498 static const char *const statnames[] =
499     {"running", "suspended", "normal", "dead"};
500
501 static int costatus (lua_State *L, lua_State *co) {
502   if (L == co) return CO_RUN;
503   switch (lua_status(co)) {
504     case LUA_YIELD:
505       return CO_SUS;
506     case 0: {
507       lua_Debug ar;
508       if (lua_getstack(co, 0, &ar) > 0)  /* does it have frames? */
509         return CO_NOR;  /* it is running */
510       else if (lua_gettop(co) == 0)
511           return CO_DEAD;
512       else
513         return CO_SUS;  /* initial state */
514     }
515     default:  /* some error occured */
516       return CO_DEAD;
517   }
518 }
519
520
521 static int luaB_costatus (lua_State *L) {
522   lua_State *co = lua_tothread(L, 1);
523   luaL_argcheck(L, co, 1, "coroutine expected");
524   lua_pushstring(L, statnames[costatus(L, co)]);
525   return 1;
526 }
527
528
529 static int auxresume (lua_State *L, lua_State *co, int narg) {
530   int status = costatus(L, co);
531   if (!lua_checkstack(co, narg))
532     luaL_error(L, "too many arguments to resume");
533   if (status != CO_SUS) {
534     lua_pushfstring(L, "cannot resume %s coroutine", statnames[status]);
535     return -1;  /* error flag */
536   }
537   lua_xmove(L, co, narg);
538   lua_setlevel(L, co);
539   status = lua_resume(co, narg);
540   if (status == 0 || status == LUA_YIELD) {
541     int nres = lua_gettop(co);
542     if (!lua_checkstack(L, nres + 1))
543       luaL_error(L, "too many results to resume");
544     lua_xmove(co, L, nres);  /* move yielded values */
545     return nres;
546   }
547   else {
548     lua_xmove(co, L, 1);  /* move error message */
549     return -1;  /* error flag */
550   }
551 }
552
553
554 static int luaB_coresume (lua_State *L) {
555   lua_State *co = lua_tothread(L, 1);
556   int r;
557   luaL_argcheck(L, co, 1, "coroutine expected");
558   r = auxresume(L, co, lua_gettop(L) - 1);
559   if (r < 0) {
560     lua_pushboolean(L, 0);
561     lua_insert(L, -2);
562     return 2;  /* return false + error message */
563   }
564   else {
565     lua_pushboolean(L, 1);
566     lua_insert(L, -(r + 1));
567     return r + 1;  /* return true + `resume' returns */
568   }
569 }
570
571
572 static int luaB_auxwrap (lua_State *L) {
573   lua_State *co = lua_tothread(L, lua_upvalueindex(1));
574   int r = auxresume(L, co, lua_gettop(L));
575   if (r < 0) {
576     if (lua_isstring(L, -1)) {  /* error object is a string? */
577       luaL_where(L, 1);  /* add extra info */
578       lua_insert(L, -2);
579       lua_concat(L, 2);
580     }
581     lua_error(L);  /* propagate error */
582   }
583   return r;
584 }
585
586
587 static int luaB_cocreate (lua_State *L) {
588   lua_State *NL = lua_newthread(L);
589   luaL_argcheck(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1), 1,
590     "Lua function expected");
591   lua_pushvalue(L, 1);  /* move function to top */
592   lua_xmove(L, NL, 1);  /* move function from L to NL */
593   return 1;
594 }
595
596
597 static int luaB_cowrap (lua_State *L) {
598   luaB_cocreate(L);
599   lua_pushcclosure(L, luaB_auxwrap, 1);
600   return 1;
601 }
602
603
604 static int luaB_yield (lua_State *L) {
605   return lua_yield(L, lua_gettop(L));
606 }
607
608
609 static int luaB_corunning (lua_State *L) {
610   if (lua_pushthread(L))
611     lua_pushnil(L);  /* main thread is not a coroutine */
612   return 1;
613 }
614
615
616 static const luaL_Reg co_funcs[] = {
617   {"create", luaB_cocreate},
618   {"resume", luaB_coresume},
619   {"running", luaB_corunning},
620   {"status", luaB_costatus},
621   {"wrap", luaB_cowrap},
622   {"yield", luaB_yield},
623   {NULL, NULL}
624 };
625
626 /* }====================================================== */
627
628
629 static void auxopen (lua_State *L, const char *name,
630                      lua_CFunction f, lua_CFunction u) {
631   lua_pushcfunction(L, u);
632   lua_pushcclosure(L, f, 1);
633   lua_setfield(L, -2, name);
634 }
635
636
637 static void base_open (lua_State *L) {
638   /* set global _G */
639   lua_pushvalue(L, LUA_GLOBALSINDEX);
640   lua_setglobal(L, "_G");
641   /* open lib into global table */
642   luaL_register(L, "_G", base_funcs);
643   lua_pushliteral(L, LUA_VERSION);
644   lua_setglobal(L, "_VERSION");  /* set global _VERSION */
645   lua_pushliteral(L, LUA_LNUM);
646   lua_setglobal(L, "_LNUM");  /* "[complex] double|float|ldouble [int16|int32|int64]" */
647   /* `ipairs' and `pairs' need auxiliary functions as upvalues */
648   auxopen(L, "ipairs", luaB_ipairs, ipairsaux);
649   auxopen(L, "pairs", luaB_pairs, luaB_next);
650   /* `newproxy' needs a weaktable as upvalue */
651   lua_createtable(L, 0, 1);  /* new table `w' */
652   lua_pushvalue(L, -1);  /* `w' will be its own metatable */
653   lua_setmetatable(L, -2);
654   lua_pushliteral(L, "kv");
655   lua_setfield(L, -2, "__mode");  /* metatable(w).__mode = "kv" */
656   lua_pushcclosure(L, luaB_newproxy, 1);
657   lua_setglobal(L, "newproxy");  /* set global `newproxy' */
658 }
659
660
661 LUALIB_API int luaopen_base (lua_State *L) {
662   base_open(L);
663   luaL_register(L, LUA_COLIBNAME, co_funcs);
664   return 2;
665 }
666