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

#define NEED_newSV_type
#include "ppport.h"

/* stuff that should probably be in ppport.h, but isn't */

/* OK, so this is wrong, but it's what 5.6 did. */
#ifndef U_32
#define U_32(nv) ( (U32) I_32(nv) )
#endif

/* blead (5.9) stores these somewhere else, with access macros */
#ifndef COP_SEQ_RANGE_LOW
#define COP_SEQ_RANGE_LOW(sv)  (U_32(SvNVX(sv)))
#define COP_SEQ_RANGE_HIGH(sv) ((U32) SvIVX(sv))
#endif

#ifndef CvISXSUB
#define CvISXSUB(cv) CvXSUB(cv)
#endif

#ifndef CvWEAKOUTSIDE
#define CvWEAKOUTSIDE(cv) (0)
#endif

#ifndef CvCONST
#define CvCONST(cv) (0)
#endif

#ifndef AvREIFY_only
#define AvREIFY_only(av) (AvFLAGS(av) = AVf_REIFY)
#endif

#ifndef SvWEAKREF
#define SvWEAKREF(sv) (0)
#endif

#ifndef hv_iternext_flags
#define hv_iternext_flags(hv, fl) hv_iternext(hv)
#endif

#ifndef HV_ITERNEXT_WANTPLACEHOLDERS
#define HV_ITERNEXT_WANTPLACEHOLDERS 0
#endif

/* again, not correct but good enough for our purposes */
#ifndef sv_magicext
#define sv_magicext(sv, obj, how, vtbl, name, namelen) \
    sv_magic(sv, obj, how, name, namelen)
#endif

#ifndef isGV_with_GP
#define isGV_with_GP(sv) 1
#endif

#ifndef CvGV_set
#define CvGV_set(cv,gv) CvGV(cv) = (gv)
#endif

#ifndef CvSTASH_set
#define CvSTASH_set(cv,st) CvSTASH(cv) = (st)
#endif

#ifndef CVf_CVGV_RC
#define CVf_CVGV_RC 0
#endif

#if PERL_VERSION < 9 || (PERL_VERSION == 8 && PERL_SUBVERSION < 9)
#define SVt_LAST 16
#endif

static const char *svtypenames[SVt_LAST] = {
#if PERL_VERSION < 9
        "NULL",
        "IV",
        "NV",
        "RV",
        "PV",
        "PVIV",
        "PVNV",
        "MG",
        "BM",
        "LV",
        "AV",
        "HV",
        "CV",
        "GV",
        "FM",
        "IO"
#elif PERL_VERSION < 11
        "NULL",
        "BIND",
        "IV",
        "NV",
        "RV",
        "PV",
        "PVIV",
        "PVNV",
        "PVMG",
        "GV",
        "LV",
        "AV",
        "HV",
        "CV",
        "FM",
        "IO"
#else
        "NULL",
        "BIND",
        "IV",
        "NV",
        "PV",
        "PVIV",
        "PVNV",
        "MG",
        "REGEXP",
        "GV",
        "LV",
        "AV",
        "HV",
        "CV",
        "FM",
        "IO"
#endif
};

#ifdef DEBUG_CLONE
#define TRACEME(a) warn a;
#else
#define TRACEME(a)
#endif

#define TRACE_TYPE(type) TRACEME(("  %s\n", svtypenames[type]))

#define TRACE_SV(action, name, sv)                              \
    TRACEME(("%s (%s) = 0x%x(%d) [%x]%s%s%s%s%s\n", action, name, sv,    \
        SvREFCNT(sv), SvFLAGS(sv),                              \
        (SvPADMY(sv)   ? " PADMY"   : ""),                      \
        (SvPADTMP(sv)  ? " PADTMP"  : ""),                      \
        (SvTEMP(sv)    ? " TEMP"    : ""),                      \
        (SvFAKE(sv)    ? " FAKE"    : ""),                      \
        (SvMAGICAL(sv) ? " MAGIC"   : "")                       \
    ))

