ext/threads/t/libc.t testing libc functions for threadsafety
ext/threads/t/list.t Test threads->list()
ext/threads/t/problems.t Test various memory problems
+ext/threads/t/stack.t Tests for stack limits
+ext/threads/t/stack_env.t Tests for stack limits
ext/threads/t/stress_cv.t Test with multiple threads, coderef cv argument.
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.
Revision history for Perl extension threads.
+1.25 Thu May 4 12:34:02 EDT 2006
+ - Final sync with blead
+ - Lock counters in tests
+
1.24 Mon Apr 24 10:29:11 EDT 2006
- assert() that thread 0 is never destructed
- Determinancy in free.t
-threads version 1.24
+threads version 1.25
====================
This module needs perl 5.8.0 or later compiled with 'useithreads'.
--- /dev/null
+use strict;
+use warnings;
+
+BEGIN {
+ if ($ENV{'PERL_CORE'}){
+ chdir 't';
+ unshift @INC, '../lib';
+ }
+ use Config;
+ if (! $Config{'useithreads'}) {
+ print("1..0 # Skip: Perl not compiled with 'useithreads'\n");
+ exit(0);
+ }
+}
+
+use ExtUtils::testlib;
+
+sub ok {
+ my ($id, $ok, $name) = @_;
+
+ # You have to do it this way or VMS will get confused.
+ if ($ok) {
+ print("ok $id - $name\n");
+ } else {
+ print("not ok $id - $name\n");
+ printf("# Failed test at line %d\n", (caller)[2]);
+ }
+
+ return ($ok);
+}
+
+BEGIN {
+ $| = 1;
+ print("1..18\n"); ### Number of tests that will be run ###
+};
+
+use threads 1.09 ('stack_size' => 32*4096);
+ok(1, 1, 'Loaded');
+
+### Start of Testing ###
+
+ok(2, threads->get_stack_size() == 32*4096,
+ 'Stack size set in import');
+ok(3, threads->set_stack_size(64*4096) == 32*4096,
+ 'Set returns previous value');
+ok(4, threads->get_stack_size() == 64*4096,
+ 'Get stack size');
+
+threads->create(
+ sub {
+ ok(5, threads->get_stack_size() == 64*4096,
+ 'Get stack size in thread');
+ ok(6, threads->self()->get_stack_size() == 64*4096,
+ 'Thread gets own stack size');
+ ok(7, threads->set_stack_size(32*4096) == 64*4096,
+ 'Thread changes stack size');
+ ok(8, threads->get_stack_size() == 32*4096,
+ 'Get stack size in thread');
+ ok(9, threads->self()->get_stack_size() == 64*4096,
+ 'Thread stack size unchanged');
+ }
+)->join();
+
+ok(10, threads->get_stack_size() == 32*4096,
+ 'Default thread sized changed in thread');
+
+threads->create(
+ { 'stack' => 64*4096 },
+ sub {
+ ok(11, threads->get_stack_size() == 32*4096,
+ 'Get stack size in thread');
+ ok(12, threads->self()->get_stack_size() == 64*4096,
+ 'Thread gets own stack size');
+ }
+)->join();
+
+my $thr = threads->create( { 'stack' => 64*4096 }, sub { } );
+
+$thr->create(
+ sub {
+ ok(13, threads->get_stack_size() == 32*4096,
+ 'Get stack size in thread');
+ ok(14, threads->self()->get_stack_size() == 64*4096,
+ 'Thread gets own stack size');
+ }
+)->join();
+
+$thr->create(
+ { 'stack' => 48*4096 },
+ sub {
+ ok(15, threads->get_stack_size() == 32*4096,
+ 'Get stack size in thread');
+ ok(16, threads->self()->get_stack_size() == 48*4096,
+ 'Thread gets own stack size');
+ ok(17, threads->set_stack_size(64*4096) == 32*4096,
+ 'Thread changes stack size');
+ }
+)->join();
+
+$thr->join();
+
+ok(18, threads->get_stack_size() == 64*4096,
+ 'Default thread sized changed in thread');
+
+# EOF
--- /dev/null
+use strict;
+use warnings;
+
+BEGIN {
+ if ($ENV{'PERL_CORE'}){
+ chdir 't';
+ unshift @INC, '../lib';
+ }
+ use Config;
+ if (! $Config{'useithreads'}) {
+ print("1..0 # Skip: Perl not compiled with 'useithreads'\n");
+ exit(0);
+ }
+}
+
+use ExtUtils::testlib;
+
+sub ok {
+ my ($id, $ok, $name) = @_;
+
+ # You have to do it this way or VMS will get confused.
+ if ($ok) {
+ print("ok $id - $name\n");
+ } else {
+ print("not ok $id - $name\n");
+ printf("# Failed test at line %d\n", (caller)[2]);
+ }
+
+ return ($ok);
+}
+
+BEGIN {
+ $| = 1;
+ print("1..4\n"); ### Number of tests that will be run ###
+
+ $ENV{'PERL5_ITHREADS_STACK_SIZE'} = 196608;
+};
+
+use threads;
+ok(1, 1, 'Loaded');
+
+### Start of Testing ###
+
+ok(2, threads->get_stack_size() == 48*4096,
+ '$ENV{PERL5_ITHREADS_STACK_SIZE}');
+ok(3, threads->set_stack_size(32*4096) == 48*4096,
+ 'Set returns previous value');
+ok(4, threads->get_stack_size() == 32*4096,
+ 'Get stack size');
+
+# EOF
use strict;
use warnings;
-our $VERSION = '1.24_02';
+our $VERSION = '1.25';
my $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
# Handle args
while (my $sym = shift) {
- if ($sym =~ /all/) {
+ if ($sym =~ /^stack/) {
+ threads->set_stack_size(shift);
+
+ } elsif ($sym =~ /all/) {
push(@EXPORT, qw(yield));
} else {
no strict 'refs';
*{$caller.'::'.$sym} = \&{$sym};
}
+
+ # Set stack size via environment variable
+ if (exists($ENV{'PERL5_ITHREADS_STACK_SIZE'})) {
+ threads->set_stack_size($ENV{'PERL5_ITHREADS_STACK_SIZE'});
+ }
}
=head1 VERSION
-This document describes threads version 1.24
+This document describes threads version 1.25
=head1 SYNOPSIS
- use threads ('yield');
+ use threads ('yield', 'stack_size' => 64*4096);
sub start_thread {
my @args = @_;
...
}
+ $stack_size = threads->get_stack_size();
+ $old_size = threads->set_stack_size(32*4096);
+
=head1 DESCRIPTION
Perl 5.6 introduced something called interpreter threads. Interpreter threads
=back
+=head1 THREAD STACK SIZE
+
+The default per-thread stack size for different platforms varies
+significantly, and is almost always far more than is needed for most
+applications. On Win32, Perl's makefile explicitly sets the default stack to
+16 MB; on most other platforms, the system default is used, which again may be
+much larger than is needed.
+
+By tuning the stack size to more accurately reflect your application's needs,
+you may significantly reduce your application's memory usage, and increase the
+number of simultaneously running threads.
+
+N.B., on Windows, Address space allocation granularity is 64 KB, therefore,
+setting the stack smaller than that on Win32 Perl will not save any more
+memory.
+
+=over
+
+=item threads->get_stack_size();
+
+Returns the current default per-thread stack size. The default is zero, which
+means the system default stack size is currently in use.
+
+=item $size = $thr->get_stack_size();
+
+Returns the stack size for a particular thread. A return value of zero
+indicates the system default stack size was used for the thread.
+
+=item $old_size = threads->set_stack_size($new_size);
+
+Sets a new default per-thread stack size, and returns the previous setting.
+
+Some platforms have a minimum thread stack size. Trying to set the stack size
+below this value will result in a warning, and the minimum stack size will be
+used.
+
+Some Linux platforms have a maximum stack size. Setting too large of a stack
+size will cause thread creation to fail.
+
+If needed, C<$new_size> will be rounded up to the next multiple of the memory
+page size (usually 4096 or 8192).
+
+Threads created after the stack size is set will then either call
+C<pthread_attr_setstacksize()> I<(for pthreads platforms)>, or supply the
+stack size to C<CreateThread()> I<(for Win32 Perl)>.
+
+(Obviously, this call does not affect any currently extant threads.)
+
+=item use threads ('stack_size' => VALUE);
+
+This sets the default per-thread stack size at the start of the application.
+
+=item $ENV{'PERL5_ITHREADS_STACK_SIZE'}
+
+The default per-thread stack size may be set at the start of the application
+through the use of the environment variable C<PERL5_ITHREADS_STACK_SIZE>:
+
+ PERL5_ITHREADS_STACK_SIZE=1048576
+ export PERL5_ITHREADS_STACK_SIZE
+ perl -e'use threads; print(threads->get_stack_size(), "\n")'
+
+This value overrides any C<stack_size> parameter given to C<use threads>. Its
+primary purpose is to permit setting the per-thread stack size for legacy
+threaded applications.
+
+=item threads->create({'stack_size' => VALUE}, FUNCTION, ARGS)
+
+This change to the thread creation method permits specifying the stack size
+for an individual thread.
+
+=item $thr2 = $thr1->create(FUNCTION, ARGS)
+
+This creates a new thread (C<$thr2>) that inherits the stack size from an
+existing thread (C<$thr1>). This is shorthand for the following:
+
+ my $stack_size = $thr1->get_stack_size();
+ my $thr2 = threads->create({'stack_size' => $stack_size}, FUNCTION, ARGS);
+
+=back
+
=head1 WARNINGS
=over 4
of the created threads by joining them, and only then exit from the main
thread.
+=item Using minimum thread stack size of #
+
+Some platforms have a minimum thread stack size. Trying to set the stack size
+below this value will result in the above warning, and the stack size will be
+set to the minimum.
+
=back
=head1 ERRORS
L<threads> module (i.e., threaded and non-threaded Perls are binary
incompatible.)
+=item Cannot change stack size of an existing thread
+
+The stack size of currently extant threads cannot be changed, therefore, the
+following results in the above error:
+
+ $thr->set_stack_size($size);
+
+=item Thread creation failed: pthread_attr_setstacksize(I<SIZE>) returned 22
+
+The specified I<SIZE> exceeds the system's maximum stack size. Use a smaller
+value for the stack size.
+
=back
=head1 BUGS
L<http://www.cpanforum.com/dist/threads>
Annotated POD for L<threads>:
-L<http://annocpan.org/~JDHEDDEN/threads-1.24/shared.pm>
+L<http://annocpan.org/~JDHEDDEN/threads-1.25/shared.pm>
L<threads::shared>, L<perlthrtut>
Perl threads mailing list:
L<http://lists.cpan.org/showlist.cgi?name=iThreads>
+Stack size discussion:
+L<http://www.perlmonks.org/?node_id=532956>
+
=head1 AUTHOR
Artur Bergman E<lt>sky AT crucially DOT netE<gt>
Vipul Ved Prakash E<lt>mail AT vipul DOT netE<gt> -
Helping with debugging
+Dean Arnold E<lt>darnold AT presicient DOT comE<gt> -
+Stack size API
+
=cut
#ifdef WIN32
# include <windows.h>
+ /* Supposed to be in Winbase.h */
+# ifndef STACK_SIZE_PARAM_IS_A_RESERVATION
+# define STACK_SIZE_PARAM_IS_A_RESERVATION 0x00010000
+# endif
# include <win32thread.h>
#else
# ifdef OS2
#else
pthread_t thr; /* OS's handle for the thread */
#endif
+ IV stack_size;
} ithread;
static UV tid_counter = 0;
static IV active_threads = 0;
+#ifdef THREAD_CREATE_NEEDS_STACK
+static IV default_stack_size = THREAD_CREATE_NEEDS_STACK;
+#else
+static IV default_stack_size = 0;
+#endif
+static IV page_size = 0;
/* Used by Perl interpreter for thread context switching */
};
+/* Provided default, minimum and rational stack sizes */
+static IV
+good_stack_size(pTHX_ IV stack_size)
+{
+ /* Use default stack size if no stack size specified */
+ if (! stack_size)
+ return (default_stack_size);
+
+#ifdef PTHREAD_STACK_MIN
+ /* Can't use less than minimum */
+ if (stack_size < PTHREAD_STACK_MIN) {
+ if (ckWARN_d(WARN_THREADS)) {
+ Perl_warn(aTHX_ "Using minimum thread stack size of %" IVdf, (IV)PTHREAD_STACK_MIN);
+ }
+ return (PTHREAD_STACK_MIN);
+ }
+#endif
+
+ /* Round up to page size boundary */
+ if (page_size <= 0) {
+#ifdef PL_mmap_page_size
+ page_size = PL_mmap_page_size;
+#else
+# ifdef HAS_MMAP
+# if defined(HAS_SYSCONF) && (defined(_SC_PAGESIZE) || defined(_SC_MMAP_PAGE_SIZE))
+ SETERRNO(0, SS_NORMAL);
+# ifdef _SC_PAGESIZE
+ page_size = sysconf(_SC_PAGESIZE);
+# else
+ page_size = sysconf(_SC_MMAP_PAGE_SIZE);
+# endif
+ if ((long)page_size < 0) {
+ if (errno) {
+ SV * const error = get_sv("@", FALSE);
+ (void)SvUPGRADE(error, SVt_PV);
+ Perl_croak(aTHX_ "PANIC: sysconf: %s", SvPV_nolen(error));
+ } else {
+ Perl_croak(aTHX_ "PANIC: sysconf: pagesize unknown");
+ }
+ }
+# else
+# ifdef HAS_GETPAGESIZE
+ page_size = getpagesize();
+# else
+# if defined(I_SYS_PARAM) && defined(PAGESIZE)
+ page_size = PAGESIZE;
+# endif
+# endif
+ if (page_size <= 0)
+ Perl_croak(aTHX_ "PANIC: bad pagesize %" IVdf, (IV)page_size);
+# endif
+# else
+ page_size = 8192; /* A conservative default */
+# endif
+#endif
+ }
+ stack_size = ((stack_size + (page_size - 1)) / page_size) * page_size;
+
+ return (stack_size);
+}
+
+
/* Starts executing the thread.
* Passed as the C level function to run in the new thread.
*/
pTHX_ SV *obj,
char *classname,
SV *init_function,
+ IV stack_size,
SV *params)
{
ithread *thread;
MUTEX_INIT(&thread->mutex);
thread->tid = tid_counter++;
+ thread->stack_size = good_stack_size(aTHX_ stack_size);
thread->gimme = GIMME_V;
/* "Clone" our interpreter into the thread's interpreter.
/* Create/start the thread */
#ifdef WIN32
thread->handle = CreateThread(NULL,
- (DWORD)0,
+ (DWORD)thread->stack_size,
S_ithread_run,
(LPVOID)thread,
- 0,
+ STACK_SIZE_PARAM_IS_A_RESERVATION,
&thread->thr);
#else
{
PTHREAD_ATTR_SETDETACHSTATE(&attr, attr_joinable);
# endif
-# ifdef THREAD_CREATE_NEEDS_STACK
+# ifdef _POSIX_THREAD_ATTR_STACKSIZE
/* Set thread's stack size */
- rc_stack_size = pthread_attr_setstacksize(&attr, THREAD_CREATE_NEEDS_STACK);
+ if (thread->stack_size > 0) {
+ rc_stack_size = pthread_attr_setstacksize(&attr, (size_t)thread->stack_size);
+ }
# endif
/* Create the thread */
(void *)thread);
# endif
}
+
+# ifdef _POSIX_THREAD_ATTR_STACKSIZE
+ /* Try to get thread's actual stack size */
+ {
+ size_t stacksize;
+ if (! pthread_attr_getstacksize(&attr, &stacksize)) {
+ if (stacksize) {
+ thread->stack_size = (IV)stacksize;
+ }
+ }
+ }
+# endif
}
#endif
sv_2mortal(params);
S_ithread_destruct(aTHX_ thread);
#ifndef WIN32
- if (ckWARN_d(WARN_THREADS)) {
-# ifdef THREAD_CREATE_NEEDS_STACK
- if (rc_stack_size)
- Perl_warn(aTHX_ "Thread creation failed: pthread_attr_setstacksize(%" IVdf ") returned %d", (IV)THREAD_CREATE_NEEDS_STACK, rc_stack_size);
- else
-# endif
- Perl_warn(aTHX_ "Thread creation failed: pthread_create returned %d", rc_thread_create);
- }
+ if (ckWARN_d(WARN_THREADS)) {
+ if (rc_stack_size)
+ Perl_warn(aTHX_ "Thread creation failed: pthread_attr_setstacksize(%" IVdf ") returned %d", thread->stack_size, rc_stack_size);
+ else
+ Perl_warn(aTHX_ "Thread creation failed: pthread_create returned %d", rc_thread_create);
+ }
#endif
return (&PL_sv_undef);
}
ithread_create(...)
PREINIT:
char *classname;
+ ithread *thread;
SV *function_to_call;
AV *params;
+ HV *specs;
+ IV stack_size;
+ int idx;
int ii;
CODE:
- if (items < 2)
- Perl_croak(aTHX_ "Usage: threads->create(function, ...)");
+ if ((items >= 2) && SvROK(ST(1)) && SvTYPE(SvRV(ST(1)))==SVt_PVHV) {
+ if (--items < 2)
+ Perl_croak(aTHX_ "Usage: threads->create(\\%specs, function, ...)");
+ specs = (HV*)SvRV(ST(1));
+ idx = 1;
+ } else {
+ if (items < 2)
+ Perl_croak(aTHX_ "Usage: threads->create(function, ...)");
+ specs = NULL;
+ idx = 0;
+ }
- classname = (char *)SvPV_nolen(ST(0));
- function_to_call = ST(1);
+ if (sv_isobject(ST(0))) {
+ /* $thr->create() */
+ classname = HvNAME(SvSTASH(SvRV(ST(0))));
+ thread = INT2PTR(ithread *, SvIV(SvRV(ST(0))));
+ stack_size = thread->stack_size;
+ } else {
+ /* threads->create() */
+ classname = (char *)SvPV_nolen(ST(0));
+ stack_size = default_stack_size;
+ }
+
+ function_to_call = ST(idx+1);
+
+ if (specs) {
+ /* stack_size */
+ if (hv_exists(specs, "stack", 5)) {
+ stack_size = SvIV(*hv_fetch(specs, "stack", 5, 0));
+ } else if (hv_exists(specs, "stacksize", 9)) {
+ stack_size = SvIV(*hv_fetch(specs, "stacksize", 9, 0));
+ } else if (hv_exists(specs, "stack_size", 10)) {
+ stack_size = SvIV(*hv_fetch(specs, "stack_size", 10, 0));
+ }
+ }
/* Function args */
params = newAV();
if (items > 2) {
- for (ii=2; ii < items; ii++) {
- av_push(params, SvREFCNT_inc(ST(ii)));
+ for (ii=2; ii < items ; ii++) {
+ av_push(params, SvREFCNT_inc(ST(idx+ii)));
}
}
/* Create thread */
ST(0) = sv_2mortal(S_ithread_create(aTHX_ Nullsv,
- classname,
- function_to_call,
- newRV_noinc((SV*)params)));
+ classname,
+ function_to_call,
+ stack_size,
+ newRV_noinc((SV*)params)));
/* XSRETURN(1); - implied */
#endif
/* XSRETURN(1); - implied */
+
+void
+ithread_get_stack_size(...)
+ PREINIT:
+ IV stack_size;
+ CODE:
+ if (sv_isobject(ST(0))) {
+ /* $thr->get_stack_size() */
+ ithread *thread = INT2PTR(ithread *, SvIV(SvRV(ST(0))));
+ stack_size = thread->stack_size;
+ } else {
+ /* threads->get_stack_size() */
+ stack_size = default_stack_size;
+ }
+ XST_mIV(0, stack_size);
+ /* XSRETURN(1); - implied */
+
+
+void
+ithread_set_stack_size(...)
+ PREINIT:
+ IV old_size;
+ CODE:
+ if (items != 2)
+ Perl_croak(aTHX_ "Usage: threads->set_stack_size($size)");
+ if (sv_isobject(ST(0)))
+ Perl_croak(aTHX_ "Cannot change stack size of an existing thread");
+
+ old_size = default_stack_size;
+ default_stack_size = good_stack_size(aTHX_ SvIV(ST(1)));
+ XST_mIV(0, old_size);
+ /* XSRETURN(1); - implied */
+
#endif /* USE_ITHREADS */
thread->interp = aTHX;
thread->state = PERL_ITHR_DETACHED; /* Detached */
+ thread->stack_size = default_stack_size;
# ifdef WIN32
thread->thr = GetCurrentThreadId();
# else
projects / p5sagit/p5-mst-13.2.git / commitdiff