view release on metacpan or  search on metacpan

Clone.xs  view on Meta::CPAN

#define PERL_NO_GET_CONTEXT     /* we want efficiency */

#include "xshelper.h"

#define MAX_DEPTH 32000

#define CLONE_KEY(x) ((char *) &x) 

#define CLONE_STORE(x,y)                                               \
do {                                                                   \
    if (!hv_store(hseen, CLONE_KEY(x), PTRSIZE, SvREFCNT_inc(y), 0)) { \
        SvREFCNT_dec(y); /* Restore the refcount */                    \
        croak("Can't store clone in seen hash (hseen)");               \
    }                                                                  \
    else {                                                             \
        TRACEME(("storing ref = 0x%x clone = 0x%x\n", ref, clone));    \
        TRACEME(("clone = 0x%x(%d)\n", clone, SvREFCNT(clone)));       \
        TRACEME(("ref = 0x%x(%d)\n", ref, SvREFCNT(ref)));             \
    }                                                                  \
} while (0)

#define CLONE_FETCH(x) (hv_fetch(hseen, CLONE_KEY(x), PTRSIZE, 0))

#define PUSH_WEAKREFS(weakrefs, val) av_push( weakrefs, SvREFCNT_inc_simple_NN(val) )

#define HANDLE_WEAKREFS(weakrefs)                                      \
do {                                                                   \
    I32 i;                                                             \
    I32 len = av_len((weakrefs));                                      \
    for ( i = 0; i <= len; i++ ) {                                     \
        SV **svp = av_fetch( (weakrefs), i, 0 );                       \
        if ( svp && *svp && SvROK(*svp) ) sv_rvweaken(*svp);           \
    }                                                                  \
    SvREFCNT_dec( (SV *)(weakrefs) );                                  \
} while (0)

static SV *hv_clone (pTHX_ SV *, SV *, HV *, int, int, AV *);
static SV *av_clone (pTHX_ SV *, SV *, HV *, int, int, AV *);
static SV *sv_clone (pTHX_ SV *, HV *, int, int, AV *);
/* static SV *rv_clone (pTHX_ SV *, HV *, int, int, AV *); */
static SV *av_clone_iterative(pTHX_ SV *, HV *, int, AV *);

#ifdef DEBUG_CLONE
#define TRACEME(a) printf("%s:%d: ",__FUNCTION__, __LINE__) && printf a;
#else
#define TRACEME(a)
#endif

/* Check whether an mg_obj is a threads::shared::tie instance.
 * The mg_obj is an RV pointing to a blessed PVMG. (GH #18) */
static int
is_threads_shared_tie(SV *obj) {
    if ( !obj || !SvROK(obj) || !SvOBJECT(SvRV(obj)) )
        return 0;

    HV* stash = SvSTASH( SvRV(obj) );
    if ( ! stash ) return 0;

    const char *name = HvNAME(stash);
    return ( name && strcmp( name, "threads::shared::tie" ) == 0 );
}

static SV*
hv_clone (pTHX_ SV* ref, SV* target, HV* hseen, int depth, int rdepth, AV* weakrefs) {
    HV *clone = (HV *) target;
    HV *self = (HV *) ref;
    HE *next = NULL;
    int recur = depth ? depth - 1 : 0;

    assert(SvTYPE(ref) == SVt_PVHV);

    TRACEME(("ref = 0x%x(%d)\n", ref, SvREFCNT(ref)));

    hv_iterinit (self);
    while ((next = hv_iternext(self))) {
        SV *key = hv_iterkeysv(next);
        TRACEME(("clone item %s\n", SvPV_nolen(key) ));
        hv_store_ent(clone, key, sv_clone(aTHX_ hv_iterval(self, next), hseen, recur, rdepth, weakrefs), 0);
    }

    TRACEME(("clone = 0x%x(%d)\n", clone, SvREFCNT(clone)));
    return (SV *) clone;
}

static SV*
av_clone_iterative (pTHX_ SV* ref, HV* hseen, int rdepth, AV* weakrefs) {
    if (!ref) return NULL;

    AV *self = (AV *) ref;
    SV **seen = NULL;

    /* Check if we've already cloned this array */

Clone.xs  view on Meta::CPAN

                }
            }
            else {
                TRACEME(("magic object for type %c in NULL\n", mg->mg_type));
            }

            { /* clone the mg_ptr pv */
                char *mg_ptr = mg->mg_ptr; /* default */

                if ( mg->mg_len >= 0 ) { /* copy the pv */
                    if ( mg_ptr ) {
                        Newxz( mg_ptr, mg->mg_len+1, char ); /* add +1 for the NULL at the end? */
                        Copy( mg->mg_ptr, mg_ptr, mg->mg_len, char );
                    }
                }
                else if ( mg->mg_len == HEf_SVKEY ) {
                    /* let's share the SV for now */
                    SvREFCNT_inc( (SV*)mg->mg_ptr );
                    /* maybe we also want to clone the SV... */
                    /* if (mg_ptr) mg->mg_ptr = (char*) sv_clone(aTHX_ (SV*)mg->mg_ptr, hseen, -1); */
                }
                else if ( mg->mg_len == -1 && mg->mg_type == PERL_MAGIC_utf8 ) { /* copy the cache */
                    if ( mg->mg_ptr ) {
                        STRLEN *cache;
                        Newxz( cache, PERL_MAGIC_UTF8_CACHESIZE * 2, STRLEN );
                        mg_ptr = (char *) cache;
                        Copy( mg->mg_ptr, mg_ptr, PERL_MAGIC_UTF8_CACHESIZE * 2, STRLEN );
                    }
                }
                else if ( mg->mg_ptr != NULL) {
                    croak("Unsupported magic_ptr clone");
                }

                /* this is plain old magic, so do the same thing */
                sv_magic( clone, obj, mg->mg_type, mg_ptr, mg->mg_len );

            }
        }
        /* major kludge - why does the vtable for a qr type need to be null? */
        if (( mg = mg_find(clone, 'r') ))
            mg->mg_virtual = (MGVTBL *) NULL;
    }

    /* 2: HASH/ARRAY  - (with 'internal' elements) */
    if ( magic_ref ) {
        ;;
    }
    else if ( SvTYPE(ref) == SVt_PVHV )
        clone = hv_clone( aTHX_ ref, clone, hseen, depth, rdepth, weakrefs );
    else if ( SvTYPE(ref) == SVt_PVAV )
        clone = av_clone( aTHX_ ref, clone, hseen, depth, rdepth, weakrefs );
    /* 3: REFERENCE (inlined for speed) */
    else if ( SvROK(ref) ) {
        TRACEME(("clone = 0x%x(%d)\n", clone, SvREFCNT(clone)));
        SvREFCNT_dec( SvRV(clone) );
        SvRV(clone) = sv_clone( aTHX_ SvRV(ref), hseen, depth, rdepth, weakrefs ); /* Clone the referent */
        if ( sv_isobject(ref) ) {
            sv_bless( clone, SvSTASH( SvRV(ref) ) );
        }
        if ( SvWEAKREF(ref) ) {
            /* Defer weakening until after the entire clone graph is built.
             * sv_rvweaken decrements the referent's refcount, which can
             * destroy it if no other strong references exist yet.
             * By deferring, we ensure all strong references are in place
             * before any weakening occurs. */
            PUSH_WEAKREFS( weakrefs, clone );
        }
    }

    TRACEME(("clone = 0x%x(%d)\n", clone, SvREFCNT(clone)));
    return clone;
}