#define TRACE_SCOPE(cv) TRACEME(("scope 0x%x:%s\n", cv, \
    (cv && CvUNIQUE(cv)) ? " UNIQUE" : ""))

#define TRACE_MG(action, type, ptr, len, obj)       \
    TRACEME(("%s (%c magic) = 0x%x[%d], 0x%x\n",    \
        action, type, ptr, len, obj))

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

#define CLONE_STORE(x,y)						\
do {									\
    if (!hv_store(SEEN, CLONE_KEY(x), PTRSIZE, SvREFCNT_inc(y), 0)) {	\
        SvREFCNT_dec(y); /* Restore the refcount */                     \
	croak("Can't store clone in seen hash (HSEEN)");		\
    }									\
    else {	                                                        \
        TRACE_SV("ref", "SEEN", x);                                     \
        TRACE_SV("clone", "SEEN", y);                                   \
    }									\
} while (0)

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

static void hv_clone        (HV *SEEN, HV *ref, HV *clone);
static void av_clone        (HV *SEEN, AV *ref, AV *clone);
static SV  *sv_clone        (HV *SEEN, SV *ref);
static CV  *CC_cv_clone     (CV *ref);
static void pad_clone       (HV *SEEN, CV *ref, CV *clone);
static CV  *pad_findscope   (CV *start, SV *ref);

static void
hv_clone(HV *SEEN, HV *ref, HV *clone)
{
    HE *next = NULL;

    TRACE_SV("ref", "HV", ref);

    hv_iterinit(ref);
    while (next = hv_iternext_flags(ref, HV_ITERNEXT_WANTPLACEHOLDERS)) {
        SV *key = hv_iterkeysv(next);
        SV *val = hv_iterval(ref, next);
        SV *cln;
        HE *elm;

        SvGETMAGIC(val);
        TRACE_SV("ref", "HV elem", val);

        cln = sv_clone(SEEN, val);

        elm = hv_store_ent(clone, key, cln, 0);
        SvSETMAGIC(cln);

        if (elm) {
            TRACE_SV("clone", "HV elem", HeVAL(elm));
        }
        else {
            TRACE_SV("drop", "HV elem", cln);
            SvREFCNT_dec(cln);
        }
    }

    TRACE_SV("clone", "HV", clone);
}

static void
av_clone(HV *SEEN, AV *ref, AV *clone)
{
    I32 arrlen = 0;
    int i = 0;

    TRACE_SV("ref", "AV", ref);

    if (SvREFCNT(ref) > 1)
        CLONE_STORE(ref, (SV *)clone);

    arrlen = av_len(ref);
    av_extend(clone, arrlen);

    for (i = 0; i <= arrlen; i++) {
        SV **val = av_fetch(ref, i, 0);

        if (val) {
            SV *cln, **elm;

            SvGETMAGIC(*val);
            TRACE_SV("ref", "AV elem", *val);

            cln = sv_clone(SEEN, *val);

            elm = av_store(clone, i, cln);
            SvSETMAGIC(cln);

            if (elm) {
                TRACE_SV("clone", "AV elem", *elm);
            }
            else {
                TRACE_SV("drop", "AV elem", cln);
                SvREFCNT_dec(cln);
            }
        }
    }

    TRACE_SV("clone", "AV", clone);
}

