Ben / Nujel

/* Nujel - Copyright (C) 2020-2022 - Benjamin Vincent Schulenburg
 * This project uses the MIT license, a copy should be included under /LICENSE */
#ifndef NUJEL_AMALGAMATION
#include "nujel-private.h"
#endif

#include <string.h>
#include <stdlib.h>

#if !defined(NUJEL_USE_JUMPTABLE)
#if defined(__GNUC__)
#define NUJEL_USE_JUMPTABLE 1
#endif
#endif

NORETURN void throwStackUnderflowError(lClosure *c, const char *opcode){
	char buf[128];
	snprintf(buf, sizeof(buf), "Stack underflow at during lop%s", opcode);
	buf[sizeof(buf)-1] = 0;
	lExceptionThrowValClo("stack-underflow", buf, NIL, c);
}

/* Read an encoded signed 16-bit offset at ip */
i64 lBytecodeGetOffset16(const lBytecodeOp *ip){
	const int x = (ip[0] << 8) | ip[1];
	return (x < (1 << 15)) ? x : -((1<<16) - x);
}

/* Build a list of length len in stack starting at sp */
static lVal lStackBuildList(lVal *stack, int sp, int len){
	if(unlikely(len == 0)){return NIL;}
	const int nsp = sp - len;
	lVal ret = lCons(stack[nsp], NIL);
	lVal t = ret;
	stack = &stack[sp - (len-1)];
	for(int i = 0; i < (len-1); i++){
		t.vList->cdr = lCons(stack[i], NIL);
		t = t.vList->cdr;
	}
	return ret;
}

static void lBytecodeEnsureSufficientStack(lThread *ctx){
	const int closureSizeLeft = (ctx->closureStackSize - ctx->csp) - 1;
	if(unlikely(closureSizeLeft < 16)){
		ctx->closureStackSize += 32;
		lClosure **t = realloc(ctx->closureStack, ctx->closureStackSize * sizeof(lClosure *));
		if(unlikely(t == NULL)){ exit(56); }
		ctx->closureStack = t;
	}

	const int valueSizeLeft = ctx->valueStackSize - ctx->sp;
	if(unlikely(valueSizeLeft < 32)){
		ctx->valueStackSize += 128;
		lVal *t = realloc(ctx->valueStack, ctx->valueStackSize * sizeof(lVal));
		if(unlikely(t == NULL)){ exit(57); }
		ctx->valueStack = t;
	}
}

#define vmdispatch(o)	switch(o)
#define vmcase(l)	case l:
#define vmbreak	break

