Thread signalling [REVISED]

[p5sagit/p5-mst-13.2.git] / ext / threads / threads.xs

diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs
index 9593781..8c2eee1 100755 (executable)
--- a/ext/threads/threads.xs
+++ b/ext/threads/threads.xs
@@ -32,6 +32,9 @@ typedef perl_os_thread pthread_t;
 #    define PERL_THREAD_DETACH(t) pthread_detach((t))
 #  endif
 #endif
+#if !defined(HAS_GETPAGESIZE) && defined(I_SYS_PARAM)
+#  include <sys/param.h>
+#endif
 
 /* Values for 'state' member */
 #define PERL_ITHR_JOINABLE      0
@@ -270,17 +273,13 @@ good_stack_size(pTHX_ IV stack_size)
 
     /* 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))
+#if defined(HAS_SYSCONF) && (defined(_SC_PAGESIZE) || defined(_SC_MMAP_PAGE_SIZE))
         SETERRNO(0, SS_NORMAL);
-#      ifdef _SC_PAGESIZE
+#  ifdef _SC_PAGESIZE
         page_size = sysconf(_SC_PAGESIZE);
-#      else
+#  else
         page_size = sysconf(_SC_MMAP_PAGE_SIZE);
-#      endif
+#  endif
         if ((long)page_size < 0) {
             if (errno) {
                 SV * const error = get_sv("@", FALSE);
@@ -290,20 +289,18 @@ good_stack_size(pTHX_ IV stack_size)
                 Perl_croak(aTHX_ "PANIC: sysconf: pagesize unknown");
             }
         }
-#    else
-#      ifdef HAS_GETPAGESIZE
+#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
+#    if defined(I_SYS_PARAM) && defined(PAGESIZE)
+        page_size = PAGESIZE;
+#    else
         page_size = 8192;   /* A conservative default */
+#    endif
 #  endif
+        if (page_size <= 0)
+            Perl_croak(aTHX_ "PANIC: bad pagesize %" IVdf, (IV)page_size);
 #endif
     }
     stack_size = ((stack_size + (page_size - 1)) / page_size) * page_size;
@@ -371,7 +368,7 @@ S_ithread_run(void * arg)
 
         /* Check for failure */
         if (SvTRUE(ERRSV) && ckWARN_d(WARN_THREADS)) {
-            Perl_warn(aTHX_ "Thread failed to start: %" SVf, ERRSV);
+            Perl_warn(aTHX_ "Thread %" UVuf " terminated abnormally: %" SVf, thread->tid, ERRSV);
         }
 
         FREETMPS;
@@ -922,6 +919,46 @@ ithread_detach(...)
 
 
 void
+ithread_kill(...)
+    PREINIT:
+        ithread *thread;
+        char *sig_name;
+        IV signal;
+    CODE:
+        /* Must have safe signals */
+        if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG)
+            Perl_croak(aTHX_ "Cannot signal other threads without safe signals");
+
+        /* Object method only */
+        if (! sv_isobject(ST(0)))
+            Perl_croak(aTHX_ "Usage: $thr->kill('SIG...')");
+
+        /* Get thread */
+        thread = SV_to_ithread(aTHX_ ST(0));
+
+        /* Get signal */
+        sig_name = SvPV_nolen(ST(1));
+        if (isALPHA(*sig_name)) {
+            if (*sig_name == 'S' && sig_name[1] == 'I' && sig_name[2] == 'G')
+                sig_name += 3;
+            if ((signal = Perl_whichsig(aTHX_ sig_name)) < 0)
+                Perl_croak(aTHX_ "Unrecognized signal name: %s", sig_name);
+        } else
+            signal = SvIV(ST(1));
+
+        /* Set the signal for the thread */
+        {
+            dTHXa(thread->interp);
+            PL_psig_pend[signal]++;
+            PL_sig_pending = 1;
+        }
+
+        /* Return the thread to allow for method chaining */
+        ST(0) = ST(0);
+        /* XSRETURN(1); - implied */
+
+
+void
 ithread_DESTROY(...)
     CODE:
         sv_unmagic(SvRV(ST(0)), PERL_MAGIC_shared_scalar);