view release on metacpan or  search on metacpan

ppport.h  view on Meta::CPAN

#endif

#endif /* USE_ITHREADS */

#if (PERL_BCDVERSION >= 0x5006000)
#ifndef caller_cx

# if defined(NEED_caller_cx) || defined(NEED_caller_cx_GLOBAL)
static I32
DPPP_dopoptosub_at(const PERL_CONTEXT *cxstk, I32 startingblock)
{
    I32 i;

    for (i = startingblock; i >= 0; i--) {
	register const PERL_CONTEXT * const cx = &cxstk[i];
	switch (CxTYPE(cx)) {
	default:
	    continue;
	case CXt_EVAL:
	case CXt_SUB:
	case CXt_FORMAT:
	    return i;
	}
    }
    return i;
}
# endif

# if defined(NEED_caller_cx)
static const PERL_CONTEXT * DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp);
static
#else
extern const PERL_CONTEXT * DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp);
#endif

#ifdef caller_cx
#  undef caller_cx
#endif
#define caller_cx(a,b) DPPP_(my_caller_cx)(aTHX_ a,b)
#define Perl_caller_cx DPPP_(my_caller_cx)

#if defined(NEED_caller_cx) || defined(NEED_caller_cx_GLOBAL)

const PERL_CONTEXT *
DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp)
{
    register I32 cxix = DPPP_dopoptosub_at(cxstack, cxstack_ix);
    register const PERL_CONTEXT *cx;
    register const PERL_CONTEXT *ccstack = cxstack;
    const PERL_SI *top_si = PL_curstackinfo;

    for (;;) {
	/* we may be in a higher stacklevel, so dig down deeper */
	while (cxix < 0 && top_si->si_type != PERLSI_MAIN) {
	    top_si = top_si->si_prev;
	    ccstack = top_si->si_cxstack;
	    cxix = DPPP_dopoptosub_at(ccstack, top_si->si_cxix);
	}
	if (cxix < 0)
	    return NULL;
	/* caller() should not report the automatic calls to &DB::sub */
	if (PL_DBsub && GvCV(PL_DBsub) && cxix >= 0 &&
		ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))
	    count++;
	if (!count--)
	    break;
	cxix = DPPP_dopoptosub_at(ccstack, cxix - 1);
    }

    cx = &ccstack[cxix];
    if (dbcxp) *dbcxp = cx;

    if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
        const I32 dbcxix = DPPP_dopoptosub_at(ccstack, cxix - 1);
	/* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the
	   field below is defined for any cx. */
	/* caller() should not report the automatic calls to &DB::sub */
	if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub))
	    cx = &ccstack[dbcxix];
    }

    return cx;
}

# endif
#endif /* caller_cx */
#endif /* 5.6.0 */
#ifndef IN_PERL_COMPILETIME
#  define IN_PERL_COMPILETIME            (PL_curcop == &PL_compiling)
#endif

#ifndef IN_LOCALE_RUNTIME
#  define IN_LOCALE_RUNTIME              (PL_curcop->op_private & HINT_LOCALE)
#endif

#ifndef IN_LOCALE_COMPILETIME
#  define IN_LOCALE_COMPILETIME          (PL_hints & HINT_LOCALE)
#endif

#ifndef IN_LOCALE
#  define IN_LOCALE                      (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
#endif
#ifndef IS_NUMBER_IN_UV
#  define IS_NUMBER_IN_UV                0x01
#endif

#ifndef IS_NUMBER_GREATER_THAN_UV_MAX
#  define IS_NUMBER_GREATER_THAN_UV_MAX  0x02
#endif

#ifndef IS_NUMBER_NOT_INT
#  define IS_NUMBER_NOT_INT              0x04
#endif

#ifndef IS_NUMBER_NEG
#  define IS_NUMBER_NEG                  0x08
#endif

#ifndef IS_NUMBER_INFINITY
#  define IS_NUMBER_INFINITY             0x10
#endif

#ifndef IS_NUMBER_NAN
#  define IS_NUMBER_NAN                  0x20
#endif
#ifndef GROK_NUMERIC_RADIX
#  define GROK_NUMERIC_RADIX(sp, send)   grok_numeric_radix(sp, send)
#endif
#ifndef PERL_SCAN_GREATER_THAN_UV_MAX
#  define PERL_SCAN_GREATER_THAN_UV_MAX  0x02
#endif

#ifndef PERL_SCAN_SILENT_ILLDIGIT
#  define PERL_SCAN_SILENT_ILLDIGIT      0x04
#endif

#ifndef PERL_SCAN_ALLOW_UNDERSCORES