Cleanup threads and add a ⎕TASKS system function

3 files changed, 81 insertions, 2 deletions

diff --git a/apl9.h b/apl9.h
index bf36f52..01738e6 100644
--- a/apl9.h
+++ b/apl9.h
@@ -343,6 +343,8 @@ int spawnthread(Function, Array *, Array *);
 ThreadData *getthreaddata(void);
 void messagesend(Array *, int);
 Array *messagerecv(Function, int);
+Array *runningtasks(void);
+Array *taskproperty(vlong, vlong);
 
 /* Monadic functions from function.c */
 Array *fnNegate(Array *);
diff --git a/concurrency.c b/concurrency.c
index be1d62c..ec75474 100644
--- a/concurrency.c
+++ b/concurrency.c
@@ -195,7 +195,15 @@ newprocfn(void *data)
 		runfunc(sp->func, sp->left, sp->right);
 	}
 	lock(&threadlock);
-	/* TODO remove thread */
+	for(int i = 0; i < nthreads; i++){
+		if(threads[i] != td)
+			continue;
+
+		for(int j = i+1; j < nthreads; j++)
+			threads[j-1] = threads[j];
+		nthreads--;
+		break;
+	}
 	unlock(&threadlock);
 	freearray(sp->left);
 	freearray(sp->right);
@@ -223,3 +231,41 @@ newthreaddata(void)
 	unlock(&threadlock);
 	return td;
 }
+
+Array *
+runningtasks(void)
+{
+	lock(&threadlock);
+	Array *tasks = allocarray(AtypeInt, 1, nthreads);
+	tasks->shape[0] = nthreads;
+	for(int i = 0; i < nthreads; i++)
+		tasks->intdata[i] = threads[i]->id;
+	unlock(&threadlock);
+	return tasks;
+}
+
+Array *
+taskproperty(vlong t, vlong p)
+{
+	ThreadData *td = nil;
+	Array *res = nil;
+	lock(&threadlock);
+	for(int i = 0; i < nthreads && td == nil; i++)
+		if(threads[i]->id == t)
+			td = threads[i];
+	if(td == nil)
+		res = mkscalarint(-1);
+	else
+		switch(p){
+		case 0:
+			res = mkscalarint(t); /* thread id */
+			break;
+		default:
+			unlock(&threadlock);
+			throwerror(L"Invalid task property", EDomain);
+			break;
+		}
+	
+	unlock(&threadlock);
+	return res;
+}
\ No newline at end of file
diff --git a/quadnames.c b/quadnames.c
index bd98b9d..e3d3ca8 100644
--- a/quadnames.c
+++ b/quadnames.c
@@ -28,6 +28,8 @@ Array *quadinfo(Array *);
 Array *quadproto(Array *);
 Array *quaducs(Array *);
 Array *quaddl(Array *);
+Array *quadtasks1(Array *);
+Array *quadtasks2(Array *, Array *);
 
 int needsnewline = 0;
 static Rune *quadquotebuf = nil;
@@ -50,6 +52,7 @@ QuadnameDef quadnames[] = {
 	{L"⎕PROTO", FunctionTag, nil, nil, quadproto, nil},
 	{L"⎕UCS", FunctionTag, nil, nil, quaducs, nil},
 	{L"⎕DL", FunctionTag, nil, nil, quaddl, nil},
+	{L"⎕TASKS", FunctionTag, nil, nil, quadtasks1, quadtasks2},
 	{nil, 0, nil, nil, nil, nil} /* MUST BE LAST */
 };
 
@@ -410,4 +413,32 @@ quaddl(Array *a)
 	else
 		throwerror(nil, EDomain);
 	return fnSame(a);
-}
\ No newline at end of file
+}
+
+/* ⎕TASKS */
+Array *
+quadtasks1(Array *properties)
+{
+	Array *threadids = runningtasks();
+	Array *res = rundfn(L"⍺ ⎕TASKS ⍵", nil, nil, threadids, properties);
+	freearray(threadids);
+	return res;
+}
+
+/* ⎕TASKS */
+Array *
+quadtasks2(Array *task, Array *property)
+{
+	if(GetType(task) != AtypeInt || GetType(property) != AtypeInt)
+		throwerror(nil, EDomain);
+	if(GetRank(task) > 1 || GetRank(property) > 1)
+		throwerror(nil, ERank);
+	if(GetRank(task) > 0 || GetRank(property) > 0)
+		return rundfn(L"⍺ ⎕TASKS⌾ ⍵", nil, nil, task, property);
+
+	/* Get task with ID task, and property based on number in property */
+	return taskproperty(task->intdata[0], property->intdata[0]);
+}
+
+
+