diff options
| -rwxr-xr-x | APLDemo | 2 | ||||
| -rw-r--r-- | concurrency.c | 14 | ||||
| -rw-r--r-- | demos/chain.apl | 18 | ||||
| -rw-r--r-- | demos/demos | 3 | ||||
| -rw-r--r-- | demos/intro.apl | 33 |
5 files changed, 67 insertions, 3 deletions
@@ -5,7 +5,7 @@ if(~ $#winid 0){ win apl & sleep 1 winid=`{grep -e '-apl' /mnt/acme/index | awk '{print $1}' } - rm /tmp/apldemo.$winid.state + rm -f /tmp/apldemo.$winid.state exit } diff --git a/concurrency.c b/concurrency.c index 9670866..6719e6a 100644 --- a/concurrency.c +++ b/concurrency.c @@ -12,6 +12,8 @@ struct SpawnData Array *name; Array *left; Array *right; + QLock lock; + Rendez done; }; static void newprocfn(SpawnData *); @@ -64,18 +66,22 @@ spawnthread(Function f, Array *name, Array *left, Array *right) unlock datastructures exit proc */ - SpawnData *sp = emalloc(sizeof(SpawnData)); + SpawnData *sp = emallocz(sizeof(SpawnData), 1); sp->func = dupfunction(f); sp->func.scope = dupscope(f.scope); sp->name = duparray(name); sp->left = left ? duparray(left) : nil; sp->right = duparray(right); - + sp->done.l = &sp->lock; + + qlock(&sp->lock); int id = rfork(RFPROC|RFMEM); if(id == 0){ /* in new process*/ newprocfn(sp); exits(nil); } + rsleep(&sp->done); + qunlock(&sp->lock); return id; } @@ -189,8 +195,12 @@ Retry: static void newprocfn(SpawnData *sp) { + qlock(&sp->lock); ThreadData *td = newthreaddata(sp->name); _privates[0] = td; + rwakeup(&sp->done); + qunlock(&sp->lock); + ErrorGuard *eg = newerrorguard(mkscalarint(0), nil); /* make a catch-all error guard */ if(setjmp(eg->jmp)) displayerror(); diff --git a/demos/chain.apl b/demos/chain.apl new file mode 100644 index 0000000..e7e1979 --- /dev/null +++ b/demos/chain.apl @@ -0,0 +1,18 @@ +⍝ First we define a function which recieves a message, +⍝ and sends one to the task with id ⍵ +f←{ + (from msg)←{1 ⍵}⍇⍬ + (1+msg)⍈⍵ + } + +⍝ Now start 10000 of those +last←f&'chain'⍣10000⊢⎕self + +≢⎕THREADS 0 + +⍝ Start the chain by sending something to the last one +0 ⍈ last + +⎕threads 0 1 2 + +{1 (2⊃⍵)}⍇0 ⍝ We only pick out the message part, not the sender diff --git a/demos/demos b/demos/demos new file mode 100644 index 0000000..b687a93 --- /dev/null +++ b/demos/demos @@ -0,0 +1,3 @@ +APLDemo intro.apl +APLDemo doubleup.apl +APLDemo chain.apl diff --git a/demos/intro.apl b/demos/intro.apl new file mode 100644 index 0000000..a98bb1e --- /dev/null +++ b/demos/intro.apl @@ -0,0 +1,33 @@ +⍝ The send primitive is a dyadic function +⍝ message ⍈ to + +message←'Hello there' + +⍝ We can send it to ourselves +us←⎕self +us +message ⍈ us + +⍝ Let's examine the state of the system +us ⎕threads 0 ⍝ Thread ID +us ⎕threads 1 ⍝ Thread name +us ⎕threads 2 ⍝ Number of messages in mailbox +us ⎕threads 3 ⍝ Approximate C stack usage (in bytes) + +⍝ All at once, for all currently running threads +⎕threads 0 1 2 3 + +⍝ We have one message in our mailbox, let's receive it +⍝ The recieve primitive is a monadic operator +⍝ filter ⍇ timeout +{1 ⍵} ⍇ 0 + +⍝ Again? +{1 ⍵} ⍇ 0 +⍝ The time we asked it to wait was 0, so it failed immediately. +{1 ⍵} ⍇ 5 + +⍝ What if we don't want it to timeout? +{1 ⍵} ⍇ ⍬ ⍝ Noone will send it anything, so it hangs + + |