/* largely taken from pad.c:cv_clone (in op.c in 5.6) */
static CV *
CC_cv_clone(CV *ref)
{
    AV *const rpadlist = CvPADLIST(ref);
    AV *const rname    = (AV *)*av_fetch(rpadlist, 0, FALSE);
    U32       rdepth   = CvDEPTH(ref) ? CvDEPTH(ref) : 1;
    AV *const rpad     = (AV *)*av_fetch(rpadlist, rdepth, FALSE);
    const I32 fname    = AvFILLp(rname);
    const I32 fpad     = AvFILLp(rpad);
    SV **     prname   = AvARRAY(rname);
    AV *      cpadlist;
    AV *      cname;
    AV *      cpad;
    AV *      a0;
    CV       *clone, *outside;
    I32       ix;

    TRACE_SV("ref", "CV", ref);

    /* CvCONST is only set if the sub is actually constant */
    if (CvCONST(ref)) {
        SvREFCNT_inc(ref);
        TRACE_SV("copy", "CV", ref);
        return ref;
    }

    /* BEGIN, eval &c. */
    assert(!CvUNIQUE(ref));
#if PERL_VERSION > 9
    /* closure prototype */
    assert(!CvCLONE(ref));
#endif
    /* named sub */
    assert(CvANON(ref));
    /* an instantiated closure shouldn't be WEAKOUTSIDE */
    assert(!(!CvCLONE(ref) && CvWEAKOUTSIDE(ref)));

    outside = CvOUTSIDE(ref);
    assert(CvPADLIST(outside));
    /* we should be cloning an instantiated closure, so CvOUTSIDE
     * shouldn't be a closure prototype */
    assert(!(outside && CvCLONE(outside)));

    clone = (CV *)newSV_type(SvTYPE(ref));
    CvFLAGS(clone) = CvFLAGS(ref) & ~CVf_CVGV_RC;

#ifdef USE_ITHREADS
    CvFILE(clone)           = CvISXSUB(ref) ? CvFILE(ref)
                                            : savepv(CvFILE(ref));
#else
    CvFILE(clone)           = CvFILE(ref);
#endif
    CvGV_set(clone,         CvGV(ref));
    CvSTASH_set(clone,      CvSTASH(ref));

    OP_REFCNT_LOCK;
    CvROOT(clone)           = OpREFCNT_inc(CvROOT(ref));
    OP_REFCNT_UNLOCK;

    CvSTART(clone)          = CvSTART(ref);

    CvOUTSIDE(clone)        = outside;
    if (!CvWEAKOUTSIDE(clone)) SvREFCNT_inc(outside);
#ifdef CvOUTSIDE_SEQ
    CvOUTSIDE_SEQ(clone)    = CvOUTSIDE_SEQ(ref);
#endif

    if (SvPOK(ref))
        sv_setpvn((SV *)clone, SvPVX_const(ref), SvCUR(ref));

    /* create a new padlist, and initial pad */

    cname = newAV();
    av_fill(cname, fname);

    /* fill in the names of the lexicals */
    for (ix = fname; ix >= 0; ix--) {
        av_store(cname, ix, SvREFCNT_inc(prname[ix]));
    }

    cpad = newAV();
    av_fill(cpad,  fpad);

    /* create @_ */
    a0 = newAV();
    av_extend(a0, 0);
    av_store(cpad, 0, (SV *)a0);
    AvREIFY_only(a0);

    /* the pad is filled in later, by pad_clone */

    cpadlist = newAV();
    AvREAL_off(cpadlist);
    av_store(cpadlist, 0, (SV *)cname);
    av_store(cpadlist, 1, (SV *)cpad);

    CvPADLIST(clone) = cpadlist;

    TRACE_SV("clone", "CV", clone);

    return clone;
}

/* mostly stolen from PadWalker */

