- All states now use thunk functions to call the action functions. This is the bare

minimum to be able to say that VM is being used.
- Added tags for the pointer constants table.

SVN r1871 (scripting)

src/info.cpp

@@ -51,6 +51,72 @@
 
 extern void LoadActors ();
 
+int CallDecorateAction(VMFrameStack *stack, VMValue *param, int numparam, VMReturn *ret, int numret)
+{
+	assert(numparam == 6);
+	actionf_p action = (actionf_p)param[5].a;
+	action((AActor *)param[0].a, (AActor *)param[1].a, (FState *)param[2].a, param[3].i, (StateCallData *)param[4].a);
+	return 0;
+}
+
+void FState::SetAction(PSymbolActionFunction *func, bool setdefaultparams)
+{
+	if (func != NULL)
+	{
+		// All generated functions use this code.
+		static const VM_UBYTE codetemplate[] =
+		{
+			OP_PARAM,		0, REGT_POINTER, 0,
+			OP_PARAM,		0, REGT_POINTER, 1,
+			OP_PARAM,		0, REGT_POINTER, 2,
+			OP_PARAM,		0, REGT_INT, 0,
+			OP_PARAM,		0, REGT_POINTER, 3,
+			OP_PARAM,		0, REGT_POINTER|REGT_KONST, 0,
+			OP_CALL_K,		1, 6, 0,
+			OP_RET,			0, REGT_NIL, 0
+		};
+
+		// Find the CallDecorateAction function. If not found, create it and install it
+		// in Actor.
+		VMFunction *callfunc;
+		PSymbol *sym = RUNTIME_CLASS(AActor)->Symbols.FindSymbol("CallDecorateAction", false);
+		if (sym == NULL)
+		{
+			PSymbolVMFunction *symfunc = new PSymbolVMFunction("CallDecorateAction");
+			VMNativeFunction *calldec = new VMNativeFunction(CallDecorateAction);
+			symfunc->Function = calldec;
+			sym = symfunc;
+			RUNTIME_CLASS(AActor)->Symbols.AddSymbol(sym);
+		}
+		assert(sym->SymbolType == SYM_VMFunction);
+		assert(((PSymbolVMFunction *)sym)->Function != NULL);
+		callfunc = ((PSymbolVMFunction *)sym)->Function;
+
+		// Create a function for this state.
+		VMScriptFunction *vmfunc = new VMScriptFunction;
+		VM_UBYTE *code = vmfunc->AllocCode(sizeof(codetemplate)/VM_OPSIZE);
+		memcpy(code, codetemplate, sizeof(codetemplate));
+		FVoidObj *konsta = vmfunc->AllocKonstA(2);
+		VM_ATAG *atag = vmfunc->KonstATags();
+		konsta[0].v = func->Function;
+		konsta[1].o = callfunc;
+		atag[0] = ATAG_GENERIC;
+		atag[1] = ATAG_OBJECT;
+		vmfunc->NumRegA = 4;
+		vmfunc->NumRegD = 1;
+		vmfunc->MaxParam = 6;
+		vmfunc->NumArgs = 5;
+		ActionFunc = vmfunc;
+
+		if (setdefaultparams) ParameterIndex = func->defaultparameterindex+1;
+	}
+	else 
+	{
+		ActionFunc = NULL;
+		if (setdefaultparams) ParameterIndex = 0;
+	}
+}
+
 bool FState::CallAction(AActor *self, AActor *stateowner, StateCallData *statecall)
 {
 	if (ActionFunc != NULL)

src/info.h

@@ -92,21 +92,7 @@ struct FState
 	{
 		Frame = (Frame & SF_FULLBRIGHT) | (frame-'A');
 	}
-	void SetAction(PSymbolActionFunction *func, bool setdefaultparams = true)
-	{
-#if 0
-		if (func != NULL)
-		{
-			ActionFunc = func->Function;
-			if (setdefaultparams) ParameterIndex = func->defaultparameterindex+1;
-		}
-		else 
-#endif
-		{
-			ActionFunc = NULL;
-			if (setdefaultparams) ParameterIndex = 0;
-		}
-	}
+	void SetAction(PSymbolActionFunction *func, bool setdefaultparams = true);
 	bool CallAction(AActor *self, AActor *stateowner, StateCallData *statecall = NULL);
 	static const PClass *StaticFindStateOwner (const FState *state);
 	static const PClass *StaticFindStateOwner (const FState *state, const FActorInfo *info);

src/zscript/vm.h

@@ -14,8 +14,10 @@ typedef unsigned short		VM_UHALF;
 typedef signed short		VM_SHALF;
 typedef unsigned int		VM_UWORD;
 typedef signed int			VM_SWORD;
+typedef VM_UBYTE			VM_ATAG;
 
 #define VM_EPSILON			(1/1024.0)
+#define VM_OPSIZE			4		// Number of bytes used by one opcode
 
 enum
 {
@@ -109,7 +111,7 @@ enum
 
 class VMFunction : public DObject
 {
-	DECLARE_CLASS(VMFunction, DObject);
+	DECLARE_ABSTRACT_CLASS(VMFunction, DObject);
 public:
 	bool Native;
 };
@@ -409,7 +411,7 @@ struct VMValue
 		Type = REGT_POINTER;
 		return *this;
 	}
-	void SetPointer(void *v, VM_UBYTE atag=ATAG_GENERIC)
+	void SetPointer(void *v, VM_ATAG atag=ATAG_GENERIC)
 	{
 		Kill();
 		a = v;
@@ -614,9 +616,9 @@ struct VMFrame
 		return (void **)(GetRegS() + NumRegS);
 	}
 
-	VM_UBYTE *GetRegATag() const
+	VM_ATAG *GetRegATag() const
 	{
-		return (VM_UBYTE *)(GetRegD() + NumRegD);
+		return (VM_ATAG *)(GetRegD() + NumRegD);
 	}
 
 	VMValue *GetParam() const
@@ -626,12 +628,12 @@ struct VMFrame
 
 	void *GetExtra() const
 	{
-		VM_UBYTE *ptag = GetRegATag();
-		ptrdiff_t ofs = ptag - (VM_UBYTE *)this;
+		VM_ATAG *ptag = GetRegATag();
+		ptrdiff_t ofs = ptag - (VM_ATAG *)this;
 		return (VM_UBYTE *)this + ((ofs + NumRegA + 15) & ~15);
 	}
 
-	void GetAllRegs(int *&d, double *&f, FString *&s, void **&a, VM_UBYTE *&atag, VMValue *&param) const
+	void GetAllRegs(int *&d, double *&f, FString *&s, void **&a, VM_ATAG *&atag, VMValue *&param) const
 	{
 		// Calling the individual functions produces suboptimal code. :(
 		param = GetParam();
@@ -639,7 +641,7 @@ struct VMFrame
 		s = (FString *)(f + NumRegF);
 		a = (void **)(s + NumRegS);
 		d = (int *)(a + NumRegA);
-		atag = (VM_UBYTE *)(d + NumRegD);
+		atag = (VM_ATAG *)(d + NumRegD);
 	}
 
 	void InitRegS();
@@ -660,7 +662,7 @@ struct VMRegisters
 	double *f;
 	FString *s;
 	void **a;
-	VM_UBYTE *atag;
+	VM_ATAG *atag;
 	VMValue *param;
 };
 
