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