static void
pad_clone(HV *SEEN, CV *ref, CV *clone)
{
    U32 vdepth = CvDEPTH(clone) ? CvDEPTH(clone) : 1;
    U32 rdepth = CvDEPTH(ref)   ? CvDEPTH(ref)   : 1;
    AV *padn   = (AV *) *av_fetch(CvPADLIST(clone), 0,      FALSE);
    AV *padv   = (AV *) *av_fetch(CvPADLIST(clone), vdepth, FALSE);
    AV *padr   = (AV *) *av_fetch(CvPADLIST(ref),   rdepth, FALSE);
    I32 i;

    TRACE_SV("ref", "pad", ref);

    for (i = av_len(padn); i >= 0; --i) {
        SV  **name_p, *name_sv, **val_p, *val_sv;
        SV  **old_p, *old_sv, *new_sv;
        const char *name;
        bool  can_copy;
        bool  is_proto;

        name_p  = av_fetch(padn, i, 0);
        name_sv = name_p ? *name_p : &PL_sv_undef;
        name    = (name_p && SvPOKp(name_sv))
                        ? SvPVX_const(name_sv)
                        : "???";

        val_p    = av_fetch(padr, i, 0);
        val_sv   = val_p ? *val_p : &PL_sv_undef;

        is_proto = 0;

        /* The following types of entries exist in pads... */

        /* @_ must be cloned */
        if (i == 0) {
            name = "@_";
            can_copy = 0;
        }

        /* 'our' entries have everything in the name, and need no pad
         * entry */
        else if (SvFLAGS(name_sv) & SVpad_OUR) {
            can_copy = 1;
        }

        /* PADTMP entries are targs/GVs/constants, and need copying.
         * PADGV/CONST are used by ithreads */
        else if (
            SvPADTMP(val_sv) || 
            IS_PADGV(val_sv) ||
            IS_PADCONST(val_sv)
        ) {
            name = "PADTMP";
            can_copy = 1;
        }

        /* entries with names are lexicals */
        else if (name_sv != &PL_sv_undef) {

            /* closure prototypes must be copied */
            if (*name == '&') {
#if PERL_VERSION < 9
                if (!SvFAKE(name_sv)) {
                    can_copy = 0;
                    is_proto = 1;
                }
                else
#endif
                can_copy = 1;
            }

            /* non-closures must clone all lexicals */
            else if (!CvCLONED(clone)) {
                can_copy = 0;
            }

            /* lexicals declared in this sub must be cloned */
            else if (!SvFAKE(name_sv)) {
                can_copy = 0;
            }

            /* closed-over lexicals need checking */
            else {
                CV *scope;

                /* start with the scope that declared the lexical... */
                scope = pad_findscope(clone, name_sv);

                /* even if this scope is unique, it may be inside one
                 * which isn't:
                 *     sub foo { eval q/my $x; sub { $x; }/; }
                 * eval STRING is always CvUNIQUE */
                while (scope && CvUNIQUE(scope)) {
                    scope = CvOUTSIDE(scope);
                    TRACE_SCOPE(scope);
                }

                /* XXX handle locating loops: see cop@269 */

                /* if this lexical was defined in a scope that can only
                 * run once it can be copied, otherwise it must be
                 * cloned */
                can_copy = (!scope || CvUNIQUE(scope));
            }
        }

        /* just in case :) */
        else {
            warn("Clone::Closure: unknown pad entry: please report a bug!");
#ifdef DEBUG_CLONE
            warn("name:\n");
            sv_dump(name_sv);
            warn("val:\n");
            sv_dump(val_sv);
#endif
            continue;
        }

        TRACE_SV("ref", name, val_sv);

        if (is_proto) {
            assert(PERL_VERSION < 9);
#ifdef CvWEAKOUTSIDE_on
            assert(CvWEAKOUTSIDE(val_sv));
#endif

            new_sv = (SV *)CC_cv_clone((CV *)val_sv);

            CvCLONE_on(new_sv);
            SvPADMY_on(new_sv);

#ifndef CvWEAKOUTSIDE_on
            {
                CV *old = CvOUTSIDE(new_sv);
                SvREFCNT_dec(old);
                TRACE_SV("ref", "outside", old);
            }
#endif
            CvOUTSIDE(new_sv) = clone;
#ifdef CvWEAKOUTSIDE_on
            TRACE_SV("weaken", name, new_sv);
            TRACE_SV("outside", name, clone);
            CvWEAKOUTSIDE_on(new_sv);
#else
            SvREFCNT_inc(clone);
            TRACE_SV("clone", "outside", clone);
#endif

            pad_clone(SEEN, (CV *)val_sv, (CV *)new_sv);
        }
        else if (can_copy) {
            new_sv = SvREFCNT_inc(val_sv);
            CLONE_STORE(val_sv, new_sv);
        }
        else {
            new_sv = sv_clone(SEEN, val_sv);
        }
         
        TRACE_SV("ref, again", name, val_sv);
        TRACE_SV(can_copy ? "copy" : "clone", name, new_sv);

        old_p    = av_fetch(padv, i, 0);
        old_sv   = old_p ? *old_p : &PL_sv_undef;

        /* can't use av_store as the refcounts get wrong:
         * pads are AvREAL even though they shouldn't be */
        (AvARRAY(padv))[i] = new_sv;

        /* XXX I don't like this: sometimes the refcnt gets too low */
        if ( SvREFCNT(old_sv) > 1 ) {
            SvREFCNT_dec(old_sv);
            TRACE_SV("drop", name, old_sv);
        }
        else
            TRACE_SV("NO DROP", name, old_sv);
    }

    TRACE_SV("clone", "pad", clone);
}

