view release on metacpan or  search on metacpan

omnithreads/omnithreads.xs  view on Meta::CPAN

    SvIOK_on(sv);
    return (0);
}

int
ithread_mg_free(pTHX_ SV *sv, MAGIC *mg)
{
    ithread *thread = (ithread *)mg->mg_ptr;
    int cleanup;

    {
	omni_mutex_lock lock(thread->mutex);
	cleanup = ((--thread->count == 0) &&
		   (thread->state & PERL_ITHR_FINISHED) &&
		   (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED)));
    }

    if (cleanup) {
        S_ithread_destruct(aTHX_ thread);
    }
    return (0);
}

int
ithread_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param)
{
    ithread *thread = (ithread *)mg->mg_ptr;
    omni_mutex_lock lock(thread->mutex);
    thread->count++;
    return (0);
}

MGVTBL ithread_vtbl = {
    ithread_mg_get,     /* get */
    0,                  /* set */
    0,                  /* len */
    0,                  /* clear */
    ithread_mg_free,    /* free */
    0,                  /* copy */
    ithread_mg_dup      /* dup */
};


/* Starts executing the thread.
 * Passed as the C level function to run in the new thread.
 */
static void *
S_ithread_run(void * arg)
{
    ithread *thread = (ithread *)arg;
    int jmp_rc = 0;
    I32 oldscope;
    int exit_app = 0;
    int exit_code = 0;
    int cleanup;

    dJMPENV;

    dTHXa(thread->interp);

    /* Blocked until ->create() call finishes */
    thread->mutex.lock();
    thread->mutex.unlock();

    PERL_SET_CONTEXT(thread->interp);
    S_ithread_set(aTHX_ thread);

    PL_perl_destruct_level = 2;

    {
        AV *params = (AV *)SvRV(thread->params);
        int len = (int)av_len(params)+1;
        int ii;

        dSP;
        ENTER;
        SAVETMPS;

        /* Put args on the stack */
        PUSHMARK(SP);
        for (ii=0; ii < len; ii++) {
            XPUSHs(av_shift(params));
        }
        PUTBACK;

        oldscope = PL_scopestack_ix;
        JMPENV_PUSH(jmp_rc);
        if (jmp_rc == 0) {
            /* Run the specified function */
            len = (int)call_sv(thread->init_function, thread->gimme|G_EVAL);
        } else if (jmp_rc == 2) {
            /* Thread exited */
            exit_app = 1;
            exit_code = STATUS_CURRENT;
            while (PL_scopestack_ix > oldscope) {
                LEAVE;
            }
        }
        JMPENV_POP;

        /* Remove args from stack and put back in params array */
        SPAGAIN;
        for (ii=len-1; ii >= 0; ii--) {
            SV *sv = POPs;
            if (jmp_rc == 0) {
                av_store(params, ii, SvREFCNT_inc(sv));
            }
        }

        FREETMPS;
        LEAVE;

        /* Check for failure */
        if (SvTRUE(ERRSV) && ckWARN_d(WARN_THREADS)) {
            oldscope = PL_scopestack_ix;
            JMPENV_PUSH(jmp_rc);
            if (jmp_rc == 0) {
                /* Warn that thread died */
                Perl_warn(aTHX_ "Thread %" UVuf " terminated abnormally: %" SVf, thread->tid, ERRSV);
            } else if (jmp_rc == 2) {
                /* Warn handler exited */