diff options
Diffstat (limited to 'contrib/perl5/ext/Thread')
26 files changed, 0 insertions, 1736 deletions
diff --git a/contrib/perl5/ext/Thread/Makefile.PL b/contrib/perl5/ext/Thread/Makefile.PL deleted file mode 100644 index e67fbb7..0000000 --- a/contrib/perl5/ext/Thread/Makefile.PL +++ /dev/null @@ -1,7 +0,0 @@ -use ExtUtils::MakeMaker; -WriteMakefile( - NAME => 'Thread', - VERSION_FROM => 'Thread.pm', - MAN3PODS => {} - ); - diff --git a/contrib/perl5/ext/Thread/Notes b/contrib/perl5/ext/Thread/Notes deleted file mode 100644 index 1505877..0000000 --- a/contrib/perl5/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/contrib/perl5/ext/Thread/README b/contrib/perl5/ext/Thread/README deleted file mode 100644 index a6b22fb..0000000 --- a/contrib/perl5/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/contrib/perl5/ext/Thread/Thread.pm b/contrib/perl5/ext/Thread/Thread.pm deleted file mode 100644 index 23f9fe5..0000000 --- a/contrib/perl5/ext/Thread/Thread.pm +++ /dev/null @@ -1,225 +0,0 @@ -package Thread; -require Exporter; -use XSLoader (); -our($VERSION, @ISA, @EXPORT); - -$VERSION = "1.0"; - -@ISA = qw(Exporter); -@EXPORT_OK = qw(yield cond_signal cond_broadcast cond_wait async); - -=head1 NAME - -Thread - manipulate threads in Perl (EXPERIMENTAL, subject to change) - -=head1 CAVEAT - -The Thread extension requires Perl to be built in a particular way to -enable the older 5.005 threading model. Just to confuse matters, there -is an alternate threading model known as "ithreads" that does NOT -support this extension. If you are using a binary distribution such -as ActivePerl that is built with ithreads support, this extension CANNOT -be used. - -=head1 SYNOPSIS - - use Thread; - - my $t = new Thread \&start_sub, @start_args; - - $result = $t->join; - $result = $t->eval; - $t->detach; - - if($t->equal($another_thread)) { - # ... - } - - my $tid = Thread->self->tid; - my $tlist = Thread->list; - - lock($scalar); - yield(); - - use Thread 'async'; - -=head1 DESCRIPTION - - WARNING: Threading is an experimental feature. Both the interface - and implementation are subject to change drastically. In fact, this - documentation describes the flavor of threads that was in version - 5.005. Perl 5.6.0 and later have the beginnings of support for - interpreter threads, which (when finished) is expected to be - significantly different from what is described here. The information - contained here may therefore soon be obsolete. Use at your own risk! - -The C<Thread> module provides multithreading support for perl. - -=head1 FUNCTIONS - -=over 8 - -=item new \&start_sub - -=item new \&start_sub, LIST - -C<new> starts a new thread of execution in the referenced subroutine. The -optional list is passed as parameters to the subroutine. Execution -continues in both the subroutine and the code after the C<new> call. - -C<new Thread> returns a thread object representing the newly created -thread. - -=item lock VARIABLE - -C<lock> places a lock on a variable until the lock goes out of scope. If -the variable is locked by another thread, the C<lock> call will block until -it's available. C<lock> is recursive, so multiple calls to C<lock> are -safe--the variable will remain locked until the outermost lock on the -variable goes out of scope. - -Locks on variables only affect C<lock> calls--they do I<not> affect normal -access to a variable. (Locks on subs are different, and covered in a bit) -If you really, I<really> want locks to block access, then go ahead and tie -them to something and manage this yourself. This is done on purpose. While -managing access to variables is a good thing, perl doesn't force you out of -its living room... - -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<lock -@a>, any other thread doing a C<lock($a[12])> won't block. - -You may also C<lock> a sub, using C<lock &sub>. Any calls to that sub from -another thread will block until the lock is released. This behaviour is not -equivalent to declaring the sub with the C<locked> attribute. The C<locked> -attribute serializes access to a subroutine, but allows different threads -non-simultaneous access. C<lock &sub>, on the other hand, will not allow -I<any> other thread access for the duration of the lock. - -Finally, C<lock> will traverse up references exactly I<one> level. -C<lock(\$a)> is equivalent to C<lock($a)>, while C<lock(\\$a)> is not. - -=item async BLOCK; - -C<async> creates a thread to execute the block immediately following -it. This block is treated as an anonymous sub, and so must have a -semi-colon after the closing brace. Like C<new Thread>, C<async> returns a -thread object. - -=item Thread->self - -The C<Thread-E<gt>self> function returns a thread object that represents -the thread making the C<Thread-E<gt>self> call. - -=item Thread->list - -C<Thread-E<gt>list> returns a list of thread objects for all running and -finished but un-C<join>ed threads. - -=item cond_wait VARIABLE - -The C<cond_wait> function takes a B<locked> variable as a parameter, -unlocks the variable, and blocks until another thread does a C<cond_signal> -or C<cond_broadcast> for that same locked variable. The variable that -C<cond_wait> blocked on is relocked after the C<cond_wait> is satisfied. -If there are multiple threads C<cond_wait>ing on the same variable, all but -one will reblock waiting to reaquire the lock on the variable. (So if -you're only using C<cond_wait> for synchronization, give up the lock as -soon as possible) - -=item cond_signal VARIABLE - -The C<cond_signal> function takes a locked variable as a parameter and -unblocks one thread that's C<cond_wait>ing on that variable. If more than -one thread is blocked in a C<cond_wait> on that variable, only one (and -which one is indeterminate) will be unblocked. - -If there are no threads blocked in a C<cond_wait> on the variable, the -signal is discarded. - -=item cond_broadcast VARIABLE - -The C<cond_broadcast> function works similarly to C<cond_signal>. -C<cond_broadcast>, though, will unblock B<all> the threads that are blocked -in a C<cond_wait> on the locked variable, rather than only one. - -=item yield - -The C<yield> function allows another thread to take control of the -CPU. The exact results are implementation-dependent. - -=back - -=head1 METHODS - -=over 8 - -=item join - -C<join> waits for a thread to end and returns any values the thread exited -with. C<join> will block until the thread has ended, though it won't block -if the thread has already terminated. - -If the thread being C<join>ed C<die>d, the error it died with will be -returned at this time. If you don't want the thread performing the C<join> -to die as well, you should either wrap the C<join> in an C<eval> or use the -C<eval> thread method instead of C<join>. - -=item eval - -The C<eval> method wraps an C<eval> around a C<join>, and so waits for a -thread to exit, passing along any values the thread might have returned. -Errors, of course, get placed into C<$@>. - -=item detach - -C<detach> tells a thread that it is never going to be joined i.e. -that all traces of its existence can be removed once it stops running. -Errors in detached threads will not be visible anywhere - if you want -to catch them, you should use $SIG{__DIE__} or something like that. - -=item equal - -C<equal> tests whether two thread objects represent the same thread and -returns true if they do. - -=item tid - -The C<tid> method returns the tid of a thread. The tid is a monotonically -increasing integer assigned when a thread is created. The main thread of a -program will have a tid of zero, while subsequent threads will have tids -assigned starting with one. - -=back - -=head1 LIMITATIONS - -The sequence number used to assign tids is a simple integer, and no -checking is done to make sure the tid isn't currently in use. If a program -creates more than 2^32 - 1 threads in a single run, threads may be assigned -duplicate tids. This limitation may be lifted in a future version of Perl. - -=head1 SEE ALSO - -L<attributes>, L<Thread::Queue>, L<Thread::Semaphore>, L<Thread::Specific>. - -=cut - -# -# Methods -# - -# -# Exported functions -# -sub async (&) { - return new Thread $_[0]; -} - -sub eval { - return eval { shift->join; }; -} - -XSLoader::load 'Thread'; - -1; diff --git a/contrib/perl5/ext/Thread/Thread.xs b/contrib/perl5/ext/Thread/Thread.xs deleted file mode 100644 index 15e2aa2..0000000 --- a/contrib/perl5/ext/Thread/Thread.xs +++ /dev/null @@ -1,670 +0,0 @@ -#define PERL_NO_GET_CONTEXT -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -/* Magic signature for Thread's mg_private is "Th" */ -#define Thread_MAGIC_SIGNATURE 0x5468 - -#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) -{ -#ifdef USE_THREADS - DEBUG_S(WITH_THR(PerlIO_printf(Perl_debug_log, - "%p: remove_thread %p\n", thr, t))); - MUTEX_LOCK(&PL_threads_mutex); - MUTEX_DESTROY(&t->mutex); - PL_nthreads--; - t->prev->next = t->next; - t->next->prev = t->prev; - SvREFCNT_dec(t->oursv); - COND_BROADCAST(&PL_nthreads_cond); - MUTEX_UNLOCK(&PL_threads_mutex); -#endif -} - -static THREAD_RET_TYPE -threadstart(void *arg) -{ -#ifdef USE_THREADS -#ifdef FAKE_THREADS - Thread savethread = thr; - LOGOP myop; - dSP; - I32 oldscope = PL_scopestack_ix; - I32 retval; - AV *av; - int i; - - DEBUG_S(PerlIO_printf(Perl_debug_log, "new thread %p starting at %s\n", - thr, SvPEEK(TOPs))); - thr = (Thread) arg; - savemark = TOPMARK; - thr->prev = thr->prev_run = savethread; - thr->next = savethread->next; - thr->next_run = savethread->next_run; - savethread->next = savethread->next_run = thr; - thr->wait_queue = 0; - thr->private = 0; - - /* Now duplicate most of perl_call_sv but with a few twists */ - PL_op = (OP*)&myop; - Zero(PL_op, 1, LOGOP); - myop.op_flags = OPf_STACKED; - myop.op_next = Nullop; - myop.op_flags |= OPf_KNOW; - myop.op_flags |= OPf_WANT_LIST; - PL_op = pp_entersub(ARGS); - DEBUG_S(if (!PL_op) - PerlIO_printf(Perl_debug_log, "thread starts at Nullop\n")); - /* - * When this thread is next scheduled, we start in the right - * place. When the thread runs off the end of the sub, perl.c - * handles things, using savemark to figure out how much of the - * stack is the return value for any join. - */ - thr = savethread; /* back to the old thread */ - return 0; -#else - Thread thr = (Thread) arg; - LOGOP myop; - dSP; - I32 oldmark = TOPMARK; - I32 oldscope = PL_scopestack_ix; - I32 retval; - SV *sv; - AV *av; - int i, ret; - dJMPENV; - -#if defined(MULTIPLICITY) - PERL_SET_INTERP(thr->interp); -#endif - - DEBUG_S(PerlIO_printf(Perl_debug_log, "new thread %p waiting to start\n", - thr)); - - /* - * Wait until our creator releases us. If we didn't do this, then - * it would be potentially possible for out thread to carry on and - * do stuff before our creator fills in our "self" field. For example, - * if we went and created another thread which tried to JOIN with us, - * then we'd be in a mess. - */ - MUTEX_LOCK(&thr->mutex); - MUTEX_UNLOCK(&thr->mutex); - - /* - * It's safe to wait until now to set the thread-specific pointer - * from our pthread_t structure to our struct perl_thread, since - * we're the only thread who can get at it anyway. - */ - PERL_SET_THX(thr); - - DEBUG_S(PerlIO_printf(Perl_debug_log, "new thread %p starting at %s\n", - thr, SvPEEK(TOPs))); - - av = newAV(); - sv = POPs; - PUTBACK; - ENTER; - SAVETMPS; - perl_call_sv(sv, G_ARRAY|G_EVAL); - SPAGAIN; - retval = SP - (PL_stack_base + oldmark); - SP = PL_stack_base + oldmark + 1; - if (SvCUR(thr->errsv)) { - MUTEX_LOCK(&thr->mutex); - thr->flags |= THRf_DID_DIE; - MUTEX_UNLOCK(&thr->mutex); - av_store(av, 0, &PL_sv_no); - av_store(av, 1, newSVsv(thr->errsv)); - DEBUG_S(PerlIO_printf(Perl_debug_log, "%p died: %s\n", - thr, SvPV(thr->errsv, PL_na))); - } - else { - DEBUG_S(STMT_START { - for (i = 1; i <= retval; i++) { - PerlIO_printf(Perl_debug_log, "%p return[%d] = %s\n", - thr, i, SvPEEK(SP[i - 1])); - } - } STMT_END); - av_store(av, 0, &PL_sv_yes); - for (i = 1; i <= retval; i++, SP++) - sv_setsv(*av_fetch(av, i, TRUE), SvREFCNT_inc(*SP)); - } - FREETMPS; - LEAVE; - - finishoff: -#if 0 - /* removed for debug */ - SvREFCNT_dec(PL_curstack); -#endif - SvREFCNT_dec(thr->cvcache); - SvREFCNT_dec(thr->threadsv); - SvREFCNT_dec(thr->specific); - SvREFCNT_dec(thr->errsv); - - /*Safefree(cxstack);*/ - while (PL_curstackinfo->si_next) - PL_curstackinfo = PL_curstackinfo->si_next; - while (PL_curstackinfo) { - PERL_SI *p = PL_curstackinfo->si_prev; - SvREFCNT_dec(PL_curstackinfo->si_stack); - Safefree(PL_curstackinfo->si_cxstack); - Safefree(PL_curstackinfo); - PL_curstackinfo = p; - } - Safefree(PL_markstack); - Safefree(PL_scopestack); - Safefree(PL_savestack); - Safefree(PL_retstack); - Safefree(PL_tmps_stack); - Safefree(PL_ofs); - - SvREFCNT_dec(PL_rs); - SvREFCNT_dec(PL_nrs); - SvREFCNT_dec(PL_statname); - SvREFCNT_dec(PL_errors); - Safefree(PL_screamfirst); - Safefree(PL_screamnext); - Safefree(PL_reg_start_tmp); - SvREFCNT_dec(PL_lastscream); - SvREFCNT_dec(PL_defoutgv); - Safefree(PL_reg_poscache); - - MUTEX_LOCK(&thr->mutex); - DEBUG_S(PerlIO_printf(Perl_debug_log, - "%p: threadstart finishing: state is %u\n", - thr, ThrSTATE(thr))); - switch (ThrSTATE(thr)) { - case THRf_R_JOINABLE: - ThrSETSTATE(thr, THRf_ZOMBIE); - MUTEX_UNLOCK(&thr->mutex); - DEBUG_S(PerlIO_printf(Perl_debug_log, - "%p: R_JOINABLE thread finished\n", thr)); - break; - case THRf_R_JOINED: - ThrSETSTATE(thr, THRf_DEAD); - MUTEX_UNLOCK(&thr->mutex); - remove_thread(aTHX_ thr); - DEBUG_S(PerlIO_printf(Perl_debug_log, - "%p: R_JOINED thread finished\n", thr)); - break; - case THRf_R_DETACHED: - ThrSETSTATE(thr, THRf_DEAD); - MUTEX_UNLOCK(&thr->mutex); - SvREFCNT_dec(av); - DEBUG_S(PerlIO_printf(Perl_debug_log, - "%p: DETACHED thread finished\n", thr)); - remove_thread(aTHX_ thr); /* This might trigger main thread to finish */ - break; - default: - MUTEX_UNLOCK(&thr->mutex); - croak("panic: illegal state %u at end of threadstart", ThrSTATE(thr)); - /* NOTREACHED */ - } - return THREAD_RET_CAST(av); /* Available for anyone to join with */ - /* us unless we're detached, in which */ - /* case noone sees the value anyway. */ -#endif -#else - return THREAD_RET_CAST(NULL); -#endif -} - -static SV * -newthread (pTHX_ SV *startsv, AV *initargs, char *classname) -{ -#ifdef USE_THREADS - dSP; - Thread savethread; - int i; - SV *sv; - int err; -#ifndef THREAD_CREATE - static pthread_attr_t attr; - static int attr_inited = 0; - sigset_t fullmask, oldmask; - static int attr_joinable = PTHREAD_CREATE_JOINABLE; -#endif - - savethread = thr; - thr = new_struct_thread(thr); - /* temporarily pretend to be the child thread in case the - * XPUSHs() below want to grow the child's stack. This is - * safe, since the other thread is not yet created, and we - * are the only ones who know about it */ - PERL_SET_THX(thr); - SPAGAIN; - DEBUG_S(PerlIO_printf(Perl_debug_log, - "%p: newthread (%p), tid is %u, preparing stack\n", - savethread, thr, thr->tid)); - /* The following pushes the arg list and startsv onto the *new* stack */ - PUSHMARK(SP); - /* Could easily speed up the following greatly */ - for (i = 0; i <= AvFILL(initargs); i++) - XPUSHs(SvREFCNT_inc(*av_fetch(initargs, i, FALSE))); - XPUSHs(SvREFCNT_inc(startsv)); - PUTBACK; - - /* On your marks... */ - PERL_SET_THX(savethread); - MUTEX_LOCK(&thr->mutex); - -#ifdef THREAD_CREATE - err = THREAD_CREATE(thr, threadstart); -#else - /* Get set... */ - sigfillset(&fullmask); - if (sigprocmask(SIG_SETMASK, &fullmask, &oldmask) == -1) - croak("panic: sigprocmask"); - err = 0; - if (!attr_inited) { - attr_inited = 1; - err = pthread_attr_init(&attr); -# ifdef PTHREAD_ATTR_SETDETACHSTATE - if (err == 0) - err = PTHREAD_ATTR_SETDETACHSTATE(&attr, attr_joinable); - -# else - croak("panic: can't pthread_attr_setdetachstate"); -# endif - } - if (err == 0) - err = PTHREAD_CREATE(&thr->self, attr, threadstart, (void*) thr); -#endif - - if (err) { - MUTEX_UNLOCK(&thr->mutex); - DEBUG_S(PerlIO_printf(Perl_debug_log, - "%p: create of %p failed %d\n", - savethread, thr, err)); - /* Thread creation failed--clean up */ - SvREFCNT_dec(thr->cvcache); - remove_thread(aTHX_ thr); - for (i = 0; i <= AvFILL(initargs); i++) - SvREFCNT_dec(*av_fetch(initargs, i, FALSE)); - SvREFCNT_dec(startsv); - return NULL; - } - -#ifdef THREAD_POST_CREATE - THREAD_POST_CREATE(thr); -#else - if (sigprocmask(SIG_SETMASK, &oldmask, 0)) - croak("panic: sigprocmask"); -#endif - - sv = newSViv(thr->tid); - sv_magic(sv, thr->oursv, '~', 0, 0); - SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE; - sv = sv_bless(newRV_noinc(sv), gv_stashpv(classname, TRUE)); - - /* Go */ - MUTEX_UNLOCK(&thr->mutex); - - return sv; -#else -# 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; -#endif -} - -static Signal_t handle_thread_signal (int sig); - -static Signal_t -handle_thread_signal(int sig) -{ - dTHXo; - unsigned char c = (unsigned char) sig; - /* - * 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 - AV * av = NO_INIT - int i = NO_INIT - PPCODE: -#ifdef USE_THREADS - if (t == thr) - croak("Attempt to join self"); - DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: joining %p (state %u)\n", - thr, t, ThrSTATE(t));); - MUTEX_LOCK(&t->mutex); - switch (ThrSTATE(t)) { - case THRf_R_JOINABLE: - case THRf_R_JOINED: - ThrSETSTATE(t, THRf_R_JOINED); - MUTEX_UNLOCK(&t->mutex); - break; - case THRf_ZOMBIE: - ThrSETSTATE(t, THRf_DEAD); - MUTEX_UNLOCK(&t->mutex); - remove_thread(aTHX_ t); - break; - default: - MUTEX_UNLOCK(&t->mutex); - croak("can't join with thread"); - /* NOTREACHED */ - } - JOIN(t, &av); - - sv_2mortal((SV*)av); - - if (SvTRUE(*av_fetch(av, 0, FALSE))) { - /* Could easily speed up the following if necessary */ - for (i = 1; i <= AvFILL(av); i++) - XPUSHs(*av_fetch(av, i, FALSE)); - } - else { - STRLEN n_a; - char *mess = SvPV(*av_fetch(av, 1, FALSE), n_a); - DEBUG_S(PerlIO_printf(Perl_debug_log, - "%p: join propagating die message: %s\n", - thr, mess)); - croak(mess); - } -#endif - -void -detach(t) - Thread t - CODE: -#ifdef USE_THREADS - DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: detaching %p (state %u)\n", - thr, t, ThrSTATE(t));); - MUTEX_LOCK(&t->mutex); - switch (ThrSTATE(t)) { - case THRf_R_JOINABLE: - ThrSETSTATE(t, THRf_R_DETACHED); - /* fall through */ - case THRf_R_DETACHED: - DETACH(t); - MUTEX_UNLOCK(&t->mutex); - break; - case THRf_ZOMBIE: - ThrSETSTATE(t, THRf_DEAD); - DETACH(t); - MUTEX_UNLOCK(&t->mutex); - remove_thread(aTHX_ t); - break; - default: - MUTEX_UNLOCK(&t->mutex); - croak("can't detach thread"); - /* NOTREACHED */ - } -#endif - -void -equal(t1, t2) - Thread t1 - Thread t2 - PPCODE: - PUSHs((t1 == t2) ? &PL_sv_yes : &PL_sv_no); - -void -flags(t) - Thread t - PPCODE: -#ifdef USE_THREADS - PUSHs(sv_2mortal(newSViv(t->flags))); -#endif - -void -self(classname) - char * classname - PREINIT: - SV *sv; - PPCODE: -#ifdef USE_THREADS - sv = newSViv(thr->tid); - sv_magic(sv, thr->oursv, '~', 0, 0); - SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE; - PUSHs(sv_2mortal(sv_bless(newRV_noinc(sv), - gv_stashpv(classname, TRUE)))); -#endif - -U32 -tid(t) - Thread t - CODE: -#ifdef USE_THREADS - MUTEX_LOCK(&t->mutex); - RETVAL = t->tid; - MUTEX_UNLOCK(&t->mutex); -#else - RETVAL = 0; -#endif - OUTPUT: - RETVAL - -void -DESTROY(t) - SV * t - PPCODE: - PUSHs(&PL_sv_yes); - -void -yield() - CODE: -{ -#ifdef USE_THREADS - YIELD; -#endif -} - -void -cond_wait(sv) - SV * sv - MAGIC * mg = NO_INIT -CODE: -#ifdef USE_THREADS - if (SvROK(sv)) - sv = SvRV(sv); - - mg = condpair_magic(sv); - DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: cond_wait %p\n", thr, sv)); - MUTEX_LOCK(MgMUTEXP(mg)); - if (MgOWNER(mg) != thr) { - MUTEX_UNLOCK(MgMUTEXP(mg)); - croak("cond_wait for lock that we don't own\n"); - } - MgOWNER(mg) = 0; - COND_SIGNAL(MgOWNERCONDP(mg)); - COND_WAIT(MgCONDP(mg), MgMUTEXP(mg)); - while (MgOWNER(mg)) - COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg)); - MgOWNER(mg) = thr; - MUTEX_UNLOCK(MgMUTEXP(mg)); -#endif - -void -cond_signal(sv) - SV * sv - MAGIC * mg = NO_INIT -CODE: -#ifdef USE_THREADS - if (SvROK(sv)) - sv = SvRV(sv); - - mg = condpair_magic(sv); - DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: cond_signal %p\n",thr,sv)); - MUTEX_LOCK(MgMUTEXP(mg)); - if (MgOWNER(mg) != thr) { - MUTEX_UNLOCK(MgMUTEXP(mg)); - croak("cond_signal for lock that we don't own\n"); - } - COND_SIGNAL(MgCONDP(mg)); - MUTEX_UNLOCK(MgMUTEXP(mg)); -#endif - -void -cond_broadcast(sv) - SV * sv - MAGIC * mg = NO_INIT -CODE: -#ifdef USE_THREADS - if (SvROK(sv)) - sv = SvRV(sv); - - mg = condpair_magic(sv); - DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: cond_broadcast %p\n", - thr, sv)); - MUTEX_LOCK(MgMUTEXP(mg)); - if (MgOWNER(mg) != thr) { - MUTEX_UNLOCK(MgMUTEXP(mg)); - croak("cond_broadcast for lock that we don't own\n"); - } - COND_BROADCAST(MgCONDP(mg)); - MUTEX_UNLOCK(MgMUTEXP(mg)); -#endif - -void -list(classname) - char * classname - PREINIT: - Thread t; - AV * av; - SV ** svp; - int n = 0; - PPCODE: -#ifdef USE_THREADS - av = newAV(); - /* - * Iterate until we have enough dynamic storage for all threads. - * We mustn't do any allocation while holding threads_mutex though. - */ - MUTEX_LOCK(&PL_threads_mutex); - do { - n = PL_nthreads; - MUTEX_UNLOCK(&PL_threads_mutex); - if (AvFILL(av) < n - 1) { - int i = AvFILL(av); - for (i = AvFILL(av); i < n - 1; i++) { - SV *sv = newSViv(0); /* fill in tid later */ - sv_magic(sv, 0, '~', 0, 0); /* fill in other magic later */ - av_push(av, sv_bless(newRV_noinc(sv), - gv_stashpv(classname, TRUE))); - - } - } - MUTEX_LOCK(&PL_threads_mutex); - } while (n < PL_nthreads); - n = PL_nthreads; /* Get the final correct value */ - - /* - * At this point, there's enough room to fill in av. - * Note that we are holding threads_mutex so the list - * won't change out from under us but all the remaining - * processing is "fast" (no blocking, malloc etc.) - */ - t = thr; - svp = AvARRAY(av); - do { - SV *sv = (SV*)SvRV(*svp); - sv_setiv(sv, t->tid); - SvMAGIC(sv)->mg_obj = SvREFCNT_inc(t->oursv); - SvMAGIC(sv)->mg_flags |= MGf_REFCOUNTED; - SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE; - t = t->next; - svp++; - } while (t != thr); - /* */ - MUTEX_UNLOCK(&PL_threads_mutex); - /* Truncate any unneeded slots in av */ - av_fill(av, n - 1); - /* Finally, push all the new objects onto the stack and drop av */ - EXTEND(SP, n); - for (svp = AvARRAY(av); n > 0; n--, svp++) - PUSHs(*svp); - (void)sv_2mortal((SV*)av); -#endif - - -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: -#ifdef USE_THREADS - if (AvFILL(thr->specific) == -1) { - GV *gv = gv_fetchpv("Thread::Specific::FIELDS", TRUE, SVt_PVHV); - av_store(thr->specific, 0, newRV((SV*)GvHV(gv))); - } - XPUSHs(sv_bless(newRV((SV*)thr->specific),gv_stashpv(classname,TRUE))); -#endif diff --git a/contrib/perl5/ext/Thread/Thread/Queue.pm b/contrib/perl5/ext/Thread/Thread/Queue.pm deleted file mode 100644 index 831573c..0000000 --- a/contrib/perl5/ext/Thread/Thread/Queue.pm +++ /dev/null @@ -1,95 +0,0 @@ -package Thread::Queue; -use Thread qw(cond_wait cond_broadcast); - -=head1 NAME - -Thread::Queue - thread-safe queues - -=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; diff --git a/contrib/perl5/ext/Thread/Thread/Semaphore.pm b/contrib/perl5/ext/Thread/Thread/Semaphore.pm deleted file mode 100644 index 3cd6338..0000000 --- a/contrib/perl5/ext/Thread/Thread/Semaphore.pm +++ /dev/null @@ -1,85 +0,0 @@ -package Thread::Semaphore; -use Thread qw(cond_wait cond_broadcast); - -=head1 NAME - -Thread::Semaphore - thread-safe semaphores - -=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; diff --git a/contrib/perl5/ext/Thread/Thread/Signal.pm b/contrib/perl5/ext/Thread/Thread/Signal.pm deleted file mode 100644 index f5f03db..0000000 --- a/contrib/perl5/ext/Thread/Thread/Signal.pm +++ /dev/null @@ -1,50 +0,0 @@ -package Thread::Signal; -use Thread qw(async); - -=head1 NAME - -Thread::Signal - Start a thread which runs signal handlers reliably - -=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; diff --git a/contrib/perl5/ext/Thread/Thread/Specific.pm b/contrib/perl5/ext/Thread/Thread/Specific.pm deleted file mode 100644 index a6271a4..0000000 --- a/contrib/perl5/ext/Thread/Thread/Specific.pm +++ /dev/null @@ -1,28 +0,0 @@ -package Thread::Specific; - -=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; diff --git a/contrib/perl5/ext/Thread/create.t b/contrib/perl5/ext/Thread/create.t deleted file mode 100644 index df8fc77..0000000 --- a/contrib/perl5/ext/Thread/create.t +++ /dev/null @@ -1,26 +0,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/contrib/perl5/ext/Thread/die.t b/contrib/perl5/ext/Thread/die.t deleted file mode 100644 index 6239405..0000000 --- a/contrib/perl5/ext/Thread/die.t +++ /dev/null @@ -1,16 +0,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/contrib/perl5/ext/Thread/die2.t b/contrib/perl5/ext/Thread/die2.t deleted file mode 100644 index f6b6955..0000000 --- a/contrib/perl5/ext/Thread/die2.t +++ /dev/null @@ -1,16 +0,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/contrib/perl5/ext/Thread/io.t b/contrib/perl5/ext/Thread/io.t deleted file mode 100644 index 6012008..0000000 --- a/contrib/perl5/ext/Thread/io.t +++ /dev/null @@ -1,39 +0,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"; -} diff --git a/contrib/perl5/ext/Thread/join.t b/contrib/perl5/ext/Thread/join.t deleted file mode 100644 index cba2c1c..0000000 --- a/contrib/perl5/ext/Thread/join.t +++ /dev/null @@ -1,11 +0,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/contrib/perl5/ext/Thread/join2.t b/contrib/perl5/ext/Thread/join2.t deleted file mode 100644 index 99b43a5..0000000 --- a/contrib/perl5/ext/Thread/join2.t +++ /dev/null @@ -1,12 +0,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/contrib/perl5/ext/Thread/list.t b/contrib/perl5/ext/Thread/list.t deleted file mode 100644 index f13f4b2..0000000 --- a/contrib/perl5/ext/Thread/list.t +++ /dev/null @@ -1,30 +0,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/contrib/perl5/ext/Thread/lock.t b/contrib/perl5/ext/Thread/lock.t deleted file mode 100644 index fefb129..0000000 --- a/contrib/perl5/ext/Thread/lock.t +++ /dev/null @@ -1,27 +0,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/contrib/perl5/ext/Thread/queue.t b/contrib/perl5/ext/Thread/queue.t deleted file mode 100644 index 4672ba6..0000000 --- a/contrib/perl5/ext/Thread/queue.t +++ /dev/null @@ -1,36 +0,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/contrib/perl5/ext/Thread/specific.t b/contrib/perl5/ext/Thread/specific.t deleted file mode 100644 index da130b1..0000000 --- a/contrib/perl5/ext/Thread/specific.t +++ /dev/null @@ -1,17 +0,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/contrib/perl5/ext/Thread/sync.t b/contrib/perl5/ext/Thread/sync.t deleted file mode 100644 index 6445b55..0000000 --- a/contrib/perl5/ext/Thread/sync.t +++ /dev/null @@ -1,60 +0,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/contrib/perl5/ext/Thread/sync2.t b/contrib/perl5/ext/Thread/sync2.t deleted file mode 100644 index ffc74b4..0000000 --- a/contrib/perl5/ext/Thread/sync2.t +++ /dev/null @@ -1,68 +0,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/contrib/perl5/ext/Thread/typemap b/contrib/perl5/ext/Thread/typemap deleted file mode 100644 index 7ce7d5c..0000000 --- a/contrib/perl5/ext/Thread/typemap +++ /dev/null @@ -1,24 +0,0 @@ -Thread T_XSCPTR - -INPUT -T_XSCPTR - STMT_START { - MAGIC *mg; - SV *sv = ($arg); - - if (!sv_isobject(sv)) - croak(\"$var is not an object\"); - sv = (SV*)SvRV(sv); - if (!SvRMAGICAL(sv) || !(mg = mg_find(sv, '~')) - || mg->mg_private != ${ntype}_MAGIC_SIGNATURE) - croak(\"XSUB ${func_name}: $var is a forged ${ntype} object\"); - $var = ($type) SvPVX(mg->mg_obj); - DEBUG_S(PerlIO_printf(Perl_debug_log, - \"XSUB ${func_name}: %p\\n\", $var);) - } STMT_END -T_IVREF - if (SvROK($arg)) - $var = ($type) SvIV((SV*)SvRV($arg)); - else - croak(\"$var is not a reference\") - diff --git a/contrib/perl5/ext/Thread/unsync.t b/contrib/perl5/ext/Thread/unsync.t deleted file mode 100644 index f0a51ef..0000000 --- a/contrib/perl5/ext/Thread/unsync.t +++ /dev/null @@ -1,37 +0,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/contrib/perl5/ext/Thread/unsync2.t b/contrib/perl5/ext/Thread/unsync2.t deleted file mode 100644 index fb955ac..0000000 --- a/contrib/perl5/ext/Thread/unsync2.t +++ /dev/null @@ -1,36 +0,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/contrib/perl5/ext/Thread/unsync3.t b/contrib/perl5/ext/Thread/unsync3.t deleted file mode 100644 index e03e9c8..0000000 --- a/contrib/perl5/ext/Thread/unsync3.t +++ /dev/null @@ -1,50 +0,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/contrib/perl5/ext/Thread/unsync4.t b/contrib/perl5/ext/Thread/unsync4.t deleted file mode 100644 index 494ad2b..0000000 --- a/contrib/perl5/ext/Thread/unsync4.t +++ /dev/null @@ -1,38 +0,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"; |
