sin, cos, more checks

7 files changed, 196 insertions, 1 deletions

diff --git a/com.c b/com.c
index f610bd7..432ebb4 100644
--- a/com.c
+++ b/com.c
@@ -9,6 +9,7 @@
 #include "util.h"
 #include "lib.h"
 #include "read.h"
+#include "dis.h"
 
 
 #define BYTECODE(C) (C->ch->bc)
@@ -363,7 +364,7 @@ static void for_form(Compiler *C, ObjArr *a, Op _, int flags) {
 	cpl_constop(C, OP_LOADK, VAL_NUM(1));
 	cpl_op(C, OP_ADD);
 	cpl_op(C, OP_SETLOCAL);
-	cpl_op(C, islot);
+	cpl_byte(C, islot);
 	cpl_op(C, OP_DROP);
 	cpl_op(C, OP_REDO);
 	size_t ph_A = placeholder(C);
@@ -593,6 +594,12 @@ static BuiltinForm *find_builtinform(char *name) {
 }
 
 static void cpl_expr(Compiler *C, Val v, int flags) {
+	int stack_cur_a = C->stack_cur;
+	int nlocals_a = 0;
+	if (C->scope) {
+		nlocals_a = C->scope->nlocals;
+	}
+
 	switch (val_type(v)) {
 	case TY_NUM: case TY_NIL: case TY_BOOL:
 		cpl_constop(C, OP_LOADK, v);
@@ -636,6 +643,18 @@ static void cpl_expr(Compiler *C, Val v, int flags) {
 		}
 		break;
 	}
+
+	int stack_cur_b = C->stack_cur;
+	int nlocals_b = C->stack_cur;
+	if (C->scope) {
+		nlocals_b = C->scope->nlocals;
+	}
+
+	// every badthing expression returns exactly one value,
+	// and might declare some locals as well, which also live on the stack
+	// so (returned values) = (stack change) - (new locals) = 1
+	CHECK( (stack_cur_b - stack_cur_a) - (nlocals_b - nlocals_a) == 1,
+	      "stack corruption (compiler bug)");
 }
 
 
diff --git a/dis.c b/dis.c
index 2d7e9a2..530ad49 100644
--- a/dis.c
+++ b/dis.c
@@ -10,6 +10,41 @@ static void print_const(Chunk *ch, uint8_t ix) {
 	println_val(k);
 }
 
+
+char *op_name(Op op) {
+	switch (op) {
+	case OP_RET:		return "ret"; break;
+	case OP_LOADK:		return "loadk"; break;
+	case OP_ADD:		return "add"; break;
+	case OP_SUB:		return "sub"; break;
+	case OP_MUL:		return "mul"; break;
+	case OP_DIV:		return "div"; break;
+	case OP_MOD:		return "mod"; break;
+	case OP_EQU:		return "equ"; break;
+	case OP_CMP:		return "cmp"; break;
+	case OP_HALT:		return "halt"; break;
+	case OP_DROP:		return "drop"; break;
+	case OP_GETGLOBAL:	return "getglobal"; break;
+	case OP_SETGLOBAL:	return "setglobal"; break;
+	case OP_GETLOCAL:	return "getlocal"; break;
+	case OP_SETLOCAL:	return "setlocal"; break;
+	case OP_TRUE:		return "true"; break;
+	case OP_FALSE:		return "false"; break;
+	case OP_NIL:		return "nil"; break;
+	case OP_0BRANCH:	return "0branch"; break;
+	case OP_SKIP:		return "skip"; break;
+	case OP_REDO:		return "redo"; break;
+	case OP_CALL:		return "call"; break;
+	case OP_TAILCALL:	return "tailcall"; break;
+	case OP_ENDSCOPE:	return "endscope"; break;
+	case OP_ARRNEW:		return "arrnew"; break;
+	case OP_ARRAPPEND:	return "arrappend"; break;
+	case OP_ARRLEN:		return "arrlen"; break;
+	case OP_SETIDX:		return "setidx"; break;
+	default: return "???"; break;
+	}
+}
+
 static void disasm_chunk_h(Chunk *ch, int depth);
 void disasm_chunk(Chunk *ch) {
 	disasm_chunk_h(ch, 0);
diff --git a/dis.h b/dis.h
index 8a26c8a..47b73a6 100644
--- a/dis.h
+++ b/dis.h
@@ -7,4 +7,6 @@ void disasm_chunk(Chunk *ch);
 // returns length of disasmed instr in bytes
 size_t disasm_instr(Chunk *ch, size_t ip);
 
+char *op_name(Op op);
+
 #endif
diff --git a/lib.c b/lib.c
index 5d5d2b3..9660003 100644
--- a/lib.c
+++ b/lib.c
@@ -1,3 +1,4 @@
+#include <math.h>
 #include <time.h>
 #include <string.h>
 #include <stdio.h>
@@ -115,6 +116,37 @@ static Val fn_ssplit(State *S, int nargs, Val *args) {
 	return VAL_OBJ(out);
 }
 
+// math
+static Val fn_sin(State *S, int nargs, Val *args) {
+	CHECK(nargs == 1, "need exactly 1 arg for sin");
+	CHECK(IS_NUM(args[0]), "need num for sin");
+	double x = AS_NUM(args[0]);
+	return VAL_NUM(sin(x));
+}
+static Val fn_cos(State *S, int nargs, Val *args) {
+	CHECK(nargs == 1, "need exactly 1 arg for cos");
+	CHECK(IS_NUM(args[0]), "need num for cos");
+	double x = AS_NUM(args[0]);
+	return VAL_NUM(cos(x));
+}
+static Val fn_ceil(State *S, int nargs, Val *args) {
+	CHECK(nargs == 1, "need exactly 1 arg for ceil");
+	CHECK(IS_NUM(args[0]), "need num for ceil");
+	double x = AS_NUM(args[0]);
+	return VAL_NUM(ceil(x));
+}
+static Val fn_floor(State *S, int nargs, Val *args) {
+	CHECK(nargs == 1, "need exactly 1 arg for floor");
+	CHECK(IS_NUM(args[0]), "need num for floor");
+	double x = AS_NUM(args[0]);
+	return VAL_NUM(floor(x));
+}
+static Val fn_abs(State *S, int nargs, Val *args) {
+	CHECK(nargs == 1, "need exactly 1 arg for abs");
+	CHECK(IS_NUM(args[0]), "need num for abs");
+	double x = AS_NUM(args[0]);
+	return VAL_NUM(abs(x));
+}
 
 
 typedef struct {
@@ -133,6 +165,12 @@ static BuiltinFunc builtin_funcs[] = {
 	{ ",", fn_pend },
 	{ "s,", fn_spend },
 	{ "ssplit", fn_ssplit },
+
+	{ "sin", fn_sin },
+	{ "cos", fn_cos },
+	{ "ceil", fn_ceil },
+	{ "floor", fn_floor },
+	{ "abs", fn_abs },
 	{ 0 },
 };
 
diff --git a/tests/sin.bth b/tests/sin.bth
new file mode 100644
index 0000000..319241f
--- /dev/null
+++ b/tests/sin.bth
@@ -0,0 +1,14 @@
+(defn (ts x)
+  (* 10 (+ 1 (sin x))))
+
+(set! _G_ts ts)
+
+(defn (p t)
+  (for (i (_G_ts t))
+    (write " "))
+  (say 'x))
+
+
+
+(for (i 50) (p (/ i 8)))
+	
diff --git a/tests/sin.out b/tests/sin.out
new file mode 100644
index 0000000..3519c6d
--- /dev/null
+++ b/tests/sin.out
@@ -0,0 +1,50 @@
+          x
+            x
+             x
+              x
+               x
+                x
+                 x
+                  x
+                   x
+                    x
+                    x
+                    x
+                    x
+                    x
+                    x
+                    x
+                    x
+                   x
+                  x
+                 x
+                x
+               x
+              x
+             x
+            x
+           x
+         x
+        x
+       x
+      x
+     x
+    x
+   x
+  x
+  x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+  x
+   x
+   x
+    x
+     x
+       x
+        x
+         x
diff --git a/tests/sincos.bth b/tests/sincos.bth
new file mode 100644
index 0000000..7f6a135
--- /dev/null
+++ b/tests/sincos.bth
@@ -0,0 +1,37 @@
+(defn (ts x)
+  (* 10 (+ 1 (sin x))))
+(defn (tc x)
+  (* 10 (+ 1 (cos x))))
+(set! _G_ts ts)
+(set! _G_tc tc)
+
+(defn (min x y)
+  (if (< x y) x y))
+(defn (max x y)
+  (if (< x y) y x))
+(set! _G_min min)
+(set! _G_max max)
+
+(defn (ws n)
+  (for (i (- n 1)) (write " "))
+  (say 'x))
+(set! _G_ws ws)
+
+(defn (p2 t)
+  (let (s (_G_ts t)
+        c (_G_tc t)
+        fs (floor s)
+        fc (floor c)
+        m (_G_min fs fc)
+        M (_G_max fs fc)
+        d (- M m))
+    (if (= 0 d)
+      (_G_ws m)
+      (do (_G_ws m) (_G_ws d)))))
+
+      
+
+
+
+(for (i 100) (p2 (/ i 16)))
+