Mercurial > vba-clojure

     1 /*

     2 ** $Id: lapi.c,v 2.55.1.5 2008/07/04 18:41:18 roberto Exp $

     3 ** Lua API

     4 ** See Copyright Notice in lua.h

     5 */

     6 

     7 

     8 #include <assert.h>

     9 #include <math.h>

    10 #include <stdarg.h>

    11 #include <string.h>

    12 

    13 #define lapi_c

    14 #define LUA_CORE

    15 

    16 #include "lua.h"

    17 

    18 #include "lapi.h"

    19 #include "ldebug.h"

    20 #include "ldo.h"

    21 #include "lfunc.h"

    22 #include "lgc.h"

    23 #include "lmem.h"

    24 #include "lobject.h"

    25 #include "lstate.h"

    26 #include "lstring.h"

    27 #include "ltable.h"

    28 #include "ltm.h"

    29 #include "lundump.h"

    30 #include "lvm.h"

    31 

    32 

    33 

    34 const char lua_ident[] =

    35   "$Lua: " LUA_RELEASE " " LUA_COPYRIGHT " $\n"

    36   "$Authors: " LUA_AUTHORS " $\n"

    37   "$URL: www.lua.org $\n";

    38 

    39 

    40 

    41 #define api_checknelems(L, n)	api_check(L, (n) <= (L->top - L->base))

    42 

    43 #define api_checkvalidindex(L, i)	api_check(L, (i) != luaO_nilobject)

    44 

    45 #define api_incr_top(L)   {api_check(L, L->top < L->ci->top); L->top++;}

    46 

    47 

    48 

    49 static TValue *index2adr (lua_State *L, int idx) {

    50   if (idx > 0) {

    51     TValue *o = L->base + (idx - 1);

    52     api_check(L, idx <= L->ci->top - L->base);

    53     if (o >= L->top) return cast(TValue *, luaO_nilobject);

    54     else return o;

    55   }

    56   else if (idx > LUA_REGISTRYINDEX) {

    57     api_check(L, idx != 0 && -idx <= L->top - L->base);

    58     return L->top + idx;

    59   }

    60   else switch (idx) {  /* pseudo-indices */

    61     case LUA_REGISTRYINDEX: return registry(L);

    62     case LUA_ENVIRONINDEX: {

    63       Closure *func = curr_func(L);

    64       sethvalue(L, &L->env, func->c.env);

    65       return &L->env;

    66     }

    67     case LUA_GLOBALSINDEX: return gt(L);

    68     default: {

    69       Closure *func = curr_func(L);

    70       idx = LUA_GLOBALSINDEX - idx;

    71       return (idx <= func->c.nupvalues)

    72                 ? &func->c.upvalue[idx-1]

    73                 : cast(TValue *, luaO_nilobject);

    74     }

    75   }

    76 }

    77 

    78 

    79 static Table *getcurrenv (lua_State *L) {

    80   if (L->ci == L->base_ci)  /* no enclosing function? */

    81     return hvalue(gt(L));  /* use global table as environment */

    82   else {

    83     Closure *func = curr_func(L);

    84     return func->c.env;

    85   }

    86 }

    87 

    88 

    89 void luaA_pushobject (lua_State *L, const TValue *o) {

    90   setobj2s(L, L->top, o);

    91   api_incr_top(L);

    92 }

    93 

    94 

    95 LUA_API int lua_checkstack (lua_State *L, int size) {

    96   int res = 1;

    97   lua_lock(L);

    98   if (size > LUAI_MAXCSTACK || (L->top - L->base + size) > LUAI_MAXCSTACK)

    99     res = 0;  /* stack overflow */

   100   else if (size > 0) {

   101     luaD_checkstack(L, size);

   102     if (L->ci->top < L->top + size)

   103       L->ci->top = L->top + size;

   104   }

   105   lua_unlock(L);

   106   return res;

   107 }

   108 

   109 

   110 LUA_API void lua_xmove (lua_State *from, lua_State *to, int n) {

   111   int i;

   112   if (from == to) return;

   113   lua_lock(to);

   114   api_checknelems(from, n);

   115   api_check(from, G(from) == G(to));

   116   api_check(from, to->ci->top - to->top >= n);

   117   from->top -= n;

   118   for (i = 0; i < n; i++) {

   119     setobj2s(to, to->top++, from->top + i);

   120   }

   121   lua_unlock(to);

   122 }

   123 

   124 

   125 LUA_API void lua_setlevel (lua_State *from, lua_State *to) {

   126   to->nCcalls = from->nCcalls;

   127 }

   128 

   129 

   130 LUA_API lua_CFunction lua_atpanic (lua_State *L, lua_CFunction panicf) {

   131   lua_CFunction old;

   132   lua_lock(L);

   133   old = G(L)->panic;

   134   G(L)->panic = panicf;

   135   lua_unlock(L);

   136   return old;

   137 }

   138 

   139 

   140 LUA_API lua_State *lua_newthread (lua_State *L) {

   141   lua_State *L1;

   142   lua_lock(L);

   143   luaC_checkGC(L);

   144   L1 = luaE_newthread(L);

   145   setthvalue(L, L->top, L1);

   146   api_incr_top(L);

   147   lua_unlock(L);

   148   luai_userstatethread(L, L1);

   149   return L1;

   150 }

   151 

   152 

   153 

   154 /*

   155 ** basic stack manipulation

   156 */

   157 

   158 

   159 LUA_API int lua_gettop (lua_State *L) {

   160   return cast_int(L->top - L->base);

   161 }

   162 

   163 

   164 LUA_API void lua_settop (lua_State *L, int idx) {

   165   lua_lock(L);

   166   if (idx >= 0) {

   167     api_check(L, idx <= L->stack_last - L->base);

   168     while (L->top < L->base + idx)

   169       setnilvalue(L->top++);

   170     L->top = L->base + idx;

   171   }

   172   else {

   173     api_check(L, -(idx+1) <= (L->top - L->base));

   174     L->top += idx+1;  /* `subtract' index (index is negative) */

   175   }

   176   lua_unlock(L);

   177 }

   178 

   179 

   180 LUA_API void lua_remove (lua_State *L, int idx) {

   181   StkId p;

   182   lua_lock(L);

   183   p = index2adr(L, idx);

   184   api_checkvalidindex(L, p);

   185   while (++p < L->top) setobjs2s(L, p-1, p);

   186   L->top--;

   187   lua_unlock(L);

   188 }

   189 

   190 

   191 LUA_API void lua_insert (lua_State *L, int idx) {

   192   StkId p;

   193   StkId q;

   194   lua_lock(L);

   195   p = index2adr(L, idx);

   196   api_checkvalidindex(L, p);

   197   for (q = L->top; q>p; q--) setobjs2s(L, q, q-1);

   198   setobjs2s(L, p, L->top);

   199   lua_unlock(L);

   200 }

   201 

   202 

   203 LUA_API void lua_replace (lua_State *L, int idx) {

   204   StkId o;

   205   lua_lock(L);

   206   /* explicit test for incompatible code */

   207   if (idx == LUA_ENVIRONINDEX && L->ci == L->base_ci)

   208     luaG_runerror(L, "no calling environment");

   209   api_checknelems(L, 1);

   210   o = index2adr(L, idx);

   211   api_checkvalidindex(L, o);

   212   if (idx == LUA_ENVIRONINDEX) {

   213     Closure *func = curr_func(L);

   214     api_check(L, ttistable(L->top - 1)); 

   215     func->c.env = hvalue(L->top - 1);

   216     luaC_barrier(L, func, L->top - 1);

   217   }

   218   else {

   219     setobj(L, o, L->top - 1);

   220     if (idx < LUA_GLOBALSINDEX)  /* function upvalue? */

   221       luaC_barrier(L, curr_func(L), L->top - 1);

   222   }

   223   L->top--;

   224   lua_unlock(L);

   225 }

   226 

   227 

   228 LUA_API void lua_pushvalue (lua_State *L, int idx) {

   229   lua_lock(L);

   230   setobj2s(L, L->top, index2adr(L, idx));

   231   api_incr_top(L);

   232   lua_unlock(L);

   233 }

   234 

   235 

   236 

   237 /*

   238 ** access functions (stack -> C)

   239 */

   240 

   241 

   242 LUA_API int lua_type (lua_State *L, int idx) {

   243   StkId o = index2adr(L, idx);

   244   return (o == luaO_nilobject) ? LUA_TNONE : ttype(o);

   245 }

   246 

   247 

   248 LUA_API const char *lua_typename (lua_State *L, int t) {

   249   UNUSED(L);

   250   return (t == LUA_TNONE) ? "no value" : luaT_typenames[t];

   251 }

   252 

   253 

   254 LUA_API int lua_iscfunction (lua_State *L, int idx) {

   255   StkId o = index2adr(L, idx);

   256   return iscfunction(o);

   257 }

   258 

   259 

   260 LUA_API int lua_isnumber (lua_State *L, int idx) {

   261   TValue n;

   262   const TValue *o = index2adr(L, idx);

   263   return tonumber(o, &n);

   264 }

   265 

   266 

   267 LUA_API int lua_isstring (lua_State *L, int idx) {

   268   int t = lua_type(L, idx);

   269   return (t == LUA_TSTRING || t == LUA_TNUMBER);

   270 }

   271 

   272 

   273 LUA_API int lua_isuserdata (lua_State *L, int idx) {

   274   const TValue *o = index2adr(L, idx);

   275   return (ttisuserdata(o) || ttislightuserdata(o));

   276 }

   277 

   278 

   279 LUA_API int lua_rawequal (lua_State *L, int index1, int index2) {

   280   StkId o1 = index2adr(L, index1);

   281   StkId o2 = index2adr(L, index2);

   282   return (o1 == luaO_nilobject || o2 == luaO_nilobject) ? 0

   283          : luaO_rawequalObj(o1, o2);

   284 }

   285 

   286 

   287 LUA_API int lua_equal (lua_State *L, int index1, int index2) {

   288   StkId o1, o2;

   289   int i;

   290   lua_lock(L);  /* may call tag method */

   291   o1 = index2adr(L, index1);

   292   o2 = index2adr(L, index2);

   293   i = (o1 == luaO_nilobject || o2 == luaO_nilobject) ? 0 : equalobj(L, o1, o2);

   294   lua_unlock(L);

   295   return i;

   296 }

   297 

   298 

   299 LUA_API int lua_lessthan (lua_State *L, int index1, int index2) {

   300   StkId o1, o2;

   301   int i;

   302   lua_lock(L);  /* may call tag method */

   303   o1 = index2adr(L, index1);

   304   o2 = index2adr(L, index2);

   305   i = (o1 == luaO_nilobject || o2 == luaO_nilobject) ? 0

   306        : luaV_lessthan(L, o1, o2);

   307   lua_unlock(L);

   308   return i;

   309 }

   310 

   311 

   312 

   313 LUA_API lua_Number lua_tonumber (lua_State *L, int idx) {

   314   TValue n;

   315   const TValue *o = index2adr(L, idx);

   316   if (tonumber(o, &n))

   317     return nvalue(o);

   318   else

   319     return 0;

   320 }

   321 

   322 

   323 LUA_API lua_Integer lua_tointeger (lua_State *L, int idx) {

   324   TValue n;

   325   const TValue *o = index2adr(L, idx);

   326   if (tonumber(o, &n)) {

   327     lua_Integer res;

   328     lua_Number num = nvalue(o);

   329     lua_number2integer(res, num);

   330     return res;

   331   }

   332   else

   333     return 0;

   334 }

   335 

   336 

   337 LUA_API int lua_toboolean (lua_State *L, int idx) {

   338   const TValue *o = index2adr(L, idx);

   339   return !l_isfalse(o);

   340 }

   341 

   342 

   343 LUA_API const char *lua_tolstring (lua_State *L, int idx, size_t *len) {

   344   StkId o = index2adr(L, idx);

   345   if (!ttisstring(o)) {

   346     lua_lock(L);  /* `luaV_tostring' may create a new string */

   347     if (!luaV_tostring(L, o)) {  /* conversion failed? */

   348       if (len != NULL) *len = 0;

   349       lua_unlock(L);

   350       return NULL;

   351     }

   352     luaC_checkGC(L);

   353     o = index2adr(L, idx);  /* previous call may reallocate the stack */

   354     lua_unlock(L);

   355   }

   356   if (len != NULL) *len = tsvalue(o)->len;

   357   return svalue(o);

   358 }

   359 

   360 

   361 LUA_API size_t lua_objlen (lua_State *L, int idx) {

   362   StkId o = index2adr(L, idx);

   363   switch (ttype(o)) {

   364     case LUA_TSTRING: return tsvalue(o)->len;

   365     case LUA_TUSERDATA: return uvalue(o)->len;

   366     case LUA_TTABLE: return luaH_getn(hvalue(o));

   367     case LUA_TNUMBER: {

   368       size_t l;

   369       lua_lock(L);  /* `luaV_tostring' may create a new string */

   370       l = (luaV_tostring(L, o) ? tsvalue(o)->len : 0);

   371       lua_unlock(L);

   372       return l;

   373     }

   374     default: return 0;

   375   }

   376 }

   377 

   378 

   379 LUA_API lua_CFunction lua_tocfunction (lua_State *L, int idx) {

   380   StkId o = index2adr(L, idx);

   381   return (!iscfunction(o)) ? NULL : clvalue(o)->c.f;

   382 }

   383 

   384 

   385 LUA_API void *lua_touserdata (lua_State *L, int idx) {

   386   StkId o = index2adr(L, idx);

   387   switch (ttype(o)) {

   388     case LUA_TUSERDATA: return (rawuvalue(o) + 1);

   389     case LUA_TLIGHTUSERDATA: return pvalue(o);

   390     default: return NULL;

   391   }

   392 }

   393 

   394 

   395 LUA_API lua_State *lua_tothread (lua_State *L, int idx) {

   396   StkId o = index2adr(L, idx);

   397   return (!ttisthread(o)) ? NULL : thvalue(o);

   398 }

   399 

   400 

   401 LUA_API const void *lua_topointer (lua_State *L, int idx) {

   402   StkId o = index2adr(L, idx);

   403   switch (ttype(o)) {

   404     case LUA_TTABLE: return hvalue(o);

   405     case LUA_TFUNCTION: return clvalue(o);

   406     case LUA_TTHREAD: return thvalue(o);

   407     case LUA_TUSERDATA:

   408     case LUA_TLIGHTUSERDATA:

   409       return lua_touserdata(L, idx);

   410     default: return NULL;

   411   }

   412 }

   413 

   414 

   415 

   416 /*

   417 ** push functions (C -> stack)

   418 */

   419 

   420 

   421 LUA_API void lua_pushnil (lua_State *L) {

   422   lua_lock(L);

   423   setnilvalue(L->top);

   424   api_incr_top(L);

   425   lua_unlock(L);

   426 }

   427 

   428 

   429 LUA_API void lua_pushnumber (lua_State *L, lua_Number n) {

   430   lua_lock(L);

   431   setnvalue(L->top, n);

   432   api_incr_top(L);

   433   lua_unlock(L);

   434 }

   435 

   436 

   437 LUA_API void lua_pushinteger (lua_State *L, lua_Integer n) {

   438   lua_lock(L);

   439   setnvalue(L->top, cast_num(n));

   440   api_incr_top(L);

   441   lua_unlock(L);

   442 }

   443 

   444 

   445 LUA_API void lua_pushlstring (lua_State *L, const char *s, size_t len) {

   446   lua_lock(L);

   447   luaC_checkGC(L);

   448   setsvalue2s(L, L->top, luaS_newlstr(L, s, len));

   449   api_incr_top(L);

   450   lua_unlock(L);

   451 }

   452 

   453 

   454 LUA_API void lua_pushstring (lua_State *L, const char *s) {

   455   if (s == NULL)

   456     lua_pushnil(L);

   457   else

   458     lua_pushlstring(L, s, strlen(s));

   459 }

   460 

   461 

   462 LUA_API const char *lua_pushvfstring (lua_State *L, const char *fmt,

   463                                       va_list argp) {

   464   const char *ret;

   465   lua_lock(L);

   466   luaC_checkGC(L);

   467   ret = luaO_pushvfstring(L, fmt, argp);

   468   lua_unlock(L);

   469   return ret;

   470 }

   471 

   472 

   473 LUA_API const char *lua_pushfstring (lua_State *L, const char *fmt, ...) {

   474   const char *ret;

   475   va_list argp;

   476   lua_lock(L);

   477   luaC_checkGC(L);

   478   va_start(argp, fmt);

   479   ret = luaO_pushvfstring(L, fmt, argp);

   480   va_end(argp);

   481   lua_unlock(L);

   482   return ret;

   483 }

   484 

   485 

   486 LUA_API void lua_pushcclosure (lua_State *L, lua_CFunction fn, int n) {

   487   Closure *cl;

   488   lua_lock(L);

   489   luaC_checkGC(L);

   490   api_checknelems(L, n);

   491   cl = luaF_newCclosure(L, n, getcurrenv(L));

   492   cl->c.f = fn;

   493   L->top -= n;

   494   while (n--)

   495     setobj2n(L, &cl->c.upvalue[n], L->top+n);

   496   setclvalue(L, L->top, cl);

   497   lua_assert(iswhite(obj2gco(cl)));

   498   api_incr_top(L);

   499   lua_unlock(L);

   500 }

   501 

   502 

   503 LUA_API void lua_pushboolean (lua_State *L, int b) {

   504   lua_lock(L);

   505   setbvalue(L->top, (b != 0));  /* ensure that true is 1 */

   506   api_incr_top(L);

   507   lua_unlock(L);

   508 }

   509 

   510 

   511 LUA_API void lua_pushlightuserdata (lua_State *L, void *p) {

   512   lua_lock(L);

   513   setpvalue(L->top, p);

   514   api_incr_top(L);

   515   lua_unlock(L);

   516 }

   517 

   518 

   519 LUA_API int lua_pushthread (lua_State *L) {

   520   lua_lock(L);

   521   setthvalue(L, L->top, L);

   522   api_incr_top(L);

   523   lua_unlock(L);

   524   return (G(L)->mainthread == L);

   525 }

   526 

   527 

   528 

   529 /*

   530 ** get functions (Lua -> stack)

   531 */

   532 

   533 

   534 LUA_API void lua_gettable (lua_State *L, int idx) {

   535   StkId t;

   536   lua_lock(L);

   537   t = index2adr(L, idx);

   538   api_checkvalidindex(L, t);

   539   luaV_gettable(L, t, L->top - 1, L->top - 1);

   540   lua_unlock(L);

   541 }

   542 

   543 

   544 LUA_API void lua_getfield (lua_State *L, int idx, const char *k) {

   545   StkId t;

   546   TValue key;

   547   lua_lock(L);

   548   t = index2adr(L, idx);

   549   api_checkvalidindex(L, t);

   550   setsvalue(L, &key, luaS_new(L, k));

   551   luaV_gettable(L, t, &key, L->top);

   552   api_incr_top(L);

   553   lua_unlock(L);

   554 }

   555 

   556 

   557 LUA_API void lua_rawget (lua_State *L, int idx) {

   558   StkId t;

   559   lua_lock(L);

   560   t = index2adr(L, idx);

   561   api_check(L, ttistable(t));

   562   setobj2s(L, L->top - 1, luaH_get(hvalue(t), L->top - 1));

   563   lua_unlock(L);

   564 }

   565 

   566 

   567 LUA_API void lua_rawgeti (lua_State *L, int idx, int n) {

   568   StkId o;

   569   lua_lock(L);

   570   o = index2adr(L, idx);

   571   api_check(L, ttistable(o));

   572   setobj2s(L, L->top, luaH_getnum(hvalue(o), n));

   573   api_incr_top(L);

   574   lua_unlock(L);

   575 }

   576 

   577 

   578 LUA_API void lua_createtable (lua_State *L, int narray, int nrec) {

   579   lua_lock(L);

   580   luaC_checkGC(L);

   581   sethvalue(L, L->top, luaH_new(L, narray, nrec));

   582   api_incr_top(L);

   583   lua_unlock(L);

   584 }

   585 

   586 

   587 LUA_API int lua_getmetatable (lua_State *L, int objindex) {

   588   const TValue *obj;

   589   Table *mt = NULL;

   590   int res;

   591   lua_lock(L);

   592   obj = index2adr(L, objindex);

   593   switch (ttype(obj)) {

   594     case LUA_TTABLE:

   595       mt = hvalue(obj)->metatable;

   596       break;

   597     case LUA_TUSERDATA:

   598       mt = uvalue(obj)->metatable;

   599       break;

   600     default:

   601       mt = G(L)->mt[ttype(obj)];

   602       break;

   603   }

   604   if (mt == NULL)

   605     res = 0;

   606   else {

   607     sethvalue(L, L->top, mt);

   608     api_incr_top(L);

   609     res = 1;

   610   }

   611   lua_unlock(L);

   612   return res;

   613 }

   614 

   615 

   616 LUA_API void lua_getfenv (lua_State *L, int idx) {

   617   StkId o;

   618   lua_lock(L);

   619   o = index2adr(L, idx);

   620   api_checkvalidindex(L, o);

   621   switch (ttype(o)) {

   622     case LUA_TFUNCTION:

   623       sethvalue(L, L->top, clvalue(o)->c.env);

   624       break;

   625     case LUA_TUSERDATA:

   626       sethvalue(L, L->top, uvalue(o)->env);

   627       break;

   628     case LUA_TTHREAD:

   629       setobj2s(L, L->top,  gt(thvalue(o)));

   630       break;

   631     default:

   632       setnilvalue(L->top);

   633       break;

   634   }

   635   api_incr_top(L);

   636   lua_unlock(L);

   637 }

   638 

   639 

   640 /*

   641 ** set functions (stack -> Lua)

   642 */

   643 

   644 

   645 LUA_API void lua_settable (lua_State *L, int idx) {

   646   StkId t;

   647   lua_lock(L);

   648   api_checknelems(L, 2);

   649   t = index2adr(L, idx);

   650   api_checkvalidindex(L, t);

   651   luaV_settable(L, t, L->top - 2, L->top - 1);

   652   L->top -= 2;  /* pop index and value */

   653   lua_unlock(L);

   654 }

   655 

   656 

   657 LUA_API void lua_setfield (lua_State *L, int idx, const char *k) {

   658   StkId t;

   659   TValue key;

   660   lua_lock(L);

   661   api_checknelems(L, 1);

   662   t = index2adr(L, idx);

   663   api_checkvalidindex(L, t);

   664   setsvalue(L, &key, luaS_new(L, k));

   665   luaV_settable(L, t, &key, L->top - 1);

   666   L->top--;  /* pop value */

   667   lua_unlock(L);

   668 }

   669 

   670 

   671 LUA_API void lua_rawset (lua_State *L, int idx) {

   672   StkId t;

   673   lua_lock(L);

   674   api_checknelems(L, 2);

   675   t = index2adr(L, idx);

   676   api_check(L, ttistable(t));

   677   setobj2t(L, luaH_set(L, hvalue(t), L->top-2), L->top-1);

   678   luaC_barriert(L, hvalue(t), L->top-1);

   679   L->top -= 2;

   680   lua_unlock(L);

   681 }

   682 

   683 

   684 LUA_API void lua_rawseti (lua_State *L, int idx, int n) {

   685   StkId o;

   686   lua_lock(L);

   687   api_checknelems(L, 1);

   688   o = index2adr(L, idx);

   689   api_check(L, ttistable(o));

   690   setobj2t(L, luaH_setnum(L, hvalue(o), n), L->top-1);

   691   luaC_barriert(L, hvalue(o), L->top-1);

   692   L->top--;

   693   lua_unlock(L);

   694 }

   695 

   696 

   697 LUA_API int lua_setmetatable (lua_State *L, int objindex) {

   698   TValue *obj;

   699   Table *mt;

   700   lua_lock(L);

   701   api_checknelems(L, 1);

   702   obj = index2adr(L, objindex);

   703   api_checkvalidindex(L, obj);

   704   if (ttisnil(L->top - 1))

   705     mt = NULL;

   706   else {

   707     api_check(L, ttistable(L->top - 1));

   708     mt = hvalue(L->top - 1);

   709   }

   710   switch (ttype(obj)) {

   711     case LUA_TTABLE: {

   712       hvalue(obj)->metatable = mt;

   713       if (mt)

   714         luaC_objbarriert(L, hvalue(obj), mt);

   715       break;

   716     }

   717     case LUA_TUSERDATA: {

   718       uvalue(obj)->metatable = mt;

   719       if (mt)

   720         luaC_objbarrier(L, rawuvalue(obj), mt);

   721       break;

   722     }

   723     default: {

   724       G(L)->mt[ttype(obj)] = mt;

   725       break;

   726     }

   727   }

   728   L->top--;

   729   lua_unlock(L);

   730   return 1;

   731 }

   732 

   733 

   734 LUA_API int lua_setfenv (lua_State *L, int idx) {

   735   StkId o;

   736   int res = 1;

   737   lua_lock(L);

   738   api_checknelems(L, 1);

   739   o = index2adr(L, idx);

   740   api_checkvalidindex(L, o);

   741   api_check(L, ttistable(L->top - 1));

   742   switch (ttype(o)) {

   743     case LUA_TFUNCTION:

   744       clvalue(o)->c.env = hvalue(L->top - 1);

   745       break;

   746     case LUA_TUSERDATA:

   747       uvalue(o)->env = hvalue(L->top - 1);

   748       break;

   749     case LUA_TTHREAD:

   750       sethvalue(L, gt(thvalue(o)), hvalue(L->top - 1));

   751       break;

   752     default:

   753       res = 0;

   754       break;

   755   }

   756   if (res) luaC_objbarrier(L, gcvalue(o), hvalue(L->top - 1));

   757   L->top--;

   758   lua_unlock(L);

   759   return res;

   760 }

   761 

   762 

   763 /*

   764 ** `load' and `call' functions (run Lua code)

   765 */

   766 

   767 

   768 #define adjustresults(L,nres) \

   769     { if (nres == LUA_MULTRET && L->top >= L->ci->top) L->ci->top = L->top; }

   770 

   771 

   772 #define checkresults(L,na,nr) \

   773      api_check(L, (nr) == LUA_MULTRET || (L->ci->top - L->top >= (nr) - (na)))

   774 	

   775 

   776 LUA_API void lua_call (lua_State *L, int nargs, int nresults) {

   777   StkId func;

   778   lua_lock(L);

   779   api_checknelems(L, nargs+1);

   780   checkresults(L, nargs, nresults);

   781   func = L->top - (nargs+1);

   782   luaD_call(L, func, nresults);

   783   adjustresults(L, nresults);

   784   lua_unlock(L);

   785 }

   786 

   787 

   788 

   789 /*

   790 ** Execute a protected call.

   791 */

   792 struct CallS {  /* data to `f_call' */

   793   StkId func;

   794   int nresults;

   795 };

   796 

   797 

   798 static void f_call (lua_State *L, void *ud) {

   799   struct CallS *c = cast(struct CallS *, ud);

   800   luaD_call(L, c->func, c->nresults);

   801 }

   802 

   803 

   804 

   805 LUA_API int lua_pcall (lua_State *L, int nargs, int nresults, int errfunc) {

   806   struct CallS c;

   807   int status;

   808   ptrdiff_t func;

   809   lua_lock(L);

   810   api_checknelems(L, nargs+1);

   811   checkresults(L, nargs, nresults);

   812   if (errfunc == 0)

   813     func = 0;

   814   else {

   815     StkId o = index2adr(L, errfunc);

   816     api_checkvalidindex(L, o);

   817     func = savestack(L, o);

   818   }

   819   c.func = L->top - (nargs+1);  /* function to be called */

   820   c.nresults = nresults;

   821   status = luaD_pcall(L, f_call, &c, savestack(L, c.func), func);

   822   adjustresults(L, nresults);

   823   lua_unlock(L);

   824   return status;

   825 }

   826 

   827 

   828 /*

   829 ** Execute a protected C call.

   830 */

   831 struct CCallS {  /* data to `f_Ccall' */

   832   lua_CFunction func;

   833   void *ud;

   834 };

   835 

   836 

   837 static void f_Ccall (lua_State *L, void *ud) {

   838   struct CCallS *c = cast(struct CCallS *, ud);

   839   Closure *cl;

   840   cl = luaF_newCclosure(L, 0, getcurrenv(L));

   841   cl->c.f = c->func;

   842   setclvalue(L, L->top, cl);  /* push function */

   843   api_incr_top(L);

   844   setpvalue(L->top, c->ud);  /* push only argument */

   845   api_incr_top(L);

   846   luaD_call(L, L->top - 2, 0);

   847 }

   848 

   849 

   850 LUA_API int lua_cpcall (lua_State *L, lua_CFunction func, void *ud) {

   851   struct CCallS c;

   852   int status;

   853   lua_lock(L);

   854   c.func = func;

   855   c.ud = ud;

   856   status = luaD_pcall(L, f_Ccall, &c, savestack(L, L->top), 0);

   857   lua_unlock(L);

   858   return status;

   859 }

   860 

   861 

   862 LUA_API int lua_load (lua_State *L, lua_Reader reader, void *data,

   863                       const char *chunkname) {

   864   ZIO z;

   865   int status;

   866   lua_lock(L);

   867   if (!chunkname) chunkname = "?";

   868   luaZ_init(L, &z, reader, data);

   869   status = luaD_protectedparser(L, &z, chunkname);

   870   lua_unlock(L);

   871   return status;

   872 }

   873 

   874 

   875 LUA_API int lua_dump (lua_State *L, lua_Writer writer, void *data) {

   876   int status;

   877   TValue *o;

   878   lua_lock(L);

   879   api_checknelems(L, 1);

   880   o = L->top - 1;

   881   if (isLfunction(o))

   882     status = luaU_dump(L, clvalue(o)->l.p, writer, data, 0);

   883   else

   884     status = 1;

   885   lua_unlock(L);

   886   return status;

   887 }

   888 

   889 

   890 LUA_API int  lua_status (lua_State *L) {

   891   return L->status;

   892 }

   893 

   894 

   895 /*

   896 ** Garbage-collection function

   897 */

   898 

   899 LUA_API int lua_gc (lua_State *L, int what, int data) {

   900   int res = 0;

   901   global_State *g;

   902   lua_lock(L);

   903   g = G(L);

   904   switch (what) {

   905     case LUA_GCSTOP: {

   906       g->GCthreshold = MAX_LUMEM;

   907       break;

   908     }

   909     case LUA_GCRESTART: {

   910       g->GCthreshold = g->totalbytes;

   911       break;

   912     }

   913     case LUA_GCCOLLECT: {

   914       luaC_fullgc(L);

   915       break;

   916     }

   917     case LUA_GCCOUNT: {

   918       /* GC values are expressed in Kbytes: #bytes/2^10 */

   919       res = cast_int(g->totalbytes >> 10);

   920       break;

   921     }

   922     case LUA_GCCOUNTB: {

   923       res = cast_int(g->totalbytes & 0x3ff);

   924       break;

   925     }

   926     case LUA_GCSTEP: {

   927       lu_mem a = (cast(lu_mem, data) << 10);

   928       if (a <= g->totalbytes)

   929         g->GCthreshold = g->totalbytes - a;

   930       else

   931         g->GCthreshold = 0;

   932       while (g->GCthreshold <= g->totalbytes) {

   933         luaC_step(L);

   934         if (g->gcstate == GCSpause) {  /* end of cycle? */

   935           res = 1;  /* signal it */

   936           break;

   937         }

   938       }

   939       break;

   940     }

   941     case LUA_GCSETPAUSE: {

   942       res = g->gcpause;

   943       g->gcpause = data;

   944       break;

   945     }

   946     case LUA_GCSETSTEPMUL: {

   947       res = g->gcstepmul;

   948       g->gcstepmul = data;

   949       break;

   950     }

   951     default: res = -1;  /* invalid option */

   952   }

   953   lua_unlock(L);

   954   return res;

   955 }

   956 

   957 

   958 

   959 /*

   960 ** miscellaneous functions

   961 */

   962 

   963 

   964 LUA_API int lua_error (lua_State *L) {

   965   lua_lock(L);

   966   api_checknelems(L, 1);

   967   luaG_errormsg(L);

   968   lua_unlock(L);

   969   return 0;  /* to avoid warnings */

   970 }

   971 

   972 

   973 LUA_API int lua_next (lua_State *L, int idx) {

   974   StkId t;

   975   int more;

   976   lua_lock(L);

   977   t = index2adr(L, idx);

   978   api_check(L, ttistable(t));

   979   more = luaH_next(L, hvalue(t), L->top - 1);

   980   if (more) {

   981     api_incr_top(L);

   982   }

   983   else  /* no more elements */

   984     L->top -= 1;  /* remove key */

   985   lua_unlock(L);

   986   return more;

   987 }

   988 

   989 

   990 LUA_API void lua_concat (lua_State *L, int n) {

   991   lua_lock(L);

   992   api_checknelems(L, n);

   993   if (n >= 2) {

   994     luaC_checkGC(L);

   995     luaV_concat(L, n, cast_int(L->top - L->base) - 1);

   996     L->top -= (n-1);

   997   }

   998   else if (n == 0) {  /* push empty string */

   999     setsvalue2s(L, L->top, luaS_newlstr(L, "", 0));

  1000     api_incr_top(L);

  1001   }

  1002   /* else n == 1; nothing to do */

  1003   lua_unlock(L);

  1004 }

  1005 

  1006 

  1007 LUA_API lua_Alloc lua_getallocf (lua_State *L, void **ud) {

  1008   lua_Alloc f;

  1009   lua_lock(L);

  1010   if (ud) *ud = G(L)->ud;

  1011   f = G(L)->frealloc;

  1012   lua_unlock(L);

  1013   return f;

  1014 }

  1015 

  1016 

  1017 LUA_API void lua_setallocf (lua_State *L, lua_Alloc f, void *ud) {

  1018   lua_lock(L);

  1019   G(L)->ud = ud;

  1020   G(L)->frealloc = f;

  1021   lua_unlock(L);

  1022 }

  1023 

  1024 

  1025 LUA_API void *lua_newuserdata (lua_State *L, size_t size) {

  1026   Udata *u;

  1027   lua_lock(L);

  1028   luaC_checkGC(L);

  1029   u = luaS_newudata(L, size, getcurrenv(L));

  1030   setuvalue(L, L->top, u);

  1031   api_incr_top(L);

  1032   lua_unlock(L);

  1033   return u + 1;

  1034 }

  1035 

  1036 

  1037 

  1038 

  1039 static const char *aux_upvalue (StkId fi, int n, TValue **val) {

  1040   Closure *f;

  1041   if (!ttisfunction(fi)) return NULL;

  1042   f = clvalue(fi);

  1043   if (f->c.isC) {

  1044     if (!(1 <= n && n <= f->c.nupvalues)) return NULL;

  1045     *val = &f->c.upvalue[n-1];

  1046     return "";

  1047   }

  1048   else {

  1049     Proto *p = f->l.p;

  1050     if (!(1 <= n && n <= p->sizeupvalues)) return NULL;

  1051     *val = f->l.upvals[n-1]->v;

  1052     return getstr(p->upvalues[n-1]);

  1053   }

  1054 }

  1055 

  1056 

  1057 LUA_API const char *lua_getupvalue (lua_State *L, int funcindex, int n) {

  1058   const char *name;

  1059   TValue *val;

  1060   lua_lock(L);

  1061   name = aux_upvalue(index2adr(L, funcindex), n, &val);

  1062   if (name) {

  1063     setobj2s(L, L->top, val);

  1064     api_incr_top(L);

  1065   }

  1066   lua_unlock(L);

  1067   return name;

  1068 }

  1069 

  1070 

  1071 LUA_API const char *lua_setupvalue (lua_State *L, int funcindex, int n) {

  1072   const char *name;

  1073   TValue *val;

  1074   StkId fi;

  1075   lua_lock(L);

  1076   fi = index2adr(L, funcindex);

  1077   api_checknelems(L, 1);

  1078   name = aux_upvalue(fi, n, &val);

  1079   if (name) {

  1080     L->top--;

  1081     setobj(L, val, L->top);

  1082     luaC_barrier(L, clvalue(fi), L->top);

  1083   }

  1084   lua_unlock(L);

  1085   return name;

  1086 }

  1087
author	Robert McIntyre <rlm@mit.edu>
date	Mon, 02 Apr 2012 23:13:49 -0500
parents	27763b933818
children