[p5sagit/p5-mst-13.2.git] / ext / threads / shared / shared.xs


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


void shared_sv_attach_sv (SV* sv, shared_sv* shared) {
    HV* shared_hv = get_hv("threads::shared::shared", FALSE);
    SV* id = newSViv((IV)shared);
    STRLEN length = sv_len(id);
    SV* tiedobject;
    SV** tiedobject_ = hv_fetch(shared_hv, SvPV(id,length), length, 0);
    if(tiedobject_) {
    	tiedobject = (*tiedobject_);
        SvROK_on(sv);
        SvRV(sv) = SvRV(tiedobject);

    } else {
        croak("die\n");
    }
}


int shared_sv_fetch_mg (pTHX_ SV* sv, MAGIC *mg) {
    shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj);
    SHAREDSvLOCK(shared);
    if(mg->mg_private != shared->index) {
        if(SvROK(SHAREDSvGET(shared))) {
            shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared)));
	    shared_sv_attach_sv(sv, target);
        } else {
            sv_setsv(sv, SHAREDSvGET(shared));
        }
        mg->mg_private = shared->index;
    }
    SHAREDSvUNLOCK(shared);

    return 0;
}

int shared_sv_store_mg (pTHX_ SV* sv, MAGIC *mg) {
    shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj);
    SHAREDSvLOCK(shared);
    if(SvROK(SHAREDSvGET(shared)))
        Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared))));
    if(SvROK(sv)) {
        shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(sv));
        if(!target) {
            sv_setsv(sv,SHAREDSvGET(shared));
            SHAREDSvUNLOCK(shared);            
            Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared scalar");
        }
        SHAREDSvEDIT(shared);
        Perl_sv_free(PL_sharedsv_space,SHAREDSvGET(shared));
        SHAREDSvGET(shared) = newRV_noinc(newSViv((IV)target));
    } else {
            SHAREDSvEDIT(shared);
	sv_setsv(SHAREDSvGET(shared), sv);
    }
    shared->index++;
    mg->mg_private = shared->index;
    SHAREDSvRELEASE(shared);
    if(SvROK(SHAREDSvGET(shared)))
       Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared))));       
    SHAREDSvUNLOCK(shared);
    return 0;
}

int shared_sv_destroy_mg (pTHX_ SV* sv, MAGIC *mg) {
    shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj);
    if(!shared) 
        return 0;
    Perl_sharedsv_thrcnt_dec(aTHX_ shared);
}

MGVTBL svtable = {MEMBER_TO_FPTR(shared_sv_fetch_mg),
		  MEMBER_TO_FPTR(shared_sv_store_mg),
		  0,
		  0,
		  MEMBER_TO_FPTR(shared_sv_destroy_mg)
};

MODULE = threads::shared		PACKAGE = threads::shared		


PROTOTYPES: DISABLE


SV*
ptr(ref)
	SV* ref
	CODE:
	RETVAL = newSViv(SvIV(SvRV(ref)));
	OUTPUT:
	RETVAL


SV*
_thrcnt(ref)
        SV* ref
	CODE:
        shared_sv* shared;
	if(SvROK(ref))
	    ref = SvRV(ref);
	shared = Perl_sharedsv_find(aTHX, ref);
        if(!shared)
           croak("thrcnt can only be used on shared values");
	SHAREDSvLOCK(shared);
        RETVAL = newSViv(SvREFCNT(SHAREDSvGET(shared)));
        SHAREDSvUNLOCK(shared);
	OUTPUT:
        RETVAL   


void
thrcnt_inc(ref)
        SV* ref
        CODE:
	shared_sv* shared;
        if(SvROK(ref)) 
            ref = SvRV(ref);
        shared = Perl_sharedsv_find(aTHX, ref);
        if(!shared)
           croak("thrcnt can only be used on shared values");
	Perl_sharedsv_thrcnt_inc(aTHX_ shared);

void
_thrcnt_dec(ref)
        SV* ref
        CODE:
	shared_sv* shared = (shared_sv*) SvIV(ref);
        if(!shared)
           croak("thrcnt can only be used on shared values");
	Perl_sharedsv_thrcnt_dec(aTHX_ shared);


MODULE = threads::shared		PACKAGE = threads::shared::sv		

SV*
new(class, value)
	SV* class
	SV* value
	CODE:
	shared_sv* shared = Perl_sharedsv_new(aTHX);
        MAGIC* shared_magic;
	SV* obj = newSViv((IV)shared);
	SHAREDSvEDIT(shared);
	SHAREDSvGET(shared) = newSVsv(value);
        SHAREDSvRELEASE(shared);
	sv_magic(value, 0, PERL_MAGIC_ext, "threads::shared", 16);
        shared_magic = mg_find(value, PERL_MAGIC_ext);
        shared_magic->mg_virtual = &svtable;
        shared_magic->mg_obj = newSViv((IV)shared);
        shared_magic->mg_flags |= MGf_REFCOUNTED;
        shared_magic->mg_private = 0;
        SvMAGICAL_on(value);
        RETVAL = obj;
        OUTPUT:        	
        RETVAL


