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;

use Coro ();

$VERSION = 0.5;

=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 <pcg@goof.com>
 http://www.goof.com/pcg/marc/

=cut

Revision:	1.6
Committed:	Sun Sep 16 01:34:36 2001 UTC (22 years, 8 months ago) by root
Branch:	MAIN
Changes since 1.5:	+1 -1 lines
Log Message:	* empty log message *
#	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			use Coro ();
30
31	root	1.6	$VERSION = 0.5;
32	root	1.1
33			=item $l = new Coro::RWLock;
34
35			Create a new reader/writer lock.
36
37			=cut
38
39			sub new {
40	root	1.2	# [rdcount, [readqueue], wrcount, [writequeue]]
41			bless [0, [], 0, []], $_[0];
42	root	1.1	}
43
44			=item $l->rdlock
45
46			Acquire a read lock.
47
48			=item $l->tryrdlock
49
50			Try to acquire a read lock.
51
52			=cut
53
54			sub rdlock {
55	root	1.2	while ($_[0][0]) {
56			push @{$_[0][3]}, $Coro::current;
57			Coro::schedule;
58			}
59			++$_[0][2];
60			}
61
62			sub tryrdlock {
63			return if $_[0][0];
64			++$_[0][2];
65			}
66
67			=item $l->wrlock
68
69			Acquire a write lock.
70
71			=item $l->trywrlock
72
73			Try to acquire a write lock.
74
75			=cut
76
77			sub wrlock {
78			while ($_[0][0] \|\| $_[0][2]) {
79			push @{$_[0][1]}, $Coro::current;
80			Coro::schedule;
81			}
82			++$_[0][0];
83			}
84
85			sub trywrlock {
86			return if $_[0][0] \|\| $_[0][2];
87			++$_[0][0];
88			}
89
90			=item $l->unlock
91
92			Give up the rwlock.
93
94			=cut
95
96			sub unlock {
97			# either we are a reader or a writer. decrement accordingly.
98			if ($_[0][2]) {
99			return if --$_[0][2];
100			} else {
101			$_[0][0]--;
102			}
103			# now we have the choice between waking up a reader or a writer. we choose the writer.
104			if (@{$_[0][1]}) {
105			(shift @{$_[0][1]})->ready;
106			} elsif (@{$_[0][3]}) {
107			(shift @{$_[0][3]})->ready;
108			}
109	root	1.1	}
110
111			1;
112
113			=back
114
115			=head1 AUTHOR
116
117			Marc Lehmann <pcg@goof.com>
118			http://www.goof.com/pcg/marc/
119
120			=cut
121