contrib/perl5/ext/Thread/Thread.xs

   1 #include "EXTERN.h"
   2 #include "perl.h"
   3 #include "XSUB.h"
   4
   5 /* Magic signature for Thread's mg_private is "Th" */
   6 #define Thread_MAGIC_SIGNATURE 0x5468
   7
   8 #ifdef __cplusplus
   9 #ifdef I_UNISTD
  10 #include <unistd.h>
  11 #endif
  12 #endif
  13 #include <fcntl.h>
  14
  15 static int sig_pipe[2];
  16
  17 #ifndef THREAD_RET_TYPE
  18 #define THREAD_RET_TYPE void *
  19 #define THREAD_RET_CAST(x) ((THREAD_RET_TYPE) x)
  20 #endif
  21
  22 static void
  23 remove_thread(struct perl_thread *t)
  24 {
  25 #ifdef USE_THREADS
  26     DEBUG_S(WITH_THR(PerlIO_printf(PerlIO_stderr(),
  27                                    "%p: remove_thread %p\n", thr, t)));
  28     MUTEX_LOCK(&PL_threads_mutex);
  29     MUTEX_DESTROY(&t->mutex);
  30     PL_nthreads--;
  31     t->prev->next = t->next;
  32     t->next->prev = t->prev;
  33     COND_BROADCAST(&PL_nthreads_cond);
  34     MUTEX_UNLOCK(&PL_threads_mutex);
  35 #endif
  36 }
  37
  38 static THREAD_RET_TYPE
  39 threadstart(void *arg)
  40 {
  41 #ifdef USE_THREADS
  42 #ifdef FAKE_THREADS
  43     Thread savethread = thr;
  44     LOGOP myop;
  45     dSP;
  46     I32 oldscope = PL_scopestack_ix;
  47     I32 retval;
  48     AV *av;
  49     int i;
  50
  51     DEBUG_S(PerlIO_printf(PerlIO_stderr(), "new thread %p starting at %s\n",
  52                           thr, SvPEEK(TOPs)));
  53     thr = (Thread) arg;
  54     savemark = TOPMARK;
  55     thr->prev = thr->prev_run = savethread;
  56     thr->next = savethread->next;
  57     thr->next_run = savethread->next_run;
  58     savethread->next = savethread->next_run = thr;
  59     thr->wait_queue = 0;
  60     thr->private = 0;
  61
  62     /* Now duplicate most of perl_call_sv but with a few twists */
  63     PL_op = (OP*)&myop;
  64     Zero(PL_op, 1, LOGOP);
  65     myop.op_flags = OPf_STACKED;
  66     myop.op_next = Nullop;
  67     myop.op_flags |= OPf_KNOW;
  68     myop.op_flags |= OPf_WANT_LIST;
  69     PL_op = pp_entersub(ARGS);
  70     DEBUG_S(if (!PL_op)
  71             PerlIO_printf(PerlIO_stderr(), "thread starts at Nullop\n"));
  72     /*
  73      * When this thread is next scheduled, we start in the right
  74      * place. When the thread runs off the end of the sub, perl.c
  75      * handles things, using savemark to figure out how much of the
  76      * stack is the return value for any join.
  77      */
  78     thr = savethread;           /* back to the old thread */
  79     return 0;
  80 #else
  81     Thread thr = (Thread) arg;
  82     LOGOP myop;
  83     djSP;
  84     I32 oldmark = TOPMARK;
  85     I32 oldscope = PL_scopestack_ix;
  86     I32 retval;
  87     SV *sv;
  88     AV *av = newAV();
  89     int i, ret;
  90     dJMPENV;
  91     DEBUG_S(PerlIO_printf(PerlIO_stderr(), "new thread %p waiting to start\n",
  92                           thr));
  93
  94     /* Don't call *anything* requiring dTHR until after SET_THR() */
  95     /*
  96      * Wait until our creator releases us. If we didn't do this, then
  97      * it would be potentially possible for out thread to carry on and
  98      * do stuff before our creator fills in our "self" field. For example,
  99      * if we went and created another thread which tried to JOIN with us,
 100      * then we'd be in a mess.
 101      */
 102     MUTEX_LOCK(&thr->mutex);
 103     MUTEX_UNLOCK(&thr->mutex);
 104
 105     /*
 106      * It's safe to wait until now to set the thread-specific pointer
 107      * from our pthread_t structure to our struct perl_thread, since
 108      * we're the only thread who can get at it anyway.
 109      */
 110     SET_THR(thr);
 111
 112     /* Only now can we use SvPEEK (which calls sv_newmortal which does dTHR) */
 113     DEBUG_S(PerlIO_printf(PerlIO_stderr(), "new thread %p starting at %s\n",
 114                           thr, SvPEEK(TOPs)));
 115
 116     sv = POPs;
 117     PUTBACK;
 118     ENTER;
 119     SAVETMPS;
 120     perl_call_sv(sv, G_ARRAY|G_EVAL);
 121     SPAGAIN;
 122     retval = SP - (PL_stack_base + oldmark);
 123     SP = PL_stack_base + oldmark + 1;
 124     if (SvCUR(thr->errsv)) {
 125         STRLEN n_a;
 126         MUTEX_LOCK(&thr->mutex);
 127         thr->flags |= THRf_DID_DIE;
 128         MUTEX_UNLOCK(&thr->mutex);
 129         av_store(av, 0, &PL_sv_no);
 130         av_store(av, 1, newSVsv(thr->errsv));
 131         DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p died: %s\n",
 132                               thr, SvPV(thr->errsv, n_a)));
 133     } else {
 134         DEBUG_S(STMT_START {
 135             for (i = 1; i <= retval; i++) {
 136                 PerlIO_printf(PerlIO_stderr(), "%p return[%d] = %s\n",
 137                                 thr, i, SvPEEK(SP[i - 1]));
 138             }
 139         } STMT_END);
 140         av_store(av, 0, &PL_sv_yes);
 141         for (i = 1; i <= retval; i++, SP++)
 142             sv_setsv(*av_fetch(av, i, TRUE), SvREFCNT_inc(*SP));
 143     }
 144     FREETMPS;
 145     LEAVE;
 146
 147   finishoff:
 148 #if 0
 149     /* removed for debug */
 150     SvREFCNT_dec(PL_curstack);
 151 #endif
 152     SvREFCNT_dec(thr->cvcache);
 153     SvREFCNT_dec(thr->threadsv);
 154     SvREFCNT_dec(thr->specific);
 155     SvREFCNT_dec(thr->errsv);
 156     SvREFCNT_dec(thr->errhv);
 157
 158     /*Safefree(cxstack);*/
 159     while (PL_curstackinfo->si_next)
 160         PL_curstackinfo = PL_curstackinfo->si_next;
 161     while (PL_curstackinfo) {
 162         PERL_SI *p = PL_curstackinfo->si_prev;
 163         SvREFCNT_dec(PL_curstackinfo->si_stack);
 164         Safefree(PL_curstackinfo->si_cxstack);
 165         Safefree(PL_curstackinfo);
 166         PL_curstackinfo = p;
 167     }
 168     Safefree(PL_markstack);
 169     Safefree(PL_scopestack);
 170     Safefree(PL_savestack);
 171     Safefree(PL_retstack);
 172     Safefree(PL_tmps_stack);
 173     Safefree(PL_ofs);
 174
 175     SvREFCNT_dec(PL_rs);
 176     SvREFCNT_dec(PL_nrs);
 177     SvREFCNT_dec(PL_statname);
 178     Safefree(PL_screamfirst);
 179     Safefree(PL_screamnext);
 180     Safefree(PL_reg_start_tmp);
 181     SvREFCNT_dec(PL_lastscream);
 182     SvREFCNT_dec(PL_defoutgv);
 183
 184     MUTEX_LOCK(&thr->mutex);
 185     DEBUG_S(PerlIO_printf(PerlIO_stderr(),
 186                           "%p: threadstart finishing: state is %u\n",
 187                           thr, ThrSTATE(thr)));
 188     switch (ThrSTATE(thr)) {
 189     case THRf_R_JOINABLE:
 190         ThrSETSTATE(thr, THRf_ZOMBIE);
 191         MUTEX_UNLOCK(&thr->mutex);
 192         DEBUG_S(PerlIO_printf(PerlIO_stderr(),
 193                               "%p: R_JOINABLE thread finished\n", thr));
 194         break;
 195     case THRf_R_JOINED:
 196         ThrSETSTATE(thr, THRf_DEAD);
 197         MUTEX_UNLOCK(&thr->mutex);
 198         remove_thread(thr);
 199         DEBUG_S(PerlIO_printf(PerlIO_stderr(),
 200                               "%p: R_JOINED thread finished\n", thr));
 201         break;
 202     case THRf_R_DETACHED:
 203         ThrSETSTATE(thr, THRf_DEAD);
 204         MUTEX_UNLOCK(&thr->mutex);
 205         SvREFCNT_dec(av);
 206         DEBUG_S(PerlIO_printf(PerlIO_stderr(),
 207                               "%p: DETACHED thread finished\n", thr));
 208         remove_thread(thr);     /* This might trigger main thread to finish */
 209         break;
 210     default:
 211         MUTEX_UNLOCK(&thr->mutex);
 212         croak("panic: illegal state %u at end of threadstart", ThrSTATE(thr));
 213         /* NOTREACHED */
 214     }
 215     return THREAD_RET_CAST(av); /* Available for anyone to join with */
 216                                         /* us unless we're detached, in which */
 217                                         /* case noone sees the value anyway. */
 218 #endif
 219 #else
 220     return THREAD_RET_CAST(NULL);
 221 #endif
 222 }
 223
 224 static SV *
 225 newthread (SV *startsv, AV *initargs, char *classname)
 226 {
 227 #ifdef USE_THREADS
 228     dSP;
 229     Thread savethread;
 230     int i;
 231     SV *sv;
 232     int err;
 233 #ifndef THREAD_CREATE
 234     static pthread_attr_t attr;
 235     static int attr_inited = 0;
 236     sigset_t fullmask, oldmask;
 237 #endif
 238
 239     savethread = thr;
 240     thr = new_struct_thread(thr);
 241     /* temporarily pretend to be the child thread in case the
 242      * XPUSHs() below want to grow the child's stack.  This is
 243      * safe, since the other thread is not yet created, and we
 244      * are the only ones who know about it */
 245     SET_THR(thr);
 246     SPAGAIN;
 247     DEBUG_S(PerlIO_printf(PerlIO_stderr(),
 248                           "%p: newthread (%p), tid is %u, preparing stack\n",
 249                           savethread, thr, thr->tid));
 250     /* The following pushes the arg list and startsv onto the *new* stack */
 251     PUSHMARK(SP);
 252     /* Could easily speed up the following greatly */
 253     for (i = 0; i <= AvFILL(initargs); i++)
 254         XPUSHs(SvREFCNT_inc(*av_fetch(initargs, i, FALSE)));
 255     XPUSHs(SvREFCNT_inc(startsv));
 256     PUTBACK;
 257
 258     /* On your marks... */
 259     SET_THR(savethread);
 260     MUTEX_LOCK(&thr->mutex);
 261
 262 #ifdef THREAD_CREATE
 263     err = THREAD_CREATE(thr, threadstart);
 264 #else
 265     /* Get set...  */
 266     sigfillset(&fullmask);
 267     if (sigprocmask(SIG_SETMASK, &fullmask, &oldmask) == -1)
 268         croak("panic: sigprocmask");
 269     err = 0;
 270     if (!attr_inited) {
 271         attr_inited = 1;
 272 #ifdef OLD_PTHREADS_API
 273         err = pthread_attr_create(&attr);
 274 #else
 275         err = pthread_attr_init(&attr);
 276 #endif
 277 #ifdef OLD_PTHREADS_API
 278 #ifdef VMS
 279 /* This is available with the old pthreads API, but only with */
 280 /* DecThreads (VMS and Digital Unix) */
 281         if (err == 0)
 282             err = pthread_attr_setdetach_np(&attr, ATTR_JOINABLE);
 283 #endif
 284 #else
 285         if (err == 0)
 286             err = pthread_attr_setdetachstate(&attr, ATTR_JOINABLE);
 287 #endif
 288     }
 289     if (err == 0)
 290 #ifdef OLD_PTHREADS_API
 291         err = pthread_create(&thr->self, attr, threadstart, (void*) thr);
 292 #else
 293         err = pthread_create(&thr->self, &attr, threadstart, (void*) thr);
 294 #endif
 295 #endif
 296     if (err) {
 297         MUTEX_UNLOCK(&thr->mutex);
 298         DEBUG_S(PerlIO_printf(PerlIO_stderr(),
 299                               "%p: create of %p failed %d\n",
 300                               savethread, thr, err));
 301         /* Thread creation failed--clean up */
 302         SvREFCNT_dec(thr->cvcache);
 303         remove_thread(thr);
 304         MUTEX_DESTROY(&thr->mutex);
 305         for (i = 0; i <= AvFILL(initargs); i++)
 306             SvREFCNT_dec(*av_fetch(initargs, i, FALSE));
 307         SvREFCNT_dec(startsv);
 308         return NULL;
 309     }
 310
 311 #ifdef THREAD_POST_CREATE
 312     THREAD_POST_CREATE(thr);
 313 #else
 314     if (sigprocmask(SIG_SETMASK, &oldmask, 0))
 315         croak("panic: sigprocmask");
 316 #endif
 317
 318     sv = newSViv(thr->tid);
 319     sv_magic(sv, thr->oursv, '~', 0, 0);
 320     SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE;
 321     sv = sv_bless(newRV_noinc(sv), gv_stashpv(classname, TRUE));
 322
 323     /* Go */
 324     MUTEX_UNLOCK(&thr->mutex);
 325
 326     return sv;
 327 #else
 328     croak("No threads in this perl");
 329     return &PL_sv_undef;
 330 #endif
 331 }
 332
 333 static Signal_t handle_thread_signal _((int sig));
 334
 335 static Signal_t
 336 handle_thread_signal(int sig)
 337 {
 338     unsigned char c = (unsigned char) sig;
 339     /*
 340      * We're not really allowed to call fprintf in a signal handler
 341      * so don't be surprised if this isn't robust while debugging
 342      * with -DL.
 343      */
 344     DEBUG_S(PerlIO_printf(PerlIO_stderr(),
 345             "handle_thread_signal: got signal %d\n", sig););
 346     write(sig_pipe[1], &c, 1);
 347 }
 348
 349 MODULE = Thread         PACKAGE = Thread
 350 PROTOTYPES: DISABLE
 351
 352 void
 353 new(classname, startsv, ...)
 354         char *          classname
 355         SV *            startsv
 356         AV *            av = av_make(items - 2, &ST(2));
 357     PPCODE:
 358         XPUSHs(sv_2mortal(newthread(startsv, av, classname)));
 359
 360 void
 361 join(t)
 362         Thread  t
 363         AV *    av = NO_INIT
 364         int     i = NO_INIT
 365     PPCODE:
 366 #ifdef USE_THREADS
 367         DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: joining %p (state %u)\n",
 368                               thr, t, ThrSTATE(t)););
 369         MUTEX_LOCK(&t->mutex);
 370         switch (ThrSTATE(t)) {
 371         case THRf_R_JOINABLE:
 372         case THRf_R_JOINED:
 373             ThrSETSTATE(t, THRf_R_JOINED);
 374             MUTEX_UNLOCK(&t->mutex);
 375             break;
 376         case THRf_ZOMBIE:
 377             ThrSETSTATE(t, THRf_DEAD);
 378             MUTEX_UNLOCK(&t->mutex);
 379             remove_thread(t);
 380             break;
 381         default:
 382             MUTEX_UNLOCK(&t->mutex);
 383             croak("can't join with thread");
 384             /* NOTREACHED */
 385         }
 386         JOIN(t, &av);
 387
 388         if (SvTRUE(*av_fetch(av, 0, FALSE))) {
 389             /* Could easily speed up the following if necessary */
 390             for (i = 1; i <= AvFILL(av); i++)
 391                 XPUSHs(sv_2mortal(*av_fetch(av, i, FALSE)));
 392         } else {
 393             STRLEN n_a;
 394             char *mess = SvPV(*av_fetch(av, 1, FALSE), n_a);
 395             DEBUG_S(PerlIO_printf(PerlIO_stderr(),
 396                                   "%p: join propagating die message: %s\n",
 397                                   thr, mess));
 398             croak(mess);
 399         }
 400 #endif
 401
 402 void
 403 detach(t)
 404         Thread  t
 405     CODE:
 406 #ifdef USE_THREADS
 407         DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: detaching %p (state %u)\n",
 408                               thr, t, ThrSTATE(t)););
 409         MUTEX_LOCK(&t->mutex);
 410         switch (ThrSTATE(t)) {
 411         case THRf_R_JOINABLE:
 412             ThrSETSTATE(t, THRf_R_DETACHED);
 413             /* fall through */
 414         case THRf_R_DETACHED:
 415             DETACH(t);
 416             MUTEX_UNLOCK(&t->mutex);
 417             break;
 418         case THRf_ZOMBIE:
 419             ThrSETSTATE(t, THRf_DEAD);
 420             DETACH(t);
 421             MUTEX_UNLOCK(&t->mutex);
 422             remove_thread(t);
 423             break;
 424         default:
 425             MUTEX_UNLOCK(&t->mutex);
 426             croak("can't detach thread");
 427             /* NOTREACHED */
 428         }
 429 #endif
 430
 431 void
 432 equal(t1, t2)
 433         Thread  t1
 434         Thread  t2
 435     PPCODE:
 436         PUSHs((t1 == t2) ? &PL_sv_yes : &PL_sv_no);
 437
 438 void
 439 flags(t)
 440         Thread  t
 441     PPCODE:
 442 #ifdef USE_THREADS
 443         PUSHs(sv_2mortal(newSViv(t->flags)));
 444 #endif
 445
 446 void
 447 self(classname)
 448         char *  classname
 449     PREINIT:
 450         SV *sv;
 451     PPCODE:
 452 #ifdef USE_THREADS
 453         sv = newSViv(thr->tid);
 454         sv_magic(sv, thr->oursv, '~', 0, 0);
 455         SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE;
 456         PUSHs(sv_2mortal(sv_bless(newRV_noinc(sv),
 457                                   gv_stashpv(classname, TRUE))));
 458 #endif
 459
 460 U32
 461 tid(t)
 462         Thread  t
 463     CODE:
 464 #ifdef USE_THREADS
 465         MUTEX_LOCK(&t->mutex);
 466         RETVAL = t->tid;
 467         MUTEX_UNLOCK(&t->mutex);
 468 #else
 469         RETVAL = 0;
 470 #endif
 471     OUTPUT:
 472         RETVAL
 473
 474 void
 475 DESTROY(t)
 476         SV *    t
 477     PPCODE:
 478         PUSHs(&PL_sv_yes);
 479
 480 void
 481 yield()
 482     CODE:
 483 {
 484 #ifdef USE_THREADS
 485         YIELD;
 486 #endif
 487 }
 488
 489 void
 490 cond_wait(sv)
 491         SV *    sv
 492         MAGIC * mg = NO_INIT
 493 CODE:
 494 #ifdef USE_THREADS
 495         if (SvROK(sv))
 496             sv = SvRV(sv);
 497
 498         mg = condpair_magic(sv);
 499         DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: cond_wait %p\n", thr, sv));
 500         MUTEX_LOCK(MgMUTEXP(mg));
 501         if (MgOWNER(mg) != thr) {
 502             MUTEX_UNLOCK(MgMUTEXP(mg));
 503             croak("cond_wait for lock that we don't own\n");
 504         }
 505         MgOWNER(mg) = 0;
 506         COND_SIGNAL(MgOWNERCONDP(mg));
 507         COND_WAIT(MgCONDP(mg), MgMUTEXP(mg));
 508         while (MgOWNER(mg))
 509             COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
 510         MgOWNER(mg) = thr;
 511         MUTEX_UNLOCK(MgMUTEXP(mg));
 512 #endif
 513
 514 void
 515 cond_signal(sv)
 516         SV *    sv
 517         MAGIC * mg = NO_INIT
 518 CODE:
 519 #ifdef USE_THREADS
 520         if (SvROK(sv))
 521             sv = SvRV(sv);
 522
 523         mg = condpair_magic(sv);
 524         DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: cond_signal %p\n",thr,sv));
 525         MUTEX_LOCK(MgMUTEXP(mg));
 526         if (MgOWNER(mg) != thr) {
 527             MUTEX_UNLOCK(MgMUTEXP(mg));
 528             croak("cond_signal for lock that we don't own\n");
 529         }
 530         COND_SIGNAL(MgCONDP(mg));
 531         MUTEX_UNLOCK(MgMUTEXP(mg));
 532 #endif
 533
 534 void
 535 cond_broadcast(sv)
 536         SV *    sv
 537         MAGIC * mg = NO_INIT
 538 CODE:
 539 #ifdef USE_THREADS
 540         if (SvROK(sv))
 541             sv = SvRV(sv);
 542
 543         mg = condpair_magic(sv);
 544         DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: cond_broadcast %p\n",
 545                               thr, sv));
 546         MUTEX_LOCK(MgMUTEXP(mg));
 547         if (MgOWNER(mg) != thr) {
 548             MUTEX_UNLOCK(MgMUTEXP(mg));
 549             croak("cond_broadcast for lock that we don't own\n");
 550         }
 551         COND_BROADCAST(MgCONDP(mg));
 552         MUTEX_UNLOCK(MgMUTEXP(mg));
 553 #endif
 554
 555 void
 556 list(classname)
 557         char *  classname
 558     PREINIT:
 559         Thread  t;
 560         AV *    av;
 561         SV **   svp;
 562         int     n = 0;
 563     PPCODE:
 564 #ifdef USE_THREADS
 565         av = newAV();
 566         /*
 567          * Iterate until we have enough dynamic storage for all threads.
 568          * We mustn't do any allocation while holding threads_mutex though.
 569          */
 570         MUTEX_LOCK(&PL_threads_mutex);
 571         do {
 572             n = PL_nthreads;
 573             MUTEX_UNLOCK(&PL_threads_mutex);
 574             if (AvFILL(av) < n - 1) {
 575                 int i = AvFILL(av);
 576                 for (i = AvFILL(av); i < n - 1; i++) {
 577                     SV *sv = newSViv(0);        /* fill in tid later */
 578                     sv_magic(sv, 0, '~', 0, 0); /* fill in other magic later */
 579                     av_push(av, sv_bless(newRV_noinc(sv),
 580                                          gv_stashpv(classname, TRUE)));
 581
 582                 }
 583             }
 584             MUTEX_LOCK(&PL_threads_mutex);
 585         } while (n < PL_nthreads);
 586         n = PL_nthreads;        /* Get the final correct value */
 587
 588         /*
 589          * At this point, there's enough room to fill in av.
 590          * Note that we are holding threads_mutex so the list
 591          * won't change out from under us but all the remaining
 592          * processing is "fast" (no blocking, malloc etc.)
 593          */
 594         t = thr;
 595         svp = AvARRAY(av);
 596         do {
 597             SV *sv = (SV*)SvRV(*svp);
 598             sv_setiv(sv, t->tid);
 599             SvMAGIC(sv)->mg_obj = SvREFCNT_inc(t->oursv);
 600             SvMAGIC(sv)->mg_flags |= MGf_REFCOUNTED;
 601             SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE;
 602             t = t->next;
 603             svp++;
 604         } while (t != thr);
 605         /*  */
 606         MUTEX_UNLOCK(&PL_threads_mutex);
 607         /* Truncate any unneeded slots in av */
 608         av_fill(av, n - 1);
 609         /* Finally, push all the new objects onto the stack and drop av */
 610         EXTEND(SP, n);
 611         for (svp = AvARRAY(av); n > 0; n--, svp++)
 612             PUSHs(*svp);
 613         (void)sv_2mortal((SV*)av);
 614 #endif
 615
 616
 617 MODULE = Thread         PACKAGE = Thread::Signal
 618
 619 void
 620 kill_sighandler_thread()
 621     PPCODE:
 622         write(sig_pipe[1], "\0", 1);
 623         PUSHs(&PL_sv_yes);
 624
 625 void
 626 init_thread_signals()
 627     PPCODE:
 628         PL_sighandlerp = handle_thread_signal;
 629         if (pipe(sig_pipe) == -1)
 630             XSRETURN_UNDEF;
 631         PUSHs(&PL_sv_yes);
 632
 633 void
 634 await_signal()
 635     PREINIT:
 636         unsigned char c;
 637         SSize_t ret;
 638     CODE:
 639         do {
 640             ret = read(sig_pipe[0], &c, 1);
 641         } while (ret == -1 && errno == EINTR);
 642         if (ret == -1)
 643             croak("panic: await_signal");
 644         ST(0) = sv_newmortal();
 645         if (ret)
 646             sv_setsv(ST(0), c ? psig_ptr[c] : &PL_sv_no);
 647         DEBUG_S(PerlIO_printf(PerlIO_stderr(),
 648                               "await_signal returning %s\n", SvPEEK(ST(0))););
 649
 650 MODULE = Thread         PACKAGE = Thread::Specific
 651
 652 void
 653 data(classname = "Thread::Specific")
 654         char *  classname
 655     PPCODE:
 656 #ifdef USE_THREADS
 657         if (AvFILL(thr->specific) == -1) {
 658             GV *gv = gv_fetchpv("Thread::Specific::FIELDS", TRUE, SVt_PVHV);
 659             av_store(thr->specific, 0, newRV((SV*)GvHV(gv)));
 660         }
 661         XPUSHs(sv_bless(newRV((SV*)thr->specific),gv_stashpv(classname,TRUE)));
 662 #endif