summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--apl9.h30
-rw-r--r--array.c5
-rw-r--r--concurrency.c10
-rw-r--r--eval.c364
-rw-r--r--functions.c28
-rw-r--r--lexer.c76
-rw-r--r--main.c54
-rw-r--r--memory.c223
-rw-r--r--operators.c2
-rw-r--r--print.c32
-rw-r--r--quadnames.c74
-rw-r--r--symbol.c64
-rw-r--r--tests/chain.apl8
-rw-r--r--tests/queens.apl5
14 files changed, 583 insertions, 392 deletions
diff --git a/apl9.h b/apl9.h
index 4c28315..8b32141 100644
--- a/apl9.h
+++ b/apl9.h
@@ -104,7 +104,7 @@ struct Array
struct Statement
{
int ntoks;
- Datum *toks;
+ Datum **toks;
Statement *guard;
Statement *next;
};
@@ -144,6 +144,7 @@ struct Datum
{
datumTag tag;
int shy;
+ int refs;
union {
Array *array;
Statement stmt;
@@ -159,9 +160,9 @@ struct Symbol
{
int undefined;
Rune *name;
- Datum value;
+ Datum *value;
Datum *(*getfn)(void);
- void (*setfn)(Datum);
+ void (*setfn)(Datum *);
};
struct Symtab
@@ -182,7 +183,7 @@ struct QuadnameDef
Rune *name;
datumTag tag;
Datum *(*get)(void);
- void (*set)(Datum);
+ void (*set)(Datum *);
fnmonad monadfn;
fndyad dyadfn;
opmonad monadop;
@@ -225,11 +226,10 @@ struct Mail
/* Function prototypes for the different source files */
/* main.c */
Datum *evalline(Rune *, Biobuf *, int);
-Rune *prompt(Rune *);
/* print.c */
-Rune *ppdatum(Datum);
-Rune *ppdatums(Datum *, int);
+Rune *ppdatum(Datum *);
+Rune *ppdatums(Datum **, int);
Rune *pparray(Array *);
Rune *ppoperator(Operator);
Rune *ppfunction(Function);
@@ -273,11 +273,20 @@ void globalDIVset(int);
/* memory.c */
void *emalloc(ulong);
+void *emallocz(ulong, int);
+void *erealloc(void *, ulong);
void checkmem(char *);
-
Array *allocarray(int, int, int);
void freearray(Array *);
void incarrayref(Array *);
+Datum *allocdatum(int, int);
+void freedatum(Datum *);
+void incdatumref(Datum *);
+void freefunction(Function);
+void freeoperator(Operator);
+void freestatement(Statement);
+Function dupfunction(Function);
+Operator dupoperator(Operator);
/* functions.c */
Array *runfunc(Function, Array *,Array *);
@@ -286,7 +295,7 @@ Array *runtrain(Function *, int, Array *, Array *, Array *);
/* quadnames.c */
void initquadnames(void);
-Datum quadnamedatum(QuadnameDef);
+Datum *quadnamedatum(QuadnameDef);
/* error.c */
void throwerror(Rune *, int);
@@ -442,7 +451,8 @@ extern opmonad monadoperatordefs[]; /* operators.c */
extern opdyad dyadoperatordefs[]; /* operators.c */
extern fndyad hybridfunctiondefs[]; /* hybrids.c */
extern opmonad hybridoperatordefs[]; /* hybrids.c */
-extern int alloccounts; /* memory.c */
+extern int arrayalloccounts; /* memory.c */
+extern int datumalloccounts; /* memory.c */
extern QuadnameDef quadnames[]; /* quadnames.c */
extern int printprecision; /* print.c */
extern ErrorHandler globalerror; /* error.c */
diff --git a/array.c b/array.c
index bc00a89..a712ad3 100644
--- a/array.c
+++ b/array.c
@@ -1,5 +1,6 @@
#include <u.h>
#include <libc.h>
+#include <thread.h>
#include <bio.h>
#include "apl9.h"
@@ -324,7 +325,7 @@ comparearray(Array *a, Array *b, int checkshapes)
break;
default:
print("Missing comparison code for type %d\n", a->type);
- exits(nil);
+ threadexitsall(nil);
}
if(sub != 0)
return sub;
@@ -364,7 +365,7 @@ fillelement(Array *a)
}
default:
print("Can't make fill element of array type %d\n", a->type);
- exits(nil);
+ threadexitsall(nil);
return 0;
}
}
diff --git a/concurrency.c b/concurrency.c
index 4af563c..c393884 100644
--- a/concurrency.c
+++ b/concurrency.c
@@ -4,7 +4,7 @@
#include <bio.h>
#include "apl9.h"
-#define STACKSIZE (8*1024*1024) /* 8 MB */
+#define STACKSIZE (8*1024*1024) /* 64 MB */
typedef struct SpawnData SpawnData;
struct SpawnData
@@ -48,7 +48,7 @@ spawnthread(Function f, Array *left, Array *right)
exit proc
*/
Channel *setupdone = chancreate(sizeof(int), 0);
- SpawnData *sp = malloc(sizeof(SpawnData));
+ SpawnData *sp = emalloc(sizeof(SpawnData));
sp->func = f;
sp->left = left ? duparray(left) : nil;
sp->right = duparray(right);
@@ -77,7 +77,7 @@ messagesend(Array *a, int id)
unlock(&threadlock);
if(td != nil){
qlock(&td->lock);
- Mail *newmail = malloc(sizeof(Mail));
+ Mail *newmail = emalloc(sizeof(Mail));
newmail->contents = fnSame(a);
newmail->next = 0;
if(td->lastmail != nil)
@@ -132,7 +132,7 @@ newprocfn(void *data)
static ThreadData *
newthreaddata(void)
{
- ThreadData *td = mallocz(sizeof(ThreadData), 1);
+ ThreadData *td = emallocz(sizeof(ThreadData), 1);
td->id = threadid();
td->currentdfn = nil;
td->mail = 0;
@@ -141,7 +141,7 @@ newthreaddata(void)
lock(&threadlock);
nthreads++;
- threads = realloc(threads, sizeof(ThreadData *) * nthreads);
+ threads = erealloc(threads, sizeof(ThreadData *) * nthreads);
threads[nthreads-1] = td;
unlock(&threadlock);
return td;
diff --git a/eval.c b/eval.c
index 1d54e42..b7515b1 100644
--- a/eval.c
+++ b/eval.c
@@ -8,19 +8,19 @@
int traceeval;
-typedef Datum (*evalfn)(Datum, Datum);
-
-Datum strand(Datum, Datum);
-Datum monadfun(Datum, Datum);
-Datum dyadfun(Datum, Datum);
-Datum parens(Datum, Datum);
-Datum nameis(Datum, Datum);
-Datum namesis(Datum, Datum);
-Datum assign(Datum, Datum);
-Datum monadop(Datum, Datum);
-Datum dyadop(Datum, Datum);
-Datum train(Datum, Datum);
-Datum *lookup(Datum);
+typedef Datum *(*evalfn)(Datum *, Datum *);
+
+Datum *strand(Datum *, Datum *);
+Datum *monadfun(Datum *, Datum *);
+Datum *dyadfun(Datum *, Datum *);
+Datum *parens(Datum *, Datum *);
+Datum *nameis(Datum *, Datum *);
+Datum *namesis(Datum *, Datum *);
+Datum *assign(Datum *, Datum *);
+Datum *monadop(Datum *, Datum *);
+Datum *dyadop(Datum *, Datum *);
+Datum *train(Datum *, Datum *);
+Datum *lookup(Datum *);
int bindingstrengths[11][11] = {
/* A F H MO DO AF ( ) ← IS N */
@@ -56,8 +56,11 @@ Datum *
eval(Statement *stmt, int toplevel)
{
/* start by looking up first variable if needed */
- if(stmt->ntoks > 0 && stmt->toks[stmt->ntoks-1].tag == NameTag)
- stmt->toks[stmt->ntoks-1] = *lookup(stmt->toks[stmt->ntoks-1]);;
+ if(stmt->ntoks > 0 && stmt->toks[stmt->ntoks-1]->tag == NameTag){
+ Datum *var = stmt->toks[stmt->ntoks-1];
+ stmt->toks[stmt->ntoks-1] = lookup(var);
+ freedatum(var);
+ }
while(stmt->ntoks > 1){
int maxlevel = 0;
@@ -70,18 +73,20 @@ retry:
if(offset == 0)
level = 0;
else{
- Datum left = stmt->toks[offset-1];
- Datum right = stmt->toks[offset];
- level = bindingstrengths[left.tag][right.tag];
+ Datum *left = stmt->toks[offset-1];
+ Datum *right = stmt->toks[offset];
+ level = bindingstrengths[left->tag][right->tag];
}
- if(level == 0 && stmt->toks[offset-1].tag == NameTag){
- stmt->toks[offset-1] = *lookup(stmt->toks[offset-1]);
+ if(level == 0 && offset > 0 && stmt->toks[offset-1]->tag == NameTag){
+ Datum *var = stmt->toks[offset-1];
+ stmt->toks[offset-1] = lookup(var);
+ freedatum(var);
goto retry;
}else if(level < maxlevel){
- Datum left = stmt->toks[offset];
- Datum right = stmt->toks[offset+1];
- fn = evalfns[left.tag][right.tag];
+ Datum *left = stmt->toks[offset];
+ Datum *right = stmt->toks[offset+1];
+ fn = evalfns[left->tag][right->tag];
traceprint("Reducing %S and %S (fn=%p, level=%d, max=%d)\n", ppdatum(left), ppdatum(right), fn, level, maxlevel);
break;
}else if(level > maxlevel)
@@ -90,13 +95,10 @@ retry:
if(maxlevel == 0)
throwerror(L"No reduce rule", EParse);
else{
- Datum new = fn(stmt->toks[offset],stmt->toks[offset+1]);
+ Datum *new = fn(stmt->toks[offset], stmt->toks[offset+1]);
traceprint("handler fn done\n");
- if(stmt->toks[offset].tag == ArrayTag)
- freearray(stmt->toks[offset].array);
- if(stmt->toks[offset+1].tag == ArrayTag)
- freearray(stmt->toks[offset+1].array);
-
+ freedatum(stmt->toks[offset]);
+ freedatum(stmt->toks[offset+1]);
stmt->toks[offset] = new;
for(int i = offset+1; i < stmt->ntoks-1; i++)
stmt->toks[i] = stmt->toks[i+1];
@@ -105,42 +107,42 @@ retry:
}
if(stmt->ntoks == 1){
int stop = 0;
- if(toplevel == 0 && !stmt->toks[0].shy)
+ if(toplevel == 0 && !stmt->toks[0]->shy)
stop = 1;
if(stmt->guard){
int guardOK = 1;
- if(stmt->toks[0].tag != ArrayTag)
+ if(stmt->toks[0]->tag != ArrayTag)
guardOK = 0;
- else if(stmt->toks[0].array->size != 1)
+ else if(stmt->toks[0]->array->size != 1)
guardOK = 0;
- else if(stmt->toks[0].array->type != AtypeInt)
+ else if(stmt->toks[0]->array->type != AtypeInt)
guardOK = 0;
- else if(stmt->toks[0].array->intdata[0] != 0 && stmt->toks[0].array->intdata[0] != 1)
+ else if(stmt->toks[0]->array->intdata[0] != 0 && stmt->toks[0]->array->intdata[0] != 1)
guardOK = 0;
if(!guardOK)
throwerror(L"Guard expected single valued boolean", EDomain);
else{
stop = 0;
- if(stmt->toks[0].array->intdata[0] == 1)
+ if(stmt->toks[0]->array->intdata[0] == 1)
return eval(stmt->guard, toplevel);
}
}
if(stmt->next && !stop)
return eval(stmt->next, toplevel);
else
- return stmt->toks;
+ return stmt->toks[0];
}else
return nil;
}
Datum *
-lookup(Datum var)
+lookup(Datum *var)
{
- traceprint("VAR LOOKUP %S\n", var.name);
- Symbol *symbol = getsym(var.name, 0);
+ traceprint("VAR LOOKUP %S\n", var->name);
+ Symbol *symbol = getsym(var->name, 0);
if(symbol->undefined){
- Rune *msg = runesmprint("Undefined name: %S", var.name);
+ Rune *msg = runesmprint("Undefined name: %S", var->name);
throwerror(msg, EValue);
}
@@ -148,236 +150,234 @@ lookup(Datum var)
if(symbol->getfn != nil)
val = symbol->getfn();
else{
- val = &symbol->value;
- if(val->tag == ArrayTag)
- incarrayref(val->array); /* since the value is now in the var AND in the code */
+ val = symbol->value;
+ incdatumref(val);
}
val->shy = 0;
- traceprint("VAR %S = %S\n", var.name, ppdatum(*val));
+ traceprint("VAR %S = %S\n", var->name, ppdatum(val));
return val;
}
-Datum
-strand(Datum left, Datum right)
+Datum *
+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 ? fnSame(left.array) : fnEnclose(left.array);
- Array *rightarr = right.array->stranded ? fnSame(right.array) : fnEnclose(right.array);
+ traceprint("Stranding (%d %d)\n", left->array->stranded, right->array->stranded);
+ Datum *result = allocdatum(ArrayTag, 0);
+ Array *leftarr = left->array->stranded ? fnSame(left->array) : fnEnclose(left->array);
+ Array *rightarr = right->array->stranded ? fnSame(right->array) : fnEnclose(right->array);
Array *tmp = fnCatenateFirst(leftarr, rightarr);
- result.tag = ArrayTag;
- result.array = simplifyarray(tmp);
- result.array->stranded = 1;
+ result->array = simplifyarray(tmp);
+ result->array->stranded = 1;
freearray(tmp);
freearray(leftarr);
freearray(rightarr);
return result;
}
-Datum
-monadfun(Datum left, Datum right)
+Datum *
+monadfun(Datum *left, Datum *right)
{
traceprint("Monadic function application\n");
- Datum result;
- result.tag = ArrayTag;
- result.shy = 0;
- result.array = runfunc(left.func, left.func.left, right.array);
+ Datum *result = allocdatum(ArrayTag, 0);
+ result->array = runfunc(left->func, left->func.left, right->array);
return result;
}
-Datum
-dyadfun(Datum left, Datum right)
+Datum *
+dyadfun(Datum *left, Datum *right)
{
traceprint("Applying left argument to function\n");
- Datum result;
- result.shy = 0;
- result.tag = BoundFunctionTag;
- if(right.tag == FunctionTag)
- result.func = right.func;
- else if(right.tag == HybridTag){
- result.func.type = FunctypeHybrid;
- result.func.code = right.hybrid;
+ Datum *result = allocdatum(BoundFunctionTag, 0);
+ if(right->tag == FunctionTag)
+ result->func = dupfunction(right->func);
+ else if(right->tag == HybridTag){
+ result->func.type = FunctypeHybrid;
+ result->func.code = right->hybrid;
}
- result.func.left = left.array;
- incarrayref(left.array);
+ result->func.left = fnSame(left->array);
return result;
}
-Datum
-parens(Datum left, Datum right)
+Datum *
+parens(Datum *left, Datum *right)
{
/* evaluate a parenthesis expression and return the result */
USED(right);
- traceprint("PARENS: %S\n", ppdatums(left.stmt.toks, left.stmt.ntoks));
- Datum *result = eval(&left.stmt, 1);
- if(result[0].tag == ArrayTag)
- result[0].array->stranded = 0;
- result[0].shy = 0;
- return result[0]; /* TODO handle error if ntoks != 1 */
+ traceprint("PARENS: %S\n", ppdatums(left->stmt.toks, left->stmt.ntoks));
+ Datum *result = eval(&left->stmt, 1);
+ incdatumref(result);
+ if(result->tag == ArrayTag)
+ result->array->stranded = 0;
+ result->shy = 0;
+ return result; /* TODO handle error if ntoks != 1 */
}
-Datum
-nameis(Datum left, Datum right)
+Datum *
+nameis(Datum *left, Datum *right)
{
- traceprint("NAMEIS %S←\n", left.name);
- right.tag = AssignmentTag;
- right.names.ntoks = 1;
- right.names.toks = malloc(sizeof(Datum));
- right.names.toks[0] = left;
- return right;
+ USED(right);
+ traceprint("NAMEIS %S←\n", left->name);
+ Datum *result = allocdatum(AssignmentTag, 0);
+ result->names.ntoks = 1;
+ result->names.toks = emalloc(sizeof(Datum*));
+ result->names.toks[0] = left;
+ incdatumref(left);
+ return result;
}
-Datum
-namesis(Datum left, Datum right)
+Datum *
+namesis(Datum *left, Datum *right)
{
- if(left.tag == RParTag)
+ if(left->tag == RParTag){
+ incdatumref(right);
return right;
+ }
traceprint("NAMES IS %S %S\n", ppdatum(left), ppdatum(right));
- right.tag = AssignmentTag;
- right.names = left.stmt;
- return right;
+ Datum *result = allocdatum(AssignmentTag, 0);
+ result->names.ntoks = left->stmt.ntoks;
+ result->names.toks = emalloc(sizeof(Datum*) * result->names.ntoks);
+ for(int i = 0; i < result->names.ntoks; i++){
+ result->names.toks[i] = left->stmt.toks[i];
+ incdatumref(result->names.toks[i]);
+ }
+ return result;
}
-Datum
-assign(Datum left, Datum right)
+Datum *
+assign(Datum *left, Datum *right)
{
traceprint("ASSIGN %S %S\n", ppdatum(left), ppdatum(right));
- if(left.names.ntoks == 1){
- if(left.names.toks[0].tag != NameTag)
+ if(left->names.ntoks == 1){
+ traceprint("Assign single\n");
+ if(left->names.toks[0]->tag != NameTag)
throwerror(nil, ESyntax);
- Symbol *symbol = getsym(left.names.toks[0].name, 0);
+ Symbol *symbol = getsym(left->names.toks[0]->name, 0);
if(symbol->setfn != nil)
symbol->setfn(right);
else{
/* re-assign the symbol to one that is sure to be local. This enables shadowing */
symbol = getsym(symbol->name, 1);
- if(symbol->undefined == 0 && symbol->value.tag == ArrayTag)
- freearray(symbol->value.array);
+ if(symbol->undefined == 0)
+ freedatum(symbol->value);
symbol->value = right;
+ incdatumref(right);
symbol->undefined = 0;
- if(symbol->value.tag == ArrayTag){
- symbol->value.array->stranded = 0;
- incarrayref(right.array); /* for the binding */
- }
+ if(symbol->value->tag == ArrayTag)
+ symbol->value->array->stranded = 0;
}
}else{
- if(right.tag != ArrayTag)
+ if(right->tag != ArrayTag)
throwerror(nil, ESyntax);
- if(right.array->rank != 1 && right.array->rank != 0)
+ if(right->array->rank != 1 && right->array->rank != 0)
throwerror(nil, ERank);
int nlocs = 0;
- Datum *locations = nil;
- for(int i = 0; i < left.names.ntoks; i++){
- Datum loc = left.names.toks[i];
- if(loc.tag == NameTag){
+ Datum **locations = nil;
+ for(int i = 0; i < left->names.ntoks; i++){
+ Datum *loc = left->names.toks[i];
+ if(loc->tag == NameTag){
nlocs++;
- locations = realloc(locations, sizeof(Datum) * nlocs);
- locations[nlocs-1].tag = AssignmentTag;
- locations[nlocs-1].names.ntoks = 1;
- locations[nlocs-1].names.toks = malloc(sizeof(Datum));
- locations[nlocs-1].names.toks[0] = loc;
- }else if(loc.tag == LParTag){
+ locations = erealloc(locations, sizeof(Datum*) * nlocs);
+ locations[nlocs-1] = allocdatum(AssignmentTag, 0);
+ locations[nlocs-1]->names.ntoks = 1;
+ locations[nlocs-1]->names.toks = emalloc(sizeof(Datum*));
+ locations[nlocs-1]->names.toks[0] = loc;
+ incdatumref(loc);
+ }else if(loc->tag == LParTag){
i++;
nlocs++;
- locations = realloc(locations, sizeof(Datum) * nlocs);
- locations[nlocs-1].tag = AssignmentTag;
- locations[nlocs-1].names = loc.stmt;
+ locations = erealloc(locations, sizeof(Datum*) * nlocs);
+ locations[nlocs-1] = allocdatum(AssignmentTag, 0);
+ locations[nlocs-1]->names.ntoks = loc->stmt.ntoks;
+ locations[nlocs-1]->names.toks = emalloc(sizeof(Datum*) * loc->stmt.ntoks);
+ for(int j = 0; j < loc->stmt.ntoks; j++){
+ locations[nlocs-1]->names.toks[j] = loc->stmt.toks[j];
+ incdatumref(loc->stmt.toks[j]);
+ }
}
}
- if(right.array->rank == 1 && right.array->size != nlocs)
+ if(right->array->rank == 1 && right->array->size != nlocs)
throwerror(nil, ELength);
for(int i = 0; i < nlocs; i++){
- if(right.array->rank == 0)
- assign(locations[i], right);
+ Datum *item;
+ if(right->array->rank == 0)
+ item = right;
else{
- Datum item;
- item.tag = ArrayTag;
- item.array = arrayitem(right.array, i);
- assign(locations[i], item);
- freearray(item.array);
+ item = allocdatum(ArrayTag, 0);
+ item->array = arrayitem(right->array, i);
}
+ assign(locations[i], item);
+ freedatum(item); /* free the returned item */
+ if(item != right)
+ freedatum(item);
+ freedatum(locations[i]);
}
}
- right.shy = 1;
- if(right.tag == ArrayTag)
- incarrayref(right.array); /* for the returned array */
- return right;
+ Datum *result = right;
+ incdatumref(right);
+ result->shy = 1;
+ return result;
}
-Datum
-monadop(Datum left, Datum right)
+Datum *
+monadop(Datum *left, Datum *right)
{
traceprint("Applying left argument to operator\n");
- Datum *arg = emalloc(sizeof(Datum));
- *arg = left;
-
- Datum result;
- result.shy = 0;
- result.tag = FunctionTag,
- result.func.type = FunctypeOp;
- if(right.tag == MonadicOpTag || right.tag == DyadicOpTag)
- result.func.operator = right.operator;
+ Datum *result = allocdatum(FunctionTag, 0);
+ result->func.type = FunctypeOp;
+ if(right->tag == MonadicOpTag || right->tag == DyadicOpTag)
+ result->func.operator = dupoperator(right->operator);
else{
- result.func.operator.type = OperatortypeHybrid;
- result.func.operator.code = right.hybrid;
+ result->func.operator.type = OperatortypeHybrid;
+ result->func.operator.code = right->hybrid;
}
- result.func.operator.left = arg;
- result.func.left = nil;
- if(arg->tag == ArrayTag)
- incarrayref(arg->array);
+ result->func.operator.left = left;
+ incdatumref(left);
+ result->func.left = nil;
return result;
}
-Datum
-dyadop(Datum left, Datum right)
+Datum *
+dyadop(Datum *left, Datum *right)
{
traceprint("Applying right argument to operator\n");
- Datum *arg = emalloc(sizeof(Datum));
- *arg = right;
-
- Datum result;
- result.shy = 0;
- result.tag = MonadicOpTag,
- result.operator = left.operator;
- result.operator.right = arg;
- if(arg->tag == ArrayTag)
- incarrayref(arg->array);
+ Datum *result = allocdatum(MonadicOpTag, 0);
+ result->operator = dupoperator(left->operator);
+ result->operator.right = right;
+ incdatumref(right);
return result;
}
-Datum
-train(Datum left, Datum right)
+Datum *
+train(Datum *left, Datum *right)
{
- Datum result;
- result.shy = 0;
- result.tag = FunctionTag;
- result.func.type = FunctypeTrain;
- result.func.left = nil;
- if(left.func.type == FunctypeTrain)
- result.func = left.func;
+ traceprint("Creating train from %S and %S\n", ppdatum(left), ppdatum(right));
+ Datum *result = allocdatum(FunctionTag, 0);
+ result->func.type = FunctypeTrain;
+ result->func.left = nil;
+ if(left->func.type == FunctypeTrain)
+ result->func = left->func;
else{
- result.func.train.nfuncs = 1;
- result.func.train.funcs = malloc(sizeof(Function));
- result.func.train.funcs[0] = left.func;
+ result->func.train.nfuncs = 1;
+ result->func.train.funcs = emalloc(sizeof(Function));
+ result->func.train.funcs[0] = dupfunction(left->func);
}
- if(right.func.type == FunctypeTrain){
- int oldn = result.func.train.nfuncs;
- result.func.train.nfuncs = oldn + right.func.train.nfuncs;
- result.func.train.funcs = realloc(result.func.train.funcs, sizeof(Function) * result.func.train.nfuncs);
- for(int i = 0; i < right.func.train.nfuncs; i++)
- result.func.train.funcs[oldn + i] = right.func.train.funcs[i];
+ if(right->func.type == FunctypeTrain){
+ int oldn = result->func.train.nfuncs;
+ result->func.train.nfuncs = oldn + right->func.train.nfuncs;
+ result->func.train.funcs = erealloc(result->func.train.funcs, sizeof(Function) * result->func.train.nfuncs);
+ for(int i = 0; i < right->func.train.nfuncs; i++)
+ result->func.train.funcs[oldn + i] = dupfunction(right->func.train.funcs[i]);
}else{
- result.func.train.nfuncs++;
- result.func.train.funcs = realloc(result.func.train.funcs, sizeof(Function) * result.func.train.nfuncs);
- result.func.train.funcs[result.func.train.nfuncs-1] = right.func;
+ result->func.train.nfuncs++;
+ result->func.train.funcs = erealloc(result->func.train.funcs, sizeof(Function) * result->func.train.nfuncs);
+ result->func.train.funcs[result->func.train.nfuncs-1] = dupfunction(right->func);
}
return result;
} \ No newline at end of file
diff --git a/functions.c b/functions.c
index 46f9782..7c49554 100644
--- a/functions.c
+++ b/functions.c
@@ -145,7 +145,9 @@ runfunc(Function f, Array *left, Array *right)
Datum *dfnres = evalline(code, nil, 0);
popdfnframe();
- result = (*dfnres).array; /* TODO what if the evaluation failed */
+ result = dfnres->array; /* TODO what if the evaluation failed */
+ incarrayref(result);
+ freedatum(dfnres);
}else if(f.type == FunctypePrim){
if(left){
fndyad d = dyadfunctiondefs[f.code];
@@ -525,7 +527,7 @@ fnMix(Array *right)
for(j = 0; j < commonshape->size; j++)
result->shape[i+j] = commonshape->intdata[j];
- int *index = malloc(sizeof(int) * commonrank);
+ int *index = emalloc(sizeof(int) * commonrank);
int offset;
for(i = 0; i < size/commonsize; i++){
Array *a = right->arraydata[i];
@@ -618,7 +620,7 @@ fnGradeUp(Array *right)
int i,j;
int len = right->shape[0];
- Array **elems = malloc(sizeof(Array *) * len);
+ Array **elems = emalloc(sizeof(Array *) * len);
Array *index = mkscalarint(globalIO());
Array *order = allocarray(AtypeInt, 1, len);
order->shape[0] = len;
@@ -740,7 +742,7 @@ fnRavel(Array *right)
{
Array *res = duparray(right);
res->rank = 1;
- res->shape = realloc(res->shape, sizeof(int) * 1);
+ res->shape = erealloc(res->shape, sizeof(int) * 1);
res->shape[0] = res->size;
return res;
}
@@ -750,7 +752,7 @@ fnTable(Array *right)
{
Array *res = duparray(right);
res->rank = 2;
- res->shape = realloc(res->shape, sizeof(int) * 2);
+ res->shape = erealloc(res->shape, sizeof(int) * 2);
res->shape[0] = right->rank ? res->shape[0] : 1;
res->shape[1] = right->size / res->shape[0];
return res;
@@ -814,8 +816,8 @@ fnTranspose(Array *right)
res->shape[i] = right->shape[res->rank - 1 - i];
int from, to;
- int *sizesFrom = malloc(sizeof(int) * right->rank);
- int *sizesTo = malloc(sizeof(int) * right->rank);
+ int *sizesFrom = emalloc(sizeof(int) * right->rank);
+ int *sizesTo = emalloc(sizeof(int) * right->rank);
int accFrom = 1, accTo = 1;
for(int i = 0; i < right->rank; i++){
sizesFrom[i] = accFrom;
@@ -1289,7 +1291,7 @@ fnTake(Array *left, Array *right)
if(right->rank == 0){
right = duparray(right);
right->rank = left->size;
- right->shape = realloc(right->shape, sizeof(int) * right->rank);
+ right->shape = erealloc(right->shape, sizeof(int) * right->rank);
for(i = 0; i < right->rank; i++)
right->shape[i] = 1;
}else
@@ -1306,7 +1308,7 @@ fnTake(Array *left, Array *right)
left->intdata[i] = old->intdata[i];
}
- int *shape = malloc(sizeof(int) * left->size);
+ int *shape = emalloc(sizeof(int) * left->size);
int size = 1;
for(i = 0; i < left->size; i++){
int s = left->intdata[i];
@@ -1319,7 +1321,7 @@ fnTake(Array *left, Array *right)
for(i = 0; i < right->rank; i++)
result->shape[i] = shape[i];
- int *index = mallocz(sizeof(int) * left->size, 1);
+ int *index = emallocz(sizeof(int) * left->size, 1);
int fromindex;
for(i = 0; i < size; i++){
for(int j = left->size-1; index[j] == shape[j]; j--){
@@ -1378,7 +1380,7 @@ fnDrop(Array *left, Array *right)
if(right->rank == 0){
right = duparray(right);
right->rank = left->size;
- right->shape = realloc(right->shape, sizeof(int) * right->rank);
+ right->shape = erealloc(right->shape, sizeof(int) * right->rank);
for(i = 0; i < right->rank; i++)
right->shape[i] = 1;
}else
@@ -1560,7 +1562,7 @@ fnIndex(Array *left, Array *right)
for(i = 0; i < rank; i++)
result->shape[i] = shape->intdata[i];
freearray(shape);
- int *leftindex = mallocz(sizeof(int) * right->rank, 1);
+ int *leftindex = emallocz(sizeof(int) * right->rank, 1);
for(i = 0; i < result->size; i++){
for(int j = left->size-1; leftindex[j] == left->arraydata[j]->size; j--){
leftindex[j] = 0;
@@ -1925,7 +1927,7 @@ indexOfHelper(Array *left, Array *right, int interval)
rightshape->intdata[rightshape->size-1-i] = right->shape[right->rank-1-i];
right = fnReshape(rightshape, right);
- Array **lefts = malloc(sizeof(Array *) * n);
+ Array **lefts = emalloc(sizeof(Array *) * n);
Array *index = mkscalarint(io);
for(i = 0; i < n; i++){
index->intdata[0] = i+io;
diff --git a/lexer.c b/lexer.c
index 864bb3c..ed2c2e4 100644
--- a/lexer.c
+++ b/lexer.c
@@ -55,7 +55,7 @@ lexline(InputStream *input, int toplevel)
{
Statement *stmt = emalloc(sizeof(Statement));
stmt->ntoks = 0;
- stmt->toks = mallocz(sizeof(Datum) * MAX_LINE_TOKENS, 1);
+ stmt->toks = emallocz(sizeof(Datum*) * MAX_LINE_TOKENS, 1);
stmt->guard = nil;
stmt->next = nil;
@@ -67,7 +67,7 @@ lexline(InputStream *input, int toplevel)
continue;
}else if(runestrchr(L"←⋄\n⍝⍬", peek)){
switch(peek){
- case L'←': stmt->toks[stmt->ntoks].tag = ArrowTag; break;
+ case L'←': stmt->toks[stmt->ntoks] = allocdatum(ArrowTag, 0); break;
case L'\n':
case L'⋄':
if(stmt->ntoks == 0)
@@ -81,9 +81,9 @@ lexline(InputStream *input, int toplevel)
ungetrune(input);
goto end;
case L'⍬':
- stmt->toks[stmt->ntoks].tag = ArrayTag;
- stmt->toks[stmt->ntoks].array = allocarray(AtypeInt, 1, 0);
- stmt->toks[stmt->ntoks].array->shape[0] = 0;
+ stmt->toks[stmt->ntoks] = allocdatum(ArrayTag, 0);
+ stmt->toks[stmt->ntoks]->array = allocarray(AtypeInt, 1, 0);
+ stmt->toks[stmt->ntoks]->array->shape[0] = 0;
break;
}
}else if(!toplevel && peek == ':'){
@@ -115,14 +115,14 @@ lexline(InputStream *input, int toplevel)
goto syntax_error;
*p = 0;
if(oplevel == 0){
- stmt->toks[stmt->ntoks].tag = FunctionTag;
- stmt->toks[stmt->ntoks].func.type = FunctypeDfn;
- stmt->toks[stmt->ntoks].func.dfn = runestrdup(buf);
+ stmt->toks[stmt->ntoks] = allocdatum(FunctionTag, 0);
+ stmt->toks[stmt->ntoks]->func.type = FunctypeDfn;
+ stmt->toks[stmt->ntoks]->func.dfn = runestrdup(buf);
}else{
- stmt->toks[stmt->ntoks].tag = oplevel == 1 ? MonadicOpTag : DyadicOpTag;
- stmt->toks[stmt->ntoks].operator.type = OperatortypeDop;
- stmt->toks[stmt->ntoks].operator.dyadic = oplevel == 2;
- stmt->toks[stmt->ntoks].operator.dop = runestrdup(buf);
+ stmt->toks[stmt->ntoks] = allocdatum(oplevel == 1 ? MonadicOpTag : DyadicOpTag, 0);
+ stmt->toks[stmt->ntoks]->operator.type = OperatortypeDop;
+ stmt->toks[stmt->ntoks]->operator.dyadic = oplevel == 2;
+ stmt->toks[stmt->ntoks]->operator.dop = runestrdup(buf);
}
}else if(peek == '('){
int unclosed = 1;
@@ -138,27 +138,27 @@ lexline(InputStream *input, int toplevel)
if(peek != ')')
goto syntax_error;
*p = 0;
- stmt->toks[stmt->ntoks].tag = LParTag;
- stmt->toks[stmt->ntoks].stmt = *lexlinestr(buf, toplevel);
+ stmt->toks[stmt->ntoks] = allocdatum(LParTag, 0);
+ stmt->toks[stmt->ntoks]->stmt = *lexlinestr(buf, toplevel);
stmt->ntoks++;
- stmt->toks[stmt->ntoks].tag = RParTag;
+ stmt->toks[stmt->ntoks] = allocdatum(RParTag, 0);
}else if(p = runestrchr(primfuncnames, peek)){
- stmt->toks[stmt->ntoks].tag = FunctionTag;
- stmt->toks[stmt->ntoks].func.type = FunctypePrim;
- stmt->toks[stmt->ntoks].func.code = p-primfuncnames;
+ stmt->toks[stmt->ntoks] = allocdatum(FunctionTag, 0);
+ stmt->toks[stmt->ntoks]->func.type = FunctypePrim;
+ stmt->toks[stmt->ntoks]->func.code = p-primfuncnames;
}else if(p = runestrchr(primmonopnames, peek)){
- stmt->toks[stmt->ntoks].tag = MonadicOpTag;
- stmt->toks[stmt->ntoks].operator.type = OperatortypePrim;
- stmt->toks[stmt->ntoks].operator.dyadic = 0;
- stmt->toks[stmt->ntoks].operator.code = p-primmonopnames;
+ stmt->toks[stmt->ntoks] = allocdatum(MonadicOpTag, 0);
+ stmt->toks[stmt->ntoks]->operator.type = OperatortypePrim;
+ stmt->toks[stmt->ntoks]->operator.dyadic = 0;
+ stmt->toks[stmt->ntoks]->operator.code = p-primmonopnames;
}else if(p = runestrchr(primdyadopnames, peek)){
- stmt->toks[stmt->ntoks].tag = DyadicOpTag;
- stmt->toks[stmt->ntoks].operator.type = OperatortypePrim;
- stmt->toks[stmt->ntoks].operator.dyadic = 1;
- stmt->toks[stmt->ntoks].operator.code = p-primdyadopnames;
+ stmt->toks[stmt->ntoks] = allocdatum(DyadicOpTag, 0);
+ stmt->toks[stmt->ntoks]->operator.type = OperatortypePrim;
+ stmt->toks[stmt->ntoks]->operator.dyadic = 1;
+ stmt->toks[stmt->ntoks]->operator.code = p-primdyadopnames;
}else if(p = runestrchr(primhybridnames, peek)){
- stmt->toks[stmt->ntoks].tag = HybridTag;
- stmt->toks[stmt->ntoks].hybrid = p-primhybridnames;
+ stmt->toks[stmt->ntoks] = allocdatum(HybridTag, 0);
+ stmt->toks[stmt->ntoks]->hybrid = p-primhybridnames;
}else if(isdigitrune(peek) || peek == L'¯'){
char buf[64];
char *p = buf;
@@ -180,12 +180,12 @@ get_digits:
}
*p = 0;
ungetrune(input);
- stmt->toks[stmt->ntoks].tag = ArrayTag;
- stmt->toks[stmt->ntoks].array = floating ? mkscalarfloat(atof(buf)) : mkscalarint(atoll(buf));
+ stmt->toks[stmt->ntoks] = allocdatum(ArrayTag, 0);
+ stmt->toks[stmt->ntoks]->array = floating ? mkscalarfloat(atof(buf)) : mkscalarint(atoll(buf));
}else if(runestrchr(L"⍺⍵⍶⍹", peek)){
Rune name[2] = {peek, 0};
- stmt->toks[stmt->ntoks].tag = NameTag;
- stmt->toks[stmt->ntoks].name = runestrdup(name);
+ stmt->toks[stmt->ntoks] = allocdatum(NameTag, 0);
+ stmt->toks[stmt->ntoks]->name = runestrdup(name);
}else if(isalpharune(peek) || peek == '_'){
Rune buf[64];
Rune *p = buf;
@@ -195,8 +195,8 @@ get_digits:
}
*p = 0;
ungetrune(input);
- stmt->toks[stmt->ntoks].tag = NameTag;
- stmt->toks[stmt->ntoks].name = runestrdup(buf);
+ stmt->toks[stmt->ntoks] = allocdatum(NameTag, 0);
+ stmt->toks[stmt->ntoks]->name = runestrdup(buf);
}else if(runestrchr(L"⎕⍞", peek)){
/* quad names */
Rune buf[64];
@@ -241,11 +241,11 @@ get_digits:
}
if(!done)
goto syntax_error;
- stmt->toks[stmt->ntoks].tag = ArrayTag;
+ stmt->toks[stmt->ntoks] = allocdatum(ArrayTag, 0);
if(runestrlen(buf) == 1)
- stmt->toks[stmt->ntoks].array = mkscalarrune(buf[0]);
+ stmt->toks[stmt->ntoks]->array = mkscalarrune(buf[0]);
else
- stmt->toks[stmt->ntoks].array = mkrunearray(buf);
+ stmt->toks[stmt->ntoks]->array = mkrunearray(buf);
}else{
Rune *err;
syntax_error:
@@ -259,7 +259,7 @@ syntax_error:
peek = getrune(input);
}
end:
- stmt->toks = realloc(stmt->toks, sizeof(Datum) * stmt->ntoks);
+ stmt->toks = erealloc(stmt->toks, sizeof(Datum) * stmt->ntoks);
return stmt;
}
diff --git a/main.c b/main.c
index 0520592..9acd568 100644
--- a/main.c
+++ b/main.c
@@ -52,33 +52,15 @@ restart:
}
print("\t");
Datum *result = evalline(nil, stdin, 1);
- if(result == nil)
- continue;
- else{
- if(result[0].shy == 0)
- print("%S\n", ppdatum(*result));
- if(result->tag == ArrayTag)
- freearray(result->array);
- free(result);
- }
- /* print("Unfreed arrays: %d\n", alloccounts); */
+ if(result && !result->shy)
+ print("%S\n", ppdatum(result));
+ freedatum(result);
+/*
+ print("Unfreed arrays: %d\n", arrayalloccounts);
+ print("Unfreed datums: %d\n", datumalloccounts);
+*/
}
- exits(nil);
-}
-
-Rune *
-prompt(Rune *pr)
-{
- Rune line[MAX_LINE_LENGTH];
-
- print("%S",pr);
-
- int i = 0;
- line[0] = 0;
- while(i == 0 || line[i-1] != '\n')
- line[i++] = Bgetrune(stdin);
- line[i-1] = 0;
- return runestrdup(line);
+ threadexitsall(nil);
}
Datum *
@@ -94,16 +76,14 @@ evalline(Rune *line, Biobuf *bio, int toplevel)
Datum *result = eval(stmts, toplevel);
if(result)
- return result;
- else{
- Statement *s = stmts;
- while(s != nil){
- Statement *tmp = s;
- s = s->next;
- free(tmp->toks);
- free(tmp);
- }
-
- return nil;
+ incdatumref(result);
+
+ Statement *s = stmts;
+ while(s != nil){
+ Statement *tmp = s;
+ s = s->next;
+ freestatement(*tmp);
+ free(tmp);
}
+ return result;
} \ No newline at end of file
diff --git a/memory.c b/memory.c
index 4606ef2..33c30d7 100644
--- a/memory.c
+++ b/memory.c
@@ -1,20 +1,44 @@
#include <u.h>
#include <libc.h>
+#include <thread.h>
#include <bio.h>
#include <pool.h>
#include "apl9.h"
-int alloccounts = 0;
+int arrayalloccounts = 0;
+int datumalloccounts = 0;
int debugmem;
void *
emalloc(ulong size)
{
void *res = malloc(size);
- if(res == nil){
+ if(res == nil && size > 0){
print("Out of memory! :(\n");
- exits("emalloc");
+ threadexitsall("emalloc");
+ }
+ return res;
+}
+
+void *
+emallocz(ulong size, int clr)
+{
+ void *res = mallocz(size, clr);
+ if(res == nil && size > 0){
+ print("Out of memory! :(\n");
+ threadexitsall("emallocz");
+ }
+ return res;
+}
+
+void *
+erealloc(void *ptr, ulong size)
+{
+ void *res = realloc(ptr, size);
+ if(res == nil && size > 0){
+ print("Out of memory! :(\n");
+ threadexitsall("erealloc");
}
return res;
}
@@ -36,19 +60,18 @@ 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->rawdata);
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);
+ arrayalloccounts--;
+ }else if(a->refs < 0){
+ print("NEGATIVE REF COUNT (array)! %p\n", a);
+ threadexitsall(nil);
}
+
}
Array *
@@ -63,16 +86,186 @@ allocarray(arrayDataType t, int rank, int size)
a->rawdata = emalloc(datasizes[t] * size);
a->type = t;
a->refs = 1;
- alloccounts++;
+ arrayalloccounts++;
return a;
}
void
incarrayref(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++)
- incarrayref(a->arraydata[i]);
+}
+
+Datum *
+allocdatum(int tag, int shy)
+{
+ Datum *d = emallocz(sizeof(Datum), 1);
+ d->refs = 1;
+ d->tag = tag;
+ d->shy = shy;
+ datumalloccounts++;
+ return d;
+}
+
+void
+freedatum(Datum *d)
+{
+ if(d == nil)
+ return;
+
+ d->refs--;
+ if(d->refs == 0){
+ /* print("FREE DATUM: %S\n", ppdatum(d)); */
+ switch(d->tag){
+ case ArrayTag:
+ freearray(d->array);
+ break;
+ case FunctionTag:
+ case BoundFunctionTag:
+ freefunction(d->func);
+ break;
+ case HybridTag:
+ break;
+ case MonadicOpTag:
+ case DyadicOpTag:
+ freeoperator(d->operator);
+ break;
+ case LParTag:
+ freestatement(d->stmt);
+ break;
+ case RParTag:
+ break;
+ case ArrowTag:
+ break;
+ case AssignmentTag:
+ freestatement(d->names);
+ break;
+ case NameTag:
+ free(d->name);
+ break;
+ default:
+ print("Don't know how to free datum with tag: %d\n", d->tag);
+ threadexitsall("freedatum");
+ }
+ free(d);
+ datumalloccounts--;
+ }else if(d->refs < 0){
+ print("NEGATIVE REF COUNT (datum)! %p\n", d);
+ threadexitsall(nil);
+ }
+}
+
+void
+incdatumref(Datum *d)
+{
+ d->refs++;
+}
+
+void
+freefunction(Function f)
+{
+ freearray(f.left);
+ switch(f.type){
+ case FunctypeDfn:
+ free(f.dfn);
+ break;
+ case FunctypePrim:
+ break;
+ case FunctypeOp:
+ freeoperator(f.operator);
+ break;
+ case FunctypeQuad:
+ free(f.quad);
+ break;
+ case FunctypeHybrid:
+ break;
+ case FunctypeTrain:
+ for(int i = 0; i < f.train.nfuncs; i++)
+ freefunction(f.train.funcs[i]);
+ free(f.train.funcs);
+ break;
+ default:
+ print("Missing case in freefunction: %d\n", f.type);
+ threadexitsall("freefunction");
+ }
+}
+
+void
+freeoperator(Operator o)
+{
+ freedatum(o.left);
+ freedatum(o.right);
+ switch(o.type){
+ case OperatortypeDop:
+ free(o.dop);
+ break;
+ case OperatortypePrim:
+ case OperatortypeHybrid:
+ break;
+ default:
+ print("Missing case in freeoperator: %d\n", o.type);
+ threadexitsall("freeoperator");
+ }
+}
+
+void
+freestatement(Statement s)
+{
+ for(int i = 0; i < s.ntoks; i++)
+ freedatum(s.toks[i]);
+ free(s.toks);
+ if(s.guard)
+ freestatement(*s.guard);
+}
+
+Function
+dupfunction(Function f)
+{
+ Function g = f;
+ if(g.left)
+ incarrayref(g.left);
+
+ switch(f.type){
+ case FunctypeDfn:
+ g.dfn = runestrdup(f.dfn);
+ break;
+ case FunctypePrim:
+ break;
+ case FunctypeOp:
+ g.operator = dupoperator(f.operator);
+ break;
+ case FunctypeQuad:
+ g.quad = emalloc(sizeof(QuadnameDef));
+ *g.quad = *f.quad;
+ break;
+ case FunctypeHybrid:
+ break;
+ default:
+ print("Missing case in dupfunction: %d\n", f.type);
+ threadexitsall("dupfunction");
+ }
+ return g;
+
+}
+
+Operator
+dupoperator(Operator o)
+{
+ Operator p = o;
+ if(p.left)
+ incdatumref(p.left);
+ if(p.right)
+ incdatumref(p.right);
+ switch(o.type){
+ case OperatortypeDop:
+ p.dop = runestrdup(o.dop);
+ break;
+ case OperatortypePrim:
+ case OperatortypeHybrid:
+ break;
+ default:
+ print("Missing case in dupoperator: %d\n", o.type);
+ threadexitsall("dupoperator");
+ }
+ return p;
} \ No newline at end of file
diff --git a/operators.c b/operators.c
index a06b0d6..336588a 100644
--- a/operators.c
+++ b/operators.c
@@ -111,7 +111,7 @@ opOuterProduct(Datum *lefto, Array *left, Array *right)
int i;
int rank = left->rank + right->rank;
int size = 1;
- int *shape = malloc(sizeof(int) * rank);
+ int *shape = emalloc(sizeof(int) * rank);
for(i = 0; i < left->rank; i++){
shape[i] = left->shape[i];
size *= left->shape[i];
diff --git a/print.c b/print.c
index 45bca53..232fc54 100644
--- a/print.c
+++ b/print.c
@@ -11,28 +11,28 @@ Rune *printborder(Rune *, int *, int, int);
Rune *strline(Rune *, int);
Rune *
-ppdatum(Datum d)
+ppdatum(Datum *d)
{
Rune *result;
- switch(d.tag){
- case ArrayTag: result = pparray(d.array); break;
+ switch(d->tag){
+ case ArrayTag: result = pparray(d->array); break;
case BoundFunctionTag:
- case FunctionTag: result = ppfunction(d.func); break;
- case HybridTag: result = runesmprint("%C", primhybridnames[d.func.code]); break;
+ case FunctionTag: result = ppfunction(d->func); break;
+ case HybridTag: result = runesmprint("%C", primhybridnames[d->func.code]); break;
case MonadicOpTag:
- case DyadicOpTag: result = ppoperator(d.operator); break;
- case LParTag: result = runesmprint("(%S", ppdatums(d.stmt.toks, d.stmt.ntoks)); break;
+ case DyadicOpTag: result = ppoperator(d->operator); break;
+ case LParTag: result = runesmprint("(%S", ppdatums(d->stmt.toks, d->stmt.ntoks)); break;
case RParTag: result = runestrdup(L")"); break;
case ArrowTag: result = runestrdup(L"←"); break;
- case AssignmentTag: result = runesmprint("(%S)←", ppdatums(d.stmt.toks, d.stmt.ntoks)); break;
- case NameTag: result = runestrdup(d.name); break;
- default: result = runesmprint("<not printable %d>", d.tag);
+ case AssignmentTag: result = runesmprint("(%S)←", ppdatums(d->stmt.toks, d->stmt.ntoks)); break;
+ case NameTag: result = runestrdup(d->name); break;
+ default: result = runesmprint("<not printable %d>", d->tag);
}
return result;
}
Rune *
-ppdatums(Datum *ds, int n)
+ppdatums(Datum **ds, int n)
{
int i;
Rune *res = runesmprint("");
@@ -54,7 +54,7 @@ pparray(Array *a)
for(int i = 0; i < a->rank-1; i++)
rowcount *= a->shape[i];
}
- Rune **rowstrs = mallocz(sizeof(Rune *) * rowcount, 1);
+ Rune **rowstrs = emallocz(sizeof(Rune *) * rowcount, 1);
int boxing = !simplearray(a);
char *align = a->type == AtypeArray ? "-" : "";
@@ -90,8 +90,8 @@ pparray(Array *a)
}
int lastdim = a->rank ? a->shape[a->rank-1] : 1;
- int *widths = mallocz(sizeof(int) * lastdim, 1);
- int *heights = mallocz(sizeof(int) * rowcount, 1);
+ int *widths = emallocz(sizeof(int) * lastdim, 1);
+ int *heights = emallocz(sizeof(int) * rowcount, 1);
for(int i = 0; i < a->size; i++){
int w,h;
strdims(elemstrs[i], &w, &h);
@@ -179,8 +179,8 @@ pparray(Array *a)
Rune *
ppoperator(Operator op)
{
- Rune *left = op.left ? ppdatum(*op.left) : runestrdup(L"");
- Rune *right = op.right ? ppdatum(*op.right) : runestrdup(L"");
+ Rune *left = op.left ? ppdatum(op.left) : runestrdup(L"");
+ Rune *right = op.right ? ppdatum(op.right) : runestrdup(L"");
Rune *res;
if(op.type == OperatortypeDop)
res = runesmprint("(%S{%S}%S)", left, op.dop, right);
diff --git a/quadnames.c b/quadnames.c
index 7d5884c..57c5dbb 100644
--- a/quadnames.c
+++ b/quadnames.c
@@ -6,15 +6,15 @@
#include "apl9.h"
Datum *getquotequad(void);
-void setquotequad(Datum);
+void setquotequad(Datum *);
Datum *getquad(void);
-void setquad(Datum);
+void setquad(Datum *);
Datum *getio(void);
-void setio(Datum);
+void setio(Datum *);
Datum *getpp(void);
-void setpp(Datum);
+void setpp(Datum *);
Datum *getdiv(void);
-void setdiv(Datum);
+void setdiv(Datum *);
Datum *geta(void);
Datum *getd(void);
Datum *getself(void);
@@ -66,26 +66,25 @@ initquadnames(void)
}
}
-Datum
+Datum *
quadnamedatum(QuadnameDef q)
{
- Datum d;
- d.tag = q.tag;
+ Datum *d = allocdatum(q.tag, 0);
switch(q.tag){
case NameTag:
- d.name = q.name;
+ d->name = runestrdup(q.name);
break;
case FunctionTag:
- d.func.type = FunctypeQuad;
- d.func.quad = malloc(sizeof(QuadnameDef));
- *d.func.quad = q;
- d.func.left = nil;
+ d->func.type = FunctypeQuad;
+ d->func.quad = emalloc(sizeof(QuadnameDef));
+ *d->func.quad = q;
+ d->func.left = nil;
break;
case MonadicOpTag:
case DyadicOpTag:
default:
print("Can't use quad names with type=%d\n", q.tag);
- exits(nil);
+ threadexitsall(nil);
}
return d;
}
@@ -104,21 +103,20 @@ getquotequad(void)
sizemax = size+1;
quadquotebuf = nil;
}else{
- input = malloc(sizeof(Rune) * sizemax);
+ input = emalloc(sizeof(Rune) * sizemax);
size = 0;
}
do{
if(size == sizemax-1){
sizemax += 512;
- input = realloc(input, sizeof(Rune) * sizemax);
+ input = erealloc(input, sizeof(Rune) * sizemax);
}
input[size] = Bgetrune(stdin);
size++;
}while(input[size-1] != '\n');
input[size-1] = 0;
- Datum *result = mallocz(sizeof(Datum), 1);
- result->tag = ArrayTag;
+ Datum *result = allocdatum(ArrayTag, 0);
result->array = mkrunearray(input);
free(input);
unlock(&quadlock);
@@ -126,7 +124,7 @@ getquotequad(void)
}
void
-setquotequad(Datum new)
+setquotequad(Datum *new)
{
lock(&quadlock);
Rune *str = ppdatum(new);
@@ -158,7 +156,7 @@ getquad(void)
}
void
-setquad(Datum new)
+setquad(Datum *new)
{
lock(&quadlock);
needsnewline = 0;
@@ -170,65 +168,61 @@ setquad(Datum new)
Datum *
getio(void)
{
- Datum *d = mallocz(sizeof(Datum), 1);
- d->tag = ArrayTag;
+ Datum *d = allocdatum(ArrayTag, 0);
d->array = mkscalarint(globalIO());
return d;
}
void
-setio(Datum new)
+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))
+ 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
- globalIOset(new.array->intdata[0]);
+ globalIOset(new->array->intdata[0]);
}
/* ⎕PP */
Datum *
getpp(void)
{
- Datum *d = mallocz(sizeof(Datum), 1);
- d->tag = ArrayTag;
+ Datum *d = allocdatum(ArrayTag, 0);
d->array = mkscalarint(printprecision);
return d;
}
void
-setpp(Datum new)
+setpp(Datum *new)
{
- if(new.tag != ArrayTag || new.array->rank != 0 || new.array->type != AtypeInt || new.array->intdata[0] < 0)
+ 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];
+ printprecision = new->array->intdata[0];
}
/* ⎕DIV */
Datum *
getdiv(void)
{
- Datum *d = mallocz(sizeof(Datum), 1);
- d->tag = ArrayTag;
+ Datum *d = allocdatum(ArrayTag, 0);
d->array = mkscalarint(globalDIV());
return d;
}
void
-setdiv(Datum new)
+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))
+ 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
- globalDIVset(new.array->intdata[0]);
+ globalDIVset(new->array->intdata[0]);
}
/* ⎕A */
Datum *
geta(void)
{
- Datum *d = mallocz(sizeof(Datum), 1);
- d->tag = ArrayTag;
+ Datum *d = allocdatum(ArrayTag, 0);
d->array = mkrunearray(L"ABCDEFGHIJKLMNOPQRSTUVWXYZ");
return d;
}
@@ -237,8 +231,7 @@ geta(void)
Datum *
getd(void)
{
- Datum *d = mallocz(sizeof(Datum), 1);
- d->tag = ArrayTag;
+ Datum *d = allocdatum(ArrayTag, 0);
d->array = mkrunearray(L"0123456789");
return d;
}
@@ -247,8 +240,7 @@ getd(void)
Datum *
getself(void)
{
- Datum *d = mallocz(sizeof(Datum), 1);
- d->tag = ArrayTag;
+ Datum *d = allocdatum(ArrayTag, 0);
d->array = mkscalarint(threadid());
return d;
}
diff --git a/symbol.c b/symbol.c
index 4240ace..046857b 100644
--- a/symbol.c
+++ b/symbol.c
@@ -14,8 +14,8 @@ Datum *getalpha(void);
Datum *getomega(void);
Datum *getalphao(void);
Datum *getomegao(void);
-void setalpha(Datum);
-void setsyntaxerr(Datum);
+void setalpha(Datum *);
+void setsyntaxerr(Datum *);
Symbol *
getsym(Rune *name, int fresh)
@@ -44,7 +44,7 @@ getsym(Rune *name, int fresh)
tab = td->currentdfn->symtab;
tab->nsyms++;
- tab->syms = realloc(tab->syms, sizeof(Symbol *) * tab->nsyms);
+ tab->syms = erealloc(tab->syms, sizeof(Symbol *) * tab->nsyms);
tab->syms[tab->nsyms-1] = emalloc(sizeof(Symbol));
tab->syms[tab->nsyms-1]->name = runestrdup(name);
tab->syms[tab->nsyms-1]->undefined = 1;
@@ -71,8 +71,9 @@ freesymtab(Symtab *tab)
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);
+ if(s->undefined == 0)
+ freedatum(s->value);
+ free(s->name);
}
free(tab->syms);
free(tab);
@@ -115,18 +116,23 @@ DfnFrame *
pushdfnframe(Rune *code, Datum *lefto, Datum *righto, Array *left, Array *right)
{
ThreadData *td = getthreaddata();
- DfnFrame *new = malloc(sizeof(DfnFrame));
+ DfnFrame *new = emalloc(sizeof(DfnFrame));
new->code = code;
new->symtab = newsymtab();
new->lefto = lefto;
new->righto = righto;
+ if(lefto)
+ incdatumref(lefto);
+ if(righto)
+ incdatumref(righto);
if(left){
- new->left = mallocz(sizeof(Datum), 1);
- new->left->tag = ArrayTag;
+ new->left = allocdatum(ArrayTag, 0);
new->left->array = left;
+ incarrayref(left);
}else
new->left = nil;
new->right = right;
+ incarrayref(right);
new->prev = td->currentdfn;
td->currentdfn = new;
return new;
@@ -139,6 +145,10 @@ popdfnframe(void)
if(td->currentdfn != nil){
DfnFrame *prev = td->currentdfn->prev;
freesymtab(td->currentdfn->symtab);
+ freedatum(td->currentdfn->lefto);
+ freedatum(td->currentdfn->righto);
+ freedatum(td->currentdfn->left);
+ freearray(td->currentdfn->right);
free(td->currentdfn);
td->currentdfn = prev;
}
@@ -194,14 +204,11 @@ getalpha(void)
{
DfnFrame *dfn = getcurrentdfn();
Datum *res = nil;
- if(dfn == nil)
+ if(dfn == nil || dfn->left == nil)
throwerror(nil, ESyntax);
else{
- res = malloc(sizeof(Datum));
- *res = *dfn->left;
- if(res->tag == ArrayTag)
- incarrayref(res->array);
- return res;
+ res = dfn->left;
+ incdatumref(res);
}
return res;
}
@@ -211,11 +218,10 @@ getomega(void)
{
DfnFrame *dfn = getcurrentdfn();
Datum *res = nil;
- if(dfn == nil)
+ if(dfn == nil || dfn->right == nil)
throwerror(nil, ESyntax);
else{
- res = mallocz(sizeof(Datum), 1);
- res->tag = ArrayTag;
+ res = allocdatum(ArrayTag, 0);
res->array = dfn->right;
incarrayref(res->array);
}
@@ -227,13 +233,11 @@ getalphao(void)
{
DfnFrame *dfn = getcurrentdfn();
Datum *res = nil;
- if(dfn == nil)
+ if(dfn == nil || dfn->lefto == nil)
throwerror(nil, ESyntax);
else{
- res = malloc(sizeof(Datum));
- *res = *dfn->lefto;
- if(res->tag == ArrayTag)
- incarrayref(res->array);
+ res = dfn->lefto;
+ incdatumref(res);
}
return res;
}
@@ -243,31 +247,29 @@ getomegao(void)
{
DfnFrame *dfn = getcurrentdfn();
Datum *res = nil;
- if(dfn == nil)
+ if(dfn == nil || dfn->righto == nil)
throwerror(nil, ESyntax);
else{
- res = malloc(sizeof(Datum));
- *res = *dfn->righto;
- if(res->tag == ArrayTag)
- incarrayref(res->array);
+ res = dfn->righto;
+ incdatumref(res);
}
return res;
}
void
-setalpha(Datum new)
+setalpha(Datum *new)
{
DfnFrame *dfn = getcurrentdfn();
if(dfn == nil)
throwerror(nil, ESyntax);
if(dfn->left == nil){
- dfn->left = malloc(sizeof(Datum));
- *dfn->left = new;
+ dfn->left = new;
+ incdatumref(new);
}
}
void
-setsyntaxerr(Datum)
+setsyntaxerr(Datum *)
{
throwerror(nil, ESyntax);
} \ No newline at end of file
diff --git a/tests/chain.apl b/tests/chain.apl
new file mode 100644
index 0000000..c8efeb7
--- /dev/null
+++ b/tests/chain.apl
@@ -0,0 +1,8 @@
+worker←{
+ msg←{1}⍇0
+ ⎕←'Worker id ',(⍕⎕self),' got message: ',(⍕msg),' forwarding to ',⍕⍵
+ ⍵≡⍬: ⎕←'DONE'
+ msg⍈⍵
+}
+last←worker&⍣25⊢⍬
+_←'Hello there'⍈last
diff --git a/tests/queens.apl b/tests/queens.apl
index a2ce041..d372186 100644
--- a/tests/queens.apl
+++ b/tests/queens.apl
@@ -4,4 +4,7 @@ subs←{(⊂⍵)⍪¨(⍳⍴⊃⍺)~atk ⍵}
accm←{⍺⍪((⍴⍵)=⍴⊃⍺)↑⊂⍵}
fmt←{(⊂⎕io+⍵=⌾⍳⍴⍵)⌷'∘⎕'}
queens←{fmt¨ 1↓(↓1 ⍵⍴0)accm dfs subs ⍬}
-⎕←queens 5
+eightqueens←queens 8
+⎕←'Number of solutions to 8 queens: ',⍕≢eightqueens
+⎕←'First five:'
+⎕←5↑eightqueens \ No newline at end of file
generated by cgit v1.2.3 (git 2.25.1) at 2025-10-13 08:38:12 +0000