X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Findirect.git;a=blobdiff_plain;f=indirect.xs;h=45309ce648a1cf43b3b0cccd4a31b076d864a616;hp=b5e0675448331df025ad1a0c67db04dc3f6f0ceb;hb=8e1c49f42da7671812398f92d819da04c7a41e1b;hpb=24819cd3b0b220a2d05ae0346e3c745c45261b31 diff --git a/indirect.xs b/indirect.xs index b5e0675..45309ce 100644 --- a/indirect.xs +++ b/indirect.xs @@ -6,6 +6,23 @@ #include "perl.h" #include "XSUB.h" +#define __PACKAGE__ "indirect" +#define __PACKAGE_LEN__ (sizeof(__PACKAGE__)-1) + +/* --- Compatibility wrappers ---------------------------------------------- */ + +#ifndef NOOP +# define NOOP +#endif + +#ifndef dNOOP +# define dNOOP +#endif + +#ifndef Newx +# define Newx(v, n, c) New(0, v, n, c) +#endif + #ifndef SvPV_const # define SvPV_const SvPV #endif @@ -22,6 +39,14 @@ # define sv_catpvn_nomg sv_catpvn #endif +#ifndef mPUSHp +# define mPUSHp(P, L) PUSHs(sv_2mortal(newSVpvn((P), (L)))) +#endif + +#ifndef mPUSHu +# define mPUSHu(U) PUSHs(sv_2mortal(newSVuv(U))) +#endif + #ifndef HvNAME_get # define HvNAME_get(H) HvNAME(H) #endif @@ -60,106 +85,354 @@ # endif #endif -/* ... Hints ............................................................... */ +#ifndef I_WORKAROUND_REQUIRE_PROPAGATION +# define I_WORKAROUND_REQUIRE_PROPAGATION !I_HAS_PERL(5, 10, 1) +#endif -STATIC U32 indirect_hash = 0; +/* ... Thread safety and multiplicity ...................................... */ -STATIC IV indirect_hint(pTHX) { -#define indirect_hint() indirect_hint(aTHX) - SV *id; -#if I_HAS_PERL(5, 10, 0) - id = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash, - NULL, - "indirect", 8, - 0, - indirect_hash); +#ifndef I_MULTIPLICITY +# if defined(MULTIPLICITY) || defined(PERL_IMPLICIT_CONTEXT) +# define I_MULTIPLICITY 1 +# else +# define I_MULTIPLICITY 0 +# endif +#endif +#if I_MULTIPLICITY && !defined(tTHX) +# define tTHX PerlInterpreter* +#endif + +#if I_MULTIPLICITY && defined(USE_ITHREADS) && defined(dMY_CXT) && defined(MY_CXT) && defined(START_MY_CXT) && defined(MY_CXT_INIT) && (defined(MY_CXT_CLONE) || defined(dMY_CXT_SV)) +# define I_THREADSAFE 1 +# ifndef MY_CXT_CLONE +# define MY_CXT_CLONE \ + dMY_CXT_SV; \ + my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1)); \ + Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t); \ + sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) +# endif #else - SV **val = hv_fetch(GvHV(PL_hintgv), "indirect", 8, indirect_hash); - if (!val) - return 0; - id = *val; +# define I_THREADSAFE 0 +# undef dMY_CXT +# define dMY_CXT dNOOP +# undef MY_CXT +# define MY_CXT indirect_globaldata +# undef START_MY_CXT +# define START_MY_CXT STATIC my_cxt_t MY_CXT; +# undef MY_CXT_INIT +# define MY_CXT_INIT NOOP +# undef MY_CXT_CLONE +# define MY_CXT_CLONE NOOP +#endif + +/* --- Helpers ------------------------------------------------------------- */ + +/* ... Thread-safe hints ................................................... */ + +/* If any of those are true, we need to store the hint in a global table. */ + +#if I_THREADSAFE || I_WORKAROUND_REQUIRE_PROPAGATION + +typedef struct { + SV *code; +#if I_WORKAROUND_REQUIRE_PROPAGATION + I32 requires; +#endif +} indirect_hint_t; + +#define PTABLE_NAME ptable_hints + +#define PTABLE_VAL_FREE(V) \ + { indirect_hint_t *h = (V); SvREFCNT_dec(h->code); PerlMemShared_free(h); } + +#define pPTBL pTHX +#define pPTBL_ pTHX_ +#define aPTBL aTHX +#define aPTBL_ aTHX_ + +#include "ptable.h" + +#define ptable_hints_store(T, K, V) ptable_hints_store(aTHX_ (T), (K), (V)) +#define ptable_hints_free(T) ptable_hints_free(aTHX_ (T)) + +#endif /* I_THREADSAFE || I_WORKAROUND_REQUIRE_PROPAGATION */ + +/* Define the op->str ptable here because we need to be able to clean it during + * thread cleanup. */ + +typedef struct { + const char *pos; + char *buf; + STRLEN len, size; + line_t line; +} indirect_op_info_t; + +#define PTABLE_NAME ptable +#define PTABLE_VAL_FREE(V) if (V) { Safefree(((indirect_op_info_t *) (V))->buf); Safefree(V); } + +#define pPTBL pTHX +#define pPTBL_ pTHX_ +#define aPTBL aTHX +#define aPTBL_ aTHX_ + +#include "ptable.h" + +#define ptable_store(T, K, V) ptable_store(aTHX_ (T), (K), (V)) +#define ptable_clear(T) ptable_clear(aTHX_ (T)) +#define ptable_free(T) ptable_free(aTHX_ (T)) + +#define MY_CXT_KEY __PACKAGE__ "::_guts" XS_VERSION + +typedef struct { +#if I_THREADSAFE || I_WORKAROUND_REQUIRE_PROPAGATION + ptable *tbl; /* It really is a ptable_hints */ #endif - return (id && SvOK(id) && SvIOK(id)) ? SvIV(id) : 0; + ptable *map; + const char *linestr; +#if I_THREADSAFE + tTHX owner; +#endif +} my_cxt_t; + +START_MY_CXT + +#if I_THREADSAFE + +STATIC SV *indirect_clone(pTHX_ SV *sv, tTHX owner) { +#define indirect_clone(S, O) indirect_clone(aTHX_ (S), (O)) + CLONE_PARAMS param; + AV *stashes = NULL; + SV *dupsv; + + if (SvTYPE(sv) == SVt_PVHV && HvNAME_get(sv)) + stashes = newAV(); + + param.stashes = stashes; + param.flags = 0; + param.proto_perl = owner; + + dupsv = sv_dup(sv, ¶m); + + if (stashes) { + av_undef(stashes); + SvREFCNT_dec(stashes); + } + + return SvREFCNT_inc(dupsv); } -/* ... op -> source position ............................................... */ +STATIC void indirect_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) { + my_cxt_t *ud = ud_; + indirect_hint_t *h1 = ent->val; + indirect_hint_t *h2 = PerlMemShared_malloc(sizeof *h2); -STATIC HV *indirect_map = NULL; -STATIC const char *indirect_linestr = NULL; + *h2 = *h1; -/* We need (CHAR_BIT * sizeof(UV)) / 4 + 1 chars, but it's just better to take - * a power of two */ -#define OP2STR_BUF char buf[(CHAR_BIT * sizeof(UV)) / 2] -#define OP2STR(O) (sprintf(buf, "%"UVxf, PTR2UV(O))) + if (ud->owner != aTHX) + h2->code = indirect_clone(h1->code, ud->owner); -STATIC void indirect_map_store(pTHX_ const OP *o, const char *src, SV *sv) { -#define indirect_map_store(O, S, N) indirect_map_store(aTHX_ (O), (S), (N)) - OP2STR_BUF; - const char *pl_linestr; - SV *val; + ptable_hints_store(ud->tbl, ent->key, h2); + SvREFCNT_inc(h2->code); +} - /* When lex_inwhat is set, we're in a quotelike environment (qq, qr, but not q) - * In this case the linestr has temporarly changed, but the old buffer should - * still be alive somewhere. */ +STATIC void indirect_thread_cleanup(pTHX_ void *); + +STATIC void indirect_thread_cleanup(pTHX_ void *ud) { + int *level = ud; + + if (*level) { + *level = 0; + LEAVE; + SAVEDESTRUCTOR_X(indirect_thread_cleanup, level); + ENTER; + } else { + dMY_CXT; + PerlMemShared_free(level); + ptable_free(MY_CXT.map); + ptable_hints_free(MY_CXT.tbl); + } +} - if (!PL_lex_inwhat) { - pl_linestr = SvPVX_const(PL_linestr); - if (indirect_linestr != pl_linestr) { - hv_clear(indirect_map); - indirect_linestr = pl_linestr; +#endif /* I_THREADSAFE */ + +#if I_THREADSAFE || I_WORKAROUND_REQUIRE_PROPAGATION + +STATIC SV *indirect_tag(pTHX_ SV *value) { +#define indirect_tag(V) indirect_tag(aTHX_ (V)) + indirect_hint_t *h; + dMY_CXT; + + value = SvOK(value) && SvROK(value) ? SvRV(value) : NULL; + + h = PerlMemShared_malloc(sizeof *h); + h->code = SvREFCNT_inc(value); + +#if I_WORKAROUND_REQUIRE_PROPAGATION + { + const PERL_SI *si; + I32 requires = 0; + + for (si = PL_curstackinfo; si; si = si->si_prev) { + I32 cxix; + + for (cxix = si->si_cxix; cxix >= 0; --cxix) { + const PERL_CONTEXT *cx = si->si_cxstack + cxix; + + if (CxTYPE(cx) == CXt_EVAL && cx->blk_eval.old_op_type == OP_REQUIRE) + ++requires; + } } + + h->requires = requires; } +#endif + + /* We only need for the key to be an unique tag for looking up the value later. + * Allocated memory provides convenient unique identifiers, so that's why we + * use the value pointer as the key itself. */ + ptable_hints_store(MY_CXT.tbl, value, h); - val = newSVsv(sv); - SvUPGRADE(val, SVt_PVIV); - SvUVX(val) = PTR2UV(src); - SvIOK_on(val); - SvIsUV_on(val); - if (!hv_store(indirect_map, buf, OP2STR(o), val, 0)) SvREFCNT_dec(val); + return newSVuv(PTR2UV(value)); } -STATIC const char *indirect_map_fetch(pTHX_ const OP *o, SV ** const name) { -#define indirect_map_fetch(O, S) indirect_map_fetch(aTHX_ (O), (S)) - OP2STR_BUF; - SV **val; +STATIC SV *indirect_detag(pTHX_ const SV *hint) { +#define indirect_detag(H) indirect_detag(aTHX_ (H)) + indirect_hint_t *h; + dMY_CXT; - if (indirect_linestr != SvPVX_const(PL_linestr)) + if (!(hint && SvOK(hint) && SvIOK(hint))) return NULL; - val = hv_fetch(indirect_map, buf, OP2STR(o), 0); - if (!val) { - *name = NULL; - return NULL; + h = ptable_fetch(MY_CXT.tbl, INT2PTR(void *, SvUVX(hint))); + +#if I_WORKAROUND_REQUIRE_PROPAGATION + { + const PERL_SI *si; + I32 requires = 0; + + for (si = PL_curstackinfo; si; si = si->si_prev) { + I32 cxix; + + for (cxix = si->si_cxix; cxix >= 0; --cxix) { + const PERL_CONTEXT *cx = si->si_cxstack + cxix; + + if (CxTYPE(cx) == CXt_EVAL && cx->blk_eval.old_op_type == OP_REQUIRE + && ++requires > h->requires) + return NULL; + } + } } +#endif - *name = *val; - return INT2PTR(const char *, SvUVX(*val)); + return h->code; } -STATIC void indirect_map_delete(pTHX_ const OP *o) { -#define indirect_map_delete(O) indirect_map_delete(aTHX_ (O)) - OP2STR_BUF; +#else - (void)hv_delete(indirect_map, buf, OP2STR(o), G_DISCARD); +STATIC SV *indirect_tag(pTHX_ SV *value) { +#define indirect_tag(V) indirect_tag(aTHX_ (V)) + UV tag = 0; + + if (SvOK(value) && SvROK(value)) { + value = SvRV(value); + SvREFCNT_inc(value); + tag = PTR2UV(value); + } + + return newSVuv(tag); } -STATIC void indirect_map_clean_kids(pTHX_ const OP *o) { -#define indirect_map_clean_kids(O) indirect_map_clean_kids(aTHX_ (O)) - if (o->op_flags & OPf_KIDS) { - const OP *kid = ((const UNOP *) o)->op_first; - for (; kid; kid = kid->op_sibling) { - indirect_map_clean_kids(kid); - indirect_map_delete(kid); +#define indirect_detag(H) (((H) && SvOK(H)) ? INT2PTR(SV *, SvUVX(H)) : NULL) + +#endif /* I_THREADSAFE || I_WORKAROUND_REQUIRE_PROPAGATION */ + +STATIC U32 indirect_hash = 0; + +STATIC SV *indirect_hint(pTHX) { +#define indirect_hint() indirect_hint(aTHX) + SV *hint; + + if (IN_PERL_RUNTIME) + return NULL; + +#if I_HAS_PERL(5, 9, 5) + hint = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash, + NULL, + __PACKAGE__, __PACKAGE_LEN__, + 0, + indirect_hash); +#else + { + SV **val = hv_fetch(GvHV(PL_hintgv), __PACKAGE__, __PACKAGE_LEN__, + indirect_hash); + if (!val) + return 0; + hint = *val; + } +#endif + return indirect_detag(hint); +} + +/* ... op -> source position ............................................... */ + +STATIC void indirect_map_store(pTHX_ const OP *o, const char *src, SV *sv, line_t line) { +#define indirect_map_store(O, S, N, L) indirect_map_store(aTHX_ (O), (S), (N), (L)) + indirect_op_info_t *oi; + const char *s; + STRLEN len; + dMY_CXT; + + /* When lex_inwhat is set, we're in a quotelike environment (qq, qr, but not q) + * In this case the linestr has temporarly changed, but the old buffer should + * still be alive somewhere. */ + + if (!PL_lex_inwhat) { + const char *pl_linestr = SvPVX_const(PL_linestr); + if (MY_CXT.linestr != pl_linestr) { + ptable_clear(MY_CXT.map); + MY_CXT.linestr = pl_linestr; } } + + if (!(oi = ptable_fetch(MY_CXT.map, o))) { + Newx(oi, 1, indirect_op_info_t); + ptable_store(MY_CXT.map, o, oi); + oi->buf = NULL; + oi->size = 0; + } + + s = SvPV_const(sv, len); + if (len > oi->size) { + Safefree(oi->buf); + Newx(oi->buf, len, char); + oi->size = len; + } + Copy(s, oi->buf, len, char); + oi->len = len; + oi->pos = src; + oi->line = line; } -STATIC void indirect_map_clean(pTHX_ const OP *o) { -#define indirect_map_clean(O) indirect_map_clean(aTHX_ (O)) - indirect_map_clean_kids(o); - indirect_map_delete(o); +STATIC const indirect_op_info_t *indirect_map_fetch(pTHX_ const OP *o) { +#define indirect_map_fetch(O) indirect_map_fetch(aTHX_ (O)) + const indirect_op_info_t *val; + dMY_CXT; + + if (MY_CXT.linestr != SvPVX_const(PL_linestr)) + return NULL; + + return ptable_fetch(MY_CXT.map, o); +} + +STATIC void indirect_map_delete(pTHX_ const OP *o) { +#define indirect_map_delete(O) indirect_map_delete(aTHX_ (O)) + dMY_CXT; + + ptable_store(MY_CXT.map, o, NULL); } +/* --- Check functions ----------------------------------------------------- */ + STATIC const char *indirect_find(pTHX_ SV *sv, const char *s) { #define indirect_find(N, S) indirect_find(aTHX_ (N), (S)) STRLEN len; @@ -193,10 +466,14 @@ STATIC OP *indirect_ck_const(pTHX_ OP *o) { if (indirect_hint()) { SV *sv = cSVOPo_sv; - if (SvPOK(sv) && (SvTYPE(sv) >= SVt_PV)) - indirect_map_store(o, indirect_find(sv, PL_oldbufptr), sv); + if (SvPOK(sv) && (SvTYPE(sv) >= SVt_PV)) { + const char *s = indirect_find(sv, PL_oldbufptr); + indirect_map_store(o, s, sv, CopLINE(&PL_compiling)); + return o; + } } + indirect_map_delete(o); return o; } @@ -256,12 +533,15 @@ STATIC OP *indirect_ck_rv2sv(pTHX_ OP *o) { } o = CALL_FPTR(indirect_old_ck_rv2sv)(aTHX_ o); - indirect_map_store(o, s, sv); + indirect_map_store(o, s, sv, CopLINE(&PL_compiling)); return o; } done: - return CALL_FPTR(indirect_old_ck_rv2sv)(aTHX_ o); + o = CALL_FPTR(indirect_old_ck_rv2sv)(aTHX_ o); + + indirect_map_delete(o); + return o; } /* ... ck_padany ........................................................... */ @@ -281,10 +561,12 @@ STATIC OP *indirect_ck_padany(pTHX_ OP *o) { while (s < t && isSPACE(*t)) --t; sv = sv_2mortal(newSVpvn("$", 1)); sv_catpvn_nomg(sv, s, t - s + 1); - indirect_map_store(o, s, sv); + indirect_map_store(o, s, sv, CopLINE(&PL_compiling)); + return o; } } + indirect_map_delete(o); return o; } @@ -295,67 +577,127 @@ STATIC OP *(*indirect_old_ck_method)(pTHX_ OP *) = 0; STATIC OP *indirect_ck_method(pTHX_ OP *o) { if (indirect_hint()) { OP *op = cUNOPo->op_first; + const indirect_op_info_t *oi = indirect_map_fetch(op); + const char *s = NULL; + line_t line; SV *sv; - const char *s = indirect_map_fetch(op, &sv); - if (!s) { + + if (oi && (s = oi->pos)) { + sv = sv_2mortal(newSVpvn(oi->buf, oi->len)); + line = oi->line; /* Keep the old line so that we really point to the first */ + } else { sv = cSVOPx_sv(op); if (!SvPOK(sv) || (SvTYPE(sv) < SVt_PV)) goto done; - sv = sv_mortalcopy(sv); - s = indirect_find(sv, PL_oldbufptr); + sv = sv_mortalcopy(sv); + s = indirect_find(sv, PL_oldbufptr); + line = CopLINE(&PL_compiling); } + o = CALL_FPTR(indirect_old_ck_method)(aTHX_ o); /* o may now be a method_named */ - indirect_map_store(o, s, sv); + + indirect_map_store(o, s, sv, line); return o; } done: - return CALL_FPTR(indirect_old_ck_method)(aTHX_ o); + o = CALL_FPTR(indirect_old_ck_method)(aTHX_ o); + + indirect_map_delete(o); + return o; } /* ... ck_entersub ......................................................... */ -STATIC const char indirect_msg[] = "Indirect call of method \"%s\" on object \"%s\""; +STATIC int indirect_is_indirect(const indirect_op_info_t *moi, const indirect_op_info_t *ooi) { + if (moi->pos > ooi->pos) + return 0; + + if (moi->pos == ooi->pos) + return moi->len == ooi->len && !memcmp(moi->buf, ooi->buf, moi->len); + + return 1; +} STATIC OP *(*indirect_old_ck_entersub)(pTHX_ OP *) = 0; STATIC OP *indirect_ck_entersub(pTHX_ OP *o) { - LISTOP *op; - OP *om, *oo; - IV hint = indirect_hint(); + SV *code = indirect_hint(); o = CALL_FPTR(indirect_old_ck_entersub)(aTHX_ o); - if (hint) { - const char *pm, *po; - SV *svm, *svo; - oo = o; + if (code) { + const indirect_op_info_t *moi, *ooi; + OP *mop, *oop; + LISTOP *lop; + + oop = o; do { - op = (LISTOP *) oo; - if (!op->op_flags & OPf_KIDS) + lop = (LISTOP *) oop; + if (!(lop->op_flags & OPf_KIDS)) goto done; - oo = op->op_first; - } while (oo->op_type != OP_PUSHMARK); - oo = oo->op_sibling; - om = op->op_last; - if (om->op_type == OP_METHOD) - om = cUNOPx(om)->op_first; - else if (om->op_type != OP_METHOD_NAMED) + oop = lop->op_first; + } while (oop->op_type != OP_PUSHMARK); + oop = oop->op_sibling; + mop = lop->op_last; + + if (!oop) goto done; - pm = indirect_map_fetch(om, &svm); - po = indirect_map_fetch(oo, &svo); - if (pm && po && pm < po) { - const char *psvm = SvPV_nolen_const(svm), *psvo = SvPV_nolen_const(svo); - if (hint == 2) - croak(indirect_msg, psvm, psvo); - else - warn(indirect_msg, psvm, psvo); + + switch (oop->op_type) { + case OP_CONST: + case OP_RV2SV: + case OP_PADSV: + break; + default: + goto done; + } + + if (mop->op_type == OP_METHOD) + mop = cUNOPx(mop)->op_first; + else if (mop->op_type != OP_METHOD_NAMED) + goto done; + + moi = indirect_map_fetch(mop); + if (!(moi && moi->pos)) + goto done; + + ooi = indirect_map_fetch(oop); + if (!(ooi && ooi->pos)) + goto done; + + if (indirect_is_indirect(moi, ooi)) { + SV *file; + dSP; + + ENTER; + SAVETMPS; + +#ifdef USE_ITHREADS + file = sv_2mortal(newSVpv(CopFILE(&PL_compiling), 0)); +#else + file = sv_mortalcopy(CopFILESV(&PL_compiling)); +#endif + + PUSHMARK(SP); + EXTEND(SP, 4); + mPUSHp(ooi->buf, ooi->len); + mPUSHp(moi->buf, moi->len); + PUSHs(file); + mPUSHu(moi->line); + PUTBACK; + + call_sv(code, G_VOID); + + PUTBACK; + + FREETMPS; + LEAVE; } -done: - indirect_map_clean(o); } +done: return o; } @@ -365,13 +707,25 @@ STATIC U32 indirect_initialized = 0; MODULE = indirect PACKAGE = indirect -PROTOTYPES: DISABLE +PROTOTYPES: ENABLE BOOT: { if (!indirect_initialized++) { - PERL_HASH(indirect_hash, "indirect", 8); - indirect_map = newHV(); + HV *stash; + + MY_CXT_INIT; + MY_CXT.map = ptable_new(); + MY_CXT.linestr = NULL; +#if I_THREADSAFE || I_WORKAROUND_REQUIRE_PROPAGATION + MY_CXT.tbl = ptable_new(); +#endif +#if I_THREADSAFE + MY_CXT.owner = aTHX; +#endif + + PERL_HASH(indirect_hash, __PACKAGE__, __PACKAGE_LEN__); + indirect_old_ck_const = PL_check[OP_CONST]; PL_check[OP_CONST] = MEMBER_TO_FPTR(indirect_ck_const); indirect_old_ck_rv2sv = PL_check[OP_RV2SV]; @@ -382,5 +736,49 @@ BOOT: PL_check[OP_METHOD] = MEMBER_TO_FPTR(indirect_ck_method); indirect_old_ck_entersub = PL_check[OP_ENTERSUB]; PL_check[OP_ENTERSUB] = MEMBER_TO_FPTR(indirect_ck_entersub); + + stash = gv_stashpvn(__PACKAGE__, __PACKAGE_LEN__, 1); + newCONSTSUB(stash, "I_THREADSAFE", newSVuv(I_THREADSAFE)); } } + +#if I_THREADSAFE + +void +CLONE(...) +PROTOTYPE: DISABLE +PREINIT: + ptable *t; + int *level; +CODE: + { + my_cxt_t ud; + dMY_CXT; + ud.tbl = t = ptable_new(); + ud.owner = MY_CXT.owner; + ptable_walk(MY_CXT.tbl, indirect_ptable_clone, &ud); + } + { + MY_CXT_CLONE; + MY_CXT.map = ptable_new(); + MY_CXT.linestr = NULL; + MY_CXT.tbl = t; + MY_CXT.owner = aTHX; + } + { + level = PerlMemShared_malloc(sizeof *level); + *level = 1; + LEAVE; + SAVEDESTRUCTOR_X(indirect_thread_cleanup, level); + ENTER; + } + +#endif + +SV * +_tag(SV *value) +PROTOTYPE: $ +CODE: + RETVAL = indirect_tag(value); +OUTPUT: + RETVAL