@@ -669,15 +671,33 @@ struct VMException : public DObject
 	DECLARE_CLASS(VMFunction, DObject);
 };
 
+union FVoidObj
+{
+	DObject *o;
+	void *v;
+};
+
 class VMScriptFunction : public VMFunction
 {
 	DECLARE_CLASS(VMScriptFunction, VMFunction);
 public:
-	const VM_UBYTE *Code;
+	VMScriptFunction();
+	~VMScriptFunction();
+	size_t PropagateMark();
+	VM_UBYTE *AllocCode(int numops);
+	int *AllocKonstD(int numkonst);
+	double *AllocKonstF(int numkonst);
+	FString *AllocKonstS(int numkonst);
+	FVoidObj *AllocKonstA(int numkonst);
+
+	VM_ATAG *KonstATags() { return (VM_UBYTE *)(KonstA + NumKonstA); }
+	const VM_ATAG *KonstATags() const { return (VM_UBYTE *)(KonstA + NumKonstA); }
+
+	VM_UBYTE *Code;
 	int *KonstD;
 	double *KonstF;
 	FString *KonstS;
-	void **KonstA;
+	FVoidObj *KonstA;
 	int ExtraSpace;
 	int NumCodeBytes;
 	VM_UBYTE NumRegD;
@@ -724,8 +744,13 @@ class VMNativeFunction : public VMFunction
 {
 	DECLARE_CLASS(VMNativeFunction, VMFunction);
 public:
+	typedef int (*NativeCallType)(VMFrameStack *stack, VMValue *param, int numparam, VMReturn *ret, int numret);
+
+	VMNativeFunction() : NativeCall(NULL) { Native = true; }
+	VMNativeFunction(NativeCallType call) : NativeCall(call) { Native = true; }
+
 	// Return value is the number of results.
-	int (*NativeCall)(VMFrameStack *stack, VMValue *param, int numparam, VMReturn *ret, int numret);
+	NativeCallType NativeCall;
 };
 
 
@@ -762,7 +787,7 @@ public:
 		RegA++;
 	}
 
