#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#define NEED_PL_signals
#include "ppport.h"

#define MY_CXT_KEY "threads::shared::_guts" XS_VERSION

typedef struct {
    int dummy;          /* you can access this elsewhere as MY_CXT.dummy */
} my_cxt_t;

START_MY_CXT

void
exec_leave(pTHX_ SV *both) {
    U32 process;
    U32 ordinal;
    AV *av_ord_lock;

    dSP;
    ENTER;
    SAVETMPS;

    av_ord_lock = (AV*)SvRV(both);
    process = (U32)SvUV((SV*)*av_fetch(av_ord_lock, 1, 0));
    ordinal = (U32)SvUV((SV*)*av_fetch(av_ord_lock, 2, 0));
  /*  printf ("unlock: ordinal = %d, process = %d\n",ordinal,process); */
    SvREFCNT_dec(av_ord_lock);
    SvREFCNT_dec(both);

    PUSHMARK(SP);
    XPUSHs(sv_2mortal(newSVuv(ordinal)));
    PUTBACK;

    if (process == getpid()) {
        call_pv( "threads::shared::_unlock",G_DISCARD );
    }

    SPAGAIN;
    PUTBACK;
    FREETMPS;
    LEAVE;
}

MODULE = forks               PACKAGE = threads::shared

#----------------------------------------------------------------------
# OUT: 1 boolean value indicating whether unsafe signals are in use 

bool
_check_pl_signal_unsafe_flag()
    PREINIT:
        U32 flags;
    CODE:
        flags = PL_signals & PERL_SIGNALS_UNSAFE_FLAG;
        if (flags == 0) {
            RETVAL = 0;
        } else {
            RETVAL = 1;
        }
    OUTPUT:
        RETVAL

#----------------------------------------------------------------------
#  IN: 1 any variable (scalar,array,hash,glob)
# OUT: 1 reference to that variable

SV*
share(SV *myref)
    PROTOTYPE: \[$@%]
    CODE:
        myref = SvRV(myref);
        if(SvROK(myref))
            myref = SvRV(myref);

        ENTER;
        SAVETMPS;

        PUSHMARK(SP);
        XPUSHs(sv_2mortal(newRV_inc(myref)));
        PUTBACK;

        call_pv( "threads::shared::_share",G_DISCARD );

        FREETMPS;
        LEAVE;
        RETVAL = newRV_inc(myref);
    OUTPUT:
        RETVAL

#----------------------------------------------------------------------
#  IN: 1 any variable (scalar,array,hash,glob)
# OUT: 1 reference to that variable

SV*
share_disabled(SV *myref)
    PROTOTYPE: \[$@%]
    CODE:
        myref = SvRV(myref);
        if(SvROK(myref))
            myref = SvRV(myref);
        RETVAL = newRV_inc(myref);
    OUTPUT:
        RETVAL

#----------------------------------------------------------------------
#  IN: 1 any variable (scalar,array,hash,glob)

void
lock(SV *myref)
    PROTOTYPE: \[$@%]
    PPCODE:
        int count;
        U32 process;
        U32 ordinal;
        AV *av_ord_lock;

        LEAVE;

        myref = SvRV(myref);
        if(SvROK(myref))
            myref = SvRV(myref);

        ENTER;
        SAVETMPS;

        PUSHMARK(SP);
        XPUSHs(sv_2mortal(newSVpv("_lock",0)));
        XPUSHs(sv_2mortal(newRV_inc(myref)));
        PUTBACK;

        process = getpid();
        count = call_pv( "threads::shared::_remote",G_SCALAR );

        SPAGAIN;
        ordinal = POPl;
   /*     printf ("lock: ordinal = %d, process = %d\n",ordinal,process); */
        PUTBACK;

        FREETMPS;
        LEAVE;
        
        av_ord_lock = newAV();
        av_store(av_ord_lock, 1, newSVuv(process));
        av_store(av_ord_lock, 2, newSVuv(ordinal));

        SAVEDESTRUCTOR_X(exec_leave,newRV((SV*)av_ord_lock));
        ENTER;

#----------------------------------------------------------------------
#  IN: 1 any variable (scalar,array,hash,glob) -- signal variable
#      2 any variable (scalar,array,hash,glob) -- lock variable

void
cond_wait(SV *myref, ...)
    PROTOTYPE: \[$@%];\[$@%]
    PREINIT:
        SV *myref2;
    CODE:
        myref = SvRV(myref);
        if(SvROK(myref))
            myref = SvRV(myref);
        if (items > 1)
        {
            myref2 = SvRV(ST(1));
            if(SvROK(myref2))
                myref2 = SvRV(myref2);
        }
        
        ENTER;
        SAVETMPS;

        PUSHMARK(SP);
        XPUSHs(sv_2mortal(newSVpv("_wait",0)));
        XPUSHs(sv_2mortal(newRV_inc(myref)));
        if (items > 1)
            XPUSHs(sv_2mortal(newRV_inc(myref2)));
        PUTBACK;

        call_pv( "threads::shared::_remote",G_DISCARD );

        FREETMPS;
        LEAVE;

