This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
threads - stack size support
authorJerry D. Hedden <jdhedden@cpan.org>
Thu, 4 May 2006 10:07:58 +0000 (03:07 -0700)
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Fri, 5 May 2006 11:32:36 +0000 (11:32 +0000)
From: "Jerry D. Hedden" <jerry@hedden.us>
Message-ID: <20060504100758.fb30e530d17747c2b054d625b8945d88.1ee893a99c.wbe@email.secureserver.net>

p4raw-id: //depot/perl@28104

MANIFEST
ext/threads/Changes
ext/threads/README
ext/threads/t/stack.t [new file with mode: 0644]
ext/threads/t/stack_env.t [new file with mode: 0644]
ext/threads/threads.pm
ext/threads/threads.xs

index a367c87..5841f31 100644 (file)
--- 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.
index 2ab741e..6daa99e 100755 (executable)
@@ -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
index 568ae07..a324595 100755 (executable)
@@ -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 (file)
index 0000000..69ecb1c
--- /dev/null
@@ -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 (file)
index 0000000..18ad794
--- /dev/null
@@ -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
index fc62b90..af2343b 100755 (executable)
@@ -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<handle>.
 
 =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
@@ -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<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
@@ -393,7 +502,7 @@ L<threads> Discussion Forum on CPAN:
 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>
 
@@ -403,6 +512,9 @@ L<http://www.perl.com/pub/a/2002/09/04/threads.html>
 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>
@@ -424,4 +536,7 @@ Rocco Caputo E<lt>troc AT netrus 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
index 477bc21..9593781 100755 (executable)
 
 #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
@@ -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