view release on metacpan or  search on metacpan

Op.xs  view on Meta::CPAN

   goto skip;

  gvop = cUNOPx(rv2gv)->op_first;
  if (!gvop || gvop->op_type != OP_GV)
   goto skip;

  gv = cGVOPx_gv(gvop);
  if (!gv)
   goto skip;

  {
   CV *cv;
   dMY_CXT;

   if (gv && SvTYPE(gv) >= SVt_PVGV && (cv = GvCV(gv)) == MY_CXT.placeholder) {
    SvREFCNT_dec(cv);
    GvCV(gv) = NULL;
   }
  }
 }

skip:
 return o;
}

/* --- XS ------------------------------------------------------------------ */

MODULE = Sub::Op      PACKAGE = Sub::Op

PROTOTYPES: ENABLE

BOOT:
{
 so_op_name = ptable_new();
#ifdef USE_ITHREADS
 MUTEX_INIT(&so_op_name_mutex);
#endif

 MY_CXT_INIT;
 MY_CXT.map         = newHV();
 MY_CXT.placeholder = NULL;
#if SO_THREADSAFE
 MY_CXT.owner       = aTHX;
#endif /* SO_THREADSAFE */

 so_old_ck_entersub    = PL_check[OP_ENTERSUB];
 PL_check[OP_ENTERSUB] = so_ck_entersub;
 so_old_ck_gelem       = PL_check[OP_GELEM];
 PL_check[OP_GELEM]    = so_ck_gelem;
}

#if SO_THREADSAFE

void
CLONE(...)
PROTOTYPE: DISABLE
PREINIT:
 HV  *map;
 CV  *placeholder;
 tTHX owner;
PPCODE:
 {
  dMY_CXT;
  owner       = MY_CXT.owner;
  map         = (HV *) so_clone((SV *) MY_CXT.map,         owner);
  placeholder = (CV *) so_clone((SV *) MY_CXT.placeholder, owner);
 }
 {
  MY_CXT_CLONE;
  MY_CXT.map         = map;
  MY_CXT.placeholder = placeholder;
  MY_CXT.owner       = aTHX;
 }
 XSRETURN(0);

#endif /* SO_THREADSAFE */

void
_placeholder(SV *sv)
PROTOTYPE: $
PPCODE:
 if (SvROK(sv)) {
  sv = SvRV(sv);
  if (SvTYPE(sv) >= SVt_PVCV) {
   dMY_CXT;
   SvREFCNT_dec(MY_CXT.placeholder);
   MY_CXT.placeholder = (CV *) SvREFCNT_inc(sv);
  }
 }
 XSRETURN(0);

void
_custom_name(SV *op)
PROTOTYPE: $
PREINIT:
 OP *o;
 so_op_name_t *on;
PPCODE:
 if (!SvROK(op))
  XSRETURN_UNDEF;
 o = INT2PTR(OP *, SvIV(SvRV(op)));
 if (!o || o->op_type != OP_CUSTOM)
  XSRETURN_UNDEF;
#ifdef USE_ITHREADS
 MUTEX_LOCK(&so_op_name_mutex);
#endif /* USE_ITHREADS */
 on = ptable_fetch(so_op_name, o);
#ifdef USE_ITHREADS
 MUTEX_UNLOCK(&so_op_name_mutex);
#endif /* USE_ITHREADS */
 if (!on)
  XSRETURN_UNDEF;
 ST(0) = sv_2mortal(newSVpvn(&on->buf, on->len));
 XSRETURN(1);

void
_constant_sub(SV *sv)
PROTOTYPE: $
PPCODE:
 if (!SvROK(sv))
  XSRETURN_UNDEF;
 sv = SvRV(sv);
 if (SvTYPE(sv) < SVt_PVCV)
  XSRETURN_UNDEF;
 ST(0) = sv_2mortal(newSVuv(CvCONST(sv)));
 XSRETURN(1);