From: Jerry D. Hedden Date: Mon, 30 Apr 2007 17:06:28 +0000 (-0400) Subject: Remove ext/Thread X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=47f9f84cc98b8a5779f47ca8a12283098d2816e4;p=p5sagit%2Fp5-mst-13.2.git Remove ext/Thread From: "Jerry D. Hedden" Message-ID: <1ff86f510704301406t6373912ame78fea5c7a148cf4@mail.gmail.com> p4raw-id: //depot/perl@31114 --- diff --git a/Configure b/Configure index f35a311..3d7c519 100755 --- a/Configure +++ b/Configure @@ -4206,29 +4206,19 @@ EOM else : perl-5.9.x and later - use5005threads="$undef" - case "$usethreads" in - $define) - : Default to ithreads unless overridden on command line or with - : old config.sh - dflt='y' - case "$useithreads" in - $undef|false|[nN]*) dflt='n';; - esac - rp='Use the newer interpreter-based ithreads?' - . ./myread - case "$ans" in - y|Y) val="$define" ;; - *) val="$undef" ;; - esac - set useithreads - eval $setvar - ;; - *) - useithreads="$undef" - ;; - esac + if test X"$usethreads" = "X$define"; then + case "$use5005threads" in + $define|true|[yY]*) + $cat >&4 < 'Thread', - VERSION_FROM => '../../lib/Thread.pm', - MAN3PODS => {}, -); - diff --git a/ext/Thread/Notes b/ext/Thread/Notes deleted file mode 100644 index 1505877..0000000 --- a/ext/Thread/Notes +++ /dev/null @@ -1,13 +0,0 @@ -Should cvcache be per CV (keyed by thread) or per thread (keyed by CV)? - -Maybe ought to protect all SVs by a mutex for SvREFCNT_{dec,inc}, -upgrades and so on. Then use SvMUTEX instead of CvMUTEX for CVs. -On the other hand, people shouldn't expect concurrent operations -on non-lexicals to be safe anyway. - -Probably don't need to bother keeping track of CvOWNER on clones. - -Either @_ needs to be made lexical or other arrangments need to be -made so that some globs (or just *_) are per-thread. - -tokenbuf and buf probably ought to be global protected by a global lock. diff --git a/ext/Thread/Queue.pmx b/ext/Thread/Queue.pmx deleted file mode 100644 index 231ce3c..0000000 --- a/ext/Thread/Queue.pmx +++ /dev/null @@ -1,107 +0,0 @@ -package Thread::Queue; -use Thread qw(cond_wait cond_broadcast); - -use vars qw($VERSION); -$VERSION = '1.00'; - -=head1 NAME - -Thread::Queue - thread-safe queues (5.005-threads) - -=head1 CAVEAT - -This Perl installation is using the old unsupported "5.005 threads". -Use of the old threads model is discouraged. - -For the whole story about the development of threads in Perl, and why -you should B be using "old threads" unless you know what you're -doing, see the CAVEAT of the C module. - -=head1 SYNOPSIS - - use Thread::Queue; - my $q = new Thread::Queue; - $q->enqueue("foo", "bar"); - my $foo = $q->dequeue; # The "bar" is still in the queue. - my $foo = $q->dequeue_nb; # returns "bar", or undef if the queue was - # empty - my $left = $q->pending; # returns the number of items still in the queue - -=head1 DESCRIPTION - -A queue, as implemented by C is a thread-safe data structure -much like a list. Any number of threads can safely add elements to the end -of the list, or remove elements from the head of the list. (Queues don't -permit adding or removing elements from the middle of the list) - -=head1 FUNCTIONS AND METHODS - -=over 8 - -=item new - -The C function creates a new empty queue. - -=item enqueue LIST - -The C method adds a list of scalars on to the end of the queue. -The queue will grow as needed to accomodate the list. - -=item dequeue - -The C method removes a scalar from the head of the queue and -returns it. If the queue is currently empty, C will block the -thread until another thread Cs a scalar. - -=item dequeue_nb - -The C method, like the C method, removes a scalar from -the head of the queue and returns it. Unlike C, though, -C won't block if the queue is empty, instead returning -C. - -=item pending - -The C method returns the number of items still in the queue. (If -there can be multiple readers on the queue it's best to lock the queue -before checking to make sure that it stays in a consistent state) - -=back - -=head1 SEE ALSO - -L - -=cut - -sub new { - my $class = shift; - return bless [@_], $class; -} - -sub dequeue : locked : method { - my $q = shift; - cond_wait $q until @$q; - return shift @$q; -} - -sub dequeue_nb : locked : method { - my $q = shift; - if (@$q) { - return shift @$q; - } else { - return undef; - } -} - -sub enqueue : locked : method { - my $q = shift; - push(@$q, @_) and cond_broadcast $q; -} - -sub pending : locked : method { - my $q = shift; - return scalar(@$q); -} - -1; diff --git a/ext/Thread/README b/ext/Thread/README deleted file mode 100644 index a6b22fb..0000000 --- a/ext/Thread/README +++ /dev/null @@ -1,20 +0,0 @@ -See the README.threads in the main perl 5.004_xx development -distribution (x >= 50) for details of how to build and use this. -If all else fails, read on. - -If your version of patch can't create a file from scratch, then you'll -need to create an empty thread.h manually first. Perl itself will need -to be built with -DUSE_THREADS yet. If you're using MIT pthreads or -another threads package that needs pthread_init() to be called, then -add -DNEED_PTHREAD_INIT. If you're using a threads library that only -follows one of the old POSIX drafts, then you'll probably need to add --DOLD_PTHREADS_API. I haven't tested -DOLD_PTHREADS_API properly yet -and I think you may still have to tweak a couple of the mutex calls -to follow the old API. - -This extension is copyright Malcolm Beattie 1995-1997 and is freely -distributable under your choice of the GNU Public License or the -Artistic License (see the main perl distribution). - -Malcolm Beattie -mbeattie@sable.ox.ac.uk diff --git a/ext/Thread/README.threads b/ext/Thread/README.threads deleted file mode 100644 index 6e4d133..0000000 --- a/ext/Thread/README.threads +++ /dev/null @@ -1,26 +0,0 @@ -NOTE: This documentation describes the style of threading that was -available in Perl 5.005. Perl 5.6.0 introduced the early beginnings of -interpreter-based threads support, also known as ithreads, and in Perl -5.8.0 the interpeter threads became available from perl level through -the threads and threads::shared modules (in Perl 5.6 ithreads are -available only internally and to XS extension builders, and used -by the Win32 port for emulating fork()). As of Perl 5.8.0, ithreads has -become the standard threading model for Perl. - -As of 5.9.0, the older threading model is not supported anymore. - -Malcolm Beattie -mbeattie@sable.ox.ac.uk -Last updated: 27 November 1997 - -Configure-related info updated 16 July 1998 by -Andy Dougherty - -Other minor updates 10 Feb 1999 by -Gurusamy Sarathy - -More platforms added 26 Jul 1999 by -Jarkko Hietaniemi - -Removed 5005threads support 03 Oct 2002 by -H.Merijn Brand diff --git a/ext/Thread/Semaphore.pmx b/ext/Thread/Semaphore.pmx deleted file mode 100644 index a9fb089..0000000 --- a/ext/Thread/Semaphore.pmx +++ /dev/null @@ -1,97 +0,0 @@ -package Thread::Semaphore; -use Thread qw(cond_wait cond_broadcast); - -use vars qw($VERSION); -$VERSION = '1.00'; - -=head1 NAME - -Thread::Semaphore - thread-safe semaphores (5.005-threads) - -=head1 CAVEAT - -This Perl installation is using the old unsupported "5.005 threads". -Use of the old threads model is discouraged. - -For the whole story about the development of threads in Perl, and why -you should B be using "old threads" unless you know what you're -doing, see the CAVEAT of the C module. - -=head1 SYNOPSIS - - use Thread::Semaphore; - my $s = new Thread::Semaphore; - $s->up; # Also known as the semaphore V -operation. - # The guarded section is here - $s->down; # Also known as the semaphore P -operation. - - # The default semaphore value is 1. - my $s = new Thread::Semaphore($initial_value); - $s->up($up_value); - $s->down($up_value); - -=head1 DESCRIPTION - -Semaphores provide a mechanism to regulate access to resources. Semaphores, -unlike locks, aren't tied to particular scalars, and so may be used to -control access to anything you care to use them for. - -Semaphores don't limit their values to zero or one, so they can be used to -control access to some resource that may have more than one of. (For -example, filehandles) Increment and decrement amounts aren't fixed at one -either, so threads can reserve or return multiple resources at once. - -=head1 FUNCTIONS AND METHODS - -=over 8 - -=item new - -=item new NUMBER - -C creates a new semaphore, and initializes its count to the passed -number. If no number is passed, the semaphore's count is set to one. - -=item down - -=item down NUMBER - -The C method decreases the semaphore's count by the specified number, -or one if no number has been specified. If the semaphore's count would drop -below zero, this method will block until such time that the semaphore's -count is equal to or larger than the amount you're Cing the -semaphore's count by. - -=item up - -=item up NUMBER - -The C method increases the semaphore's count by the number specified, -or one if no number's been specified. This will unblock any thread blocked -trying to C the semaphore if the C raises the semaphore count -above what the Cs are trying to decrement it by. - -=back - -=cut - -sub new { - my $class = shift; - my $val = @_ ? shift : 1; - bless \$val, $class; -} - -sub down : locked : method { - my $s = shift; - my $inc = @_ ? shift : 1; - cond_wait $s until $$s >= $inc; - $$s -= $inc; -} - -sub up : locked : method { - my $s = shift; - my $inc = @_ ? shift : 1; - ($$s += $inc) > 0 and cond_broadcast $s; -} - -1; diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs deleted file mode 100644 index 87db003..0000000 --- a/ext/Thread/Thread.xs +++ /dev/null @@ -1,190 +0,0 @@ -#define PERL_NO_GET_CONTEXT -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#ifdef __cplusplus -#ifdef I_UNISTD -#include -#endif -#endif -#include - -static int sig_pipe[2]; - -#ifndef THREAD_RET_TYPE -#define THREAD_RET_TYPE void * -#define THREAD_RET_CAST(x) ((THREAD_RET_TYPE) x) -#endif - -static void -remove_thread(pTHX_ Thread t) -{ -} - -static THREAD_RET_TYPE -threadstart(void *arg) -{ - return THREAD_RET_CAST(NULL); -} - -static SV * -newthread (pTHX_ SV *startsv, AV *initargs, char *classname) -{ -#ifdef USE_ITHREADS - croak("This perl was built for \"ithreads\", which currently does not support Thread.pm.\n" - "Run \"perldoc Thread\" for more information"); -#else - croak("This perl was not built with support for 5.005-style threads.\n" - "Run \"perldoc Thread\" for more information"); -#endif - return &PL_sv_undef; -} - -static Signal_t handle_thread_signal (int sig); - -static Signal_t -handle_thread_signal(int sig) -{ - unsigned char c = (unsigned char) sig; - dTHX; - /* - * We're not really allowed to call fprintf in a signal handler - * so don't be surprised if this isn't robust while debugging - * with -DL. - */ - DEBUG_S(PerlIO_printf(Perl_debug_log, - "handle_thread_signal: got signal %d\n", sig)); - write(sig_pipe[1], &c, 1); -} - -MODULE = Thread PACKAGE = Thread -PROTOTYPES: DISABLE - -void -new(classname, startsv, ...) - char * classname - SV * startsv - AV * av = av_make(items - 2, &ST(2)); - PPCODE: - XPUSHs(sv_2mortal(newthread(aTHX_ startsv, av, classname))); - -void -join(t) - Thread t - PREINIT: -#ifdef USE_5005THREADS - AV * av; - int i; -#endif - PPCODE: - -void -detach(t) - Thread t - CODE: - -void -equal(t1, t2) - Thread t1 - Thread t2 - PPCODE: - PUSHs((t1 == t2) ? &PL_sv_yes : &PL_sv_no); - -void -flags(t) - Thread t - PPCODE: - -void -done(t) - Thread t - PPCODE: - -void -self(classname) - char * classname - PREINIT: -#ifdef USE_5005THREADS - SV *sv; -#endif - PPCODE: - -U32 -tid(t) - Thread t - CODE: - RETVAL = 0; - OUTPUT: - RETVAL - -void -DESTROY(t) - SV * t - PPCODE: - PUSHs(t ? &PL_sv_yes : &PL_sv_no); - -void -yield() - CODE: - -void -cond_wait(sv) - SV * sv -CODE: - -void -cond_signal(sv) - SV * sv -CODE: - -void -cond_broadcast(sv) - SV * sv -CODE: - -void -list(classname) - char * classname - PPCODE: - - -MODULE = Thread PACKAGE = Thread::Signal - -void -kill_sighandler_thread() - PPCODE: - write(sig_pipe[1], "\0", 1); - PUSHs(&PL_sv_yes); - -void -init_thread_signals() - PPCODE: - PL_sighandlerp = handle_thread_signal; - if (pipe(sig_pipe) == -1) - XSRETURN_UNDEF; - PUSHs(&PL_sv_yes); - -void -await_signal() - PREINIT: - unsigned char c; - SSize_t ret; - CODE: - do { - ret = read(sig_pipe[0], &c, 1); - } while (ret == -1 && errno == EINTR); - if (ret == -1) - croak("panic: await_signal"); - ST(0) = sv_newmortal(); - if (ret) - sv_setsv(ST(0), c ? PL_psig_ptr[c] : &PL_sv_no); - DEBUG_S(PerlIO_printf(Perl_debug_log, - "await_signal returning %s\n", SvPEEK(ST(0)))); - -MODULE = Thread PACKAGE = Thread::Specific - -void -data(classname = "Thread::Specific") - char * classname - PPCODE: diff --git a/ext/Thread/Thread/Signal.pm b/ext/Thread/Thread/Signal.pm deleted file mode 100644 index 1fede3e..0000000 --- a/ext/Thread/Thread/Signal.pm +++ /dev/null @@ -1,72 +0,0 @@ -package Thread::Signal; -use Thread qw(async); - -our $VERSION = '1.00'; - -=head1 NAME - -Thread::Signal - Start a thread which runs signal handlers reliably (for old code) - -=head1 CAVEAT - -For new code the use of the C module is discouraged and -the direct use of the C and associated modules is encouraged instead. - -However, there is no direct equivalent of the Thread::Signal module in the -new implementation of threads. On the bright side: signals are now delivered -reliably to Perl programs that do not use threads. The handling of signals -with the new threading features is up to the underlying thread implementation -that is being used and may therefor be less reliable. - -If you want to specify a thread-specific signal, you can alter the %SIG hash -in the thread where you want to handle a signal differently from other threads. -This at least seems to work under Linux. But there are no guarantees and your -mileage may vary. - -For the whole story about the development of threads in Perl, and why you -should B be using this module unless you know what you're doing, see the -CAVEAT of the C module. - -=head1 SYNOPSIS - - use Thread::Signal; - - $SIG{HUP} = \&some_handler; - -=head1 DESCRIPTION - -The C module starts up a special signal handler thread. -All signals to the process are delivered to it and it runs the -associated C<$SIG{FOO}> handlers for them. Without this module, -signals arriving at inopportune moments (such as when perl's internals -are in the middle of updating critical structures) cause the perl -code of the handler to be run unsafely which can cause memory corruption -or worse. - -=head1 BUGS - -This module changes the semantics of signal handling slightly in that -the signal handler is run separately from the main thread (and in -parallel with it). This means that tricks such as calling C from -a signal handler behave differently (and, in particular, can't be -used to exit directly from a system call). - -=cut - -if (!init_thread_signals()) { - require Carp; - Carp::croak("init_thread_signals failed: $!"); -} - -async { - my $sig; - while ($sig = await_signal()) { - &$sig(); - } -}; - -END { - kill_sighandler_thread(); -} - -1; diff --git a/ext/Thread/Thread/Specific.pm b/ext/Thread/Thread/Specific.pm deleted file mode 100644 index ed7cbf8..0000000 --- a/ext/Thread/Thread/Specific.pm +++ /dev/null @@ -1,30 +0,0 @@ -package Thread::Specific; - -our $VERSION = '1.00'; - -=head1 NAME - -Thread::Specific - thread-specific keys - -=head1 SYNOPSIS - - use Thread::Specific; - my $k = key_create Thread::Specific; - -=head1 DESCRIPTION - -C returns a unique thread-specific key. - -=cut - -sub import : locked : method { - require fields; - fields::->import(@_); -} - -sub key_create : locked : method { - our %FIELDS; # suppress "used only once" - return ++$FIELDS{__MAX__}; -} - -1; diff --git a/ext/Thread/create.tx b/ext/Thread/create.tx deleted file mode 100644 index 13f3852..0000000 --- a/ext/Thread/create.tx +++ /dev/null @@ -1,34 +0,0 @@ -BEGIN { - eval { require Config; import Config }; - if ($@) { - print "1..0 # Skip: no Config\n"; - exit(0); - } -} - -use Thread 'async'; -use Config; -use Tie::Hash; - -sub start_here { - my $i; - print "In start_here with args: @_\n"; - for ($i = 1; $i <= 5; $i++) { - print "start_here: $i\n"; - sleep 1; - } -} - -async { - tie my(%h), 'Tie::StdHash'; - %h = %Config; - print "running on $h{archname}\n"; -}; - -print "Starting new thread now\n"; -$t = new Thread \&start_here, qw(foo bar baz); -print "Started thread $t\n"; -for ($count = 1; $count <= 5; $count++) { - print "main: $count\n"; - sleep 1; -} diff --git a/ext/Thread/die.tx b/ext/Thread/die.tx deleted file mode 100644 index 2581416..0000000 --- a/ext/Thread/die.tx +++ /dev/null @@ -1,24 +0,0 @@ -BEGIN { - eval { require Config; import Config }; - if ($@) { - print "1..0 # Skip: no Config\n"; - exit(0); - } -} - -use Thread 'async'; - -$t = async { - print "here\n"; - die "success"; - print "shouldn't get here\n"; -}; - -sleep 1; -print "joining...\n"; -eval { @r = $t->join; }; -if ($@) { - print "thread died with message: $@"; -} else { - print "thread failed to die successfully\n"; -} diff --git a/ext/Thread/die2.tx b/ext/Thread/die2.tx deleted file mode 100644 index d84b3d0..0000000 --- a/ext/Thread/die2.tx +++ /dev/null @@ -1,24 +0,0 @@ -BEGIN { - eval { require Config; import Config }; - if ($@) { - print "1..0 # Skip: no Config\n"; - exit(0); - } -} - -use Thread 'async'; - -$t = async { - sleep 1; - print "here\n"; - die "success if preceded by 'thread died...'"; - print "shouldn't get here\n"; -}; - -print "joining...\n"; -@r = eval { $t->join; }; -if ($@) { - print "thread died with message: $@"; -} else { - print "thread failed to die successfully\n"; -} diff --git a/ext/Thread/io.tx b/ext/Thread/io.tx deleted file mode 100644 index 8855897..0000000 --- a/ext/Thread/io.tx +++ /dev/null @@ -1,47 +0,0 @@ -BEGIN { - eval { require Config; import Config }; - if ($@) { - print "1..0 # Skip: no Config\n"; - exit(0); - } -} - -use Thread; - -sub counter { -$count = 10; -while ($count--) { - sleep 1; - print "ping $count\n"; -} -} - -sub reader { - my $line; - while ($line = ) { - print "reader: $line"; - } - print "End of input in reader\n"; - return 0; -} - -print <<'EOT'; -This test starts up a thread to read and echo whatever is typed on -the keyboard/stdin, line by line, while the main thread counts down -to zero. The test stays running until both the main thread has -finished counting down and the I/O thread has seen end-of-file on -the terminal/stdin. -EOT - -$r = new Thread \&counter; - -&reader; - -__END__ - - -$count = 10; -while ($count--) { - sleep 1; - print "ping $count\n"; -} diff --git a/ext/Thread/join.tx b/ext/Thread/join.tx deleted file mode 100644 index db9e219..0000000 --- a/ext/Thread/join.tx +++ /dev/null @@ -1,19 +0,0 @@ -BEGIN { - eval { require Config; import Config }; - if ($@) { - print "1..0 # Skip: no Config\n"; - exit(0); - } -} - -use Thread; -sub foo { - print "In foo with args: @_\n"; - return (7, 8, 9); -} - -print "Starting thread\n"; -$t = new Thread \&foo, qw(foo bar baz); -print "Joining with $t\n"; -@results = $t->join(); -print "Joining returned ", scalar(@results), " values: @results\n"; diff --git a/ext/Thread/join2.tx b/ext/Thread/join2.tx deleted file mode 100644 index c7d5e15..0000000 --- a/ext/Thread/join2.tx +++ /dev/null @@ -1,20 +0,0 @@ -BEGIN { - eval { require Config; import Config }; - if ($@) { - print "1..0 # Skip: no Config\n"; - exit(0); - } -} - -use Thread; -sub foo { - print "In foo with args: @_\n"; - return (7, 8, 9); -} - -print "Starting thread\n"; -$t = new Thread \&foo, qw(foo bar baz); -sleep 2; -print "Joining with $t\n"; -@results = $t->join(); -print "Joining returned @results\n"; diff --git a/ext/Thread/list.tx b/ext/Thread/list.tx deleted file mode 100644 index 424b46f..0000000 --- a/ext/Thread/list.tx +++ /dev/null @@ -1,38 +0,0 @@ -BEGIN { - eval { require Config; import Config }; - if ($@) { - print "1..0 # Skip: no Config\n"; - exit(0); - } -} - -use Thread qw(async); -use Thread::Semaphore; - -my $sem = Thread::Semaphore->new(0); - -$nthreads = 4; - -for (my $i = 0; $i < $nthreads; $i++) { - async { - my $tid = Thread->self->tid; - print "thread $tid started...\n"; - $sem->down; - print "thread $tid finishing\n"; - }; -} - -print "main: started $nthreads threads\n"; -sleep 2; - -my @list = Thread->list; -printf "main: Thread->list returned %d threads\n", scalar(@list); - -foreach my $t (@list) { - print "inspecting thread $t...\n"; - print "...deref is $$t\n"; - print "...flags = ", $t->flags, "\n"; - print "...tid = ", $t->tid, "\n"; -} -print "main thread telling workers to finish off...\n"; -$sem->up($nthreads); diff --git a/ext/Thread/lock.tx b/ext/Thread/lock.tx deleted file mode 100644 index d8199b5..0000000 --- a/ext/Thread/lock.tx +++ /dev/null @@ -1,35 +0,0 @@ -BEGIN { - eval { require Config; import Config }; - if ($@) { - print "1..0 # Skip: no Config\n"; - exit(0); - } -} - -use Thread; - -$level = 0; - -sub worker -{ - my $num = shift; - my $i; - print "thread $num starting\n"; - for ($i = 1; $i <= 20; $i++) { - print "thread $num iteration $i\n"; - select(undef, undef, undef, rand(10)/100); - { - lock($lock); - warn "thread $num saw non-zero level = $level\n" if $level; - $level++; - print "thread $num has lock\n"; - select(undef, undef, undef, rand(10)/100); - $level--; - } - print "thread $num released lock\n"; - } -} - -for ($t = 1; $t <= 5; $t++) { - new Thread \&worker, $t; -} diff --git a/ext/Thread/queue.tx b/ext/Thread/queue.tx deleted file mode 100644 index de3a895..0000000 --- a/ext/Thread/queue.tx +++ /dev/null @@ -1,44 +0,0 @@ -BEGIN { - eval { require Config; import Config }; - if ($@) { - print "1..0 # Skip: no Config\n"; - exit(0); - } -} - -use Thread; -use Thread::Queue; - -$q = new Thread::Queue; - -sub reader { - my $tid = Thread->self->tid; - my $i = 0; - while (1) { - $i++; - print "reader (tid $tid): waiting for element $i...\n"; - my $el = $q->dequeue; - print "reader (tid $tid): dequeued element $i: value $el\n"; - select(undef, undef, undef, rand(2)); - if ($el == -1) { - # end marker - print "reader (tid $tid) returning\n"; - return; - } - } -} - -my $nthreads = 3; - -for (my $i = 0; $i < $nthreads; $i++) { - Thread->new(\&reader, $i); -} - -for (my $i = 1; $i <= 10; $i++) { - my $el = int(rand(100)); - select(undef, undef, undef, rand(2)); - print "writer: enqueuing value $el\n"; - $q->enqueue($el); -} - -$q->enqueue((-1) x $nthreads); # one end marker for each thread diff --git a/ext/Thread/specific.tx b/ext/Thread/specific.tx deleted file mode 100644 index 4747b6a..0000000 --- a/ext/Thread/specific.tx +++ /dev/null @@ -1,25 +0,0 @@ -BEGIN { - eval { require Config; import Config }; - if ($@) { - print "1..0 # Skip: no Config\n"; - exit(0); - } -} - -use Thread; - -use Thread::Specific qw(foo); - -sub count { - my $tid = Thread->self->tid; - my Thread::Specific $tsd = Thread::Specific::data; - for (my $i = 0; $i < 5; $i++) { - $tsd->{foo} = $i; - print "thread $tid count: $tsd->{foo}\n"; - select(undef, undef, undef, rand(2)); - } -}; - -for(my $t = 0; $t < 5; $t++) { - new Thread \&count; -} diff --git a/ext/Thread/sync.tx b/ext/Thread/sync.tx deleted file mode 100644 index 4fa25a7..0000000 --- a/ext/Thread/sync.tx +++ /dev/null @@ -1,68 +0,0 @@ -BEGIN { - eval { require Config; import Config }; - if ($@) { - print "1..0 # Skip: no Config\n"; - exit(0); - } -} - -use Thread; - -$level = 0; - -sub single_file : locked { - my $arg = shift; - $level++; - print "Level $level for $arg\n"; - print "(something is wrong)\n" if $level < 0 || $level > 1; - sleep 1; - $level--; - print "Back to level $level\n"; -} - -sub start_bar { - my $i; - print "start bar\n"; - for $i (1..3) { - print "bar $i\n"; - single_file("bar $i"); - sleep 1 if rand > 0.5; - } - print "end bar\n"; - return 1; -} - -sub start_foo { - my $i; - print "start foo\n"; - for $i (1..3) { - print "foo $i\n"; - single_file("foo $i"); - sleep 1 if rand > 0.5; - } - print "end foo\n"; - return 1; -} - -sub start_baz { - my $i; - print "start baz\n"; - for $i (1..3) { - print "baz $i\n"; - single_file("baz $i"); - sleep 1 if rand > 0.5; - } - print "end baz\n"; - return 1; -} - -$| = 1; -srand($$^$^T); - -$foo = new Thread \&start_foo; -$bar = new Thread \&start_bar; -$baz = new Thread \&start_baz; -$foo->join(); -$bar->join(); -$baz->join(); -print "main: threads finished, exiting\n"; diff --git a/ext/Thread/sync2.tx b/ext/Thread/sync2.tx deleted file mode 100644 index 7311231..0000000 --- a/ext/Thread/sync2.tx +++ /dev/null @@ -1,76 +0,0 @@ -BEGIN { - eval { require Config; import Config }; - if ($@) { - print "1..0 # Skip: no Config\n"; - exit(0); - } -} - -use Thread; - -$global = undef; - -sub single_file : locked { - my $who = shift; - my $i; - - print "Uh oh: $who entered while locked by $global\n" if $global; - $global = $who; - print "["; - for ($i = 0; $i < int(10 * rand); $i++) { - print $who; - select(undef, undef, undef, 0.1); - } - print "]"; - $global = undef; -} - -sub start_a { - my ($i, $j); - for ($j = 0; $j < 10; $j++) { - single_file("A"); - for ($i = 0; $i < int(10 * rand); $i++) { - print "a"; - select(undef, undef, undef, 0.1); - } - } -} - -sub start_b { - my ($i, $j); - for ($j = 0; $j < 10; $j++) { - single_file("B"); - for ($i = 0; $i < int(10 * rand); $i++) { - print "b"; - select(undef, undef, undef, 0.1); - } - } -} - -sub start_c { - my ($i, $j); - for ($j = 0; $j < 10; $j++) { - single_file("C"); - for ($i = 0; $i < int(10 * rand); $i++) { - print "c"; - select(undef, undef, undef, 0.1); - } - } -} - -$| = 1; -srand($$^$^T); - -print <<'EOT'; -Each pair of square brackets [...] should contain a repeated sequence of -a unique upper case letter. Lower case letters may appear randomly both -in and out of the brackets. -EOT -$foo = new Thread \&start_a; -$bar = new Thread \&start_b; -$baz = new Thread \&start_c; -print "\nmain: joining...\n"; -#$foo->join; -#$bar->join; -#$baz->join; -print "\ndone\n"; diff --git a/ext/Thread/unsync.tx b/ext/Thread/unsync.tx deleted file mode 100644 index b4adb3b..0000000 --- a/ext/Thread/unsync.tx +++ /dev/null @@ -1,45 +0,0 @@ -BEGIN { - eval { require Config; import Config }; - if ($@) { - print "1..0 # Skip: no Config\n"; - exit(0); - } -} - -use Thread; - -$| = 1; - -if (@ARGV) { - srand($ARGV[0]); -} else { - my $seed = $$ ^ $^T; - print "Randomising to $seed\n"; - srand($seed); -} - -sub whoami { - my ($depth, $a, $b, $c) = @_; - my $i; - print "whoami ($depth): $a $b $c\n"; - sleep 1; - whoami($depth - 1, $a, $b, $c) if $depth > 0; -} - -sub start_foo { - my $r = 3 + int(10 * rand); - print "start_foo: r is $r\n"; - whoami($r, "start_foo", "foo1", "foo2"); - print "start_foo: finished\n"; -} - -sub start_bar { - my $r = 3 + int(10 * rand); - print "start_bar: r is $r\n"; - whoami($r, "start_bar", "bar1", "bar2"); - print "start_bar: finished\n"; -} - -$foo = new Thread \&start_foo; -$bar = new Thread \&start_bar; -print "main: exiting\n"; diff --git a/ext/Thread/unsync2.tx b/ext/Thread/unsync2.tx deleted file mode 100644 index 1576537..0000000 --- a/ext/Thread/unsync2.tx +++ /dev/null @@ -1,44 +0,0 @@ -BEGIN { - eval { require Config; import Config }; - if ($@) { - print "1..0 # Skip: no Config\n"; - exit(0); - } -} - -use Thread; - -$| = 1; - -srand($$^$^T); - -sub printargs { - my $thread = shift; - my $arg; - my $i; - while ($arg = shift) { - my $delay = int(rand(500)); - $i++; - print "$thread arg $i is $arg\n"; - 1 while $delay--; - } -} - -sub start_thread { - my $thread = shift; - my $count = 10; - while ($count--) { - my(@args) = ($thread) x int(rand(10)); - print "$thread $count calling printargs @args\n"; - printargs($thread, @args); - } -} - -new Thread (\&start_thread, "A"); -new Thread (\&start_thread, "B"); -#new Thread (\&start_thread, "C"); -#new Thread (\&start_thread, "D"); -#new Thread (\&start_thread, "E"); -#new Thread (\&start_thread, "F"); - -print "main: exiting\n"; diff --git a/ext/Thread/unsync3.tx b/ext/Thread/unsync3.tx deleted file mode 100644 index ecf77d1..0000000 --- a/ext/Thread/unsync3.tx +++ /dev/null @@ -1,58 +0,0 @@ -BEGIN { - eval { require Config; import Config }; - if ($@) { - print "1..0 # Skip: no Config\n"; - exit(0); - } -} - -use Thread; - -$| = 1; - -srand($$^$^T); - -sub whoami { - my $thread = shift; - print $thread; -} - -sub uppercase { - my $count = 100; - while ($count--) { - my $i = int(rand(1000)); - 1 while $i--; - print "A"; - $i = int(rand(1000)); - 1 while $i--; - whoami("B"); - } -} - -sub lowercase { - my $count = 100; - while ($count--) { - my $i = int(rand(1000)); - 1 while $i--; - print "x"; - $i = int(rand(1000)); - 1 while $i--; - whoami("y"); - } -} - -sub numbers { - my $count = 100; - while ($count--) { - my $i = int(rand(1000)); - 1 while $i--; - print 1; - $i = int(rand(1000)); - 1 while $i--; - whoami(2); - } -} - -new Thread \&numbers; -new Thread \&uppercase; -new Thread \&lowercase; diff --git a/ext/Thread/unsync4.tx b/ext/Thread/unsync4.tx deleted file mode 100644 index 8a6c1241..0000000 --- a/ext/Thread/unsync4.tx +++ /dev/null @@ -1,46 +0,0 @@ -BEGIN { - eval { require Config; import Config }; - if ($@) { - print "1..0 # Skip: no Config\n"; - exit(0); - } -} - -use Thread; - -$| = 1; - -srand($$^$^T); - -sub printargs { - my(@copyargs) = @_; - my $thread = shift @copyargs; - my $arg; - my $i; - while ($arg = shift @copyargs) { - my $delay = int(rand(500)); - $i++; - print "$thread arg $i is $arg\n"; - 1 while $delay--; - } -} - -sub start_thread { - my(@threadargs) = @_; - my $thread = $threadargs[0]; - my $count = 10; - while ($count--) { - my(@args) = ($thread) x int(rand(10)); - print "$thread $count calling printargs @args\n"; - printargs($thread, @args); - } -} - -new Thread (\&start_thread, "A"); -new Thread (\&start_thread, "B"); -new Thread (\&start_thread, "C"); -new Thread (\&start_thread, "D"); -new Thread (\&start_thread, "E"); -new Thread (\&start_thread, "F"); - -print "main: exiting\n"; diff --git a/hints/vmesa.sh b/hints/vmesa.sh index bda26fc..faebd45 100644 --- a/hints/vmesa.sh +++ b/hints/vmesa.sh @@ -322,7 +322,7 @@ sig_num_init='0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,2 sizetype='size_t' so='.a' ssizetype='ssize_t' -static_ext='Data/Dumper Digest/MD5 Fcntl Filter/Util/Call GDBM_File IO IPC/SysV List/Util MIME/Base64 NDBM_File Opcode PerlIO/scalar POSIX Socket Storable Thread Time/HiRes Time/Piece attrs re' +static_ext='Data/Dumper Digest/MD5 Fcntl Filter/Util/Call GDBM_File IO IPC/SysV List/Util MIME/Base64 NDBM_File Opcode PerlIO/scalar POSIX Socket Storable Time/HiRes Time/Piece attrs re' stdchar='char' stdio_cnt='(fp)->__countIn' stdio_ptr='(fp)->__bufPtr' diff --git a/lib/Carp/Heavy.pm b/lib/Carp/Heavy.pm index a293b59..15f8188 100644 --- a/lib/Carp/Heavy.pm +++ b/lib/Carp/Heavy.pm @@ -192,8 +192,8 @@ sub ret_backtrace { $i++; my $tid_msg = ''; - if (defined &Thread::tid) { - my $tid = Thread->self->tid; + if (defined &threads::tid) { + my $tid = threads->tid; $tid_msg = " thread $tid" if $tid; } @@ -213,8 +213,8 @@ sub ret_summary { $i++; my $tid_msg = ''; - if (defined &Thread::tid) { - my $tid = Thread->self->tid; + if (defined &threads::tid) { + my $tid = threads->tid; $tid_msg = " thread $tid" if $tid; } diff --git a/perl.h b/perl.h index 54ebb8f..49c8e1a 100644 --- a/perl.h +++ b/perl.h @@ -4500,8 +4500,6 @@ struct interpreter { }; #endif /* MULTIPLICITY */ -typedef void *Thread; - /* Done with PERLVAR macros for now ... */ #undef PERLVAR #undef PERLVARA diff --git a/plan9/config_sh.sample b/plan9/config_sh.sample index f112ba9..2e8ca7a 100644 --- a/plan9/config_sh.sample +++ b/plan9/config_sh.sample @@ -713,7 +713,7 @@ issymlink='/bin/test -h' ivdformat='"ld"' ivsize='4' ivtype='long' -known_extensions='B ByteLoader Cwd DB_File Data/Dumper Devel/DProf Devel/PPPort Devel/Peek Digest/MD5 Encode Fcntl File/Glob Filter/Util/Call GDBM_File I18N/Langinfo IO IPC/SysV List/Util MIME/Base64 NDBM_File ODBM_File Opcode POSIX PerlIO/encoding PerlIO/scalar PerlIO/via SDBM_File Socket Storable Sys/Hostname Sys/Syslog Thread Time/HiRes Unicode/Normalize XS/APItest XS/Typemap attrs re threads threads/shared' +known_extensions='B ByteLoader Cwd DB_File Data/Dumper Devel/DProf Devel/PPPort Devel/Peek Digest/MD5 Encode Fcntl File/Glob Filter/Util/Call GDBM_File I18N/Langinfo IO IPC/SysV List/Util MIME/Base64 NDBM_File ODBM_File Opcode POSIX PerlIO/encoding PerlIO/scalar PerlIO/via SDBM_File Socket Storable Sys/Hostname Sys/Syslog Time/HiRes Unicode/Normalize XS/APItest XS/Typemap attrs re threads threads/shared' ksh='' ld='ld' lddlflags='' diff --git a/pod/perlmodlib.pod b/pod/perlmodlib.pod index 223b7df..a778c6d 100644 --- a/pod/perlmodlib.pod +++ b/pod/perlmodlib.pod @@ -1709,14 +1709,6 @@ Thread-safe queues Thread-safe semaphores -=item Thread::Signal - -Start a thread which runs signal handlers reliably (for old code) - -=item Thread::Specific - -Thread-specific keys - =item Tie::Array Base class for tied arrays diff --git a/pod/perlothrtut.pod b/pod/perlothrtut.pod index a481e9f..12811dc 100644 --- a/pod/perlothrtut.pod +++ b/pod/perlothrtut.pod @@ -6,8 +6,8 @@ perlothrtut - old tutorial on threads in Perl B: This tutorial describes the old-style thread model that was introduced in -release 5.005. This model is now deprecated, and will be removed, probably -in version 5.10. The interfaces described here were considered +release 5.005. This model is deprecated, and has been removed +for version 5.10. The interfaces described here were considered experimental, and are likely to be buggy. For information about the new interpreter threads ("ithreads") model, see diff --git a/pod/perlthrtut.pod b/pod/perlthrtut.pod index a6b0b18..65992c7 100644 --- a/pod/perlthrtut.pod +++ b/pod/perlthrtut.pod @@ -10,9 +10,9 @@ model, each thread runs in its own Perl interpreter, and any data sharing between threads must be explicit. The user-level interface for I uses the L class. -B: There is another older Perl threading flavor called the 5.005 model -that used the L class. This old model is known to have problems, is -deprecated, and support for it will be removed in release 5.10. You are +B: There was another older Perl threading flavor called the 5.005 model +that used the L class. This old model was known to have problems, is +deprecated, and was removed for release 5.10. You are strongly encouraged to migrate any existing 5.005 threads code to the new model as soon as possible. diff --git a/toke.c b/toke.c index 7181fee..c2a5566 100644 --- a/toke.c +++ b/toke.c @@ -5200,8 +5200,7 @@ Perl_yylex(pTHX) } else if (gv && !gvp && -tmp==KEY_lock /* XXX generalizable kludge */ - && GvCVu(gv) - && !hv_fetchs(GvHVn(PL_incgv), "Thread.pm", FALSE)) + && GvCVu(gv)) { tmp = 0; /* any sub overrides "weak" keyword */ } diff --git a/win32/Makefile b/win32/Makefile index 58c17a8..8a5dc93 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -1146,7 +1146,6 @@ distclean: realclean -del /f $(LIBDIR)\PerlIO\scalar.pm -del /f $(LIBDIR)\PerlIO\via.pm -del /f $(LIBDIR)\Sys\Hostname.pm - -del /f $(LIBDIR)\Thread\Signal.pm $(LIBDIR)\Thread\Specific.pm -del /f $(LIBDIR)\threads\shared.pm -del /f $(LIBDIR)\Time\HiRes.pm -del /f $(LIBDIR)\Unicode\Normalize.pm diff --git a/win32/Makefile.ce b/win32/Makefile.ce index 71aa2c1..17d333c 100644 --- a/win32/Makefile.ce +++ b/win32/Makefile.ce @@ -657,7 +657,7 @@ CORE_NOCFG_H = \ .\include\sys\socket.h \ .\win32.h -DYNAMIC_EXT = Socket IO Fcntl Opcode SDBM_File POSIX attrs Thread B re \ +DYNAMIC_EXT = Socket IO Fcntl Opcode SDBM_File POSIX attrs B re \ Data/Dumper Devel/Peek ByteLoader Devel/DProf File/Glob \ Sys/Hostname diff --git a/win32/ce-helpers/cecopy-lib.pl b/win32/ce-helpers/cecopy-lib.pl index f1cff4d..35bba3b 100644 --- a/win32/ce-helpers/cecopy-lib.pl +++ b/win32/ce-helpers/cecopy-lib.pl @@ -78,7 +78,6 @@ sub BEGIN { Switch.pm Symbol.pm Test.pm - Thread.pm UNIVERSAL.pm utf8.pm vars.pm diff --git a/win32/config.bc b/win32/config.bc index 10a148b..7a048d0 100644 --- a/win32/config.bc +++ b/win32/config.bc @@ -519,7 +519,7 @@ dlsrc='dl_win32.xs' doublesize='8' drand01='(rand()/(double)((unsigned)1<