view release on metacpan or  search on metacpan

optimizer.xs  view on Meta::CPAN

        else if (o->op_flags & OPf_SPECIAL)
            return OPc_BASEOP;
        else
            return OPc_PVOP;
    }
    warn("can't determine class of operator %s, assuming BASEOP\n",
	 PL_op_name[o->op_type]);
    return OPc_BASEOP;
}

static char *
cc_opclassname(pTHX_ OP *o)
{
    return opclassnames[cc_opclass(aTHX_ o)];
}

/* We return you to optimizer code. */
static SV* peep_in_perl;

void
peep_callback(pTHX_ OP *o)
{
    /* First we convert the op to a B:: object */
    SV* bobject = newSViv(PTR2IV(o));
    sv_setiv(newSVrv(bobject, cc_opclassname(aTHX_ (OP*)o)), PTR2IV(o));

    /* Call the callback */

    {
        dSP;
        ENTER;
        SAVETMPS;
        PUSHMARK(SP);
        XPUSHs(sv_2mortal(bobject));
        PUTBACK;
        call_sv(peep_in_perl, G_DISCARD);

        FREETMPS;
        LEAVE;
    }
    PL_curpad = AvARRAY(PL_comppad);

}

static void
uninstall(pTHX)
{
    PL_peepp = Perl_peep;
    sv_free(peep_in_perl);
}

static void
install(pTHX_ SV* subref)
{
    /* We'll do the argument checking in Perl */
    PL_peepp = peep_callback;
    peep_in_perl = newSVsv(subref); /* Copy to be safe */
}

static void
_relocatetopad(pTHX_ OP* op, CV* cv)
{
#ifdef USE_ITHREADS
  /* Relocate const->op_sv to the pad for thread safety.
   * Despite being a "constant", the SV is written to,
   * for reference counts, sv_upgrade() etc. */
  if ((cc_opclass(aTHX_ op) == OPc_SVOP) && ((SVOP*)op)->op_sv) {
    SV** tmp_pad;
    AV* padlist;
    SV** svp;
    SVOP* o = (SVOP*)op;
    padlist = CvPADLIST(cv);
    svp = AvARRAY(padlist);
    tmp_pad = PL_curpad;
    PL_curpad = AvARRAY((AV*)svp[1]);
    PADOFFSET ix = Perl_pad_alloc(aTHX_ OP_CONST, SVs_PADTMP);
    if (SvPADTMP(o->op_sv)) {
      /* If op_sv is already a PADTMP then it is being used by
       * some pad, so make a copy. */
      sv_setsv(PL_curpad[ix],o->op_sv);
      SvREADONLY_on(PL_curpad[ix]);
      SvREFCNT_dec(o->op_sv);
    }
    else {
      SvREFCNT_dec(PL_curpad[ix]);
      SvPADTMP_on(o->op_sv);
      PL_curpad[ix] = o->op_sv;
      /* XXX I don't know how this isn't readonly already. */
      SvREADONLY_on(PL_curpad[ix]);
    }
    o->op_sv = Nullsv;
    o->op_targ = ix;
    PL_curpad = tmp_pad;
  }
#endif
}

STATIC void
no_bareword_allowed(pTHX_ OP *o)
{
    Perl_qerror(aTHX_ Perl_mess(aTHX_
		     "Bareword \"%s\" not allowed while \"strict subs\" in use",
		     SvPV_nolen(cSVOPo_sv)));
}

/* stolen from ext/B/B.xs */
#if PERL_VERSION >= 9
#  define PMOP_pmreplstart(o)   o->op_pmstashstartu.op_pmreplstart
#else
#  define PMOP_pmreplstart(o)   o->op_pmreplstart
#  define PMOP_pmpermflags(o)   o->op_pmpermflags
#  define PMOP_pmdynflags(o)    o->op_pmdynflags
#endif

void
c_extend_peep(pTHX_ register OP *o)
{
    register OP* oldop = 0;
    STRLEN n_a;
#if PERL_VERSION < 10
    if (!o || o->op_seq)

optimizer.xs  view on Meta::CPAN

  while(o) {
    if(o->op_next)
      o = o->op_next;
    else
      break;
  }
  if(!o)
    return;
  if(o->op_type == OP_LEAVESUB   ||
     o->op_type == OP_LEAVESUBLV ||
     o->op_type == OP_LEAVE      ||
     o->op_type == OP_LEAVEEVAL) {
    HE *entry;
    HV *callbacks = get_hv("optimizer::callbacks", 1);
    hv_iterinit(callbacks);
    while ((entry = hv_iternext(callbacks))) {
      peep_in_perl = HeVAL(entry);
      peep_callback(aTHX_ o);	
    }

  }

}

/* This trick stolen from B.xs */
#define PEEP_op_seqmax() PL_op_seqmax
#define PEEP_op_seqmax_inc() PL_op_seqmax++

MODULE = optimizer		PACKAGE = optimizer		PREFIX = PEEP_

PROTOTYPES: DISABLE

U32
PEEP_op_seqmax()

U32
PEEP_op_seqmax_inc()

void
PEEP_c_extend_install(SV* subref)
     CODE:
     PL_peepp = c_extend_peep;
     peep_in_perl = newSVsv(subref);

void
PEEP_c_sub_detect_install()
     CODE:
     PL_peepp = c_sub_detect;

void
PEEP_install(SV* subref)
    CODE:
    install(aTHX_ subref);

void
PEEP_uninstall()
    CODE:
    uninstall(aTHX);

void
PEEP__relocatetopad(o,cvref)
      B::OP  o
      SV*  cvref
    CODE:
    if (cvref) { 
      CV* cv = INT2PTR(CV*, SvIV(SvRV(cvref)));
      _relocatetopad(aTHX_ o, cv);
    }