MODULE = threads::shared		PACKAGE = threads::shared::av

SV* 
new(class, value)
	SV* class
	SV* value
	CODE:
	shared_sv* shared = Perl_sharedsv_new(aTHX);
	SV* obj = newSViv((IV)shared);
        SHAREDSvEDIT(shared);
        SHAREDSvGET(shared) = (SV*) newAV();
        SHAREDSvRELEASE(shared);
        RETVAL = obj;
        OUTPUT:
        RETVAL

void
STORE(self, index, value)
        SV* self
	SV* index
        SV* value
        CODE:    
        shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
        shared_sv* slot;
        SV* aentry;
	SV** aentry_;
	SHAREDSvLOCK(shared);
	aentry_ = av_fetch((AV*) SHAREDSvGET(shared), SvIV(index), 0);
	if(aentry_ && SvIV((*aentry_))) {
	    aentry = (*aentry_);
            slot = (shared_sv*) SvIV(aentry);
            if(SvROK(SHAREDSvGET(slot)))
                Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
            SHAREDSvEDIT(slot);
            sv_setsv(SHAREDSvGET(slot), value);
            SHAREDSvRELEASE(slot);
	} else {
            slot = Perl_sharedsv_new(aTHX);
            SHAREDSvEDIT(shared);
            SHAREDSvGET(slot) = newSVsv(value);
            aentry = newSViv((IV)slot);
            av_store((AV*) SHAREDSvGET(shared), SvIV(index), aentry);
            SHAREDSvRELEASE(shared);
	}
        SHAREDSvUNLOCK(shared);

SV*
FETCH(self, index)
        SV* self
	SV* index
	CODE:
	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
	shared_sv* slot;
	SV* aentry;
	SV** aentry_;
	SV* retval;
	SHAREDSvLOCK(shared);
 	aentry_ = av_fetch((AV*) SHAREDSvGET(shared), SvIV(index),0);
	if(aentry_) {
	    aentry = (*aentry_);
            if(SvTYPE(aentry) == SVt_NULL) {
	        retval = &PL_sv_undef;
	    } else {
	        slot = (shared_sv*) SvIV(aentry);
                retval = newSVsv(SHAREDSvGET(slot));
            }
	} else {
	    retval = &PL_sv_undef;
	}
        SHAREDSvUNLOCK(shared);	
        RETVAL = retval;
        OUTPUT:
        RETVAL

void
PUSH(self, ...)
	SV* self
	CODE:
	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
        int i;
        SHAREDSvLOCK(shared);
	for(i = 1; i < items; i++) {
    	    shared_sv* slot = Perl_sharedsv_new(aTHX);
	    SV* tmp = ST(i);
            SHAREDSvEDIT(slot);
	    SHAREDSvGET(slot) = newSVsv(tmp);
	    av_push((AV*) SHAREDSvGET(shared), newSViv((IV)slot));	    
	    SHAREDSvRELEASE(slot);
	}
        SHAREDSvUNLOCK(shared);

void
UNSHIFT(self, ...)
	SV* self
	CODE:
	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
        int i;
        SHAREDSvLOCK(shared);
	SHAREDSvEDIT(shared);
	av_unshift((AV*)SHAREDSvGET(shared), items - 1);
	SHAREDSvRELEASE(shared);
	for(i = 1; i < items; i++) {
    	    shared_sv* slot = Perl_sharedsv_new(aTHX);
	    SV* tmp = ST(i);
            SHAREDSvEDIT(slot);
	    SHAREDSvGET(slot) = newSVsv(tmp);
	    av_store((AV*) SHAREDSvGET(shared), i - 1, newSViv((IV)slot));
	    SHAREDSvRELEASE(slot);
	}
        SHAREDSvUNLOCK(shared);

SV*
POP(self)
	SV* self
	CODE:
	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
	shared_sv* slot;
	SV* retval;
	SHAREDSvLOCK(shared);
	SHAREDSvEDIT(shared);
	retval = av_pop((AV*)SHAREDSvGET(shared));
	SHAREDSvRELEASE(shared);
	if(retval && SvIV(retval)) {
	    slot = (shared_sv*) SvIV(retval);
	    retval = newSVsv(SHAREDSvGET(slot));
            Perl_sharedsv_thrcnt_dec(aTHX_ slot);
	} else {
            retval = &PL_sv_undef;
	}
	SHAREDSvUNLOCK(shared);
	RETVAL = retval;
	OUTPUT:
	RETVAL


SV*
SHIFT(self)
	SV* self
	CODE:
	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
	shared_sv* slot;
	SV* retval;
	SHAREDSvLOCK(shared);
	SHAREDSvEDIT(shared);
	retval = av_shift((AV*)SHAREDSvGET(shared));
	SHAREDSvRELEASE(shared);
	if(retval && SvIV(retval)) {
	    slot = (shared_sv*) SvIV(retval);
	    retval = newSVsv(SHAREDSvGET(slot));
            Perl_sharedsv_thrcnt_dec(aTHX_ slot);
	} else {
            retval = &PL_sv_undef;
	}
	SHAREDSvUNLOCK(shared);
	RETVAL = retval;
	OUTPUT:
	RETVAL

