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 <<EOM
+
+5.005 threads has been removed for 5.10. Perl will be built using ithreads.
+EOM
+ ;;
+ esac
+ fi
+ use5005threads="$undef"
+ useithreads="$usethreads"
fi
if test X"$usethreads" = "X$define" -a "X$useperlio" = "Xundef"; then
Thread|thread)
case "$usethreads" in
true|$define|y)
- case "$useithreads" in
- $undef|false|[nN]*) avail_ext="$avail_ext $xxx" ;;
+ case "$use5005threads" in
+ $define|true|[yY]*) avail_ext="$avail_ext $xxx" ;;
esac
esac
;;
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='cc'
lddlflags='-shared -L/usr/local/lib'
The default is to compile without thread support.
-Perl has two different internal threads implementations. The current
-model (available internally since 5.6, and as a user-level module since
-5.8) is called interpreter-based implementation (ithreads), with one
-interpreter per thread, and explicit sharing of data. The 5.005
-version (5005threads) is considered obsolete, buggy, and unmaintained.
-
-By default, Configure selects ithreads if -Dusethreads is specified.
-
-However, if you insist, you can select the unsupported old 5005threads behavior
-
- sh Configure -Dusethreads -Duse5005threads
+Perl used to have two different internal threads implementations. The current
+model (available internally since 5.6, and as a user-level module since 5.8) is
+called interpreter-based implementation (ithreads), with one interpreter per
+thread, and explicit sharing of data. The (deprecated) 5.005 version
+(5005threads) has been removed for release 5.10.
The 'threads' module is for use with the ithreads implementation. The
-'Thread' module offers an interface to either 5005threads or ithreads
-(whichever has been configured).
+'Thread' module emulates the old 5005threads interface on top of the current
+ithreads model.
When using threads, perl uses a dynamically-sized buffer for some of
the thread-safe library calls, such as those in the getpw*() family.
ext/Text/Soundex/Soundex.pm Text::Soundex extension Perl module
ext/Text/Soundex/Soundex.xs Text::Soundex extension external subroutines
ext/Text/Soundex/t/Soundex.t test for Text::Soundex
-ext/Thread/create.tx Test thread creation
-ext/Thread/die2.tx Test thread die() differently
-ext/Thread/die.tx Test thread die()
-ext/Thread/io.tx Test threads doing simple I/O
-ext/Thread/join2.tx Test thread joining differently
-ext/Thread/join.tx Test thread joining
-ext/Thread/list.tx Test getting list of all threads
-ext/Thread/lock.tx Test lock primitive
-ext/Thread/Makefile.PL Thread extension makefile writer
-ext/Thread/Notes Thread notes
-ext/Thread/Queue.pmx Threadsafe queue
-ext/Thread/queue.tx Test Thread::Queue module
-ext/Thread/README Thread README
-ext/Thread/README.threads Notes about multithreading
ext/threads/Changes ithreads
-ext/Thread/Semaphore.pmx Threadsafe semaphore
ext/threads/hints/hpux.pl Hint file for HPUX
ext/threads/hints/linux.pl Hint file for Linux
ext/threads/Makefile.PL ithreads
-ext/Thread/specific.tx Test thread-specific user data
ext/threads/README ithreads
ext/threads/shared/Changes Changes for threads::shared
ext/threads/shared/hints/linux.pl thread shared variables
ext/threads/t/stress_re.t Test with multiple threads, string cv argument and regexes.
ext/threads/t/stress_string.t Test with multiple threads, string cv argument.
ext/threads/t/thread.t General ithread tests from thr5005
-ext/Thread/sync2.tx Test thread synchronisation
-ext/Thread/sync.tx Test thread synchronisation
-ext/Thread/Thread/Signal.pm Start a thread to run signal handlers
-ext/Thread/Thread/Specific.pm Thread specific data access
-ext/Thread/Thread.xs Thread extension external subroutines
-ext/Thread/unsync2.tx Test thread implicit synchronisation
-ext/Thread/unsync3.tx Test thread implicit synchronisation
-ext/Thread/unsync4.tx Test thread implicit synchronisation
-ext/Thread/unsync.tx Test thread implicit synchronisation
ext/Time/HiRes/Changes Time::HiRes extension
ext/Time/HiRes/fallback/const-c.inc Time::HiRes extension
ext/Time/HiRes/fallback/const-xs.inc Time::HiRes extension
SDBM_FILE_NLM = $(AUTODIR)\SDBM_File\SDBM_File.NLM
POSIX_NLM = $(AUTODIR)\POSIX\POSIX.NLM
ATTRS_NLM = $(AUTODIR)\attrs\attrs.NLM
-THREAD_NLM = $(AUTODIR)\Thread\Thread.NLM
B_NLM = $(AUTODIR)\B\B.NLM
DUMPER_NLM = $(AUTODIR)\Data\Dumper\Dumper.NLM
PEEK_NLM = $(AUTODIR)\Devel\Peek\Peek.NLM
$(ATTRS_NLM) \
$(SDBM_FILE_NLM) \
$(POSIX_NLM) \
- $(THREAD_NLM) \
$(DUMPER_NLM) \
$(GLOB_NLM) \
$(PEEK_NLM) \
DLL_OBJ = $(DLL_SRC:.c=.obj)
X2P_OBJ = $(X2P_SRC:.c=.obj)
-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 \
Storable/Storable List/Util MIME/Base64/Base64 XS/APItest/APItest \
XS/Typemap/Typemap Unicode/Normalize/Normalize Sys/Hostname
IO = $(EXTDIR)\IO\IO
POSIX = $(EXTDIR)\POSIX\POSIX
ATTRS = $(EXTDIR)\attrs\attrs
-THREAD = $(EXTDIR)\Thread\Thread
B = $(EXTDIR)\B\B
RE = $(EXTDIR)\re\re
DUMPER = $(EXTDIR)\Data\Dumper\Dumper
$(IO).c \
$(POSIX).c \
$(ATTRS).c \
- $(THREAD).c \
$(RE).c \
$(DUMPER).c \
$(PEEK).c \
$(MAKE)
cd ..\..\netware
-$(THREAD_NLM):
- cd $(EXTDIR)\$(*B)
- ..\..\miniperl -I..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl
- $(MAKE)
- cd ..\..\netware
-
$(ATTRS_NLM):
cd $(EXTDIR)\$(*B)
..\..\miniperl -I..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl
-del /f /q $(LIBDIR)\File\Glob.pm
-del /f /q $(LIBDIR)\Unicode\Normalize.pm
-rmdir /s /q $(LIBDIR)\IO
- -rmdir /s /q $(LIBDIR)\Thread
-rmdir /s /q $(LIBDIR)\B
-rmdir /s /q $(LIBDIR)\Data
-del /f /q $(PODDIR)\*.html
doublesize='8'
drand01='(rand()/(double)((unsigned)1<<RANDBITS))'
drand48_r_proto='0'
-dynamic_ext='Socket IO Fcntl Opcode SDBM_File attrs Thread'
+dynamic_ext='Socket IO Fcntl Opcode SDBM_File attrs'
eagain='EAGAIN'
ebcdic='undef'
echo='echo'
ivdformat='"Ld"'
ivsize='8'
ivtype='long long'
-known_extensions='attrs B Compress/Raw/Zlib Cwd Data/Dumper DB_File Devel/DProf Devel/Peek Devel/PPPort Digest/MD5 Digest/SHA Encode Fcntl File/Glob Filter/Util/Call GDBM_File Hash/Util I18N/Langinfo IO IPC/SysV List/Util Math/BigInt/FastCalc MIME/Base64 NDBM_File ODBM_File Opcode PerlIO/encoding PerlIO/scalar PerlIO/via POSIX re SDBM_File Socket Storable Sys/Hostname Sys/Syslog Text/Soundex Thread threads Time/HiRes Unicode/Normalize XS/APItest XS/Typemap threads/shared'
+known_extensions='attrs B Compress/Raw/Zlib Cwd Data/Dumper DB_File Devel/DProf Devel/Peek Devel/PPPort Digest/MD5 Digest/SHA Encode Fcntl File/Glob Filter/Util/Call GDBM_File Hash/Util I18N/Langinfo IO IPC/SysV List/Util Math/BigInt/FastCalc MIME/Base64 NDBM_File ODBM_File Opcode PerlIO/encoding PerlIO/scalar PerlIO/via POSIX re SDBM_File Socket Storable Sys/Hostname Sys/Syslog Text/Soundex threads Time/HiRes Unicode/Normalize XS/APItest XS/Typemap threads/shared'
ksh=''
ld='cc'
lddlflags='-shared -L/pro/local/lib'
+++ /dev/null
-use ExtUtils::MakeMaker;
-WriteMakefile(
- NAME => 'Thread',
- VERSION_FROM => '../../lib/Thread.pm',
- MAN3PODS => {},
-);
-
+++ /dev/null
-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.
+++ /dev/null
-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<not> be using "old threads" unless you know what you're
-doing, see the CAVEAT of the C<Thread> 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<Thread::Queue> 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<new> function creates a new empty queue.
-
-=item enqueue LIST
-
-The C<enqueue> 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<dequeue> method removes a scalar from the head of the queue and
-returns it. If the queue is currently empty, C<dequeue> will block the
-thread until another thread C<enqueue>s a scalar.
-
-=item dequeue_nb
-
-The C<dequeue_nb> method, like the C<dequeue> method, removes a scalar from
-the head of the queue and returns it. Unlike C<dequeue>, though,
-C<dequeue_nb> won't block if the queue is empty, instead returning
-C<undef>.
-
-=item pending
-
-The C<pending> 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<Thread>
-
-=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;
+++ /dev/null
-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
+++ /dev/null
-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 <doughera@lafayette.edu>
-
-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
+++ /dev/null
-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<not> be using "old threads" unless you know what you're
-doing, see the CAVEAT of the C<Thread> 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<new> 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<down> 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 C<down>ing the
-semaphore's count by.
-
-=item up
-
-=item up NUMBER
-
-The C<up> 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<down> the semaphore if the C<up> raises the semaphore count
-above what the C<down>s 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;
+++ /dev/null
-#define PERL_NO_GET_CONTEXT
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-
-#ifdef __cplusplus
-#ifdef I_UNISTD
-#include <unistd.h>
-#endif
-#endif
-#include <fcntl.h>
-
-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:
+++ /dev/null
-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<Thread::Signal> module is discouraged and
-the direct use of the C<threads> 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<not> be using this module unless you know what you're doing, see the
-CAVEAT of the C<Thread> module.
-
-=head1 SYNOPSIS
-
- use Thread::Signal;
-
- $SIG{HUP} = \&some_handler;
-
-=head1 DESCRIPTION
-
-The C<Thread::Signal> 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<die> 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;
+++ /dev/null
-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<key_create> 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;
+++ /dev/null
-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;
-}
+++ /dev/null
-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";
-}
+++ /dev/null
-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";
-}
+++ /dev/null
-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 = <STDIN>) {
- 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";
-}
+++ /dev/null
-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";
+++ /dev/null
-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";
+++ /dev/null
-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);
+++ /dev/null
-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;
-}
+++ /dev/null
-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
+++ /dev/null
-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;
-}
+++ /dev/null
-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";
+++ /dev/null
-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";
+++ /dev/null
-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";
+++ /dev/null
-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";
+++ /dev/null
-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;
+++ /dev/null
-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";
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'
$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;
}
$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;
}
};
#endif /* MULTIPLICITY */
-typedef void *Thread;
-
/* Done with PERLVAR macros for now ... */
#undef PERLVAR
#undef PERLVARA
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=''
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
B<WARNING>:
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
between threads must be explicit. The user-level interface for I<ithreads>
uses the L<threads> class.
-B<NOTE>: There is another older Perl threading flavor called the 5.005 model
-that used the L<Threads> 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<NOTE>: There was another older Perl threading flavor called the 5.005 model
+that used the L<Threads> 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.
}
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 */
}
-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
.\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
Switch.pm
Symbol.pm
Test.pm
- Thread.pm
UNIVERSAL.pm
utf8.pm
vars.pm
doublesize='8'
drand01='(rand()/(double)((unsigned)1<<RANDBITS))'
drand48_r_proto='0'
-dynamic_ext='Socket IO Fcntl Opcode SDBM_File attrs Thread'
+dynamic_ext='Socket IO Fcntl Opcode SDBM_File attrs'
eagain='EAGAIN'
ebcdic='undef'
echo='echo'
doublesize='8'
drand01='(rand()/(double)((unsigned)1<<RANDBITS))'
drand48_r_proto='0'
-dynamic_ext='Socket IO Fcntl Opcode SDBM_File attrs Thread'
+dynamic_ext='Socket IO Fcntl Opcode SDBM_File attrs'
eagain='EAGAIN'
ebcdic='undef'
echo='echo'
doublesize='8'
drand01='(rand()/(double)((unsigned)1<<RANDBITS))'
drand48_r_proto='0'
-dynamic_ext='Socket IO Fcntl Opcode SDBM_File attrs Thread'
+dynamic_ext='Socket IO Fcntl Opcode SDBM_File attrs'
eagain='EAGAIN'
ebcdic='undef'
echo='echo'
doublesize='8'
drand01='(rand()/(double)((unsigned)1<<RANDBITS))'
drand48_r_proto='0'
-dynamic_ext='Socket IO Fcntl Opcode SDBM_File attrs Thread'
+dynamic_ext='Socket IO Fcntl Opcode SDBM_File attrs'
eagain='EAGAIN'
ebcdic='undef'
echo='echo'
doublesize='8'
drand01='(rand()/(double)((unsigned)1<<RANDBITS))'
drand48_r_proto='0'
-dynamic_ext='Socket IO Fcntl Opcode SDBM_File attrs Thread'
+dynamic_ext='Socket IO Fcntl Opcode SDBM_File attrs'
eagain='EAGAIN'
ebcdic='undef'
echo='echo'
FindExt::scan_ext("ext") if -d 'ext'; # also look in win32/ext/ if it exists
FindExt::set_static_extensions(split ' ', $opt{'static_ext'});
-my @dynamic_ext = grep(!/Thread/,FindExt::dynamic_ext());
-my @extensions = grep(!/Thread/,FindExt::extensions());
$opt{'nonxs_ext'} = join(' ',FindExt::nonxs_ext()) || ' ';
$opt{'static_ext'} = join(' ',FindExt::static_ext()) || ' ';
-$opt{'dynamic_ext'} = join(' ',@dynamic_ext) || ' ';
-$opt{'extensions'} = join(' ',@extensions) || ' ';
+$opt{'dynamic_ext'} = join(' ',FindExt::dynamic_ext()) || ' ';
+$opt{'extensions'} = join(' ',FindExt::extensions()) || ' ';
$opt{'known_extensions'} = join(' ',FindExt::known_extensions()) || ' ';
my $pl_h = '../patchlevel.h';
-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
https://perl5.git.perl.org / perl5.git / commitdiff