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