/* locate the scope in which a lexical was declared */
/* mostly stolen from pad.c:pad_findlex */

static CV *
pad_findscope(CV *scope, SV *name_sv)
{
    const char  *name = SvPVX_const(name_sv);
    U32          seq;
    CV          *last_fake = scope;

#ifdef CvOUTSIDE_SEQ
#define MOVE_OUT(scp, sq) sq = CvOUTSIDE_SEQ(scp), scp = CvOUTSIDE(scp)
#else
    seq = SvIVX(name_sv);
#define MOVE_OUT(scp, sq) scp = CvOUTSIDE(scp)
#endif

    TRACE_SCOPE(scope);

    for ( MOVE_OUT(scope, seq); scope; MOVE_OUT(scope, seq) ) {
        SV **svp, *sv;
        AV  *padlist, *padn;
        I32  off;

        TRACE_SCOPE(scope);

        padlist = CvPADLIST(scope);
        if (!padlist) /* an undef CV */
            continue;

        svp = av_fetch(padlist, 0, FALSE);
        if (!svp || *svp == &PL_sv_undef)
            continue;

        padn = (AV *)*svp;
        svp  = AvARRAY(padn);

        for (off = AvFILLp(padn); off > 0; off--) {

            sv = svp[off];
            if (
                !sv || sv == &PL_sv_undef
                || !strEQ(SvPVX_const(sv), name)
            ) {
                continue;
            }

            if (SvFAKE(sv)) {
                last_fake = scope;
                continue;
            }
        
            if (
                seq > COP_SEQ_RANGE_LOW(sv)
                && seq <= COP_SEQ_RANGE_HIGH(sv)
            )
            {
                return scope;
            }
            else {
                TRACEME(("found %s but %x not in [%x, %x]\n",
                    name, seq, COP_SEQ_RANGE_LOW(sv),
                    COP_SEQ_RANGE_HIGH(sv)));
            }
        }
    }

    TRACEME(("no scope found; returning last_fake = 0x%x\n",
        last_fake));
    return last_fake;
}

