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_ Thread t)
  25 {
  26 }
  27
  28 static THREAD_RET_TYPE
  29 threadstart(void *arg)
  30 {
  31     return THREAD_RET_CAST(NULL);
  32 }
  33
  34 static SV *
  35 newthread (pTHX_ SV *startsv, AV *initargs, char *classname)
  36 {
  37 #ifdef USE_ITHREADS
  38     croak("This perl was built for \"ithreads\", which currently does not support Thread.pm.\n"
  39           "Run \"perldoc Thread\" for more information");
  40 #else
  41     croak("This perl was not built with support for 5.005-style threads.\n"
  42           "Run \"perldoc Thread\" for more information");
  43 #endif
  44   return &PL_sv_undef;
  45 }
  46
  47 static Signal_t handle_thread_signal (int sig);
  48
  49 static Signal_t
  50 handle_thread_signal(int sig)
  51 {
  52     unsigned char c = (unsigned char) sig;
  53     dTHX;
  54     /*
  55      * We're not really allowed to call fprintf in a signal handler
  56      * so don't be surprised if this isn't robust while debugging
  57      * with -DL.
  58      */
  59     DEBUG_S(PerlIO_printf(Perl_debug_log,
  60             "handle_thread_signal: got signal %d\n", sig));
  61     write(sig_pipe[1], &c, 1);
  62 }
  63
  64 MODULE = Thread         PACKAGE = Thread
  65 PROTOTYPES: DISABLE
  66
  67 void
  68 new(classname, startsv, ...)
  69         char *          classname
  70         SV *            startsv
  71         AV *            av = av_make(items - 2, &ST(2));
  72     PPCODE:
  73         XPUSHs(sv_2mortal(newthread(aTHX_ startsv, av, classname)));
  74
  75 void
  76 join(t)
  77         Thread  t
  78     PREINIT:
  79 #ifdef USE_5005THREADS
  80         AV *    av;
  81         int     i;
  82 #endif
  83     PPCODE:
  84
  85 void
  86 detach(t)
  87         Thread  t
  88     CODE:
  89
  90 void
  91 equal(t1, t2)
  92         Thread  t1
  93         Thread  t2
  94     PPCODE:
  95         PUSHs((t1 == t2) ? &PL_sv_yes : &PL_sv_no);
  96
  97 void
  98 flags(t)
  99         Thread  t
 100     PPCODE:
 101
 102 void
 103 done(t)
 104         Thread  t
 105     PPCODE:
 106
 107 void
 108 self(classname)
 109         char *  classname
 110     PREINIT:
 111 #ifdef USE_5005THREADS
 112         SV *sv;
 113 #endif
 114     PPCODE:
 115
 116 U32
 117 tid(t)
 118         Thread  t
 119     CODE:
 120         RETVAL = 0;
 121     OUTPUT:
 122         RETVAL
 123
 124 void
 125 DESTROY(t)
 126         SV *    t
 127     PPCODE:
 128         PUSHs(t ? &PL_sv_yes : &PL_sv_no);
 129
 130 void
 131 yield()
 132     CODE:
 133
 134 void
 135 cond_wait(sv)
 136         SV *    sv
 137 CODE:
 138
 139 void
 140 cond_signal(sv)
 141         SV *    sv
 142 CODE:
 143
 144 void
 145 cond_broadcast(sv)
 146         SV *    sv
 147 CODE:
 148
 149 void
 150 list(classname)
 151         char *  classname
 152     PPCODE:
 153
 154
 155 MODULE = Thread         PACKAGE = Thread::Signal
 156
 157 void
 158 kill_sighandler_thread()
 159     PPCODE:
 160         write(sig_pipe[1], "\0", 1);
 161         PUSHs(&PL_sv_yes);
 162
 163 void
 164 init_thread_signals()
 165     PPCODE:
 166         PL_sighandlerp = handle_thread_signal;
 167         if (pipe(sig_pipe) == -1)
 168             XSRETURN_UNDEF;
 169         PUSHs(&PL_sv_yes);
 170
 171 void
 172 await_signal()
 173     PREINIT:
 174         unsigned char c;
 175         SSize_t ret;
 176     CODE:
 177         do {
 178             ret = read(sig_pipe[0], &c, 1);
 179         } while (ret == -1 && errno == EINTR);
 180         if (ret == -1)
 181             croak("panic: await_signal");
 182         ST(0) = sv_newmortal();
 183         if (ret)
 184             sv_setsv(ST(0), c ? PL_psig_ptr[c] : &PL_sv_no);
 185         DEBUG_S(PerlIO_printf(Perl_debug_log,
 186                               "await_signal returning %s\n", SvPEEK(ST(0))));
 187
 188 MODULE = Thread         PACKAGE = Thread::Specific
 189
 190 void
 191 data(classname = "Thread::Specific")
 192         char *  classname
 193     PPCODE: