Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: code/branches/ceguilua/src/lua/lbaselib.c @ 1952

Last change on this file since 1952 was 1806, checked in by rgrieder, 16 years ago

added single 5.1.3 directory for lua since CEGUILua 0.5 can also build against lua 5.1

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