Mercurial > vba-clojure
view src/lua/lauxlib.c @ 287:7918c0dcc0bd
merge
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Wed, 28 Mar 2012 06:06:13 -0500 |
parents | 27763b933818 |
children |
line wrap: on
line source
1 /*2 ** $Id: lauxlib.c,v 1.159.1.3 2008/01/21 13:20:51 roberto Exp $3 ** Auxiliary functions for building Lua libraries4 ** See Copyright Notice in lua.h5 */8 #include <ctype.h>9 #include <errno.h>10 #include <stdarg.h>11 #include <stdio.h>12 #include <stdlib.h>13 #include <string.h>16 /* This file uses only the official API of Lua.17 ** Any function declared here could be written as an application function.18 */20 #define lauxlib_c21 #define LUA_LIB23 #include "lua.h"25 #include "lauxlib.h"28 #define FREELIST_REF 0 /* free list of references */31 /* convert a stack index to positive */32 #define abs_index(L, i) ((i) > 0 || (i) <= LUA_REGISTRYINDEX ? (i) : \33 lua_gettop(L) + (i) + 1)36 /*37 ** {======================================================38 ** Error-report functions39 ** =======================================================40 */43 LUALIB_API int luaL_argerror (lua_State *L, int narg, const char *extramsg) {44 lua_Debug ar;45 if (!lua_getstack(L, 0, &ar)) /* no stack frame? */46 return luaL_error(L, "bad argument #%d (%s)", narg, extramsg);47 lua_getinfo(L, "n", &ar);48 if (strcmp(ar.namewhat, "method") == 0) {49 narg--; /* do not count `self' */50 if (narg == 0) /* error is in the self argument itself? */51 return luaL_error(L, "calling " LUA_QS " on bad self (%s)",52 ar.name, extramsg);53 }54 if (ar.name == NULL)55 ar.name = "?";56 return luaL_error(L, "bad argument #%d to " LUA_QS " (%s)",57 narg, ar.name, extramsg);58 }61 LUALIB_API int luaL_typerror (lua_State *L, int narg, const char *tname) {62 const char *msg = lua_pushfstring(L, "%s expected, got %s",63 tname, luaL_typename(L, narg));64 return luaL_argerror(L, narg, msg);65 }68 static void tag_error (lua_State *L, int narg, int tag) {69 luaL_typerror(L, narg, lua_typename(L, tag));70 }73 LUALIB_API void luaL_where (lua_State *L, int level) {74 lua_Debug ar;75 if (lua_getstack(L, level, &ar)) { /* check function at level */76 lua_getinfo(L, "Sl", &ar); /* get info about it */77 if (ar.currentline > 0) { /* is there info? */78 lua_pushfstring(L, "%s:%d: ", ar.short_src, ar.currentline);79 return;80 }81 }82 lua_pushliteral(L, ""); /* else, no information available... */83 }86 LUALIB_API int luaL_error (lua_State *L, const char *fmt, ...) {87 va_list argp;88 va_start(argp, fmt);89 luaL_where(L, 1);90 lua_pushvfstring(L, fmt, argp);91 va_end(argp);92 lua_concat(L, 2);93 return lua_error(L);94 }96 /* }====================================================== */99 LUALIB_API int luaL_checkoption (lua_State *L, int narg, const char *def,100 const char *const lst[]) {101 const char *name = (def) ? luaL_optstring(L, narg, def) :102 luaL_checkstring(L, narg);103 int i;104 for (i=0; lst[i]; i++)105 if (strcmp(lst[i], name) == 0)106 return i;107 return luaL_argerror(L, narg,108 lua_pushfstring(L, "invalid option " LUA_QS, name));109 }112 LUALIB_API int luaL_newmetatable (lua_State *L, const char *tname) {113 lua_getfield(L, LUA_REGISTRYINDEX, tname); /* get registry.name */114 if (!lua_isnil(L, -1)) /* name already in use? */115 return 0; /* leave previous value on top, but return 0 */116 lua_pop(L, 1);117 lua_newtable(L); /* create metatable */118 lua_pushvalue(L, -1);119 lua_setfield(L, LUA_REGISTRYINDEX, tname); /* registry.name = metatable */120 return 1;121 }124 LUALIB_API void *luaL_checkudata (lua_State *L, int ud, const char *tname) {125 void *p = lua_touserdata(L, ud);126 if (p != NULL) { /* value is a userdata? */127 if (lua_getmetatable(L, ud)) { /* does it have a metatable? */128 lua_getfield(L, LUA_REGISTRYINDEX, tname); /* get correct metatable */129 if (lua_rawequal(L, -1, -2)) { /* does it have the correct mt? */130 lua_pop(L, 2); /* remove both metatables */131 return p;132 }133 }134 }135 luaL_typerror(L, ud, tname); /* else error */136 return NULL; /* to avoid warnings */137 }140 LUALIB_API void luaL_checkstack (lua_State *L, int space, const char *mes) {141 if (!lua_checkstack(L, space))142 luaL_error(L, "stack overflow (%s)", mes);143 }146 LUALIB_API void luaL_checktype (lua_State *L, int narg, int t) {147 if (lua_type(L, narg) != t)148 tag_error(L, narg, t);149 }152 LUALIB_API void luaL_checkany (lua_State *L, int narg) {153 if (lua_type(L, narg) == LUA_TNONE)154 luaL_argerror(L, narg, "value expected");155 }158 LUALIB_API const char *luaL_checklstring (lua_State *L, int narg, size_t *len) {159 const char *s = lua_tolstring(L, narg, len);160 if (!s) tag_error(L, narg, LUA_TSTRING);161 return s;162 }165 LUALIB_API const char *luaL_optlstring (lua_State *L, int narg,166 const char *def, size_t *len) {167 if (lua_isnoneornil(L, narg)) {168 if (len)169 *len = (def ? strlen(def) : 0);170 return def;171 }172 else return luaL_checklstring(L, narg, len);173 }176 LUALIB_API lua_Number luaL_checknumber (lua_State *L, int narg) {177 lua_Number d = lua_tonumber(L, narg);178 if (d == 0 && !lua_isnumber(L, narg)) /* avoid extra test when d is not 0 */179 tag_error(L, narg, LUA_TNUMBER);180 return d;181 }184 LUALIB_API lua_Number luaL_optnumber (lua_State *L, int narg, lua_Number def) {185 return luaL_opt(L, luaL_checknumber, narg, def);186 }189 LUALIB_API lua_Integer luaL_checkinteger (lua_State *L, int narg) {190 lua_Integer d = lua_tointeger(L, narg);191 if (d == 0 && !lua_isnumber(L, narg)) /* avoid extra test when d is not 0 */192 tag_error(L, narg, LUA_TNUMBER);193 return d;194 }197 LUALIB_API lua_Integer luaL_optinteger (lua_State *L, int narg,198 lua_Integer def) {199 return luaL_opt(L, luaL_checkinteger, narg, def);200 }203 LUALIB_API int luaL_getmetafield (lua_State *L, int obj, const char *event) {204 if (!lua_getmetatable(L, obj)) /* no metatable? */205 return 0;206 lua_pushstring(L, event);207 lua_rawget(L, -2);208 if (lua_isnil(L, -1)) {209 lua_pop(L, 2); /* remove metatable and metafield */210 return 0;211 }212 else {213 lua_remove(L, -2); /* remove only metatable */214 return 1;215 }216 }219 LUALIB_API int luaL_callmeta (lua_State *L, int obj, const char *event) {220 obj = abs_index(L, obj);221 if (!luaL_getmetafield(L, obj, event)) /* no metafield? */222 return 0;223 lua_pushvalue(L, obj);224 lua_call(L, 1, 1);225 return 1;226 }229 LUALIB_API void (luaL_register) (lua_State *L, const char *libname,230 const luaL_Reg *l) {231 luaI_openlib(L, libname, l, 0);232 }235 static int libsize (const luaL_Reg *l) {236 int size = 0;237 for (; l->name; l++) size++;238 return size;239 }242 LUALIB_API void luaI_openlib (lua_State *L, const char *libname,243 const luaL_Reg *l, int nup) {244 if (libname) {245 int size = libsize(l);246 /* check whether lib already exists */247 luaL_findtable(L, LUA_REGISTRYINDEX, "_LOADED", 1);248 lua_getfield(L, -1, libname); /* get _LOADED[libname] */249 if (!lua_istable(L, -1)) { /* not found? */250 lua_pop(L, 1); /* remove previous result */251 /* try global variable (and create one if it does not exist) */252 if (luaL_findtable(L, LUA_GLOBALSINDEX, libname, size) != NULL)253 luaL_error(L, "name conflict for module " LUA_QS, libname);254 lua_pushvalue(L, -1);255 lua_setfield(L, -3, libname); /* _LOADED[libname] = new table */256 }257 lua_remove(L, -2); /* remove _LOADED table */258 lua_insert(L, -(nup+1)); /* move library table to below upvalues */259 }260 for (; l->name; l++) {261 int i;262 for (i=0; i<nup; i++) /* copy upvalues to the top */263 lua_pushvalue(L, -nup);264 lua_pushcclosure(L, l->func, nup);265 lua_setfield(L, -(nup+2), l->name);266 }267 lua_pop(L, nup); /* remove upvalues */268 }272 /*273 ** {======================================================274 ** getn-setn: size for arrays275 ** =======================================================276 */278 #if defined(LUA_COMPAT_GETN)280 static int checkint (lua_State *L, int topop) {281 int n = (lua_type(L, -1) == LUA_TNUMBER) ? lua_tointeger(L, -1) : -1;282 lua_pop(L, topop);283 return n;284 }287 static void getsizes (lua_State *L) {288 lua_getfield(L, LUA_REGISTRYINDEX, "LUA_SIZES");289 if (lua_isnil(L, -1)) { /* no `size' table? */290 lua_pop(L, 1); /* remove nil */291 lua_newtable(L); /* create it */292 lua_pushvalue(L, -1); /* `size' will be its own metatable */293 lua_setmetatable(L, -2);294 lua_pushliteral(L, "kv");295 lua_setfield(L, -2, "__mode"); /* metatable(N).__mode = "kv" */296 lua_pushvalue(L, -1);297 lua_setfield(L, LUA_REGISTRYINDEX, "LUA_SIZES"); /* store in register */298 }299 }302 LUALIB_API void luaL_setn (lua_State *L, int t, int n) {303 t = abs_index(L, t);304 lua_pushliteral(L, "n");305 lua_rawget(L, t);306 if (checkint(L, 1) >= 0) { /* is there a numeric field `n'? */307 lua_pushliteral(L, "n"); /* use it */308 lua_pushinteger(L, n);309 lua_rawset(L, t);310 }311 else { /* use `sizes' */312 getsizes(L);313 lua_pushvalue(L, t);314 lua_pushinteger(L, n);315 lua_rawset(L, -3); /* sizes[t] = n */316 lua_pop(L, 1); /* remove `sizes' */317 }318 }321 LUALIB_API int luaL_getn (lua_State *L, int t) {322 int n;323 t = abs_index(L, t);324 lua_pushliteral(L, "n"); /* try t.n */325 lua_rawget(L, t);326 if ((n = checkint(L, 1)) >= 0) return n;327 getsizes(L); /* else try sizes[t] */328 lua_pushvalue(L, t);329 lua_rawget(L, -2);330 if ((n = checkint(L, 2)) >= 0) return n;331 return (int)lua_objlen(L, t);332 }334 #endif336 /* }====================================================== */340 LUALIB_API const char *luaL_gsub (lua_State *L, const char *s, const char *p,341 const char *r) {342 const char *wild;343 size_t l = strlen(p);344 luaL_Buffer b;345 luaL_buffinit(L, &b);346 while ((wild = strstr(s, p)) != NULL) {347 luaL_addlstring(&b, s, wild - s); /* push prefix */348 luaL_addstring(&b, r); /* push replacement in place of pattern */349 s = wild + l; /* continue after `p' */350 }351 luaL_addstring(&b, s); /* push last suffix */352 luaL_pushresult(&b);353 return lua_tostring(L, -1);354 }357 LUALIB_API const char *luaL_findtable (lua_State *L, int idx,358 const char *fname, int szhint) {359 const char *e;360 lua_pushvalue(L, idx);361 do {362 e = strchr(fname, '.');363 if (e == NULL) e = fname + strlen(fname);364 lua_pushlstring(L, fname, e - fname);365 lua_rawget(L, -2);366 if (lua_isnil(L, -1)) { /* no such field? */367 lua_pop(L, 1); /* remove this nil */368 lua_createtable(L, 0, (*e == '.' ? 1 : szhint)); /* new table for field */369 lua_pushlstring(L, fname, e - fname);370 lua_pushvalue(L, -2);371 lua_settable(L, -4); /* set new table into field */372 }373 else if (!lua_istable(L, -1)) { /* field has a non-table value? */374 lua_pop(L, 2); /* remove table and value */375 return fname; /* return problematic part of the name */376 }377 lua_remove(L, -2); /* remove previous table */378 fname = e + 1;379 } while (*e == '.');380 return NULL;381 }385 /*386 ** {======================================================387 ** Generic Buffer manipulation388 ** =======================================================389 */392 #define bufflen(B) ((B)->p - (B)->buffer)393 #define bufffree(B) ((size_t)(LUAL_BUFFERSIZE - bufflen(B)))395 #define LIMIT (LUA_MINSTACK/2)398 static int emptybuffer (luaL_Buffer *B) {399 size_t l = bufflen(B);400 if (l == 0) return 0; /* put nothing on stack */401 else {402 lua_pushlstring(B->L, B->buffer, l);403 B->p = B->buffer;404 B->lvl++;405 return 1;406 }407 }410 static void adjuststack (luaL_Buffer *B) {411 if (B->lvl > 1) {412 lua_State *L = B->L;413 int toget = 1; /* number of levels to concat */414 size_t toplen = lua_strlen(L, -1);415 do {416 size_t l = lua_strlen(L, -(toget+1));417 if (B->lvl - toget + 1 >= LIMIT || toplen > l) {418 toplen += l;419 toget++;420 }421 else break;422 } while (toget < B->lvl);423 lua_concat(L, toget);424 B->lvl = B->lvl - toget + 1;425 }426 }429 LUALIB_API char *luaL_prepbuffer (luaL_Buffer *B) {430 if (emptybuffer(B))431 adjuststack(B);432 return B->buffer;433 }436 LUALIB_API void luaL_addlstring (luaL_Buffer *B, const char *s, size_t l) {437 while (l--)438 luaL_addchar(B, *s++);439 }442 LUALIB_API void luaL_addstring (luaL_Buffer *B, const char *s) {443 luaL_addlstring(B, s, strlen(s));444 }447 LUALIB_API void luaL_pushresult (luaL_Buffer *B) {448 emptybuffer(B);449 lua_concat(B->L, B->lvl);450 B->lvl = 1;451 }454 LUALIB_API void luaL_addvalue (luaL_Buffer *B) {455 lua_State *L = B->L;456 size_t vl;457 const char *s = lua_tolstring(L, -1, &vl);458 if (vl <= bufffree(B)) { /* fit into buffer? */459 memcpy(B->p, s, vl); /* put it there */460 B->p += vl;461 lua_pop(L, 1); /* remove from stack */462 }463 else {464 if (emptybuffer(B))465 lua_insert(L, -2); /* put buffer before new value */466 B->lvl++; /* add new value into B stack */467 adjuststack(B);468 }469 }472 LUALIB_API void luaL_buffinit (lua_State *L, luaL_Buffer *B) {473 B->L = L;474 B->p = B->buffer;475 B->lvl = 0;476 }478 /* }====================================================== */481 LUALIB_API int luaL_ref (lua_State *L, int t) {482 int ref;483 t = abs_index(L, t);484 if (lua_isnil(L, -1)) {485 lua_pop(L, 1); /* remove from stack */486 return LUA_REFNIL; /* `nil' has a unique fixed reference */487 }488 lua_rawgeti(L, t, FREELIST_REF); /* get first free element */489 ref = (int)lua_tointeger(L, -1); /* ref = t[FREELIST_REF] */490 lua_pop(L, 1); /* remove it from stack */491 if (ref != 0) { /* any free element? */492 lua_rawgeti(L, t, ref); /* remove it from list */493 lua_rawseti(L, t, FREELIST_REF); /* (t[FREELIST_REF] = t[ref]) */494 }495 else { /* no free elements */496 ref = (int)lua_objlen(L, t);497 ref++; /* create new reference */498 }499 lua_rawseti(L, t, ref);500 return ref;501 }504 LUALIB_API void luaL_unref (lua_State *L, int t, int ref) {505 if (ref >= 0) {506 t = abs_index(L, t);507 lua_rawgeti(L, t, FREELIST_REF);508 lua_rawseti(L, t, ref); /* t[ref] = t[FREELIST_REF] */509 lua_pushinteger(L, ref);510 lua_rawseti(L, t, FREELIST_REF); /* t[FREELIST_REF] = ref */511 }512 }516 /*517 ** {======================================================518 ** Load functions519 ** =======================================================520 */522 typedef struct LoadF {523 int extraline;524 FILE *f;525 char buff[LUAL_BUFFERSIZE];526 } LoadF;529 static const char *getF (lua_State *L, void *ud, size_t *size) {530 LoadF *lf = (LoadF *)ud;531 (void)L;532 if (lf->extraline) {533 lf->extraline = 0;534 *size = 1;535 return "\n";536 }537 if (feof(lf->f)) return NULL;538 *size = fread(lf->buff, 1, sizeof(lf->buff), lf->f);539 return (*size > 0) ? lf->buff : NULL;540 }543 static int errfile (lua_State *L, const char *what, int fnameindex) {544 const char *serr = strerror(errno);545 const char *filename = lua_tostring(L, fnameindex) + 1;546 lua_pushfstring(L, "cannot %s %s: %s", what, filename, serr);547 lua_remove(L, fnameindex);548 return LUA_ERRFILE;549 }552 LUALIB_API int luaL_loadfile (lua_State *L, const char *filename) {553 LoadF lf;554 int status, readstatus;555 int c;556 int fnameindex = lua_gettop(L) + 1; /* index of filename on the stack */557 lf.extraline = 0;558 if (filename == NULL) {559 lua_pushliteral(L, "=stdin");560 lf.f = stdin;561 }562 else {563 lua_pushfstring(L, "@%s", filename);564 lf.f = fopen(filename, "r");565 if (lf.f == NULL) return errfile(L, "open", fnameindex);566 }567 c = getc(lf.f);568 if (c == '#') { /* Unix exec. file? */569 lf.extraline = 1;570 while ((c = getc(lf.f)) != EOF && c != '\n') ; /* skip first line */571 if (c == '\n') c = getc(lf.f);572 }573 if (c == LUA_SIGNATURE[0] && filename) { /* binary file? */574 lf.f = freopen(filename, "rb", lf.f); /* reopen in binary mode */575 if (lf.f == NULL) return errfile(L, "reopen", fnameindex);576 /* skip eventual `#!...' */577 while ((c = getc(lf.f)) != EOF && c != LUA_SIGNATURE[0]) ;578 lf.extraline = 0;579 }580 ungetc(c, lf.f);581 status = lua_load(L, getF, &lf, lua_tostring(L, -1));582 readstatus = ferror(lf.f);583 if (filename) fclose(lf.f); /* close file (even in case of errors) */584 if (readstatus) {585 lua_settop(L, fnameindex); /* ignore results from `lua_load' */586 return errfile(L, "read", fnameindex);587 }588 lua_remove(L, fnameindex);589 return status;590 }593 typedef struct LoadS {594 const char *s;595 size_t size;596 } LoadS;599 static const char *getS (lua_State *L, void *ud, size_t *size) {600 LoadS *ls = (LoadS *)ud;601 (void)L;602 if (ls->size == 0) return NULL;603 *size = ls->size;604 ls->size = 0;605 return ls->s;606 }609 LUALIB_API int luaL_loadbuffer (lua_State *L, const char *buff, size_t size,610 const char *name) {611 LoadS ls;612 ls.s = buff;613 ls.size = size;614 return lua_load(L, getS, &ls, name);615 }618 LUALIB_API int (luaL_loadstring) (lua_State *L, const char *s) {619 return luaL_loadbuffer(L, s, strlen(s), s);620 }624 /* }====================================================== */627 static void *l_alloc (void *ud, void *ptr, size_t osize, size_t nsize) {628 (void)ud;629 (void)osize;630 if (nsize == 0) {631 free(ptr);632 return NULL;633 }634 else635 return realloc(ptr, nsize);636 }639 static int panic (lua_State *L) {640 (void)L; /* to avoid warnings */641 fprintf(stderr, "PANIC: unprotected error in call to Lua API (%s)\n",642 lua_tostring(L, -1));643 return 0;644 }647 LUALIB_API lua_State *luaL_newstate (void) {648 lua_State *L = lua_newstate(l_alloc, NULL);649 if (L) lua_atpanic(L, &panic);650 return L;651 }