Re: STM and fairness

2008-03-05 Thread Josef Svenningsson
Tim, Simon,

Thanks for your detailed descriptions. Much of my understanding was
confirmed. I'll see if I can send you a patch with my suggested fix as
soon as my teaching is over.

Thanks,

Josef

On Mon, Mar 3, 2008 at 2:03 PM, Tim Harris (RESEARCH)
[EMAIL PROTECTED] wrote:
 Hi,

  At the moment we don't make any particular effort to make threads runnable 
 in some specific order when they are unblocked.  The current implementation 
 is simply what was easiest to write.

  If I remember rightly threads blocked on TVars will initially be 
 half-woken, putting them on the same run-queue as their waker and leaving 
 the STM data structures intact.  When scheduled they will check whether or 
 not the TVars' contents differ from the values that caused them to block: if 
 the values are unchanged then a thread can block again without needing to 
 build up wait queue structures.  In Simon's example of 100 threads blocked on 
 a single-cell TVar buffer, this would mean 99 of them are validated and block 
 again without needing to re-execute the rest of the transaction containing 
 the TVar access.  This will probably happen within a single OS thread so 
 these are lightweight thread switches within the GHC run time rather than 99 
 OS thread switches.

  At some point it might be nice to look at using run-time feedback about how 
 individual TVars are used.  I suspect that, looking at it dynamically, there 
 are a few simple policies that would apply to most TVars (wake-all / 
 wake-one) with the caveat that anything other than wake-all must eventually 
 fall back to wake-all to preserve the intended semantics for retry.

  NB -- when thinking about a shared buffer built over TVars there's also the 
 possibility that a non-blocked thread will consume the resource ahead of a 
 blocked thread that has been woken.  As with programming with 
 locks/condition-variables, avoiding this case would need an explicit queue of 
 consumers to be maintained by the application (and symmetrically for 
 producers).

  In any case, running threads in something approximating the same order they 
 blocked sounds sensible to me.  The lists of threads blocked on a TVar are 
 doubly-linked (right?) so wouldn't need to be explicitly reversed.

  Tim








  -Original Message-
  From: Simon Peyton-Jones
  Sent: 29 February 2008 20:06
  To: Josef Svenningsson; glasgow-haskell-users@haskell.org
  Cc: Tim Harris (RESEARCH)
  Subject: RE: STM and fairness

  | I'd like to know a bit about the STM implementation in GHC,
  | specifically about how it tries to achieve fairness. I've been reading
  | Composable Memory Transactions but it does not contain that much
  | details on this specific matter. What I want to know boils down to
  | this: what order are processes run which have been woken up from a
  | call to retry?

  Tim is the one who implemented this stuff, so I'm ccing him.

  If threads queue up on a single MVar, it's obvious how to achieve fairness 
 of a sort.  Furthremore, if 100 threads are blocked on one MVar, the 
 scheduler can wake up exactly one when the MVar is filled.  With STM it's 
 much less obvious.

  First, a thread may block on a whole bunch of TVars; if any of them are 
 changed, the thread should re-run.  So there is no single list of threads to 
 reverse or not reverse.

  Second, if 100 threads are blocked on a TVar, t, waking up just one of them 
 may not suffice -- it may read some more TVars and then retry again, 
 re-blocking itself on t (plus some more). The only simple thing to do is to 
 wake all of them up.  In common situations (e.g. a buffer), we may wake up 
 all 100 threads, only for 99 of them to lose the race and block again.

  This arises from the fact that transactions do a wonderful thing, by letting 
 you perform multiple operations atomically -- but that makes it harder to 
 optimize.


  All that said, you may well be right that one could do a better job of 
 scheduling.  For example, even though there may be lots of threads blocked on 
 a TVar, and all must be made runnable, they could perhaps be run in the same 
 order that they blocked, so the longest-blocked got to run first.   I don't 
 think we try to do that, but Tim would know.

  By all means suggest a patch!

  Simon

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


STM and fairness

2008-02-29 Thread Josef Svenningsson
Hi,

I'd like to know a bit about the STM implementation in GHC,
specifically about how it tries to achieve fairness. I've been reading
Composable Memory Transactions but it does not contain that much
details on this specific matter. What I want to know boils down to
this: what order are processes run which have been woken up from a
call to retry? When programming with condition variables the standard
behaviour is that the process which has waited the longest is the
first one to get to run. But that doesn't seem to be the behaviour
here. Consider the following program:
\begin{code}
module STMFair where

import Control.Concurrent
import Control.Concurrent.STM

