src/ldo.c

   1 /*
   2 ** $Id: ldo.c,v 1.109 2000/10/30 12:38:50 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 "lua.h"
  14
  15 #include "ldebug.h"
  16 #include "ldo.h"
  17 #include "lgc.h"
  18 #include "lmem.h"
  19 #include "lobject.h"
  20 #include "lparser.h"
  21 #include "lstate.h"
  22 #include "lstring.h"
  23 #include "ltable.h"
  24 #include "ltm.h"
  25 #include "lundump.h"
  26 #include "lvm.h"
  27 #include "lzio.h"
  28
  29
  30 /* space to handle stack overflow errors */
  31 #define EXTRA_STACK     (2*LUA_MINSTACK)
  32
  33
  34 void luaD_init (lua_State *L, int stacksize) {
  35   L->stack = luaM_newvector(L, stacksize+EXTRA_STACK, TObject);
  36   L->nblocks += stacksize*sizeof(TObject);
  37   L->stack_last = L->stack+(stacksize-1);
  38   L->stacksize = stacksize;
  39   L->Cbase = L->top = L->stack;
  40 }
  41
  42
  43 void luaD_checkstack (lua_State *L, int n) {
  44   if (L->stack_last - L->top <= n) {  /* stack overflow? */
  45     if (L->stack_last-L->stack > (L->stacksize-1)) {
  46       /* overflow while handling overflow */
  47       luaD_breakrun(L, LUA_ERRERR);  /* break run without error message */
  48     }
  49     else {
  50       L->stack_last += EXTRA_STACK;  /* to be used by error message */
  51       lua_error(L, "stack overflow");
  52     }
  53   }
  54 }
  55
  56
  57 static void restore_stack_limit (lua_State *L) {
  58   if (L->top - L->stack < L->stacksize - 1)
  59     L->stack_last = L->stack + (L->stacksize-1);
  60 }
  61
  62
  63 /*
  64 ** Adjust stack. Set top to base+extra, pushing NILs if needed.
  65 ** (we cannot add base+extra unless we are sure it fits in the stack;
  66 **  otherwise the result of such operation on pointers is undefined)
  67 */
  68 void luaD_adjusttop (lua_State *L, StkId base, int extra) {
  69   int diff = extra-(L->top-base);
  70   if (diff <= 0)
  71     L->top = base+extra;
  72   else {
  73     luaD_checkstack(L, diff);
  74     while (diff--)
  75       ttype(L->top++) = LUA_TNIL;
  76   }
  77 }
  78
  79
  80 /*
  81 ** Open a hole inside the stack at `pos'
  82 */
  83 static void luaD_openstack (lua_State *L, StkId pos) {
  84   int i = L->top-pos;
  85   while (i--) pos[i+1] = pos[i];
  86   incr_top;
  87 }
  88
  89
  90 static void dohook (lua_State *L, lua_Debug *ar, lua_Hook hook) {
  91   StkId old_Cbase = L->Cbase;
  92   StkId old_top = L->Cbase = L->top;
  93   luaD_checkstack(L, LUA_MINSTACK);  /* ensure minimum stack size */
  94   L->allowhooks = 0;  /* cannot call hooks inside a hook */
  95   (*hook)(L, ar);
  96   LUA_ASSERT(L->allowhooks == 0, "invalid allow");
  97   L->allowhooks = 1;
  98   L->top = old_top;
  99   L->Cbase = old_Cbase;
 100 }
 101
 102
 103 void luaD_lineHook (lua_State *L, StkId func, int line, lua_Hook linehook) {
 104   if (L->allowhooks) {
 105     lua_Debug ar;
 106     ar._func = func;
 107     ar.event = "line";
 108     ar.currentline = line;
 109     dohook(L, &ar, linehook);
 110   }
 111 }
 112
 113
 114 static void luaD_callHook (lua_State *L, StkId func, lua_Hook callhook,
 115                     const char *event) {
 116   if (L->allowhooks) {
 117     lua_Debug ar;
 118     ar._func = func;
 119     ar.event = event;
 120     infovalue(func)->pc = NULL;  /* function is not active */
 121     dohook(L, &ar, callhook);
 122   }
 123 }
 124
 125
 126 static StkId callCclosure (lua_State *L, const struct Closure *cl, StkId base) {
 127   int nup = cl->nupvalues;  /* number of upvalues */
 128   StkId old_Cbase = L->Cbase;
 129   int n;
 130   L->Cbase = base;       /* new base for C function */
 131   luaD_checkstack(L, nup+LUA_MINSTACK);  /* ensure minimum stack size */
 132   for (n=0; n<nup; n++)  /* copy upvalues as extra arguments */
 133     *(L->top++) = cl->upvalue[n];
 134   n = (*cl->f.c)(L);  /* do the actual call */
 135   L->Cbase = old_Cbase;  /* restore old C base */
 136   return L->top - n;  /* return index of first result */
 137 }
 138
 139
 140 void luaD_callTM (lua_State *L, Closure *f, int nParams, int nResults) {
 141   StkId base = L->top - nParams;
 142   luaD_openstack(L, base);
 143   clvalue(base) = f;
 144   ttype(base) = LUA_TFUNCTION;
 145   luaD_call(L, base, nResults);
 146 }
 147
 148
 149 /*
 150 ** Call a function (C or Lua). The function to be called is at *func.
 151 ** The arguments are on the stack, right after the function.
 152 ** When returns, the results are on the stack, starting at the original
 153 ** function position.
 154 ** The number of results is nResults, unless nResults=LUA_MULTRET.
 155 */
 156 void luaD_call (lua_State *L, StkId func, int nResults) {
 157   lua_Hook callhook;
 158   StkId firstResult;
 159   CallInfo ci;
 160   Closure *cl;
 161   if (ttype(func) != LUA_TFUNCTION) {
 162     /* `func' is not a function; check the `function' tag method */
 163     Closure *tm = luaT_gettmbyObj(L, func, TM_FUNCTION);
 164     if (tm == NULL)
 165       luaG_typeerror(L, func, "call");
 166     luaD_openstack(L, func);
 167     clvalue(func) = tm;  /* tag method is the new function to be called */
 168     ttype(func) = LUA_TFUNCTION;
 169   }
 170   cl = clvalue(func);
 171   ci.func = cl;
 172   infovalue(func) = &ci;
 173   ttype(func) = LUA_TMARK;
 174   callhook = L->callhook;
 175   if (callhook)
 176     luaD_callHook(L, func, callhook, "call");
 177   firstResult = (cl->isC ? callCclosure(L, cl, func+1) :
 178                            luaV_execute(L, cl, func+1));
 179   if (callhook)  /* same hook that was active at entry */
 180     luaD_callHook(L, func, callhook, "return");
 181   LUA_ASSERT(ttype(func) == LUA_TMARK, "invalid tag");
 182   /* move results to `func' (to erase parameters and function) */
 183   if (nResults == LUA_MULTRET) {
 184     while (firstResult < L->top)  /* copy all results */
 185       *func++ = *firstResult++;
 186     L->top = func;
 187   }
 188   else {  /* copy at most `nResults' */
 189     for (; nResults > 0 && firstResult < L->top; nResults--)
 190       *func++ = *firstResult++;
 191     L->top = func;
 192     for (; nResults > 0; nResults--) {  /* if there are not enough results */
 193       ttype(L->top) = LUA_TNIL;  /* adjust the stack */
 194       incr_top;  /* must check stack space */
 195     }
 196   }
 197   luaC_checkGC(L);
 198 }
 199
 200
 201 /*
 202 ** Execute a protected call.
 203 */
 204 struct CallS {  /* data to `f_call' */
 205   StkId func;
 206   int nresults;
 207 };
 208
 209 static void f_call (lua_State *L, void *ud) {
 210   struct CallS *c = (struct CallS *)ud;
 211   luaD_call(L, c->func, c->nresults);
 212 }
 213
 214
 215 LUA_API int lua_call (lua_State *L, int nargs, int nresults) {
 216   StkId func = L->top - (nargs+1);  /* function to be called */
 217   struct CallS c;
 218   int status;
 219   c.func = func; c.nresults = nresults;
 220   status = luaD_runprotected(L, f_call, &c);
 221   if (status != 0)  /* an error occurred? */
 222     L->top = func;  /* remove parameters from the stack */
 223   return status;
 224 }
 225
 226
 227 /*
 228 ** Execute a protected parser.
 229 */
 230 struct ParserS {  /* data to `f_parser' */
 231   ZIO *z;
 232   int bin;
 233 };
 234
 235 static void f_parser (lua_State *L, void *ud) {
 236   struct ParserS *p = (struct ParserS *)ud;
 237   Proto *tf = p->bin ? luaU_undump(L, p->z) : luaY_parser(L, p->z);
 238   luaV_Lclosure(L, tf, 0);
 239 }
 240
 241
 242 static int protectedparser (lua_State *L, ZIO *z, int bin) {
 243   struct ParserS p;
 244   unsigned long old_blocks;
 245   int status;
 246   p.z = z; p.bin = bin;
 247   luaC_checkGC(L);
 248   old_blocks = L->nblocks;
 249   status = luaD_runprotected(L, f_parser, &p);
 250   if (status == 0) {
 251     /* add new memory to threshold (as it probably will stay) */
 252     L->GCthreshold += (L->nblocks - old_blocks);
 253   }
 254   else if (status == LUA_ERRRUN)  /* an error occurred: correct error code */
 255     status = LUA_ERRSYNTAX;
 256   return status;
 257 }
 258
 259
 260 static int parse_file (lua_State *L, const char *filename) {
 261   ZIO z;
 262   int status;
 263   int bin;  /* flag for file mode */
 264   int c;    /* look ahead char */
 265   FILE *f = (filename == NULL) ? stdin : fopen(filename, "r");
 266   if (f == NULL) return LUA_ERRFILE;  /* unable to open file */
 267   c = fgetc(f);
 268   ungetc(c, f);
 269   bin = (c == ID_CHUNK);
 270   if (bin && f != stdin) {
 271     f = freopen(filename, "rb", f);  /* set binary mode */
 272     if (f == NULL) return LUA_ERRFILE;  /* unable to reopen file */
 273   }
 274   lua_pushstring(L, "@");
 275   lua_pushstring(L, (filename == NULL) ? "(stdin)" : filename);
 276   lua_concat(L, 2);
 277   filename = lua_tostring(L, -1);  /* filename = '@'..filename */
 278   lua_pop(L, 1);  /* OK: there is no GC during parser */
 279   luaZ_Fopen(&z, f, filename);
 280   status = protectedparser(L, &z, bin);
 281   if (f != stdin)
 282     fclose(f);
 283   return status;
 284 }
 285
 286
 287 LUA_API int lua_dofile (lua_State *L, const char *filename) {
 288   int status = parse_file(L, filename);
 289   if (status == 0)  /* parse OK? */
 290     status = lua_call(L, 0, LUA_MULTRET);  /* call main */
 291   return status;
 292 }
 293
 294
 295 static int parse_buffer (lua_State *L, const char *buff, size_t size,
 296                          const char *name) {
 297   ZIO z;
 298   if (!name) name = "?";
 299   luaZ_mopen(&z, buff, size, name);
 300   return protectedparser(L, &z, buff[0]==ID_CHUNK);
 301 }
 302
 303
 304 LUA_API int lua_dobuffer (lua_State *L, const char *buff, size_t size, const char *name) {
 305   int status = parse_buffer(L, buff, size, name);
 306   if (status == 0)  /* parse OK? */
 307     status = lua_call(L, 0, LUA_MULTRET);  /* call main */
 308   return status;
 309 }
 310
 311
 312 LUA_API int lua_dostring (lua_State *L, const char *str) {
 313   return lua_dobuffer(L, str, strlen(str), str);
 314 }
 315
 316
 317 /*
 318 ** {======================================================
 319 ** Error-recover functions (based on long jumps)
 320 ** =======================================================
 321 */
 322
 323 /* chain list of long jump buffers */
 324 struct lua_longjmp {
 325   jmp_buf b;
 326   struct lua_longjmp *previous;
 327   volatile int status;  /* error code */
 328 };
 329
 330
 331 static void message (lua_State *L, const char *s) {
 332   const TObject *em = luaH_getglobal(L, LUA_ERRORMESSAGE);
 333   if (ttype(em) == LUA_TFUNCTION) {
 334     *L->top = *em;
 335     incr_top;
 336     lua_pushstring(L, s);
 337     luaD_call(L, L->top-2, 0);
 338   }
 339 }
 340
 341
 342 /*
 343 ** Reports an error, and jumps up to the available recovery label
 344 */
 345 LUA_API void lua_error (lua_State *L, const char *s) {
 346   if (s) message(L, s);
 347   luaD_breakrun(L, LUA_ERRRUN);
 348 }
 349
 350
 351 void luaD_breakrun (lua_State *L, int errcode) {
 352   if (L->errorJmp) {
 353     L->errorJmp->status = errcode;
 354     longjmp(L->errorJmp->b, 1);
 355   }
 356   else {
 357     if (errcode != LUA_ERRMEM)
 358       message(L, "unable to recover; exiting\n");
 359     exit(EXIT_FAILURE);
 360   }
 361 }
 362
 363
 364 int luaD_runprotected (lua_State *L, void (*f)(lua_State *, void *), void *ud) {
 365   StkId oldCbase = L->Cbase;
 366   StkId oldtop = L->top;
 367   struct lua_longjmp lj;
 368   int allowhooks = L->allowhooks;
 369   lj.status = 0;
 370   lj.previous = L->errorJmp;  /* chain new error handler */
 371   L->errorJmp = &lj;
 372   if (setjmp(lj.b) == 0)
 373     (*f)(L, ud);
 374   else {  /* an error occurred: restore the state */
 375     L->allowhooks = allowhooks;
 376     L->Cbase = oldCbase;
 377     L->top = oldtop;
 378     restore_stack_limit(L);
 379   }
 380   L->errorJmp = lj.previous;  /* restore old error handler */
 381   return lj.status;
 382 }
 383
 384 /* }====================================================== */
 385