2 ** $Id: ldo.c,v 1.109a 2000/10/30 12:38:50 roberto Exp $
3 ** Stack and Call structure of Lua
4 ** See Copyright Notice in lua.h
30 /* space to handle stack overflow errors */
31 #define EXTRA_STACK (2*LUA_MINSTACK)
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
;
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 */
50 L
->stack_last
+= EXTRA_STACK
; /* to be used by error message */
51 lua_error(L
, "stack overflow");
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);
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)
68 void luaD_adjusttop (lua_State
*L
, StkId base
, int extra
) {
69 int diff
= extra
-(L
->top
-base
);
73 luaD_checkstack(L
, diff
);
75 ttype(L
->top
++) = LUA_TNIL
;
81 ** Open a hole inside the stack at `pos'
83 static void luaD_openstack (lua_State
*L
, StkId pos
) {
85 while (i
--) pos
[i
+1] = pos
[i
];
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 */
96 LUA_ASSERT(L
->allowhooks
== 0, "invalid allow");
103 void luaD_lineHook (lua_State
*L
, StkId func
, int line
, lua_Hook linehook
) {
108 ar
.currentline
= line
;
109 dohook(L
, &ar
, linehook
);
114 static void luaD_callHook (lua_State
*L
, StkId func
, lua_Hook callhook
,
120 infovalue(func
)->pc
= NULL
; /* function is not active */
121 dohook(L
, &ar
, callhook
);
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
;
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 */
140 void luaD_callTM (lua_State
*L
, Closure
*f
, int nParams
, int nResults
) {
141 StkId base
= L
->top
- nParams
;
142 luaD_openstack(L
, base
);
144 ttype(base
) = LUA_TFUNCTION
;
145 luaD_call(L
, base
, nResults
);
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.
156 void luaD_call (lua_State
*L
, StkId func
, int nResults
) {
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
);
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
;
172 infovalue(func
) = &ci
;
173 ttype(func
) = LUA_TMARK
;
174 callhook
= L
->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
++;
188 else { /* copy at most `nResults' */
189 for (; nResults
> 0 && firstResult
< L
->top
; nResults
--)
190 *func
++ = *firstResult
++;
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 */
202 ** Execute a protected call.
204 struct CallS
{ /* data to `f_call' */
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
);
215 LUA_API
int lua_call (lua_State
*L
, int nargs
, int nresults
) {
216 StkId func
= L
->top
- (nargs
+1); /* function to be called */
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 */
228 ** Execute a protected parser.
230 struct ParserS
{ /* data to `f_parser' */
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);
242 static int protectedparser (lua_State
*L
, ZIO
*z
, int bin
) {
244 unsigned long old_blocks
;
246 p
.z
= z
; p
.bin
= bin
;
247 /* before parsing, give a (good) chance to GC */
248 if (L
->nblocks
/8 >= L
->GCthreshold
/10)
249 luaC_collectgarbage(L
);
250 old_blocks
= L
->nblocks
;
251 status
= luaD_runprotected(L
, f_parser
, &p
);
253 /* add new memory to threshold (as it probably will stay) */
254 L
->GCthreshold
+= (L
->nblocks
- old_blocks
);
256 else if (status
== LUA_ERRRUN
) /* an error occurred: correct error code */
257 status
= LUA_ERRSYNTAX
;
262 static int parse_file (lua_State
*L
, const char *filename
) {
265 int bin
; /* flag for file mode */
266 int c
; /* look ahead char */
267 FILE *f
= (filename
== NULL
) ? stdin
: fopen(filename
, "r");
268 if (f
== NULL
) return LUA_ERRFILE
; /* unable to open file */
271 bin
= (c
== ID_CHUNK
);
272 if (bin
&& f
!= stdin
) {
273 f
= freopen(filename
, "rb", f
); /* set binary mode */
274 if (f
== NULL
) return LUA_ERRFILE
; /* unable to reopen file */
276 lua_pushstring(L
, "@");
277 lua_pushstring(L
, (filename
== NULL
) ? "(stdin)" : filename
);
280 filename
= lua_tostring(L
, c
); /* filename = '@'..filename */
281 luaZ_Fopen(&z
, f
, filename
);
282 status
= protectedparser(L
, &z
, bin
);
283 lua_remove(L
, c
); /* remove `filename' from the stack */
290 LUA_API
int lua_dofile (lua_State
*L
, const char *filename
) {
291 int status
= parse_file(L
, filename
);
292 if (status
== 0) /* parse OK? */
293 status
= lua_call(L
, 0, LUA_MULTRET
); /* call main */
298 static int parse_buffer (lua_State
*L
, const char *buff
, size_t size
,
301 if (!name
) name
= "?";
302 luaZ_mopen(&z
, buff
, size
, name
);
303 return protectedparser(L
, &z
, buff
[0]==ID_CHUNK
);
307 LUA_API
int lua_dobuffer (lua_State
*L
, const char *buff
, size_t size
, const char *name
) {
308 int status
= parse_buffer(L
, buff
, size
, name
);
309 if (status
== 0) /* parse OK? */
310 status
= lua_call(L
, 0, LUA_MULTRET
); /* call main */
315 LUA_API
int lua_dostring (lua_State
*L
, const char *str
) {
316 return lua_dobuffer(L
, str
, strlen(str
), str
);
321 ** {======================================================
322 ** Error-recover functions (based on long jumps)
323 ** =======================================================
326 /* chain list of long jump buffers */
329 struct lua_longjmp
*previous
;
330 volatile int status
; /* error code */
334 static void message (lua_State
*L
, const char *s
) {
335 const TObject
*em
= luaH_getglobal(L
, LUA_ERRORMESSAGE
);
336 if (ttype(em
) == LUA_TFUNCTION
) {
339 lua_pushstring(L
, s
);
340 luaD_call(L
, L
->top
-2, 0);
346 ** Reports an error, and jumps up to the available recovery label
348 LUA_API
void lua_error (lua_State
*L
, const char *s
) {
349 if (s
) message(L
, s
);
350 luaD_breakrun(L
, LUA_ERRRUN
);
354 void luaD_breakrun (lua_State
*L
, int errcode
) {
356 L
->errorJmp
->status
= errcode
;
357 longjmp(L
->errorJmp
->b
, 1);
360 if (errcode
!= LUA_ERRMEM
)
361 message(L
, "unable to recover; exiting\n");
367 int luaD_runprotected (lua_State
*L
, void (*f
)(lua_State
*, void *), void *ud
) {
368 StkId oldCbase
= L
->Cbase
;
369 StkId oldtop
= L
->top
;
370 struct lua_longjmp lj
;
371 int allowhooks
= L
->allowhooks
;
373 lj
.previous
= L
->errorJmp
; /* chain new error handler */
375 if (setjmp(lj
.b
) == 0)
377 else { /* an error occurred: restore the state */
378 L
->allowhooks
= allowhooks
;
381 restore_stack_limit(L
);
383 L
->errorJmp
= lj
.previous
; /* restore old error handler */
387 /* }====================================================== */