/* Evaluate ops within callingClosure after pushing args on the stack */
lVal lBytecodeEval(lClosure *callingClosure, lBytecodeArray *text){
	jmp_buf oldExceptionTarget;
	lBytecodeOp *ip;
	lBytecodeArray * volatile ops = text;
	lClosure * volatile c = callingClosure;
	lThread ctx;
	const lVal * volatile lits = text->literals->data;

	#ifdef NUJEL_USE_JUMPTABLE
	#undef vmdispatch
	#undef vmcase
	#undef vmbreak

	#define vmdispatch(x)	goto *vmJumptable[x];
	#define vmcase(label)	l##label:
	#define vmbreak	vmdispatch(*ip++);

	static const void *const vmJumptable[256] = {
		&&llopNOP,
		&&llopRet,
		&&llopIntByte,
		&&llopIntAdd,
		&&llopApply,
		&&llopSetVal,
		&&llopPushValExt,
		&&llopDefVal,
		&&llopDefValExt,
		&&llopJmp,
		&&llopJt,
		&&llopJf,
		&&llopDup,
		&&llopDrop,
		&&llopGetVal,
		&&llopGetValExt,
		&&llopSetValExt,
		&&llopCar,
		&&llopCdr,
		&&llopClosurePush,
		&&llopCons,
		&&llopLet,
		&&llopClosurePop,
		&&llopFnDynamic,
		&&llopMacroDynamic,
		&&llopTry,
		&&llopPushVal,
		&&llopPushTrue,
		&&llopPushFalse,
		&&llopEval,
		&&llopLessPred,
		&&llopLessEqPred,
		&&llopEqualPred,
		&&llopGreaterEqPred,
		&&llopGreaterPred,
		&&llopIncInt,
		&&llopPushNil,
		&&llopAdd,
		&&llopSub,
		&&llopMul,
		&&llopDiv,
		&&llopRem,
		&&llopZeroPred,
		&&llopRef,
		&&llopCadr,
		&&llopMutableEval,
		&&llopList
	};
	#endif

	if(unlikely(++exceptionTargetDepth > RECURSION_DEPTH_MAX)){
		exceptionTargetDepth--;
		lExceptionThrowValClo("too-deep", "Recursing too deep", NIL, NULL);
		return NIL;
	}

	ctx.closureStackSize = 256;
	ctx.valueStackSize   = 32;
	ctx.closureStack     = malloc(ctx.closureStackSize * sizeof(lClosure *));
	ctx.valueStack       = malloc(ctx.valueStackSize * sizeof(lVal));
	ctx.csp              = 0;
	ctx.sp               = 0;
	ctx.closureStack[0]  = c;
	ctx.text             = text;

	int exceptionCount = 0;
	const int RSP = lRootsGet();
	lRootsClosurePush(callingClosure);
	lRootsThreadPush(&ctx);

	memcpy(oldExceptionTarget,exceptionTarget,sizeof(jmp_buf));
	const int setjmpRet = setjmp(exceptionTarget);
	if(unlikely(setjmpRet)){
		while((ctx.csp > 0) && (c->type != closureTry)){
			ctx.csp--;
			c = ctx.closureStack[ctx.csp];
		}
		if((ctx.csp > 0) && (++exceptionCount < 1000)){
			lVal handler = c->exceptionHandler;

			c = ctx.closureStack[--ctx.csp];
			ops = c->text;
			lits = ops->literals->data;
			ctx.text = ops;
			ip = c->ip;
			ctx.sp = c->sp;
			ctx.valueStack[ctx.sp++] = lApply(c, lCons(exceptionValue, NIL), handler);
		} else {
			exceptionTargetDepth--;
			memcpy(exceptionTarget, oldExceptionTarget, sizeof(jmp_buf));
			free(ctx.closureStack);
			free(ctx.valueStack);
			lRootsRet(RSP);
			lExceptionThrowRaw(exceptionValue);
			return NIL;
		}
	} else {
		ip = ops->data;
		lGarbageCollectIfNecessary();
	}

	while(true){
		#ifdef VM_RUNTIME_CHECKS
		if(unlikely(ctx.csp >= ctx.closureStackSize-1)){
			ctx.closureStackSize *= 2;
			lClosure **newStack = realloc(ctx.closureStack, ctx.closureStackSize * sizeof(lClosure*));
			if (unlikely(newStack == NULL)) {
				goto topLevelNoReturn;
			}
			ctx.closureStack = newStack;
		}
		if(unlikely(ctx.sp >= ctx.valueStackSize-1)){
			ctx.valueStackSize *= 2;
			lVal **newStack = realloc(ctx.valueStack, ctx.valueStackSize * sizeof(lVal*));
			if (unlikely(newStack == NULL)) {
				goto topLevelNoReturn;
			}
			ctx.valueStack = newStack;
		}
		#endif
	vmdispatch(*ip++){
	vmcase(lopNOP)
		vmbreak;
	vmcase(lopIntByte) {
		const i8 v = *ip++;
		ctx.valueStack[ctx.sp++] = lValInt(v);
		vmbreak;}
	vmcase(lopAdd)
		ctx.valueStack[ctx.sp-2] = lAdd(c, ctx.valueStack[ctx.sp-2], ctx.valueStack[ctx.sp-1]);
		ctx.sp--;
		vmbreak;
	vmcase(lopSub)
		ctx.valueStack[ctx.sp-2] = lSub(c, ctx.valueStack[ctx.sp-2], ctx.valueStack[ctx.sp-1]);
		ctx.sp--;
		vmbreak;
	vmcase(lopMul)
		ctx.valueStack[ctx.sp-2] = lMul(c, ctx.valueStack[ctx.sp-2], ctx.valueStack[ctx.sp-1]);
		ctx.sp--;
		vmbreak;
	vmcase(lopDiv)
		ctx.valueStack[ctx.sp-2] = lDiv(c, ctx.valueStack[ctx.sp-2], ctx.valueStack[ctx.sp-1]);
		ctx.sp--;
		vmbreak;
	vmcase(lopRem)
		ctx.valueStack[ctx.sp-2] = lRem(c, ctx.valueStack[ctx.sp-2], ctx.valueStack[ctx.sp-1]);
		ctx.sp--;
		vmbreak;
	vmcase(lopIntAdd)
		ctx.valueStack[ctx.sp-2].vInt = ctx.valueStack[ctx.sp-2].vInt + ctx.valueStack[ctx.sp-1].vInt;
		ctx.sp--;
		vmbreak;
	vmcase(lopCons)
		ctx.valueStack[ctx.sp-2] = lCons(ctx.valueStack[ctx.sp-2], ctx.valueStack[ctx.sp-1]);
		ctx.sp--;
		vmbreak;
	vmcase(lopLessPred) {
		lVal a = ctx.valueStack[ctx.sp-2];
		lVal b = ctx.valueStack[ctx.sp-1];
		ctx.valueStack[ctx.sp-2] = lValBool(lValGreater(a, b) < 0);
		ctx.sp--;
		vmbreak; }
	vmcase(lopLessEqPred) {
		lVal a = ctx.valueStack[ctx.sp-2];
		lVal b = ctx.valueStack[ctx.sp-1];
		ctx.valueStack[ctx.sp-2] = lValBool(lValGreater(a, b) <= 0);
		ctx.sp--;
		vmbreak; }
	vmcase(lopEqualPred) {
		lVal a = ctx.valueStack[ctx.sp-2];
		lVal b = ctx.valueStack[ctx.sp-1];
		ctx.valueStack[ctx.sp-2] = lValBool(lValEqual(a, b));
		ctx.sp--;
		vmbreak; }
	vmcase(lopGreaterEqPred) {
		lVal a = ctx.valueStack[ctx.sp-2];
		lVal b = ctx.valueStack[ctx.sp-1];
		ctx.valueStack[ctx.sp-2] = lValBool(lValGreater(a,b) >= 0);
		ctx.sp--;
		vmbreak; }
	vmcase(lopGreaterPred) {
		lVal a = ctx.valueStack[ctx.sp-2];
		lVal b = ctx.valueStack[ctx.sp-1];
		ctx.valueStack[ctx.sp-2] = lValBool(lValGreater(a, b) > 0);
		ctx.sp--;
		vmbreak; }
	vmcase(lopPushNil)
		ctx.valueStack[ctx.sp++] = NIL;
		vmbreak;
	vmcase(lopPushTrue)
		ctx.valueStack[ctx.sp++] = lValBool(true);
		vmbreak;
	vmcase(lopPushFalse)
		ctx.valueStack[ctx.sp++] = lValBool(false);
		vmbreak;
	vmcase(lopPushValExt) {
		const uint v = (ip[0] << 8) | (ip[1]);
		ip += 2;
		ctx.valueStack[ctx.sp++] = lits[v];
		vmbreak; }
	vmcase(lopPushVal) {
		const uint v = *ip++;
		ctx.valueStack[ctx.sp++] = lits[v];
		vmbreak; }
	vmcase(lopDup)
		ctx.sp++;
		ctx.valueStack[ctx.sp-1] = ctx.valueStack[ctx.sp-2];
		vmbreak;
	vmcase(lopDrop)
		ctx.sp--;
		vmbreak;
	vmcase(lopJmp)
		lGarbageCollectIfNecessary();
		ip += lBytecodeGetOffset16(ip)-1;
		vmbreak;
	vmcase(lopJt)
		lGarbageCollectIfNecessary();
		ip +=  castToBool(ctx.valueStack[--ctx.sp]) ? lBytecodeGetOffset16(ip)-1 : 2;
		vmbreak;
	vmcase(lopJf)
		lGarbageCollectIfNecessary();
		ip += !castToBool(ctx.valueStack[--ctx.sp]) ? lBytecodeGetOffset16(ip)-1 : 2;
		vmbreak;
	vmcase(lopDefValExt) {
		uint v;
		v = (ip[0] << 8) | (ip[1]);
		ip += 2;
		goto defValBody;
	vmcase(lopDefVal)
		v = *ip++;
		defValBody:
		lDefineClosureSym(c, lits[v].vSymbol, ctx.valueStack[ctx.sp-1]);
		vmbreak; }
	vmcase(lopGetValExt) {
		uint v;
		v = (ip[0] << 8) | (ip[1]);
		ip += 2;
		goto getValBody;
	vmcase(lopGetVal)
		v = *ip++;
		getValBody:
		ctx.valueStack[ctx.sp++] = lGetClosureSym(c, lits[v].vSymbol);
		vmbreak; }
	vmcase(lopRef)
		ctx.valueStack[ctx.sp-2] = lGenericRef(c, ctx.valueStack[ctx.sp-2], ctx.valueStack[ctx.sp-1]);
		ctx.sp--;
		vmbreak;
	vmcase(lopSetValExt) {
		uint v = (ip[0] << 8) | (ip[1]);
		ip += 2;
		goto setValBody;
	vmcase(lopSetVal)
		v = *ip++;
		setValBody:
		lSetClosureSym(c, lits[v].vSymbol, ctx.valueStack[ctx.sp-1]);
		vmbreak; }
	vmcase(lopZeroPred) {
		lVal a = ctx.valueStack[ctx.sp-1];
		bool p = false;

		if(likely(a.type == ltInt)){
			p = a.vInt == 0;
		}else if(a.type == ltFloat){
			p = a.vFloat == 0.0;
		}

		ctx.valueStack[ctx.sp-1] = lValBool(p);
		vmbreak; }
	vmcase(lopIncInt)
		if(likely(ctx.valueStack[ctx.sp-1].type == ltInt)){
			ctx.valueStack[ctx.sp-1] = lValInt(ctx.valueStack[ctx.sp-1].vInt + 1);
		}
		vmbreak;
	vmcase(lopCar)
		ctx.valueStack[ctx.sp-1] = lCar(ctx.valueStack[ctx.sp-1]);
		vmbreak;
	vmcase(lopCdr)
		ctx.valueStack[ctx.sp-1] = lCdr(ctx.valueStack[ctx.sp-1]);
		vmbreak;
	vmcase(lopCadr)
		ctx.valueStack[ctx.sp-1] = lCadr(ctx.valueStack[ctx.sp-1]);
		vmbreak;
	vmcase(lopList) {
		int len = *ip++;
		lVal cargs = lStackBuildList(ctx.valueStack, ctx.sp, len);
		ctx.sp = ctx.sp - len;
		ctx.valueStack[ctx.sp++] = cargs;
		vmbreak; }
	vmcase(lopClosurePush)
		ctx.valueStack[ctx.sp++] = lValEnvironment(c);
		vmbreak;
	vmcase(lopLet)
		c = lClosureNew(c, closureLet);
		c->type = closureLet;
		ctx.closureStack[++ctx.csp] = c;
		vmbreak;
	vmcase(lopClosurePop)
		c = ctx.closureStack[--ctx.csp];
		vmbreak;
	vmcase(lopTry)
		c->ip   = ip + lBytecodeGetOffset16(ip)-1;
		c->sp   = ctx.sp;
		c->text = ops;

		c = lClosureNew(c, closureTry);
		c->exceptionHandler = ctx.valueStack[--ctx.sp];
		ctx.closureStack[++ctx.csp] = c;
		ip+=2;
		vmbreak;
	vmcase(lopMacroDynamic)
	vmcase(lopFnDynamic) {
		const lBytecodeOp curOp = ip[-1];
		lVal cBody = ctx.valueStack[--ctx.sp];
		lVal cDocs = ctx.valueStack[--ctx.sp];
		lVal cArgs = ctx.valueStack[--ctx.sp];
		lVal fun = lLambdaNew(c, cArgs, cBody);
		lClosureSetMeta(fun.vClosure, cDocs);
		if(unlikely(curOp == lopMacroDynamic)){
			fun.type = ltMacro;
		}
		ctx.valueStack[ctx.sp++] = fun;
		vmbreak; }
	vmcase(lopMutableEval)
	vmcase(lopEval) {
		const lBytecodeOp curOp = ip[-1];
		lVal env = ctx.valueStack[--ctx.sp];
		lVal bc = ctx.valueStack[--ctx.sp];
		if(unlikely(env.type != ltEnvironment)){
			lExceptionThrowValClo("type-error", "Can't eval in that", env, c);
		}
		if(unlikely(bc.type != ltBytecodeArr)){
			lExceptionThrowValClo("type-error", "Can't eval that", bc, c);
		}

		c->text = ops;
		c->sp   = ctx.sp;
		c->ip   = ip;

		if(unlikely(curOp == lopMutableEval)){
			c = ctx.closureStack[++ctx.csp] = env.vClosure;
		} else {
			c = ctx.closureStack[++ctx.csp] = lClosureNew(env.vClosure, closureCall);
		}

		c->text = bc.vBytecodeArr;
		ip = c->ip = c->text->data;
		ctx.text = ops = c->text;
		lits = ops->literals->data;
		lBytecodeEnsureSufficientStack(&ctx);
		lGarbageCollectIfNecessary();

		vmbreak; }
	vmcase(lopApply) {
		int len = *ip++;
		lVal cargs = lStackBuildList(ctx.valueStack, ctx.sp, len);
		ctx.sp = ctx.sp - len;
		lVal fun = ctx.valueStack[--ctx.sp];
		switch(fun.type){
		case ltMacro:
		case ltLambda:
			c->text = ops;
			c->sp   = ctx.sp;
			c->ip   = ip;

			ctx.closureStack[++ctx.csp] = lClosureNewFunCall(c, cargs, fun);
			c = ctx.closureStack[ctx.csp];
			ip = c->ip;
			ctx.text = ops = c->text;
			lits = ops->literals->data;
			lBytecodeEnsureSufficientStack(&ctx);
			lGarbageCollectIfNecessary();
			break;
		case ltNativeFunc:
			ctx.valueStack[ctx.sp++] = fun.vNFunc->fp(c, cargs);
			break;
		default:
			lExceptionThrowValClo("type-error", "Can't apply to following val", fun, c);
			break;
		}
		vmbreak; }
	vmcase(lopRet)
		if(likely(ctx.csp > 0)){
			while(ctx.closureStack[ctx.csp]->type != closureCall){
				if(unlikely(--ctx.csp <= 0)){goto topLevelReturn;}
			}
			lVal ret = ctx.valueStack[ctx.sp-1];
			c   = ctx.closureStack[--ctx.csp];
			ip  = c->ip;
			ops = c->text;
			lits = ops->literals->data;
			ctx.text = ops;
			ctx.sp = c->sp;
			ctx.valueStack[ctx.sp++] = ret;
			vmbreak;
		}
		topLevelReturn:
		memcpy(exceptionTarget, oldExceptionTarget, sizeof(jmp_buf));
		exceptionTargetDepth--;
		lVal ret = ctx.valueStack[ctx.sp-1];
		free(ctx.closureStack);
		free(ctx.valueStack);
		lRootsRet(RSP);
		return ret;
	}}
}