void
CLEAR(self)
	SV* self
	CODE:
	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
	shared_sv* slot;
	SV** svp;
	I32 i;
	SHAREDSvLOCK(shared);
	svp = AvARRAY((AV*)SHAREDSvGET(shared));
	i   = AvFILLp((AV*)SHAREDSvGET(shared));
	while ( i >= 0) {
	    if(SvIV(svp[i])) {
	        Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(svp[i]));
	    }
	    i--;
	}
	SHAREDSvEDIT(shared);
	av_clear((AV*)SHAREDSvGET(shared));
	SHAREDSvRELEASE(shared);
	SHAREDSvUNLOCK(shared);
	
void
EXTEND(self, count)
	SV* self
	SV* count
	CODE:
	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
	SHAREDSvEDIT(shared);
	av_extend((AV*)SHAREDSvGET(shared), (I32) SvIV(count));
	SHAREDSvRELEASE(shared);


SV*
EXISTS(self, index)
	SV* self
	SV* index
	CODE:
	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
	I32 exists;
	SHAREDSvLOCK(shared);
	exists = av_exists((AV*) SHAREDSvGET(shared), (I32) SvIV(index));
	if(exists) {
	    RETVAL = &PL_sv_yes;
	} else {
	    RETVAL = &PL_sv_no;
	}
	SHAREDSvUNLOCK(shared);

void
STORESIZE(self,count)
	SV* self
	SV* count
	CODE:
	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
	SHAREDSvEDIT(shared);
	av_fill((AV*) SHAREDSvGET(shared), (I32) SvIV(count));
	SHAREDSvRELEASE(shared);

SV*
FETCHSIZE(self)
	SV* self
	CODE:
	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
	SHAREDSvLOCK(shared);
	RETVAL = newSViv(av_len((AV*) SHAREDSvGET(shared)) + 1);
	SHAREDSvUNLOCK(shared);
	OUTPUT:
	RETVAL

SV*
DELETE(self,index)
	SV* self
	SV* index
	CODE:
	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
	shared_sv* slot;
	SHAREDSvLOCK(shared);
	if(av_exists((AV*) SHAREDSvGET(shared), (I32) SvIV(index))) {
	    SV* tmp;
	    SHAREDSvEDIT(shared);
	    tmp = av_delete((AV*)SHAREDSvGET(shared), (I32) SvIV(index),0);
	    SHAREDSvRELEASE(shared);
	    if(SvIV(tmp)) {
		slot = (shared_sv*) SvIV(tmp);
		RETVAL = newSVsv(SHAREDSvGET(slot));
                Perl_sharedsv_thrcnt_dec(aTHX_ slot);               
	    } else {
                RETVAL = &PL_sv_undef;
	    }	    
	} else {
	    RETVAL = &PL_sv_undef;
	}	
	SHAREDSvUNLOCK(shared);
	OUTPUT:
	RETVAL

AV*
SPLICE(self, offset, length, ...)
	SV* self
	SV* offset
	SV* length
	CODE:
	croak("Splice is not implmented for shared arrays");
	
MODULE = threads::shared		PACKAGE = threads::shared::hv

SV* 
new(class, value)
	SV* class
	SV* value
	CODE:
	shared_sv* shared = Perl_sharedsv_new(aTHX);
	SV* obj = newSViv((IV)shared);
        SHAREDSvEDIT(shared);
        SHAREDSvGET(shared) = (SV*) newHV();
        SHAREDSvRELEASE(shared);
        RETVAL = obj;
        OUTPUT:
        RETVAL

void
STORE(self, key, value)
        SV* self
        SV* key
        SV* value
        CODE:
        shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
        shared_sv* slot;
        SV* hentry;
        SV** hentry_;
	STRLEN len;
	char* ckey = SvPV(key, len);
        SHAREDSvLOCK(shared);
        hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len, 0);
        if(hentry_ && SvIV((*hentry_))) {
            hentry = (*hentry_);
            slot = (shared_sv*) SvIV(hentry);
            if(SvROK(SHAREDSvGET(slot)))
                Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
            SHAREDSvEDIT(slot);
            sv_setsv(SHAREDSvGET(slot), value);
            SHAREDSvRELEASE(slot);
        } else {
            slot = Perl_sharedsv_new(aTHX);
            SHAREDSvEDIT(shared);
            SHAREDSvGET(slot) = newSVsv(value);
            hentry = newSViv((IV)slot);
            hv_store((HV*) SHAREDSvGET(shared), ckey,len , hentry, 0);
            SHAREDSvRELEASE(shared);
        }
        SHAREDSvUNLOCK(shared);


