Remove warnings from tests.
[p5sagit/p5-mst-13.2.git] / ext / threads / threads.xs
index 4e34a40..df2bb67 100755 (executable)
@@ -13,7 +13,7 @@
 #define PERL_THREAD_ALLOC_SPECIFIC(k) \
 STMT_START {\
   if((k = TlsAlloc()) == TLS_OUT_OF_INDEXES) {\
-    PerlIO_printf(PerlIO_stderr(),"panic threads.xs: TlsAlloc");\
+    PerlIO_printf(PerlIO_stderr(), "panic threads.xs: TlsAlloc");\
     exit(1);\
   }\
 } STMT_END
@@ -46,6 +46,11 @@ typedef perl_os_thread pthread_t;
 } STMT_END
 #endif
 #endif
+#ifdef OEMVS
+#   define PERL_THREAD_GETSPECIFIC_THREAD(k, t) STMT_START { void *gsptr; PERL_THREAD_GETSPECIFIC(k, gsptr); t = (ithread *) gsptr; } STMT_END
+#else
+#   define PERL_THREAD_GETSPECIFIC_THREAD(k, t) PERL_THREAD_GETSPECIFIC(k, t)
+#endif
 
 /* Values for 'state' member */
 #define PERL_ITHR_JOINABLE             0
