lbuiltin.c 23 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816
  1. /*
  2. ** $Id: lbuiltin.c,v 1.77 1999/11/29 19:11:36 roberto Exp roberto $
  3. ** Built-in functions
  4. ** See Copyright Notice in lua.h
  5. */
  6. #include <ctype.h>
  7. #include <stdio.h>
  8. #include <stdlib.h>
  9. #include <string.h>
  10. #define LUA_REENTRANT
  11. #include "lapi.h"
  12. #include "lauxlib.h"
  13. #include "lbuiltin.h"
  14. #include "ldo.h"
  15. #include "lfunc.h"
  16. #include "lmem.h"
  17. #include "lobject.h"
  18. #include "lstate.h"
  19. #include "lstring.h"
  20. #include "ltable.h"
  21. #include "ltm.h"
  22. #include "lua.h"
  23. #include "lundump.h"
  24. #include "lvm.h"
  25. /*
  26. ** {======================================================
  27. ** Auxiliary functions
  28. ** =======================================================
  29. */
  30. static void pushtagstring (lua_State *L, TaggedString *s) {
  31. ttype(L->stack.top) = LUA_T_STRING;
  32. tsvalue(L->stack.top) = s;
  33. incr_top;
  34. }
  35. static real getsize (const Hash *h) {
  36. real max = 0;
  37. int i = h->size;
  38. Node *n = h->node;
  39. while (i--) {
  40. if (ttype(key(n)) == LUA_T_NUMBER &&
  41. ttype(val(n)) != LUA_T_NIL &&
  42. nvalue(key(n)) > max)
  43. max = nvalue(key(n));
  44. n++;
  45. }
  46. return max;
  47. }
  48. static real getnarg (lua_State *L, const Hash *a) {
  49. TObject index;
  50. const TObject *value;
  51. /* value = table.n */
  52. ttype(&index) = LUA_T_STRING;
  53. tsvalue(&index) = luaS_new(L, "n");
  54. value = luaH_get(L, a, &index);
  55. return (ttype(value) == LUA_T_NUMBER) ? nvalue(value) : getsize(a);
  56. }
  57. static Hash *gettable (lua_State *L, int arg) {
  58. return avalue(luaA_Address(L, luaL_tablearg(L, arg)));
  59. }
  60. /* }====================================================== */
  61. /*
  62. ** {======================================================
  63. ** Functions that use only the official API
  64. ** =======================================================
  65. */
  66. /*
  67. ** If your system does not support "stderr", redefine this function, or
  68. ** redefine _ERRORMESSAGE so that it won't need _ALERT.
  69. */
  70. static void luaB_alert (lua_State *L) {
  71. fputs(luaL_check_string(L, 1), stderr);
  72. }
  73. /*
  74. ** Standard implementation of _ERRORMESSAGE.
  75. ** The library "iolib" redefines _ERRORMESSAGE for better error information.
  76. */
  77. static void error_message (lua_State *L) {
  78. lua_Object al = lua_rawgetglobal(L, "_ALERT");
  79. if (lua_isfunction(L, al)) { /* avoid error loop if _ALERT is not defined */
  80. char buff[600];
  81. sprintf(buff, "lua error: %.500s\n", luaL_check_string(L, 1));
  82. lua_pushstring(L, buff);
  83. lua_callfunction(L, al);
  84. }
  85. }
  86. /*
  87. ** If your system does not support "stdout", you can just remove this function.
  88. ** If you need, you can define your own "print" function, following this
  89. ** model but changing "fputs" to put the strings at a proper place
  90. ** (a console window or a log file, for instance).
  91. */
  92. #ifndef MAXPRINT
  93. #define MAXPRINT 40 /* arbitrary limit */
  94. #endif
  95. static void luaB_print (lua_State *L) {
  96. lua_Object args[MAXPRINT];
  97. lua_Object obj;
  98. int n = 0;
  99. int i;
  100. while ((obj = lua_getparam(L, n+1)) != LUA_NOOBJECT) {
  101. luaL_arg_check(L, n < MAXPRINT, n+1, "too many arguments");
  102. args[n++] = obj;
  103. }
  104. for (i=0; i<n; i++) {
  105. lua_pushobject(L, args[i]);
  106. if (lua_call(L, "tostring"))
  107. lua_error(L, "error in `tostring' called by `print'");
  108. obj = lua_getresult(L, 1);
  109. if (!lua_isstring(L, obj))
  110. lua_error(L, "`tostring' must return a string to `print'");
  111. if (i>0) fputs("\t", stdout);
  112. fputs(lua_getstring(L, obj), stdout);
  113. }
  114. fputs("\n", stdout);
  115. }
  116. static void luaB_tonumber (lua_State *L) {
  117. int base = luaL_opt_int(L, 2, 10);
  118. if (base == 10) { /* standard conversion */
  119. lua_Object o = lua_getparam(L, 1);
  120. if (lua_isnumber(L, o)) lua_pushnumber(L, lua_getnumber(L, o));
  121. else lua_pushnil(L); /* not a number */
  122. }
  123. else {
  124. const char *s1 = luaL_check_string(L, 1);
  125. char *s2;
  126. real n;
  127. luaL_arg_check(L, 0 <= base && base <= 36, 2, "base out of range");
  128. n = strtoul(s1, &s2, base);
  129. if (s1 == s2) return; /* no valid digits: return nil */
  130. while (isspace((unsigned char)*s2)) s2++; /* skip trailing spaces */
  131. if (*s2) return; /* invalid trailing character: return nil */
  132. lua_pushnumber(L, n);
  133. }
  134. }
  135. static void luaB_error (lua_State *L) {
  136. lua_error(L, lua_getstring(L, lua_getparam(L, 1)));
  137. }
  138. static void luaB_setglobal (lua_State *L) {
  139. const char *n = luaL_check_string(L, 1);
  140. lua_Object value = luaL_nonnullarg(L, 2);
  141. lua_pushobject(L, value);
  142. lua_setglobal(L, n);
  143. }
  144. static void luaB_rawsetglobal (lua_State *L) {
  145. const char *n = luaL_check_string(L, 1);
  146. lua_Object value = luaL_nonnullarg(L, 2);
  147. lua_pushobject(L, value);
  148. lua_rawsetglobal(L, n);
  149. }
  150. static void luaB_getglobal (lua_State *L) {
  151. lua_pushobject(L, lua_getglobal(L, luaL_check_string(L, 1)));
  152. }
  153. static void luaB_rawgetglobal (lua_State *L) {
  154. lua_pushobject(L, lua_rawgetglobal(L, luaL_check_string(L, 1)));
  155. }
  156. static void luaB_tag (lua_State *L) {
  157. lua_pushnumber(L, lua_tag(L, lua_getparam(L, 1)));
  158. }
  159. static void luaB_settag (lua_State *L) {
  160. lua_Object o = luaL_tablearg(L, 1);
  161. lua_pushobject(L, o);
  162. lua_settag(L, luaL_check_int(L, 2));
  163. lua_pushobject(L, o); /* return first argument */
  164. }
  165. static void luaB_newtag (lua_State *L) {
  166. lua_pushnumber(L, lua_newtag(L));
  167. }
  168. static void luaB_copytagmethods (lua_State *L) {
  169. lua_pushnumber(L, lua_copytagmethods(L, luaL_check_int(L, 1),
  170. luaL_check_int(L, 2)));
  171. }
  172. static void luaB_rawgettable (lua_State *L) {
  173. lua_pushobject(L, luaL_nonnullarg(L, 1));
  174. lua_pushobject(L, luaL_nonnullarg(L, 2));
  175. lua_pushobject(L, lua_rawgettable(L));
  176. }
  177. static void luaB_rawsettable (lua_State *L) {
  178. lua_pushobject(L, luaL_nonnullarg(L, 1));
  179. lua_pushobject(L, luaL_nonnullarg(L, 2));
  180. lua_pushobject(L, luaL_nonnullarg(L, 3));
  181. lua_rawsettable(L);
  182. }
  183. static void luaB_settagmethod (lua_State *L) {
  184. int tag = luaL_check_int(L, 1);
  185. const char *event = luaL_check_string(L, 2);
  186. lua_Object nf = luaL_nonnullarg(L, 3);
  187. #ifndef LUA_COMPAT_GC
  188. if (strcmp(event, "gc") == 0 && tag != LUA_T_NIL)
  189. lua_error(L, "cannot set this tag method from Lua");
  190. #endif
  191. lua_pushobject(L, nf);
  192. lua_pushobject(L, lua_settagmethod(L, tag, event));
  193. }
  194. static void luaB_gettagmethod (lua_State *L) {
  195. lua_pushobject(L, lua_gettagmethod(L, luaL_check_int(L, 1),
  196. luaL_check_string(L, 2)));
  197. }
  198. static void luaB_seterrormethod (lua_State *L) {
  199. lua_Object nf = luaL_functionarg(L, 1);
  200. lua_pushobject(L, nf);
  201. lua_pushobject(L, lua_seterrormethod(L));
  202. }
  203. static void luaB_collectgarbage (lua_State *L) {
  204. lua_pushnumber(L, lua_collectgarbage(L, luaL_opt_int(L, 1, 0)));
  205. }
  206. static void luaB_type (lua_State *L) {
  207. lua_Object o = luaL_nonnullarg(L, 1);
  208. lua_pushstring(L, lua_type(L, o));
  209. }
  210. /* }====================================================== */
  211. /*
  212. ** {======================================================
  213. ** Functions that could use only the official API but
  214. ** do not, for efficiency.
  215. ** =======================================================
  216. */
  217. static void passresults (lua_State *L) {
  218. L->Cstack.base = L->Cstack.lua2C; /* position of first result */
  219. if (L->Cstack.num == 0)
  220. lua_pushuserdata(L, NULL); /* at least one result to signal no errors */
  221. }
  222. static void luaB_dostring (lua_State *L) {
  223. long l;
  224. const char *s = luaL_check_lstr(L, 1, &l);
  225. if (*s == ID_CHUNK)
  226. lua_error(L, "`dostring' cannot run pre-compiled code");
  227. if (lua_dobuffer(L, s, l, luaL_opt_string(L, 2, s)) == 0)
  228. passresults(L);
  229. /* else return no value */
  230. }
  231. static void luaB_dofile (lua_State *L) {
  232. const char *fname = luaL_opt_string(L, 1, NULL);
  233. if (lua_dofile(L, fname) == 0)
  234. passresults(L);
  235. /* else return no value */
  236. }
  237. static void luaB_call (lua_State *L) {
  238. lua_Object f = luaL_nonnullarg(L, 1);
  239. const Hash *arg = gettable(L, 2);
  240. const char *options = luaL_opt_string(L, 3, "");
  241. lua_Object err = lua_getparam(L, 4);
  242. int narg = (int)getnarg(L, arg);
  243. int i, status;
  244. if (err != LUA_NOOBJECT) { /* set new error method */
  245. lua_pushobject(L, err);
  246. err = lua_seterrormethod(L);
  247. }
  248. /* push arg[1...n] */
  249. luaD_checkstack(L, narg);
  250. for (i=0; i<narg; i++)
  251. *(L->stack.top++) = *luaH_getint(L, arg, i+1);
  252. status = lua_callfunction(L, f);
  253. if (err != LUA_NOOBJECT) { /* restore old error method */
  254. lua_pushobject(L, err);
  255. lua_seterrormethod(L);
  256. }
  257. if (status != 0) { /* error in call? */
  258. if (strchr(options, 'x')) {
  259. lua_pushnil(L);
  260. return; /* return nil to signal the error */
  261. }
  262. else
  263. lua_error(L, NULL);
  264. }
  265. else { /* no errors */
  266. if (strchr(options, 'p')) { /* pack results? */
  267. luaV_pack(L, L->Cstack.lua2C, L->Cstack.num, L->stack.top);
  268. incr_top;
  269. }
  270. else
  271. L->Cstack.base = L->Cstack.lua2C; /* position of first result */
  272. }
  273. }
  274. static void luaB_nextvar (lua_State *L) {
  275. const TObject *o = luaA_Address(L, luaL_nonnullarg(L, 1));
  276. TaggedString *g;
  277. if (ttype(o) == LUA_T_NIL)
  278. g = NULL;
  279. else {
  280. luaL_arg_check(L, ttype(o) == LUA_T_STRING, 1, "variable name expected");
  281. g = tsvalue(o);
  282. }
  283. if (!luaA_nextvar(L, g))
  284. lua_pushnil(L);
  285. }
  286. static void luaB_next (lua_State *L) {
  287. const Hash *a = gettable(L, 1);
  288. const TObject *k = luaA_Address(L, luaL_nonnullarg(L, 2));
  289. int i; /* will get first element after `i' */
  290. if (ttype(k) == LUA_T_NIL)
  291. i = 0; /* get first */
  292. else {
  293. i = luaH_pos(L, a, k)+1;
  294. luaL_arg_check(L, i != 0, 2, "key not found");
  295. }
  296. if (luaA_next(L, a, i) == 0)
  297. lua_pushnil(L);
  298. }
  299. static void luaB_tostring (lua_State *L) {
  300. lua_Object obj = lua_getparam(L, 1);
  301. const TObject *o = luaA_Address(L, obj);
  302. char buff[64];
  303. switch (ttype(o)) {
  304. case LUA_T_NUMBER:
  305. lua_pushstring(L, lua_getstring(L, obj));
  306. return;
  307. case LUA_T_STRING:
  308. lua_pushobject(L, obj);
  309. return;
  310. case LUA_T_ARRAY:
  311. sprintf(buff, "table: %p", o->value.a);
  312. break;
  313. case LUA_T_CLOSURE:
  314. sprintf(buff, "function: %p", o->value.cl);
  315. break;
  316. case LUA_T_PROTO:
  317. sprintf(buff, "function: %p", o->value.tf);
  318. break;
  319. case LUA_T_CPROTO:
  320. sprintf(buff, "function: %p", o->value.f);
  321. break;
  322. case LUA_T_USERDATA:
  323. sprintf(buff, "userdata: %p", o->value.ts->u.d.value);
  324. break;
  325. case LUA_T_NIL:
  326. lua_pushstring(L, "nil");
  327. return;
  328. default:
  329. LUA_INTERNALERROR(L, "invalid type");
  330. }
  331. lua_pushstring(L, buff);
  332. }
  333. /* }====================================================== */
  334. /*
  335. ** {======================================================
  336. ** "Extra" functions
  337. ** These functions can be written in Lua, so you can
  338. ** delete them if you need a tiny Lua implementation.
  339. ** If you delete them, remove their entries in array
  340. ** "builtin_funcs".
  341. ** =======================================================
  342. */
  343. static void luaB_assert (lua_State *L) {
  344. lua_Object p = lua_getparam(L, 1);
  345. if (p == LUA_NOOBJECT || lua_isnil(L, p))
  346. luaL_verror(L, "assertion failed! %.90s", luaL_opt_string(L, 2, ""));
  347. }
  348. static void luaB_foreachi (lua_State *L) {
  349. struct Stack *S = &L->stack;
  350. const Hash *t = gettable(L, 1);
  351. int n = (int)getnarg(L, t);
  352. int i;
  353. StkId f = luaA_Address(L, luaL_functionarg(L, 2)) - S->stack;
  354. /* 'f' cannot be a pointer to TObject, because it is on the stack, and the
  355. stack may be reallocated by the call. */
  356. luaD_checkstack(L, 3); /* for f, key, and val */
  357. for (i=1; i<=n; i++) {
  358. *(S->top++) = *(S->stack+f);
  359. ttype(S->top) = LUA_T_NUMBER; nvalue(S->top++) = i;
  360. *(S->top++) = *luaH_getint(L, t, i);
  361. luaD_call(L, S->top-3, 1);
  362. if (ttype(S->top-1) != LUA_T_NIL)
  363. return;
  364. S->top--;
  365. }
  366. }
  367. static void luaB_foreach (lua_State *L) {
  368. struct Stack *S = &L->stack;
  369. const Hash *a = gettable(L, 1);
  370. StkId f = luaA_Address(L, luaL_functionarg(L, 2)) - S->stack;
  371. int i;
  372. luaD_checkstack(L, 3); /* for f, key, and val */
  373. for (i=0; i<a->size; i++) {
  374. const Node *nd = &(a->node[i]);
  375. if (ttype(val(nd)) != LUA_T_NIL) {
  376. *(S->top++) = *(S->stack+f);
  377. *(S->top++) = *key(nd);
  378. *(S->top++) = *val(nd);
  379. luaD_call(L, S->top-3, 1);
  380. if (ttype(S->top-1) != LUA_T_NIL)
  381. return;
  382. S->top--; /* remove result */
  383. }
  384. }
  385. }
  386. static void luaB_foreachvar (lua_State *L) {
  387. struct Stack *S = &L->stack;
  388. StkId f = luaA_Address(L, luaL_functionarg(L, 1)) - S->stack;
  389. GlobalVar *gv;
  390. luaD_checkstack(L, 4); /* for extra var name, f, var name, and globalval */
  391. for (gv = L->rootglobal; gv; gv = gv->next) {
  392. if (gv->value.ttype != LUA_T_NIL) {
  393. pushtagstring(L, gv->name); /* keep (extra) name on stack to avoid GC */
  394. *(S->top++) = *(S->stack+f);
  395. pushtagstring(L, gv->name);
  396. *(S->top++) = gv->value;
  397. luaD_call(L, S->top-3, 1);
  398. if (ttype(S->top-1) != LUA_T_NIL) {
  399. S->top--;
  400. *(S->top-1) = *S->top; /* remove extra name */
  401. return;
  402. }
  403. S->top-=2; /* remove result and extra name */
  404. }
  405. }
  406. }
  407. static void luaB_getn (lua_State *L) {
  408. lua_pushnumber(L, getnarg(L, gettable(L, 1)));
  409. }
  410. static void luaB_tinsert (lua_State *L) {
  411. Hash *a = gettable(L, 1);
  412. lua_Object v = lua_getparam(L, 3);
  413. int n = (int)getnarg(L, a);
  414. int pos;
  415. if (v != LUA_NOOBJECT)
  416. pos = luaL_check_int(L, 2);
  417. else { /* called with only 2 arguments */
  418. v = luaL_nonnullarg(L, 2);
  419. pos = n+1;
  420. }
  421. luaV_setn(L, a, n+1); /* a.n = n+1 */
  422. for ( ;n>=pos; n--)
  423. luaH_move(L, a, n, n+1); /* a[n+1] = a[n] */
  424. luaH_setint(L, a, pos, luaA_Address(L, v)); /* a[pos] = v */
  425. }
  426. static void luaB_tremove (lua_State *L) {
  427. Hash *a = gettable(L, 1);
  428. int n = (int)getnarg(L, a);
  429. int pos = luaL_opt_int(L, 2, n);
  430. if (n <= 0) return; /* table is "empty" */
  431. luaA_pushobject(L, luaH_getint(L, a, pos)); /* result = a[pos] */
  432. for ( ;pos<n; pos++)
  433. luaH_move(L, a, pos+1, pos); /* a[pos] = a[pos+1] */
  434. luaV_setn(L, a, n-1); /* a.n = n-1 */
  435. luaH_setint(L, a, n, &luaO_nilobject); /* a[n] = nil */
  436. }
  437. /*
  438. ** {======================================================
  439. ** Quicksort
  440. */
  441. static void swap (lua_State *L, Hash *a, int i, int j) {
  442. TObject temp;
  443. temp = *luaH_getint(L, a, i);
  444. luaH_move(L, a, j, i);
  445. luaH_setint(L, a, j, &temp);
  446. }
  447. static int sort_comp (lua_State *L, lua_Object f, const TObject *a,
  448. const TObject *b) {
  449. /* notice: the caller (auxsort) must check stack space */
  450. if (f != LUA_NOOBJECT) {
  451. *(L->stack.top) = *luaA_Address(L, f);
  452. *(L->stack.top+1) = *a;
  453. *(L->stack.top+2) = *b;
  454. L->stack.top += 3;
  455. luaD_call(L, L->stack.top-3, 1);
  456. }
  457. else { /* a < b? */
  458. *(L->stack.top) = *a;
  459. *(L->stack.top+1) = *b;
  460. L->stack.top += 2;
  461. luaV_comparison(L, LUA_T_NUMBER, LUA_T_NIL, LUA_T_NIL, IM_LT);
  462. }
  463. return ttype(--(L->stack.top)) != LUA_T_NIL;
  464. }
  465. static void auxsort (lua_State *L, Hash *a, int l, int u, lua_Object f) {
  466. struct Stack *S = &L->stack;
  467. StkId P = S->top - S->stack; /* temporary place for pivot */
  468. S->top++;
  469. ttype(S->stack+P) = LUA_T_NIL;
  470. while (l < u) { /* for tail recursion */
  471. int i, j;
  472. /* sort elements a[l], a[(l+u)/2] and a[u] */
  473. if (sort_comp(L, f, luaH_getint(L, a, u), luaH_getint(L, a, l)))
  474. swap(L, a, l, u); /* a[u]<a[l] */
  475. if (u-l == 1) break; /* only 2 elements */
  476. i = (l+u)/2;
  477. *(S->stack+P) = *luaH_getint(L, a, i); /* P = a[i] */
  478. if (sort_comp(L, f, S->stack+P, luaH_getint(L, a, l))) /* a[i]<a[l]? */
  479. swap(L, a, l, i);
  480. else if (sort_comp(L, f, luaH_getint(L, a, u), S->stack+P)) /* a[u]<a[i]? */
  481. swap(L, a, i, u);
  482. if (u-l == 2) break; /* only 3 elements */
  483. *(S->stack+P) = *luaH_getint(L, a, i); /* save pivot on stack (GC) */
  484. swap(L, a, i, u-1); /* put median element as pivot (a[u-1]) */
  485. /* a[l] <= P == a[u-1] <= a[u], only needs to sort from l+1 to u-2 */
  486. i = l; j = u-1;
  487. for (;;) { /* invariant: a[l..i] <= P <= a[j..u] */
  488. /* repeat i++ until a[i] >= P */
  489. while (sort_comp(L, f, luaH_getint(L, a, ++i), S->stack+P))
  490. if (i>u) lua_error(L, "invalid order function for sorting");
  491. /* repeat j-- until a[j] <= P */
  492. while (sort_comp(L, f, (S->stack+P), luaH_getint(L, a, --j)))
  493. if (j<l) lua_error(L, "invalid order function for sorting");
  494. if (j<i) break;
  495. swap(L, a, i, j);
  496. }
  497. swap(L, a, u-1, i); /* swap pivot (a[u-1]) with a[i] */
  498. /* a[l..i-1] <= a[i] == P <= a[i+1..u] */
  499. /* adjust so that smaller "half" is in [j..i] and larger one in [l..u] */
  500. if (i-l < u-i) {
  501. j=l; i=i-1; l=i+2;
  502. }
  503. else {
  504. j=i+1; i=u; u=j-2;
  505. }
  506. auxsort(L, a, j, i, f); /* call recursively the smaller one */
  507. } /* repeat the routine for the larger one */
  508. S->top--; /* remove pivot from stack */
  509. }
  510. static void luaB_sort (lua_State *L) {
  511. lua_Object t = lua_getparam(L, 1);
  512. Hash *a = gettable(L, 1);
  513. int n = (int)getnarg(L, a);
  514. lua_Object func = lua_getparam(L, 2);
  515. luaL_arg_check(L, func == LUA_NOOBJECT || lua_isfunction(L, func), 2,
  516. "function expected");
  517. luaD_checkstack(L, 4); /* for Pivot, f, a, b (sort_comp) */
  518. auxsort(L, a, 1, n, func);
  519. lua_pushobject(L, t);
  520. }
  521. /* }====================================================== */
  522. /* }====================================================== */
  523. #ifdef DEBUG
  524. /*
  525. ** {======================================================
  526. ** some DEBUG functions
  527. ** (for internal debugging of the Lua implementation)
  528. ** =======================================================
  529. */
  530. static void mem_query (lua_State *L) {
  531. lua_pushnumber(L, totalmem);
  532. lua_pushnumber(L, numblocks);
  533. }
  534. static void hash_query (lua_State *L) {
  535. const TObject *o = luaA_Address(L, luaL_nonnullarg(L, 1));
  536. if (lua_getparam(L, 2) == LUA_NOOBJECT) {
  537. luaL_arg_check(L, ttype(o) == LUA_T_STRING, 1, "string expected");
  538. lua_pushnumber(L, tsvalue(o)->hash);
  539. }
  540. else {
  541. const Hash *t = avalue(luaA_Address(L, luaL_tablearg(L, 2)));
  542. lua_pushnumber(L, luaH_mainposition(L, t, o) - t->node);
  543. }
  544. }
  545. static void table_query (lua_State *L) {
  546. const Hash *t = avalue(luaA_Address(L, luaL_tablearg(L, 1)));
  547. int i = luaL_opt_int(L, 2, -1);
  548. if (i == -1) {
  549. lua_pushnumber(L, t->size);
  550. lua_pushnumber(L, t->firstfree - t->node);
  551. }
  552. else if (i < t->size) {
  553. luaA_pushobject(L, &t->node[i].key);
  554. luaA_pushobject(L, &t->node[i].val);
  555. if (t->node[i].next)
  556. lua_pushnumber(L, t->node[i].next - t->node);
  557. }
  558. }
  559. static void query_strings (lua_State *L) {
  560. int h = luaL_check_int(L, 1) - 1;
  561. int s = luaL_opt_int(L, 2, 0) - 1;
  562. if (s==-1) {
  563. if (h < NUM_HASHS) {
  564. lua_pushnumber(L, L->string_root[h].nuse);
  565. lua_pushnumber(L, L->string_root[h].size);
  566. }
  567. }
  568. else {
  569. TaggedString *ts = L->string_root[h].hash[s];
  570. for (ts = L->string_root[h].hash[s]; ts; ts = ts->nexthash) {
  571. if (ts->constindex == -1) lua_pushstring(L, "<USERDATA>");
  572. else lua_pushstring(L, ts->str);
  573. }
  574. }
  575. }
  576. static void extra_services (lua_State *L) {
  577. const char *service = luaL_check_string(L, 1);
  578. switch (*service) {
  579. case 'U': /* create a userdata with a given value/tag */
  580. lua_pushusertag(L, (void *)luaL_check_int(L, 2), luaL_check_int(L, 3));
  581. break;
  582. case 'u': /* return the value of a userdata */
  583. lua_pushnumber(L, (int)lua_getuserdata(L, lua_getparam(L, 2)));
  584. break;
  585. case 't': /* set `gc' tag method */
  586. lua_pushobject(L, lua_getparam(L, 3));
  587. lua_settagmethod(L, luaL_check_int(L, 2), "gc");
  588. break;
  589. default: luaL_argerror(L, 1, "invalid service");
  590. }
  591. }
  592. static void testC (lua_State *L) {
  593. #define getnum(L, s) ((*s++) - '0')
  594. #define getname(L, s) (nome[0] = *s++, nome)
  595. lua_Object reg[10];
  596. char nome[2];
  597. const char *s = luaL_check_string(L, 1);
  598. nome[1] = 0;
  599. for (;;) {
  600. switch (*s++) {
  601. case '0': case '1': case '2': case '3': case '4':
  602. case '5': case '6': case '7': case '8': case '9':
  603. lua_pushnumber(L, *(s-1) - '0');
  604. break;
  605. case 'c': reg[getnum(L, s)] = lua_createtable(L); break;
  606. case 'C': { lua_CFunction f = lua_getcfunction(L, lua_getglobal(L, getname(L, s)));
  607. lua_pushcclosure(L, f, getnum(L, s));
  608. break;
  609. }
  610. case 'P': reg[getnum(L, s)] = lua_pop(L); break;
  611. case 'g': { int n=getnum(L, s); reg[n]=lua_getglobal(L, getname(L, s)); break; }
  612. case 'G': { int n = getnum(L, s);
  613. reg[n] = lua_rawgetglobal(L, getname(L, s));
  614. break;
  615. }
  616. case 'l': lua_pushnumber(L, lua_ref(L, 1)); reg[getnum(L, s)] = lua_pop(L); break;
  617. case 'L': lua_pushnumber(L, lua_ref(L, 0)); reg[getnum(L, s)] = lua_pop(L); break;
  618. case 'r': { int n=getnum(L, s);
  619. reg[n]=lua_getref(L, (int)lua_getnumber(L, reg[getnum(L, s)]));
  620. break;
  621. }
  622. case 'u': lua_unref(L, (int)lua_getnumber(L, reg[getnum(L, s)]));
  623. break;
  624. case 'p': { int n = getnum(L, s); reg[n] = lua_getparam(L, getnum(L, s)); break; }
  625. case '=': lua_setglobal(L, getname(L, s)); break;
  626. case 's': lua_pushstring(L, getname(L, s)); break;
  627. case 'o': lua_pushobject(L, reg[getnum(L, s)]); break;
  628. case 'f': lua_call(L, getname(L, s)); break;
  629. case 'i': reg[getnum(L, s)] = lua_gettable(L); break;
  630. case 'I': reg[getnum(L, s)] = lua_rawgettable(L); break;
  631. case 't': lua_settable(L); break;
  632. case 'T': lua_rawsettable(L); break;
  633. case 'N' : lua_pushstring(L, lua_nextvar(L, lua_getstring(L, reg[getnum(L, s)])));
  634. break;
  635. case 'n' : { int n=getnum(L, s);
  636. n=lua_next(L, reg[n], (int)lua_getnumber(L, reg[getnum(L, s)]));
  637. lua_pushnumber(L, n); break;
  638. }
  639. case 'q' : { int n1=getnum(L, s); int n2=getnum(L, s);
  640. lua_pushnumber(L, lua_equal(L, reg[n1], reg[n2]));
  641. break;
  642. }
  643. default: luaL_verror(L, "unknown command in `testC': %c", *(s-1));
  644. }
  645. if (*s == 0) return;
  646. if (*s++ != ' ') lua_error(L, "missing ` ' between commands in `testC'");
  647. }
  648. }
  649. /* }====================================================== */
  650. #endif
  651. static const struct luaL_reg builtin_funcs[] = {
  652. #ifdef DEBUG
  653. {"extra", extra_services},
  654. {"hash", hash_query},
  655. {"querystr", query_strings},
  656. {"querytab", table_query},
  657. {"testC", testC},
  658. {"totalmem", mem_query},
  659. #endif
  660. {"_ALERT", luaB_alert},
  661. {"_ERRORMESSAGE", error_message},
  662. {"call", luaB_call},
  663. {"collectgarbage", luaB_collectgarbage},
  664. {"copytagmethods", luaB_copytagmethods},
  665. {"dofile", luaB_dofile},
  666. {"dostring", luaB_dostring},
  667. {"error", luaB_error},
  668. {"getglobal", luaB_getglobal},
  669. {"gettagmethod", luaB_gettagmethod},
  670. {"newtag", luaB_newtag},
  671. {"next", luaB_next},
  672. {"nextvar", luaB_nextvar},
  673. {"print", luaB_print},
  674. {"rawgetglobal", luaB_rawgetglobal},
  675. {"rawgettable", luaB_rawgettable},
  676. {"rawsetglobal", luaB_rawsetglobal},
  677. {"rawsettable", luaB_rawsettable},
  678. {"seterrormethod", luaB_seterrormethod},
  679. {"setglobal", luaB_setglobal},
  680. {"settag", luaB_settag},
  681. {"settagmethod", luaB_settagmethod},
  682. {"tag", luaB_tag},
  683. {"tonumber", luaB_tonumber},
  684. {"tostring", luaB_tostring},
  685. {"type", luaB_type},
  686. /* "Extra" functions */
  687. {"assert", luaB_assert},
  688. {"foreach", luaB_foreach},
  689. {"foreachi", luaB_foreachi},
  690. {"foreachvar", luaB_foreachvar},
  691. {"getn", luaB_getn},
  692. {"sort", luaB_sort},
  693. {"tinsert", luaB_tinsert},
  694. {"tremove", luaB_tremove}
  695. };
  696. void luaB_predefine (lua_State *L) {
  697. /* pre-register mem error messages, to avoid loop when error arises */
  698. luaS_newfixedstring(L, tableEM);
  699. luaS_newfixedstring(L, memEM);
  700. luaL_openl(L, builtin_funcs);
  701. lua_pushstring(L, LUA_VERSION);
  702. lua_setglobal(L, "_VERSION");
  703. }