SV*
FETCH(self, key)
        SV* self
        SV* key
        CODE:
        shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
        shared_sv* slot;
        SV* hentry;
        SV** hentry_;
        SV* retval;
	STRLEN len;
	char* ckey = SvPV(key, len);
        SHAREDSvLOCK(shared);
        hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len,0);
        if(hentry_) {
            hentry = (*hentry_);
            if(SvTYPE(hentry) == SVt_NULL) {
                retval = &PL_sv_undef;
            } else {
                slot = (shared_sv*) SvIV(hentry);
                retval = newSVsv(SHAREDSvGET(slot));
            }
        } else {
            retval = &PL_sv_undef;
        }
        SHAREDSvUNLOCK(shared);
        RETVAL = retval;
        OUTPUT:
        RETVAL

void
CLEAR(self)
	SV* self
	CODE:
        shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
        shared_sv* slot;
	HE* entry;
	SHAREDSvLOCK(shared);
	Perl_hv_iterinit(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
	entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
	while(entry) {
		slot = (shared_sv*) SvIV(Perl_hv_iterval(PL_sharedsv_space, (HV*) SHAREDSvGET(shared), entry));
		Perl_sharedsv_thrcnt_dec(aTHX_ slot);
		entry = Perl_hv_iternext(PL_sharedsv_space,(HV*) SHAREDSvGET(shared));
	}
	SHAREDSvEDIT(shared);
	hv_clear((HV*) SHAREDSvGET(shared));
	SHAREDSvRELEASE(shared);
	SHAREDSvUNLOCK(shared);

SV*
FIRSTKEY(self)
	SV* self
	CODE:
        shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
	char* key = NULL;
	I32 len;
	HE* entry;
	SHAREDSvLOCK(shared);
        Perl_hv_iterinit(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
        entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
	if(entry) {
                key = Perl_hv_iterkey(PL_sharedsv_space, entry,&len);
		RETVAL = newSVpv(key, len);
        } else {
	     RETVAL = &PL_sv_undef;
	}
        SHAREDSvUNLOCK(shared);
	OUTPUT:
	RETVAL


SV*
NEXTKEY(self, oldkey)
        SV* self
	SV* oldkey
        CODE:
        shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
        char* key = NULL;
        I32 len;
        HE* entry;
        SHAREDSvLOCK(shared);
        entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
        if(entry) {
                key = Perl_hv_iterkey(PL_sharedsv_space, entry,&len);
                RETVAL = newSVpv(key, len);
        } else {
             RETVAL = &PL_sv_undef;
        }
        SHAREDSvUNLOCK(shared);
        OUTPUT:
        RETVAL


SV*
EXISTS(self, key)
	SV* self
	SV* key
	CODE:
	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
	STRLEN len;
	char* ckey = SvPV(key, len);
	SHAREDSvLOCK(shared);
	if(hv_exists((HV*)SHAREDSvGET(shared), ckey, len)) {
		RETVAL = &PL_sv_yes;
	} else {
		RETVAL = &PL_sv_no;
	}
	SHAREDSvUNLOCK(shared);
	OUTPUT:
	RETVAL

SV*
DELETE(self, key)
        SV* self
        SV* key
        CODE:
        shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
	shared_sv* slot;
        STRLEN len;
        char* ckey = SvPV(key, len);
        SV* tmp;
	SHAREDSvLOCK(shared);
	SHAREDSvEDIT(shared);
	tmp = hv_delete((HV*) SHAREDSvGET(shared), ckey, len,0);
	SHAREDSvRELEASE(shared);
	if(tmp) {
		slot = (shared_sv*) SvIV(tmp);
		RETVAL = newSVsv(SHAREDSvGET(slot));
		Perl_sharedsv_thrcnt_dec(aTHX_ slot);
	} else {
		RETVAL = &PL_sv_undef;
	}
        SHAREDSvUNLOCK(shared);
        OUTPUT:
        RETVAL
Commit	Line	Data
b050c948	1
	2	#include "EXTERN.h"
	3	#include "perl.h"
	4	#include "XSUB.h"
	5
	6
	7	void shared_sv_attach_sv (SV* sv, shared_sv* shared) {
	8	HV* shared_hv = get_hv("threads::shared::shared", FALSE);
	9	SV* id = newSViv((IV)shared);
	10	STRLEN length = sv_len(id);
	11	SV* tiedobject;
	12	SV** tiedobject_ = hv_fetch(shared_hv, SvPV(id,length), length, 0);
	13	if(tiedobject_) {
	14	tiedobject = (*tiedobject_);
	15	SvROK_on(sv);
	16	SvRV(sv) = SvRV(tiedobject);
	17
	18	} else {
	19	croak("die\n");
	20	}
	21	}
	22
	23
	24	int shared_sv_fetch_mg (pTHX_ SV* sv, MAGIC *mg) {
	25	shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj);
	26	SHAREDSvLOCK(shared);
55fc11ad	27	if(mg->mg_private != shared->index) {
	28	if(SvROK(SHAREDSvGET(shared))) {
	29	shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared)));
	30	shared_sv_attach_sv(sv, target);
	31	} else {
	32	sv_setsv(sv, SHAREDSvGET(shared));
	33	}
	34	mg->mg_private = shared->index;
