This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
amigaos4: neither sched_yield nor pthread_yield
[perl5.git] / dist / threads / threads.xs
index f6fe7dc..3b38367 100644 (file)
 #ifndef sv_dup_inc
 #  define sv_dup_inc(s,t)      SvREFCNT_inc(sv_dup(s,t))
 #endif
 #ifndef sv_dup_inc
 #  define sv_dup_inc(s,t)      SvREFCNT_inc(sv_dup(s,t))
 #endif
+#ifndef PERL_UNUSED_RESULT
+#  if defined(__GNUC__) && defined(HASATTRIBUTE_WARN_UNUSED_RESULT)
+#    define PERL_UNUSED_RESULT(v) STMT_START { __typeof__(v) z = (v); (void)sizeof(z); } STMT_END
+#  else
+#    define PERL_UNUSED_RESULT(v) ((void)(v))
+#  endif
+#endif
 
 #ifdef USE_ITHREADS
 
 
 #ifdef USE_ITHREADS
 
+#if defined(__amigaos4__)
+#  undef YIELD
+#  define YIELD sleep(0)
+#endif
 #ifdef WIN32
 #  include <windows.h>
    /* Supposed to be in Winbase.h */
 #ifdef WIN32
 #  include <windows.h>
    /* Supposed to be in Winbase.h */
@@ -346,7 +357,7 @@ S_exit_warning(pTHX)
 /* Called from perl_destruct() in each thread.  If it's the main thread,
  * stop it from freeing everything if there are other threads still running.
  */
 /* Called from perl_destruct() in each thread.  If it's the main thread,
  * stop it from freeing everything if there are other threads still running.
  */
-int
+STATIC int
 Perl_ithread_hook(pTHX)
 {
     dMY_POOL;
 Perl_ithread_hook(pTHX)
 {
     dMY_POOL;
@@ -356,7 +367,7 @@ Perl_ithread_hook(pTHX)
 
 /* MAGIC (in mg.h sense) hooks */
 
 
 /* MAGIC (in mg.h sense) hooks */
 
-int
+STATIC int
 ithread_mg_get(pTHX_ SV *sv, MAGIC *mg)
 {
     ithread *thread = (ithread *)mg->mg_ptr;
 ithread_mg_get(pTHX_ SV *sv, MAGIC *mg)
 {
     ithread *thread = (ithread *)mg->mg_ptr;
@@ -365,7 +376,7 @@ ithread_mg_get(pTHX_ SV *sv, MAGIC *mg)
     return (0);
 }
 
     return (0);
 }
 
-int
+STATIC int
 ithread_mg_free(pTHX_ SV *sv, MAGIC *mg)
 {
     ithread *thread = (ithread *)mg->mg_ptr;
 ithread_mg_free(pTHX_ SV *sv, MAGIC *mg)
 {
     ithread *thread = (ithread *)mg->mg_ptr;
@@ -375,7 +386,7 @@ ithread_mg_free(pTHX_ SV *sv, MAGIC *mg)
     return (0);
 }
 
     return (0);
 }
 
-int
+STATIC int
 ithread_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param)
 {
     PERL_UNUSED_ARG(param);
 ithread_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param)
 {
     PERL_UNUSED_ARG(param);
@@ -383,14 +394,17 @@ ithread_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param)
     return (0);
 }
 
     return (0);
 }
 
-MGVTBL ithread_vtbl = {
+STATIC const MGVTBL ithread_vtbl = {
     ithread_mg_get,     /* get */
     0,                  /* set */
     0,                  /* len */
     0,                  /* clear */
     ithread_mg_free,    /* free */
     0,                  /* copy */
     ithread_mg_get,     /* get */
     0,                  /* set */
     0,                  /* len */
     0,                  /* clear */
     ithread_mg_free,    /* free */
     0,                  /* copy */
-    ithread_mg_dup      /* dup */
+    ithread_mg_dup,     /* dup */
+#if (PERL_VERSION > 8) || (PERL_VERSION == 8 && PERL_SUBVERSION > 8)
+    0                   /* local */
+#endif
 };
 
 
 };
 
 
@@ -467,10 +481,10 @@ S_ithread_run(void * arg)
 {
     ithread *thread = (ithread *)arg;
     int jmp_rc = 0;
 {
     ithread *thread = (ithread *)arg;
     int jmp_rc = 0;
-    I32 oldscope;
-    int exit_app = 0;   /* Thread terminated using 'exit' */
-    int exit_code = 0;
-    int died = 0;       /* Thread terminated abnormally */
+    volatile I32 oldscope;
+    volatile int exit_app = 0;   /* Thread terminated using 'exit' */
+    volatile int exit_code = 0;
+    volatile int died = 0;       /* Thread terminated abnormally */
 
     dJMPENV;
 
 
     dJMPENV;
 
@@ -496,7 +510,7 @@ S_ithread_run(void * arg)
 
     {
         AV *params = thread->params;
 
     {
         AV *params = thread->params;
-        int len = (int)av_len(params)+1;
+        volatile int len = (int)av_len(params)+1;
         int ii;
 
         dSP;
         int ii;
 
         dSP;
@@ -711,7 +725,13 @@ S_ithread_create(
     PERL_SET_CONTEXT(aTHX);
     if (!thread) {
         MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex);
     PERL_SET_CONTEXT(aTHX);
     if (!thread) {
         MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex);
-        PerlLIO_write(PerlIO_fileno(Perl_error_log), PL_no_mem, strlen(PL_no_mem));
+        {
+          int fd = PerlIO_fileno(Perl_error_log);
+          if (fd >= 0) {
+            /* If there's no error_log, we cannot scream about it missing. */
+            PERL_UNUSED_RESULT(PerlLIO_write(fd, PL_no_mem, strlen(PL_no_mem)));
+          }
+        }
         my_exit(1);
     }
     Zero(thread, 1, ithread);
         my_exit(1);
     }
     Zero(thread, 1, ithread);
@@ -1414,7 +1434,7 @@ ithread_kill(...)
         /* Set the signal for the thread */
         thread = S_SV_to_ithread(aTHX_ ST(0));
         MUTEX_LOCK(&thread->mutex);
         /* Set the signal for the thread */
         thread = S_SV_to_ithread(aTHX_ ST(0));
         MUTEX_LOCK(&thread->mutex);
-        if (thread->interp) {
+        if (thread->interp && ! (thread->state & PERL_ITHR_FINISHED)) {
             dTHXa(thread->interp);
             if (PL_psig_pend && PL_psig_ptr[signal]) {
                 PL_psig_pend[signal]++;
             dTHXa(thread->interp);
             if (PL_psig_pend && PL_psig_ptr[signal]) {
                 PL_psig_pend[signal]++;
@@ -1422,7 +1442,7 @@ ithread_kill(...)
                 no_handler = 0;
             }
         } else {
                 no_handler = 0;
             }
         } else {
-            /* Ignore signal to terminated thread */
+            /* Ignore signal to terminated/finished thread */
             no_handler = 0;
         }
         MUTEX_UNLOCK(&thread->mutex);
             no_handler = 0;
         }
         MUTEX_UNLOCK(&thread->mutex);