diff options
Diffstat (limited to 'ext/List-Util/multicall.h')
| -rw-r--r-- | ext/List-Util/multicall.h | 166 |
1 files changed, 0 insertions, 166 deletions
diff --git a/ext/List-Util/multicall.h b/ext/List-Util/multicall.h deleted file mode 100644 index b8296e1755..0000000000 --- a/ext/List-Util/multicall.h +++ /dev/null @@ -1,166 +0,0 @@ -/* multicall.h (version 1.0) - * - * Implements a poor-man's MULTICALL interface for old versions - * of perl that don't offer a proper one. Intended to be compatible - * with 5.6.0 and later. - * - */ - -#ifdef dMULTICALL -#define REAL_MULTICALL -#else -#undef REAL_MULTICALL - -/* In versions of perl where MULTICALL is not defined (i.e. prior - * to 5.9.4), Perl_pad_push is not exported either. It also has - * an extra argument in older versions; certainly in the 5.8 series. - * So we redefine it here. - */ - -#ifndef AVf_REIFY -# ifdef SVpav_REIFY -# define AVf_REIFY SVpav_REIFY -# else -# error Neither AVf_REIFY nor SVpav_REIFY is defined -# endif -#endif - -#ifndef AvFLAGS -# define AvFLAGS SvFLAGS -#endif - -static void -multicall_pad_push(pTHX_ AV *padlist, int depth) -{ - if (depth <= AvFILLp(padlist)) - return; - - { - SV** const svp = AvARRAY(padlist); - AV* const newpad = newAV(); - SV** const oldpad = AvARRAY(svp[depth-1]); - I32 ix = AvFILLp((AV*)svp[1]); - const I32 names_fill = AvFILLp((AV*)svp[0]); - SV** const names = AvARRAY(svp[0]); - AV *av; - - for ( ;ix > 0; ix--) { - if (names_fill >= ix && names[ix] != &PL_sv_undef) { - const char sigil = SvPVX(names[ix])[0]; - if ((SvFLAGS(names[ix]) & SVf_FAKE) || sigil == '&') { - /* outer lexical or anon code */ - av_store(newpad, ix, SvREFCNT_inc(oldpad[ix])); - } - else { /* our own lexical */ - SV *sv; - if (sigil == '@') - sv = (SV*)newAV(); - else if (sigil == '%') - sv = (SV*)newHV(); - else - sv = NEWSV(0, 0); - av_store(newpad, ix, sv); - SvPADMY_on(sv); - } - } - else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) { - av_store(newpad, ix, SvREFCNT_inc(oldpad[ix])); - } - else { - /* save temporaries on recursion? */ - SV * const sv = NEWSV(0, 0); - av_store(newpad, ix, sv); - SvPADTMP_on(sv); - } - } - av = newAV(); - av_extend(av, 0); - av_store(newpad, 0, (SV*)av); - AvFLAGS(av) = AVf_REIFY; - - av_store(padlist, depth, (SV*)newpad); - AvFILLp(padlist) = depth; - } -} - -#define dMULTICALL \ - SV **newsp; /* set by POPBLOCK */ \ - PERL_CONTEXT *cx; \ - CV *multicall_cv; \ - OP *multicall_cop; \ - bool multicall_oldcatch; \ - U8 hasargs = 0 - -/* Between 5.9.1 and 5.9.2 the retstack was removed, and the - return op is now stored on the cxstack. */ -#define HAS_RETSTACK (\ - PERL_REVISION < 5 || \ - (PERL_REVISION == 5 && PERL_VERSION < 9) || \ - (PERL_REVISION == 5 && PERL_VERSION == 9 && PERL_SUBVERSION < 2) \ -) - - -/* PUSHSUB is defined so differently on different versions of perl - * that it's easier to define our own version than code for all the - * different possibilities. - */ -#if HAS_RETSTACK -# define PUSHSUB_RETSTACK(cx) -#else -# define PUSHSUB_RETSTACK(cx) cx->blk_sub.retop = Nullop; -#endif -#define MULTICALL_PUSHSUB(cx, the_cv) \ - cx->blk_sub.cv = the_cv; \ - cx->blk_sub.olddepth = CvDEPTH(the_cv); \ - cx->blk_sub.hasargs = hasargs; \ - cx->blk_sub.lval = PL_op->op_private & \ - (OPpLVAL_INTRO|OPpENTERSUB_INARGS); \ - PUSHSUB_RETSTACK(cx) \ - if (!CvDEPTH(the_cv)) { \ - (void)SvREFCNT_inc(the_cv); \ - (void)SvREFCNT_inc(the_cv); \ - SAVEFREESV(the_cv); \ - } - -#define PUSH_MULTICALL(the_cv) \ - STMT_START { \ - CV *_nOnclAshIngNamE_ = the_cv; \ - AV* padlist = CvPADLIST(_nOnclAshIngNamE_); \ - multicall_cv = _nOnclAshIngNamE_; \ - ENTER; \ - multicall_oldcatch = CATCH_GET; \ - SAVESPTR(CvROOT(multicall_cv)->op_ppaddr); \ - CvROOT(multicall_cv)->op_ppaddr = PL_ppaddr[OP_NULL]; \ - SAVETMPS; SAVEVPTR(PL_op); \ - CATCH_SET(TRUE); \ - PUSHSTACKi(PERLSI_SORT); \ - PUSHBLOCK(cx, CXt_SUB, PL_stack_sp); \ - MULTICALL_PUSHSUB(cx, multicall_cv); \ - if (++CvDEPTH(multicall_cv) >= 2) { \ - PERL_STACK_OVERFLOW_CHECK(); \ - multicall_pad_push(aTHX_ padlist, CvDEPTH(multicall_cv)); \ - } \ - SAVECOMPPAD(); \ - PL_comppad = (AV*) (AvARRAY(padlist)[CvDEPTH(multicall_cv)]); \ - PL_curpad = AvARRAY(PL_comppad); \ - multicall_cop = CvSTART(multicall_cv); \ - } STMT_END - -#define MULTICALL \ - STMT_START { \ - PL_op = multicall_cop; \ - CALLRUNOPS(aTHX); \ - } STMT_END - -#define POP_MULTICALL \ - STMT_START { \ - CvDEPTH(multicall_cv)--; \ - LEAVESUB(multicall_cv); \ - POPBLOCK(cx,PL_curpm); \ - POPSTACK; \ - CATCH_SET(multicall_oldcatch); \ - LEAVE; \ - SPAGAIN; \ - } STMT_END - -#endif |