Implement basic reference counting for arrays, which so they

get freed when not in use anymore.

9 files changed, 138 insertions, 37 deletions

diff --git a/apl9.h b/apl9.h
index 64f7eba..7c44980 100644
--- a/apl9.h
+++ b/apl9.h
@@ -46,6 +46,7 @@ struct Array
 	int *shape;
 	int size;
 	int stranded; /* 1 if build directly by stranding */
+	int refs; /* reference counting */
 	union {
 		char *rawdata;
 		vlong *intdata;
@@ -111,7 +112,6 @@ Rune *pparray(Array *);
 Statement *lexline(Rune *);
 
 /* array.c */
-Array *mkarray(int, int, int);
 Array *mkscalarint(vlong);
 Array *duparray(Array *);
 int simplearray(Array *);
@@ -123,8 +123,14 @@ Datum *eval(Statement *);
 /* symbol.c */
 Symbol *getsym(Symtab *, Rune *);
 Symtab *newsymtab(void);
+void freesymtab(Symtab *);
 vlong globalIO(void);
 
+/* memory.c */
+Array *allocarray(int, int, int);
+void freearray(Array *);
+void incref(Array *);
+
 /* Monadic functions from functions.h */
 Array *fnSame(Array *);
 Array *fnTally(Array *);
@@ -151,4 +157,5 @@ extern Rune primhybridnames[]; /* lexer.c */
 extern fnmonad monadfunctiondefs[]; /* function.c */
 extern fndyad dyadfunctiondefs[]; /* function.c */
 extern Symtab *globalsymtab; /* symbol.c */
-extern Symtab *currentsymtab; /* symbol.c */
\ No newline at end of file
+extern Symtab *currentsymtab; /* symbol.c */
+extern int alloccounts; /* memory.c */
\ No newline at end of file
diff --git a/array.c b/array.c
index 9feb132..4913112 100644
--- a/array.c
+++ b/array.c
@@ -10,23 +10,9 @@ int datasizes[] = {
 };
 
 Array *
-mkarray(arrayDataType t, int rank, int size)
-{
-	Array *a = malloc(sizeof(Array));
-	a->rank = rank;
-	a->type = t;
-	a->size = size;
-	a->stranded = 0;
-	a->shape = malloc(sizeof(int) * rank);
-	a->rawdata = malloc(datasizes[t] * size);
-	a->type = t;
-	return a;
-}
-
-Array *
 mkscalarint(vlong i)
 {
-	Array *a = mkarray(AtypeInt, 0, 1);
+	Array *a = allocarray(AtypeInt, 0, 1);
 	a->intdata[0] = i;
 
 	return a;
@@ -35,10 +21,12 @@ mkscalarint(vlong i)
 Array *
 duparray(Array *a)
 {
-	Array *b = mkarray(a->type, a->rank, a->size);
+	Array *b = allocarray(a->type, a->rank, a->size);
 	memcpy(b->shape, a->shape, sizeof(int) * a->rank);
 	memcpy(b->rawdata, a->rawdata, datasizes[a->type]*a->size);
-	/* TODO duplicate recursivley */
+	if(b->type == AtypeArray)
+		for(int i = 0; i < b->size; i++)
+			incref(b->arraydata[i]);
 	return b;
 }
 
diff --git a/eval.c b/eval.c
index ae7dbd7..2eb5abd 100644
--- a/eval.c
+++ b/eval.c
@@ -104,7 +104,13 @@ retry:
 			errormsg = L"No reduce rule. Syntax error.";
 			return nil;
 		}else{
-			stmt->toks[offset] = fn(stmt->toks[offset],stmt->toks[offset+1]);
+			Datum new = fn(stmt->toks[offset],stmt->toks[offset+1]);
+			if(stmt->toks[offset].tag == ArrayTag)
+				freearray(stmt->toks[offset].array);
+			if(stmt->toks[offset+1].tag == ArrayTag)
+				freearray(stmt->toks[offset+1].array);
+
+			stmt->toks[offset] = new;
 			for(int i = offset+1; i < stmt->ntoks-1; i++)
 				stmt->toks[i] = stmt->toks[i+1];
 			stmt->ntoks--;
@@ -126,8 +132,13 @@ lookup(Datum var)
 	if(var.symbol->undefined){
 		errormsg = runesmprint("Variable undefined: %S\n", var.symbol->name);
 		return nil;
-	}else
-		return &var.symbol->value;
+	}else{
+		Datum *val = &var.symbol->value;
+		val->shy = 0;
+		if(val->tag == ArrayTag)
+			incref(val->array); /* since the value is now in the var AND in the code */
+		return val;
+	}
 }
 
 Datum
