scummvm/engines/grim/lua/ldo.cpp

/*
** $Id$
** Stack and Call structure of Lua
** See Copyright Notice in lua.h
*/


#include "engines/grim/lua/ldo.h"
#include "engines/grim/lua/lfunc.h"
#include "engines/grim/lua/lgc.h"
#include "engines/grim/lua/lmem.h"
#include "engines/grim/lua/lobject.h"
#include "engines/grim/lua/lopcodes.h"
#include "engines/grim/lua/lparser.h"
#include "engines/grim/lua/lstate.h"
#include "engines/grim/lua/ltask.h"
#include "engines/grim/lua/ltm.h"
#include "engines/grim/lua/lua.h"
#include "engines/grim/lua/luadebug.h"
#include "engines/grim/lua/lundump.h"
#include "engines/grim/lua/lvm.h"
#include "engines/grim/lua/lzio.h"

#include "common/file.h"

namespace Grim {

#ifndef STACK_LIMIT
#define STACK_LIMIT     6000
#endif

// Extra stack size to run a function: LUA_T_LINE(1), TM calls(2), ...
#define	EXTRA_STACK	5

/*
** Error messages
*/

void stderrorim() {
	fprintf(stderr, "lua error: %s\n", lua_getstring(lua_getparam(1)));
}

#define STACK_UNIT	256

// Initial size for CallInfo array
#define BASIC_CI_SIZE	8

void luaD_init() {
	ttype(&errorim) = LUA_T_CPROTO;
	fvalue(&errorim) = stderrorim;
}

void luaD_checkstack(int32 n) {
	struct Stack *S = &lua_state->stack;
	if (S->last-S->top <= n) {
		StkId top = S->top-S->stack;
		int32 stacksize = (S->last-S->stack) + 1 + STACK_UNIT + n;
		S->stack = luaM_reallocvector(S->stack, stacksize, TObject);
		S->last = S->stack + (stacksize - 1);
		S->top = S->stack + top;
		if (stacksize >= STACK_LIMIT) {  // stack overflow?
			if (lua_stackedfunction(100) == LUA_NOOBJECT)  // 100 funcs on stack?
				lua_error("Lua2C - C2Lua overflow"); // doesn't look like a rec. loop
			else
				lua_error("stack size overflow");
		}
	}
}

/*
** Adjust stack. Set top to the given value, pushing NILs if needed.
*/
void luaD_adjusttop(StkId newtop) {
	int32 diff = newtop-(lua_state->stack.top-lua_state->stack.stack);
	if (diff <= 0)
		lua_state->stack.top += diff;
	else {
		luaD_checkstack(diff);
		while (diff--)
			ttype(lua_state->stack.top++) = LUA_T_NIL;
	}
}

/*
** Open a hole below "nelems" from the lua_state->stack.top.
*/
void luaD_openstack(int32 nelems) {
	luaO_memup(lua_state->stack.top - nelems + 1, lua_state->stack.top - nelems, nelems * sizeof(TObject));
	incr_top;
}

void luaD_lineHook(int32 line) {
	struct C_Lua_Stack oldCLS = lua_state->Cstack;
	StkId old_top = lua_state->Cstack.lua2C = lua_state->Cstack.base = lua_state->stack.top-lua_state->stack.stack;
	lua_state->Cstack.num = 0;
	(*lua_linehook)(line);
	lua_state->stack.top = lua_state->stack.stack + old_top;
	lua_state->Cstack = oldCLS;
}

void luaD_callHook(StkId base, TProtoFunc *tf, int32 isreturn) {
	struct C_Lua_Stack oldCLS = lua_state->Cstack;
	StkId old_top = lua_state->Cstack.lua2C = lua_state->Cstack.base = lua_state->stack.top - lua_state->stack.stack;
	lua_state->Cstack.num = 0;
	if (isreturn)
		(*lua_callhook)(LUA_NOOBJECT, "(return)", 0);
	else {
		TObject *f = lua_state->stack.stack + base - 1;
		if (tf)
			(*lua_callhook)(Ref(f), tf->fileName->str, tf->lineDefined);
		else
			(*lua_callhook)(Ref(f), "(C)", -1);
	}
	lua_state->stack.top = lua_state->stack.stack + old_top;
	lua_state->Cstack = oldCLS;
}

/*
** Call a C function.
** Cstack.num is the number of arguments; Cstack.lua2C points to the
** first argument. Returns an index to the first result from C.
*/
static StkId callC(lua_CFunction f, StkId base) {
	struct C_Lua_Stack *CS = &lua_state->Cstack;
	struct C_Lua_Stack oldCLS = *CS;
	StkId firstResult;
	int32 numarg = (lua_state->stack.top - lua_state->stack.stack) - base;
	CS->num = numarg;
	CS->lua2C = base;
	CS->base = base + numarg;  // == top - stack
	if (lua_callhook) {
		TObject *r = lua_state->stack.stack + base - 1;
		(*lua_callhook)(Ref(r), "(C)", -1);
	}
	lua_state->state_counter2++;
	(*f)();  // do the actual call
	lua_state->state_counter2--;
//	if (lua_callhook)  // func may have changed lua_callhook
//		(*lua_callhook)(LUA_NOOBJECT, "(return)", 0);
	firstResult = CS->base;
	*CS = oldCLS;
	return firstResult;
}

static StkId callCclosure(struct Closure *cl, lua_CFunction f, StkId base) {
	TObject *pbase;
	int32 nup = cl->nelems;  // number of upvalues
	luaD_checkstack(nup);
	pbase = lua_state->stack.stack + base;  // care: previous call may change this
	// open space for upvalues as extra arguments
	luaO_memup(pbase+nup, pbase, (lua_state->stack.top - pbase) * sizeof(TObject));
	// copy upvalues into stack
	memcpy(pbase, cl->consts + 1, nup * sizeof(TObject));
	lua_state->stack.top += nup;
	return callC(f, base);
}

void luaD_callTM(TObject *f, int32 nParams, int32 nResults) {
	luaD_openstack(nParams);
	*(lua_state->stack.top - nParams - 1) = *f;
	lua_state->state_counter1++;
	lua_state->state_counter2++;
	luaD_call((lua_state->stack.top - lua_state->stack.stack) - nParams, nResults);
	lua_state->state_counter2--;
	lua_state->state_counter1--;
}

int32 luaD_call(StkId base, int nResults) {
	lua_Task *tmpTask = lua_state->task;
	if (!lua_state->task || lua_state->state_counter2) {
		lua_Task *t = luaM_new(lua_Task);
		lua_taskinit(t, lua_state->task, base, nResults);
		lua_state->task = t;
	} else {
		tmpTask = lua_state->some_task;
	}

	while (1) {
		lua_CFunction function = NULL;
		StkId firstResult = 0;
		TObject *funcObj = lua_state->stack.stack + base - 1;
		if (ttype(funcObj) == LUA_T_CLOSURE) {
			Closure *c = clvalue(funcObj);
			TObject *proto = &(c->consts[0]);
			ttype(funcObj) = LUA_T_CLMARK;
			if (ttype(proto) == LUA_T_CPROTO) {
				function = fvalue(funcObj);
				firstResult = callCclosure(c, fvalue(proto), base);
			} else {
				lua_taskresume(lua_state->task, c, tfvalue(proto), base);
				firstResult = luaV_execute(lua_state->task);
			}
		} else if (ttype(funcObj) == LUA_T_PMARK) {
			if (!lua_state->task->some_flag) {
				TObject *im = luaT_getimbyObj(funcObj, IM_FUNCTION);
				if (ttype(im) == LUA_T_NIL)
					lua_error("call expression not a function");
				luaD_callTM(im, (lua_state->stack.top - lua_state->stack.stack) - (base - 1), nResults);
				continue;
			}
			firstResult = luaV_execute(lua_state->task);
		} else if (ttype(funcObj) == LUA_T_CMARK) {
			if (!lua_state->task->some_flag) {
				TObject *im = luaT_getimbyObj(funcObj, IM_FUNCTION);
				if (ttype(im) == LUA_T_NIL)
					lua_error("call expression not a function");
				luaD_callTM(im, (lua_state->stack.top - lua_state->stack.stack) - (base - 1), nResults);
				continue;
			}
		} else if (ttype(funcObj) == LUA_T_CLMARK) {
			Closure *c = clvalue(funcObj);
			TObject *proto = &(c->consts[0]);
			if (!lua_state->task->some_flag) {
				TObject *im = luaT_getimbyObj(funcObj, IM_FUNCTION);
				if (ttype(im) == LUA_T_NIL)
					lua_error("call expression not a function");
				luaD_callTM(im, (lua_state->stack.top - lua_state->stack.stack) - (base - 1), nResults);
				continue;
			}
			if (ttype(proto) != LUA_T_CPROTO)
				firstResult = luaV_execute(lua_state->task);
		} else if (ttype(funcObj) == LUA_T_PROTO) {
			ttype(funcObj) = LUA_T_PMARK;
			lua_taskresume(lua_state->task, NULL, tfvalue(funcObj), base);
			firstResult = luaV_execute(lua_state->task);
		} else if (ttype(funcObj) == LUA_T_CPROTO) {
			ttype(funcObj) = LUA_T_CMARK;
			function = fvalue(funcObj);
			firstResult = callC(fvalue(funcObj), base);
		} else {
			TObject *im = luaT_getimbyObj(funcObj, IM_FUNCTION);
			if (ttype(im) == LUA_T_NIL)
				lua_error("call expression not a function");
			luaD_callTM(im, (lua_state->stack.top - lua_state->stack.stack) - (base - 1), nResults);
			continue;
		}

		if (firstResult <= 0) {
			nResults = lua_state->task->aux;
			base = -firstResult;
			lua_Task *t = luaM_new(lua_Task);
			lua_taskinit(t, lua_state->task, base, nResults);
			lua_state->task = t;
		} else {
			nResults = lua_state->task->some_results;
			base = lua_state->task->some_base;
			if (nResults != 255)
				luaD_adjusttop(firstResult + nResults);
			base--;
			nResults = lua_state->stack.top - (lua_state->stack.stack + firstResult);
			for (int32 i = 0; i < nResults; i++)
				*(lua_state->stack.stack + base + i) = *(lua_state->stack.stack + firstResult + i);
			lua_state->stack.top -= firstResult - base;

			lua_Task *tmp = lua_state->task;
			lua_state->task = lua_state->task->next;
			luaM_free(tmp);
			if (lua_state->task) {
				nResults = lua_state->task->some_results;
				base = lua_state->task->some_base;
			}

			if (function == break_here) {
				if (!lua_state->state_counter1)  {
					lua_state->some_task = tmpTask;
					return 1;
				}
			}
		}

		if (lua_state->task == tmpTask)
			break;
	}

	return 0;
}

static void travstack(struct Stack *S, int32 (*fn)(TObject *)) {
	StkId i;
	for (i = (S->top - 1) - S->stack; i >= 0; i--)
		fn(S->stack + i);
}

/*
** Traverse all objects on lua_state->stack.stack, and all other active stacks
*/
void luaD_travstack(int32(*fn)(TObject *)) {
	LState *t;
	for (t = lua_rootState; t != NULL; t = t->next) {
		travstack(&t->stack, fn);
	}
}

static void message(const char *s) {
	TObject im = errorim;
	if (ttype(&im) != LUA_T_NIL) {
		lua_pushstring(s);
		luaD_callTM(&im, 1, 0);
	}
}

/*
** Reports an error, and jumps up to the available recover label
*/
void lua_error(const char *s) {
	if (s)
		message(s);
	if (lua_state->errorJmp) {
		longjmp(*((jmp_buf *)lua_state->errorJmp), 1);
	} else {
		fprintf(stderr, "lua: exit(1). Unable to recover\n");
		exit(1);
	}
}

/*
** Call the function at lua_state->Cstack.base, and incorporate results on
** the Lua2C structure.
*/
static void do_callinc(int32 nResults) {
	StkId base = lua_state->Cstack.base;
	luaD_call(base + 1, nResults);
	lua_state->Cstack.lua2C = base;  // position of the luaM_new results
	lua_state->Cstack.num = (lua_state->stack.top - lua_state->stack.stack) - base;  // number of results
	lua_state->Cstack.base = base + lua_state->Cstack.num;  // incorporate results on lua_state->stack.stack/
}

/*
** Execute a protected call. Assumes that function is at lua_state->Cstack.base and
** parameters are on top of it. Leave nResults on the stack.
*/
int32 luaD_protectedrun(int32 nResults) {
	jmp_buf myErrorJmp;
	int32 status;
	struct C_Lua_Stack oldCLS = lua_state->Cstack;
	jmp_buf *oldErr = lua_state->errorJmp;
	lua_state->errorJmp = &myErrorJmp;
	lua_state->state_counter1++;
	lua_Task *tmpTask = lua_state->task;
	if (setjmp(myErrorJmp) == 0) {
		do_callinc(nResults);
		status = 0;
	} else { // an error occurred: restore lua_state->Cstack and lua_state->stack.top
		lua_state->Cstack = oldCLS;
		lua_state->stack.top = lua_state->stack.stack + lua_state->Cstack.base;
		while (tmpTask != lua_state->task) {
			lua_Task *t = lua_state->task;
			lua_state->task = lua_state->task->next;
			luaM_free(t);
		}
		status = 1;
	}
	lua_state->state_counter1--;
	lua_state->errorJmp = oldErr;
	return status;
}

/*
** returns 0 = chunk loaded; 1 = error; 2 = no more chunks to load
*/
static int32 protectedparser(ZIO *z, int32 bin) {
	int32 status;
	TProtoFunc *tf;
	jmp_buf myErrorJmp;
	jmp_buf *oldErr = lua_state->errorJmp;
	lua_state->errorJmp = &myErrorJmp;
	if (setjmp(myErrorJmp) == 0) {
		tf = bin ? luaU_undump1(z) : luaY_parser(z);
		status = 0;
	} else {
		tf = NULL;
		status = 1;
	}
	lua_state->errorJmp = oldErr;
	if (status)
		return 1;  // error code
	if (tf == NULL)
		return 2;  // 'natural' end
	luaD_adjusttop(lua_state->Cstack.base + 1);  // one slot for the pseudo-function
	lua_state->stack.stack[lua_state->Cstack.base].ttype = LUA_T_PROTO;
	lua_state->stack.stack[lua_state->Cstack.base].value.tf = tf;
	luaV_closure(0);
	return 0;
}

static int32 do_main(ZIO *z, int32 bin) {
	int32 status;
	do {
		int32 old_blocks = (luaC_checkGC(), nblocks);
		status = protectedparser(z, bin);
		if (status == 1)
			return 1;  // error
		else if (status == 2)
			return 0;  // 'natural' end
		else {
			int32 newelems2 = 2 * (nblocks - old_blocks);
			GCthreshold += newelems2;
			status = luaD_protectedrun(MULT_RET);
			GCthreshold -= newelems2;
		}
	} while (bin && status == 0);
	return status;
}

void luaD_gcIM(TObject *o) {
	TObject *im = luaT_getimbyObj(o, IM_GC);
	if (ttype(im) != LUA_T_NIL) {
		*lua_state->stack.top = *o;
		incr_top;
		luaD_callTM(im, 1, 0);
	}
}

#define SIZE_PREF 20  // size of string prefix to appear in error messages
#define SSIZE_PREF "20"

static void build_name (const char *str, char *name) {
	if (str == NULL || *str == ID_CHUNK)
		strcpy(name, "(buffer)");
	else {
		char *temp;
		sprintf(name, "(dostring) >> \"%." SSIZE_PREF "s\"", str);
		temp = strchr(name, '\n');
		if (temp) {  // end string after first line
			*temp = '"';
			*(temp + 1) = 0;
		}
	}
}

int32 lua_dostring(const char *str) {
	return lua_dobuffer(str, strlen(str), NULL);
}

int32 lua_dobuffer(const char *buff, int32 size, const char *name) {
	char newname[SIZE_PREF + 25];
	ZIO z;
	int32 status;

	if (!name) {
		build_name(buff, newname);
		name = newname;
	}
	luaZ_mopen(&z, buff, size, name);
	status = do_main(&z, buff[0] == ID_CHUNK);
	return status;
}

} // end of namespace Grim