@@ -54,16 +59,16 @@ typedef perl_os_thread pthread_t;
 #define PERL_ITHR_JOINED               2
 
 typedef struct ithread_s {
-    struct ithread_s *next;    /* next thread in the list */
-    struct ithread_s *prev;    /* prev thread in the list */
+    struct ithread_s *next;    /* Next thread in the list */
+    struct ithread_s *prev;    /* Prev thread in the list */
     PerlInterpreter *interp;   /* The threads interpreter */
-    I32 tid;                   /* threads module's thread id */
-    perl_mutex mutex;          /* mutex for updating things in this struct */
-    I32 count;                 /* how many SVs have a reference to us */
-    signed char state;         /* are we detached ? */
+    I32 tid;                   /* Threads module's thread id */
+    perl_mutex mutex;          /* Mutex for updating things in this struct */
+    I32 count;                 /* How many SVs have a reference to us */
+    signed char state;         /* Are we detached ? */
     int gimme;                 /* Context of create */
     SV* init_function;          /* Code to run */
-    SV* params;                 /* args to pass function */
+    SV* params;                 /* Args to pass function */
 #ifdef WIN32
        DWORD   thr;            /* OS's idea if thread id */
        HANDLE handle;          /* OS's waitable handle */
@@ -130,8 +135,11 @@ Perl_ithread_destruct (pTHX_ ithread* thread, const char *why)
        if(thread->interp) {
            dTHXa(thread->interp);
            ithread*        current_thread;
+#ifdef OEMVS
+           void *ptr;
+#endif
            PERL_SET_CONTEXT(thread->interp);
-           PERL_THREAD_GETSPECIFIC(self_key,current_thread);
+           PERL_THREAD_GETSPECIFIC_THREAD(self_key, current_thread);
            PERL_THREAD_SETSPECIFIC(self_key,thread);
 
 
@@ -350,27 +358,19 @@ ithread *
 SV_to_ithread(pTHX_ SV *sv)
 {
     ithread *thread;
-#ifdef OEMVS
-    void *ptr;
-#endif
     if (SvROK(sv))
      {
       thread = INT2PTR(ithread*, SvIV(SvRV(sv)));
      }
     else
      {
-#ifdef OEMVS
-      PERL_THREAD_GETSPECIFIC(self_key,ptr);
-      thread = (ithread *) ptr;
-#else
-      PERL_THREAD_GETSPECIFIC(self_key,thread);
-#endif
+      PERL_THREAD_GETSPECIFIC_THREAD(self_key, thread);
      }
     return thread;
 }
 
 /*
- * iThread->create(); ( aka iThread->new() )
+ * ithread->create(); ( aka ithread->new() )
  * Called in context of parent thread
  */
 
@@ -384,7 +384,7 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param
        SV**            tmps_tmp = PL_tmps_stack;
        I32             tmps_ix  = PL_tmps_ix;
 
-       PERL_THREAD_GETSPECIFIC(self_key,current_thread);
+       PERL_THREAD_GETSPECIFIC_THREAD(self_key, current_thread);
        MUTEX_LOCK(&create_destruct_mutex);
        thread = PerlMemShared_malloc(sizeof(ithread));
        Zero(thread,1,ithread);
@@ -500,13 +500,13 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param
 #  endif
 #  ifdef THREAD_CREATE_NEEDS_STACK
            if(pthread_attr_setstacksize(&attr, THREAD_CREATE_NEEDS_STACK))
-             croak("panic: pthread_attr_setstacksize failed");
+             Perl_croak(aTHX_ "panic: pthread_attr_setstacksize failed");
 #  endif
 
 #ifdef OLD_PTHREADS_API
          pthread_create( &thread->thr, attr, Perl_ithread_run, (void *)thread);
 #else
-#  ifdef PTHREAD_SCOPE_SYSTEM
+#  if defined(HAS_PTHREAD_ATTR_SETSCOPE) && defined(PTHREAD_SCOPE_SYSTEM)
          pthread_attr_setscope( &attr, PTHREAD_SCOPE_SYSTEM );
 #  endif
          pthread_create( &thread->thr, &attr, Perl_ithread_run, (void *)thread);
@@ -524,15 +524,12 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param
 SV*
 Perl_ithread_self (pTHX_ SV *obj, char* Class)
 {
-    ithread *thread;
-#ifdef OEMVS
-    void *ptr;
-    PERL_THREAD_GETSPECIFIC(self_key,ptr);
-    thread = (ithread *) ptr;
-#else
-    PERL_THREAD_GETSPECIFIC(self_key,thread);
-#endif
-    return ithread_to_SV(aTHX_ obj, thread, Class, TRUE);
+   ithread *thread;
+   PERL_THREAD_GETSPECIFIC_THREAD(self_key, thread);
+   if (thread)
+       return ithread_to_SV(aTHX_ obj, thread, Class, TRUE);
+   else
+       Perl_croak(aTHX_ "panic: cannot find thread data");
 }
 
 /*
@@ -589,7 +586,7 @@ Perl_ithread_join(pTHX_ SV *obj)
          clone_params.stashes = newAV();
          clone_params.flags |= CLONEf_JOIN_IN;
          PL_ptr_table = ptr_table_new();
-         PERL_THREAD_GETSPECIFIC(self_key,current_thread);
+         PERL_THREAD_GETSPECIFIC_THREAD(self_key, current_thread);
          PERL_THREAD_SETSPECIFIC(self_key,thread);
 
 #if 0
@@ -618,7 +615,7 @@ Perl_ithread_join(pTHX_ SV *obj)
          PL_ptr_table = NULL;
 
        }
-       /* We have finished with it */
+       /* We are finished with it */
        thread->state |= PERL_ITHR_JOINED;
        MUTEX_UNLOCK(&thread->mutex);
        
@@ -666,7 +663,7 @@ PPCODE:
   MUTEX_LOCK(&create_destruct_mutex);
   curr_thread = threads;
   if(curr_thread->tid != 0)    
-    PUSHs( sv_2mortal(ithread_to_SV(aTHX_ NULL, curr_thread, classname, TRUE)));
+    XPUSHs( sv_2mortal(ithread_to_SV(aTHX_ NULL, curr_thread, classname, TRUE)));
   while(curr_thread) {
     curr_thread = curr_thread->next;
     if(curr_thread == threads)
@@ -674,7 +671,7 @@ PPCODE:
     if(curr_thread->state & PERL_ITHR_DETACHED ||
        curr_thread->state & PERL_ITHR_JOINED)
          continue;
-     PUSHs( sv_2mortal(ithread_to_SV(aTHX_ NULL, curr_thread, classname, TRUE)));
+     XPUSHs( sv_2mortal(ithread_to_SV(aTHX_ NULL, curr_thread, classname, TRUE)));
   }    
   MUTEX_UNLOCK(&create_destruct_mutex);
 }
@@ -739,11 +736,11 @@ BOOT:
        thread->next = thread;
         thread->prev = thread;
        thread->interp = aTHX;
-       thread->count  = 1;  /* imortal */
+       thread->count  = 1;  /* Immortal. */
        thread->tid = tid_counter++;
        known_threads++;
        active_threads++;
-       thread->state = 1;
+       thread->state = PERL_ITHR_DETACHED;
 #ifdef WIN32
        thread->thr = GetCurrentThreadId();
 #else