/* This file is part of the Sub::Op Perl module.
 * See http://search.cpan.org/dist/Sub-Op/ */

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

#define __PACKAGE__     "Sub::Op::LexicalSub"
#define __PACKAGE_LEN__ (sizeof(__PACKAGE__)-1)

#include "sub_op.h"

STATIC PADOFFSET sols_find_sv_in_curpad(pTHX_ SV *sv) {
#define sols_find_sv_in_curpad(S) sols_find_sv_in_curpad(aTHX_ (S))
 I32 ix;
 AV  *padlist = CvPADLIST(PL_compcv);
 AV  *comppad = (AV *) AvARRAY(padlist)[1];
 SV **curpad  = AvARRAY(comppad);

 for (ix = AvFILLp(comppad); ix > 0; --ix) {
  if (curpad[ix] == sv)
   return ix;
 }

 return NOT_IN_PAD;
}

STATIC OP *sols_check(pTHX_ OP *o, void *ud_) {
 OP *gvop, *last_arg, *rv2cv;
 SV *cv = ud_;
 GV *gv;

 gvop = sub_op_study(o, &last_arg, &rv2cv);

 if (CvANON(cv)) {
  OP *anon;

  CvDEPTH(CvOUTSIDE(cv))++;
  anon = newSVOP(OP_ANONCODE, 0, (SV *) Perl_cv_clone(aTHX_ (CV *) cv));
  CvDEPTH(CvOUTSIDE(cv))--;

  last_arg->op_sibling = newUNOP(OP_REFGEN, 0, anon);

  op_free(rv2cv);
 } else {
  SV *gv = (SV *) CvGV(cv);

#ifdef USE_ITHREADS
  PAD_SVl(cPADOPx(gvop)->op_padix) = gv;
#else
  cSVOPx(gvop)->op_sv              = gv;
#endif
  SvREFCNT_inc(gv);
 }

 return o;
}

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

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

PROTOTYPES: ENABLE

void
_init(SV *name, SV *cb)
PROTOTYPE: $$
PREINIT:
 sub_op_config_t c;
PPCODE:
 if (SvROK(cb)) {
  cb = SvRV(cb);
  if (SvTYPE(cb) >= SVt_PVCV) {
   sub_op_init(&c);
   c.name   = SvPV_const(name, c.namelen);
   if (SvPOK(cb)) { /* Sub is prototyped */
    c.proto = SvPV_const(cb, c.protolen);
   }
   c.check  = sols_check;
   c.ud     = SvREFCNT_inc(cb);
   sub_op_register(aTHX_ &c, 0);
  }
 }
 XSRETURN(0);