@@ -136,11 +147,13 @@ strand(Datum left, Datum right)
 	traceprint("Stranding (%d %d)\n", left.array->stranded, right.array->stranded);
 	Datum result;
 	result.shy = 0;
-	Array *leftarr = left.array->stranded ? left.array : fnEnclose(left.array);
-	Array *rightarr = right.array->stranded ? right.array : fnEnclose(right.array);
+	Array *leftarr = left.array->stranded ? fnSame(left.array) : fnEnclose(left.array);
+	Array *rightarr = right.array->stranded ? fnSame(right.array) : fnEnclose(right.array);
 	result.tag = ArrayTag;
 	result.array = fnCatenateFirst(leftarr, rightarr);
 	result.array->stranded = 1;
+	freearray(leftarr);
+	freearray(rightarr);
 	return result;
 }
 
@@ -159,14 +172,17 @@ monadfun(Datum left, Datum right)
 			Symbol *alpha = getsym(currentsymtab, L"⍺");
 			alpha->value.tag = ArrayTag;
 			alpha->value.array = left.func.left;
+			/* no need to increment refs, since it was done on binding the arg */
 			alpha->undefined = 0;
 		}
 
 		Symbol *omega = getsym(currentsymtab, L"⍵");
 		omega->value = right;
 		omega->undefined = 0;
+		incref(right.array);
 
 		Datum *dfnres = evalline(left.func.dfn);
+		freesymtab(currentsymtab);
 		currentsymtab = tmpsymtab;
 		return *dfnres; /* TODO what if the evaluation failed */
 	}else{
@@ -176,6 +192,10 @@ monadfun(Datum left, Datum right)
 		else
 			result.array = monadfunctiondefs[left.func.code](right.array);
 	}
+
+	if(left.func.left)
+		freearray(left.func.left);
+
 	return result;
 }
 
@@ -188,6 +208,7 @@ dyadfun(Datum left, Datum right)
 	result.tag = BoundFunctionTag,
 	result.func = right.func;
 	result.func.left = left.array;
+	incref(left.array);
 	return result;
 }
 
@@ -219,8 +240,11 @@ assign(Datum left, Datum right)
 {
 	left.symbol->value = right; /* TODO think about this*/
 	left.symbol->undefined = 0;
-	if(left.symbol->value.tag == ArrayTag)
+	if(left.symbol->value.tag == ArrayTag){
 		left.symbol->value.array->stranded = 0;
+		incref(right.array); /* for the binding */
+		incref(right.array); /* for the returned array */
+	}
 	right.shy = 1;
 	return right;
 }
