src/ldo.c

   1 /*
   2 ** $Id: ldo.c,v 1.45 1999/06/22 20:37:23 roberto Exp $
   3 ** Stack and Call structure of Lua
   4 ** See Copyright Notice in lua.h
   5 */
   6
   7
   8 #include <setjmp.h>
   9 #include <stdio.h>
  10 #include <stdlib.h>
  11 #include <string.h>
  12
  13 #include "lauxlib.h"
  14 #include "ldo.h"
  15 #include "lfunc.h"
  16 #include "lgc.h"
  17 #include "lmem.h"
  18 #include "lobject.h"
  19 #include "lparser.h"
  20 #include "lstate.h"
  21 #include "lstring.h"
  22 #include "ltm.h"
  23 #include "lua.h"
  24 #include "luadebug.h"
  25 #include "lundump.h"
  26 #include "lvm.h"
  27 #include "lzio.h"
  28
  29
  30
  31 #ifndef STACK_LIMIT
  32 #define STACK_LIMIT     6000  /* arbitrary limit */
  33 #endif
  34
  35
  36
  37 #define STACK_UNIT      128
  38
  39
  40 #ifdef DEBUG
  41 #undef STACK_UNIT
  42 #define STACK_UNIT      2
  43 #endif
  44
  45
  46 void luaD_init (void) {
  47   L->stack.stack = luaM_newvector(STACK_UNIT, TObject);
  48   L->stack.top = L->stack.stack;
  49   L->stack.last = L->stack.stack+(STACK_UNIT-1);
  50 }
  51
  52
  53 void luaD_checkstack (int n) {
  54   struct Stack *S = &L->stack;
  55   if (S->last-S->top <= n) {
  56     StkId top = S->top-S->stack;
  57     int stacksize = (S->last-S->stack)+STACK_UNIT+n;
  58     luaM_reallocvector(S->stack, stacksize, TObject);
  59     S->last = S->stack+(stacksize-1);
  60     S->top = S->stack + top;
  61     if (stacksize >= STACK_LIMIT) {  /* stack overflow? */
  62       if (lua_stackedfunction(100) == LUA_NOOBJECT)  /* 100 funcs on stack? */
  63         lua_error("Lua2C - C2Lua overflow"); /* doesn't look like a rec. loop */
  64       else
  65         lua_error("stack size overflow");
  66     }
  67   }
  68 }
  69
  70
  71 /*
  72 ** Adjust stack. Set top to the given value, pushing NILs if needed.
  73 */
  74 void luaD_adjusttop (StkId newtop) {
  75   int diff = newtop-(L->stack.top-L->stack.stack);
  76   if (diff <= 0)
  77     L->stack.top += diff;
  78   else {
  79     luaD_checkstack(diff);
  80     while (diff--)
  81       ttype(L->stack.top++) = LUA_T_NIL;
  82   }
  83 }
  84
  85
  86 /*
  87 ** Open a hole below "nelems" from the L->stack.top.
  88 */
  89 void luaD_openstack (int nelems) {
  90   luaO_memup(L->stack.top-nelems+1, L->stack.top-nelems,
  91              nelems*sizeof(TObject));
  92   incr_top;
  93 }
  94
  95
  96 void luaD_lineHook (int line) {
  97   struct C_Lua_Stack oldCLS = L->Cstack;
  98   StkId old_top = L->Cstack.lua2C = L->Cstack.base = L->stack.top-L->stack.stack;
  99   L->Cstack.num = 0;
 100   (*L->linehook)(line);
 101   L->stack.top = L->stack.stack+old_top;
 102   L->Cstack = oldCLS;
 103 }
 104
 105
 106 void luaD_callHook (StkId base, TProtoFunc *tf, int isreturn) {
 107   struct C_Lua_Stack oldCLS = L->Cstack;
 108   StkId old_top = L->Cstack.lua2C = L->Cstack.base = L->stack.top-L->stack.stack;
 109   L->Cstack.num = 0;
 110   if (isreturn)
 111     (*L->callhook)(LUA_NOOBJECT, "(return)", 0);
 112   else {
 113     TObject *f = L->stack.stack+base-1;
 114     if (tf)
 115       (*L->callhook)(Ref(f), tf->source->str, tf->lineDefined);
 116     else
 117       (*L->callhook)(Ref(f), "(C)", -1);
 118   }
 119   L->stack.top = L->stack.stack+old_top;
 120   L->Cstack = oldCLS;
 121 }
 122
 123
 124 /*
 125 ** Call a C function.
 126 ** Cstack.num is the number of arguments; Cstack.lua2C points to the
 127 ** first argument. Returns an index to the first result from C.
 128 */
 129 static StkId callC (lua_CFunction f, StkId base) {
 130   struct C_Lua_Stack *cls = &L->Cstack;
 131   struct C_Lua_Stack oldCLS = *cls;
 132   StkId firstResult;
 133   int numarg = (L->stack.top-L->stack.stack) - base;
 134   cls->num = numarg;
 135   cls->lua2C = base;
 136   cls->base = base+numarg;  /* == top-stack */
 137   if (L->callhook)
 138     luaD_callHook(base, NULL, 0);
 139   (*f)();  /* do the actual call */
 140   if (L->callhook)  /* func may have changed callhook */
 141     luaD_callHook(base, NULL, 1);
 142   firstResult = cls->base;
 143   *cls = oldCLS;
 144   return firstResult;
 145 }
 146
 147
 148 static StkId callCclosure (struct Closure *cl, lua_CFunction f, StkId base) {
 149   TObject *pbase;
 150   int nup = cl->nelems;  /* number of upvalues */
 151   luaD_checkstack(nup);
 152   pbase = L->stack.stack+base;  /* care: previous call may change this */
 153   /* open space for upvalues as extra arguments */
 154   luaO_memup(pbase+nup, pbase, (L->stack.top-pbase)*sizeof(TObject));
 155   /* copy upvalues into stack */
 156   memcpy(pbase, cl->consts+1, nup*sizeof(TObject));
 157   L->stack.top += nup;
 158   return callC(f, base);
 159 }
 160
 161
 162 void luaD_callTM (TObject *f, int nParams, int nResults) {
 163   luaD_openstack(nParams);
 164   *(L->stack.top-nParams-1) = *f;
 165   luaD_calln(nParams, nResults);
 166 }
 167
 168
 169 /*
 170 ** Call a function (C or Lua). The parameters must be on the stack,
 171 ** between [top-nArgs,top). The function to be called is right below the
 172 ** arguments.
 173 ** When returns, the results are on the stack, between [top-nArgs-1,top).
 174 ** The number of results is nResults, unless nResults=MULT_RET.
 175 */
 176 void luaD_calln (int nArgs, int nResults) {
 177   struct Stack *S = &L->stack;  /* to optimize */
 178   StkId base = (S->top-S->stack)-nArgs;
 179   TObject *func = S->stack+base-1;
 180   StkId firstResult;
 181   int i;
 182   switch (ttype(func)) {
 183     case LUA_T_CPROTO:
 184       ttype(func) = LUA_T_CMARK;
 185       firstResult = callC(fvalue(func), base);
 186       break;
 187     case LUA_T_PROTO:
 188       ttype(func) = LUA_T_PMARK;
 189       firstResult = luaV_execute(NULL, tfvalue(func), base);
 190       break;
 191     case LUA_T_CLOSURE: {
 192       Closure *c = clvalue(func);
 193       TObject *proto = &(c->consts[0]);
 194       ttype(func) = LUA_T_CLMARK;
 195       firstResult = (ttype(proto) == LUA_T_CPROTO) ?
 196                        callCclosure(c, fvalue(proto), base) :
 197                        luaV_execute(c, tfvalue(proto), base);
 198       break;
 199     }
 200     default: { /* func is not a function */
 201       /* Check the tag method for invalid functions */
 202       TObject *im = luaT_getimbyObj(func, IM_FUNCTION);
 203       if (ttype(im) == LUA_T_NIL)
 204         lua_error("call expression not a function");
 205       luaD_callTM(im, (S->top-S->stack)-(base-1), nResults);
 206       return;
 207     }
 208   }
 209   /* adjust the number of results */
 210   if (nResults == MULT_RET)
 211     nResults = (S->top-S->stack)-firstResult;
 212   else
 213     luaD_adjusttop(firstResult+nResults);
 214   /* move results to base-1 (to erase parameters and function) */
 215   base--;
 216   for (i=0; i<nResults; i++)
 217     *(S->stack+base+i) = *(S->stack+firstResult+i);
 218   S->top -= firstResult-base;
 219 }
 220
 221
 222 /*
 223 ** Traverse all objects on L->stack.stack
 224 */
 225 void luaD_travstack (int (*fn)(TObject *))
 226 {
 227   StkId i;
 228   for (i = (L->stack.top-1)-L->stack.stack; i>=0; i--)
 229     fn(L->stack.stack+i);
 230 }
 231
 232
 233
 234 static void message (char *s) {
 235   TObject *em = &(luaS_new("_ERRORMESSAGE")->u.s.globalval);
 236   if (ttype(em) == LUA_T_PROTO || ttype(em) == LUA_T_CPROTO ||
 237       ttype(em) == LUA_T_CLOSURE) {
 238     *L->stack.top = *em;
 239     incr_top;
 240     lua_pushstring(s);
 241     luaD_calln(1, 0);
 242   }
 243 }
 244
 245 /*
 246 ** Reports an error, and jumps up to the available recover label
 247 */
 248 void lua_error (char *s) {
 249   if (s) message(s);
 250   if (L->errorJmp)
 251     longjmp(L->errorJmp->b, 1);
 252   else {
 253     message("exit(1). Unable to recover.\n");
 254     exit(1);
 255   }
 256 }
 257
 258
 259 /*
 260 ** Execute a protected call. Assumes that function is at L->Cstack.base and
 261 ** parameters are on top of it. Leave nResults on the stack.
 262 */
 263 int luaD_protectedrun (void) {
 264   volatile struct C_Lua_Stack oldCLS = L->Cstack;
 265   struct lua_longjmp myErrorJmp;
 266   volatile int status;
 267   struct lua_longjmp *volatile oldErr = L->errorJmp;
 268   L->errorJmp = &myErrorJmp;
 269   if (setjmp(myErrorJmp.b) == 0) {
 270     StkId base = L->Cstack.base;
 271     luaD_calln((L->stack.top-L->stack.stack)-base-1, MULT_RET);
 272     L->Cstack.lua2C = base;  /* position of the new results */
 273     L->Cstack.num = (L->stack.top-L->stack.stack) - base;
 274     L->Cstack.base = base + L->Cstack.num;  /* incorporate results on stack */
 275     status = 0;
 276   }
 277   else {  /* an error occurred: restore L->Cstack and L->stack.top */
 278     L->Cstack = oldCLS;
 279     L->stack.top = L->stack.stack+L->Cstack.base;
 280     status = 1;
 281   }
 282   L->errorJmp = oldErr;
 283   return status;
 284 }
 285
 286
 287 /*
 288 ** returns 0 = chunk loaded; 1 = error; 2 = no more chunks to load
 289 */
 290 static int protectedparser (ZIO *z, int bin) {
 291   volatile struct C_Lua_Stack oldCLS = L->Cstack;
 292   struct lua_longjmp myErrorJmp;
 293   volatile int status;
 294   TProtoFunc *volatile tf;
 295   struct lua_longjmp *volatile oldErr = L->errorJmp;
 296   L->errorJmp = &myErrorJmp;
 297   if (setjmp(myErrorJmp.b) == 0) {
 298     tf = bin ? luaU_undump1(z) : luaY_parser(z);
 299     status = 0;
 300   }
 301   else {  /* an error occurred: restore L->Cstack and L->stack.top */
 302     L->Cstack = oldCLS;
 303     L->stack.top = L->stack.stack+L->Cstack.base;
 304     tf = NULL;
 305     status = 1;
 306   }
 307   L->errorJmp = oldErr;
 308   if (status) return 1;  /* error code */
 309   if (tf == NULL) return 2;  /* 'natural' end */
 310   luaD_adjusttop(L->Cstack.base+1);  /* one slot for the pseudo-function */
 311   L->stack.stack[L->Cstack.base].ttype = LUA_T_PROTO;
 312   L->stack.stack[L->Cstack.base].value.tf = tf;
 313   luaV_closure(0);
 314   return 0;
 315 }
 316
 317
 318 static int do_main (ZIO *z, int bin) {
 319   int status;
 320   int debug = L->debug;  /* save debug status */
 321   do {
 322     long old_blocks = (luaC_checkGC(), L->nblocks);
 323     status = protectedparser(z, bin);
 324     if (status == 1) return 1;  /* error */
 325     else if (status == 2) return 0;  /* 'natural' end */
 326     else {
 327       unsigned long newelems2 = 2*(L->nblocks-old_blocks);
 328       L->GCthreshold += newelems2;
 329       status = luaD_protectedrun();
 330       L->GCthreshold -= newelems2;
 331     }
 332   } while (bin && status == 0);
 333   L->debug = debug;  /* restore debug status */
 334   return status;
 335 }
 336
 337
 338 void luaD_gcIM (TObject *o)
 339 {
 340   TObject *im = luaT_getimbyObj(o, IM_GC);
 341   if (ttype(im) != LUA_T_NIL) {
 342     *L->stack.top = *o;
 343     incr_top;
 344     luaD_callTM(im, 1, 0);
 345   }
 346 }
 347
 348
 349 #define MAXFILENAME     260     /* maximum part of a file name kept */
 350
 351 int lua_dofile (char *filename) {
 352   ZIO z;
 353   int status;
 354   int c;
 355   int bin;
 356   char source[MAXFILENAME];
 357   FILE *f = (filename == NULL) ? stdin : fopen(filename, "r");
 358   if (f == NULL)
 359     return 2;
 360   c = fgetc(f);
 361   ungetc(c, f);
 362   bin = (c == ID_CHUNK);
 363   if (bin)
 364     f = freopen(filename, "rb", f);  /* set binary mode */
 365   luaL_filesource(source, filename, sizeof(source));
 366   luaZ_Fopen(&z, f, source);
 367   status = do_main(&z, bin);
 368   if (f != stdin)
 369     fclose(f);
 370   return status;
 371 }
 372
 373
 374 int lua_dostring (char *str) {
 375   return lua_dobuffer(str, strlen(str), str);
 376 }
 377
 378
 379 int lua_dobuffer (char *buff, int size, char *name) {
 380   ZIO z;
 381   if (!name) name = "?";
 382   luaZ_mopen(&z, buff, size, name);
 383   return do_main(&z, buff[0]==ID_CHUNK);
 384 }
 385