Implement ⎕DIV for allowing division by zero to result in 0 if needed

5 files changed, 47 insertions, 28 deletions

diff --git a/apl9.h b/apl9.h
index dc38112..12bfc03 100644
--- a/apl9.h
+++ b/apl9.h
@@ -135,13 +135,14 @@ struct Symbol
 	Rune *name;
 	Datum value;
 	Datum *(*getfn)(void);
-	int (*setfn)(Datum);
+	void (*setfn)(Datum);
 };
 
 struct Symtab
 {
 	int nsyms;
 	int io; /* index origin */
+	int div; /* division method */
 	Symbol **syms;
 };
 
@@ -155,7 +156,7 @@ struct QuadnameDef
 	Rune *name;
 	datumTag tag;
 	Datum *(*get)(void);
-	int (*set)(Datum);
+	void (*set)(Datum);
 	fnmonad monadfn;
 	fndyad dyadfn;
 	opmonad monadop;
diff --git a/eval.c b/eval.c
index 1070cb2..86d0d15 100644
--- a/eval.c
+++ b/eval.c
@@ -230,11 +230,9 @@ nameis(Datum left, Datum right)
 Datum
 assign(Datum left, Datum right)
 {
-	if(left.symbol->setfn != nil){
-		int ok = left.symbol->setfn(right);
-		if(!ok)
-			throwerror(nil, ESyntax);
-	}else{
+	if(left.symbol->setfn != nil)
+		left.symbol->setfn(right);
+	else{
 		if(left.symbol->undefined == 0 && left.symbol->value.tag == ArrayTag)
 			freearray(left.symbol->value.array);
 		left.symbol->value = right;
diff --git a/functions.c b/functions.c
index 870ee17..2e0bfa2 100644
--- a/functions.c
+++ b/functions.c
@@ -680,8 +680,12 @@ SCALAR_FUNCTION_2(fnTimes, 0, left->type,
 
 SCALAR_FUNCTION_2(fnDivide, 1, left->type,
 	case AtypeFloat:
-		if(right->floatdata[i] == 0)
-			throwerror(nil, EDomain);
+		if(right->floatdata[i] == 0){
+			if(currentsymtab->div)
+				res->floatdata[i] = 0;
+			else
+				throwerror(nil, EDomain);
+		}
 		else
 			res->floatdata[i] /= right->floatdata[i];
 		break;
diff --git a/quadnames.c b/quadnames.c
index 3368b70..df98193 100644
--- a/quadnames.c
+++ b/quadnames.c
@@ -5,11 +5,13 @@
 #include "apl9.h"
 
 Datum *getquad(void);
-int setquad(Datum);
+void setquad(Datum);
 Datum *getio(void);
-int setio(Datum);
+void setio(Datum);
 Datum *getpp(void);
-int setpp(Datum);
+void setpp(Datum);
+Datum *getdiv(void);
+void setdiv(Datum);
 
 Array *runfile(Array *);
 Array *quadthrow1(Array *);
@@ -19,6 +21,7 @@ QuadnameDef quadnames[] = {
 	{L"⎕", NameTag, getquad, setquad, nil, nil},
 	{L"⎕IO", NameTag, getio, setio, nil, nil},
 	{L"⎕PP", NameTag, getpp, setpp, nil, nil},
+	{L"⎕DIV", NameTag, getdiv, setdiv, nil, nil},
 	{L"⎕RUN", FunctionTag, nil, nil, runfile, nil},
 	{L"⎕THROW", FunctionTag, nil, nil, quadthrow1, quadthrow2},
 	{nil, 0, nil, nil, nil, nil} /* MUST BE LAST */
@@ -61,11 +64,10 @@ getquad(void)
 	return result;
 }
 
-int
+void
 setquad(Datum new)
 {
 	print("%S\n", ppdatum(new));
-	return 1;
 }
 
 /* ⎕IO */
@@ -78,16 +80,13 @@ getio(void)
 	return d;
 }
 
-int
+void
 setio(Datum new)
 {
-	if(new.tag != ArrayTag || new.array->rank != 0 || new.array->type != AtypeInt || (new.array->intdata[0] != 0 && new.array->intdata[0] != 1)){
-		print("⎕IO: domain error\n");
-		return 0;
-	}else{
+	if(new.tag != ArrayTag || new.array->rank != 0 || new.array->type != AtypeInt || (new.array->intdata[0] != 0 && new.array->intdata[0] != 1))
+		throwerror(nil, EDomain);
+	else
 		currentsymtab->io = new.array->intdata[0];
-		return 1;
-	}
 }
 
 /* ⎕PP */
@@ -100,16 +99,32 @@ getpp(void)
 	return d;
 }
 
-int
+void
 setpp(Datum new)
 {
-	if(new.tag != ArrayTag || new.array->rank != 0 || new.array->type != AtypeInt || new.array->intdata[0] < 0){
-		print("⎕PP: domain error\n");
-		return 0;
-	}else{
+	if(new.tag != ArrayTag || new.array->rank != 0 || new.array->type != AtypeInt || new.array->intdata[0] < 0)
+		throwerror(nil, EDomain);
+	else
 		printprecision = new.array->intdata[0];
-		return 1;
-	}
+}
+
+/* ⎕DIV */
+Datum *
+getdiv(void)
+{
+	Datum *d = mallocz(sizeof(Datum), 1);
+	d->tag = ArrayTag;
+	d->array = mkscalarint(currentsymtab->div);
+	return d;
+}
+
+void
+setdiv(Datum new)
+{
+	if(new.tag != ArrayTag || new.array->rank != 0 || new.array->type != AtypeInt || (new.array->intdata[0] != 0 && new.array->intdata[0] != 1))
+		throwerror(nil, EDomain);
+	else
+		currentsymtab->div = new.array->intdata[0];
 }
 
 /* ⎕RUN */
diff --git a/symbol.c b/symbol.c
index 9b91cd1..d51a730 100644
--- a/symbol.c
+++ b/symbol.c
@@ -31,6 +31,7 @@ newsymtab(void)
 	tab->nsyms = 0;
 	tab->syms = nil;
 	tab->io = currentsymtab ? currentsymtab->io : 1;
+	tab->div = currentsymtab ? currentsymtab->div : 0;
 
 	return tab;
 }