2 ** $Id: lbuiltin.c,v 1.59 1999/06/17 17:04:03 roberto Exp $
4 ** See Copyright Notice in lua.h
31 ** {======================================================
32 ** Auxiliary functions
33 ** =======================================================
37 static void pushtagstring (TaggedString
*s
) {
39 o
.ttype
= LUA_T_STRING
;
45 static real
getsize (Hash
*h
) {
48 for (i
= 0; i
<nhash(h
); i
++) {
50 if (ttype(ref(n
)) == LUA_T_NUMBER
&&
51 ttype(val(n
)) != LUA_T_NIL
&&
59 static real
getnarg (Hash
*a
) {
63 ttype(&index
) = LUA_T_STRING
;
64 tsvalue(&index
) = luaS_new("n");
65 value
= luaH_get(a
, &index
);
66 return (ttype(value
) == LUA_T_NUMBER
) ? nvalue(value
) : getsize(a
);
70 static Hash
*gethash (int arg
) {
71 return avalue(luaA_Address(luaL_tablearg(arg
)));
74 /* }====================================================== */
78 ** {======================================================
79 ** Functions that use only the official API
80 ** =======================================================
85 ** If your system does not support "stderr", redefine this function, or
86 ** redefine _ERRORMESSAGE so that it won't need _ALERT.
88 static void luaB_alert (void) {
89 fputs(luaL_check_string(1), stderr
);
94 ** Standard implementation of _ERRORMESSAGE.
95 ** The library "iolib" redefines _ERRORMESSAGE for better error information.
97 static void error_message (void) {
98 lua_Object al
= lua_rawgetglobal("_ALERT");
99 if (lua_isfunction(al
)) { /* avoid error loop if _ALERT is not defined */
101 sprintf(buff
, "lua error: %.500s\n", luaL_check_string(1));
102 lua_pushstring(buff
);
103 lua_callfunction(al
);
109 ** If your system does not support "stdout", just remove this function.
110 ** If you need, you can define your own "print" function, following this
111 ** model but changing "fputs" to put the strings at a proper place
112 ** (a console window or a log file, for instance).
115 #define MAXPRINT 40 /* arbitrary limit */
118 static void luaB_print (void) {
119 lua_Object args
[MAXPRINT
];
123 while ((obj
= lua_getparam(n
+1)) != LUA_NOOBJECT
) {
124 luaL_arg_check(n
< MAXPRINT
, n
+1, "too many arguments");
127 for (i
=0; i
<n
; i
++) {
128 lua_pushobject(args
[i
]);
129 if (lua_call("tostring"))
130 lua_error("error in `tostring' called by `print'");
131 obj
= lua_getresult(1);
132 if (!lua_isstring(obj
))
133 lua_error("`tostring' must return a string to `print'");
134 if (i
>0) fputs("\t", stdout
);
135 fputs(lua_getstring(obj
), stdout
);
141 static void luaB_tonumber (void) {
142 int base
= luaL_opt_int(2, 10);
143 if (base
== 10) { /* standard conversion */
144 lua_Object o
= lua_getparam(1);
145 if (lua_isnumber(o
)) lua_pushnumber(lua_getnumber(o
));
146 else lua_pushnil(); /* not a number */
149 char *s
= luaL_check_string(1);
151 luaL_arg_check(0 <= base
&& base
<= 36, 2, "base out of range");
152 n
= strtol(s
, &s
, base
);
153 while (isspace((unsigned char)*s
)) s
++; /* skip trailing spaces */
154 if (*s
) lua_pushnil(); /* invalid format: return nil */
155 else lua_pushnumber(n
);
160 static void luaB_error (void) {
161 lua_error(lua_getstring(lua_getparam(1)));
164 static void luaB_setglobal (void) {
165 char *n
= luaL_check_string(1);
166 lua_Object value
= luaL_nonnullarg(2);
167 lua_pushobject(value
);
169 lua_pushobject(value
); /* return given value */
172 static void luaB_rawsetglobal (void) {
173 char *n
= luaL_check_string(1);
174 lua_Object value
= luaL_nonnullarg(2);
175 lua_pushobject(value
);
177 lua_pushobject(value
); /* return given value */
180 static void luaB_getglobal (void) {
181 lua_pushobject(lua_getglobal(luaL_check_string(1)));
184 static void luaB_rawgetglobal (void) {
185 lua_pushobject(lua_rawgetglobal(luaL_check_string(1)));
188 static void luaB_luatag (void) {
189 lua_pushnumber(lua_tag(lua_getparam(1)));
192 static void luaB_settag (void) {
193 lua_Object o
= luaL_tablearg(1);
195 lua_settag(luaL_check_int(2));
196 lua_pushobject(o
); /* return first argument */
199 static void luaB_newtag (void) {
200 lua_pushnumber(lua_newtag());
203 static void luaB_copytagmethods (void) {
204 lua_pushnumber(lua_copytagmethods(luaL_check_int(1),
208 static void luaB_rawgettable (void) {
209 lua_pushobject(luaL_nonnullarg(1));
210 lua_pushobject(luaL_nonnullarg(2));
211 lua_pushobject(lua_rawgettable());
214 static void luaB_rawsettable (void) {
215 lua_pushobject(luaL_nonnullarg(1));
216 lua_pushobject(luaL_nonnullarg(2));
217 lua_pushobject(luaL_nonnullarg(3));
221 static void luaB_settagmethod (void) {
222 lua_Object nf
= luaL_nonnullarg(3);
224 lua_pushobject(lua_settagmethod(luaL_check_int(1), luaL_check_string(2)));
227 static void luaB_gettagmethod (void) {
228 lua_pushobject(lua_gettagmethod(luaL_check_int(1), luaL_check_string(2)));
231 static void luaB_seterrormethod (void) {
232 lua_Object nf
= luaL_functionarg(1);
234 lua_pushobject(lua_seterrormethod());
237 static void luaB_collectgarbage (void) {
238 lua_pushnumber(lua_collectgarbage(luaL_opt_int(1, 0)));
241 /* }====================================================== */
245 ** {======================================================
246 ** Functions that could use only the official API but
247 ** do not, for efficiency.
248 ** =======================================================
251 static void luaB_dostring (void) {
253 char *s
= luaL_check_lstr(1, &l
);
255 lua_error("`dostring' cannot run pre-compiled code");
256 if (lua_dobuffer(s
, l
, luaL_opt_string(2, s
)) == 0)
257 if (luaA_passresults() == 0)
258 lua_pushuserdata(NULL
); /* at least one result to signal no errors */
262 static void luaB_dofile (void) {
263 char *fname
= luaL_opt_string(1, NULL
);
264 if (lua_dofile(fname
) == 0)
265 if (luaA_passresults() == 0)
266 lua_pushuserdata(NULL
); /* at least one result to signal no errors */
270 static void luaB_call (void) {
271 lua_Object f
= luaL_nonnullarg(1);
272 Hash
*arg
= gethash(2);
273 char *options
= luaL_opt_string(3, "");
274 lua_Object err
= lua_getparam(4);
275 int narg
= (int)getnarg(arg
);
277 if (err
!= LUA_NOOBJECT
) { /* set new error method */
279 err
= lua_seterrormethod();
281 /* push arg[1...n] */
282 luaD_checkstack(narg
);
283 for (i
=0; i
<narg
; i
++)
284 *(L
->stack
.top
++) = *luaH_getint(arg
, i
+1);
285 status
= lua_callfunction(f
);
286 if (err
!= LUA_NOOBJECT
) { /* restore old error method */
288 lua_seterrormethod();
290 if (status
!= 0) { /* error in call? */
291 if (strchr(options
, 'x')) {
293 return; /* return nil to signal the error */
298 else { /* no errors */
299 if (strchr(options
, 'p'))
307 static void luaB_nextvar (void) {
308 TObject
*o
= luaA_Address(luaL_nonnullarg(1));
310 if (ttype(o
) == LUA_T_NIL
)
313 luaL_arg_check(ttype(o
) == LUA_T_STRING
, 1, "variable name expected");
316 if (!luaA_nextvar(g
))
321 static void luaB_next (void) {
322 Hash
*a
= gethash(1);
323 TObject
*k
= luaA_Address(luaL_nonnullarg(2));
324 int i
= (ttype(k
) == LUA_T_NIL
) ? 0 : luaH_pos(a
, k
)+1;
325 if (luaA_next(a
, i
) == 0)
330 static void luaB_tostring (void) {
331 lua_Object obj
= lua_getparam(1);
332 TObject
*o
= luaA_Address(obj
);
336 lua_pushstring(lua_getstring(obj
));
342 sprintf(buff
, "table: %p", (void *)o
->value
.a
);
345 sprintf(buff
, "function: %p", (void *)o
->value
.cl
);
348 sprintf(buff
, "function: %p", (void *)o
->value
.tf
);
351 sprintf(buff
, "function: %p", (void *)o
->value
.f
);
354 sprintf(buff
, "userdata: %p", o
->value
.ts
->u
.d
.v
);
357 lua_pushstring("nil");
360 LUA_INTERNALERROR("invalid type");
362 lua_pushstring(buff
);
366 static void luaB_type (void) {
367 lua_Object o
= luaL_nonnullarg(1);
368 lua_pushstring(luaO_typename(luaA_Address(o
)));
369 lua_pushnumber(lua_tag(o
));
372 /* }====================================================== */
377 ** {======================================================
379 ** These functions can be written in Lua, so you can
380 ** delete them if you need a tiny Lua implementation.
381 ** If you delete them, remove their entries in array
383 ** =======================================================
386 static void luaB_assert (void) {
387 lua_Object p
= lua_getparam(1);
388 if (p
== LUA_NOOBJECT
|| lua_isnil(p
))
389 luaL_verror("assertion failed! %.100s", luaL_opt_string(2, ""));
393 static void luaB_foreachi (void) {
394 Hash
*t
= gethash(1);
396 int n
= (int)getnarg(t
);
398 /* 'f' cannot be a pointer to TObject, because it is on the stack, and the
399 stack may be reallocated by the call. Moreover, some C compilers do not
400 initialize structs, so we must do the assignment after the declaration */
401 f
= *luaA_Address(luaL_functionarg(2));
402 luaD_checkstack(3); /* for f, ref, and val */
403 for (i
=1; i
<=n
; i
++) {
404 *(L
->stack
.top
++) = f
;
405 ttype(L
->stack
.top
) = LUA_T_NUMBER
; nvalue(L
->stack
.top
++) = i
;
406 *(L
->stack
.top
++) = *luaH_getint(t
, i
);
408 if (ttype(L
->stack
.top
-1) != LUA_T_NIL
)
415 static void luaB_foreach (void) {
416 Hash
*a
= gethash(1);
418 TObject f
; /* see comment in 'foreachi' */
419 f
= *luaA_Address(luaL_functionarg(2));
420 luaD_checkstack(3); /* for f, ref, and val */
421 for (i
=0; i
<a
->nhash
; i
++) {
422 Node
*nd
= &(a
->node
[i
]);
423 if (ttype(val(nd
)) != LUA_T_NIL
) {
424 *(L
->stack
.top
++) = f
;
425 *(L
->stack
.top
++) = *ref(nd
);
426 *(L
->stack
.top
++) = *val(nd
);
428 if (ttype(L
->stack
.top
-1) != LUA_T_NIL
)
430 L
->stack
.top
--; /* remove result */
436 static void luaB_foreachvar (void) {
438 TObject f
; /* see comment in 'foreachi' */
439 f
= *luaA_Address(luaL_functionarg(1));
440 luaD_checkstack(4); /* for extra var name, f, var name, and globalval */
441 for (g
= L
->rootglobal
.next
; g
; g
= g
->next
) {
442 TaggedString
*s
= (TaggedString
*)g
;
443 if (s
->u
.s
.globalval
.ttype
!= LUA_T_NIL
) {
444 pushtagstring(s
); /* keep (extra) s on stack to avoid GC */
445 *(L
->stack
.top
++) = f
;
447 *(L
->stack
.top
++) = s
->u
.s
.globalval
;
449 if (ttype(L
->stack
.top
-1) != LUA_T_NIL
) {
451 *(L
->stack
.top
-1) = *L
->stack
.top
; /* remove extra s */
454 L
->stack
.top
-=2; /* remove result and extra s */
460 static void luaB_getn (void) {
461 lua_pushnumber(getnarg(gethash(1)));
465 static void luaB_tinsert (void) {
466 Hash
*a
= gethash(1);
467 lua_Object v
= lua_getparam(3);
468 int n
= (int)getnarg(a
);
470 if (v
!= LUA_NOOBJECT
)
471 pos
= luaL_check_int(2);
472 else { /* called with only 2 arguments */
473 v
= luaL_nonnullarg(2);
476 luaV_setn(a
, n
+1); /* a.n = n+1 */
478 luaH_move(a
, n
, n
+1); /* a[n+1] = a[n] */
479 luaH_setint(a
, pos
, luaA_Address(v
)); /* a[pos] = v */
483 static void luaB_tremove (void) {
484 Hash
*a
= gethash(1);
485 int n
= (int)getnarg(a
);
486 int pos
= luaL_opt_int(2, n
);
487 if (n
<= 0) return; /* table is "empty" */
488 luaA_pushobject(luaH_getint(a
, pos
)); /* result = a[pos] */
490 luaH_move(a
, pos
+1, pos
); /* a[pos] = a[pos+1] */
491 luaV_setn(a
, n
-1); /* a.n = n-1 */
492 luaH_setint(a
, n
, &luaO_nilobject
); /* a[n] = nil */
500 static void swap (Hash
*a
, int i
, int j
) {
502 temp
= *luaH_getint(a
, i
);
504 luaH_setint(a
, j
, &temp
);
507 static int sort_comp (lua_Object f
, TObject
*a
, TObject
*b
) {
508 /* notice: the caller (auxsort) must check stack space */
509 if (f
!= LUA_NOOBJECT
) {
510 *(L
->stack
.top
) = *luaA_Address(f
);
511 *(L
->stack
.top
+1) = *a
;
512 *(L
->stack
.top
+2) = *b
;
517 *(L
->stack
.top
) = *a
;
518 *(L
->stack
.top
+1) = *b
;
520 luaV_comparison(LUA_T_NUMBER
, LUA_T_NIL
, LUA_T_NIL
, IM_LT
);
522 return ttype(--(L
->stack
.top
)) != LUA_T_NIL
;
525 static void auxsort (Hash
*a
, int l
, int u
, lua_Object f
) {
526 while (l
< u
) { /* for tail recursion */
529 /* sort elements a[l], a[(l+u)/2] and a[u] */
530 if (sort_comp(f
, luaH_getint(a
, u
), luaH_getint(a
, l
))) /* a[l]>a[u]? */
532 if (u
-l
== 1) break; /* only 2 elements */
534 P
= luaH_getint(a
, i
);
535 if (sort_comp(f
, P
, luaH_getint(a
, l
))) /* a[l]>a[i]? */
537 else if (sort_comp(f
, luaH_getint(a
, u
), P
)) /* a[i]>a[u]? */
539 if (u
-l
== 2) break; /* only 3 elements */
541 *P
= *luaH_getint(a
, i
); /* save pivot on stack (for GC) */
542 swap(a
, i
, u
-1); /* put median element as pivot (a[u-1]) */
543 /* a[l] <= P == a[u-1] <= a[u], only needs to sort from l+1 to u-2 */
546 /* invariant: a[l..i] <= P <= a[j..u] */
547 while (sort_comp(f
, luaH_getint(a
, ++i
), P
)) /* stop when a[i] >= P */
548 if (i
>u
) lua_error("invalid order function for sorting");
549 while (sort_comp(f
, P
, luaH_getint(a
, --j
))) /* stop when a[j] <= P */
550 if (j
<l
) lua_error("invalid order function for sorting");
554 swap(a
, u
-1, i
); /* swap pivot (a[u-1]) with a[i] */
555 L
->stack
.top
--; /* remove pivot from stack */
556 /* a[l..i-1] <= a[i] == P <= a[i+1..u] */
557 /* adjust so that smaller "half" is in [j..i] and larger one in [l..u] */
564 auxsort(a
, j
, i
, f
); /* call recursively the smaller one */
565 } /* repeat the routine for the larger one */
568 static void luaB_sort (void) {
569 lua_Object t
= lua_getparam(1);
570 Hash
*a
= gethash(1);
571 int n
= (int)getnarg(a
);
572 lua_Object func
= lua_getparam(2);
573 luaL_arg_check(func
== LUA_NOOBJECT
|| lua_isfunction(func
), 2,
574 "function expected");
575 luaD_checkstack(4); /* for Pivot, f, a, b (sort_comp) */
576 auxsort(a
, 1, n
, func
);
580 /* }}===================================================== */
584 ** ====================================================== */
590 ** {======================================================
591 ** some DEBUG functions
592 ** =======================================================
595 static void mem_query (void) {
596 lua_pushnumber(totalmem
);
597 lua_pushnumber(numblocks
);
601 static void query_strings (void) {
602 lua_pushnumber(L
->string_root
[luaL_check_int(1)].nuse
);
606 static void countlist (void) {
607 char *s
= luaL_check_string(1);
608 GCnode
*l
= (s
[0]=='t') ? L
->roottable
.next
: (s
[0]=='c') ? L
->rootcl
.next
:
609 (s
[0]=='p') ? L
->rootproto
.next
: L
->rootglobal
.next
;
619 static void testC (void) {
620 #define getnum(s) ((*s++) - '0')
621 #define getname(s) (nome[0] = *s++, nome)
623 static int locks
[10];
626 char *s
= luaL_check_string(1);
630 case '0': case '1': case '2': case '3': case '4':
631 case '5': case '6': case '7': case '8': case '9':
632 lua_pushnumber(*(s
-1) - '0');
635 case 'c': reg
[getnum(s
)] = lua_createtable(); break;
636 case 'C': { lua_CFunction f
= lua_getcfunction(lua_getglobal(getname(s
)));
637 lua_pushcclosure(f
, getnum(s
));
640 case 'P': reg
[getnum(s
)] = lua_pop(); break;
641 case 'g': { int n
=getnum(s
); reg
[n
]=lua_getglobal(getname(s
)); break; }
642 case 'G': { int n
= getnum(s
);
643 reg
[n
] = lua_rawgetglobal(getname(s
));
646 case 'l': locks
[getnum(s
)] = lua_ref(1); break;
647 case 'L': locks
[getnum(s
)] = lua_ref(0); break;
648 case 'r': { int n
=getnum(s
); reg
[n
]=lua_getref(locks
[getnum(s
)]); break; }
649 case 'u': lua_unref(locks
[getnum(s
)]); break;
650 case 'p': { int n
= getnum(s
); reg
[n
] = lua_getparam(getnum(s
)); break; }
651 case '=': lua_setglobal(getname(s
)); break;
652 case 's': lua_pushstring(getname(s
)); break;
653 case 'o': lua_pushobject(reg
[getnum(s
)]); break;
654 case 'f': lua_call(getname(s
)); break;
655 case 'i': reg
[getnum(s
)] = lua_gettable(); break;
656 case 'I': reg
[getnum(s
)] = lua_rawgettable(); break;
657 case 't': lua_settable(); break;
658 case 'T': lua_rawsettable(); break;
659 case 'N' : lua_pushstring(lua_nextvar(lua_getstring(reg
[getnum(s
)])));
661 case 'n' : { int n
=getnum(s
);
662 n
=lua_next(reg
[n
], (int)lua_getnumber(reg
[getnum(s
)]));
663 lua_pushnumber(n
); break;
665 default: luaL_verror("unknown command in `testC': %c", *(s
-1));
668 if (*s
++ != ' ') lua_error("missing ` ' between commands in `testC'");
672 /* }====================================================== */
677 static struct luaL_reg builtin_funcs
[] = {
679 {"setfallback", luaT_setfallback
},
683 {"totalmem", mem_query
},
684 {"count", countlist
},
685 {"querystr", query_strings
},
687 {"_ALERT", luaB_alert
},
688 {"_ERRORMESSAGE", error_message
},
690 {"collectgarbage", luaB_collectgarbage
},
691 {"copytagmethods", luaB_copytagmethods
},
692 {"dofile", luaB_dofile
},
693 {"dostring", luaB_dostring
},
694 {"error", luaB_error
},
695 {"getglobal", luaB_getglobal
},
696 {"gettagmethod", luaB_gettagmethod
},
697 {"newtag", luaB_newtag
},
699 {"nextvar", luaB_nextvar
},
700 {"print", luaB_print
},
701 {"rawgetglobal", luaB_rawgetglobal
},
702 {"rawgettable", luaB_rawgettable
},
703 {"rawsetglobal", luaB_rawsetglobal
},
704 {"rawsettable", luaB_rawsettable
},
705 {"seterrormethod", luaB_seterrormethod
},
706 {"setglobal", luaB_setglobal
},
707 {"settag", luaB_settag
},
708 {"settagmethod", luaB_settagmethod
},
709 {"tag", luaB_luatag
},
710 {"tonumber", luaB_tonumber
},
711 {"tostring", luaB_tostring
},
713 /* "Extra" functions */
714 {"assert", luaB_assert
},
715 {"foreach", luaB_foreach
},
716 {"foreachi", luaB_foreachi
},
717 {"foreachvar", luaB_foreachvar
},
720 {"tinsert", luaB_tinsert
},
721 {"tremove", luaB_tremove
}
725 #define INTFUNCSIZE (sizeof(builtin_funcs)/sizeof(builtin_funcs[0]))
728 void luaB_predefine (void) {
729 /* pre-register mem error messages, to avoid loop when error arises */
730 luaS_newfixedstring(tableEM
);
731 luaS_newfixedstring(memEM
);
732 luaL_openlib(builtin_funcs
, (sizeof(builtin_funcs
)/sizeof(builtin_funcs
[0])));
733 lua_pushstring(LUA_VERSION
);
734 lua_setglobal("_VERSION");