Coro/Coro/RWLock.pm

=head1 NAME

Coro::RWLock - reader/write locks

=head1 SYNOPSIS

 use Coro::RWLock;

 $lck = new Coro::RWLock;

 $lck->rdlock; # acquire read lock

 $lck->unlock;

=head1 DESCRIPTION

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).

=over 4

=cut

package Coro::RWLock;

BEGIN { eval { require warnings } && warnings->unimport ("uninitialized") }

use Coro ();

$VERSION = 5.15;

=item $l = new Coro::RWLock;

Create a new reader/writer lock.

=cut

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

=item $l->rdlock

Acquire a read lock.

=item $l->tryrdlock

Try to acquire a read lock.

=cut

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

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

=item $l->wrlock

Acquire a write lock.

=item $l->trywrlock

Try to acquire a write lock.

=cut

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];
}

=item $l->unlock

Give up the rwlock.

=cut

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;

=back

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut

Revision:	1.65
Committed:	Tue Jun 30 08:28:55 2009 UTC (14 years, 11 months ago) by root
Branch:	MAIN
CVS Tags:	rel-5_15
Changes since 1.64:	+1 -1 lines
Log Message:	5.15
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			Coro::RWLock - reader/write locks
4
5			=head1 SYNOPSIS
6
7			use Coro::RWLock;
8
9			$lck = new Coro::RWLock;
10
11			$lck->rdlock; # acquire read lock
12
13			$lck->unlock;
14
15			=head1 DESCRIPTION
16
17			This module implements reader/write locks. A read can be acquired for
18			read by many coroutines in parallel as long as no writer has locked it
19			(shared access). A single write lock can be acquired when no readers
20			exist. RWLocks basically allow many concurrent readers (without writers)
21			OR a single writer (but no readers).
22
23			=over 4
24
25			=cut
26
27			package Coro::RWLock;
28
29	pcg	1.20	BEGIN { eval { require warnings } && warnings->unimport ("uninitialized") }
30	root	1.7
31	root	1.1	use Coro ();
32
33	root	1.65	$VERSION = 5.15;
34	root	1.1
35			=item $l = new Coro::RWLock;
36
37			Create a new reader/writer lock.
38
39			=cut
40
41			sub new {
42	root	1.2	# [rdcount, [readqueue], wrcount, [writequeue]]
43			bless [0, [], 0, []], $_[0];
44	root	1.1	}
45
46			=item $l->rdlock
47
48			Acquire a read lock.
49
50			=item $l->tryrdlock
51
52			Try to acquire a read lock.
53
54			=cut
55
56			sub rdlock {
57	root	1.2	while ($_[0][0]) {
58			push @{$_[0][3]}, $Coro::current;
59	root	1.37	&Coro::schedule;
60	root	1.2	}
61			++$_[0][2];
62			}
63
64			sub tryrdlock {
65			return if $_[0][0];
66			++$_[0][2];
67			}
68
69			=item $l->wrlock
70
71			Acquire a write lock.
72
73			=item $l->trywrlock
74
75			Try to acquire a write lock.
76
77			=cut
78
79			sub wrlock {
80			while ($_[0][0] \|\| $_[0][2]) {
81			push @{$_[0][1]}, $Coro::current;
82	root	1.37	&Coro::schedule;
83	root	1.2	}
84			++$_[0][0];
85			}
86
87			sub trywrlock {
88			return if $_[0][0] \|\| $_[0][2];
89			++$_[0][0];
90			}
91
92			=item $l->unlock
93
94			Give up the rwlock.
95
96			=cut
97
98			sub unlock {
99			# either we are a reader or a writer. decrement accordingly.
100			if ($_[0][2]) {
101			return if --$_[0][2];
102			} else {
103			$_[0][0]--;
104			}
105			# now we have the choice between waking up a reader or a writer. we choose the writer.
106			if (@{$_[0][1]}) {
107			(shift @{$_[0][1]})->ready;
108			} elsif (@{$_[0][3]}) {
109			(shift @{$_[0][3]})->ready;
110			}
111	root	1.1	}
112
113			1;
114
115			=back
116
117			=head1 AUTHOR
118
119	root	1.28	Marc Lehmann <schmorp@schmorp.de>
120	root	1.26	http://home.schmorp.de/
121	root	1.1
122			=cut
123