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