src/lapi.c

   1 /*
   2 ** $Id: lapi.c,v 1.47 1999/06/22 20:37:23 roberto Exp $
   3 ** Lua API
   4 ** See Copyright Notice in lua.h
   5 */
   6
   7
   8 #include <stdlib.h>
   9 #include <string.h>
  10
  11 #include "lapi.h"
  12 #include "lauxlib.h"
  13 #include "ldo.h"
  14 #include "lfunc.h"
  15 #include "lgc.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 "luadebug.h"
  24 #include "lvm.h"
  25
  26
  27 char lua_ident[] = "$Lua: " LUA_VERSION " " LUA_COPYRIGHT " $\n"
  28                    "$Authors:  " LUA_AUTHORS " $";
  29
  30
  31
  32 TObject *luaA_Address (lua_Object o) {
  33   return (o != LUA_NOOBJECT) ?  Address(o) : NULL;
  34 }
  35
  36
  37 static lua_Type normalized_type (TObject *o)
  38 {
  39   int t = ttype(o);
  40   switch (t) {
  41     case LUA_T_PMARK:
  42       return LUA_T_PROTO;
  43     case LUA_T_CMARK:
  44       return LUA_T_CPROTO;
  45     case LUA_T_CLMARK:
  46       return LUA_T_CLOSURE;
  47     default:
  48       return t;
  49   }
  50 }
  51
  52
  53 static void set_normalized (TObject *d, TObject *s)
  54 {
  55   d->value = s->value;
  56   d->ttype = normalized_type(s);
  57 }
  58
  59
  60 static TObject *luaA_protovalue (TObject *o)
  61 {
  62   return (normalized_type(o) == LUA_T_CLOSURE) ?  protovalue(o) : o;
  63 }
  64
  65
  66 void luaA_packresults (void)
  67 {
  68   luaV_pack(L->Cstack.lua2C, L->Cstack.num, L->stack.top);
  69   incr_top;
  70 }
  71
  72
  73 int luaA_passresults (void) {
  74   L->Cstack.base = L->Cstack.lua2C;  /* position of first result */
  75   return L->Cstack.num;
  76 }
  77
  78
  79 static void checkCparams (int nParams)
  80 {
  81   if (L->stack.top-L->stack.stack < L->Cstack.base+nParams)
  82     lua_error("API error - wrong number of arguments in C2lua stack");
  83 }
  84
  85
  86 static lua_Object put_luaObject (TObject *o) {
  87   luaD_openstack((L->stack.top-L->stack.stack)-L->Cstack.base);
  88   L->stack.stack[L->Cstack.base++] = *o;
  89   return L->Cstack.base;  /* this is +1 real position (see Ref) */
  90 }
  91
  92
  93 static lua_Object put_luaObjectonTop (void) {
  94   luaD_openstack((L->stack.top-L->stack.stack)-L->Cstack.base);
  95   L->stack.stack[L->Cstack.base++] = *(--L->stack.top);
  96   return L->Cstack.base;  /* this is +1 real position (see Ref) */
  97 }
  98
  99
 100 static void top2LC (int n) {
 101   /* Put the 'n' elements on the top as the Lua2C contents */
 102   L->Cstack.base = (L->stack.top-L->stack.stack);  /* new base */
 103   L->Cstack.lua2C = L->Cstack.base-n;  /* position of the new results */
 104   L->Cstack.num = n;  /* number of results */
 105 }
 106
 107
 108 lua_Object lua_pop (void) {
 109   checkCparams(1);
 110   return put_luaObjectonTop();
 111 }
 112
 113
 114 /*
 115 ** Get a parameter, returning the object handle or LUA_NOOBJECT on error.
 116 ** 'number' must be 1 to get the first parameter.
 117 */
 118 lua_Object lua_lua2C (int number)
 119 {
 120   if (number <= 0 || number > L->Cstack.num) return LUA_NOOBJECT;
 121   /* Ref(L->stack.stack+(L->Cstack.lua2C+number-1)) ==
 122      L->stack.stack+(L->Cstack.lua2C+number-1)-L->stack.stack+1 == */
 123   return L->Cstack.lua2C+number;
 124 }
 125
 126
 127 int lua_callfunction (lua_Object function)
 128 {
 129   if (function == LUA_NOOBJECT)
 130     return 1;
 131   else {
 132     luaD_openstack((L->stack.top-L->stack.stack)-L->Cstack.base);
 133     set_normalized(L->stack.stack+L->Cstack.base, Address(function));
 134     return luaD_protectedrun();
 135   }
 136 }
 137
 138
 139 lua_Object lua_gettagmethod (int tag, char *event)
 140 {
 141   return put_luaObject(luaT_gettagmethod(tag, event));
 142 }
 143
 144
 145 lua_Object lua_settagmethod (int tag, char *event)
 146 {
 147   checkCparams(1);
 148   luaT_settagmethod(tag, event, L->stack.top-1);
 149   return put_luaObjectonTop();
 150 }
 151
 152
 153 lua_Object lua_seterrormethod (void) {
 154   lua_Object temp;
 155   checkCparams(1);
 156   temp = lua_getglobal("_ERRORMESSAGE");
 157   lua_setglobal("_ERRORMESSAGE");
 158   return temp;
 159 }
 160
 161
 162 lua_Object lua_gettable (void)
 163 {
 164   checkCparams(2);
 165   luaV_gettable();
 166   return put_luaObjectonTop();
 167 }
 168
 169
 170 lua_Object lua_rawgettable (void) {
 171   checkCparams(2);
 172   if (ttype(L->stack.top-2) != LUA_T_ARRAY)
 173     lua_error("indexed expression not a table in rawgettable");
 174   *(L->stack.top-2) = *luaH_get(avalue(L->stack.top-2), L->stack.top-1);
 175   --L->stack.top;
 176   return put_luaObjectonTop();
 177 }
 178
 179
 180 void lua_settable (void) {
 181   checkCparams(3);
 182   luaV_settable(L->stack.top-3);
 183   L->stack.top -= 2;  /* pop table and index */
 184 }
 185
 186
 187 void lua_rawsettable (void) {
 188   checkCparams(3);
 189   luaV_rawsettable(L->stack.top-3);
 190 }
 191
 192
 193 lua_Object lua_createtable (void)
 194 {
 195   TObject o;
 196   luaC_checkGC();
 197   avalue(&o) = luaH_new(0);
 198   ttype(&o) = LUA_T_ARRAY;
 199   return put_luaObject(&o);
 200 }
 201
 202
 203 lua_Object lua_getglobal (char *name)
 204 {
 205   luaD_checkstack(2);  /* may need that to call T.M. */
 206   luaV_getglobal(luaS_new(name));
 207   return put_luaObjectonTop();
 208 }
 209
 210
 211 lua_Object lua_rawgetglobal (char *name)
 212 {
 213   TaggedString *ts = luaS_new(name);
 214   return put_luaObject(&ts->u.s.globalval);
 215 }
 216
 217
 218 void lua_setglobal (char *name)
 219 {
 220   checkCparams(1);
 221   luaD_checkstack(2);  /* may need that to call T.M. */
 222   luaV_setglobal(luaS_new(name));
 223 }
 224
 225
 226 void lua_rawsetglobal (char *name)
 227 {
 228   TaggedString *ts = luaS_new(name);
 229   checkCparams(1);
 230   luaS_rawsetglobal(ts, --L->stack.top);
 231 }
 232
 233
 234
 235 int lua_isnil (lua_Object o)
 236 {
 237   return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_NIL);
 238 }
 239
 240 int lua_istable (lua_Object o)
 241 {
 242   return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_ARRAY);
 243 }
 244
 245 int lua_isuserdata (lua_Object o)
 246 {
 247   return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_USERDATA);
 248 }
 249
 250 int lua_iscfunction (lua_Object o)
 251 {
 252   return (lua_tag(o) == LUA_T_CPROTO);
 253 }
 254
 255 int lua_isnumber (lua_Object o)
 256 {
 257   return (o!= LUA_NOOBJECT) && (tonumber(Address(o)) == 0);
 258 }
 259
 260 int lua_isstring (lua_Object o)
 261 {
 262   int t = lua_tag(o);
 263   return (t == LUA_T_STRING) || (t == LUA_T_NUMBER);
 264 }
 265
 266 int lua_isfunction (lua_Object o)
 267 {
 268   int t = lua_tag(o);
 269   return (t == LUA_T_PROTO) || (t == LUA_T_CPROTO);
 270 }
 271
 272
 273 double lua_getnumber (lua_Object object)
 274 {
 275  if (object == LUA_NOOBJECT) return 0.0;
 276  if (tonumber(Address(object))) return 0.0;
 277  else return (nvalue(Address(object)));
 278 }
 279
 280 char *lua_getstring (lua_Object object)
 281 {
 282   luaC_checkGC();  /* "tostring" may create a new string */
 283   if (object == LUA_NOOBJECT || tostring(Address(object)))
 284     return NULL;
 285   else return (svalue(Address(object)));
 286 }
 287
 288 long lua_strlen (lua_Object object)
 289 {
 290   luaC_checkGC();  /* "tostring" may create a new string */
 291   if (object == LUA_NOOBJECT || tostring(Address(object)))
 292     return 0L;
 293   else return (tsvalue(Address(object))->u.s.len);
 294 }
 295
 296 void *lua_getuserdata (lua_Object object)
 297 {
 298   if (object == LUA_NOOBJECT || ttype(Address(object)) != LUA_T_USERDATA)
 299     return NULL;
 300   else return tsvalue(Address(object))->u.d.v;
 301 }
 302
 303 lua_CFunction lua_getcfunction (lua_Object object)
 304 {
 305   if (!lua_iscfunction(object))
 306     return NULL;
 307   else return fvalue(luaA_protovalue(Address(object)));
 308 }
 309
 310
 311 void lua_pushnil (void)
 312 {
 313   ttype(L->stack.top) = LUA_T_NIL;
 314   incr_top;
 315 }
 316
 317 void lua_pushnumber (double n)
 318 {
 319   ttype(L->stack.top) = LUA_T_NUMBER;
 320   nvalue(L->stack.top) = n;
 321   incr_top;
 322 }
 323
 324 void lua_pushlstring (char *s, long len)
 325 {
 326   tsvalue(L->stack.top) = luaS_newlstr(s, len);
 327   ttype(L->stack.top) = LUA_T_STRING;
 328   incr_top;
 329   luaC_checkGC();
 330 }
 331
 332 void lua_pushstring (char *s)
 333 {
 334   if (s == NULL)
 335     lua_pushnil();
 336   else
 337     lua_pushlstring(s, strlen(s));
 338 }
 339
 340 void lua_pushcclosure (lua_CFunction fn, int n)
 341 {
 342   if (fn == NULL)
 343     lua_error("API error - attempt to push a NULL Cfunction");
 344   checkCparams(n);
 345   ttype(L->stack.top) = LUA_T_CPROTO;
 346   fvalue(L->stack.top) = fn;
 347   incr_top;
 348   luaV_closure(n);
 349   luaC_checkGC();
 350 }
 351
 352 void lua_pushusertag (void *u, int tag)
 353 {
 354   if (tag < 0 && tag != LUA_ANYTAG)
 355     luaT_realtag(tag);  /* error if tag is not valid */
 356   tsvalue(L->stack.top) = luaS_createudata(u, tag);
 357   ttype(L->stack.top) = LUA_T_USERDATA;
 358   incr_top;
 359   luaC_checkGC();
 360 }
 361
 362 void luaA_pushobject (TObject *o)
 363 {
 364   *L->stack.top = *o;
 365   incr_top;
 366 }
 367
 368 void lua_pushobject (lua_Object o) {
 369   if (o == LUA_NOOBJECT)
 370     lua_error("API error - attempt to push a NOOBJECT");
 371   set_normalized(L->stack.top, Address(o));
 372   incr_top;
 373 }
 374
 375
 376 int lua_tag (lua_Object lo)
 377 {
 378   if (lo == LUA_NOOBJECT)
 379      return LUA_T_NIL;
 380   else {
 381     TObject *o = Address(lo);
 382     int t;
 383     switch (t = ttype(o)) {
 384       case LUA_T_USERDATA:
 385         return o->value.ts->u.d.tag;
 386       case LUA_T_ARRAY:
 387         return o->value.a->htag;
 388       case LUA_T_PMARK:
 389         return LUA_T_PROTO;
 390       case LUA_T_CMARK:
 391         return LUA_T_CPROTO;
 392       case LUA_T_CLOSURE: case LUA_T_CLMARK:
 393         return o->value.cl->consts[0].ttype;
 394 #ifdef DEBUG
 395       case LUA_T_LINE:
 396         LUA_INTERNALERROR("invalid type");
 397 #endif
 398       default:
 399         return t;
 400     }
 401   }
 402 }
 403
 404
 405 void lua_settag (int tag)
 406 {
 407   checkCparams(1);
 408   luaT_realtag(tag);
 409   switch (ttype(L->stack.top-1)) {
 410     case LUA_T_ARRAY:
 411       (L->stack.top-1)->value.a->htag = tag;
 412       break;
 413     case LUA_T_USERDATA:
 414       (L->stack.top-1)->value.ts->u.d.tag = tag;
 415       break;
 416     default:
 417       luaL_verror("cannot change the tag of a %.20s",
 418                   luaO_typename(L->stack.top-1));
 419   }
 420   L->stack.top--;
 421 }
 422
 423
 424 TaggedString *luaA_nextvar (TaggedString *g) {
 425   if (g == NULL)
 426     g = (TaggedString *)L->rootglobal.next;  /* first variable */
 427   else {
 428     /* check whether name is in global var list */
 429     luaL_arg_check((GCnode *)g != g->head.next, 1, "variable name expected");
 430     g = (TaggedString *)g->head.next;  /* get next */
 431   }
 432   while (g && g->u.s.globalval.ttype == LUA_T_NIL)  /* skip globals with nil */
 433     g = (TaggedString *)g->head.next;
 434   if (g) {
 435     ttype(L->stack.top) = LUA_T_STRING; tsvalue(L->stack.top) = g;
 436     incr_top;
 437     luaA_pushobject(&g->u.s.globalval);
 438   }
 439   return g;
 440 }
 441
 442
 443 char *lua_nextvar (char *varname) {
 444   TaggedString *g = (varname == NULL) ? NULL : luaS_new(varname);
 445   g = luaA_nextvar(g);
 446   if (g) {
 447     top2LC(2);
 448     return g->str;
 449   }
 450   else {
 451     top2LC(0);
 452     return NULL;
 453   }
 454 }
 455
 456
 457 int luaA_next (Hash *t, int i) {
 458   int tsize = nhash(t);
 459   for (; i<tsize; i++) {
 460     Node *n = node(t, i);
 461     if (ttype(val(n)) != LUA_T_NIL) {
 462       luaA_pushobject(ref(n));
 463       luaA_pushobject(val(n));
 464       return i+1;  /* index to be used next time */
 465     }
 466   }
 467   return 0;  /* no more elements */
 468 }
 469
 470
 471 int lua_next (lua_Object o, int i) {
 472   TObject *t = Address(o);
 473   if (ttype(t) != LUA_T_ARRAY)
 474     lua_error("API error - object is not a table in `lua_next'");
 475   i = luaA_next(avalue(t), i);
 476   top2LC((i==0) ? 0 : 2);
 477   return i;
 478 }
 479
 480
 481
 482 /*
 483 ** {======================================================
 484 ** To manipulate some state information
 485 ** =======================================================
 486 */
 487
 488 lua_State *lua_setstate (lua_State *st) {
 489   lua_State *old = lua_state;
 490   lua_state = st;
 491   return old;
 492 }
 493
 494 lua_LHFunction lua_setlinehook (lua_LHFunction func) {
 495   lua_LHFunction old = L->linehook;
 496   L->linehook = func;
 497   return old;
 498 }
 499
 500 lua_CHFunction lua_setcallhook (lua_CHFunction func) {
 501   lua_CHFunction old = L->callhook;
 502   L->callhook = func;
 503   return old;
 504 }
 505
 506 int lua_setdebug (int debug) {
 507   int old = L->debug;
 508   L->debug = debug;
 509   return old;
 510 }
 511
 512 /* }====================================================== */
 513
 514
 515 /*
 516 ** {======================================================
 517 ** Debug interface
 518 ** =======================================================
 519 */
 520
 521
 522 lua_Function lua_stackedfunction (int level)
 523 {
 524   StkId i;
 525   for (i = (L->stack.top-1)-L->stack.stack; i>=0; i--) {
 526     int t = L->stack.stack[i].ttype;
 527     if (t == LUA_T_CLMARK || t == LUA_T_PMARK || t == LUA_T_CMARK)
 528       if (level-- == 0)
 529         return Ref(L->stack.stack+i);
 530   }
 531   return LUA_NOOBJECT;
 532 }
 533
 534
 535 int lua_nups (lua_Function func) {
 536   TObject *o = luaA_Address(func);
 537   return (!o || normalized_type(o) != LUA_T_CLOSURE) ? 0 : o->value.cl->nelems;
 538 }
 539
 540
 541 int lua_currentline (lua_Function func)
 542 {
 543   TObject *f = Address(func);
 544   return (f+1 < L->stack.top && (f+1)->ttype == LUA_T_LINE) ?
 545              (f+1)->value.i : -1;
 546 }
 547
 548
 549 lua_Object lua_getlocal (lua_Function func, int local_number, char **name) {
 550   /* check whether func is a Lua function */
 551   if (lua_tag(func) != LUA_T_PROTO)
 552     return LUA_NOOBJECT;
 553   else {
 554     TObject *f = Address(func);
 555     TProtoFunc *fp = luaA_protovalue(f)->value.tf;
 556     *name = luaF_getlocalname(fp, local_number, lua_currentline(func));
 557     if (*name) {
 558       /* if "*name", there must be a LUA_T_LINE */
 559       /* therefore, f+2 points to function base */
 560       return put_luaObject((f+2)+(local_number-1));
 561     }
 562     else
 563       return LUA_NOOBJECT;
 564   }
 565 }
 566
 567
 568 int lua_setlocal (lua_Function func, int local_number)
 569 {
 570   /* check whether func is a Lua function */
 571   if (lua_tag(func) != LUA_T_PROTO)
 572     return 0;
 573   else {
 574     TObject *f = Address(func);
 575     TProtoFunc *fp = luaA_protovalue(f)->value.tf;
 576     char *name = luaF_getlocalname(fp, local_number, lua_currentline(func));
 577     checkCparams(1);
 578     --L->stack.top;
 579     if (name) {
 580       /* if "name", there must be a LUA_T_LINE */
 581       /* therefore, f+2 points to function base */
 582       *((f+2)+(local_number-1)) = *L->stack.top;
 583       return 1;
 584     }
 585     else
 586       return 0;
 587   }
 588 }
 589
 590
 591 void lua_funcinfo (lua_Object func, char **source, int *linedefined) {
 592   if (!lua_isfunction(func))
 593     lua_error("API error - `funcinfo' called with a non-function value");
 594   else {
 595     TObject *f = luaA_protovalue(Address(func));
 596     if (normalized_type(f) == LUA_T_PROTO) {
 597       *source = tfvalue(f)->source->str;
 598       *linedefined = tfvalue(f)->lineDefined;
 599     }
 600     else {
 601       *source = "(C)";
 602       *linedefined = -1;
 603     }
 604   }
 605 }
 606
 607
 608 static int checkfunc (TObject *o)
 609 {
 610   return luaO_equalObj(o, L->stack.top);
 611 }
 612
 613
 614 char *lua_getobjname (lua_Object o, char **name)
 615 { /* try to find a name for given function */
 616   set_normalized(L->stack.top, Address(o)); /* to be accessed by "checkfunc" */
 617   if ((*name = luaS_travsymbol(checkfunc)) != NULL)
 618     return "global";
 619   else if ((*name = luaT_travtagmethods(checkfunc)) != NULL)
 620     return "tag-method";
 621   else return "";
 622 }
 623
 624 /* }====================================================== */
 625
 626
 627 /*
 628 ** {======================================================
 629 ** BLOCK mechanism
 630 ** =======================================================
 631 */
 632
 633
 634 #ifndef MAX_C_BLOCKS
 635 #define MAX_C_BLOCKS    1000  /* arbitrary limit */
 636 #endif
 637
 638
 639 void lua_beginblock (void) {
 640   luaM_growvector(L->Cblocks, L->numCblocks, 1, struct C_Lua_Stack,
 641                   "too many nested blocks", MAX_C_BLOCKS);
 642   L->Cblocks[L->numCblocks] = L->Cstack;
 643   L->numCblocks++;
 644 }
 645
 646 void lua_endblock (void) {
 647   --L->numCblocks;
 648   L->Cstack = L->Cblocks[L->numCblocks];
 649   luaD_adjusttop(L->Cstack.base);
 650 }
 651
 652
 653
 654 int lua_ref (int lock) {
 655   int ref;
 656   checkCparams(1);
 657   ref = luaC_ref(L->stack.top-1, lock);
 658   L->stack.top--;
 659   return ref;
 660 }
 661
 662
 663
 664 lua_Object lua_getref (int ref) {
 665   TObject *o = luaC_getref(ref);
 666   return (o ? put_luaObject(o) : LUA_NOOBJECT);
 667 }
 668
 669 /* }====================================================== */
 670
 671
 672
 673 #ifdef LUA_COMPAT2_5
 674 /*
 675 ** API: set a function as a fallback
 676 */
 677
 678 static void do_unprotectedrun (lua_CFunction f, int nParams, int nResults) {
 679   luaD_openstack(nParams);
 680   (L->stack.top-nParams)->ttype = LUA_T_CPROTO;
 681   (L->stack.top-nParams)->value.f = f;
 682   luaD_calln(nParams, nResults);
 683 }
 684
 685
 686 lua_Object lua_setfallback (char *name, lua_CFunction fallback) {
 687   lua_pushstring(name);
 688   lua_pushcfunction(fallback);
 689   do_unprotectedrun(luaT_setfallback, 2, 1);
 690   return put_luaObjectonTop();
 691 }
 692 #endif
 693