static SV *
sv_clone(HV *SEEN, SV *ref)
{
    dTHX;
    SV *clone = ref;
    SV **seen = NULL;
    int recurse = 1;

    TRACE_SV("ref", "SV", ref);

    if (SvIMMORTAL(ref)) {
        TRACE_SV("immortal", "SV", ref);
        return ref;
    }

    if ( seen = CLONE_FETCH(ref) ) {
        SvREFCNT_inc(*seen);
        TRACE_SV("fetch", "SV", *seen);
        return *seen;
    }

    TRACEME(("switch: (0x%x)\n", ref));
    switch (SvTYPE (ref)) {

        case SVt_NULL:
#if PERL_VERSION < 11
        case SVt_IV:
#endif
        case SVt_NV:
        case SVt_PV:
        case SVt_PVIV:
        case SVt_PVNV:
        case SVt_PVMG:
#if PERL_VERSION > 10
        case SVt_REGEXP:
#endif
        case SVt_PVLV:
        simple_clone:
            TRACE_TYPE(SvTYPE(ref))
            clone = newSVsv(ref);
            break;

        case SVt_PVFM:
        case SVt_PVIO:
        simple_copy:
            TRACE_TYPE(SvTYPE(ref))
            clone = SvREFCNT_inc(ref);  /* just return the ref */
            break;

        case SVt_RV:
            if (SvROK(ref)) {
                TRACEME(("  ROK (%s)\n", svtypenames[SvTYPE(ref)]));
                clone = NEWSV(1002, 0);
                sv_upgrade(clone, SVt_RV);
                break;
            }
            goto simple_clone;

        case SVt_PVAV:
            TRACE_TYPE(SVt_PVAV);
            clone = (SV *)newAV();
            break;

        case SVt_PVHV:
            TRACE_TYPE(SVt_PVHV);
            clone = (SV *)newHV();
            break;

        case SVt_PVCV:	/* 12 */
            {
                CV *cv = (CV *)ref;
                /* we shouldn't be cloning a closure prototype */
                /* (when nec. pad_clone calls CC_cv_clone directly) */
                assert(!CvCLONE(cv));

                if (CvCLONED(cv)) {
                    /* closures are cloned */
                    TRACEME(("  CV (closure)\n"));
                    clone = (SV *)CC_cv_clone(cv);
                }
                else {
                    /* named subs aren't cloned */
                    TRACEME(("  CV\n"));
                    clone = SvREFCNT_inc(ref);
                }
                break;
            }

        case SVt_PVGV:
            if (isGV_with_GP(ref))
                goto simple_copy;
            /* fall through */

#if PERL_VERSION < 9
        case SVt_PVBM:
#endif
            TRACEME(("  PVBM\n"));
            clone = newSVsv(ref);
            fbm_compile(clone, SvTAIL(ref) ? FBMcf_TAIL : 0);
            break;
    
        default:
            croak("unknown type of scalar: 0x%x", SvTYPE(ref));
    }

    /**
    * It is *vital* that this is performed *before* recursion,
    * to properly handle circular references. cb 2001-02-06
    */

    CLONE_STORE(ref,clone);

    if (SvMAGICAL(ref) && clone != ref) {
        MAGIC*  mg;
        int     shared = 0;

        for (mg = SvMAGIC(ref); mg; mg = mg->mg_moremagic) {
            SV      *obj = mg->mg_obj;
            char    *ptr = mg->mg_ptr;
            int     keepmg = 1, copymg = 0;

            TRACE_MG("ref", mg->mg_type, ptr, mg->mg_len, obj);

            switch (mg->mg_type) {
                case PERL_MAGIC_qr:
#if PERL_VERSION < 11
                /* 'r' magic with a SvPVX is for storing (??{})
                 * patterns. 'r' magic without is for qr//.
                 */
                if (SvPVX(ref) == NULL) {
                    regexp *const re = (regexp *)mg->mg_obj;
                    obj = (SV *)ReREFCNT_inc(re); 
                    break;
                }
#endif
                keepmg = 0;
                break;

                case PERL_MAGIC_utf8:
                {
                    void *tmp;

#ifdef PERL_MAGIC_UTF8_CACHESIZE
                    if (mg->mg_ptr) {
                        Newxz(tmp, PERL_MAGIC_UTF8_CACHESIZE * 2, STRLEN);
                        ptr = (char *)tmp;
                        Copy(
                            mg->mg_ptr, ptr,
                            PERL_MAGIC_UTF8_CACHESIZE * 2, STRLEN
                        );
                    }
#else
                    croak("can't handle 'w' magic under this version of perl");
#endif
                    break;
                }

                case PERL_MAGIC_tiedelem:
                    keepmg = 0;
                    shared = -1;
                    break;

#define SvSHRTIE(sv, mg) \
    sv_isa( SvTIED_obj(sv, mg), "threads::shared::tie" )

                case PERL_MAGIC_tied:
                    /* PL_vtbl_pack is normal tie magic */
                    if (mg->mg_virtual == &PL_vtbl_pack) {
                        recurse = 0;
                        copymg  = 1;
                    }
                    else {
                        if (SvSHRTIE(ref, mg)) {
                            shared  = 1;
                            keepmg  = 0;
                        }
                        else {
                            croak("tie magic with unknown vtable");
                        }
                    }
                    break;

                case PERL_MAGIC_tiedscalar:
                case PERL_MAGIC_taint:
                case PERL_MAGIC_uvar:
                case PERL_MAGIC_uvar_elem:
                case PERL_MAGIC_vstring:
                case PERL_MAGIC_glob:
                case PERL_MAGIC_ext:
                    copymg = 1;
                    break;

                case PERL_MAGIC_shared:
                    croak("don't know how to handle 'N' magic!");

                case PERL_MAGIC_shared_scalar:
                    if (!shared) shared = 1;
                    keepmg = 0;
                    break;

                /* bm & backref magics are handled separately */
                default:
                    keepmg = 0;
                    break;
            }

            if (copymg)
                obj = obj ? sv_clone(SEEN, mg->mg_obj) : NULL;

            if (keepmg) {
                TRACE_MG("clone", mg->mg_type, ptr, mg->mg_len, obj);
                sv_magicext(
                    clone, 
                    obj,
                    mg->mg_type, 
                    mg->mg_virtual,
                    ptr, 
                    mg->mg_len
                );
            }
            else {
                TRACE_MG("drop", mg->mg_type, mg->mg_ptr, mg->mg_len,
                mg->mg_obj);
            }
        }

        if (shared > 0) {
#ifdef SvSHARE
            TRACE_SV("share", "SV", clone);
            SvSHARE(clone);
#else
            croak("can't share values in this version of perl");
#endif
        }
    }

    if (!recurse) {
        TRACE_SV("skip", "SV", clone);
    }
    else if ( SvTYPE(ref) == SVt_PVHV ) {
        hv_clone(SEEN, (HV *)ref, (HV *)clone);
    }
    else if ( SvTYPE(ref) == SVt_PVAV ) {
        av_clone(SEEN, (AV *)ref, (AV *)clone);
    }
    else if ( SvTYPE(ref) == SVt_PVCV ) {
        if (CvCLONED((CV *)ref)) {
            pad_clone(SEEN, (CV *)ref, (CV *)clone);
        }
    }
    /* 3: REFERENCE (inlined for speed) */
    else if (SvROK(ref)) {
        TRACE_SV("ref", "RV", ref);

        SvROK_on(clone);
        SvRV(clone) = sv_clone(SEEN, SvRV(ref));

        if (sv_isobject(ref)) {
            sv_bless(clone, SvSTASH(SvRV(ref)));
        }

        if (SvWEAKREF(ref)) {
            TRACE_SV("weaken", "RV", clone);
            sv_rvweaken(clone);
        }

        TRACE_SV("clone", "RV", clone);
    }

    if (SvREADONLY(ref))
        SvREADONLY_on(clone);

    TRACE_SV("clone", "SV", clone);
    return clone;
}

MODULE = Clone::Closure		PACKAGE = Clone::Closure

PROTOTYPES: ENABLE

void
_breakpoint()
    PPCODE:
        XSRETURN_UNDEF;

void
clone(ref)
	SV *ref
    PREINIT:
	SV *clone;
        HV *SEEN;
    PPCODE:
        SEEN = newHV();

        TRACE_SV("ref", "clone", ref);
	clone = sv_clone(SEEN, ref);
        TRACE_SV("clone", "clone", clone);

        SvREFCNT_dec(SEEN);

	EXTEND(SP,1);
	PUSHs(sv_2mortal(clone));