\ No newline at end of file
diff --git a/functions.c b/functions.c
index 4d9a69f..bbac1a9 100644
--- a/functions.c
+++ b/functions.c
@@ -121,6 +121,7 @@ fndyad dyadfunctiondefs[] = {
 Array *
 fnSame(Array *right)
 {
+	incref(right);
 	return right;
 }
 
@@ -133,10 +134,11 @@ fnTally(Array *right)
 Array *
 fnEnclose(Array *right)
 {
+	incref(right);
 	if(simplescalar(right))
 		return right;
 	else{
-		Array *res = mkarray(AtypeArray, 0, 1);
+		Array *res = allocarray(AtypeArray, 0, 1);
 		res->arraydata[0] = right;
 		return res;
 	}
@@ -147,7 +149,7 @@ fnIndexGenerator(Array *right)
 {
 	/* TODO only works for creating vectors */
 	vlong n = right->intdata[0];
-	Array *res = mkarray(AtypeInt, 1, n);
+	Array *res = allocarray(AtypeInt, 1, n);
 	res->shape[0] = n;
 	vlong io = globalIO();
 	for(vlong i = 0; i < n; i++)
@@ -161,7 +163,7 @@ fnNest(Array *right)
 	if(simplearray(right))
 		return fnEnclose(right);
 	else
-		return right;
+		return fnSame(right);
 }
 
 Array *
@@ -177,7 +179,7 @@ fnRavel(Array *right)
 Array *
 fnShape(Array *right)
 {
-	Array *res = mkarray(AtypeInt, 1, right->rank);
+	Array *res = allocarray(AtypeInt, 1, right->rank);
 	res->shape[0] = right->rank;
 	for(int i = 0; i < right->rank; i++)
 		res->intdata[i] = right->shape[i];
@@ -190,6 +192,7 @@ Array *
 fnLeft(Array *left, Array *right)
 {
 	USED(right);
+	incref(left);
 	return left;
 }
 
@@ -197,6 +200,7 @@ Array *
 fnRight(Array *left, Array *right)
 {
 	USED(left);
+	incref(right);
 	return right;
 }
 
@@ -204,16 +208,19 @@ Array *
 fnCatenateFirst(Array *left, Array *right)
 {
 	/* not even close to being right, but it works for stranding :) */
-	if(left->rank == 0)
-		left = fnRavel(left);
-	if(right->rank == 0)
-		right = fnRavel(right);
+	left = left->rank == 0 ? fnRavel(left) : fnSame(left);
+	right = right->rank == 0 ? fnRavel(right) : fnSame(right);
 
 	/* assume two vectors of same type for now */
-	Array *res = mkarray(left->type, 1, left->size+right->size);
+	Array *res = allocarray(left->type, 1, left->size+right->size);
 	res->shape[0] = left->shape[0] + right->shape[0];
 	memcpy(res->rawdata, left->rawdata, datasizes[res->type]*left->size);
 	memcpy(res->rawdata+datasizes[res->type]*left->size, right->rawdata, datasizes[res->type]*right->size);
+	if(res->type == AtypeArray)
+		for(int i = 0; i < res->size; i++)
+			incref(res->arraydata[i]);
+	freearray(left);
+	freearray(right);
 	return res;
 }
 
@@ -228,10 +235,13 @@ fnReshape(Array *left, Array *right)
 	if(left->size == 0)
 		size = 0;
 
-	Array *res = mkarray(right->type, left->size, size);
+	Array *res = allocarray(right->type, left->size, size);
 	for(i = 0; i < left->size; i++)
 		res->shape[i] = left->intdata[i];
 	for(i = 0, p = res->rawdata; i < size; i++, p += datasizes[res->type])
 		memcpy(p, right->rawdata + (datasizes[res->type] * (i % right->size)), datasizes[res->type]);
+	if(res->type == AtypeArray)
+		for(i = 0; i < res->size; i++)
+			incref(res->arraydata[i]);
 	return res;
 }
\ No newline at end of file
diff --git a/main.c b/main.c
index 2e12fff..ad84ad3 100644
--- a/main.c
+++ b/main.c
@@ -35,8 +35,11 @@ main(int argc, char *argv[])
 		}else{
 			if(result[0].shy == 0)
 				print("%S\n", ppdatum(*result));
+			if(result->tag == ArrayTag)
+				freearray(result->array);
 			free(result);
 		}
+		print("Unfreed allocations: %d\n", alloccounts);
 	}
 	exits(nil);
 }
