ext/threads/threads.xs

   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 #if 0
 133         sv_dump(SvRV(Perl_get_sv(current_perl, "threads::calltempstore",FALSE)));
 134         sv_dump(SvRV(Perl_get_sv(thread->interp, "threads::calltempstore",FALSE)));
 135 #endif
 136
 137         thread->init_function = newSVsv(Perl_get_sv(thread->interp, "threads::calltempstore",FALSE));
 138         thread->params = newSVsv(Perl_get_sv(thread->interp, "threads::paramtempstore",FALSE));
 139
 140         init_function = NULL;
 141         temp_store = NULL;
 142
 143
 144         /*
 145                 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
 146         */
 147
 148
 149
 150         temp_store = Perl_get_sv(thread->interp,"threads::paramtempstore",FALSE);
 151         Perl_sv_setsv(thread->interp,temp_store, &PL_sv_undef);
 152
 153         temp_store = Perl_get_sv(thread->interp,"threads::calltempstore",FALSE);
 154         Perl_sv_setsv(thread->interp,temp_store, &PL_sv_undef);
 155
 156         PERL_SET_CONTEXT(current_perl);
 157
 158         temp_store = Perl_get_sv(current_perl,"threads::paramtempstore",FALSE);
 159         Perl_sv_setsv(current_perl, temp_store, &PL_sv_undef);
 160
 161         temp_store = Perl_get_sv(current_perl,"threads::calltempstore",FALSE);
 162         Perl_sv_setsv(current_perl, temp_store, &PL_sv_undef);
 163
 164         /* lets init the thread */
 165
 166
 167
 168
 169
 170         MUTEX_INIT(&thread->mutex);
 171         thread->tid = tid_counter++;
 172         thread->detached = 0;
 173         thread->count = 1;
 174
 175 #ifdef WIN32
 176
 177         thread->handle = CreateThread(NULL, 0, thread_run,
 178                         (LPVOID)thread, 0, &thread->thr);
 179
 180 #else
 181         pthread_create( &thread->thr, NULL, (void *) thread_run, thread);
 182 #endif
 183         MUTEX_UNLOCK(&create_mutex);
 184
 185
 186         if(!SvRV(obj_ref)) printf("FUCK\n");
 187   return obj_ref;
 188 }
 189
 190 /*
 191         returns the id of the thread
 192 */
 193 I32 thread_tid (SV* obj) {
 194         ithread* thread;
 195         if(!SvROK(obj)) {
 196                 obj = thread_self(SvPV_nolen(obj));
 197                 thread = (ithread*)SvIV(SvRV(obj));
 198                 SvREFCNT_dec(obj);
 199         } else {
 200                 thread = (ithread*)SvIV(SvRV(obj));
 201         }
 202         return thread->tid;
 203 }
 204
 205 SV* thread_self (char* class) {
 206         dTHX;
 207         SV*      obj_ref;
 208         SV*      obj;
 209         SV*             thread_tid_ptr;
 210         SV*             thread_ptr;
 211         HE*             thread_entry;
 212         IV      pointer;
 213         PerlInterpreter *old_context = PERL_GET_CONTEXT;
 214
 215
 216
 217         SHAREDSvEDIT(threads);
 218 #ifdef WIN32
 219         thread_tid_ptr = Perl_newSViv(sharedsv_space, (IV) GetCurrentThreadId());
 220 #else
 221         thread_tid_ptr = Perl_newSViv(sharedsv_space, (IV) pthread_self());
 222 #endif
 223         thread_entry = Perl_hv_fetch_ent(sharedsv_space,(HV*) SHAREDSvGET(threads), thread_tid_ptr, 0,0);
 224         thread_ptr = HeVAL(thread_entry);
 225         SvREFCNT_dec(thread_tid_ptr);
 226         pointer = SvIV(thread_ptr);
 227         SHAREDSvRELEASE(threads);
 228
 229
 230
 231
 232         obj_ref = newSViv(0);
 233         obj = newSVrv(obj_ref, class);
 234         sv_setiv(obj, pointer);
 235         SvREADONLY_on(obj);
 236         return obj_ref;
 237 }
 238
 239 /*
 240         joins the thread
 241         this code needs to take the returnvalue from the call_sv and send it back
 242 */
 243
 244 void thread_join(SV* obj) {
 245         ithread* thread = (ithread*)SvIV(SvRV(obj));
 246 #ifdef WIN32
 247         DWORD waitcode;
 248         waitcode = WaitForSingleObject(thread->handle, INFINITE);
 249 #else
 250         void *retval;
 251         pthread_join(thread->thr,&retval);
 252 #endif
 253 }
 254
 255
 256 /*
 257         detaches a thread
 258         needs to better clean up memory
 259 */
 260
 261 void thread_detach(SV* obj) {
 262         ithread* thread = (ithread*)SvIV(SvRV(obj));
 263         MUTEX_LOCK(&thread->mutex);
 264         thread->detached = 1;
 265 #if !defined(WIN32)
 266         pthread_detach(thread->thr);
 267 #endif
 268         MUTEX_UNLOCK(&thread->mutex);
 269 }
 270
 271
 272
 273 void thread_DESTROY (SV* obj) {
 274         ithread* thread = (ithread*)SvIV(SvRV(obj));
 275
 276         MUTEX_LOCK(&thread->mutex);
 277         thread->count--;
 278         MUTEX_UNLOCK(&thread->mutex);
 279         thread_destruct(thread);
 280
 281 }
 282
 283 void thread_destruct (ithread* thread) {
 284         return;
 285         MUTEX_LOCK(&thread->mutex);
 286         if(thread->count != 0) {
 287                 MUTEX_UNLOCK(&thread->mutex);
 288                 return;
 289         }
 290         MUTEX_UNLOCK(&thread->mutex);
 291         /* it is safe noone is holding a ref to this */
 292         /*printf("proper destruction!\n");*/
 293 }
 294
 295
 296 MODULE = threads                PACKAGE = threads
 297 BOOT:
 298         Perl_sharedsv_init(aTHX);
 299         PL_perl_destruct_level = 2;
 300         threads = Perl_sharedsv_new(aTHX);
 301         SHAREDSvEDIT(threads);
 302         SHAREDSvGET(threads) = (SV *)newHV();
 303         SHAREDSvRELEASE(threads);
 304         {
 305
 306
 307             SV* temp = get_sv("threads::sharedsv_space", TRUE | GV_ADDMULTI);
 308             SV* temp2 = newSViv((IV)sharedsv_space );
 309             sv_setsv( temp , temp2 );
 310         }
 311         {
 312                 ithread* thread = malloc(sizeof(ithread));
 313                 SV* thread_tid_ptr;
 314                 SV* thread_ptr;
 315                 MUTEX_INIT(&thread->mutex);
 316                 thread->tid = 0;
 317 #ifdef WIN32
 318                 thread->thr = GetCurrentThreadId();
 319 #else
 320                 thread->thr = pthread_self();
 321 #endif
 322                 SHAREDSvEDIT(threads);
 323                 thread_tid_ptr = Perl_newSViv(sharedsv_space, (IV) thread->thr);
 324                 thread_ptr = Perl_newSViv(sharedsv_space, (IV) thread);
 325                 hv_store_ent((HV*) SHAREDSvGET(threads), thread_tid_ptr, thread_ptr,0);
 326                 SvREFCNT_dec(thread_tid_ptr);
 327                 SHAREDSvRELEASE(threads);
 328
 329         }
 330         MUTEX_INIT(&create_mutex);
 331
 332
 333
 334 PROTOTYPES: DISABLE
 335
 336 SV *
 337 create (class, function_to_call, ...)
 338         char *  class
 339         SV *    function_to_call
 340                 CODE:
 341                         AV* params = newAV();
 342                         if(items > 2) {
 343                                 int i;
 344                                 for(i = 2; i < items ; i++) {
 345                                         av_push(params, ST(i));
 346                                 }
 347                         }
 348                         RETVAL = thread_create(class, function_to_call, newRV_noinc((SV*) params));
 349                         OUTPUT:
 350                         RETVAL
 351
 352 SV *
 353 self (class)
 354                 char* class
 355         CODE:
 356                 RETVAL = thread_self(class);
 357         OUTPUT:
 358                 RETVAL
 359
 360 int
 361 tid (obj)
 362                 SV *    obj;
 363         CODE:
 364                 RETVAL = thread_tid(obj);
 365         OUTPUT:
 366         RETVAL
 367
 368 void
 369 join (obj)
 370         SV *    obj
 371         PREINIT:
 372         I32* temp;
 373         PPCODE:
 374         temp = PL_markstack_ptr++;
 375         thread_join(obj);
 376         if (PL_markstack_ptr != temp) {
 377           /* truly void, because dXSARGS not invoked */
 378           PL_markstack_ptr = temp;
 379           XSRETURN_EMPTY; /* return empty stack */
 380         }
 381         /* must have used dXSARGS; list context implied */
 382         return; /* assume stack size is correct */
 383
 384 void
 385 detach (obj)
 386         SV *    obj
 387         PREINIT:
 388         I32* temp;
 389         PPCODE:
 390         temp = PL_markstack_ptr++;
 391         thread_detach(obj);
 392         if (PL_markstack_ptr != temp) {
 393           /* truly void, because dXSARGS not invoked */
 394           PL_markstack_ptr = temp;
 395           XSRETURN_EMPTY; /* return empty stack */
 396         }
 397         /* must have used dXSARGS; list context implied */
 398         return; /* assume stack size is correct */
 399
 400
 401
 402
 403
 404 void
 405 DESTROY (obj)
 406         SV *    obj
 407         PREINIT:
 408         I32* temp;
 409         PPCODE:
 410         temp = PL_markstack_ptr++;
 411         thread_DESTROY(obj);
 412         if (PL_markstack_ptr != temp) {
 413           /* truly void, because dXSARGS not invoked */
 414           PL_markstack_ptr = temp;
 415           XSRETURN_EMPTY; /* return empty stack */
 416         }
 417         /* must have used dXSARGS; list context implied */
 418         return; /* assume stack size is correct */
 419
 420
 421