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 //      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);
 300         ((HV*) SHAREDSvGET(threads)) = newHV();
 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