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