X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2Fthreads%2Fshared%2Fshared.pm;h=c79988999e1f7892f5138dfb08398fc9ed15103d;hb=e67b86b37ae4d5803ca56ffbafafded7569e185f;hp=d0d6cce30c92dc172c921e44f8335329a461ce94;hpb=9ece3ee6650e9c2f6d5131c19ae5e80f2a8bfc4a;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/threads/shared/shared.pm b/ext/threads/shared/shared.pm index d0d6cce..c799889 100644 --- a/ext/threads/shared/shared.pm +++ b/ext/threads/shared/shared.pm @@ -1,104 +1,42 @@ package threads::shared; +use 5.007_003; use strict; use warnings; -use Config; -use Scalar::Util qw(weaken); -use attributes qw(reftype); -BEGIN { - if($Config{'useithreads'} && $threads::threads) { - *share = \&share_enabled; +require Exporter; +our @ISA = qw(Exporter); +our @EXPORT = qw(share cond_wait cond_broadcast cond_signal _refcnt _id _thrcnt); +our $VERSION = '0.90'; + +if ($threads::threads) { + *cond_wait = \&cond_wait_enabled; + *cond_signal = \&cond_signal_enabled; + *cond_broadcast = \&cond_broadcast_enabled; + require XSLoader; + XSLoader::load('threads::shared',$VERSION); +} +else { + *share = \&share_disabled; *cond_wait = \&cond_wait_disabled; *cond_signal = \&cond_signal_disabled; *cond_broadcast = \&cond_broadcast_disabled; - *unlock = \&unlock_disabled; - *lock = \&lock_disabled; - } else { - *share = \&share_enabled; - } } -require Exporter; -require DynaLoader; -our @ISA = qw(Exporter DynaLoader); - -our @EXPORT = qw(share cond_wait cond_broadcast cond_signal unlock lock); -our $VERSION = '0.01'; - -our %shared; sub cond_wait_disabled { return @_ }; sub cond_signal_disabled { return @_}; sub cond_broadcast_disabled { return @_}; -sub unlock_disabled { 1 }; -sub lock_disabled { 1 } sub share_disabled { return @_} -sub share_enabled (\[$@%]) { # \] - my $value = $_[0]; - my $ref = reftype($value); - if($ref eq 'SCALAR') { - my $obj = \threads::shared::sv->new($$value); - bless $obj, 'threads::shared::sv'; - $shared{$$obj} = $value; - weaken($shared{$$obj}); - } elsif($ref eq "ARRAY") { - tie @$value, 'threads::shared::av', $value; - } elsif($ref eq "HASH") { - tie %$value, "threads::shared::hv", $value; - } else { - die "You cannot share ref of type $_[0]\n"; - } -} +$threads::shared::threads_shared = 1; -sub CLONE { - return unless($_[0] eq "threads::shared"); - foreach my $ptr (keys %shared) { - if($ptr) { - thrcnt_inc($shared{$ptr}); - } - } -} - -sub DESTROY { - my $self = shift; - _thrcnt_dec($$self); - delete($shared{$$self}); -} - -package threads::shared::sv; -use base 'threads::shared'; - -sub DESTROY {} - -package threads::shared::av; -use base 'threads::shared'; -use Scalar::Util qw(weaken); -sub TIEARRAY { - my $class = shift; - my $value = shift; - my $self = bless \threads::shared::av->new($value),'threads::shared::av'; - $shared{$self->ptr} = $value; - weaken($shared{$self->ptr}); - return $self; -} -package threads::shared::hv; -use base 'threads::shared'; -use Scalar::Util qw(weaken); -sub TIEHASH { - my $class = shift; - my $value = shift; - my $self = bless \threads::shared::hv->new($value),'threads::shared::hv'; - $shared{$self->ptr} = $value; - weaken($shared{$self->ptr}); - return $self; +sub threads::shared::tie::SPLICE +{ + die "Splice not implemented for shared arrays"; } -package threads::shared; -bootstrap threads::shared $VERSION; - __END__ =head1 NAME @@ -107,44 +45,152 @@ threads::shared - Perl extension for sharing data structures between threads =head1 SYNOPSIS + use threads; use threads::shared; - my($foo, @foo, %foo); - share($foo); - share(@foo); + my $var : shared; + + my($scalar, @array, %hash); + share($scalar); + share(@array); share(%hash); - my $bar = share([]); - $hash{bar} = share({}); + my $bar = &share([]); + $hash{bar} = &share({}); + + { lock(%hash); ... } - lock(\%hash); - unlock(\%hash); cond_wait($scalar); - cond_broadcast(\@array); - cond_signal($scalar); + cond_broadcast(@array); + cond_signal(%hash); =head1 DESCRIPTION -This modules allows you to share() variables. These variables will -then be shared across different threads (and pseudoforks on -win32). They are used together with the threads module. +By default, variables are private to each thread, and each newly created +thread gets a private copy of each existing variable. This module allows +you to share variables across different threads (and pseudoforks on +win32). It is used together with the threads module. + +=head1 EXPORT + +C, C, C, C, C + +Note that if this module is imported when C has not yet been +loaded, then these functions all become no-ops. This makes it possible to +write modules that will work in both threaded and non-threaded +environments. + +=head1 FUNCTIONS + +=over 4 + +=item share VARIABLE + +C takes a value and marks it as shared. You can share a scalar, +array, hash, scalar ref, array ref or hash ref. C will return +the shared rvalue. -=head2 EXPORT +C will traverse up references exactly I level. +C is equivalent to C, while C is not. -share(), lock(), unlock(), cond_wait, cond_signal, cond_broadcast +A variable can also be marked as shared at compile time by using the +C attribute: C. + +If you want to share a newly created reference unfortunately you +need to use C<&share([])> and C<&share({})> syntax due to problems +with Perl's prototyping. + +=item lock VARIABLE + +C places a lock on a variable until the lock goes out of scope. If +the variable is locked by another thread, the C call will block until +it's available. C is recursive, so multiple calls to C are +safe -- the variable will remain locked until the outermost lock on the +variable goes out of scope. + +If a container object, such as a hash or array, is locked, all the elements +of that container are not locked. For example, if a thread does a C, any other thread doing a C won't block. + +C will traverse up references exactly I level. +C is equivalent to C, while C is not. + +Note that you cannot explicitly unlock a variable; you can only wait for +the lock to go out of scope. If you need more fine-grained control, see +L. + +=item cond_wait VARIABLE + +The C function takes a B variable as a parameter, +unlocks the variable, and blocks until another thread does a C +or C for that same locked variable. The variable that +C blocked on is relocked after the C is satisfied. +If there are multiple threads Cing on the same variable, all but +one will reblock waiting to reacquire the lock on the variable. (So if +you're only using C for synchronisation, give up the lock as +soon as possible). The two actions of unlocking the variable and entering +the blocked wait state are atomic, The two actions of exiting from the +blocked wait state and relocking the variable are not. + +It is important to note that the variable can be notified even if no +thread C or C on the variable. It is therefore +important to check the value of the variable and go back to waiting if the +requirement is not fulfilled. + +=item cond_signal VARIABLE + +The C function takes a B variable as a parameter and +unblocks one thread that's Cing on that variable. If more than +one thread is blocked in a C on that variable, only one (and +which one is indeterminate) will be unblocked. + +If there are no threads blocked in a C on the variable, the +signal is discarded. By always locking before signaling, you can (with +care), avoid signaling before another thread has entered cond_wait(). + +C will normally generate a warning if you attempt to use it +on an unlocked variable. On the rare occasions where doing this may be +sensible, you can skip the warning with + + { no warnings 'threads'; cond_signal($foo) } + +=item cond_broadcast VARIABLE + +The C function works similarly to C. +C, though, will unblock B the threads that are blocked +in a C on the locked variable, rather than only one. + +=back + +=head1 NOTES + +threads::shared is designed to disable itself silently if threads are +not available. If you want access to threads, you must C +before you C. threads will emit a warning if you +use it after threads::shared. =head1 BUGS -Not stress tested! +C is not supported on shared references. In the current version, +C will only bless the thread local reference and the blessing +will not propagate to the other threads. This is expected to be +implemented in a future version of Perl. + Does not support splice on arrays! +Taking references to the elements of shared arrays and hashes does not +autovivify the elements, and neither does slicing a shared array/hash +over non-existent indices/keys autovivify the elements. + =head1 AUTHOR Arthur Bergman Earthur at contiller.seE threads::shared is released under the same license as Perl +Documentation borrowed from the old Thread.pm + =head1 SEE ALSO -L L +L, L, L =cut