#----------------------------------------------------------------------
#  IN: 1 any variable (scalar,array,hash,glob) -- signal variable
#      2 epoch time of event expiration
#      3 any variable (scalar,array,hash,glob) -- lock variable

bool
cond_timedwait(SV *myref, double epochts, ...)
    PROTOTYPE: \[$@%]$;\[$@%]
    PREINIT:
        SV *myref2;
        int count;
        bool retval;
        U32 ordinal;
    CODE:
        myref = SvRV(myref);
        if(SvROK(myref))
            myref = SvRV(myref);
        if (items > 2)
        {
            myref2 = SvRV(ST(2));
            if(SvROK(myref2))
                myref2 = SvRV(myref2);
        }

        ENTER;
        SAVETMPS;

        PUSHMARK(SP);
        XPUSHs(sv_2mortal(newSVpv("_timedwait",0)));
        XPUSHs(sv_2mortal(newRV_inc(myref)));
        XPUSHs(sv_2mortal(newSVnv(epochts)));
        if (items > 2)
            XPUSHs(sv_2mortal(newRV_inc(myref2)));
        PUTBACK;

        count = call_pv( "threads::shared::_remote",G_ARRAY );

        SPAGAIN;
        if (count != 2)
            croak ("Error receiving response value from _remote\n");

        retval = POPi;
        ordinal = POPi;
        PUTBACK;

        FREETMPS;
        LEAVE;
        RETVAL = retval;
    OUTPUT:
        RETVAL

#----------------------------------------------------------------------
#  IN: 1 any variable (scalar,array,hash,glob)

void
cond_signal(SV *myref)
    PROTOTYPE: \[$@%]
    CODE:
        myref = SvRV(myref);
        if(SvROK(myref))
            myref = SvRV(myref);

        ENTER;
        SAVETMPS;

        PUSHMARK(SP);
        XPUSHs(sv_2mortal(newSVpv("_signal",0)));
        XPUSHs(sv_2mortal(newRV_inc(myref)));
        PUTBACK;

        call_pv( "threads::shared::_remote",G_DISCARD );

        FREETMPS;
        LEAVE;

#----------------------------------------------------------------------
#  IN: 1 any variable (scalar,array,hash,glob)

void
cond_broadcast(SV *myref)
    PROTOTYPE: \[$@%]
    CODE:
        myref = SvRV(myref);
        if(SvROK(myref))
            myref = SvRV(myref);

        ENTER;
        SAVETMPS;

        PUSHMARK(SP);
        XPUSHs(sv_2mortal(newSVpv("_broadcast",0)));
        XPUSHs(sv_2mortal(newRV_inc(myref)));
        PUTBACK;

        call_pv( "threads::shared::_remote",G_DISCARD );

        FREETMPS;
        LEAVE;

#----------------------------------------------------------------------
#  IN: 1 scalar
#  IN: 1 optional scalar

void
bless(SV *myref, ...)
    PROTOTYPE: $;$
    PREINIT:
        HV* stash;
        SV* classname;
        STRLEN len;
        char *ptr;
        SV* myref2;
    CODE:
        if (items == 1) {
            stash = CopSTASH(PL_curcop);
        } else {
            classname = ST(1);

            if (classname &&
                ! SvGMAGICAL(classname) &&
                ! SvAMAGIC(classname) &&
                SvROK(classname))
            {
                Perl_croak(aTHX_ "Attempt to bless into a reference");
            }
            ptr = SvPV(classname, len);
            if (ckWARN(WARN_MISC) && len == 0) {
                Perl_warner(aTHX_ packWARN(WARN_MISC),
                        "Explicit blessing to '' (assuming package main)");
            }
            stash = gv_stashpvn(ptr, len, TRUE);
        }
        SvREFCNT_inc(myref);
        (void)sv_bless(myref, stash);
        ST(0) = sv_2mortal(myref);
        
        myref2 = SvRV(myref);
        if(SvROK(myref2)) {
            myref2 = SvRV(myref2);
        }

        ENTER;
        SAVETMPS;

        PUSHMARK(SP);
        XPUSHs(sv_2mortal(newRV(myref2)));
        XPUSHs(sv_2mortal(newSVpv(HvNAME(stash), 0)));
        PUTBACK;

        call_pv( "threads::shared::_bless",G_DISCARD );
        
        FREETMPS;
        LEAVE;

#----------------------------------------------------------------------

BOOT:
{
    MY_CXT_INIT;
}