Coro::RWLock - reader/write locks

Coro documentation Contained in the Coro distribution.

Index

Code Index:

NAME

Top

Coro::RWLock - reader/write locks

SYNOPSIS

Top

 use Coro;

 $lck = new Coro::RWLock;

 $lck->rdlock; # acquire read lock
 $lck->unlock; # unlock lock again

 # or:
 $lck->wrlock; # acquire write lock
 $lck->tryrdlock; # try a readlock
 $lck->trywrlock; # try a write lock

DESCRIPTION

Top

This module implements reader/write locks. A read can be acquired for read by many coroutines in parallel as long as no writer has locked it (shared access). A single write lock can be acquired when no readers exist. RWLocks basically allow many concurrent readers (without writers) OR a single writer (but no readers).

You don't have to load Coro::RWLock manually, it will be loaded automatically when you use Coro and call the new constructor.

$l = new Coro::RWLock;

Create a new reader/writer lock.

$l->rdlock

Acquire a read lock.

$l->tryrdlock

Try to acquire a read lock.

$l->wrlock

Acquire a write lock.

$l->trywrlock

Try to acquire a write lock.

$l->unlock

Give up a previous rdlock or wrlock.

AUTHOR

Top

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/
Coro documentation Contained in the Coro distribution. 
package Coro::RWLock;

use common::sense;

use Coro ();

our $VERSION = 6.0;


sub new {
   # [rdcount, [readqueue], wrcount, [writequeue]]
   bless [0, [], 0, []], $_[0];
}


sub rdlock {
   while ($_[0][0]) {
      push @{$_[0][3]}, $Coro::current;
      &Coro::schedule;
   }
   ++$_[0][2];
}

sub tryrdlock {
   return if $_[0][0];
   ++$_[0][2];
}


sub wrlock {
   while ($_[0][0] || $_[0][2]) {
      push @{$_[0][1]}, $Coro::current;
      &Coro::schedule;
   }
   ++$_[0][0];
}

sub trywrlock {
   return if $_[0][0] || $_[0][2];
   ++$_[0][0];
}


sub unlock {
   # either we are a reader or a writer. decrement accordingly.
   if ($_[0][2]) {
      return if --$_[0][2];
   } else {
      $_[0][0]--;
   }
   # now we have the choice between waking up a reader or a writer. we choose the writer.
   if (@{$_[0][1]}) {
      (shift @{$_[0][1]})->ready;
   } elsif (@{$_[0][3]}) {
      (shift @{$_[0][3]})->ready;
   }
}

1;