compilation of functions, and some parts of interpreting them

12 files changed, 186 insertions, 99 deletions

diff --git a/Makefile b/Makefile
index 907afb5..58ef051 100644
--- a/Makefile
+++ b/Makefile
@@ -1,5 +1,5 @@
-CS=ast.c com.c dis.c ht.c mem.c prs.c read.c state.c val.c vm.c
-HS=ast.h       dis.h ht.h mem.h prs.h read.h state.h val.h vm.h
+CS=ast.c         com.c dis.c ht.c mem.c prs.c read.c state.c val.c vm.c
+HS=ast.h chunk.h com.h dis.h ht.h mem.h prs.h read.h state.h val.h vm.h
 CFLAGS=$(EXTRA_CFLAGS) -O3 -lm -Wall -Wpedantic -Werror=implicit-function-declaration
 
 bth: $(CS) $(HS) Makefile
diff --git a/com.c b/com.c
index 92f0d80..5a98ef1 100644
--- a/com.c
+++ b/com.c
@@ -36,7 +36,6 @@ Compiler compiler_new(Compiler *outer, Chunk *ch) {
 
 
 size_t chunk_wbc(Compiler *C, uint8_t byte) {
-	printf("\t%p %hd\n",C, byte);
 	Chunk *ch = C->ch;
 	if (ch->bc.len == ch->bc.cap) {
 		size_t newsz = (ch->bc.cap == 0 ? 8 : ch->bc.cap * 2);
@@ -168,7 +167,7 @@ void fn_form(Compiler *C, AstVec l, Op op) {
 	AstVec arglist = l.vals[1].as.list;
 
 	ObjFunc *func = objfunc_new(C->S);
-	Compiler subcompiler = compiler_new(C, &func->chunk);
+	Compiler subcompiler = compiler_new(C, &func->ch);
 
 	for (int i = 2; i < l.len - 1; i++) {
 		compile_node(&subcompiler, l.vals[i]);
@@ -219,16 +218,15 @@ static void compile_node(Compiler *C, AstNode a) {
 	switch (a.ty) {
 	case AST_IDENT:;
 		char *ident = a.as.str;
-		BuiltinIdent *found_builtin = NULL;
+		bool found_builtin = false;
 		for (BuiltinIdent *b = builtin_idents; b->name != NULL; b++) {
 			if (0 == strcmp(b->name, ident)) {
-				found_builtin = b;
+				chunk_wbc(C, b->op);
+				found_builtin = true;
 				break;
 			}
 		}
-		if (found_builtin != NULL) {
-			chunk_wbc(C, found_builtin->op);
-		} else {
+		if (!found_builtin) {
 			// read global variable
 			ObjString *o = objstring_copy_cstr(C->S, a.as.str);
 			chunk_wbc(C, OP_GETGLOBAL);
@@ -250,16 +248,17 @@ static void compile_node(Compiler *C, AstNode a) {
 
 		#define CK(cond, msg) if (!(cond)) { fputs(msg "\n", stderr); exit(1); }
 		CK(l.len > 0, "can't handle empty list");
-		CK(l.vals[0].ty == AST_IDENT, "can only call ops");
 		#undef CK
 
-		char *head = l.vals[0].as.str;
-
 		BuiltinForm *form = NULL;
-		for (BuiltinForm *b = builtin_forms; b->name != NULL; b++) {
-			if (0 == strcmp(b->name, head)) {
-				form = b;
-				break;
+
+		if (l.vals[0].ty == AST_IDENT) {
+			char *head = l.vals[0].as.str;
+			for (BuiltinForm *b = builtin_forms; b->name != NULL; b++) {
+				if (0 == strcmp(b->name, head)) {
+					form = b;
+					break;
+				}
 			}
 		}
 
@@ -276,8 +275,17 @@ static void compile_node(Compiler *C, AstNode a) {
 
 			form->action(C, l, form->op);
 		} else {
-			fprintf(stderr, "unknown form %s\n", head);
-			exit(1);
+			// function call
+			// (f a b c )
+			if (l.len > 255) {
+				fprintf(stderr, "can't have more than 255 args in a function call\n");
+				exit(1);
+			}
+			for (int i = 0; i < l.len; i++) {
+				compile_node(C, l.vals[i]);
+			}
+			chunk_wbc(C, OP_CALL);
+			chunk_wbc(C, l.len);
 		}
 
 		break;
@@ -291,6 +299,7 @@ int main(int argc, char **argv) {
 	Chunk ch = chunk_new(S);
 
 	S->do_disasm = (argc > 1 && 0 == strcmp(argv[1], "-l"));
+	S->do_trace = false;
 
 	char n1[] = "foo";
 	char n2[] = "bar";
@@ -314,7 +323,7 @@ int main(int argc, char **argv) {
 
 
 	chunk_wbc(C, OP_PUTS);
-	chunk_wbc(C, OP_RET);
+	chunk_wbc(C, OP_HALT);
 
 	Thread th = thread_new(S);
 	th.ch = &ch;
diff --git a/dis.c b/dis.c
index 5097b05..0b22ac3 100644
--- a/dis.c
+++ b/dis.c
@@ -10,90 +10,116 @@ static void print_const(Chunk *ch, uint8_t ix) {
 	println_val(k);
 }
 
+static void disasm_chunk_h(Chunk *ch, int depth);
 void disasm_chunk(Chunk *ch) {
-	puts("constants:");
+	disasm_chunk_h(ch, 0);
+}
+
+static size_t disasm_instr_h(Chunk *ch, size_t ip, int depth);
+size_t disasm_instr(Chunk *ch, size_t ip) {
+	return disasm_instr_h(ch, ip, 0);
+}
+
+
+static size_t disasm_instr_h(Chunk *ch, size_t ip, int depth) {
+	size_t orig_ip = ip;
+	uint8_t instr = ch->bc.d[ip];
+	printf("%*s%04zd\t",depth,"",ip);
+	ip ++;
+	switch (instr) {
+	case OP_LOADK: {
+		uint8_t ix = ch->bc.d[ip++];
+		printf("loadk #%d\t; ",ix);
+		print_const(ch, ix);
+		break;
+	}
+	case OP_GETGLOBAL: {
+		uint8_t ix = ch->bc.d[ip++];
+		printf("getglobal #%d\t; ",ix);
+		print_const(ch, ix);
+		break;
+	}
+	case OP_SETGLOBAL: {
+		uint8_t ix = ch->bc.d[ip++];
+		printf("setglobal #%d\t; ",ix);
+		print_const(ch, ix);
+		break;
+	}
+	case OP_CALL: {
+		uint8_t nargs = ch->bc.d[ip++];
+		printf("call #%hhu\n",nargs);
+		break;
+	}
+	#define RSHORT() (uint16_t)( ch->bc.d[ip-2] | ch->bc.d[ip-1] << 8 )
+	case OP_SKIP: {
+		ip += 2;
+		uint16_t offset = RSHORT();
+		printf("skip +%5hu\t; -> %04zd\n", offset, ip + offset);
+		break;
+	}
+	case OP_0BRANCH: {
+		ip += 2;
+		uint16_t offset = RSHORT();
+		printf("0branch +%5hu\t; -> %04zd\n", offset, ip + offset);
+		break;
+	}
+	case OP_REDO: {
+		ip += 2;
+		uint16_t offset = RSHORT();
+		printf("redo -%5hu\t; -> %04zd\n", offset, ip - offset);
+		break;
+	}
+	#undef RSHORT
+
+	#define SIMPLE_INSTR(opcode, str) \
+		case opcode: puts(str); break;
+	SIMPLE_INSTR(OP_RET, "ret")
+	SIMPLE_INSTR(OP_PUTS, "puts")
+	SIMPLE_INSTR(OP_PRINT, "print")
+	SIMPLE_INSTR(OP_DROP, "drop")
+	SIMPLE_INSTR(OP_ADD, "add")
+	SIMPLE_INSTR(OP_SUB, "sub")
+	SIMPLE_INSTR(OP_MUL, "mul")
+	SIMPLE_INSTR(OP_DIV, "div")
+	SIMPLE_INSTR(OP_MOD, "mod")
+	SIMPLE_INSTR(OP_NIL, "nil")
+	SIMPLE_INSTR(OP_TRUE, "true")
+	SIMPLE_INSTR(OP_FALSE, "false")
+	SIMPLE_INSTR(OP_CMP, "cmp")
+	SIMPLE_INSTR(OP_EQU, "equ")
+	SIMPLE_INSTR(OP_HALT, "halt")
+	#undef SIMPLE_INSTR
+
+	default:
+		printf("unknown opcode %d\n", instr);
+		exit(2);
+
+	}
+
+	return ip - orig_ip;
+
+}
+
+static void disasm_chunk_h(Chunk *ch, int depth) {
+	#define P(msg) printf("%*s%s\n",depth,"",msg);
+	P("constants:");
 	for (uint8_t cix = 0; cix < ch->consts.len; cix++) {
-		printf("%hd\t",cix);
+		printf("%*s%hd\t",depth,"",cix);
 		print_const(ch, cix);
 	}
 
-	puts("bytecode:");
+	P("bytecode:");
+	#undef P
 	for (size_t ip = 0; ip < ch->bc.len; ) {
-		uint8_t instr = ch->bc.d[ip];
-		printf("%04zd\t",ip);
-		ip ++;
-		switch (instr) {
-		case OP_LOADK: {
-			uint8_t ix = ch->bc.d[ip++];
-			printf("loadk #%d\t; ",ix);
-			print_const(ch, ix);
-			break;
-		}
-		case OP_GETGLOBAL: {
-			uint8_t ix = ch->bc.d[ip++];
-			printf("getglobal #%d\t; ",ix);
-			print_const(ch, ix);
-			break;
-		}
-		case OP_SETGLOBAL: {
-			uint8_t ix = ch->bc.d[ip++];
-			printf("setglobal #%d\t; ",ix);
-			print_const(ch, ix);
-			break;
-		}
-		#define RSHORT() (uint16_t)( ch->bc.d[ip-2] | ch->bc.d[ip-1] << 8 )
-		case OP_SKIP: {
-			ip += 2;
-			uint16_t offset = RSHORT();
-			printf("skip +%5hu\t; -> %04zd\n", offset, ip + offset);
-			break;
-		}
-		case OP_0BRANCH: {
-			ip += 2;
-			uint16_t offset = RSHORT();
-			printf("0branch +%5hu\t; -> %04zd\n", offset, ip + offset);
-			break;
-		}
-		case OP_REDO: {
-			ip += 2;
-			uint16_t offset = RSHORT();
-			printf("redo -%5hu\t; -> %04zd\n", offset, ip - offset);
-			break;
-		}
-		#undef RSHORT
-
-
-#define SIMPLE_INSTR(opcode, str) \
-	case opcode: puts(str); break;
-		SIMPLE_INSTR(OP_RET, "ret")
-		SIMPLE_INSTR(OP_PUTS, "puts")
-		SIMPLE_INSTR(OP_PRINT, "print")
-		SIMPLE_INSTR(OP_DROP, "drop")
-		SIMPLE_INSTR(OP_ADD, "add")
-		SIMPLE_INSTR(OP_SUB, "sub")
-		SIMPLE_INSTR(OP_MUL, "mul")
-		SIMPLE_INSTR(OP_DIV, "div")
-		SIMPLE_INSTR(OP_MOD, "mod")
-		SIMPLE_INSTR(OP_NIL, "nil")
-		SIMPLE_INSTR(OP_TRUE, "true")
-		SIMPLE_INSTR(OP_FALSE, "false")
-		SIMPLE_INSTR(OP_CMP, "cmp")
-		SIMPLE_INSTR(OP_EQU, "equ")
-#undef SIMPLE_INSTR
-
-		default:
-			printf("unknown opcode %d\n", instr);
-			exit(2);
-
-		}
+		ip += disasm_instr_h(ch, ip, depth);
 	}
 	printf("\n");
 
 	for (uint8_t cix = 0; cix < ch->consts.len; cix++) {
 		Val c = ch->consts.d[cix];
 		if (IS_FUNC(c)) {
-			printf("const %d is function:\n", cix);
-			disasm_chunk(&AS_FUNC(c)->chunk);
+			printf("%*sconst %d is function:\n",depth,"", cix);
+			disasm_chunk_h(&AS_FUNC(c)->ch,depth+4);
 		}
 	}
 
diff --git a/dis.h b/dis.h
index 47aff62..8a26c8a 100644
--- a/dis.h
+++ b/dis.h
@@ -4,5 +4,7 @@
 #include "vm.h"
 
 void disasm_chunk(Chunk *ch);
+// returns length of disasmed instr in bytes
+size_t disasm_instr(Chunk *ch, size_t ip);
 
 #endif
diff --git a/run_tests.sh b/run_tests.sh
index ffa1a22..073d12c 100755
--- a/run_tests.sh
+++ b/run_tests.sh
@@ -15,7 +15,7 @@ for testfile in tests/*.bth; do
 	0) 	printf '\033[32m\033[1mPASS\033[0m %s\n' "$testname"
 		pass=$((pass + 1)) ;;
 	1) 	printf '\033[31m\033[1mFAIL\033[0m %s\n' "$testname"
-		printf "\tgot output: %s\n" "$output"
+		printf "\tgot output: %s\n" "$(echo "$output" | head -n4)"
 		printf "\texpected: "
 		cat $outfile
 		fail=$((fail + 1)) ;;
diff --git a/state.h b/state.h
index dab9a97..762d519 100644
--- a/state.h
+++ b/state.h
@@ -12,6 +12,7 @@ struct _state {
 	Ht globals;
 
 	bool do_disasm;
+	bool do_trace;
 };
 State state_new();
 
diff --git a/tests/func1.bth b/tests/func1.bth
new file mode 100644
index 0000000..c46e956
--- /dev/null
+++ b/tests/func1.bth
@@ -0,0 +1,3 @@
+(do
+	(set f (fn (_) 42))
+	(f 0))
diff --git a/tests/func1.out b/tests/func1.out
new file mode 100644
index 0000000..d81cc07
--- /dev/null
+++ b/tests/func1.out
@@ -0,0 +1 @@
+42
diff --git a/val.c b/val.c
index 621b073..930ebd8 100644
--- a/val.c
+++ b/val.c
@@ -49,7 +49,7 @@ static ObjString *objstring_create(State *S, char *src, size_t len, uint32_t has
 
 ObjFunc *objfunc_new(State *S) {
 	ObjFunc *o = NEW_OBJ(S, ObjFunc, OTY_FUNC);
-	o->chunk = chunk_new(S);
+	o->ch = chunk_new(S);
 	return o;
 }
 
diff --git a/val.h b/val.h
index c71e419..6aa85c5 100644
--- a/val.h
+++ b/val.h
@@ -53,7 +53,7 @@ typedef struct {
 
 typedef struct {
 	Obj obj;
-	Chunk chunk;
+	Chunk ch;
 } ObjFunc;
 
 // Constructs a new objstring from the given C string,
diff --git a/vm.c b/vm.c
index 3410e1c..4e412c1 100644
--- a/vm.c
+++ b/vm.c
@@ -41,12 +41,13 @@ int runvm(State *S) {
 #define PEEK()  (th->stack[th->sp-1])
 
 	while (1) {
+		ch = th->ch;
+		if (S->do_trace) {
+			printf("%p ",(void *)ch);
+			disasm_instr(ch, th->ip);
+		}
 		uint8_t instr = RBYTE();
 		switch (instr) {
-		case OP_RET:
-			status  = 0;
-			goto done;
-			break;
 		case OP_LOADK: {
 			uint8_t cix = RBYTE();
 			Val v = ch->consts.d[cix];
@@ -155,7 +156,39 @@ int runvm(State *S) {
 		case OP_TRUE: PUSH(VAL_TRUE); break;
 		case OP_FALSE: PUSH(VAL_FALSE); break;
 
+		case OP_CALL: {
+			uint8_t len = RBYTE();
+			// ignore arguments for now
+			th->sp -= len-1;
+			Val callee = POP();
+			if (!IS_FUNC(callee)) {
+				fprintf(stderr, "can only call functions\n");
+				goto done;
+			}
+			ObjFunc *func = AS_FUNC(callee);
+
+			StackFrame *sf = &th->rstack[th->rsp++];
+			sf->ch = th->ch;
+			sf->ip = th->ip;
+
+			th->ch = &func->ch;
+			th->ip = 0;
 		}
+		break;
+
+		case OP_RET: {
+			StackFrame *sf = &th->rstack[--th->rsp]; 
+			th->ch = sf->ch;
+			th->ip = sf->ip;
+			break;
+		}
+		case OP_HALT:
+			status = 0;
+			goto done;
+			break;
+
+		}
+
 	}
 	done:;
 	return status;
diff --git a/vm.h b/vm.h
index c75df82..74fe506 100644
--- a/vm.h
+++ b/vm.h
@@ -10,12 +10,21 @@ typedef struct _thread Thread;
 #include "val.h"
 #include "com.h"
 
-#define STACKSIZE 128
+typedef struct {
+	size_t ip;
+	Chunk *ch;
+
+} StackFrame;
+
+#define MAXDEPTH  64
+#define STACKSIZE 256*MAXDEPTH
 typedef struct _thread {
 	Chunk *ch;
 	size_t ip;
 	Val stack[STACKSIZE];
 	size_t sp;
+	StackFrame rstack[MAXDEPTH];
+	size_t rsp;
 } Thread;
 Thread thread_new(State *S);
 
@@ -34,6 +43,7 @@ typedef enum {
 	OP_EQU,
 	OP_CMP,
 
+	OP_HALT,
 
 	OP_DROP,
 
@@ -47,6 +57,8 @@ typedef enum {
 	OP_0BRANCH,
 	OP_SKIP,
 	OP_REDO,
+
+	OP_CALL,
 } Op;
 
 int runvm(State *S);