diff options
| -rw-r--r-- | apl9.h | 5 | ||||
| -rw-r--r-- | concurrency.c | 9 | ||||
| -rw-r--r-- | error.c | 13 | ||||
| -rw-r--r-- | functions.c | 14 | ||||
| -rw-r--r-- | lexer.c | 6 | ||||
| -rw-r--r-- | main.c | 28 | ||||
| -rw-r--r-- | quadnames.c | 104 | ||||
| -rw-r--r-- | runtime/start.apl | 54 | ||||
| -rw-r--r-- | runtime/stdlib.apl | 8 | ||||
| -rw-r--r-- | tests/chain.apl | 6 |
10 files changed, 128 insertions, 119 deletions
@@ -329,13 +329,14 @@ Array *runtrain(Function *, int, Array *, Array *, Array *); /* quadnames.c */ void initquadnames(void); Datum *quadnamedatum(QuadnameDef); -void setquotequad(Datum *); +void setquad(Datum *); Array *runfile(Array *); /* error.c */ ErrorGuard *newerrorguard(Array *, Statement *); void throwerror(Rune *, int); Rune *errorstr(int); +void displayerror(void); /* inverse.c */ Function inverse(Function); @@ -413,6 +414,7 @@ Array *fnLess(Array *, Array *); Array *fnGreater(Array *, Array *); Array *fnGreaterEqual(Array *, Array *); Array *fnMatch(Array *, Array *); +Array *fnNotMatch(Array *, Array *); Array *fnOr(Array *, Array *); Array *fnAnd(Array *, Array *); Array *fnNand(Array *, Array *); @@ -487,5 +489,4 @@ extern int arrayalloccounts; /* memory.c */ extern int datumalloccounts; /* memory.c */ extern QuadnameDef quadnames[]; /* quadnames.c */ extern int printprecision; /* print.c */ -extern int needsnewline; /* quadnames.c */ extern int mainstacksize; /* concurrency.c */
\ No newline at end of file diff --git a/concurrency.c b/concurrency.c index 3eb6685..80b9920 100644 --- a/concurrency.c +++ b/concurrency.c @@ -182,7 +182,6 @@ Retry: return res; } - static void newprocfn(void *data) { @@ -191,13 +190,15 @@ newprocfn(void *data) void **tdptr = procdata(); *tdptr = td; ErrorGuard *eg = newerrorguard(mkscalarint(0), nil); /* make a catch-all error guard */ - if(setjmp(eg->jmp)){ - print("Thread %d: %S%S%S\n", + if(setjmp(eg->jmp)) + displayerror(); + /* print("Thread %d: %S%S%S\n", threadid(), errorstr(td->lasterror), (td->lasterror && td->lasterrormsg) ? L": " : L"", td->lasterrormsg ? td->lasterrormsg : L""); - }else{ + */ + else{ int done = 1; send(sp->setupdone, &done); runfunc(sp->func, sp->left, sp->right); @@ -71,4 +71,17 @@ errorstr(int code) default: err = L""; break; } return err; +} + +void +displayerror(void) +{ + ThreadData *td = getthreaddata(); + 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); + freearray(error); }
\ No newline at end of file diff --git a/functions.c b/functions.c index 2e95316..0013d8f 100644 --- a/functions.c +++ b/functions.c @@ -88,7 +88,7 @@ fndyad dyadfunctiondefs[] = { fnGreater, /* > */ fnGreaterEqual, /* ≥ */ fnMatch, /* ≡ */ - 0, /* ≢ */ + fnNotMatch, /* ≢ */ fnOr, /* ∨ */ fnAnd, /* ∧ */ fnNand, /* ⍲ */ @@ -146,7 +146,10 @@ runfunc(Function f, Array *left, Array *right) popdfnframe(); result = dfnres->array; /* TODO what if the evaluation failed */ - incarrayref(result); + if(dfnres->tag != ArrayTag || result == nil) + result = mkscalarint(0); /* Very stupid */ + else + incarrayref(result); freedatum(dfnres); }else if(f.type == FunctypePrim){ if(left){ @@ -1243,6 +1246,13 @@ fnMatch(Array *left, Array *right) return mkscalarint(cmp == 0); } +Array * +fnNotMatch(Array *left, Array *right) +{ + int cmp = comparearray(left, right, 1); + return mkscalarint(cmp != 0); +} + SCALAR_FUNCTION_2(fnOr, 0, GetType(left), case AtypeInt: if((left->intdata[i] == 0 || left->intdata[i] == 1) && (right->intdata[i] == 0 || right->intdata[i] == 1)) @@ -84,9 +84,7 @@ lexline(InputStream *input, int toplevel) case L'⍝': while(peek != '\n' && !inputEOF(input)) peek = getrune(input); - if(stmt->ntoks == 0) - continue; - goto end; + continue; case L'⍬': stmt->toks[stmt->ntoks] = allocdatum(ArrayTag, 0); stmt->toks[stmt->ntoks]->array = allocarray(AtypeInt, 1, 0); @@ -272,7 +270,7 @@ syntax_error: free(stmt); throwerror(err, ESyntax); } - /* print("Got token: %S\n", ppdatum(stmt->toks[stmt->ntoks])); */ + // print("Got token: %S\n", ppdatum(stmt->toks[stmt->ntoks])); stmt->ntoks++; peek = getrune(input); } @@ -9,6 +9,7 @@ Biobuf *stdin; static int booted = 0; static Rune *startfile = L"runtime/start.apl"; +static Rune *stdlibfile = L"runtime/stdlib.apl"; void threadmain(int argc, char *argv[]) @@ -34,15 +35,7 @@ threadmain(int argc, char *argv[]) ErrorGuard *eg = newerrorguard(mkscalarint(0), nil); restart: if(setjmp(eg->jmp)){ - ThreadData *td = getthreaddata(); - Rune *msg = errorstr(td->lasterror); - if(td->lasterrormsg){ - if(runestrlen(msg) == 0) - print("%S\n", td->lasterrormsg); - else - print("%S: %S\n", errorstr(td->lasterror), td->lasterrormsg); - }else - print("%S\n", errorstr(td->lasterror)); + displayerror(); while(getcurrentdfn()) popdfnframe(); goto restart; @@ -50,20 +43,21 @@ restart: if(!booted){ booted = 1; - Array *path = mkrunearray(startfile); - runfile(path); - freearray(path); + runfile(mkrunearray(stdlibfile)); + runfile(mkrunearray(startfile)); } while(!off){ checkmem("main loop"); - /* if(needsnewline){ - print("\n"); - needsnewline = 0; - } */ Datum *result = evalline(nil, stdin, 1); if(result && !result->shy) - setquotequad(result); + setquad(result); + else{ + Datum *dummy = allocdatum(ArrayTag, 0); + dummy->array = mkrunearray(L""); + setquad(dummy); + freedatum(dummy); + } freedatum(result); /* print("Unfreed arrays: %d\n", arrayalloccounts); diff --git a/quadnames.c b/quadnames.c index 90a76ff..7c915eb 100644 --- a/quadnames.c +++ b/quadnames.c @@ -6,11 +6,9 @@ #include "apl9.h" Datum *getquotequad(void); -/* void setquotequad(Datum *); in apl9.h */ +void setquotequad(Datum *); Datum *getquad(void); -void setquad(Datum *); -Datum *getquotequadrawio(void); -void setquotequadrawio(Datum *); +/* void setquad(Datum *); in apl9.h */ Datum *getquadrawio(void); void setquadrawio(Datum *); Datum *getio(void); @@ -37,15 +35,12 @@ Array *quaddl(Array *); Array *quadtasks1(Array *); Array *quadtasks2(Array *, Array *); -int needsnewline = 0; static Rune *quadquotebuf = nil; -static Lock quadlock; static Array *session = nil; QuadnameDef quadnames[] = { {L"⍞", NameTag, getquotequad, setquotequad, nil, nil}, {L"⎕", NameTag, getquad, setquad, nil, nil}, - {L"⍞RAWIO", NameTag, getquotequadrawio, setquotequadrawio, nil, nil}, {L"⎕RAWIO", NameTag, getquadrawio, setquadrawio, nil, nil}, {L"⎕IO", NameTag, getio, setio, nil, nil}, {L"⎕PP", NameTag, getpp, setpp, nil, nil}, @@ -109,47 +104,10 @@ quadnamedatum(QuadnameDef q) Datum * getquotequad(void) { - return getquotequadrawio(); -} - -void -setquotequad(Datum *d) -{ - Rune *str = ppdatum(d); - Array *strarray = mkrunearray(str); - if(session) - rundfn(L"0::⍞RAWIO←⍶ ⋄ ⍺ ⍈ ⍵", d, nil, strarray, session); - else - setquotequadrawio(d); - free(str); - freearray(strarray); -} - -/* ⎕ */ -Datum * -getquad(void) -{ - return getquadrawio(); -} - -void -setquad(Datum *d) -{ - if(session) - rundfn(L"0::⎕RAWIO←⍶ ⋄ ⍶ ⍈ ⍵", d, nil, nil, session); - else - setquadrawio(d); -} - -/* ⍞RAWIO */ -Datum * -getquotequadrawio(void) -{ - lock(&quadlock); int sizemax = 512; int size; Rune *input; - if(needsnewline && quadquotebuf != nil){ + if(quadquotebuf != nil){ input = quadquotebuf; size = runestrlen(input); sizemax = size+1; @@ -171,37 +129,39 @@ getquotequadrawio(void) Datum *result = allocdatum(ArrayTag, 0); result->array = mkrunearray(input); free(input); - unlock(&quadlock); return result; } void -setquotequadrawio(Datum *new) +setquotequad(Datum *d) { - if(new->tag == ArrayTag && GetType(new->array) == AtypeRune){ - for(int i = 0; i < GetSize(new->array); i++) - print("%C", new->array->runedata[i]); - return; - } - lock(&quadlock); + Rune *str = ppdatum(d); + Array *strarray = mkrunearray(str); + if(session) + rundfn(L"0::⎕RAWIO←⍶ ⋄ ('⍞' ⍺) ⍈ ⍵", d, nil, strarray, session); + else + setquadrawio(d); + free(str); + freearray(strarray); +} - - Rune *str = ppdatum(new); - if(needsnewline && quadquotebuf != nil){ - if(quadquotebuf){ - Rune *tmp = quadquotebuf; - quadquotebuf = runesmprint("%S%S", tmp, str); - free(tmp); - } - }else{ - free(quadquotebuf); - quadquotebuf = runestrdup(str); - } +/* ⎕ */ +Datum * +getquad(void) +{ + return getquadrawio(); +} - needsnewline = 1; - print("%S", str); +void +setquad(Datum *d) +{ + Rune *str = ppdatum(d); + Array *strarray = mkrunearray(str); + if(session) + rundfn(L"0::⎕RAWIO←⍶ ⋄ ('⎕' ⍺) ⍈ ⍵", d, nil, strarray, session); + else + setquadrawio(d); free(str); - unlock(&quadlock); } /* ⎕RAWIO */ @@ -220,13 +180,11 @@ setquadrawio(Datum *new) if(new->tag == ArrayTag && GetType(new->array) == AtypeRune){ for(int i = 0; i < GetSize(new->array); i++) print("%C", new->array->runedata[i]); - print("\n"); return; } - lock(&quadlock); - needsnewline = 0; - print("%S\n", ppdatum(new)); - unlock(&quadlock); + Rune *str = ppdatum(new); + print("%S", str); + free(str); } /* ⎕IO */ diff --git a/runtime/start.apl b/runtime/start.apl index 46a0703..c98462e 100644 --- a/runtime/start.apl +++ b/runtime/start.apl @@ -1,15 +1,41 @@ -send←⍈ ⍝ I can't type those easily so give them names -recv←⍇ -prompt←6⍴' ' -session←{ - (task data)←{1 ⍵} recv ⍬ - ⎕rawio←{¯1≡⍵:'???:' ⋄ ⍵,':'} task ⎕tasks 1 - ⎕rawio←data - ⍞rawio←prompt - ∇⍵ -} - +⎕session←{ + (indented main prompt)←⍵ + unindent←{ + ⎕rawio←⎕ucs ⍺⍴8 + } + handleError←{ + 0::⍺ + (task (error msg taskname))←⍵ + ⎕rawio←error,' in [',(⍕task),':',taskname,']' + _←{⎕rawio←': ', msg} IF msg≢'' + ⎕rawio←⎕ucs 10 + ⎕rawio←prompt + ≢prompt + } + handleQuad←{ + 0::⍺ + data←⍵ + ⎕rawio←data + ⎕rawio←⎕ucs 10 + ⎕rawio←prompt + ≢prompt + } + handleQuoteQuad←{ + 0::⍺ + data←⍵ + ⎕rawio←data + ⍺ + } + handle←{ + 0::⍺ + (task (type data))←⍵ + indented←⍺ + _←indented∘unindent IF (indented>0)∧task≢main + type≡'!': 0 handleError task data + type≡'⎕': 0 handleQuad data + type≡'⍞': 0 handleQuoteQuad data + ⍵ + } + {∇ ⍵ handle {1 ⍵}⍇⍬} indented +}&'session'⊢0 ⎕self (6⍴' ') ⎕←'Welcome to APL9' -⍞rawio←prompt - -⎕session←session&'session'⊢⍬
\ No newline at end of file diff --git a/runtime/stdlib.apl b/runtime/stdlib.apl new file mode 100644 index 0000000..24b7e5e --- /dev/null +++ b/runtime/stdlib.apl @@ -0,0 +1,8 @@ +⍝ All things in here have global scope and can be changed at any time +SEND←⍈ +RECV←⍇ + +IF←{ + ⍵:⍶ ⍬ + ⍬ +}
\ No newline at end of file diff --git a/tests/chain.apl b/tests/chain.apl index af09a2b..9b9ba33 100644 --- a/tests/chain.apl +++ b/tests/chain.apl @@ -1,9 +1,9 @@ worker←{ - msg←{1 ⍵}recv ⍬ + (from msg)←{1 ⍵} RECV ⍬ ⍵≡⍬: ⎕←'DONE' ⎕←'Worker id ',(⍕⎕self),' (',(⎕self ⎕tasks 1),') got message: ',(⍕msg) ⎕←'Forwarding from ',(⍕⎕self), ' to ',⍕⍵ - msg send ⍵ + msg SEND ⍵ } last←worker&'worker'⍣10⊢⍬ -'Hello there' send last +'Hello there' SEND last |