Commit | Line | Data |
---|---|---|
c5be433b | 1 | #define PERL_NO_GET_CONTEXT |
d9bb3666 MB |
2 | #include "EXTERN.h" |
3 | #include "perl.h" | |
4 | #include "XSUB.h" | |
5 | ||
7d901afa MB |
6 | /* Magic signature for Thread's mg_private is "Th" */ |
7 | #define Thread_MAGIC_SIGNATURE 0x5468 | |
8 | ||
f0f333f4 NIS |
9 | #ifdef __cplusplus |
10 | #ifdef I_UNISTD | |
11 | #include <unistd.h> | |
12 | #endif | |
13 | #endif | |
14 | #include <fcntl.h> | |
15 | ||
85ced67f | 16 | static int sig_pipe[2]; |
f0f333f4 NIS |
17 | |
18 | #ifndef THREAD_RET_TYPE | |
f0f333f4 NIS |
19 | #define THREAD_RET_TYPE void * |
20 | #define THREAD_RET_CAST(x) ((THREAD_RET_TYPE) x) | |
458fb581 | 21 | #endif |
683929b4 | 22 | |
7d901afa | 23 | static void |
54fb45e2 | 24 | remove_thread(pTHX_ Thread t) |
7d901afa | 25 | { |
7d901afa MB |
26 | } |
27 | ||
ea0efc06 | 28 | static THREAD_RET_TYPE |
f0f333f4 | 29 | threadstart(void *arg) |
d9bb3666 | 30 | { |
f0f333f4 | 31 | return THREAD_RET_CAST(NULL); |
d9bb3666 MB |
32 | } |
33 | ||
683929b4 | 34 | static SV * |
cea2e8a9 | 35 | newthread (pTHX_ SV *startsv, AV *initargs, char *classname) |
d9bb3666 | 36 | { |
3db8f154 | 37 | #ifdef USE_ITHREADS |
948a8a50 JH |
38 | croak("This perl was built for \"ithreads\", which currently does not support Thread.pm.\n" |
39 | "Run \"perldoc Thread\" for more information"); | |
3db8f154 | 40 | #else |
948a8a50 JH |
41 | croak("This perl was not built with support for 5.005-style threads.\n" |
42 | "Run \"perldoc Thread\" for more information"); | |
f0f333f4 | 43 | #endif |
3db8f154 | 44 | return &PL_sv_undef; |
d9bb3666 MB |
45 | } |
46 | ||
20ce7b12 | 47 | static Signal_t handle_thread_signal (int sig); |
f0f333f4 | 48 | |
f152979c | 49 | static Signal_t |
f0f333f4 | 50 | handle_thread_signal(int sig) |
f152979c | 51 | { |
3aeed370 | 52 | unsigned char c = (unsigned char) sig; |
e8fcfee6 | 53 | dTHX; |
3aeed370 MB |
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 | */ | |
bf49b057 | 59 | DEBUG_S(PerlIO_printf(Perl_debug_log, |
a835d317 | 60 | "handle_thread_signal: got signal %d\n", sig)); |
3aeed370 | 61 | write(sig_pipe[1], &c, 1); |
f152979c MB |
62 | } |
63 | ||
d9bb3666 | 64 | MODULE = Thread PACKAGE = Thread |
0b9678a8 | 65 | PROTOTYPES: DISABLE |
d9bb3666 | 66 | |
683929b4 | 67 | void |
458fb581 MB |
68 | new(classname, startsv, ...) |
69 | char * classname | |
d9bb3666 | 70 | SV * startsv |
734689b1 | 71 | AV * av = av_make(items - 2, &ST(2)); |
683929b4 | 72 | PPCODE: |
cea2e8a9 | 73 | XPUSHs(sv_2mortal(newthread(aTHX_ startsv, av, classname))); |
d9bb3666 MB |
74 | |
75 | void | |
d9bb3666 MB |
76 | join(t) |
77 | Thread t | |
c5661c80 MHM |
78 | PREINIT: |
79 | #ifdef USE_5005THREADS | |
80 | AV * av; | |
81 | int i; | |
82 | #endif | |
d9bb3666 | 83 | PPCODE: |
d9bb3666 MB |
84 | |
85 | void | |
734689b1 | 86 | detach(t) |
d9bb3666 MB |
87 | Thread t |
88 | CODE: | |
d9bb3666 MB |
89 | |
90 | void | |
7d901afa MB |
91 | equal(t1, t2) |
92 | Thread t1 | |
93 | Thread t2 | |
94 | PPCODE: | |
6b88bc9c | 95 | PUSHs((t1 == t2) ? &PL_sv_yes : &PL_sv_no); |
7d901afa MB |
96 | |
97 | void | |
98 | flags(t) | |
99 | Thread t | |
100 | PPCODE: | |
7d901afa MB |
101 | |
102 | void | |
8dcd6f7b DS |
103 | done(t) |
104 | Thread t | |
105 | PPCODE: | |
8dcd6f7b DS |
106 | |
107 | void | |
458fb581 MB |
108 | self(classname) |
109 | char * classname | |
7d901afa | 110 | PREINIT: |
c5661c80 | 111 | #ifdef USE_5005THREADS |
7d901afa | 112 | SV *sv; |
c5661c80 | 113 | #endif |
f0f333f4 | 114 | PPCODE: |
7d901afa | 115 | |
50112d62 MB |
116 | U32 |
117 | tid(t) | |
118 | Thread t | |
119 | CODE: | |
f0f333f4 | 120 | RETVAL = 0; |
50112d62 MB |
121 | OUTPUT: |
122 | RETVAL | |
123 | ||
124 | void | |
125 | DESTROY(t) | |
126 | SV * t | |
127 | PPCODE: | |
05c1ce25 | 128 | PUSHs(t ? &PL_sv_yes : &PL_sv_no); |
50112d62 | 129 | |
7d901afa | 130 | void |
734689b1 | 131 | yield() |
d9bb3666 | 132 | CODE: |
d9bb3666 MB |
133 | |
134 | void | |
734689b1 MB |
135 | cond_wait(sv) |
136 | SV * sv | |
f0f333f4 | 137 | CODE: |
f0f333f4 | 138 | |
734689b1 MB |
139 | void |
140 | cond_signal(sv) | |
141 | SV * sv | |
734689b1 | 142 | CODE: |
d9bb3666 | 143 | |
734689b1 MB |
144 | void |
145 | cond_broadcast(sv) | |
146 | SV * sv | |
f0f333f4 | 147 | CODE: |
f152979c | 148 | |
7d901afa | 149 | void |
458fb581 MB |
150 | list(classname) |
151 | char * classname | |
7d901afa | 152 | PPCODE: |
7d901afa MB |
153 | |
154 | ||
f152979c MB |
155 | MODULE = Thread PACKAGE = Thread::Signal |
156 | ||
157 | void | |
158 | kill_sighandler_thread() | |
159 | PPCODE: | |
3aeed370 | 160 | write(sig_pipe[1], "\0", 1); |
6b88bc9c | 161 | PUSHs(&PL_sv_yes); |
f152979c MB |
162 | |
163 | void | |
164 | init_thread_signals() | |
165 | PPCODE: | |
533c011a | 166 | PL_sighandlerp = handle_thread_signal; |
f152979c MB |
167 | if (pipe(sig_pipe) == -1) |
168 | XSRETURN_UNDEF; | |
6b88bc9c | 169 | PUSHs(&PL_sv_yes); |
f152979c | 170 | |
3aeed370 | 171 | void |
f152979c MB |
172 | await_signal() |
173 | PREINIT: | |
3aeed370 | 174 | unsigned char c; |
ea0efc06 | 175 | SSize_t ret; |
f152979c MB |
176 | CODE: |
177 | do { | |
3aeed370 | 178 | ret = read(sig_pipe[0], &c, 1); |
f152979c MB |
179 | } while (ret == -1 && errno == EINTR); |
180 | if (ret == -1) | |
181 | croak("panic: await_signal"); | |
3aeed370 MB |
182 | ST(0) = sv_newmortal(); |
183 | if (ret) | |
22c35a8c | 184 | sv_setsv(ST(0), c ? PL_psig_ptr[c] : &PL_sv_no); |
bf49b057 | 185 | DEBUG_S(PerlIO_printf(Perl_debug_log, |
a835d317 | 186 | "await_signal returning %s\n", SvPEEK(ST(0)))); |
4e35701f | 187 | |
458fb581 MB |
188 | MODULE = Thread PACKAGE = Thread::Specific |
189 | ||
190 | void | |
191 | data(classname = "Thread::Specific") | |
192 | char * classname | |
193 | PPCODE: |