ext/Thread/Thread.xs

   1 #define PERL_NO_GET_CONTEXT
   2 #include "EXTERN.h"
   3 #include "perl.h"
   4 #include "XSUB.h"
   5
   6 /* Magic signature for Thread's mg_private is "Th" */
   7 #define Thread_MAGIC_SIGNATURE 0x5468
   8
   9 #ifdef __cplusplus
  10 #ifdef I_UNISTD
  11 #include <unistd.h>
  12 #endif
  13 #endif
  14 #include <fcntl.h>
  15
  16 static int sig_pipe[2];
  17
  18 #ifndef THREAD_RET_TYPE
  19 #define THREAD_RET_TYPE void *
  20 #define THREAD_RET_CAST(x) ((THREAD_RET_TYPE) x)
  21 #endif
  22
  23 static void
  24 remove_thread(pTHX_ struct perl_thread *t)
  25 {
  26 #ifdef USE_THREADS
  27     DEBUG_S(WITH_THR(PerlIO_printf(Perl_debug_log,
  28                                    "%p: remove_thread %p\n", thr, t)));
  29     MUTEX_LOCK(&PL_threads_mutex);
  30     MUTEX_DESTROY(&t->mutex);
  31     PL_nthreads--;
  32     t->prev->next = t->next;
  33     t->next->prev = t->prev;
  34     COND_BROADCAST(&PL_nthreads_cond);
  35     MUTEX_UNLOCK(&PL_threads_mutex);
  36 #endif
  37 }
  38
  39 static THREAD_RET_TYPE
  40 threadstart(void *arg)
  41 {
  42 #ifdef USE_THREADS
  43 #ifdef FAKE_THREADS
  44     Thread savethread = thr;
  45     LOGOP myop;
  46     dSP;
  47     I32 oldscope = PL_scopestack_ix;
  48     I32 retval;
  49     AV *av;
  50     int i;
  51
  52     DEBUG_S(PerlIO_printf(Perl_debug_log, "new thread %p starting at %s\n",
  53                           thr, SvPEEK(TOPs)));
  54     thr = (Thread) arg;
  55     savemark = TOPMARK;
  56     thr->prev = thr->prev_run = savethread;
  57     thr->next = savethread->next;
  58     thr->next_run = savethread->next_run;
  59     savethread->next = savethread->next_run = thr;
  60     thr->wait_queue = 0;
  61     thr->private = 0;
  62
  63     /* Now duplicate most of perl_call_sv but with a few twists */
  64     PL_op = (OP*)&myop;
  65     Zero(PL_op, 1, LOGOP);
  66     myop.op_flags = OPf_STACKED;
  67     myop.op_next = Nullop;
  68     myop.op_flags |= OPf_KNOW;
  69     myop.op_flags |= OPf_WANT_LIST;
  70     PL_op = pp_entersub(ARGS);
  71     DEBUG_S(if (!PL_op)
  72             PerlIO_printf(Perl_debug_log, "thread starts at Nullop\n"));
  73     /*
  74      * When this thread is next scheduled, we start in the right
  75      * place. When the thread runs off the end of the sub, perl.c
  76      * handles things, using savemark to figure out how much of the
  77      * stack is the return value for any join.
  78      */
  79     thr = savethread;           /* back to the old thread */
  80     return 0;
  81 #else
  82     Thread thr = (Thread) arg;
  83     LOGOP myop;
  84     djSP;
  85     I32 oldmark = TOPMARK;
  86     I32 oldscope = PL_scopestack_ix;
  87     I32 retval;
  88     SV *sv;
  89     AV *av;
  90     int i, ret;
  91     dJMPENV;
  92
  93 #if defined(MULTIPLICITY)
  94     PERL_SET_INTERP(thr->interp);
  95 #endif
  96
  97     DEBUG_S(PerlIO_printf(Perl_debug_log, "new thread %p waiting to start\n",
  98                           thr));
  99
 100     /* Don't call *anything* requiring dTHR until after SET_THR() */
 101     /*
 102      * Wait until our creator releases us. If we didn't do this, then
 103      * it would be potentially possible for out thread to carry on and
 104      * do stuff before our creator fills in our "self" field. For example,
 105      * if we went and created another thread which tried to JOIN with us,
 106      * then we'd be in a mess.
 107      */
 108     MUTEX_LOCK(&thr->mutex);
 109     MUTEX_UNLOCK(&thr->mutex);
 110
 111     /*
 112      * It's safe to wait until now to set the thread-specific pointer
 113      * from our pthread_t structure to our struct perl_thread, since
 114      * we're the only thread who can get at it anyway.
 115      */
 116     SET_THR(thr);
 117
 118     /* Only now can we use SvPEEK (which calls sv_newmortal which does dTHR) */
 119     DEBUG_S(PerlIO_printf(Perl_debug_log, "new thread %p starting at %s\n",
 120                           thr, SvPEEK(TOPs)));
 121
 122     av = newAV();
 123     sv = POPs;
 124     PUTBACK;
 125     ENTER;
 126     SAVETMPS;
 127     perl_call_sv(sv, G_ARRAY|G_EVAL);
 128     SPAGAIN;
 129     retval = SP - (PL_stack_base + oldmark);
 130     SP = PL_stack_base + oldmark + 1;
 131     if (SvCUR(thr->errsv)) {
 132         MUTEX_LOCK(&thr->mutex);
 133         thr->flags |= THRf_DID_DIE;
 134         MUTEX_UNLOCK(&thr->mutex);
 135         av_store(av, 0, &PL_sv_no);
 136         av_store(av, 1, newSVsv(thr->errsv));
 137         DEBUG_S(PerlIO_printf(Perl_debug_log, "%p died: %s\n",
 138                               thr, SvPV(thr->errsv, PL_na)));
 139     } else {
 140         DEBUG_S(STMT_START {
 141             for (i = 1; i <= retval; i++) {
 142                 PerlIO_printf(Perl_debug_log, "%p return[%d] = %s\n",
 143                                 thr, i, SvPEEK(SP[i - 1]));
 144             }
 145         } STMT_END);
 146         av_store(av, 0, &PL_sv_yes);
 147         for (i = 1; i <= retval; i++, SP++)
 148             sv_setsv(*av_fetch(av, i, TRUE), SvREFCNT_inc(*SP));
 149     }
 150     FREETMPS;
 151     LEAVE;
 152
 153   finishoff:
 154 #if 0
 155     /* removed for debug */
 156     SvREFCNT_dec(PL_curstack);
 157 #endif
 158     SvREFCNT_dec(thr->cvcache);
 159     SvREFCNT_dec(thr->threadsv);
 160     SvREFCNT_dec(thr->specific);
 161     SvREFCNT_dec(thr->errsv);
 162
 163     /*Safefree(cxstack);*/
 164     while (PL_curstackinfo->si_next)
 165         PL_curstackinfo = PL_curstackinfo->si_next;
 166     while (PL_curstackinfo) {
 167         PERL_SI *p = PL_curstackinfo->si_prev;
 168         SvREFCNT_dec(PL_curstackinfo->si_stack);
 169         Safefree(PL_curstackinfo->si_cxstack);
 170         Safefree(PL_curstackinfo);
 171         PL_curstackinfo = p;
 172     }
 173     Safefree(PL_markstack);
 174     Safefree(PL_scopestack);
 175     Safefree(PL_savestack);
 176     Safefree(PL_retstack);
 177     Safefree(PL_tmps_stack);
 178     Safefree(PL_ofs);
 179
 180     SvREFCNT_dec(PL_rs);
 181     SvREFCNT_dec(PL_nrs);
 182     SvREFCNT_dec(PL_statname);
 183     SvREFCNT_dec(PL_errors);
 184     Safefree(PL_screamfirst);
 185     Safefree(PL_screamnext);
 186     Safefree(PL_reg_start_tmp);
 187     SvREFCNT_dec(PL_lastscream);
 188     SvREFCNT_dec(PL_defoutgv);
 189     Safefree(PL_reg_poscache);
 190
 191     MUTEX_LOCK(&thr->mutex);
 192     DEBUG_S(PerlIO_printf(Perl_debug_log,
 193                           "%p: threadstart finishing: state is %u\n",
 194                           thr, ThrSTATE(thr)));
 195     switch (ThrSTATE(thr)) {
 196     case THRf_R_JOINABLE:
 197         ThrSETSTATE(thr, THRf_ZOMBIE);
 198         MUTEX_UNLOCK(&thr->mutex);
 199         DEBUG_S(PerlIO_printf(Perl_debug_log,
 200                               "%p: R_JOINABLE thread finished\n", thr));
 201         break;
 202     case THRf_R_JOINED:
 203         ThrSETSTATE(thr, THRf_DEAD);
 204         MUTEX_UNLOCK(&thr->mutex);
 205         remove_thread(aTHX_ thr);
 206         DEBUG_S(PerlIO_printf(Perl_debug_log,
 207                               "%p: R_JOINED thread finished\n", thr));
 208         break;
 209     case THRf_R_DETACHED:
 210         ThrSETSTATE(thr, THRf_DEAD);
 211         MUTEX_UNLOCK(&thr->mutex);
 212         SvREFCNT_dec(av);
 213         DEBUG_S(PerlIO_printf(Perl_debug_log,
 214                               "%p: DETACHED thread finished\n", thr));
 215         remove_thread(aTHX_ thr);       /* This might trigger main thread to finish */
 216         break;
 217     default:
 218         MUTEX_UNLOCK(&thr->mutex);
 219         croak("panic: illegal state %u at end of threadstart", ThrSTATE(thr));
 220         /* NOTREACHED */
 221     }
 222     return THREAD_RET_CAST(av); /* Available for anyone to join with */
 223                                         /* us unless we're detached, in which */
 224                                         /* case noone sees the value anyway. */
 225 #endif
 226 #else
 227     return THREAD_RET_CAST(NULL);
 228 #endif
 229 }
 230
 231 static SV *
 232 newthread (pTHX_ SV *startsv, AV *initargs, char *classname)
 233 {
 234 #ifdef USE_THREADS
 235     dSP;
 236     Thread savethread;
 237     int i;
 238     SV *sv;
 239     int err;
 240 #ifndef THREAD_CREATE
 241     static pthread_attr_t attr;
 242     static int attr_inited = 0;
 243     sigset_t fullmask, oldmask;
 244     static int attr_joinable = PTHREAD_CREATE_JOINABLE;
 245 #endif
 246
 247     savethread = thr;
 248     thr = new_struct_thread(thr);
 249     /* temporarily pretend to be the child thread in case the
 250      * XPUSHs() below want to grow the child's stack.  This is
 251      * safe, since the other thread is not yet created, and we
 252      * are the only ones who know about it */
 253     SET_THR(thr);
 254     SPAGAIN;
 255     DEBUG_S(PerlIO_printf(Perl_debug_log,
 256                           "%p: newthread (%p), tid is %u, preparing stack\n",
 257                           savethread, thr, thr->tid));
 258     /* The following pushes the arg list and startsv onto the *new* stack */
 259     PUSHMARK(SP);
 260     /* Could easily speed up the following greatly */
 261     for (i = 0; i <= AvFILL(initargs); i++)
 262         XPUSHs(SvREFCNT_inc(*av_fetch(initargs, i, FALSE)));
 263     XPUSHs(SvREFCNT_inc(startsv));
 264     PUTBACK;
 265
 266     /* On your marks... */
 267     SET_THR(savethread);
 268     MUTEX_LOCK(&thr->mutex);
 269
 270 #ifdef THREAD_CREATE
 271     err = THREAD_CREATE(thr, threadstart);
 272 #else
 273     /* Get set...  */
 274     sigfillset(&fullmask);
 275     if (sigprocmask(SIG_SETMASK, &fullmask, &oldmask) == -1)
 276         croak("panic: sigprocmask");
 277     err = 0;
 278     if (!attr_inited) {
 279         attr_inited = 1;
 280         err = pthread_attr_init(&attr);
 281 #  ifdef PTHREAD_ATTR_SETDETACHSTATE
 282         if (err == 0)
 283             err = PTHREAD_ATTR_SETDETACHSTATE(&attr, attr_joinable);
 284
 285 #  else
 286         croak("panic: can't pthread_attr_setdetachstate");
 287 #  endif
 288     }
 289     if (err == 0)
 290         err = PTHREAD_CREATE(&thr->self, attr, threadstart, (void*) thr);
 291 #endif
 292
 293     if (err) {
 294         MUTEX_UNLOCK(&thr->mutex);
 295         DEBUG_S(PerlIO_printf(Perl_debug_log,
 296                               "%p: create of %p failed %d\n",
 297                               savethread, thr, err));
 298         /* Thread creation failed--clean up */
 299         SvREFCNT_dec(thr->cvcache);
 300         remove_thread(aTHX_ thr);
 301         MUTEX_DESTROY(&thr->mutex);
 302         for (i = 0; i <= AvFILL(initargs); i++)
 303             SvREFCNT_dec(*av_fetch(initargs, i, FALSE));
 304         SvREFCNT_dec(startsv);
 305         return NULL;
 306     }
 307
 308 #ifdef THREAD_POST_CREATE
 309     THREAD_POST_CREATE(thr);
 310 #else
 311     if (sigprocmask(SIG_SETMASK, &oldmask, 0))
 312         croak("panic: sigprocmask");
 313 #endif
 314
 315     sv = newSViv(thr->tid);
 316     sv_magic(sv, thr->oursv, '~', 0, 0);
 317     SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE;
 318     sv = sv_bless(newRV_noinc(sv), gv_stashpv(classname, TRUE));
 319
 320     /* Go */
 321     MUTEX_UNLOCK(&thr->mutex);
 322
 323     return sv;
 324 #else
 325     croak("No threads in this perl");
 326     return &PL_sv_undef;
 327 #endif
 328 }
 329
 330 static Signal_t handle_thread_signal (int sig);
 331
 332 static Signal_t
 333 handle_thread_signal(int sig)
 334 {
 335     dTHXo;
 336     unsigned char c = (unsigned char) sig;
 337     /*
 338      * We're not really allowed to call fprintf in a signal handler
 339      * so don't be surprised if this isn't robust while debugging
 340      * with -DL.
 341      */
 342     DEBUG_S(PerlIO_printf(Perl_debug_log,
 343             "handle_thread_signal: got signal %d\n", sig););
 344     write(sig_pipe[1], &c, 1);
 345 }
 346
 347 MODULE = Thread         PACKAGE = Thread
 348 PROTOTYPES: DISABLE
 349
 350 void
 351 new(classname, startsv, ...)
 352         char *          classname
 353         SV *            startsv
 354         AV *            av = av_make(items - 2, &ST(2));
 355     PPCODE:
 356         XPUSHs(sv_2mortal(newthread(aTHX_ startsv, av, classname)));
 357
 358 void
 359 join(t)
 360         Thread  t
 361         AV *    av = NO_INIT
 362         int     i = NO_INIT
 363     PPCODE:
 364 #ifdef USE_THREADS
 365         if (t == thr)
 366             croak("Attempt to join self");
 367         DEBUG_S(PerlIO_printf(Perl_debug_log, "%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(aTHX_ 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(Perl_debug_log,
 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(Perl_debug_log, "%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(aTHX_ 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(Perl_debug_log, "%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(Perl_debug_log, "%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(Perl_debug_log, "%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 ? PL_psig_ptr[c] : &PL_sv_no);
 647         DEBUG_S(PerlIO_printf(Perl_debug_log,
 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