Try to throw errors on C stack overflows

4 files changed, 46 insertions, 1 deletions

diff --git a/apl9.h b/apl9.h
index 0fafe80..19c21aa 100644
--- a/apl9.h
+++ b/apl9.h
@@ -2,6 +2,9 @@
 #define MAX_LINE_LENGTH 1024
 #define MAX_LINE_TOKENS 1024
 
+#define STACKSIZE (1024*1024) /* 1 MB */
+#define REQUIREDSTACK (16*1024) /* 16 KB */
+
 typedef enum
 {
 	ArrayTag,
@@ -53,6 +56,7 @@ typedef enum
 	EValue = 6,
 	EDomain = 11,
 	ETimeout = 12, /* not in dyalog */
+	EStack = 13, /* C stack overflow */
 	ENotImplemented = 100, /* not in dyalog */
 } errorCodes;
 
@@ -233,6 +237,7 @@ struct DfnFrame
 struct ThreadData
 {
 	int id;
+	int requiredstack;
 	DfnFrame *currentdfn;
 	Mail *mail;
 	Mail *lastmail;
@@ -350,6 +355,9 @@ void messagesend(Array *, int);
 Array *messagerecv(Function, int);
 Array *runningtasks(void);
 Array *taskproperty(vlong, vlong);
+int stackused(void);
+int hasstack(int);
+void checkstack(void);
 
 /* Monadic functions from function.c */
 Array *fnNegate(Array *);
diff --git a/concurrency.c b/concurrency.c
index 99ca589..c01426d 100644
--- a/concurrency.c
+++ b/concurrency.c
@@ -2,9 +2,11 @@
 #include <libc.h>
 #include <thread.h>
 #include <bio.h>
+
 #include "apl9.h"
 
-#define STACKSIZE (8*1024*1024) /* 8 MB */
+/* Nasty stuff to get stack size used */
+#include "/sys/src/libthread/threadimpl.h"
 
 typedef struct SpawnData SpawnData;
 struct SpawnData
@@ -224,6 +226,7 @@ newthreaddata(Array *name)
 {
 	ThreadData *td = emallocz(sizeof(ThreadData), 1);
 	td->id = threadid();
+	td->requiredstack = REQUIREDSTACK;
 	td->currentdfn = nil;
 	td->mail = 0;
 	td->lastmail = 0;
@@ -271,6 +274,12 @@ taskproperty(vlong t, vlong p)
 		case 1: /* thread name */
 			res = fnSame(td->name);
 			break;
+		case 2: /* stacksize max */
+			res = mkscalarint(STACKSIZE);
+			break;
+		case 3: /* used stacksize */
+			res = mkscalarint(stackused());
+			break;
 		default:
 			unlock(&threadlock);
 			throwerror(L"Invalid task property", EDomain);
@@ -279,4 +288,27 @@ taskproperty(vlong t, vlong p)
 	
 	unlock(&threadlock);
 	return res;
+}
+
+int
+stackused(void)
+{
+	int x;
+	Proc *p = _threadgetproc();
+	Thread *t = p->thread;
+	return STACKSIZE - ((uchar*)&x - (uchar*)t->stk);
+}
+
+int
+hasstack(int n)
+{
+	return (n+stackused()) < STACKSIZE;	
+}
+
+void
+checkstack(void)
+{
+	ThreadData *td = getthreaddata();
+	if(!hasstack(td->requiredstack))
+		throwerror(L"Not enough C stack. Stuff will go bad from now on.", EStack);
 }
\ No newline at end of file
diff --git a/error.c b/error.c
index 45670f5..5b7f386 100644
--- a/error.c
+++ b/error.c
@@ -67,6 +67,7 @@ errorstr(int code)
 	case EValue: err = L"VALUE ERROR"; break;
 	case EDomain: err = L"DOMAIN ERROR"; break;
 	case ETimeout: err = L"TIMEOUT ERROR"; break;
+	case EStack: err = L"STACK OVERFLOW"; break;
 	case ENotImplemented: err = L"NOT IMPLEMENTED"; break;
 	default: err = L""; break;
 	}
@@ -77,11 +78,14 @@ void
 displayerror(void)
 {
 	ThreadData *td = getthreaddata();
+	int tmp = td->requiredstack;
+	td->requiredstack = 0;
 	Array *error = allocarray(AtypeArray, 1, 3);
 	error->shape[0] = 3;
 	error->arraydata[0] = mkrunearray(errorstr(td->lasterror));
 	error->arraydata[1] = mkrunearray(td->lasterrormsg ? td->lasterrormsg : L"");
 	error->arraydata[2] = fnSame(td->name);
 	rundfn(L"0::⎕RAWIO←⍵ ⋄ ('!' ⍵) ⍈ ⎕SESSION", nil, nil, nil, error);
+	td->requiredstack = tmp;
 	freearray(error);
 }
\ No newline at end of file
diff --git a/functions.c b/functions.c
index 0013d8f..3559050 100644
--- a/functions.c
+++ b/functions.c
@@ -128,6 +128,7 @@ Array *indexOfHelper(Array *, Array *, int);
 Array *
 runfunc(Function f, Array *left, Array *right)
 {
+	checkstack();
 	Array *result;
 	if(f.type == FunctypeDfn || (f.type == FunctypeOp && f.operator.type == OperatortypeDop)){
 		Rune *code;