b050c948	35	}
	36	SHAREDSvUNLOCK(shared);
	37
	38	return 0;
	39	}
	40
	41	int shared_sv_store_mg (pTHX_ SV* sv, MAGIC *mg) {
	42	shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj);
	43	SHAREDSvLOCK(shared);
	44	if(SvROK(SHAREDSvGET(shared)))
	45	Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared))));
b050c948	46	if(SvROK(sv)) {
	47	shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(sv));
	48	if(!target) {
b050c948	49	sv_setsv(sv,SHAREDSvGET(shared));
	50	SHAREDSvUNLOCK(shared);
	51	Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared scalar");
	52	}
f70d29d4	53	SHAREDSvEDIT(shared);
b050c948	54	Perl_sv_free(PL_sharedsv_space,SHAREDSvGET(shared));
b050c948	55	SHAREDSvGET(shared) = newRV_noinc(newSViv((IV)target));
b050c948	56	} else {
f70d29d4	57	SHAREDSvEDIT(shared);
f70d29d4	58	sv_setsv(SHAREDSvGET(shared), sv);
b050c948	59	}
55fc11ad	60	shared->index++;
55fc11ad	61	mg->mg_private = shared->index;
b050c948	62	SHAREDSvRELEASE(shared);
	63	if(SvROK(SHAREDSvGET(shared)))
	64	Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared))));
	65	SHAREDSvUNLOCK(shared);
	66	return 0;
	67	}
	68
	69	int shared_sv_destroy_mg (pTHX_ SV* sv, MAGIC *mg) {
	70	shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj);
	71	if(!shared)
	72	return 0;
	73	Perl_sharedsv_thrcnt_dec(aTHX_ shared);
	74	}
	75
	76	MGVTBL svtable = {MEMBER_TO_FPTR(shared_sv_fetch_mg),
	77	MEMBER_TO_FPTR(shared_sv_store_mg),
	78	0,
	79	0,
	80	MEMBER_TO_FPTR(shared_sv_destroy_mg)
	81	};
	82
	83	MODULE = threads::shared PACKAGE = threads::shared
	84
	85
	86	PROTOTYPES: DISABLE
	87
	88
	89	SV*
	90	ptr(ref)
	91	SV* ref
	92	CODE:
	93	RETVAL = newSViv(SvIV(SvRV(ref)));
	94	OUTPUT:
	95	RETVAL
	96
	97
	98	SV*
	99	_thrcnt(ref)
	100	SV* ref
	101	CODE:
866fba46	102	shared_sv* shared;
	103	if(SvROK(ref))
	104	ref = SvRV(ref);
	105	shared = Perl_sharedsv_find(aTHX, ref);
b050c948	106	if(!shared)
	107	croak("thrcnt can only be used on shared values");
	108	SHAREDSvLOCK(shared);
	109	RETVAL = newSViv(SvREFCNT(SHAREDSvGET(shared)));
	110	SHAREDSvUNLOCK(shared);
	111	OUTPUT:
	112	RETVAL
	113
	114
	115	void
	116	thrcnt_inc(ref)
	117	SV* ref
	118	CODE:
	119	shared_sv* shared;
	120	if(SvROK(ref))
	121	ref = SvRV(ref);
	122	shared = Perl_sharedsv_find(aTHX, ref);
	123	if(!shared)
	124	croak("thrcnt can only be used on shared values");
	125	Perl_sharedsv_thrcnt_inc(aTHX_ shared);
	126
866fba46	127	void
	128	_thrcnt_dec(ref)
	129	SV* ref
	130	CODE:
	131	shared_sv* shared = (shared_sv*) SvIV(ref);
	132	if(!shared)
	133	croak("thrcnt can only be used on shared values");
	134	Perl_sharedsv_thrcnt_dec(aTHX_ shared);
	135
b050c948	136
	137	MODULE = threads::shared PACKAGE = threads::shared::sv
	138
	139	SV*
	140	new(class, value)
	141	SV* class
	142	SV* value
	143	CODE:
	144	shared_sv* shared = Perl_sharedsv_new(aTHX);
	145	MAGIC* shared_magic;
	146	SV* obj = newSViv((IV)shared);
	147	SHAREDSvEDIT(shared);
	148	SHAREDSvGET(shared) = newSVsv(value);
	149	SHAREDSvRELEASE(shared);
	150	sv_magic(value, 0, PERL_MAGIC_ext, "threads::shared", 16);
	151	shared_magic = mg_find(value, PERL_MAGIC_ext);
	152	shared_magic->mg_virtual = &svtable;
	153	shared_magic->mg_obj = newSViv((IV)shared);
	154	shared_magic->mg_flags \|= MGf_REFCOUNTED;
55fc11ad	155	shared_magic->mg_private = 0;
b050c948	156	SvMAGICAL_on(value);
	157	RETVAL = obj;
	158	OUTPUT:
	159	RETVAL
	160
	161