diff --git a/memory.c b/memory.c
new file mode 100644
index 0000000..adc0466
--- /dev/null
+++ b/memory.c
@@ -0,0 +1,53 @@
+#include <u.h>
+#include <libc.h>
+#include <bio.h>
+
+#include "apl9.h"
+
+int alloccounts = 0;
+
+void
+freearray(Array *a)
+{
+	a->refs--;
+	if(a->refs == 0){
+		/* print("Freeing array: %S (%p)\n", pparray(a), a); */
+		if(a->type == AtypeArray)
+			for(int i = 0; i < a->size; i++)
+				freearray(a->arraydata[i]);
+		free(a->shape);
+		free(a);
+		alloccounts--;
+	}else if(a->refs > 0){
+		/* print("Not freeing (refs=%d): %S (%p)\n", a->refs, pparray(a), a); */
+	}else{
+		print("NEGATIVE REF COUNT! %p\n", a);
+		exits(nil);
+	}
+}
+
+Array *
+allocarray(arrayDataType t, int rank, int size)
+{
+	Array *a = malloc(sizeof(Array));
+	a->rank = rank;
+	a->type = t;
+	a->size = size;
+	a->stranded = 0;
+	a->shape = malloc(sizeof(int) * rank);
+	a->rawdata = malloc(datasizes[t] * size);
+	a->type = t;
+	a->refs = 1;
+	alloccounts++;
+	return a;
+}
+
+void
+incref(Array *a)
+{
+	/* print("INCREF %d->%d %S\n", a->refs, a->refs+1, pparray(a)); */
+	a->refs++;
+	if(a->type == AtypeArray)
+		for(int i = 0; i < a->size; i++)
+			incref(a->arraydata[i]);
+}
\ No newline at end of file
diff --git a/mkfile b/mkfile
index 2b9dafe..c3c3c25 100644
--- a/mkfile
+++ b/mkfile
@@ -9,6 +9,7 @@ OFILES=\
 	array.$O\
 	functions.$O\
 	symbol.$O\
+	memory.$O\
 
 HFILES=\
 	apl9.h\
diff --git a/print.c b/print.c
index 409de45..8deac3e 100644
--- a/print.c
+++ b/print.c
@@ -12,7 +12,7 @@ ppdatum(Datum d)
 	case ArrayTag: result = pparray(d.array); break;
 	case FunctionTag:
 		if(d.func.type == FunctypePrim)
-			result = runesmprint("%C", primdyadopnames[d.func.code]);
+			result = runesmprint("%C", primfuncnames[d.func.code]);
 		else
 			result = runesmprint("{%S}", d.func.dfn);
 		break;
@@ -21,7 +21,7 @@ ppdatum(Datum d)
 	case DyadicOpTag: result = runesmprint("%C", primdyadopnames[d.func.code]); break;
 	case BoundFunctionTag:
 		if(d.func.type == FunctypePrim)
-			result = runesmprint("%S∘%C", pparray(d.func.left), primdyadopnames[d.func.code]);
+			result = runesmprint("%S∘%C", pparray(d.func.left), primfuncnames[d.func.code]);
 		else
 			result = runesmprint("%S∘{%S}", pparray(d.func.left), d.func.dfn);
 		break;
diff --git a/symbol.c b/symbol.c
index 55e3f15..294d9a4 100644
--- a/symbol.c
+++ b/symbol.c
@@ -38,6 +38,21 @@ newsymtab(void)
 	return tab;
 }
 
+void
+freesymtab(Symtab *tab)
+{
+	print("Freeing symtab\n");
+	int i;
+	for(i = 0; i < tab->nsyms; i++){
+		Symbol *s = tab->syms[i];
+		if(s->undefined == 0 && s->value.tag == ArrayTag)
+			freearray(s->value.array);
+	}
+	free(tab->syms);
+	free(tab);
+	print("Done freeing symtab\n");
+}
+
 vlong
 globalIO(void)
 {