- initial import of revision 374 from cnc
[apt.git] / lua / lib / lauxlib.c
1 /*
2 ** $Id: lauxlib.c,v 1.100 2003/04/07 14:35:00 roberto Exp $
3 ** Auxiliary functions for building Lua libraries
4 ** See Copyright Notice in lua.h
5 */
6
7
8 #include <ctype.h>
9 #include <errno.h>
10 #include <stdarg.h>
11 #include <stdio.h>
12 #include <string.h>
13
14
15 /* This file uses only the official API of Lua.
16 ** Any function declared here could be written as an application function.
17 */
18
19 #define lauxlib_c
20
21 #include "lua.h"
22
23 #include "lauxlib.h"
24
25
26 /* number of prereserved references (for internal use) */
27 #define RESERVED_REFS   2
28
29 /* reserved references */
30 #define FREELIST_REF    1       /* free list of references */
31 #define ARRAYSIZE_REF   2       /* array sizes */
32
33
34 /* convert a stack index to positive */
35 #define abs_index(L, i)         ((i) > 0 || (i) <= LUA_REGISTRYINDEX ? (i) : \
36                                         lua_gettop(L) + (i) + 1)
37
38
39 /*
40 ** {======================================================
41 ** Error-report functions
42 ** =======================================================
43 */
44
45
46 LUALIB_API int luaL_argerror (lua_State *L, int narg, const char *extramsg) {
47   lua_Debug ar;
48   lua_getstack(L, 0, &ar);
49   lua_getinfo(L, "n", &ar);
50   if (strcmp(ar.namewhat, "method") == 0) {
51     narg--;  /* do not count `self' */
52     if (narg == 0)  /* error is in the self argument itself? */
53       return luaL_error(L, "calling `%s' on bad self (%s)", ar.name, extramsg);
54   }
55   if (ar.name == NULL)
56     ar.name = "?";
57   return luaL_error(L, "bad argument #%d to `%s' (%s)",
58                         narg, ar.name, extramsg);
59 }
60
61
62 LUALIB_API int luaL_typerror (lua_State *L, int narg, const char *tname) {
63   const char *msg = lua_pushfstring(L, "%s expected, got %s",
64                                     tname, lua_typename(L, lua_type(L,narg)));
65   return luaL_argerror(L, narg, msg);
66 }
67
68
69 static void tag_error (lua_State *L, int narg, int tag) {
70   luaL_typerror(L, narg, lua_typename(L, tag)); 
71 }
72
73
74 LUALIB_API void luaL_where (lua_State *L, int level) {
75   lua_Debug ar;
76   if (lua_getstack(L, level, &ar)) {  /* check function at level */
77     lua_getinfo(L, "Snl", &ar);  /* get info about it */
78     if (ar.currentline > 0) {  /* is there info? */
79       lua_pushfstring(L, "%s:%d: ", ar.short_src, ar.currentline);
80       return;
81     }
82   }
83   lua_pushliteral(L, "");  /* else, no information available... */
84 }
85
86
87 LUALIB_API int luaL_error (lua_State *L, const char *fmt, ...) {
88   va_list argp;
89   va_start(argp, fmt);
90   luaL_where(L, 1);
91   lua_pushvfstring(L, fmt, argp);
92   va_end(argp);
93   lua_concat(L, 2);
94   return lua_error(L);
95 }
96
97 /* }====================================================== */
98
99
100 LUALIB_API int luaL_findstring (const char *name, const char *const list[]) {
101   int i;
102   for (i=0; list[i]; i++)
103     if (strcmp(list[i], name) == 0)
104       return i;
105   return -1;  /* name not found */
106 }
107
108
109 LUALIB_API int luaL_newmetatable (lua_State *L, const char *tname) {
110   lua_pushstring(L, tname);
111   lua_rawget(L, LUA_REGISTRYINDEX);  /* get registry.name */
112   if (!lua_isnil(L, -1))  /* name already in use? */
113     return 0;  /* leave previous value on top, but return 0 */
114   lua_pop(L, 1);
115   lua_newtable(L);  /* create metatable */
116   lua_pushstring(L, tname);
117   lua_pushvalue(L, -2);
118   lua_rawset(L, LUA_REGISTRYINDEX);  /* registry.name = metatable */
119   lua_pushvalue(L, -1);
120   lua_pushstring(L, tname);
121   lua_rawset(L, LUA_REGISTRYINDEX);  /* registry[metatable] = name */
122   return 1;
123 }
124
125
126 LUALIB_API void  luaL_getmetatable (lua_State *L, const char *tname) {
127   lua_pushstring(L, tname);
128   lua_rawget(L, LUA_REGISTRYINDEX);
129 }
130
131
132 LUALIB_API void *luaL_checkudata (lua_State *L, int ud, const char *tname) {
133   const char *tn;
134   if (!lua_getmetatable(L, ud)) return NULL;  /* no metatable? */
135   lua_rawget(L, LUA_REGISTRYINDEX);  /* get registry[metatable] */
136   tn = lua_tostring(L, -1);
137   if (tn && (strcmp(tn, tname) == 0)) {
138     lua_pop(L, 1);
139     return lua_touserdata(L, ud);
140   }
141   else {
142     lua_pop(L, 1);
143     return NULL;
144   }
145 }
146
147
148 LUALIB_API void luaL_checkstack (lua_State *L, int space, const char *mes) {
149   if (!lua_checkstack(L, space))
150     luaL_error(L, "stack overflow (%s)", mes);
151 }
152
153
154 LUALIB_API void luaL_checktype (lua_State *L, int narg, int t) {
155   if (lua_type(L, narg) != t)
156     tag_error(L, narg, t);
157 }
158
159
160 LUALIB_API void luaL_checkany (lua_State *L, int narg) {
161   if (lua_type(L, narg) == LUA_TNONE)
162     luaL_argerror(L, narg, "value expected");
163 }
164
165
166 LUALIB_API const char *luaL_checklstring (lua_State *L, int narg, size_t *len) {
167   const char *s = lua_tostring(L, narg);
168   if (!s) tag_error(L, narg, LUA_TSTRING);
169   if (len) *len = lua_strlen(L, narg);
170   return s;
171 }
172
173
174 LUALIB_API const char *luaL_optlstring (lua_State *L, int narg,
175                                         const char *def, size_t *len) {
176   if (lua_isnoneornil(L, narg)) {
177     if (len)
178       *len = (def ? strlen(def) : 0);
179     return def;
180   }
181   else return luaL_checklstring(L, narg, len);
182 }
183
184
185 LUALIB_API lua_Number luaL_checknumber (lua_State *L, int narg) {
186   lua_Number d = lua_tonumber(L, narg);
187   if (d == 0 && !lua_isnumber(L, narg))  /* avoid extra test when d is not 0 */
188     tag_error(L, narg, LUA_TNUMBER);
189   return d;
190 }
191
192
193 LUALIB_API lua_Number luaL_optnumber (lua_State *L, int narg, lua_Number def) {
194   if (lua_isnoneornil(L, narg)) return def;
195   else return luaL_checknumber(L, narg);
196 }
197
198
199 LUALIB_API int luaL_getmetafield (lua_State *L, int obj, const char *event) {
200   if (!lua_getmetatable(L, obj))  /* no metatable? */
201     return 0;
202   lua_pushstring(L, event);
203   lua_rawget(L, -2);
204   if (lua_isnil(L, -1)) {
205     lua_pop(L, 2);  /* remove metatable and metafield */
206     return 0;
207   }
208   else {
209     lua_remove(L, -2);  /* remove only metatable */
210     return 1;
211   }
212 }
213
214
215 LUALIB_API int luaL_callmeta (lua_State *L, int obj, const char *event) {
216   obj = abs_index(L, obj);
217   if (!luaL_getmetafield(L, obj, event))  /* no metafield? */
218     return 0;
219   lua_pushvalue(L, obj);
220   lua_call(L, 1, 1);
221   return 1;
222 }
223
224
225 LUALIB_API void luaL_openlib (lua_State *L, const char *libname,
226                               const luaL_reg *l, int nup) {
227   if (libname) {
228     lua_pushstring(L, libname);
229     lua_gettable(L, LUA_GLOBALSINDEX);  /* check whether lib already exists */
230     if (lua_isnil(L, -1)) {  /* no? */
231       lua_pop(L, 1);
232       lua_newtable(L);  /* create it */
233       lua_pushstring(L, libname);
234       lua_pushvalue(L, -2);
235       lua_settable(L, LUA_GLOBALSINDEX);  /* register it with given name */
236     }
237     lua_insert(L, -(nup+1));  /* move library table to below upvalues */
238   }
239   for (; l->name; l++) {
240     int i;
241     lua_pushstring(L, l->name);
242     for (i=0; i<nup; i++)  /* copy upvalues to the top */
243       lua_pushvalue(L, -(nup+1));
244     lua_pushcclosure(L, l->func, nup);
245     lua_settable(L, -(nup+3));
246   }
247   lua_pop(L, nup);  /* remove upvalues */
248 }
249
250
251
252 /*
253 ** {======================================================
254 ** getn-setn: size for arrays
255 ** =======================================================
256 */
257
258 static int checkint (lua_State *L, int topop) {
259   int n = (int)lua_tonumber(L, -1);
260   if (n == 0 && !lua_isnumber(L, -1)) n = -1;
261   lua_pop(L, topop);
262   return n;
263 }
264
265
266 static void getsizes (lua_State *L) {
267   lua_rawgeti(L, LUA_REGISTRYINDEX, ARRAYSIZE_REF);
268   if (lua_isnil(L, -1)) {  /* no `size' table? */
269     lua_pop(L, 1);  /* remove nil */
270     lua_newtable(L);  /* create it */
271     lua_pushvalue(L, -1);  /* `size' will be its own metatable */
272     lua_setmetatable(L, -2);
273     lua_pushliteral(L, "__mode");
274     lua_pushliteral(L, "k");
275     lua_rawset(L, -3);  /* metatable(N).__mode = "k" */
276     lua_pushvalue(L, -1);
277     lua_rawseti(L, LUA_REGISTRYINDEX, ARRAYSIZE_REF);  /* store in register */
278   }
279 }
280
281
282 void luaL_setn (lua_State *L, int t, int n) {
283   t = abs_index(L, t);
284   lua_pushliteral(L, "n");
285   lua_rawget(L, t);
286   if (checkint(L, 1) >= 0) {  /* is there a numeric field `n'? */
287     lua_pushliteral(L, "n");  /* use it */
288     lua_pushnumber(L, (lua_Number)n);
289     lua_rawset(L, t);
290   }
291   else {  /* use `sizes' */
292     getsizes(L);
293     lua_pushvalue(L, t);
294     lua_pushnumber(L, (lua_Number)n);
295     lua_rawset(L, -3);  /* sizes[t] = n */
296     lua_pop(L, 1);  /* remove `sizes' */
297   }
298 }
299
300
301 int luaL_getn (lua_State *L, int t) {
302   int n;
303   t = abs_index(L, t);
304   lua_pushliteral(L, "n");  /* try t.n */
305   lua_rawget(L, t);
306   if ((n = checkint(L, 1)) >= 0) return n;
307   getsizes(L);  /* else try sizes[t] */
308   lua_pushvalue(L, t);
309   lua_rawget(L, -2);
310   if ((n = checkint(L, 2)) >= 0) return n;
311   for (n = 1; ; n++) {  /* else must count elements */
312     lua_rawgeti(L, t, n);
313     if (lua_isnil(L, -1)) break;
314     lua_pop(L, 1);
315   }
316   lua_pop(L, 1);
317   return n - 1;
318 }
319
320 /* }====================================================== */
321
322
323
324 /*
325 ** {======================================================
326 ** Generic Buffer manipulation
327 ** =======================================================
328 */
329
330
331 #define bufflen(B)      ((B)->p - (B)->buffer)
332 #define bufffree(B)     ((size_t)(LUAL_BUFFERSIZE - bufflen(B)))
333
334 #define LIMIT   (LUA_MINSTACK/2)
335
336
337 static int emptybuffer (luaL_Buffer *B) {
338   size_t l = bufflen(B);
339   if (l == 0) return 0;  /* put nothing on stack */
340   else {
341     lua_pushlstring(B->L, B->buffer, l);
342     B->p = B->buffer;
343     B->lvl++;
344     return 1;
345   }
346 }
347
348
349 static void adjuststack (luaL_Buffer *B) {
350   if (B->lvl > 1) {
351     lua_State *L = B->L;
352     int toget = 1;  /* number of levels to concat */
353     size_t toplen = lua_strlen(L, -1);
354     do {
355       size_t l = lua_strlen(L, -(toget+1));
356       if (B->lvl - toget + 1 >= LIMIT || toplen > l) {
357         toplen += l;
358         toget++;
359       }
360       else break;
361     } while (toget < B->lvl);
362     lua_concat(L, toget);
363     B->lvl = B->lvl - toget + 1;
364   }
365 }
366
367
368 LUALIB_API char *luaL_prepbuffer (luaL_Buffer *B) {
369   if (emptybuffer(B))
370     adjuststack(B);
371   return B->buffer;
372 }
373
374
375 LUALIB_API void luaL_addlstring (luaL_Buffer *B, const char *s, size_t l) {
376   while (l--)
377     luaL_putchar(B, *s++);
378 }
379
380
381 LUALIB_API void luaL_addstring (luaL_Buffer *B, const char *s) {
382   luaL_addlstring(B, s, strlen(s));
383 }
384
385
386 LUALIB_API void luaL_pushresult (luaL_Buffer *B) {
387   emptybuffer(B);
388   lua_concat(B->L, B->lvl);
389   B->lvl = 1;
390 }
391
392
393 LUALIB_API void luaL_addvalue (luaL_Buffer *B) {
394   lua_State *L = B->L;
395   size_t vl = lua_strlen(L, -1);
396   if (vl <= bufffree(B)) {  /* fit into buffer? */
397     memcpy(B->p, lua_tostring(L, -1), vl);  /* put it there */
398     B->p += vl;
399     lua_pop(L, 1);  /* remove from stack */
400   }
401   else {
402     if (emptybuffer(B))
403       lua_insert(L, -2);  /* put buffer before new value */
404     B->lvl++;  /* add new value into B stack */
405     adjuststack(B);
406   }
407 }
408
409
410 LUALIB_API void luaL_buffinit (lua_State *L, luaL_Buffer *B) {
411   B->L = L;
412   B->p = B->buffer;
413   B->lvl = 0;
414 }
415
416 /* }====================================================== */
417
418
419 LUALIB_API int luaL_ref (lua_State *L, int t) {
420   int ref;
421   t = abs_index(L, t);
422   if (lua_isnil(L, -1)) {
423     lua_pop(L, 1);  /* remove from stack */
424     return LUA_REFNIL;  /* `nil' has a unique fixed reference */
425   }
426   lua_rawgeti(L, t, FREELIST_REF);  /* get first free element */
427   ref = (int)lua_tonumber(L, -1);  /* ref = t[FREELIST_REF] */
428   lua_pop(L, 1);  /* remove it from stack */
429   if (ref != 0) {  /* any free element? */
430     lua_rawgeti(L, t, ref);  /* remove it from list */
431     lua_rawseti(L, t, FREELIST_REF);  /* (t[FREELIST_REF] = t[ref]) */
432   }
433   else {  /* no free elements */
434     ref = luaL_getn(L, t);
435     if (ref < RESERVED_REFS)
436       ref = RESERVED_REFS;  /* skip reserved references */
437     ref++;  /* create new reference */
438     luaL_setn(L, t, ref);
439   }
440   lua_rawseti(L, t, ref);
441   return ref;
442 }
443
444
445 LUALIB_API void luaL_unref (lua_State *L, int t, int ref) {
446   if (ref >= 0) {
447     t = abs_index(L, t);
448     lua_rawgeti(L, t, FREELIST_REF);
449     lua_rawseti(L, t, ref);  /* t[ref] = t[FREELIST_REF] */
450     lua_pushnumber(L, (lua_Number)ref);
451     lua_rawseti(L, t, FREELIST_REF);  /* t[FREELIST_REF] = ref */
452   }
453 }
454
455
456
457 /*
458 ** {======================================================
459 ** Load functions
460 ** =======================================================
461 */
462
463 typedef struct LoadF {
464   FILE *f;
465   char buff[LUAL_BUFFERSIZE];
466 } LoadF;
467
468
469 static const char *getF (lua_State *L, void *ud, size_t *size) {
470   LoadF *lf = (LoadF *)ud;
471   (void)L;
472   if (feof(lf->f)) return NULL;
473   *size = fread(lf->buff, 1, LUAL_BUFFERSIZE, lf->f);
474   return (*size > 0) ? lf->buff : NULL;
475 }
476
477
478 static int errfile (lua_State *L, int fnameindex) {
479   const char *filename = lua_tostring(L, fnameindex) + 1;
480   lua_pushfstring(L, "cannot read %s: %s", filename, strerror(errno));
481   lua_remove(L, fnameindex);
482   return LUA_ERRFILE;
483 }
484
485
486 LUALIB_API int luaL_loadfile (lua_State *L, const char *filename) {
487   LoadF lf;
488   int status, readstatus;
489   int c;
490   int fnameindex = lua_gettop(L) + 1;  /* index of filename on the stack */
491   if (filename == NULL) {
492     lua_pushliteral(L, "=stdin");
493     lf.f = stdin;
494   }
495   else {
496     lua_pushfstring(L, "@%s", filename);
497     lf.f = fopen(filename, "r");
498   }
499   if (lf.f == NULL) return errfile(L, fnameindex);  /* unable to open file */
500   c = ungetc(getc(lf.f), lf.f);
501   if (!(isspace(c) || isprint(c)) && lf.f != stdin) {  /* binary file? */
502     fclose(lf.f);
503     lf.f = fopen(filename, "rb");  /* reopen in binary mode */
504     if (lf.f == NULL) return errfile(L, fnameindex); /* unable to reopen file */
505   }
506   status = lua_load(L, getF, &lf, lua_tostring(L, -1));
507   readstatus = ferror(lf.f);
508   if (lf.f != stdin) fclose(lf.f);  /* close file (even in case of errors) */
509   if (readstatus) {
510     lua_settop(L, fnameindex);  /* ignore results from `lua_load' */
511     return errfile(L, fnameindex);
512   }
513   lua_remove(L, fnameindex);
514   return status;
515 }
516
517
518 typedef struct LoadS {
519   const char *s;
520   size_t size;
521 } LoadS;
522
523
524 static const char *getS (lua_State *L, void *ud, size_t *size) {
525   LoadS *ls = (LoadS *)ud;
526   (void)L;
527   if (ls->size == 0) return NULL;
528   *size = ls->size;
529   ls->size = 0;
530   return ls->s;
531 }
532
533
534 LUALIB_API int luaL_loadbuffer (lua_State *L, const char *buff, size_t size,
535                                 const char *name) {
536   LoadS ls;
537   ls.s = buff;
538   ls.size = size;
539   return lua_load(L, getS, &ls, name);
540 }
541
542 /* }====================================================== */
543
544
545 /*
546 ** {======================================================
547 ** compatibility code
548 ** =======================================================
549 */
550
551
552 static void callalert (lua_State *L, int status) {
553   if (status != 0) {
554     lua_getglobal(L, "_ALERT");
555     if (lua_isfunction(L, -1)) {
556       lua_insert(L, -2);
557       lua_call(L, 1, 0);
558     }
559     else {  /* no _ALERT function; print it on stderr */
560       fprintf(stderr, "%s\n", lua_tostring(L, -2));
561       lua_pop(L, 2);  /* remove error message and _ALERT */
562     }
563   }
564 }
565
566
567 static int aux_do (lua_State *L, int status) {
568   if (status == 0) {  /* parse OK? */
569     status = lua_pcall(L, 0, LUA_MULTRET, 0);  /* call main */
570   }
571   callalert(L, status);
572   return status;
573 }
574
575
576 LUALIB_API int lua_dofile (lua_State *L, const char *filename) {
577   return aux_do(L, luaL_loadfile(L, filename));
578 }
579
580
581 LUALIB_API int lua_dobuffer (lua_State *L, const char *buff, size_t size,
582                           const char *name) {
583   return aux_do(L, luaL_loadbuffer(L, buff, size, name));
584 }
585
586
587 LUALIB_API int lua_dostring (lua_State *L, const char *str) {
588   return lua_dobuffer(L, str, strlen(str), str);
589 }
590
591 /* }====================================================== */