src/lbuiltin.c

   1 /*
   2 ** $Id: lbuiltin.c,v 1.32 1998/06/29 18:24:06 roberto Exp $
   3 ** Built-in functions
   4 ** See Copyright Notice in lua.h
   5 */
   6
   7
   8 #include <ctype.h>
   9 #include <stdio.h>
  10 #include <stdlib.h>
  11 #include <string.h>
  12
  13 #include "lapi.h"
  14 #include "lauxlib.h"
  15 #include "lbuiltin.h"
  16 #include "ldo.h"
  17 #include "lfunc.h"
  18 #include "lmem.h"
  19 #include "lobject.h"
  20 #include "lstate.h"
  21 #include "lstring.h"
  22 #include "ltable.h"
  23 #include "ltm.h"
  24 #include "lua.h"
  25 #include "lundump.h"
  26
  27
  28
  29 static void pushstring (TaggedString *s)
  30 {
  31   TObject o;
  32   o.ttype = LUA_T_STRING;
  33   o.value.ts = s;
  34   luaA_pushobject(&o);
  35 }
  36
  37
  38 static void nextvar (void)
  39 {
  40   TObject *o = luaA_Address(luaL_nonnullarg(1));
  41   TaggedString *g;
  42   if (ttype(o) == LUA_T_NIL)
  43     g = (TaggedString *)L->rootglobal.next;
  44   else {
  45     luaL_arg_check(ttype(o) == LUA_T_STRING, 1, "variable name expected");
  46     g = tsvalue(o);
  47     /* check whether name is in global var list */
  48     luaL_arg_check((GCnode *)g != g->head.next, 1, "variable name expected");
  49     g = (TaggedString *)g->head.next;
  50   }
  51   while (g && g->u.s.globalval.ttype == LUA_T_NIL)  /* skip globals with nil */
  52     g = (TaggedString *)g->head.next;
  53   if (g) {
  54     pushstring(g);
  55     luaA_pushobject(&g->u.s.globalval);
  56   }
  57   else lua_pushnil();
  58 }
  59
  60
  61 static void foreachvar (void)
  62 {
  63   TObject f = *luaA_Address(luaL_functionarg(1));
  64   GCnode *g;
  65   StkId name = L->Cstack.base++;  /* place to keep var name (to avoid GC) */
  66   ttype(L->stack.stack+name) = LUA_T_NIL;
  67   L->stack.top++;
  68   for (g = L->rootglobal.next; g; g = g->next) {
  69     TaggedString *s = (TaggedString *)g;
  70     if (s->u.s.globalval.ttype != LUA_T_NIL) {
  71       ttype(L->stack.stack+name) = LUA_T_STRING;
  72       tsvalue(L->stack.stack+name) = s;  /* keep s on stack to avoid GC */
  73       luaA_pushobject(&f);
  74       pushstring(s);
  75       luaA_pushobject(&s->u.s.globalval);
  76       luaD_call((L->stack.top-L->stack.stack)-2, 1);
  77       if (ttype(L->stack.top-1) != LUA_T_NIL)
  78         return;
  79       L->stack.top--;
  80     }
  81   }
  82 }
  83
  84
  85 static void next (void)
  86 {
  87   lua_Object o = luaL_tablearg(1);
  88   lua_Object r = luaL_nonnullarg(2);
  89   Node *n = luaH_next(luaA_Address(o), luaA_Address(r));
  90   if (n) {
  91     luaA_pushobject(&n->ref);
  92     luaA_pushobject(&n->val);
  93   }
  94   else lua_pushnil();
  95 }
  96
  97
  98 static void foreach (void)
  99 {
 100   TObject t = *luaA_Address(luaL_tablearg(1));
 101   TObject f = *luaA_Address(luaL_functionarg(2));
 102   int i;
 103   for (i=0; i<avalue(&t)->nhash; i++) {
 104     Node *nd = &(avalue(&t)->node[i]);
 105     if (ttype(ref(nd)) != LUA_T_NIL && ttype(val(nd)) != LUA_T_NIL) {
 106       luaA_pushobject(&f);
 107       luaA_pushobject(ref(nd));
 108       luaA_pushobject(val(nd));
 109       luaD_call((L->stack.top-L->stack.stack)-2, 1);
 110       if (ttype(L->stack.top-1) != LUA_T_NIL)
 111         return;
 112       L->stack.top--;
 113     }
 114   }
 115 }
 116
 117
 118 static void internaldostring (void)
 119 {
 120   long l;
 121   char *s = luaL_check_lstr(1, &l);
 122   if (*s == ID_CHUNK)
 123     lua_error("`dostring' cannot run pre-compiled code");
 124   if (lua_dobuffer(s, l, luaL_opt_string(2, NULL)) == 0)
 125     if (luaA_passresults() == 0)
 126       lua_pushuserdata(NULL);  /* at least one result to signal no errors */
 127 }
 128
 129
 130 static void internaldofile (void)
 131 {
 132   char *fname = luaL_opt_string(1, NULL);
 133   if (lua_dofile(fname) == 0)
 134     if (luaA_passresults() == 0)
 135       lua_pushuserdata(NULL);  /* at least one result to signal no errors */
 136 }
 137
 138
 139 static void to_string (void) {
 140   lua_Object obj = lua_getparam(1);
 141   char *buff = luaL_openspace(30);
 142   TObject *o = luaA_Address(obj);
 143   switch (ttype(o)) {
 144     case LUA_T_NUMBER:
 145       lua_pushstring(lua_getstring(obj));
 146       return;
 147     case LUA_T_STRING:
 148       lua_pushobject(obj);
 149       return;
 150     case LUA_T_ARRAY: {
 151       sprintf(buff, "table: %p", (void *)o->value.a);
 152       break;
 153     }
 154     case LUA_T_CLOSURE: {
 155       sprintf(buff, "function: %p", (void *)o->value.cl);
 156       break;
 157     }
 158     case LUA_T_PROTO: {
 159       sprintf(buff, "function: %p", (void *)o->value.tf);
 160       break;
 161     }
 162     case LUA_T_CPROTO: {
 163       sprintf(buff, "function: %p", (void *)o->value.f);
 164       break;
 165     }
 166     case LUA_T_USERDATA: {
 167       sprintf(buff, "userdata: %p", o->value.ts->u.d.v);
 168       break;
 169     }
 170     case LUA_T_NIL:
 171       lua_pushstring("nil");
 172       return;
 173     default:
 174       LUA_INTERNALERROR("invalid type");
 175   }
 176   lua_pushstring(buff);
 177 }
 178
 179
 180 static void luaI_print (void) {
 181   TaggedString *ts = luaS_new("tostring");
 182   lua_Object obj;
 183   int i = 1;
 184   while ((obj = lua_getparam(i++)) != LUA_NOOBJECT) {
 185     luaA_pushobject(&ts->u.s.globalval);
 186     lua_pushobject(obj);
 187     luaD_call((L->stack.top-L->stack.stack)-1, 1);
 188     if (ttype(L->stack.top-1) != LUA_T_STRING)
 189       lua_error("`tostring' must return a string to `print'");
 190     printf("%s\t", svalue(L->stack.top-1));
 191     L->stack.top--;
 192   }
 193   printf("\n");
 194 }
 195
 196
 197 static void luaI_type (void)
 198 {
 199   lua_Object o = luaL_nonnullarg(1);
 200   lua_pushstring(luaO_typenames[-ttype(luaA_Address(o))]);
 201   lua_pushnumber(lua_tag(o));
 202 }
 203
 204
 205 static void tonumber (void)
 206 {
 207   int base = luaL_opt_number(2, 10);
 208   if (base == 10) {  /* standard conversion */
 209     lua_Object o = lua_getparam(1);
 210     if (lua_isnumber(o))
 211       lua_pushnumber(lua_getnumber(o));
 212   }
 213   else {
 214     char *s = luaL_check_string(1);
 215     unsigned long n;
 216     luaL_arg_check(0 <= base && base <= 36, 2, "base out of range");
 217     n = strtol(s, &s, base);
 218     while (isspace(*s)) s++;  /* skip trailing spaces */
 219     if (*s) lua_pushnil();  /* invalid format: return nil */
 220     else lua_pushnumber(n);
 221   }
 222 }
 223
 224
 225 static void luaI_error (void)
 226 {
 227   lua_error(lua_getstring(lua_getparam(1)));
 228 }
 229
 230
 231 static void luaI_assert (void)
 232 {
 233   lua_Object p = lua_getparam(1);
 234   if (p == LUA_NOOBJECT || lua_isnil(p))
 235     luaL_verror("assertion failed!  %.100s", luaL_opt_string(2, ""));
 236 }
 237
 238
 239 static void setglobal (void)
 240 {
 241   char *n = luaL_check_string(1);
 242   lua_Object value = luaL_nonnullarg(2);
 243   lua_pushobject(value);
 244   lua_setglobal(n);
 245   lua_pushobject(value);  /* return given value */
 246 }
 247
 248 static void rawsetglobal (void)
 249 {
 250   char *n = luaL_check_string(1);
 251   lua_Object value = luaL_nonnullarg(2);
 252   lua_pushobject(value);
 253   lua_rawsetglobal(n);
 254   lua_pushobject(value);  /* return given value */
 255 }
 256
 257 static void getglobal (void)
 258 {
 259   lua_pushobject(lua_getglobal(luaL_check_string(1)));
 260 }
 261
 262 static void rawgetglobal (void)
 263 {
 264   lua_pushobject(lua_rawgetglobal(luaL_check_string(1)));
 265 }
 266
 267 static void luatag (void)
 268 {
 269   lua_pushnumber(lua_tag(lua_getparam(1)));
 270 }
 271
 272
 273 static int getnarg (lua_Object table)
 274 {
 275   lua_Object temp;
 276   /* temp = table.n */
 277   lua_pushobject(table); lua_pushstring("n"); temp = lua_rawgettable();
 278   return (lua_isnumber(temp) ? lua_getnumber(temp) : MAX_INT);
 279 }
 280
 281 static void luaI_call (void)
 282 {
 283   lua_Object f = luaL_nonnullarg(1);
 284   lua_Object arg = luaL_tablearg(2);
 285   char *options = luaL_opt_string(3, "");
 286   lua_Object err = lua_getparam(4);
 287   int narg = getnarg(arg);
 288   int i, status;
 289   if (err != LUA_NOOBJECT) {  /* set new error method */
 290     lua_pushobject(err);
 291     err = lua_seterrormethod();
 292   }
 293   /* push arg[1...n] */
 294   for (i=0; i<narg; i++) {
 295     lua_Object temp;
 296     /* temp = arg[i+1] */
 297     lua_pushobject(arg); lua_pushnumber(i+1); temp = lua_rawgettable();
 298     if (narg == MAX_INT && lua_isnil(temp))
 299       break;
 300     lua_pushobject(temp);
 301   }
 302   status = lua_callfunction(f);
 303   if (err != LUA_NOOBJECT) {  /* restore old error method */
 304     lua_pushobject(err);
 305     lua_seterrormethod();
 306   }
 307   if (status != 0) {  /* error in call? */
 308     if (strchr(options, 'x')) {
 309       lua_pushnil();
 310       return;  /* return nil to signal the error */
 311     }
 312     else
 313       lua_error(NULL);
 314   }
 315   else { /* no errors */
 316     if (strchr(options, 'p'))
 317       luaA_packresults();
 318     else
 319       luaA_passresults();
 320   }
 321 }
 322
 323
 324 static void settag (void)
 325 {
 326   lua_Object o = luaL_tablearg(1);
 327   lua_pushobject(o);
 328   lua_settag(luaL_check_number(2));
 329   lua_pushobject(o);  /* returns first argument */
 330 }
 331
 332
 333 static void newtag (void)
 334 {
 335   lua_pushnumber(lua_newtag());
 336 }
 337
 338
 339 static void copytagmethods (void)
 340 {
 341   lua_pushnumber(lua_copytagmethods(luaL_check_number(1),
 342                                     luaL_check_number(2)));
 343 }
 344
 345
 346 static void rawgettable (void)
 347 {
 348   lua_pushobject(luaL_nonnullarg(1));
 349   lua_pushobject(luaL_nonnullarg(2));
 350   lua_pushobject(lua_rawgettable());
 351 }
 352
 353
 354 static void rawsettable (void)
 355 {
 356   lua_pushobject(luaL_nonnullarg(1));
 357   lua_pushobject(luaL_nonnullarg(2));
 358   lua_pushobject(luaL_nonnullarg(3));
 359   lua_rawsettable();
 360 }
 361
 362
 363 static void settagmethod (void)
 364 {
 365   lua_Object nf = luaL_nonnullarg(3);
 366   lua_pushobject(nf);
 367   lua_pushobject(lua_settagmethod((int)luaL_check_number(1),
 368                                   luaL_check_string(2)));
 369 }
 370
 371
 372 static void gettagmethod (void)
 373 {
 374   lua_pushobject(lua_gettagmethod((int)luaL_check_number(1),
 375                                   luaL_check_string(2)));
 376 }
 377
 378
 379 static void seterrormethod (void)
 380 {
 381   lua_Object nf = luaL_functionarg(1);
 382   lua_pushobject(nf);
 383   lua_pushobject(lua_seterrormethod());
 384 }
 385
 386
 387 static void luaI_collectgarbage (void)
 388 {
 389   lua_pushnumber(lua_collectgarbage(luaL_opt_number(1, 0)));
 390 }
 391
 392
 393 /*
 394 ** =======================================================
 395 ** some DEBUG functions
 396 ** =======================================================
 397 */
 398 #ifdef DEBUG
 399
 400 static void mem_query (void)
 401 {
 402   lua_pushnumber(totalmem);
 403   lua_pushnumber(numblocks);
 404 }
 405
 406
 407 static void countlist (void)
 408 {
 409   char *s = luaL_check_string(1);
 410   GCnode *l = (s[0]=='t') ? L->roottable.next : (s[0]=='c') ? L->rootcl.next :
 411               (s[0]=='p') ? L->rootproto.next : L->rootglobal.next;
 412   int i=0;
 413   while (l) {
 414     i++;
 415     l = l->next;
 416   }
 417   lua_pushnumber(i);
 418 }
 419
 420
 421 static void testC (void)
 422 {
 423 #define getnum(s)       ((*s++) - '0')
 424 #define getname(s)      (nome[0] = *s++, nome)
 425
 426   static int locks[10];
 427   lua_Object reg[10];
 428   char nome[2];
 429   char *s = luaL_check_string(1);
 430   nome[1] = 0;
 431   while (1) {
 432     switch (*s++) {
 433       case '0': case '1': case '2': case '3': case '4':
 434       case '5': case '6': case '7': case '8': case '9':
 435         lua_pushnumber(*(s-1) - '0');
 436         break;
 437
 438       case 'c': reg[getnum(s)] = lua_createtable(); break;
 439       case 'C': { lua_CFunction f = lua_getcfunction(lua_getglobal(getname(s)));
 440                   lua_pushcclosure(f, getnum(s));
 441                   break;
 442                 }
 443       case 'P': reg[getnum(s)] = lua_pop(); break;
 444       case 'g': { int n=getnum(s); reg[n]=lua_getglobal(getname(s)); break; }
 445       case 'G': { int n = getnum(s);
 446                   reg[n] = lua_rawgetglobal(getname(s));
 447                   break;
 448                 }
 449       case 'l': locks[getnum(s)] = lua_ref(1); break;
 450       case 'L': locks[getnum(s)] = lua_ref(0); break;
 451       case 'r': { int n=getnum(s); reg[n]=lua_getref(locks[getnum(s)]); break; }
 452       case 'u': lua_unref(locks[getnum(s)]); break;
 453       case 'p': { int n = getnum(s); reg[n] = lua_getparam(getnum(s)); break; }
 454       case '=': lua_setglobal(getname(s)); break;
 455       case 's': lua_pushstring(getname(s)); break;
 456       case 'o': lua_pushobject(reg[getnum(s)]); break;
 457       case 'f': (lua_call)(getname(s)); break;
 458       case 'i': reg[getnum(s)] = lua_gettable(); break;
 459       case 'I': reg[getnum(s)] = lua_rawgettable(); break;
 460       case 't': lua_settable(); break;
 461       case 'T': lua_rawsettable(); break;
 462       default: luaL_verror("unknown command in `testC': %c", *(s-1));
 463     }
 464   if (*s == 0) return;
 465   if (*s++ != ' ') lua_error("missing ` ' between commands in `testC'");
 466   }
 467 }
 468
 469 #endif
 470
 471
 472 /*
 473 ** Internal functions
 474 */
 475 static struct luaL_reg int_funcs[] = {
 476 #ifdef LUA_COMPAT2_5
 477   {"setfallback", luaT_setfallback},
 478 #endif
 479 #ifdef DEBUG
 480   {"testC", testC},
 481   {"totalmem", mem_query},
 482   {"count", countlist},
 483 #endif
 484   {"assert", luaI_assert},
 485   {"call", luaI_call},
 486   {"collectgarbage", luaI_collectgarbage},
 487   {"dofile", internaldofile},
 488   {"copytagmethods", copytagmethods},
 489   {"dostring", internaldostring},
 490   {"error", luaI_error},
 491   {"foreach", foreach},
 492   {"foreachvar", foreachvar},
 493   {"getglobal", getglobal},
 494   {"newtag", newtag},
 495   {"next", next},
 496   {"nextvar", nextvar},
 497   {"print", luaI_print},
 498   {"rawgetglobal", rawgetglobal},
 499   {"rawgettable", rawgettable},
 500   {"rawsetglobal", rawsetglobal},
 501   {"rawsettable", rawsettable},
 502   {"seterrormethod", seterrormethod},
 503   {"setglobal", setglobal},
 504   {"settagmethod", settagmethod},
 505   {"gettagmethod", gettagmethod},
 506   {"settag", settag},
 507   {"tonumber", tonumber},
 508   {"tostring", to_string},
 509   {"tag", luatag},
 510   {"type", luaI_type}
 511 };
 512
 513
 514 #define INTFUNCSIZE (sizeof(int_funcs)/sizeof(int_funcs[0]))
 515
 516
 517 void luaB_predefine (void)
 518 {
 519   /* pre-register mem error messages, to avoid loop when error arises */
 520   luaS_newfixedstring(tableEM);
 521   luaS_newfixedstring(memEM);
 522   luaL_openlib(int_funcs, (sizeof(int_funcs)/sizeof(int_funcs[0])));
 523   lua_pushstring(LUA_VERSION);
 524   lua_setglobal("_VERSION");
 525 }
 526