Coro/Coro/RWLock.pm

=head1 NAME

Coro::RWLock - reader/write locks

=head1 SYNOPSIS

 use Coro;

 $lck = new Coro::RWLock;

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

 # or:
 $lck->wrlock; # acquire write lock
 $lck->unlock; # unlock lock again

 # try a readlock
 if ($lck->tryrdlock) {
    ...;
    $l->unlock;
 }

 # try a write lock
 if ($lck->trywrlock) {
    ...;
    $l->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).

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

=over 4

=cut

package Coro::RWLock;

use common::sense;

use Coro ();

our $VERSION = 6.57;

=item $l = new Coro::RWLock;

Create a new reader/writer lock.

=cut

sub new {
   # [wrcount, [wrqueue], rdcount, [rdqueue]]
   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 a previous C<rdlock> or C<wrlock>.

=cut

my $waiter;

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 writer or all readers. we choose the writer.
   if (@{$_[0][1]}) {
      (shift @{$_[0][1]})->ready;
   } else {
      $waiter->ready
         while $waiter = shift @{$_[0][3]};
   }
}

1;

=back

=head1 AUTHOR/SUPPORT/CONTACT

   Marc A. Lehmann <schmorp@schmorp.de>
   http://software.schmorp.de/pkg/Coro.html

=cut

Revision:	1.127
Committed:	Mon Mar 16 11:12:52 2020 UTC (4 years, 2 months ago) by root
Branch:	MAIN
CVS Tags:	rel-6_57, HEAD
Changes since 1.126:	+1 -1 lines
Log Message:	* empty log message *
#	Content
1	=head1 NAME
2
3	Coro::RWLock - reader/write locks
4
5	=head1 SYNOPSIS
6
7	use Coro;
8
9	$lck = new Coro::RWLock;
10
11	$lck->rdlock; # acquire read lock
12	$lck->unlock; # unlock lock again
13
14	# or:
15	$lck->wrlock; # acquire write lock
16	$lck->unlock; # unlock lock again
17
18	# try a readlock
19	if ($lck->tryrdlock) {
20	...;
21	$l->unlock;
22	}
23
24	# try a write lock
25	if ($lck->trywrlock) {
26	...;
27	$l->unlock;
28	}
29
30	=head1 DESCRIPTION
31
32	This module implements reader/write locks. A read can be acquired for
33	read by many coroutines in parallel as long as no writer has locked it
34	(shared access). A single write lock can be acquired when no readers
35	exist. RWLocks basically allow many concurrent readers (without writers)
36	OR a single writer (but no readers).
37
38	You don't have to load C<Coro::RWLock> manually, it will be loaded
39	automatically when you C<use Coro> and call the C<new> constructor.
40
41	=over 4
42
43	=cut
44
45	package Coro::RWLock;
46
47	use common::sense;
48
49	use Coro ();
50
51	our $VERSION = 6.57;
52
53	=item $l = new Coro::RWLock;
54
55	Create a new reader/writer lock.
56
57	=cut
58
59	sub new {
60	# [wrcount, [wrqueue], rdcount, [rdqueue]]
61	bless [0, [], 0, []], $_[0];
62	}
63
64	=item $l->rdlock
65
66	Acquire a read lock.
67
68	=item $l->tryrdlock
69
70	Try to acquire a read lock.
71
72	=cut
73
74	sub rdlock {
75	while ($_[0][0]) {
76	push @{$_[0][3]}, $Coro::current;
77	&Coro::schedule;
78	}
79	++$_[0][2];
80	}
81
82	sub tryrdlock {
83	return if $_[0][0];
84	++$_[0][2];
85	}
86
87	=item $l->wrlock
88
89	Acquire a write lock.
90
91	=item $l->trywrlock
92
93	Try to acquire a write lock.
94
95	=cut
96
97	sub wrlock {
98	while ($_[0][0] \|\| $_[0][2]) {
99	push @{$_[0][1]}, $Coro::current;
100	&Coro::schedule;
101	}
102	++$_[0][0];
103	}
104
105	sub trywrlock {
106	return if $_[0][0] \|\| $_[0][2];
107	++$_[0][0];
108	}
109
110	=item $l->unlock
111
112	Give up a previous C<rdlock> or C<wrlock>.
113
114	=cut
115
116	my $waiter;
117
118	sub unlock {
119	# either we are a reader or a writer. decrement accordingly.
120	if ($_[0][2]) {
121	return if --$_[0][2];
122	} else {
123	$_[0][0]--;
124	}
125	# now we have the choice between waking up a writer or all readers. we choose the writer.
126	if (@{$_[0][1]}) {
127	(shift @{$_[0][1]})->ready;
128	} else {
129	$waiter->ready
130	while $waiter = shift @{$_[0][3]};
131	}
132	}
133
134	1;
135
136	=back
137
138	=head1 AUTHOR/SUPPORT/CONTACT
139
140	Marc A. Lehmann <schmorp@schmorp.de>
141	http://software.schmorp.de/pkg/Coro.html
142
143	=cut
144