2 ** $Id: lbaselib.c,v 1.17a 2000/11/06 13:45:18 roberto Exp $
4 ** See Copyright Notice in lua.h
23 ** If your system does not support `stderr', redefine this function, or
24 ** redefine _ERRORMESSAGE so that it won't need _ALERT.
26 static int luaB__ALERT (lua_State
*L
) {
27 fputs(luaL_check_string(L
, 1), stderr
);
33 ** Basic implementation of _ERRORMESSAGE.
34 ** The library `liolib' redefines _ERRORMESSAGE for better error information.
36 static int luaB__ERRORMESSAGE (lua_State
*L
) {
37 luaL_checktype(L
, 1, LUA_TSTRING
);
38 lua_getglobal(L
, LUA_ALERT
);
39 if (lua_isfunction(L
, -1)) { /* avoid error loop if _ALERT is not defined */
41 lua_pushstring(L
, "error: ");
43 if (lua_getstack(L
, 1, &ar
)) {
44 lua_getinfo(L
, "Sl", &ar
);
45 if (ar
.source
&& ar
.currentline
> 0) {
47 sprintf(buff
, "\n <%.70s: line %d>", ar
.short_src
, ar
.currentline
);
48 lua_pushstring(L
, buff
);
52 lua_pushstring(L
, "\n");
61 ** If your system does not support `stdout', you can just remove this function.
62 ** If you need, you can define your own `print' function, following this
63 ** model but changing `fputs' to put the strings at a proper place
64 ** (a console window or a log file, for instance).
66 static int luaB_print (lua_State
*L
) {
67 int n
= lua_gettop(L
); /* number of arguments */
69 lua_getglobal(L
, "tostring");
70 for (i
=1; i
<=n
; i
++) {
72 lua_pushvalue(L
, -1); /* function to be called */
73 lua_pushvalue(L
, i
); /* value to print */
75 s
= lua_tostring(L
, -1); /* get result */
77 lua_error(L
, "`tostring' must return a string to `print'");
78 if (i
>1) fputs("\t", stdout
);
80 lua_pop(L
, 1); /* pop result */
87 static int luaB_tonumber (lua_State
*L
) {
88 int base
= luaL_opt_int(L
, 2, 10);
89 if (base
== 10) { /* standard conversion */
91 if (lua_isnumber(L
, 1)) {
92 lua_pushnumber(L
, lua_tonumber(L
, 1));
97 const char *s1
= luaL_check_string(L
, 1);
100 luaL_arg_check(L
, 2 <= base
&& base
<= 36, 2, "base out of range");
101 n
= strtoul(s1
, &s2
, base
);
102 if (s1
!= s2
) { /* at least one valid digit? */
103 while (isspace((unsigned char)*s2
)) s2
++; /* skip trailing spaces */
104 if (*s2
== '\0') { /* no invalid trailing characters? */
105 lua_pushnumber(L
, n
);
110 lua_pushnil(L
); /* else not a number */
115 static int luaB_error (lua_State
*L
) {
116 lua_error(L
, luaL_opt_string(L
, 1, NULL
));
117 return 0; /* to avoid warnings */
120 static int luaB_setglobal (lua_State
*L
) {
122 lua_setglobal(L
, luaL_check_string(L
, 1));
126 static int luaB_getglobal (lua_State
*L
) {
127 lua_getglobal(L
, luaL_check_string(L
, 1));
131 static int luaB_tag (lua_State
*L
) {
133 lua_pushnumber(L
, lua_tag(L
, 1));
137 static int luaB_settag (lua_State
*L
) {
138 luaL_checktype(L
, 1, LUA_TTABLE
);
139 lua_pushvalue(L
, 1); /* push table */
140 lua_settag(L
, luaL_check_int(L
, 2));
141 return 1; /* return table */
144 static int luaB_newtag (lua_State
*L
) {
145 lua_pushnumber(L
, lua_newtag(L
));
149 static int luaB_copytagmethods (lua_State
*L
) {
150 lua_pushnumber(L
, lua_copytagmethods(L
, luaL_check_int(L
, 1),
151 luaL_check_int(L
, 2)));
155 static int luaB_globals (lua_State
*L
) {
156 lua_getglobals(L
); /* value to be returned */
157 if (!lua_isnull(L
, 1)) {
158 luaL_checktype(L
, 1, LUA_TTABLE
);
159 lua_pushvalue(L
, 1); /* new table of globals */
165 static int luaB_rawget (lua_State
*L
) {
166 luaL_checktype(L
, 1, LUA_TTABLE
);
172 static int luaB_rawset (lua_State
*L
) {
173 luaL_checktype(L
, 1, LUA_TTABLE
);
180 static int luaB_settagmethod (lua_State
*L
) {
181 int tag
= luaL_check_int(L
, 1);
182 const char *event
= luaL_check_string(L
, 2);
183 luaL_arg_check(L
, lua_isfunction(L
, 3) || lua_isnil(L
, 3), 3,
184 "function or nil expected");
185 if (strcmp(event
, "gc") == 0)
186 lua_error(L
, "deprecated use: cannot set the `gc' tag method from Lua");
187 lua_gettagmethod(L
, tag
, event
);
189 lua_settagmethod(L
, tag
, event
);
194 static int luaB_gettagmethod (lua_State
*L
) {
195 int tag
= luaL_check_int(L
, 1);
196 const char *event
= luaL_check_string(L
, 2);
197 if (strcmp(event
, "gc") == 0)
198 lua_error(L
, "deprecated use: cannot get the `gc' tag method from Lua");
199 lua_gettagmethod(L
, tag
, event
);
204 static int luaB_gcinfo (lua_State
*L
) {
205 lua_pushnumber(L
, lua_getgccount(L
));
206 lua_pushnumber(L
, lua_getgcthreshold(L
));
211 static int luaB_collectgarbage (lua_State
*L
) {
212 lua_setgcthreshold(L
, luaL_opt_int(L
, 1, 0));
217 static int luaB_type (lua_State
*L
) {
219 lua_pushstring(L
, lua_typename(L
, lua_type(L
, 1)));
224 static int luaB_next (lua_State
*L
) {
225 luaL_checktype(L
, 1, LUA_TTABLE
);
226 lua_settop(L
, 2); /* create a 2nd argument if there isn't one */
236 static int passresults (lua_State
*L
, int status
, int oldtop
) {
237 static const char *const errornames
[] =
238 {"ok", "run-time error", "file error", "syntax error",
239 "memory error", "error in error handling"};
241 int nresults
= lua_gettop(L
) - oldtop
;
243 return nresults
; /* results are already on the stack */
245 lua_pushuserdata(L
, NULL
); /* at least one result to signal no errors */
251 lua_pushstring(L
, errornames
[status
]); /* error code */
256 static int luaB_dostring (lua_State
*L
) {
257 int oldtop
= lua_gettop(L
);
259 const char *s
= luaL_check_lstr(L
, 1, &l
);
260 if (*s
== '\33') /* binary files start with ESC... */
261 lua_error(L
, "`dostring' cannot run pre-compiled code");
262 return passresults(L
, lua_dobuffer(L
, s
, l
, luaL_opt_string(L
, 2, s
)), oldtop
);
266 static int luaB_dofile (lua_State
*L
) {
267 int oldtop
= lua_gettop(L
);
268 const char *fname
= luaL_opt_string(L
, 1, NULL
);
269 return passresults(L
, lua_dofile(L
, fname
), oldtop
);
273 static int luaB_call (lua_State
*L
) {
275 const char *options
= luaL_opt_string(L
, 3, "");
276 int err
= 0; /* index of old error method */
279 luaL_checktype(L
, 2, LUA_TTABLE
);
281 if (!lua_isnull(L
, 4)) { /* set new error method */
282 lua_getglobal(L
, LUA_ERRORMESSAGE
);
283 err
= lua_gettop(L
); /* get index */
285 lua_setglobal(L
, LUA_ERRORMESSAGE
);
287 oldtop
= lua_gettop(L
); /* top before function-call preparation */
290 luaL_checkstack(L
, n
, "too many arguments");
291 for (i
=0; i
<n
; i
++) /* push arg[1...n] */
292 lua_rawgeti(L
, 2, i
+1);
293 status
= lua_call(L
, n
, LUA_MULTRET
);
294 if (err
!= 0) { /* restore old error method */
295 lua_pushvalue(L
, err
);
296 lua_setglobal(L
, LUA_ERRORMESSAGE
);
298 if (status
!= 0) { /* error in call? */
299 if (strchr(options
, 'x'))
300 lua_pushnil(L
); /* return nil to signal the error */
302 lua_error(L
, NULL
); /* propagate error without additional messages */
305 if (strchr(options
, 'p')) /* pack results? */
306 lua_error(L
, "deprecated option `p' in `call'");
307 return lua_gettop(L
) - oldtop
; /* results are already on the stack */
311 static int luaB_tostring (lua_State
*L
) {
313 switch (lua_type(L
, 1)) {
315 lua_pushstring(L
, lua_tostring(L
, 1));
321 sprintf(buff
, "table: %p", lua_topointer(L
, 1));
324 sprintf(buff
, "function: %p", lua_topointer(L
, 1));
327 sprintf(buff
, "userdata(%d): %p", lua_tag(L
, 1), lua_touserdata(L
, 1));
330 lua_pushstring(L
, "nil");
333 luaL_argerror(L
, 1, "value expected");
335 lua_pushstring(L
, buff
);
340 static int luaB_foreachi (lua_State
*L
) {
342 luaL_checktype(L
, 1, LUA_TTABLE
);
343 luaL_checktype(L
, 2, LUA_TFUNCTION
);
345 for (i
=1; i
<=n
; i
++) {
346 lua_pushvalue(L
, 2); /* function */
347 lua_pushnumber(L
, i
); /* 1st argument */
348 lua_rawgeti(L
, 1, i
); /* 2nd argument */
349 lua_rawcall(L
, 2, 1);
350 if (!lua_isnil(L
, -1))
352 lua_pop(L
, 1); /* remove nil result */
358 static int luaB_foreach (lua_State
*L
) {
359 luaL_checktype(L
, 1, LUA_TTABLE
);
360 luaL_checktype(L
, 2, LUA_TFUNCTION
);
361 lua_pushnil(L
); /* first index */
363 if (lua_next(L
, 1) == 0)
365 lua_pushvalue(L
, 2); /* function */
366 lua_pushvalue(L
, -3); /* key */
367 lua_pushvalue(L
, -3); /* value */
368 lua_rawcall(L
, 2, 1);
369 if (!lua_isnil(L
, -1))
371 lua_pop(L
, 2); /* remove value and result */
376 static int luaB_assert (lua_State
*L
) {
379 luaL_verror(L
, "assertion failed! %.90s", luaL_opt_string(L
, 2, ""));
384 static int luaB_getn (lua_State
*L
) {
385 luaL_checktype(L
, 1, LUA_TTABLE
);
386 lua_pushnumber(L
, lua_getn(L
, 1));
391 static int luaB_tinsert (lua_State
*L
) {
392 int v
= lua_gettop(L
); /* last argument: to be inserted */
394 luaL_checktype(L
, 1, LUA_TTABLE
);
396 if (v
== 2) /* called with only 2 arguments */
399 pos
= luaL_check_int(L
, 2); /* 2nd argument is the position */
400 lua_pushstring(L
, "n");
401 lua_pushnumber(L
, n
+1);
402 lua_rawset(L
, 1); /* t.n = n+1 */
403 for (; n
>=pos
; n
--) {
404 lua_rawgeti(L
, 1, n
);
405 lua_rawseti(L
, 1, n
+1); /* t[n+1] = t[n] */
408 lua_rawseti(L
, 1, pos
); /* t[pos] = v */
413 static int luaB_tremove (lua_State
*L
) {
415 luaL_checktype(L
, 1, LUA_TTABLE
);
417 pos
= luaL_opt_int(L
, 2, n
);
418 if (n
<= 0) return 0; /* table is "empty" */
419 lua_rawgeti(L
, 1, pos
); /* result = t[pos] */
420 for ( ;pos
<n
; pos
++) {
421 lua_rawgeti(L
, 1, pos
+1);
422 lua_rawseti(L
, 1, pos
); /* a[pos] = a[pos+1] */
424 lua_pushstring(L
, "n");
425 lua_pushnumber(L
, n
-1);
426 lua_rawset(L
, 1); /* t.n = n-1 */
428 lua_rawseti(L
, 1, n
); /* t[n] = nil */
436 ** {======================================================
438 ** (based on `Algorithms in MODULA-3', Robert Sedgewick;
439 ** Addison-Wesley, 1993.)
443 static void set2 (lua_State
*L
, int i
, int j
) {
444 lua_rawseti(L
, 1, i
);
445 lua_rawseti(L
, 1, j
);
448 static int sort_comp (lua_State
*L
, int a
, int b
) {
449 /* WARNING: the caller (auxsort) must ensure stack space */
450 if (!lua_isnil(L
, 2)) { /* function? */
453 lua_pushvalue(L
, a
-1); /* -1 to compensate function */
454 lua_pushvalue(L
, b
-2); /* -2 to compensate function and `a' */
455 lua_rawcall(L
, 2, 1);
456 res
= !lua_isnil(L
, -1);
461 return lua_lessthan(L
, a
, b
);
464 static void auxsort (lua_State
*L
, int l
, int u
) {
465 while (l
< u
) { /* for tail recursion */
467 /* sort elements a[l], a[(l+u)/2] and a[u] */
468 lua_rawgeti(L
, 1, l
);
469 lua_rawgeti(L
, 1, u
);
470 if (sort_comp(L
, -1, -2)) /* a[u] < a[l]? */
471 set2(L
, l
, u
); /* swap a[l] - a[u] */
474 if (u
-l
== 1) break; /* only 2 elements */
476 lua_rawgeti(L
, 1, i
);
477 lua_rawgeti(L
, 1, l
);
478 if (sort_comp(L
, -2, -1)) /* a[i]<a[l]? */
481 lua_pop(L
, 1); /* remove a[l] */
482 lua_rawgeti(L
, 1, u
);
483 if (sort_comp(L
, -1, -2)) /* a[u]<a[i]? */
488 if (u
-l
== 2) break; /* only 3 elements */
489 lua_rawgeti(L
, 1, i
); /* Pivot */
490 lua_pushvalue(L
, -1);
491 lua_rawgeti(L
, 1, u
-1);
493 /* a[l] <= P == a[u-1] <= a[u], only need to sort from l+1 to u-2 */
495 for (;;) { /* invariant: a[l..i] <= P <= a[j..u] */
496 /* repeat ++i until a[i] >= P */
497 while (lua_rawgeti(L
, 1, ++i
), sort_comp(L
, -1, -2)) {
498 if (i
>u
) lua_error(L
, "invalid order function for sorting");
499 lua_pop(L
, 1); /* remove a[i] */
501 /* repeat --j until a[j] <= P */
502 while (lua_rawgeti(L
, 1, --j
), sort_comp(L
, -3, -1)) {
503 if (j
<l
) lua_error(L
, "invalid order function for sorting");
504 lua_pop(L
, 1); /* remove a[j] */
507 lua_pop(L
, 3); /* pop pivot, a[i], a[j] */
512 lua_rawgeti(L
, 1, u
-1);
513 lua_rawgeti(L
, 1, i
);
514 set2(L
, u
-1, i
); /* swap pivot (a[u-1]) with a[i] */
515 /* a[l..i-1] <= a[i] == P <= a[i+1..u] */
516 /* adjust so that smaller "half" is in [j..i] and larger one in [l..u] */
523 auxsort(L
, j
, i
); /* call recursively the smaller one */
524 } /* repeat the routine for the larger one */
527 static int luaB_sort (lua_State
*L
) {
529 luaL_checktype(L
, 1, LUA_TTABLE
);
531 if (!lua_isnull(L
, 2)) /* is there a 2nd argument? */
532 luaL_checktype(L
, 2, LUA_TFUNCTION
);
533 lua_settop(L
, 2); /* make sure there is two arguments */
538 /* }====================================================== */
543 ** {======================================================
544 ** Deprecated functions to manipulate global environment.
545 ** =======================================================
549 #define num_deprecated 4
551 static const struct luaL_reg deprecated_names
[num_deprecated
] = {
552 {"foreachvar", luaB_foreach
},
553 {"nextvar", luaB_next
},
554 {"rawgetglobal", luaB_rawget
},
555 {"rawsetglobal", luaB_rawset
}
559 #ifdef LUA_DEPRECATEDFUNCS
562 ** call corresponding function inserting `globals' as first argument
564 static int deprecated_func (lua_State
*L
) {
565 lua_insert(L
, 1); /* upvalue is the function to be called */
567 lua_insert(L
, 2); /* table of globals is 1o argument */
568 lua_rawcall(L
, lua_gettop(L
)-1, LUA_MULTRET
);
569 return lua_gettop(L
); /* return all results */
573 static void deprecated_funcs (lua_State
*L
) {
575 for (i
=0; i
<num_deprecated
; i
++) {
576 lua_pushcfunction(L
, deprecated_names
[i
].func
);
577 lua_pushcclosure(L
, deprecated_func
, 1);
578 lua_setglobal(L
, deprecated_names
[i
].name
);
586 ** gives an explicit error in any attempt to call a deprecated function
588 static int deprecated_func (lua_State
*L
) {
589 luaL_verror(L
, "function `%.20s' is deprecated", lua_tostring(L
, -1));
590 return 0; /* to avoid warnings */
594 static void deprecated_funcs (lua_State
*L
) {
596 for (i
=0; i
<num_deprecated
; i
++) {
597 lua_pushstring(L
, deprecated_names
[i
].name
);
598 lua_pushcclosure(L
, deprecated_func
, 1);
599 lua_setglobal(L
, deprecated_names
[i
].name
);
605 /* }====================================================== */
607 static const struct luaL_reg base_funcs
[] = {
608 {LUA_ALERT
, luaB__ALERT
},
609 {LUA_ERRORMESSAGE
, luaB__ERRORMESSAGE
},
611 {"collectgarbage", luaB_collectgarbage
},
612 {"copytagmethods", luaB_copytagmethods
},
613 {"dofile", luaB_dofile
},
614 {"dostring", luaB_dostring
},
615 {"error", luaB_error
},
616 {"foreach", luaB_foreach
},
617 {"foreachi", luaB_foreachi
},
618 {"gcinfo", luaB_gcinfo
},
619 {"getglobal", luaB_getglobal
},
620 {"gettagmethod", luaB_gettagmethod
},
621 {"globals", luaB_globals
},
622 {"newtag", luaB_newtag
},
624 {"print", luaB_print
},
625 {"rawget", luaB_rawget
},
626 {"rawset", luaB_rawset
},
627 {"rawgettable", luaB_rawget
}, /* for compatibility */
628 {"rawsettable", luaB_rawset
}, /* for compatibility */
629 {"setglobal", luaB_setglobal
},
630 {"settag", luaB_settag
},
631 {"settagmethod", luaB_settagmethod
},
633 {"tonumber", luaB_tonumber
},
634 {"tostring", luaB_tostring
},
636 {"assert", luaB_assert
},
639 {"tinsert", luaB_tinsert
},
640 {"tremove", luaB_tremove
}
645 LUALIB_API
void lua_baselibopen (lua_State
*L
) {
646 luaL_openl(L
, base_funcs
);
647 lua_pushstring(L
, LUA_VERSION
);
648 lua_setglobal(L
, "_VERSION");