test n = do v - newTVarIO 0
mapM_ (\n - forkIO (process n v) 
 threadDelay delay) [1..n]
atomically (writeTVar v 1)
threadDelay delay

delay = 50

process id var = do putStrLn (Process  ++ show id ++  started)
atomically $ do
  v - readTVar var
  if v == 0
then retry
else return ()
putStrLn (Process  ++ show id ++  finished)
\end{code}

When I run 'test 2' I expect it to print:
Process 1 started
Process 2 started
Process 1 finished
Process 2 finished

This would correspond to the oldest process being executed first. But
that is not what happens instead I get this (ghci 6.8.2, Ubuntu
Linux):
Process 1 started
Process 2 started
Process 2 finished
Process 1 finished

This is certainly not the behaviour I would want. I discovered this
behaviour when implementing the dining philosophers using STM and
there one of the philosophers gets starved. Except, that he's not
quite starved. When I run the simulation long enough he will
eventually be able to eat but then for a long time there will be some
other philosopher that is starved. I find this behaviour very
mysterious and it would be nice to have some light shed on it.

Apart from this mysterious behaviour it seems quite easy to improve
the fairness of the implementation. From my examples above it seems
that the wait queues for a transactional variable do contain the
processes in the order they call retry (try running 'test n' for some
large n). It just seems that they are given to the scheduler in the
wrong order, so all that needs to be done is to reverse the list. Am I
right?

Thanks for reading,

Josef
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: STM and fairness

2008-02-29 Thread Josef Svenningsson
On Fri, Feb 29, 2008 at 4:27 PM, Roberto Zunino [EMAIL PROTECTED] wrote:
 Josef Svenningsson wrote:
   What I want to know boils down to
   this: what order are processes run which have been woken up from a
   call to retry?

  IIUC, the order of wake up is irrelevant, since *all* the threads will
  re-run the transaction in parallel. So, even if thread 1 is the first to
  wake up, thread 2 might beat it in the race, and complete its
  transaction first.

That's not quite right since there is no true parallelism here. I'm
running on a single core (which I suppose I could have mentioned) and
so it is up the scheduler to make sure that processes get a fair
chance at doing their business, i.e. achieving fairness. The point I
was trying to make is that the scheduler isn't doing a very good job
in this case.

  I suggest you put some random delay in your fairness tests, maybe using
  unsafeIOtoSTM, so that you can improve starvation ;-)

I'd rather fix the scheduler.

  Also, try running a very slow (much-delayed) transaction againts several
  fast ones. I expect the slow one will never reach completion.

Indeed. This is a well known problem with STM but afaict orthogonal to
the problem I'm talking about.

  AFAIK, achieving fairness in STM can be quite hard (not unlike other
  mainstream approaches to concurrency, sadly).

Yes. Still, in the particular situation I showed I think we can do a
better job than what is currently being done.

Cheers,

Josef
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


RE: STM and fairness

2008-02-29 Thread Simon Peyton-Jones
| I'd like to know a bit about the STM implementation in GHC,
| specifically about how it tries to achieve fairness. I've been reading
| Composable Memory Transactions but it does not contain that much
| details on this specific matter. What I want to know boils down to
| this: what order are processes run which have been woken up from a
| call to retry?

Tim is the one who implemented this stuff, so I'm ccing him.

If threads queue up on a single MVar, it's obvious how to achieve fairness of a 
sort.  Furthremore, if 100 threads are blocked on one MVar, the scheduler can 
wake up exactly one when the MVar is filled.  With STM it's much less obvious.

First, a thread may block on a whole bunch of TVars; if any of them are 
changed, the thread should re-run.  So there is no single list of threads to 
reverse or not reverse.

Second, if 100 threads are blocked on a TVar, t, waking up just one of them may 
not suffice -- it may read some more TVars and then retry again, re-blocking 
itself on t (plus some more). The only simple thing to do is to wake all of 
them up.  In common situations (e.g. a buffer), we may wake up all 100 threads, 
only for 99 of them to lose the race and block again.

This arises from the fact that transactions do a wonderful thing, by letting 
you perform multiple operations atomically -- but that makes it harder to 
optimize.


All that said, you may well be right that one could do a better job of 
scheduling.  For example, even though there may be lots of threads blocked on a 
TVar, and all must be made runnable, they could perhaps be run in the same 
order that they blocked, so the longest-blocked got to run first.   I don't 
think we try to do that, but Tim would know.

By all means suggest a patch!

Simon
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users