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

typedef CV *B__CV;

static OP *(*old_entersub)(pTHX);

// this is, of course, a slower entersub
static OP *
faster_entersub (pTHX)
{
  dSP;
  dTOPss;

  if (SvTYPE (sv) == SVt_PVGV)
    sv = (SV *)GvCV (sv);

  if (sv)
    {
      // only once for now
      PL_op->op_ppaddr = old_entersub;

      // only simple cv calls for now
      if (!PL_perldb && !PL_tainting
          && SvTYPE (sv) == SVt_PVCV && !CvXSUB (sv)
          && CvSTART (sv) // must exist
          && CvSTART (sv)->op_type != OP_NULL) // shield against compiling an already-compiled op
        {
          SV *bsv = newSViv (PTR2IV (sv));

          ENTER;
          SAVETMPS;
          PUSHMARK (SP);
          // emulate B::CV typemap entry we don't have
          XPUSHs (sv_2mortal (sv_bless (newRV_noinc (bsv), gv_stashpv ("B::CV", 1))));
          PUTBACK;
          call_pv ("Faster::entersub", G_VOID|G_DISCARD|G_EVAL);
          SPAGAIN;
          FREETMPS;
          LEAVE;
        }
    }

  return old_entersub (aTHX);
}

MODULE = Faster		PACKAGE = Faster

PROTOTYPES: ENABLE

IV
ppaddr (int optype)
	CODE:
        RETVAL = optype == OP_ENTERSUB
                 ? old_entersub
                 : PL_ppaddr [optype];
	OUTPUT:
        RETVAL

void
hook_entersub ()
	CODE:
	old_entersub = PL_ppaddr [OP_ENTERSUB];
        PL_ppaddr [OP_ENTERSUB] = faster_entersub;

void
patch_cv (B::CV cv, void *ptr)
	CODE:
{
	OP *op;

	NewOp (0, op, 1, OP);

        op->op_sibling = CvSTART (cv);
        op->op_type = OP_NULL;
        op->op_ppaddr = ptr;

        CvSTART (cv) = op;
}