Commit | Line | Data |
47ba8780 |
1 | #include "threads.h" |
2 | |
47ba8780 |
3 | /* |
b1edfb69 |
4 | * Starts executing the thread. Needs to clean up memory a tad better. |
5 | */ |
47ba8780 |
6 | |
7 | #ifdef WIN32 |
e6e315b9 |
8 | THREAD_RET_TYPE Perl_thread_run(LPVOID arg) { |
47ba8780 |
9 | #else |
e8f2bb9a |
10 | void* Perl_thread_run(void * arg) { |
47ba8780 |
11 | #endif |
5b414d21 |
12 | ithread* thread = (ithread*) arg; |
47ba8780 |
13 | SV* thread_tid_ptr; |
14 | SV* thread_ptr; |
15 | dTHXa(thread->interp); |
47ba8780 |
16 | PERL_SET_CONTEXT(thread->interp); |
17 | |
18 | #ifdef WIN32 |
19 | thread->thr = GetCurrentThreadId(); |
20 | #else |
21 | thread->thr = pthread_self(); |
22 | #endif |
23 | |
4f896ddc |
24 | SHAREDSvLOCK(threads); |
47ba8780 |
25 | SHAREDSvEDIT(threads); |
7f9a95ef |
26 | PERL_THREAD_SETSPECIFIC(self_key,INT2PTR(void*,thread->tid)); |
27 | thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, thread->tid); |
b1edfb69 |
28 | thread_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(thread)); |
47ba8780 |
29 | hv_store_ent((HV*)SHAREDSvGET(threads), thread_tid_ptr, thread_ptr,0); |
30 | SvREFCNT_dec(thread_tid_ptr); |
31 | SHAREDSvRELEASE(threads); |
4f896ddc |
32 | SHAREDSvUNLOCK(threads); |
47ba8780 |
33 | PL_perl_destruct_level = 2; |
4f896ddc |
34 | |
47ba8780 |
35 | { |
36 | |
37 | AV* params; |
38 | I32 len; |
39 | int i; |
40 | dSP; |
41 | params = (AV*) SvRV(thread->params); |
42 | len = av_len(params); |
43 | ENTER; |
44 | SAVETMPS; |
45 | PUSHMARK(SP); |
46 | if(len > -1) { |
47 | for(i = 0; i < len + 1; i++) { |
48 | XPUSHs(av_shift(params)); |
49 | } |
50 | } |
51 | PUTBACK; |
4f896ddc |
52 | call_sv(thread->init_function, G_DISCARD); |
47ba8780 |
53 | FREETMPS; |
54 | LEAVE; |
55 | |
56 | |
57 | } |
58 | |
47ba8780 |
59 | MUTEX_LOCK(&thread->mutex); |
fd58862f |
60 | PerlIO_flush((PerlIO*)NULL); |
47ba8780 |
61 | perl_destruct(thread->interp); |
62 | perl_free(thread->interp); |
63 | if(thread->detached == 1) { |
64 | MUTEX_UNLOCK(&thread->mutex); |
e6e315b9 |
65 | Perl_thread_destruct(thread); |
47ba8780 |
66 | } else { |
67 | MUTEX_UNLOCK(&thread->mutex); |
68 | } |
69 | #ifdef WIN32 |
70 | return (DWORD)0; |
e8f2bb9a |
71 | #else |
72 | return 0; |
47ba8780 |
73 | #endif |
74 | |
75 | } |
76 | |
47ba8780 |
77 | /* |
b1edfb69 |
78 | * iThread->create(); |
79 | */ |
47ba8780 |
80 | |
e6e315b9 |
81 | SV* Perl_thread_create(char* class, SV* init_function, SV* params) { |
47ba8780 |
82 | ithread* thread = malloc(sizeof(ithread)); |
83 | SV* obj_ref; |
84 | SV* obj; |
85 | SV* temp_store; |
47ba8780 |
86 | PerlInterpreter *current_perl; |
b50cb5ff |
87 | CLONE_PARAMS clone_param; |
47ba8780 |
88 | |
89 | MUTEX_LOCK(&create_mutex); |
90 | obj_ref = newSViv(0); |
91 | obj = newSVrv(obj_ref, class); |
170958c3 |
92 | sv_setiv(obj, PTR2IV(thread)); |
b1edfb69 |
93 | SvREADONLY_on(obj); |
b6a0b930 |
94 | PerlIO_flush((PerlIO*)NULL); |
b1edfb69 |
95 | current_perl = PERL_GET_CONTEXT; |
47ba8780 |
96 | |
4f896ddc |
97 | |
47ba8780 |
98 | |
cd8c9bf8 |
99 | temp_store = Perl_get_sv(current_perl, "threads::origthread", TRUE | GV_ADDMULTI); |
170958c3 |
100 | sv_setiv(temp_store,PTR2IV(current_perl)); |
cd8c9bf8 |
101 | temp_store = NULL; |
102 | |
103 | |
47ba8780 |
104 | #ifdef WIN32 |
b50cb5ff |
105 | thread->interp = perl_clone(current_perl, CLONEf_KEEP_PTR_TABLE | CLONEf_CLONE_HOST); |
47ba8780 |
106 | #else |
b50cb5ff |
107 | thread->interp = perl_clone(current_perl, CLONEf_KEEP_PTR_TABLE); |
47ba8780 |
108 | #endif |
b50cb5ff |
109 | |
47ba8780 |
110 | |
b50cb5ff |
111 | clone_param.flags = 0; |
112 | thread->init_function = Perl_sv_dup(thread->interp, init_function, &clone_param); |
113 | if(SvREFCNT(thread->init_function) == 0) { |
114 | SvREFCNT_inc(thread->init_function); |
115 | } |
116 | |
117 | thread->params = Perl_sv_dup(thread->interp,params, &clone_param); |
118 | SvREFCNT_inc(thread->params); |
119 | SvTEMP_off(thread->init_function); |
120 | ptr_table_free(PL_ptr_table); |
121 | PL_ptr_table = NULL; |
122 | |
47ba8780 |
123 | |
47ba8780 |
124 | |
47ba8780 |
125 | |
126 | PERL_SET_CONTEXT(current_perl); |
127 | |
47ba8780 |
128 | |
b1edfb69 |
129 | /* let's init the thread */ |
47ba8780 |
130 | |
131 | MUTEX_INIT(&thread->mutex); |
132 | thread->tid = tid_counter++; |
133 | thread->detached = 0; |
134 | thread->count = 1; |
135 | |
136 | #ifdef WIN32 |
137 | |
e6e315b9 |
138 | thread->handle = CreateThread(NULL, 0, Perl_thread_run, |
47ba8780 |
139 | (LPVOID)thread, 0, &thread->thr); |
140 | |
82c40bf6 |
141 | |
142 | #else |
fa26028c |
143 | { |
144 | static pthread_attr_t attr; |
145 | static int attr_inited = 0; |
146 | sigset_t fullmask, oldmask; |
147 | static int attr_joinable = PTHREAD_CREATE_JOINABLE; |
148 | if (!attr_inited) { |
149 | attr_inited = 1; |
150 | pthread_attr_init(&attr); |
151 | } |
152 | # ifdef PTHREAD_ATTR_SETDETACHSTATE |
153 | PTHREAD_ATTR_SETDETACHSTATE(&attr, attr_joinable); |
154 | # endif |
3eb37d38 |
155 | # ifdef THREAD_CREATE_NEEDS_STACK |
156 | if(pthread_attr_setstacksize(&attr, THREAD_CREATE_NEEDS_STACK)) |
157 | croak("panic: pthread_attr_setstacksize failed"); |
158 | # endif |
159 | |
3ad0b7d6 |
160 | #ifdef OLD_PTHREADS_API |
fa26028c |
161 | pthread_create( &thread->thr, attr, Perl_thread_run, (void *)thread); |
47ba8780 |
162 | #else |
3ad0b7d6 |
163 | pthread_create( &thread->thr, &attr, Perl_thread_run, (void *)thread); |
47ba8780 |
164 | #endif |
3ad0b7d6 |
165 | } |
82c40bf6 |
166 | #endif |
47ba8780 |
167 | MUTEX_UNLOCK(&create_mutex); |
168 | |
b1edfb69 |
169 | return obj_ref; |
47ba8780 |
170 | } |
171 | |
172 | /* |
b1edfb69 |
173 | * returns the id of the thread |
174 | */ |
e6e315b9 |
175 | I32 Perl_thread_tid (SV* obj) { |
47ba8780 |
176 | ithread* thread; |
177 | if(!SvROK(obj)) { |
e6e315b9 |
178 | obj = Perl_thread_self(SvPV_nolen(obj)); |
170958c3 |
179 | thread = INT2PTR(ithread*, SvIV(SvRV(obj))); |
47ba8780 |
180 | SvREFCNT_dec(obj); |
181 | } else { |
170958c3 |
182 | thread = INT2PTR(ithread*, SvIV(SvRV(obj))); |
47ba8780 |
183 | } |
184 | return thread->tid; |
185 | } |
186 | |
e6e315b9 |
187 | SV* Perl_thread_self (char* class) { |
47ba8780 |
188 | dTHX; |
189 | SV* obj_ref; |
190 | SV* obj; |
b1edfb69 |
191 | SV* thread_tid_ptr; |
192 | SV* thread_ptr; |
193 | HE* thread_entry; |
7f9a95ef |
194 | void* id; |
195 | PERL_THREAD_GETSPECIFIC(self_key,id); |
4f896ddc |
196 | SHAREDSvLOCK(threads); |
47ba8780 |
197 | SHAREDSvEDIT(threads); |
7f9a95ef |
198 | |
199 | thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(id)); |
82c40bf6 |
200 | |
b1edfb69 |
201 | thread_entry = Perl_hv_fetch_ent(PL_sharedsv_space, |
202 | (HV*) SHAREDSvGET(threads), |
203 | thread_tid_ptr, 0,0); |
47ba8780 |
204 | thread_ptr = HeVAL(thread_entry); |
205 | SvREFCNT_dec(thread_tid_ptr); |
47ba8780 |
206 | SHAREDSvRELEASE(threads); |
4f896ddc |
207 | SHAREDSvUNLOCK(threads); |
47ba8780 |
208 | |
209 | obj_ref = newSViv(0); |
210 | obj = newSVrv(obj_ref, class); |
4f896ddc |
211 | sv_setsv(obj, thread_ptr); |
47ba8780 |
212 | SvREADONLY_on(obj); |
213 | return obj_ref; |
214 | } |
215 | |
216 | /* |
b1edfb69 |
217 | * joins the thread this code needs to take the returnvalue from the |
218 | * call_sv and send it back */ |
47ba8780 |
219 | |
e6e315b9 |
220 | void Perl_thread_join(SV* obj) { |
170958c3 |
221 | ithread* thread = INT2PTR(ithread*, SvIV(SvRV(obj))); |
47ba8780 |
222 | #ifdef WIN32 |
223 | DWORD waitcode; |
224 | waitcode = WaitForSingleObject(thread->handle, INFINITE); |
225 | #else |
226 | void *retval; |
227 | pthread_join(thread->thr,&retval); |
228 | #endif |
229 | } |
230 | |
b1edfb69 |
231 | /* detaches a thread |
232 | * needs to better clean up memory */ |
47ba8780 |
233 | |
e6e315b9 |
234 | void Perl_thread_detach(SV* obj) { |
170958c3 |
235 | ithread* thread = INT2PTR(ithread*, SvIV(SvRV(obj))); |
47ba8780 |
236 | MUTEX_LOCK(&thread->mutex); |
237 | thread->detached = 1; |
82c40bf6 |
238 | PERL_THREAD_DETACH(thread->thr); |
47ba8780 |
239 | MUTEX_UNLOCK(&thread->mutex); |
240 | } |
241 | |
e6e315b9 |
242 | void Perl_thread_DESTROY (SV* obj) { |
170958c3 |
243 | ithread* thread = INT2PTR(ithread*, SvIV(SvRV(obj))); |
47ba8780 |
244 | |
245 | MUTEX_LOCK(&thread->mutex); |
246 | thread->count--; |
247 | MUTEX_UNLOCK(&thread->mutex); |
e6e315b9 |
248 | Perl_thread_destruct(thread); |
47ba8780 |
249 | } |
250 | |
e6e315b9 |
251 | void Perl_thread_destruct (ithread* thread) { |
47ba8780 |
252 | return; |
253 | MUTEX_LOCK(&thread->mutex); |
254 | if(thread->count != 0) { |
255 | MUTEX_UNLOCK(&thread->mutex); |
256 | return; |
257 | } |
258 | MUTEX_UNLOCK(&thread->mutex); |
259 | /* it is safe noone is holding a ref to this */ |
260 | /*printf("proper destruction!\n");*/ |
261 | } |
262 | |
47ba8780 |
263 | MODULE = threads PACKAGE = threads |
264 | BOOT: |
265 | Perl_sharedsv_init(aTHX); |
89e0305a |
266 | PERL_THREAD_ALLOC_SPECIFIC(self_key); |
47ba8780 |
267 | PL_perl_destruct_level = 2; |
268 | threads = Perl_sharedsv_new(aTHX); |
269 | SHAREDSvEDIT(threads); |
e8f2bb9a |
270 | SHAREDSvGET(threads) = (SV *)newHV(); |
47ba8780 |
271 | SHAREDSvRELEASE(threads); |
272 | { |
273 | |
274 | |
275 | SV* temp = get_sv("threads::sharedsv_space", TRUE | GV_ADDMULTI); |
170958c3 |
276 | SV* temp2 = newSViv(PTR2IV(PL_sharedsv_space)); |
47ba8780 |
277 | sv_setsv( temp , temp2 ); |
278 | } |
279 | { |
280 | ithread* thread = malloc(sizeof(ithread)); |
281 | SV* thread_tid_ptr; |
282 | SV* thread_ptr; |
283 | MUTEX_INIT(&thread->mutex); |
284 | thread->tid = 0; |
285 | #ifdef WIN32 |
286 | thread->thr = GetCurrentThreadId(); |
287 | #else |
288 | thread->thr = pthread_self(); |
289 | #endif |
d5ecd109 |
290 | SHAREDSvEDIT(threads); |
82c40bf6 |
291 | PERL_THREAD_ALLOC_SPECIFIC(self_key); |
7f9a95ef |
292 | PERL_THREAD_SETSPECIFIC(self_key,0); |
293 | thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, 0); |
b1edfb69 |
294 | thread_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(thread)); |
47ba8780 |
295 | hv_store_ent((HV*) SHAREDSvGET(threads), thread_tid_ptr, thread_ptr,0); |
4f896ddc |
296 | SvREFCNT_dec(thread_tid_ptr); |
d5ecd109 |
297 | SHAREDSvRELEASE(threads); |
47ba8780 |
298 | } |
299 | MUTEX_INIT(&create_mutex); |
300 | |
47ba8780 |
301 | PROTOTYPES: DISABLE |
302 | |
303 | SV * |
304 | create (class, function_to_call, ...) |
305 | char * class |
306 | SV * function_to_call |
307 | CODE: |
308 | AV* params = newAV(); |
309 | if(items > 2) { |
310 | int i; |
311 | for(i = 2; i < items ; i++) { |
312 | av_push(params, ST(i)); |
313 | } |
314 | } |
e6e315b9 |
315 | RETVAL = Perl_thread_create(class, function_to_call, newRV_noinc((SV*) params)); |
47ba8780 |
316 | OUTPUT: |
317 | RETVAL |
318 | |
319 | SV * |
8222d950 |
320 | new (class, function_to_call, ...) |
321 | char * class |
322 | SV * function_to_call |
323 | CODE: |
324 | AV* params = newAV(); |
325 | if(items > 2) { |
326 | int i; |
327 | for(i = 2; i < items ; i++) { |
328 | av_push(params, ST(i)); |
329 | } |
330 | } |
331 | RETVAL = Perl_thread_create(class, function_to_call, newRV_noinc((SV*) params)); |
332 | OUTPUT: |
333 | RETVAL |
334 | |
335 | |
336 | |
337 | SV * |
47ba8780 |
338 | self (class) |
339 | char* class |
340 | CODE: |
e6e315b9 |
341 | RETVAL = Perl_thread_self(class); |
47ba8780 |
342 | OUTPUT: |
343 | RETVAL |
344 | |
345 | int |
346 | tid (obj) |
347 | SV * obj; |
348 | CODE: |
e6e315b9 |
349 | RETVAL = Perl_thread_tid(obj); |
47ba8780 |
350 | OUTPUT: |
351 | RETVAL |
352 | |
353 | void |
354 | join (obj) |
355 | SV * obj |
356 | PREINIT: |
357 | I32* temp; |
358 | PPCODE: |
359 | temp = PL_markstack_ptr++; |
e6e315b9 |
360 | Perl_thread_join(obj); |
47ba8780 |
361 | if (PL_markstack_ptr != temp) { |
362 | /* truly void, because dXSARGS not invoked */ |
363 | PL_markstack_ptr = temp; |
364 | XSRETURN_EMPTY; /* return empty stack */ |
365 | } |
366 | /* must have used dXSARGS; list context implied */ |
367 | return; /* assume stack size is correct */ |
368 | |
369 | void |
370 | detach (obj) |
371 | SV * obj |
372 | PREINIT: |
373 | I32* temp; |
374 | PPCODE: |
375 | temp = PL_markstack_ptr++; |
e6e315b9 |
376 | Perl_thread_detach(obj); |
47ba8780 |
377 | if (PL_markstack_ptr != temp) { |
378 | /* truly void, because dXSARGS not invoked */ |
379 | PL_markstack_ptr = temp; |
380 | XSRETURN_EMPTY; /* return empty stack */ |
381 | } |
382 | /* must have used dXSARGS; list context implied */ |
383 | return; /* assume stack size is correct */ |
384 | |
47ba8780 |
385 | void |
386 | DESTROY (obj) |
387 | SV * obj |
388 | PREINIT: |
389 | I32* temp; |
390 | PPCODE: |
391 | temp = PL_markstack_ptr++; |
e6e315b9 |
392 | Perl_thread_DESTROY(obj); |
47ba8780 |
393 | if (PL_markstack_ptr != temp) { |
394 | /* truly void, because dXSARGS not invoked */ |
395 | PL_markstack_ptr = temp; |
396 | XSRETURN_EMPTY; /* return empty stack */ |
397 | } |
398 | /* must have used dXSARGS; list context implied */ |
399 | return; /* assume stack size is correct */ |
400 | |