view release on metacpan or  search on metacpan

omnithreads/omnithreads.xs  view on Meta::CPAN

                    context = G_ARRAY;
                }
            } else if (hv_exists(specs, "scalar", 6)) {
                if (SvTRUE(*hv_fetch(specs, "scalar", 6, 0))) {
                    context = G_SCALAR;
                }
            } else if (hv_exists(specs, "void", 4)) {
                if (SvTRUE(*hv_fetch(specs, "void", 4, 0))) {
                    context = G_VOID;
                }
            }

            /* exit => thread_only */
            if (hv_exists(specs, "exit", 4)) {
                str = (char *)SvPV_nolen(*hv_fetch(specs, "exit", 4, 0));
                exit_opt = (*str == 't' || *str == 'T')
                                    ? PERL_ITHR_THREAD_EXIT_ONLY : 0;
            }
        }
        if (context == -1) {
            context = GIMME_V;  /* Implicit context */
        } else {
            context |= (GIMME_V & (~(G_ARRAY|G_SCALAR|G_VOID)));
        }

        /* Function args */
        params = newAV();
        if (items > 2) {
            for (ii=2; ii < items ; ii++) {
                av_push(params, SvREFCNT_inc(ST(idx+ii)));
            }
        }

        /* Create thread */
        create_destruct_mutex.lock();
        thread = S_ithread_create(aTHX_ function_to_call,
                                        stack_size,
                                        context,
                                        exit_opt,
                                        newRV_noinc((SV*)params));
        if (! thread) {
            XSRETURN_UNDEF;
        }
        ST(0) = sv_2mortal(ithread_to_SV(aTHX_ Nullsv, thread, classname, FALSE));

        /* Let thread run */
        thread->mutex.unlock();
        create_destruct_mutex.unlock();

        /* XSRETURN(1); - implied */


void
ithread_list(...)
    PREINIT:
        char *classname;
        ithread *thread;
        int list_context;
        IV count = 0;
        int want_running;
    PPCODE:
        /* Class method only */
        if (SvROK(ST(0))) {
            Perl_croak(aTHX_ "Usage: threads->list(...)");
        }
        classname = (char *)SvPV_nolen(ST(0));

        /* Calling context */
        list_context = (GIMME_V == G_ARRAY);

        /* Running or joinable parameter */
        if (items > 1) {
            want_running = SvTRUE(ST(1));
        }

        /* Walk through threads list */
        create_destruct_mutex.lock();
        for (thread = main_thread.next;
             thread != &main_thread;
             thread = thread->next)
        {
            /* Ignore detached or joined threads */
            if (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED)) {
                continue;
            }

            /* Filter per parameter */
            if (items > 1) {
                if (want_running) {
                    if (thread->state & PERL_ITHR_FINISHED) {
                        continue;   /* Not running */
                    }
                } else {
                    if (! (thread->state & PERL_ITHR_FINISHED)) {
                        continue;   /* Still running - not joinable yet */
                    }
                }
            }

            /* Push object on stack if list context */
            if (list_context) {
                XPUSHs(sv_2mortal(ithread_to_SV(aTHX_ Nullsv, thread, classname, TRUE)));
            }
            count++;
        }
        create_destruct_mutex.unlock();
        /* If scalar context, send back count */
        if (! list_context) {
            XSRETURN_IV(count);
        }


void
ithread_self(...)
    PREINIT:
        char *classname;
        ithread *thread;
    CODE:
        /* Class method only */
        if (SvROK(ST(0))) {
            Perl_croak(aTHX_ "Usage: threads->self()");
        }
        classname = (char *)SvPV_nolen(ST(0));

        thread = S_ithread_get(aTHX);

        ST(0) = sv_2mortal(ithread_to_SV(aTHX_ Nullsv, thread, classname, TRUE));
        /* XSRETURN(1); - implied */


void
ithread_tid(...)
    PREINIT:
        ithread *thread;
    CODE:
        thread = SV_to_ithread(aTHX_ ST(0));
        XST_mUV(0, thread->tid);
        /* XSRETURN(1); - implied */


void
ithread_join(...)
    PREINIT:
        ithread *thread;
        int join_err;
        AV *params;
        int len;
        int ii;
        void *retval;
    PPCODE:
        /* Object method only */
        if (! sv_isobject(ST(0))) {
            Perl_croak(aTHX_ "Usage: $thr->join()");
        }

        /* Check if the thread is joinable */
        thread = SV_to_ithread(aTHX_ ST(0));
        join_err = (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED));
        if (join_err) {
            if (join_err & PERL_ITHR_DETACHED) {
                Perl_croak(aTHX_ "Cannot join a detached thread");
            } else {
                Perl_croak(aTHX_ "Thread already joined");
            }
        }

        /* Join the thread */
        PUTBACK;
        {
	    UV token = unlock_interpreter(aTHX);
	    thread->thr->join(0);    
	    relock_interpreter(aTHX_ token);
	}
        SPAGAIN;

        thread->mutex.lock();
        /* Mark as joined */
        thread->state |= PERL_ITHR_JOINED;

        /* Get the return value from the call_sv */
        {
            AV *params_copy;
            PerlInterpreter *other_perl;
            CLONE_PARAMS clone_params;
            ithread *current_thread;

            params_copy = (AV *)SvRV(thread->params);
            other_perl = thread->interp;
            clone_params.stashes = newAV();
            clone_params.flags = CLONEf_JOIN_IN;
            PL_ptr_table = ptr_table_new();
            current_thread = S_ithread_get(aTHX);
            S_ithread_set(aTHX_ thread);
            /* Ensure 'meaningful' addresses retain their meaning */
            ptr_table_store(PL_ptr_table, &other_perl->Isv_undef, &PL_sv_undef);
            ptr_table_store(PL_ptr_table, &other_perl->Isv_no, &PL_sv_no);
            ptr_table_store(PL_ptr_table, &other_perl->Isv_yes, &PL_sv_yes);
            params = (AV *)sv_dup((SV*)params_copy, &clone_params);
            S_ithread_set(aTHX_ current_thread);
            SvREFCNT_dec(clone_params.stashes);
            SvREFCNT_inc_void(params);
            ptr_table_free(PL_ptr_table);
            PL_ptr_table = NULL;
        }

        /* We are finished with the thread */
        S_ithread_clear(aTHX_ thread);
        thread->mutex.unlock();

        {