-	void ParamPointer(void *ptr, VM_UBYTE atag)
+	void ParamPointer(void *ptr, VM_ATAG atag)
 	{
 		Reg.a[RegA] = ptr;
 		Reg.atag[RegA] = atag;

src/zscript/vmexec.h

@@ -20,7 +20,8 @@ static int Exec(VMFrameStack *stack, const VM_UBYTE *pc, VMReturn *ret, int numr
 	const int *konstd;
 	const double *konstf;
 	const FString *konsts;
-	void * const *konsta;
+	const FVoidObj *konsta;
+	const VM_ATAG *konstatag;
 
 	if (f->Func != NULL && !f->Func->Native)
 	{
@@ -29,6 +30,7 @@ static int Exec(VMFrameStack *stack, const VM_UBYTE *pc, VMReturn *ret, int numr
 		konstf = sfunc->KonstF;
 		konsts = sfunc->KonstS;
 		konsta = sfunc->KonstA;
+		konstatag = sfunc->KonstATags();
 	}
 	else
 	{
@@ -37,6 +39,7 @@ static int Exec(VMFrameStack *stack, const VM_UBYTE *pc, VMReturn *ret, int numr
 		konstf = NULL;
 		konsts = NULL;
 		konsta = NULL;
+		konstatag = NULL;
 	}
 
 	void *ptr;
@@ -72,8 +75,8 @@ begin:
 		NEXTOP;
 	OP(LKP):
 		ASSERTA(a); ASSERTKA(BC);
-		reg.a[a] = konsta[BC];
-		reg.atag[a] = ATAG_OBJECT;
+		reg.a[a] = konsta[BC].v;
+		reg.atag[a] = konstatag[BC];
 		NEXTOP;
 	OP(LFP):
 		ASSERTA(a); assert(sfunc != NULL); assert(sfunc->ExtraSpace > 0);
@@ -439,7 +442,7 @@ begin:
 					break;
 				case REGT_POINTER | REGT_KONST:
 					assert(C < sfunc->NumKonstA);
-					::new(param) VMValue(konsta[C]);
+					::new(param) VMValue(konsta[C].v, konstatag[C]);
 					break;
 				case REGT_FLOAT:
 					if (b & REGT_MULTIREG)
@@ -486,7 +489,8 @@ begin:
 		NEXTOP;
 	OP(CALL_K):
 		ASSERTKA(a);
-		ptr = sfunc->KonstA[a];
+		assert(konstatag[a] == ATAG_OBJECT);
+		ptr = konsta[a].o;
 		goto Do_CALL;
 	OP(CALL):
 		ASSERTA(a);
@@ -572,7 +576,8 @@ begin:
 		else
 		{
 			ASSERTKA(B);
-			throw((VMException *)konsta[B]);
+			assert(konstatag[B] == ATAG_OBJECT);
+			throw((VMException *)konsta[B].o);
 		}
 		NEXTOP;
 	OP(CATCH):
@@ -1224,7 +1229,7 @@ begin:
 		NEXTOP;
 	OP(EQA_K):
 		ASSERTA(B); ASSERTKA(C);
-		CMPJMP(reg.a[B] == konsta[C]);
+		CMPJMP(reg.a[B] == konsta[C].v);
 		NEXTOP;
 	}
 	}
@@ -1254,7 +1259,8 @@ begin:
 				{
 					assert(pc[1] == 3);
 					ASSERTKA(b);
-					type = (PClass *)konsta[b];
+					assert(konstatag[b] == ATAG_OBJECT);
+					type = (PClass *)konsta[b].o;
 				}
 				ASSERTA(pc[3]);
 				if (type == extype)
@@ -1414,7 +1420,7 @@ static void FillReturns(const VMRegisters &reg, VMFrame *frame, VMReturn *return
 static void SetReturn(const VMRegisters &reg, VMFrame *frame, VMReturn *ret, VM_UBYTE regtype, int regnum)
 {
 	const void *src;
-	VM_UBYTE atag;
+	VM_ATAG atag;
 	VMScriptFunction *func = static_cast<VMScriptFunction *>(frame->Func);
 
 	assert(func != NULL && !func->Native);
@@ -1478,8 +1484,8 @@ static void SetReturn(const VMRegisters &reg, VMFrame *frame, VMReturn *ret, VM_
 		if (regtype & REGT_KONST)
 		{
 			assert(regnum < func->NumKonstA);
-			ret->SetPointer(func->KonstA[regnum]);
-			atag = ATAG_OBJECT;
+			ret->SetPointer(func->KonstA[regnum].v);
+			atag = func->KonstATags()[regnum];
 		}
 		else
 		{

src/zscript/vmframe.cpp

@@ -1,6 +1,95 @@
 #include <new>
 #include "vm.h"
 
+IMPLEMENT_CLASS(VMException)
+IMPLEMENT_ABSTRACT_CLASS(VMFunction)
+IMPLEMENT_CLASS(VMScriptFunction)
+IMPLEMENT_CLASS(VMNativeFunction)
+
+VMScriptFunction::VMScriptFunction()
+{
+	Native = false;
+	Code = NULL;
+	KonstD = NULL;
+	KonstF = NULL;
+	KonstS = NULL;
+	KonstA = NULL;
+	ExtraSpace = 0;
+	NumCodeBytes = 0;
+	NumRegD = 0;
+	NumRegF = 0;
+	NumRegS = 0;
+	NumRegA = 0;
+	NumKonstD = 0;
+	NumKonstF = 0;
+	NumKonstS = 0;
+	NumKonstA = 0;
+	MaxParam = 0;
+	NumArgs = 0;
+}
+
+VMScriptFunction::~VMScriptFunction()
+{
+	if (Code != NULL)		M_Free(Code);
+	if (KonstD != NULL)		M_Free(KonstD);
+	if (KonstF != NULL)		M_Free(KonstF);
+	if (KonstS != NULL)		delete[] KonstS;
+	if (KonstA != NULL)		M_Free(KonstA);
+}
+
+VM_UBYTE *VMScriptFunction::AllocCode(int numops)
+{
+	assert(Code == NULL && numops > 0);
+	numops *= VM_OPSIZE;
+	NumCodeBytes = numops;
+	return Code = (VM_UBYTE *)M_Malloc(numops);
+}
+
+int *VMScriptFunction::AllocKonstD(int numkonst)
+{
+	assert(KonstD == NULL && numkonst > 0);
+	NumKonstD = numkonst;
+	return KonstD = (int *)M_Malloc(numkonst * sizeof(int));
+}
+
+double *VMScriptFunction::AllocKonstF(int numkonst)
+{
+	assert(KonstF == NULL && numkonst > 0);
+	NumKonstF = numkonst;
+	return KonstF = (double *)M_Malloc(numkonst * sizeof(double));
+}
+
+FString *VMScriptFunction::AllocKonstS(int numkonst)
+{
+	assert(KonstS == NULL && numkonst > 0);
+	NumKonstS = numkonst;
+	return KonstS = new FString[numkonst];
+}
+
+FVoidObj *VMScriptFunction::AllocKonstA(int numkonst)
+{
+	assert(KonstA == NULL && numkonst > 0);
+	NumKonstA = numkonst;
+	return KonstA = (FVoidObj *)M_Malloc(numkonst * sizeof(FVoidObj) + numkonst);
+}
+
+size_t VMScriptFunction::PropagateMark()
+{
+	if (KonstA != NULL)
+	{
+		FVoidObj *konsta = KonstA;
+		VM_UBYTE *atag = KonstATags();
+		for (int count = NumKonstA; count > 0; --count)
+		{
+			if (*atag++ == ATAG_OBJECT)
+			{
+				GC::Mark(konsta->o);
+			}
+			konsta++;
+		}
+	}
+	return NumKonstA * sizeof(void *) + Super::PropagateMark();
+}
 
 //===========================================================================
 //