Commit | Line | Data |
c5be433b |
1 | #define PERL_NO_GET_CONTEXT |
d9bb3666 |
2 | #include "EXTERN.h" |
3 | #include "perl.h" |
4 | #include "XSUB.h" |
5 | |
7d901afa |
6 | /* Magic signature for Thread's mg_private is "Th" */ |
7 | #define Thread_MAGIC_SIGNATURE 0x5468 |
8 | |
f0f333f4 |
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 |
17 | |
18 | #ifndef THREAD_RET_TYPE |
f0f333f4 |
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 |
26 | } |
27 | |
ea0efc06 |
28 | static THREAD_RET_TYPE |
f0f333f4 |
29 | threadstart(void *arg) |
d9bb3666 |
30 | { |
f0f333f4 |
31 | return THREAD_RET_CAST(NULL); |
d9bb3666 |
32 | } |
33 | |
683929b4 |
34 | static SV * |
cea2e8a9 |
35 | newthread (pTHX_ SV *startsv, AV *initargs, char *classname) |
d9bb3666 |
36 | { |
3db8f154 |
37 | #ifdef USE_ITHREADS |
948a8a50 |
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 |
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 |
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 |
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 |
62 | } |
63 | |
d9bb3666 |
64 | MODULE = Thread PACKAGE = Thread |
0b9678a8 |
65 | PROTOTYPES: DISABLE |
d9bb3666 |
66 | |
683929b4 |
67 | void |
458fb581 |
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 |
74 | |
75 | void |
d9bb3666 |
76 | join(t) |
77 | Thread t |
78 | AV * av = NO_INIT |
79 | int i = NO_INIT |
80 | PPCODE: |
d9bb3666 |
81 | |
82 | void |
734689b1 |
83 | detach(t) |
d9bb3666 |
84 | Thread t |
85 | CODE: |
d9bb3666 |
86 | |
87 | void |
7d901afa |
88 | equal(t1, t2) |
89 | Thread t1 |
90 | Thread t2 |
91 | PPCODE: |
6b88bc9c |
92 | PUSHs((t1 == t2) ? &PL_sv_yes : &PL_sv_no); |
7d901afa |
93 | |
94 | void |
95 | flags(t) |
96 | Thread t |
97 | PPCODE: |
7d901afa |
98 | |
99 | void |
8dcd6f7b |
100 | done(t) |
101 | Thread t |
102 | PPCODE: |
8dcd6f7b |
103 | |
104 | void |
458fb581 |
105 | self(classname) |
106 | char * classname |
7d901afa |
107 | PREINIT: |
108 | SV *sv; |
f0f333f4 |
109 | PPCODE: |
7d901afa |
110 | |
50112d62 |
111 | U32 |
112 | tid(t) |
113 | Thread t |
114 | CODE: |
f0f333f4 |
115 | RETVAL = 0; |
50112d62 |
116 | OUTPUT: |
117 | RETVAL |
118 | |
119 | void |
120 | DESTROY(t) |
121 | SV * t |
122 | PPCODE: |
05c1ce25 |
123 | PUSHs(t ? &PL_sv_yes : &PL_sv_no); |
50112d62 |
124 | |
7d901afa |
125 | void |
734689b1 |
126 | yield() |
d9bb3666 |
127 | CODE: |
d9bb3666 |
128 | |
129 | void |
734689b1 |
130 | cond_wait(sv) |
131 | SV * sv |
f0f333f4 |
132 | CODE: |
f0f333f4 |
133 | |
734689b1 |
134 | void |
135 | cond_signal(sv) |
136 | SV * sv |
734689b1 |
137 | CODE: |
d9bb3666 |
138 | |
734689b1 |
139 | void |
140 | cond_broadcast(sv) |
141 | SV * sv |
f0f333f4 |
142 | CODE: |
f152979c |
143 | |
7d901afa |
144 | void |
458fb581 |
145 | list(classname) |
146 | char * classname |
7d901afa |
147 | PPCODE: |
7d901afa |
148 | |
149 | |
f152979c |
150 | MODULE = Thread PACKAGE = Thread::Signal |
151 | |
152 | void |
153 | kill_sighandler_thread() |
154 | PPCODE: |
3aeed370 |
155 | write(sig_pipe[1], "\0", 1); |
6b88bc9c |
156 | PUSHs(&PL_sv_yes); |
f152979c |
157 | |
158 | void |
159 | init_thread_signals() |
160 | PPCODE: |
533c011a |
161 | PL_sighandlerp = handle_thread_signal; |
f152979c |
162 | if (pipe(sig_pipe) == -1) |
163 | XSRETURN_UNDEF; |
6b88bc9c |
164 | PUSHs(&PL_sv_yes); |
f152979c |
165 | |
3aeed370 |
166 | void |
f152979c |
167 | await_signal() |
168 | PREINIT: |
3aeed370 |
169 | unsigned char c; |
ea0efc06 |
170 | SSize_t ret; |
f152979c |
171 | CODE: |
172 | do { |
3aeed370 |
173 | ret = read(sig_pipe[0], &c, 1); |
f152979c |
174 | } while (ret == -1 && errno == EINTR); |
175 | if (ret == -1) |
176 | croak("panic: await_signal"); |
3aeed370 |
177 | ST(0) = sv_newmortal(); |
178 | if (ret) |
22c35a8c |
179 | sv_setsv(ST(0), c ? PL_psig_ptr[c] : &PL_sv_no); |
bf49b057 |
180 | DEBUG_S(PerlIO_printf(Perl_debug_log, |
a835d317 |
181 | "await_signal returning %s\n", SvPEEK(ST(0)))); |
4e35701f |
182 | |
458fb581 |
183 | MODULE = Thread PACKAGE = Thread::Specific |
184 | |
185 | void |
186 | data(classname = "Thread::Specific") |
187 | char * classname |
188 | PPCODE: |