From: Jerry D. Hedden Date: Thu, 4 May 2006 10:07:58 +0000 (-0700) Subject: threads - stack size support X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=514612b7038f11927cade098ef794514f6c0f65b;p=p5sagit%2Fp5-mst-13.2.git threads - stack size support From: "Jerry D. Hedden" Message-ID: <20060504100758.fb30e530d17747c2b054d625b8945d88.1ee893a99c.wbe@email.secureserver.net> p4raw-id: //depot/perl@28104 --- diff --git a/MANIFEST b/MANIFEST index a367c87..5841f31 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1139,6 +1139,8 @@ ext/threads/t/join.t Testing the join function 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. diff --git a/ext/threads/Changes b/ext/threads/Changes index 2ab741e..6daa99e 100755 --- a/ext/threads/Changes +++ b/ext/threads/Changes @@ -1,5 +1,9 @@ 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 diff --git a/ext/threads/README b/ext/threads/README index 568ae07..a324595 100755 --- a/ext/threads/README +++ b/ext/threads/README @@ -1,4 +1,4 @@ -threads version 1.24 +threads version 1.25 ==================== This module needs perl 5.8.0 or later compiled with 'useithreads'. diff --git a/ext/threads/t/stack.t b/ext/threads/t/stack.t new file mode 100644 index 0000000..69ecb1c --- /dev/null +++ b/ext/threads/t/stack.t @@ -0,0 +1,105 @@ +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 diff --git a/ext/threads/t/stack_env.t b/ext/threads/t/stack_env.t new file mode 100644 index 0000000..18ad794 --- /dev/null +++ b/ext/threads/t/stack_env.t @@ -0,0 +1,51 @@ +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 diff --git a/ext/threads/threads.pm b/ext/threads/threads.pm index fc62b90..af2343b 100755 --- a/ext/threads/threads.pm +++ b/ext/threads/threads.pm @@ -5,7 +5,7 @@ use 5.008; use strict; use warnings; -our $VERSION = '1.24_02'; +our $VERSION = '1.25'; my $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -47,7 +47,10 @@ sub import # 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 { @@ -61,6 +64,11 @@ sub import 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'}); + } } @@ -94,11 +102,11 @@ threads - Perl interpreter-based threads =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 = @_; @@ -135,6 +143,9 @@ This document describes threads version 1.24 ... } + $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 @@ -314,6 +325,86 @@ Class method that allows a thread to obtain its own I. =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 I<(for pthreads platforms)>, or supply the +stack size to C 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=1048576 + export PERL5_ITHREADS_STACK_SIZE + perl -e'use threads; print(threads->get_stack_size(), "\n")' + +This value overrides any C parameter given to C. 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 @@ -325,6 +416,12 @@ threads running. Usually, it's a good idea to first collect the return values 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 @@ -341,6 +438,18 @@ Perl installation to be rebuilt; it is not just a question of adding the L 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) returned 22 + +The specified I exceeds the system's maximum stack size. Use a smaller +value for the stack size. + =back =head1 BUGS @@ -393,7 +502,7 @@ L Discussion Forum on CPAN: L Annotated POD for L: -L +L L, L @@ -403,6 +512,9 @@ L Perl threads mailing list: L +Stack size discussion: +L + =head1 AUTHOR Artur Bergman Esky AT crucially DOT netE @@ -424,4 +536,7 @@ Rocco Caputo Etroc AT netrus DOT netE Vipul Ved Prakash Email AT vipul DOT netE - Helping with debugging +Dean Arnold Edarnold AT presicient DOT comE - +Stack size API + =cut diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs index 477bc21..9593781 100755 --- a/ext/threads/threads.xs +++ b/ext/threads/threads.xs @@ -13,6 +13,10 @@ #ifdef WIN32 # include + /* Supposed to be in Winbase.h */ +# ifndef STACK_SIZE_PARAM_IS_A_RESERVATION +# define STACK_SIZE_PARAM_IS_A_RESERVATION 0x00010000 +# endif # include #else # ifdef OS2 @@ -52,6 +56,7 @@ typedef struct _ithread { #else pthread_t thr; /* OS's handle for the thread */ #endif + IV stack_size; } ithread; @@ -73,6 +78,12 @@ static perl_mutex create_destruct_mutex; 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 */ @@ -239,6 +250,68 @@ MGVTBL ithread_vtbl = { }; +/* 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. */ @@ -379,6 +452,7 @@ S_ithread_create( pTHX_ SV *obj, char *classname, SV *init_function, + IV stack_size, SV *params) { ithread *thread; @@ -416,6 +490,7 @@ S_ithread_create( 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. @@ -491,10 +566,10 @@ S_ithread_create( /* 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 { @@ -511,9 +586,11 @@ S_ithread_create( 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 */ @@ -533,6 +610,18 @@ S_ithread_create( (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 @@ -546,14 +635,12 @@ S_ithread_create( 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); } @@ -578,29 +665,64 @@ void 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 */ @@ -882,6 +1004,39 @@ ithread__handle(...); #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 */ @@ -922,6 +1077,7 @@ BOOT: thread->interp = aTHX; thread->state = PERL_ITHR_DETACHED; /* Detached */ + thread->stack_size = default_stack_size; # ifdef WIN32 thread->thr = GetCurrentThreadId(); # else