lbuiltin.c 24 KB

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