aaf3876d	162	MODULE = threads::shared PACKAGE = threads::shared::av
	163
	164	SV*
	165	new(class, value)
	166	SV* class
	167	SV* value
	168	CODE:
	169	shared_sv* shared = Perl_sharedsv_new(aTHX);
	170	SV* obj = newSViv((IV)shared);
	171	SHAREDSvEDIT(shared);
	172	SHAREDSvGET(shared) = (SV*) newAV();
	173	SHAREDSvRELEASE(shared);
	174	RETVAL = obj;
	175	OUTPUT:
	176	RETVAL
	177
	178	void
	179	STORE(self, index, value)
	180	SV* self
	181	SV* index
	182	SV* value
	183	CODE:
	184	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
	185	shared_sv* slot;
	186	SV* aentry;
	187	SV** aentry_;
	188	SHAREDSvLOCK(shared);
	189	aentry_ = av_fetch((AV*) SHAREDSvGET(shared), SvIV(index), 0);
	190	if(aentry_ && SvIV((*aentry_))) {
	191	aentry = (*aentry_);
	192	slot = (shared_sv*) SvIV(aentry);
	193	if(SvROK(SHAREDSvGET(slot)))
	194	Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
	195	SHAREDSvEDIT(slot);
	196	sv_setsv(SHAREDSvGET(slot), value);
	197	SHAREDSvRELEASE(slot);
	198	} else {
	199	slot = Perl_sharedsv_new(aTHX);
	200	SHAREDSvEDIT(shared);
	201	SHAREDSvGET(slot) = newSVsv(value);
	202	aentry = newSViv((IV)slot);
	203	av_store((AV*) SHAREDSvGET(shared), SvIV(index), aentry);
	204	SHAREDSvRELEASE(shared);
	205	}
	206	SHAREDSvUNLOCK(shared);
	207
	208	SV*
	209	FETCH(self, index)
	210	SV* self
	211	SV* index
	212	CODE:
	213	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
	214	shared_sv* slot;
	215	SV* aentry;
	216	SV** aentry_;
	217	SV* retval;
	218	SHAREDSvLOCK(shared);
	219	aentry_ = av_fetch((AV*) SHAREDSvGET(shared), SvIV(index),0);
	220	if(aentry_) {
	221	aentry = (*aentry_);
	222	if(SvTYPE(aentry) == SVt_NULL) {
	223	retval = &PL_sv_undef;
	224	} else {
	225	slot = (shared_sv*) SvIV(aentry);
226	retval = newSVsv(SHAREDSvGET(slot));
227	}
228	} else {
229	retval = &PL_sv_undef;
230	}
231	SHAREDSvUNLOCK(shared);
232	RETVAL = retval;
233	OUTPUT:
234	RETVAL
235
236	void
237	PUSH(self, ...)
238	SV* self
239	CODE:
240	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
241	int i;
242	SHAREDSvLOCK(shared);
243	for(i = 1; i < items; i++) {
244	shared_sv* slot = Perl_sharedsv_new(aTHX);
245	SV* tmp = ST(i);
246	SHAREDSvEDIT(slot);
247	SHAREDSvGET(slot) = newSVsv(tmp);
248	av_push((AV*) SHAREDSvGET(shared), newSViv((IV)slot));
249	SHAREDSvRELEASE(slot);
250	}
251	SHAREDSvUNLOCK(shared);
252
253	void
254	UNSHIFT(self, ...)
255	SV* self
256	CODE:
257	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
258	int i;
259	SHAREDSvLOCK(shared);
260	SHAREDSvEDIT(shared);
261	av_unshift((AV*)SHAREDSvGET(shared), items - 1);
262	SHAREDSvRELEASE(shared);
263	for(i = 1; i < items; i++) {
264	shared_sv* slot = Perl_sharedsv_new(aTHX);
265	SV* tmp = ST(i);
266	SHAREDSvEDIT(slot);
267	SHAREDSvGET(slot) = newSVsv(tmp);
268	av_store((AV*) SHAREDSvGET(shared), i - 1, newSViv((IV)slot));
269	SHAREDSvRELEASE(slot);
270	}
271	SHAREDSvUNLOCK(shared);
272
273	SV*
274	POP(self)
275	SV* self
276	CODE:
277	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
278	shared_sv* slot;
279	SV* retval;
280	SHAREDSvLOCK(shared);
281	SHAREDSvEDIT(shared);
282	retval = av_pop((AV*)SHAREDSvGET(shared));
283	SHAREDSvRELEASE(shared);
284	if(retval && SvIV(retval)) {
285	slot = (shared_sv*) SvIV(retval);
286	retval = newSVsv(SHAREDSvGET(slot));
287	Perl_sharedsv_thrcnt_dec(aTHX_ slot);
288	} else {
289	retval = &PL_sv_undef;
290	}
291	SHAREDSvUNLOCK(shared);
292	RETVAL = retval;
293	OUTPUT:
294	RETVAL
295
296
297	SV*
298	SHIFT(self)
299	SV* self
300	CODE:
301	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
302	shared_sv* slot;
303	SV* retval;
304	SHAREDSvLOCK(shared);
305	SHAREDSvEDIT(shared);
306	retval = av_shift((AV*)SHAREDSvGET(shared));
307	SHAREDSvRELEASE(shared);
308	if(retval && SvIV(retval)) {
309	slot = (shared_sv*) SvIV(retval);
310	retval = newSVsv(SHAREDSvGET(slot));
311	Perl_sharedsv_thrcnt_dec(aTHX_ slot);
312	} else {
313	retval = &PL_sv_undef;
314	}
315	SHAREDSvUNLOCK(shared);
316	RETVAL = retval;
317	OUTPUT:
318	RETVAL
319
320	void
321	CLEAR(self)
322	SV* self
323	CODE:
324	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
325	shared_sv* slot;
326	SV** svp;
327	I32 i;
328	SHAREDSvLOCK(shared);
329	svp = AvARRAY((AV*)SHAREDSvGET(shared));
330	i = AvFILLp((AV*)SHAREDSvGET(shared));
331	while ( i >= 0) {
332	if(SvIV(svp[i])) {
333	Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(svp[i]));
334	}
335	i--;
336	}
337	SHAREDSvEDIT(shared);
338	av_clear((AV*)SHAREDSvGET(shared));
339	SHAREDSvRELEASE(shared);
340	SHAREDSvUNLOCK(shared);
341
342	void
343	EXTEND(self, count)
344	SV* self
345	SV* count
346	CODE:
347	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
348	SHAREDSvEDIT(shared);
349	av_extend((AV*)SHAREDSvGET(shared), (I32) SvIV(count));
350	SHAREDSvRELEASE(shared);
351
352
353
354
355	SV*
356	EXISTS(self, index)
357	SV* self
358	SV* index
359	CODE:
360	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
361	I32 exists;
362	SHAREDSvLOCK(shared);
363	exists = av_exists((AV*) SHAREDSvGET(shared), (I32) SvIV(index));
364	if(exists) {
365	RETVAL = &PL_sv_yes;
366	} else {
367	RETVAL = &PL_sv_no;
368	}
369	SHAREDSvUNLOCK(shared);
370
371	void
372	STORESIZE(self,count)
373	SV* self
374	SV* count
375	CODE:
376	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
377	SHAREDSvEDIT(shared);
378	av_fill((AV*) SHAREDSvGET(shared), (I32) SvIV(count));
379	SHAREDSvRELEASE(shared);
380
381	SV*
382	FETCHSIZE(self)
383	SV* self
384	CODE:
385	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
386	SHAREDSvLOCK(shared);
387	RETVAL = newSViv(av_len((AV*) SHAREDSvGET(shared)) + 1);
388	SHAREDSvUNLOCK(shared);
389	OUTPUT:
390	RETVAL
391
392	SV*
393	DELETE(self,index)
394	SV* self
395	SV* index
396	CODE:
397	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
398	shared_sv* slot;
399	SHAREDSvLOCK(shared);
400	if(av_exists((AV*) SHAREDSvGET(shared), (I32) SvIV(index))) {
401	SV* tmp;
402	SHAREDSvEDIT(shared);
403	tmp = av_delete((AV*)SHAREDSvGET(shared), (I32) SvIV(index),0);
404	SHAREDSvRELEASE(shared);
405	if(SvIV(tmp)) {
406	slot = (shared_sv*) SvIV(tmp);
407	RETVAL = newSVsv(SHAREDSvGET(slot));
408	Perl_sharedsv_thrcnt_dec(aTHX_ slot);
409	} else {
410	RETVAL = &PL_sv_undef;
411	}
412	} else {
413	RETVAL = &PL_sv_undef;
414	}
415	SHAREDSvUNLOCK(shared);
416	OUTPUT:
417	RETVAL
418
419	AV*
420	SPLICE(self, offset, length, ...)
421	SV* self
422	SV* offset
423	SV* length
424	CODE:
425	croak("Splice is not implmented for shared arrays");
426
8669ce85	427	MODULE = threads::shared PACKAGE = threads::shared::hv
aaf3876d	428
8669ce85	429	SV*
	430	new(class, value)
	431	SV* class
	432	SV* value
	433	CODE:
	434	shared_sv* shared = Perl_sharedsv_new(aTHX);
	435	SV* obj = newSViv((IV)shared);
	436	SHAREDSvEDIT(shared);
	437	SHAREDSvGET(shared) = (SV*) newHV();
	438	SHAREDSvRELEASE(shared);
	439	RETVAL = obj;
	440	OUTPUT:
	441	RETVAL
	442
	443	void
	444	STORE(self, key, value)
	445	SV* self
	446	SV* key
	447	SV* value
	448	CODE:
	449	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
	450	shared_sv* slot;
	451	SV* hentry;
	452	SV** hentry_;
	453	STRLEN len;
	454	char* ckey = SvPV(key, len);
	455	SHAREDSvLOCK(shared);
	456	hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len, 0);
	457	if(hentry_ && SvIV((*hentry_))) {
	458	hentry = (*hentry_);
	459	slot = (shared_sv*) SvIV(hentry);
	460	if(SvROK(SHAREDSvGET(slot)))
	461	Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
	462	SHAREDSvEDIT(slot);
	463	sv_setsv(SHAREDSvGET(slot), value);
	464	SHAREDSvRELEASE(slot);
	465	} else {
	466	slot = Perl_sharedsv_new(aTHX);
	467	SHAREDSvEDIT(shared);
	468	SHAREDSvGET(slot) = newSVsv(value);
	469	hentry = newSViv((IV)slot);
	470	hv_store((HV*) SHAREDSvGET(shared), ckey,len , hentry, 0);
	471	SHAREDSvRELEASE(shared);
	472	}
	473	SHAREDSvUNLOCK(shared);
	474
	475
	476	SV*
	477	FETCH(self, key)
	478	SV* self
	479	SV* key
	480	CODE:
	481	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
	482	shared_sv* slot;
	483	SV* hentry;
	484	SV** hentry_;
	485	SV* retval;
	486	STRLEN len;
	487	char* ckey = SvPV(key, len);
	488	SHAREDSvLOCK(shared);
	489	hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len,0);
	490	if(hentry_) {
	491	hentry = (*hentry_);
	492	if(SvTYPE(hentry) == SVt_NULL) {
493	retval = &PL_sv_undef;
494	} else {
495	slot = (shared_sv*) SvIV(hentry);
496	retval = newSVsv(SHAREDSvGET(slot));
497	}
498	} else {
499	retval = &PL_sv_undef;
500	}
501	SHAREDSvUNLOCK(shared);
502	RETVAL = retval;
503	OUTPUT:
504	RETVAL
505
506	void
507	CLEAR(self)
508	SV* self
509	CODE:
510	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
511	shared_sv* slot;
512	HE* entry;
513	SHAREDSvLOCK(shared);
514	Perl_hv_iterinit(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
515	entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
516	while(entry) {
517	slot = (shared_sv) SvIV(Perl_hv_iterval(PL_sharedsv_space, (HV) SHAREDSvGET(shared), entry));
518	Perl_sharedsv_thrcnt_dec(aTHX_ slot);
519	entry = Perl_hv_iternext(PL_sharedsv_space,(HV*) SHAREDSvGET(shared));
520	}
521	SHAREDSvEDIT(shared);
522	hv_clear((HV*) SHAREDSvGET(shared));
523	SHAREDSvRELEASE(shared);
524	SHAREDSvUNLOCK(shared);
525
526	SV*
527	FIRSTKEY(self)
528	SV* self
529	CODE:
530	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
531	char* key = NULL;
532	I32 len;
533	HE* entry;
534	SHAREDSvLOCK(shared);
535	Perl_hv_iterinit(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
536	entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
537	if(entry) {
538	key = Perl_hv_iterkey(PL_sharedsv_space, entry,&len);
539	RETVAL = newSVpv(key, len);
540	} else {
541	RETVAL = &PL_sv_undef;
542	}
543	SHAREDSvUNLOCK(shared);
544	OUTPUT:
545	RETVAL
546
547
548	SV*
549	NEXTKEY(self, oldkey)
550	SV* self
551	SV* oldkey
552	CODE:
553	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
554	char* key = NULL;
555	I32 len;
556	HE* entry;
557	SHAREDSvLOCK(shared);
558	entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
559	if(entry) {
560	key = Perl_hv_iterkey(PL_sharedsv_space, entry,&len);
561	RETVAL = newSVpv(key, len);
562	} else {
563	RETVAL = &PL_sv_undef;
564	}
565	SHAREDSvUNLOCK(shared);
566	OUTPUT:
567	RETVAL
568
569
570	SV*
571	EXISTS(self, key)
572	SV* self
573	SV* key
574	CODE:
575	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
576	STRLEN len;
577	char* ckey = SvPV(key, len);
578	SHAREDSvLOCK(shared);
579	if(hv_exists((HV*)SHAREDSvGET(shared), ckey, len)) {
580	RETVAL = &PL_sv_yes;
581	} else {
582	RETVAL = &PL_sv_no;
583	}
584	SHAREDSvUNLOCK(shared);
585	OUTPUT:
586	RETVAL
587
588	SV*
589	DELETE(self, key)
590	SV* self
591	SV* key
592	CODE:
593	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
594	shared_sv* slot;
595	STRLEN len;
596	char* ckey = SvPV(key, len);
597	SV* tmp;
598	SHAREDSvLOCK(shared);
599	SHAREDSvEDIT(shared);
600	tmp = hv_delete((HV*) SHAREDSvGET(shared), ckey, len,0);
601	SHAREDSvRELEASE(shared);
602	if(tmp) {
b48e3745	603	slot = (shared_sv*) SvIV(tmp);
8669ce85	604	RETVAL = newSVsv(SHAREDSvGET(slot));
	605	Perl_sharedsv_thrcnt_dec(aTHX_ slot);
	606	} else {
	607	RETVAL = &PL_sv_undef;
	608	}
	609	SHAREDSvUNLOCK(shared);
	610	OUTPUT:
	611	RETVAL