2627 #ifndef _P_P_PORTABILITY_H_
2628 #define _P_P_PORTABILITY_H_
2630 #ifndef DPPP_NAMESPACE
2631 #define DPPP_NAMESPACE DPPP_
2634 #define DPPP_CAT2(x, y) CAT2(x, y)
2635 #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
2637 #ifndef PERL_REVISION
2638 #if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
2639 #define PERL_PATCHLEVEL_H_IMPLICIT
2640 #include <patchlevel.h>
2642 #if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
2643 #include <could_not_find_Perl_patchlevel.h>
2645 #ifndef PERL_REVISION
2646 #define PERL_REVISION (5)
2648 #define PERL_VERSION PATCHLEVEL
2649 #define PERL_SUBVERSION SUBVERSION
2655 #define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION)
2660 #if PERL_REVISION != 5
2661 #error ppport.h only works with Perl version 5
2668 #ifndef PERL_UCHAR_MIN
2669 #define PERL_UCHAR_MIN ((unsigned char)0)
2672 #ifndef PERL_UCHAR_MAX
2674 #define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
2677 #define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
2679 #define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
2684 #ifndef PERL_USHORT_MIN
2685 #define PERL_USHORT_MIN ((unsigned short)0)
2688 #ifndef PERL_USHORT_MAX
2690 #define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
2693 #define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
2696 #define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
2698 #define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
2704 #ifndef PERL_SHORT_MAX
2706 #define PERL_SHORT_MAX ((short)SHORT_MAX)
2709 #define PERL_SHORT_MAX ((short)MAXSHORT)
2712 #define PERL_SHORT_MAX ((short)SHRT_MAX)
2714 #define PERL_SHORT_MAX ((short)(PERL_USHORT_MAX >> 1))
2720 #ifndef PERL_SHORT_MIN
2722 #define PERL_SHORT_MIN ((short)SHORT_MIN)
2725 #define PERL_SHORT_MIN ((short)MINSHORT)
2728 #define PERL_SHORT_MIN ((short)SHRT_MIN)
2730 #define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
2736 #ifndef PERL_UINT_MAX
2738 #define PERL_UINT_MAX ((unsigned int)UINT_MAX)
2741 #define PERL_UINT_MAX ((unsigned int)MAXUINT)
2743 #define PERL_UINT_MAX (~(unsigned int)0)
2748 #ifndef PERL_UINT_MIN
2749 #define PERL_UINT_MIN ((unsigned int)0)
2752 #ifndef PERL_INT_MAX
2754 #define PERL_INT_MAX ((int)INT_MAX)
2757 #define PERL_INT_MAX ((int)MAXINT)
2759 #define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
2764 #ifndef PERL_INT_MIN
2766 #define PERL_INT_MIN ((int)INT_MIN)
2769 #define PERL_INT_MIN ((int)MININT)
2771 #define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
2776 #ifndef PERL_ULONG_MAX
2778 #define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
2781 #define PERL_ULONG_MAX ((unsigned long)MAXULONG)
2783 #define PERL_ULONG_MAX (~(unsigned long)0)
2788 #ifndef PERL_ULONG_MIN
2789 #define PERL_ULONG_MIN ((unsigned long)0L)
2792 #ifndef PERL_LONG_MAX
2794 #define PERL_LONG_MAX ((long)LONG_MAX)
2797 #define PERL_LONG_MAX ((long)MAXLONG)
2799 #define PERL_LONG_MAX ((long)(PERL_ULONG_MAX >> 1))
2804 #ifndef PERL_LONG_MIN
2806 #define PERL_LONG_MIN ((long)LONG_MIN)
2809 #define PERL_LONG_MIN ((long)MINLONG)
2811 #define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
2816 #if defined(HAS_QUAD) && (defined(convex) || defined(uts))
2817 #ifndef PERL_UQUAD_MAX
2818 #ifdef ULONGLONG_MAX
2819 #define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
2822 #define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
2824 #define PERL_UQUAD_MAX (~(unsigned long long)0)
2829 #ifndef PERL_UQUAD_MIN
2830 #define PERL_UQUAD_MIN ((unsigned long long)0L)
2833 #ifndef PERL_QUAD_MAX
2835 #define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
2838 #define PERL_QUAD_MAX ((long long)MAXLONGLONG)
2840 #define PERL_QUAD_MAX ((long long)(PERL_UQUAD_MAX >> 1))
2845 #ifndef PERL_QUAD_MIN
2847 #define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
2850 #define PERL_QUAD_MIN ((long long)MINLONGLONG)
2852 #define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
2866 #define IV_MIN PERL_INT_MIN
2870 #define IV_MAX PERL_INT_MAX
2874 #define UV_MIN PERL_UINT_MIN
2878 #define UV_MAX PERL_UINT_MAX
2883 #define IVSIZE INTSIZE
2888 #if defined(convex) || defined(uts)
2890 #define IVTYPE long long
2894 #define IV_MIN PERL_QUAD_MIN
2898 #define IV_MAX PERL_QUAD_MAX
2902 #define UV_MIN PERL_UQUAD_MIN
2906 #define UV_MAX PERL_UQUAD_MAX
2911 #define IVSIZE LONGLONGSIZE
2921 #define IV_MIN PERL_LONG_MIN
2925 #define IV_MAX PERL_LONG_MAX
2929 #define UV_MIN PERL_ULONG_MIN
2933 #define UV_MAX PERL_ULONG_MAX
2938 #define IVSIZE LONGSIZE
2948 #ifndef PERL_QUAD_MIN
2949 #define PERL_QUAD_MIN IV_MIN
2952 #ifndef PERL_QUAD_MAX
2953 #define PERL_QUAD_MAX IV_MAX
2956 #ifndef PERL_UQUAD_MIN
2957 #define PERL_UQUAD_MIN UV_MIN
2960 #ifndef PERL_UQUAD_MAX
2961 #define PERL_UQUAD_MAX UV_MAX
2970 #define IV_MIN PERL_LONG_MIN
2974 #define IV_MAX PERL_LONG_MAX
2978 #define UV_MIN PERL_ULONG_MIN
2982 #define UV_MAX PERL_ULONG_MAX
2989 #define IVSIZE LONGSIZE
2995 #define UVTYPE unsigned IVTYPE
2999 #define UVSIZE IVSIZE
3003 #define sv_setuv(sv, uv) \
3007 if (TeMpUv <= IV_MAX) \
3008 sv_setiv(sv, TeMpUv); \
3010 sv_setnv(sv, (double)TeMpUv); \
3016 #define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
3019 #define sv_2uv(sv) ((PL_Sv = (sv)), (UV)(SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
3023 #define SvUVX(sv) ((UV)SvIVX(sv))
3027 #define SvUVXx(sv) SvUVX(sv)
3031 #define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
3035 #define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
3042 #define sv_uv(sv) SvUVx(sv)
3045 #define XST_mUV(i, v) (ST(i) = sv_2mortal(newSVuv(v)))
3049 #define XSRETURN_UV(v) \
3061 sv_setuv(TARG, (UV)(u)); \
3071 sv_setuv(TARG, (UV)(u)); \
3077 #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
3079 #define PL_DBsingle DBsingle
3080 #define PL_DBsub DBsub
3082 #define PL_compiling compiling
3083 #define PL_copline copline
3084 #define PL_curcop curcop
3085 #define PL_curstash curstash
3086 #define PL_debstash debstash
3087 #define PL_defgv defgv
3088 #define PL_diehook diehook
3089 #define PL_dirty dirty
3090 #define PL_dowarn dowarn
3091 #define PL_errgv errgv
3092 #define PL_hexdigit hexdigit
3093 #define PL_hints hints
3095 #define PL_no_modify no_modify
3096 #define PL_perl_destruct_level perl_destruct_level
3097 #define PL_perldb perldb
3098 #define PL_ppaddr ppaddr
3099 #define PL_rsfp_filters rsfp_filters
3100 #define PL_rsfp rsfp
3101 #define PL_stack_base stack_base
3102 #define PL_stack_sp stack_sp
3103 #define PL_stdingv stdingv
3104 #define PL_sv_arenaroot sv_arenaroot
3105 #define PL_sv_no sv_no
3106 #define PL_sv_undef sv_undef
3107 #define PL_sv_yes sv_yes
3108 #define PL_tainted tainted
3109 #define PL_tainting tainting
3113 #ifndef PERL_UNUSED_DECL
3115 #if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
3116 #define PERL_UNUSED_DECL
3118 #define PERL_UNUSED_DECL __attribute__((unused))
3121 #define PERL_UNUSED_DECL
3125 #define NOOP (void)0
3129 #define dNOOP extern int Perl___notused PERL_UNUSED_DECL
3133 #if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
3134 #define NVTYPE long double
3136 #define NVTYPE double
3143 #if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
3145 #define INT2PTR(any, d) (any)(d)
3147 #if PTRSIZE == LONGSIZE
3148 #define PTRV unsigned long
3150 #define PTRV unsigned
3152 #define INT2PTR(any, d) (any)(PTRV)(d)
3155 #define NUM2PTR(any, d) (any)(PTRV)(d)
3156 #define PTR2IV(p) INT2PTR(IV, p)
3157 #define PTR2UV(p) INT2PTR(UV, p)
3158 #define PTR2NV(p) NUM2PTR(NV, p)
3160 #if PTRSIZE == LONGSIZE
3161 #define PTR2ul(p) (unsigned long)(p)
3163 #define PTR2ul(p) INT2PTR(unsigned long, p)
3168 #undef START_EXTERN_C
3172 #define START_EXTERN_C extern "C" {
3173 #define END_EXTERN_C }
3174 #define EXTERN_C extern "C"
3176 #define START_EXTERN_C
3177 #define END_EXTERN_C
3178 #define EXTERN_C extern
3181 #ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
3182 #if defined(__STRICT_ANSI__) && defined(PERL_GCC_PEDANTIC)
3183 #define PERL_GCC_BRACE_GROUPS_FORBIDDEN
3189 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
3190 #define STMT_START (void)(
3193 #if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
3194 #define STMT_START if (1)
3195 #define STMT_END else(void) 0
3197 #define STMT_START do
3198 #define STMT_END while (0)
3202 #define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
3207 #define DEFSV GvSV(PL_defgv)
3211 #define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
3216 #define AvFILLp AvFILL
3219 #define ERRSV get_sv("@", FALSE)
3222 #define newSVpvn(data, len) ((data) ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) : newSV(0))
3232 #define gv_stashpvn(str, len, create) gv_stashpv(str, create)
3237 #define get_cv perl_get_cv
3241 #define get_sv perl_get_sv
3245 #define get_av perl_get_av
3249 #define get_hv perl_get_hv
3256 #define memNE(s1, s2, l) (memcmp(s1, s2, l))
3260 #define memEQ(s1, s2, l) (!memcmp(s1, s2, l))
3265 #define memNE(s1, s2, l) (bcmp(s1, s2, l))
3269 #define memEQ(s1, s2, l) (!bcmp(s1, s2, l))
3274 #define MoveD(s, d, n, t) memmove((char *)(d), (char *)(s), (n) * sizeof(t))
3278 #define CopyD(s, d, n, t) memcpy((char *)(d), (char *)(s), (n) * sizeof(t))
3283 #define ZeroD(d, n, t) memzero((char *)(d), (n) * sizeof(t))
3288 #define ZeroD(d, n, t) ((void)memzero((char *)(d), (n) * sizeof(t)), d)
3293 #define Poison(d, n, t) (void)memset((char *)(d), 0xAB, (n) * sizeof(t))
3296 #define dUNDERBAR dNOOP
3300 #define UNDERBAR DEFSV
3303 #define dAX I32 ax = MARK - PL_stack_base + 1
3307 #define dITEMS I32 items = SP - MARK
3310 #define dXSTARG SV *targ = sv_newmortal()
3320 #define dTHXa(x) dNOOP
3338 #define dTHXoa(x) dTHXa(x)
3341 #define PUSHmortal PUSHs(sv_newmortal())
3345 #define mPUSHp(p, l) sv_setpvn_mg(PUSHmortal, (p), (l))
3349 #define mPUSHn(n) sv_setnv_mg(PUSHmortal, (NV)(n))
3353 #define mPUSHi(i) sv_setiv_mg(PUSHmortal, (IV)(i))
3357 #define mPUSHu(u) sv_setuv_mg(PUSHmortal, (UV)(u))
3360 #define XPUSHmortal XPUSHs(sv_newmortal())
3364 #define mXPUSHp(p, l) \
3368 sv_setpvn_mg(PUSHmortal, (p), (l)); \
3374 #define mXPUSHn(n) \
3378 sv_setnv_mg(PUSHmortal, (NV)(n)); \
3384 #define mXPUSHi(i) \
3388 sv_setiv_mg(PUSHmortal, (IV)(i)); \
3394 #define mXPUSHu(u) \
3398 sv_setuv_mg(PUSHmortal, (UV)(u)); \
3405 #define call_sv perl_call_sv
3409 #define call_pv perl_call_pv
3413 #define call_argv perl_call_argv
3417 #define call_method perl_call_method
3420 #define eval_sv perl_eval_sv
3429 #if defined(NEED_eval_pv)
3430 static SV *DPPP_(my_eval_pv)(
char *p, I32 croak_on_error);
3433 extern SV *DPPP_(my_eval_pv)(
char *p, I32 croak_on_error);
3439 #define eval_pv(a, b) DPPP_(my_eval_pv)(aTHX_ a, b)
3440 #define Perl_eval_pv DPPP_(my_eval_pv)
3442 #if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
3444 SV *DPPP_(my_eval_pv)(
char *p, I32 croak_on_error)
3447 SV *sv = newSVpv(p, 0);
3450 eval_sv(sv, G_SCALAR);
3457 if (croak_on_error && SvTRUE(GvSV(errgv)))
3458 croak(SvPVx(GvSV(errgv), na));
3466 #define newRV_inc(sv) newRV(sv)
3470 #if defined(NEED_newRV_noinc)
3471 static SV *DPPP_(my_newRV_noinc)(SV *sv);
3474 extern SV *DPPP_(my_newRV_noinc)(SV *sv);
3480 #define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
3481 #define Perl_newRV_noinc DPPP_(my_newRV_noinc)
3483 #if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
3484 SV *DPPP_(my_newRV_noinc)(SV *sv)
3486 SV *rv = (SV *)newRV(sv);
3499 #if ((PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))) && \
3500 ((PERL_VERSION != 4) || (PERL_SUBVERSION != 5))
3501 #if defined(NEED_newCONSTSUB)
3502 static void DPPP_(my_newCONSTSUB)(HV *stash,
char *
name, SV *sv);
3505 extern void DPPP_(my_newCONSTSUB)(HV *stash,
char *
name, SV *sv);
3511 #define newCONSTSUB(a, b, c) DPPP_(my_newCONSTSUB)(aTHX_ a, b, c)
3512 #define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
3514 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
3516 void DPPP_(my_newCONSTSUB)(HV *stash,
char *
name, SV *sv)
3518 U32 oldhints = PL_hints;
3519 HV *old_cop_stash = PL_curcop->cop_stash;
3520 HV *old_curstash = PL_curstash;
3521 line_t oldline = PL_curcop->cop_line;
3522 PL_curcop->cop_line = PL_copline;
3524 PL_hints &= ~HINT_BLOCK_SCOPE;
3526 PL_curstash = PL_curcop->cop_stash = stash;
3530 #
if ((PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22)))
3532 #elif ((PERL_VERSION == 3) && (PERL_SUBVERSION == 22))
3535 start_subparse(FALSE, 0),
3538 newSVOP(OP_CONST, 0, newSVpv(name, 0)), newSVOP(OP_CONST, 0, &PL_sv_no),
3539 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv)));
3541 PL_hints = oldhints;
3542 PL_curcop->cop_stash = old_cop_stash;
3543 PL_curstash = old_curstash;
3544 PL_curcop->cop_line = oldline;
3568 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
3570 #ifndef START_MY_CXT
3575 #define START_MY_CXT
3577 #if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68))
3579 #define dMY_CXT_SV SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
3581 #define dMY_CXT_SV SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, sizeof(MY_CXT_KEY) - 1, TRUE)
3588 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t *, SvUV(my_cxt_sv))
3593 #define MY_CXT_INIT \
3596 my_cxt_t *my_cxtp = (my_cxt_t *)SvPVX(newSV(sizeof(my_cxt_t) - 1)); \
3597 Zero(my_cxtp, 1, my_cxt_t); \
3598 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
3602 #define MY_CXT (*my_cxtp)
3606 #define pMY_CXT my_cxt_t *my_cxtp
3607 #define pMY_CXT_ pMY_CXT,
3608 #define _pMY_CXT , pMY_CXT
3609 #define aMY_CXT my_cxtp
3610 #define aMY_CXT_ aMY_CXT,
3611 #define _aMY_CXT , aMY_CXT
3615 #ifndef MY_CXT_CLONE
3617 #define MY_CXT_CLONE \
3619 my_cxt_t *my_cxtp = (my_cxt_t *)SvPVX(newSV(sizeof(my_cxt_t) - 1)); \
3620 Copy(INT2PTR(my_cxt_t *, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t); \
3621 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
3626 #ifndef START_MY_CXT
3628 #define START_MY_CXT static my_cxt_t my_cxt;
3629 #define dMY_CXT_SV dNOOP
3630 #define dMY_CXT dNOOP
3631 #define MY_CXT_INIT NOOP
3632 #define MY_CXT my_cxt
3634 #define pMY_CXT void
3643 #ifndef MY_CXT_CLONE
3644 #define MY_CXT_CLONE NOOP
3650 #if IVSIZE == LONGSIZE
3657 #if IVSIZE == INTSIZE
3668 #if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
3669 defined(PERL_PRIfldbl)
3670 #define NVef PERL_PRIeldbl
3671 #define NVff PERL_PRIfldbl
3672 #define NVgf PERL_PRIgldbl
3682 #if defined(NEED_sv_2pv_nolen)
3683 static char *DPPP_(my_sv_2pv_nolen)(pTHX_
register SV *sv);
3686 extern char *DPPP_(my_sv_2pv_nolen)(pTHX_
register SV *sv);
3692 #define sv_2pv_nolen(a) DPPP_(my_sv_2pv_nolen)(aTHX_ a)
3693 #define Perl_sv_2pv_nolen DPPP_(my_sv_2pv_nolen)
3695 #if defined(NEED_sv_2pv_nolen) || defined(NEED_sv_2pv_nolen_GLOBAL)
3697 char *DPPP_(my_sv_2pv_nolen)(pTHX_
register SV *sv)
3700 return sv_2pv(sv, &n_a);
3710 #define SvPV_nolen(sv) ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK ? SvPVX(sv) : sv_2pv_nolen(sv))
3721 #if ((PERL_VERSION < 7) || ((PERL_VERSION == 7) && (PERL_SUBVERSION < 0)))
3723 #if defined(NEED_sv_2pvbyte)
3724 static char *DPPP_(my_sv_2pvbyte)(pTHX_
register SV *sv, STRLEN *lp);
3727 extern char *DPPP_(my_sv_2pvbyte)(pTHX_
register SV *sv, STRLEN *lp);
3733 #define sv_2pvbyte(a, b) DPPP_(my_sv_2pvbyte)(aTHX_ a, b)
3734 #define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
3736 #if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
3738 char *DPPP_(my_sv_2pvbyte)(pTHX_
register SV *sv, STRLEN *lp)
3740 sv_utf8_downgrade(sv, 0);
3741 return SvPV(sv, *lp);
3753 #define SvPVbyte(sv, lp) \
3754 ((SvFLAGS(sv) & (SVf_POK | SVf_UTF8)) == (SVf_POK) ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
3760 #define SvPVbyte SvPV
3761 #define sv_2pvbyte sv_2pv
3766 #ifndef sv_2pvbyte_nolen
3767 #define sv_2pvbyte_nolen sv_2pv_nolen
3774 #define sv_pvn(sv, len) SvPV(sv, len)
3780 #ifndef sv_pvn_force
3781 #define sv_pvn_force(sv, len) SvPV_force(sv, len)
3784 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(vnewSVpvf)
3785 #if defined(NEED_vnewSVpvf)
3786 static SV *DPPP_(my_vnewSVpvf)(pTHX_
const char *pat, va_list *args);
3789 extern SV *DPPP_(my_vnewSVpvf)(pTHX_
const char *pat, va_list *args);
3795 #define vnewSVpvf(a, b) DPPP_(my_vnewSVpvf)(aTHX_ a, b)
3796 #define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
3798 #if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
3800 SV *DPPP_(my_vnewSVpvf)(pTHX_
const char *pat, va_list *args)
3802 register SV *sv = newSV(0);
3803 sv_vsetpvfn(sv, pat, strlen(pat), args,
Null(SV **), 0,
Null(
bool *));
3811 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf)
3812 #define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV **), 0, Null(bool *))
3816 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf)
3817 #define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV **), 0, Null(bool *))
3821 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg)
3822 #if defined(NEED_sv_catpvf_mg)
3823 static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv,
const char *pat, ...);
3826 extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv,
const char *pat, ...);
3829 #define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
3831 #if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
3833 void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv,
const char *pat, ...)
3836 va_start(args, pat);
3837 sv_vcatpvfn(sv, pat, strlen(pat), &args,
Null(SV **), 0,
Null(
bool *));
3846 #ifdef PERL_IMPLICIT_CONTEXT
3847 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg_nocontext)
3848 #if defined(NEED_sv_catpvf_mg_nocontext)
3849 static void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv,
const char *pat, ...);
3852 extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv,
const char *pat, ...);
3855 #define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
3856 #define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
3858 #if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
3860 void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv,
const char *pat, ...)
3864 va_start(args, pat);
3865 sv_vcatpvfn(sv, pat, strlen(pat), &args,
Null(SV **), 0,
Null(
bool *));
3874 #ifndef sv_catpvf_mg
3875 #ifdef PERL_IMPLICIT_CONTEXT
3876 #define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
3878 #define sv_catpvf_mg Perl_sv_catpvf_mg
3883 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf_mg)
3884 #define sv_vcatpvf_mg(sv, pat, args) \
3887 sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV **), 0, Null(bool *)); \
3894 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg)
3895 #if defined(NEED_sv_setpvf_mg)
3896 static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv,
const char *pat, ...);
3899 extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv,
const char *pat, ...);
3902 #define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
3904 #if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
3906 void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv,
const char *pat, ...)
3909 va_start(args, pat);
3910 sv_vsetpvfn(sv, pat, strlen(pat), &args,
Null(SV **), 0,
Null(
bool *));
3919 #ifdef PERL_IMPLICIT_CONTEXT
3920 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg_nocontext)
3921 #if defined(NEED_sv_setpvf_mg_nocontext)
3922 static void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv,
const char *pat, ...);
3925 extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv,
const char *pat, ...);
3928 #define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
3929 #define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
3931 #if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
3933 void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv,
const char *pat, ...)
3937 va_start(args, pat);
3938 sv_vsetpvfn(sv, pat, strlen(pat), &args,
Null(SV **), 0,
Null(
bool *));
3947 #ifndef sv_setpvf_mg
3948 #ifdef PERL_IMPLICIT_CONTEXT
3949 #define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
3951 #define sv_setpvf_mg Perl_sv_setpvf_mg
3956 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf_mg)
3957 #define sv_vsetpvf_mg(sv, pat, args) \
3960 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV **), 0, Null(bool *)); \
3966 #define SvGETMAGIC(x) \
3969 if (SvGMAGICAL(x)) \
3974 #ifndef PERL_MAGIC_sv
3975 #define PERL_MAGIC_sv '\0'
3978 #ifndef PERL_MAGIC_overload
3979 #define PERL_MAGIC_overload 'A'
3982 #ifndef PERL_MAGIC_overload_elem
3983 #define PERL_MAGIC_overload_elem 'a'
3986 #ifndef PERL_MAGIC_overload_table
3987 #define PERL_MAGIC_overload_table 'c'
3990 #ifndef PERL_MAGIC_bm
3991 #define PERL_MAGIC_bm 'B'
3994 #ifndef PERL_MAGIC_regdata
3995 #define PERL_MAGIC_regdata 'D'
3998 #ifndef PERL_MAGIC_regdatum
3999 #define PERL_MAGIC_regdatum 'd'
4002 #ifndef PERL_MAGIC_env
4003 #define PERL_MAGIC_env 'E'
4006 #ifndef PERL_MAGIC_envelem
4007 #define PERL_MAGIC_envelem 'e'
4010 #ifndef PERL_MAGIC_fm
4011 #define PERL_MAGIC_fm 'f'
4014 #ifndef PERL_MAGIC_regex_global
4015 #define PERL_MAGIC_regex_global 'g'
4018 #ifndef PERL_MAGIC_isa
4019 #define PERL_MAGIC_isa 'I'
4022 #ifndef PERL_MAGIC_isaelem
4023 #define PERL_MAGIC_isaelem 'i'
4026 #ifndef PERL_MAGIC_nkeys
4027 #define PERL_MAGIC_nkeys 'k'
4030 #ifndef PERL_MAGIC_dbfile
4031 #define PERL_MAGIC_dbfile 'L'
4034 #ifndef PERL_MAGIC_dbline
4035 #define PERL_MAGIC_dbline 'l'
4038 #ifndef PERL_MAGIC_mutex
4039 #define PERL_MAGIC_mutex 'm'
4042 #ifndef PERL_MAGIC_shared
4043 #define PERL_MAGIC_shared 'N'
4046 #ifndef PERL_MAGIC_shared_scalar
4047 #define PERL_MAGIC_shared_scalar 'n'
4050 #ifndef PERL_MAGIC_collxfrm
4051 #define PERL_MAGIC_collxfrm 'o'
4054 #ifndef PERL_MAGIC_tied
4055 #define PERL_MAGIC_tied 'P'
4058 #ifndef PERL_MAGIC_tiedelem
4059 #define PERL_MAGIC_tiedelem 'p'
4062 #ifndef PERL_MAGIC_tiedscalar
4063 #define PERL_MAGIC_tiedscalar 'q'
4066 #ifndef PERL_MAGIC_qr
4067 #define PERL_MAGIC_qr 'r'
4070 #ifndef PERL_MAGIC_sig
4071 #define PERL_MAGIC_sig 'S'
4074 #ifndef PERL_MAGIC_sigelem
4075 #define PERL_MAGIC_sigelem 's'
4078 #ifndef PERL_MAGIC_taint
4079 #define PERL_MAGIC_taint 't'
4082 #ifndef PERL_MAGIC_uvar
4083 #define PERL_MAGIC_uvar 'U'
4086 #ifndef PERL_MAGIC_uvar_elem
4087 #define PERL_MAGIC_uvar_elem 'u'
4090 #ifndef PERL_MAGIC_vstring
4091 #define PERL_MAGIC_vstring 'V'
4094 #ifndef PERL_MAGIC_vec
4095 #define PERL_MAGIC_vec 'v'
4098 #ifndef PERL_MAGIC_utf8
4099 #define PERL_MAGIC_utf8 'w'
4102 #ifndef PERL_MAGIC_substr
4103 #define PERL_MAGIC_substr 'x'
4106 #ifndef PERL_MAGIC_defelem
4107 #define PERL_MAGIC_defelem 'y'
4110 #ifndef PERL_MAGIC_glob
4111 #define PERL_MAGIC_glob '*'
4114 #ifndef PERL_MAGIC_arylen
4115 #define PERL_MAGIC_arylen '#'
4118 #ifndef PERL_MAGIC_pos
4119 #define PERL_MAGIC_pos '.'
4122 #ifndef PERL_MAGIC_backref
4123 #define PERL_MAGIC_backref '<'
4126 #ifndef PERL_MAGIC_ext
4127 #define PERL_MAGIC_ext '~'
4131 #ifndef SvPV_force_nomg
4132 #define SvPV_force_nomg SvPV_force
4136 #define SvPV_nomg SvPV
4139 #ifndef sv_catpvn_nomg
4140 #define sv_catpvn_nomg sv_catpvn
4143 #ifndef sv_catsv_nomg
4144 #define sv_catsv_nomg sv_catsv
4147 #ifndef sv_setsv_nomg
4148 #define sv_setsv_nomg sv_setsv
4152 #define sv_pvn_nomg sv_pvn
4156 #define SvIV_nomg SvIV
4160 #define SvUV_nomg SvUV
4164 #define sv_catpv_mg(sv, ptr) \
4168 sv_catpv(TeMpSv, ptr); \
4169 SvSETMAGIC(TeMpSv); \
4174 #ifndef sv_catpvn_mg
4175 #define sv_catpvn_mg(sv, ptr, len) \
4179 sv_catpvn(TeMpSv, ptr, len); \
4180 SvSETMAGIC(TeMpSv); \
4186 #define sv_catsv_mg(dsv, ssv) \
4190 sv_catsv(TeMpSv, ssv); \
4191 SvSETMAGIC(TeMpSv); \
4197 #define sv_setiv_mg(sv, i) \
4201 sv_setiv(TeMpSv, i); \
4202 SvSETMAGIC(TeMpSv); \
4208 #define sv_setnv_mg(sv, num) \
4212 sv_setnv(TeMpSv, num); \
4213 SvSETMAGIC(TeMpSv); \
4219 #define sv_setpv_mg(sv, ptr) \
4223 sv_setpv(TeMpSv, ptr); \
4224 SvSETMAGIC(TeMpSv); \
4229 #ifndef sv_setpvn_mg
4230 #define sv_setpvn_mg(sv, ptr, len) \
4234 sv_setpvn(TeMpSv, ptr, len); \
4235 SvSETMAGIC(TeMpSv); \
4241 #define sv_setsv_mg(dsv, ssv) \
4245 sv_setsv(TeMpSv, ssv); \
4246 SvSETMAGIC(TeMpSv); \
4252 #define sv_setuv_mg(sv, i) \
4256 sv_setuv(TeMpSv, i); \
4257 SvSETMAGIC(TeMpSv); \
4262 #ifndef sv_usepvn_mg
4263 #define sv_usepvn_mg(sv, ptr, len) \
4267 sv_usepvn(TeMpSv, ptr, len); \
4268 SvSETMAGIC(TeMpSv); \
4275 #define CopFILE(c) ((c)->cop_file)
4279 #define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
4283 #define CopFILE_set(c, pv) ((c)->cop_file = savepv(pv))
4287 #define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
4291 #define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
4295 #define CopSTASHPV(c) ((c)->cop_stashpv)
4298 #ifndef CopSTASHPV_set
4299 #define CopSTASHPV_set(c, pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
4303 #define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c), GV_ADD) : Nullhv)
4306 #ifndef CopSTASH_set
4307 #define CopSTASH_set(c, hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
4311 #define CopSTASH_eq(c, hv) \
4312 ((hv) && (CopSTASHPV(c) == HvNAME(hv) || (CopSTASHPV(c) && HvNAME(hv) && strEQ(CopSTASHPV(c), HvNAME(hv)))))
4317 #define CopFILEGV(c) ((c)->cop_filegv)
4320 #ifndef CopFILEGV_set
4321 #define CopFILEGV_set(c, gv) ((c)->cop_filegv = (GV *)SvREFCNT_inc(gv))
4325 #define CopFILE_set(c, pv) CopFILEGV_set((c), gv_fetchfile(pv))
4329 #define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
4333 #define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
4337 #define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
4341 #define CopSTASH(c) ((c)->cop_stash)
4344 #ifndef CopSTASH_set
4345 #define CopSTASH_set(c, hv) ((c)->cop_stash = (hv))
4349 #define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
4352 #ifndef CopSTASHPV_set
4353 #define CopSTASHPV_set(c, pv) CopSTASH_set((c), gv_stashpv(pv, GV_ADD))
4357 #define CopSTASH_eq(c, hv) (CopSTASH(c) == (hv))
4361 #ifndef IN_PERL_COMPILETIME
4362 #define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
4365 #ifndef IN_LOCALE_RUNTIME
4366 #define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
4369 #ifndef IN_LOCALE_COMPILETIME
4370 #define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
4374 #define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
4376 #ifndef IS_NUMBER_IN_UV
4377 #define IS_NUMBER_IN_UV 0x01
4380 #ifndef IS_NUMBER_GREATER_THAN_UV_MAX
4381 #define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
4384 #ifndef IS_NUMBER_NOT_INT
4385 #define IS_NUMBER_NOT_INT 0x04
4388 #ifndef IS_NUMBER_NEG
4389 #define IS_NUMBER_NEG 0x08
4392 #ifndef IS_NUMBER_INFINITY
4393 #define IS_NUMBER_INFINITY 0x10
4396 #ifndef IS_NUMBER_NAN
4397 #define IS_NUMBER_NAN 0x20
4401 #ifndef GROK_NUMERIC_RADIX
4402 #define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
4404 #ifndef PERL_SCAN_GREATER_THAN_UV_MAX
4405 #define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
4408 #ifndef PERL_SCAN_SILENT_ILLDIGIT
4409 #define PERL_SCAN_SILENT_ILLDIGIT 0x04
4412 #ifndef PERL_SCAN_ALLOW_UNDERSCORES
4413 #define PERL_SCAN_ALLOW_UNDERSCORES 0x01
4416 #ifndef PERL_SCAN_DISALLOW_PREFIX
4417 #define PERL_SCAN_DISALLOW_PREFIX 0x02
4420 #ifndef grok_numeric_radix
4421 #if defined(NEED_grok_numeric_radix)
4422 static bool DPPP_(my_grok_numeric_radix)(pTHX_
const char **sp,
const char *send);
4425 extern bool DPPP_(my_grok_numeric_radix)(pTHX_
const char **sp,
const char *send);
4428 #ifdef grok_numeric_radix
4429 #undef grok_numeric_radix
4431 #define grok_numeric_radix(a, b) DPPP_(my_grok_numeric_radix)(aTHX_ a, b)
4432 #define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
4434 #if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
4435 bool DPPP_(my_grok_numeric_radix)(pTHX_
const char **sp,
const char *send)
4437 #ifdef USE_LOCALE_NUMERIC
4438 #ifdef PL_numeric_radix_sv
4439 if (PL_numeric_radix_sv && IN_LOCALE)
4442 char *radix = SvPV(PL_numeric_radix_sv, len);
4443 if (*sp + len <= send && memEQ(*sp, radix, len))
4455 struct lconv *lc = localeconv();
4456 char *radix = lc->decimal_point;
4457 if (radix && IN_LOCALE)
4459 STRLEN len = strlen(radix);
4460 if (*sp + len <= send && memEQ(*sp, radix, len))
4470 if (*sp < send && **sp ==
'.')
4483 #if defined(NEED_grok_number)
4484 static int DPPP_(my_grok_number)(pTHX_
const char *pv, STRLEN len, UV *valuep);
4487 extern int DPPP_(my_grok_number)(pTHX_
const char *pv, STRLEN len, UV *valuep);
4493 #define grok_number(a, b, c) DPPP_(my_grok_number)(aTHX_ a, b, c)
4494 #define Perl_grok_number DPPP_(my_grok_number)
4496 #if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
4497 int DPPP_(my_grok_number)(pTHX_
const char *pv, STRLEN len, UV *valuep)
4500 const char *send = pv + len;
4501 const UV max_div_10 = UV_MAX / 10;
4502 const char max_mod_10 = UV_MAX % 10;
4507 while (s < send && isSPACE(*s))
4516 numtype = IS_NUMBER_NEG;
4529 UV value = *s -
'0';
4537 int digit = *s -
'0';
4538 if (digit >= 0 && digit <= 9)
4540 value = value * 10 + digit;
4544 if (digit >= 0 && digit <= 9)
4546 value = value * 10 + digit;
4550 if (digit >= 0 && digit <= 9)
4552 value = value * 10 + digit;
4556 if (digit >= 0 && digit <= 9)
4558 value = value * 10 + digit;
4562 if (digit >= 0 && digit <= 9)
4564 value = value * 10 + digit;
4568 if (digit >= 0 && digit <= 9)
4570 value = value * 10 + digit;
4574 if (digit >= 0 && digit <= 9)
4576 value = value * 10 + digit;
4580 if (digit >= 0 && digit <= 9)
4582 value = value * 10 + digit;
4588 while (digit >= 0 && digit <= 9 &&
4589 (value < max_div_10 ||
4590 (value == max_div_10 &&
4591 digit <= max_mod_10)))
4593 value = value * 10 + digit;
4599 if (digit >= 0 && digit <= 9 && (s < send))
4607 }
while (s < send && isDIGIT(*s));
4609 IS_NUMBER_GREATER_THAN_UV_MAX;
4629 numtype |= IS_NUMBER_IN_UV;
4634 if (GROK_NUMERIC_RADIX(&s, send))
4636 numtype |= IS_NUMBER_NOT_INT;
4637 while (s < send && isDIGIT(*s))
4641 else if (GROK_NUMERIC_RADIX(&s, send))
4643 numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV;
4645 if (s < send && isDIGIT(*s))
4650 }
while (s < send && isDIGIT(*s));
4660 else if (*s ==
'I' || *s ==
'i')
4663 if (s == send || (*s !=
'N' && *s !=
'n'))
4666 if (s == send || (*s !=
'F' && *s !=
'f'))
4669 if (s < send && (*s ==
'I' || *s ==
'i'))
4672 if (s == send || (*s !=
'N' && *s !=
'n'))
4675 if (s == send || (*s !=
'I' && *s !=
'i'))
4678 if (s == send || (*s !=
'T' && *s !=
't'))
4681 if (s == send || (*s !=
'Y' && *s !=
'y'))
4687 else if (*s ==
'N' || *s ==
'n')
4691 if (s == send || (*s !=
'A' && *s !=
'a'))
4694 if (s == send || (*s !=
'N' && *s !=
'n'))
4704 numtype &= IS_NUMBER_NEG;
4705 numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
4709 numtype &= IS_NUMBER_NEG;
4710 numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
4715 if (*s ==
'e' || *s ==
'E')
4718 numtype &= IS_NUMBER_NEG;
4719 numtype |= IS_NUMBER_NOT_INT;
4721 if (s < send && (*s ==
'-' || *s ==
'+'))
4723 if (s < send && isDIGIT(*s))
4728 }
while (s < send && isDIGIT(*s));
4734 while (s < send && isSPACE(*s))
4738 if (len == 10 && memEQ(pv,
"0 but true", 10))
4742 return IS_NUMBER_IN_UV;
4756 #if defined(NEED_grok_bin)
4757 static UV DPPP_(my_grok_bin)(pTHX_
char *start, STRLEN *len_p, I32 *flags, NV *result);
4760 extern UV DPPP_(my_grok_bin)(pTHX_
char *start, STRLEN *len_p, I32 *flags, NV *result);
4766 #define grok_bin(a, b, c, d) DPPP_(my_grok_bin)(aTHX_ a, b, c, d)
4767 #define Perl_grok_bin DPPP_(my_grok_bin)
4769 #if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
4770 UV DPPP_(my_grok_bin)(pTHX_
char *start, STRLEN *len_p, I32 *flags, NV *result)
4772 const char *s = start;
4773 STRLEN len = *len_p;
4777 const UV max_div_2 = UV_MAX / 2;
4778 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
4779 bool overflowed = FALSE;
4781 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX))
4793 else if (len >= 2 && s[0] ==
'0' && s[1] ==
'b')
4801 for (; len-- && *s; s++)
4804 if (bit ==
'0' || bit ==
'1')
4812 if (value <= max_div_2)
4814 value = (value << 1) | (bit -
'0');
4818 warn(
"Integer overflow in binary number");
4820 value_nv = (NV)value;
4829 value_nv += (NV)(bit -
'0');
4832 if (bit ==
'_' && len && allow_underscores && (bit = s[1]) && (bit ==
'0' || bit ==
'1'))
4838 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
4839 warn(
"Illegal binary digit '%c' ignored", *s);
4843 if ((overflowed && value_nv > 4294967295.0)
4845 || (!overflowed && value > 0xffffffff)
4849 warn(
"Binary number > 0b11111111111111111111111111111111 non-portable");
4857 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
4866 #if defined(NEED_grok_hex)
4867 static UV DPPP_(my_grok_hex)(pTHX_
char *start, STRLEN *len_p, I32 *flags, NV *result);
4870 extern UV DPPP_(my_grok_hex)(pTHX_
char *start, STRLEN *len_p, I32 *flags, NV *result);
4876 #define grok_hex(a, b, c, d) DPPP_(my_grok_hex)(aTHX_ a, b, c, d)
4877 #define Perl_grok_hex DPPP_(my_grok_hex)
4879 #if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
4880 UV DPPP_(my_grok_hex)(pTHX_
char *start, STRLEN *len_p, I32 *flags, NV *result)
4882 const char *s = start;
4883 STRLEN len = *len_p;
4887 const UV max_div_16 = UV_MAX / 16;
4888 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
4889 bool overflowed = FALSE;
4892 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX))
4904 else if (len >= 2 && s[0] ==
'0' && s[1] ==
'x')
4912 for (; len-- && *s; s++)
4914 xdigit = strchr((
char *)PL_hexdigit, *s);
4923 if (value <= max_div_16)
4925 value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
4928 warn(
"Integer overflow in hexadecimal number");
4930 value_nv = (NV)value;
4939 value_nv += (NV)((xdigit - PL_hexdigit) & 15);
4942 if (*s ==
'_' && len && allow_underscores && s[1] && (xdigit = strchr((
char *)PL_hexdigit, s[1])))
4948 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
4949 warn(
"Illegal hexadecimal digit '%c' ignored", *s);
4953 if ((overflowed && value_nv > 4294967295.0)
4955 || (!overflowed && value > 0xffffffff)
4959 warn(
"Hexadecimal number > 0xffffffff non-portable");
4967 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
4976 #if defined(NEED_grok_oct)
4977 static UV DPPP_(my_grok_oct)(pTHX_
char *start, STRLEN *len_p, I32 *flags, NV *result);
4980 extern UV DPPP_(my_grok_oct)(pTHX_
char *start, STRLEN *len_p, I32 *flags, NV *result);
4986 #define grok_oct(a, b, c, d) DPPP_(my_grok_oct)(aTHX_ a, b, c, d)
4987 #define Perl_grok_oct DPPP_(my_grok_oct)
4989 #if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
4990 UV DPPP_(my_grok_oct)(pTHX_
char *start, STRLEN *len_p, I32 *flags, NV *result)
4992 const char *s = start;
4993 STRLEN len = *len_p;
4997 const UV max_div_8 = UV_MAX / 8;
4998 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
4999 bool overflowed = FALSE;
5001 for (; len-- && *s; s++)
5005 int digit = *s -
'0';
5006 if (digit >= 0 && digit <= 7)
5014 if (value <= max_div_8)
5016 value = (value << 3) | digit;
5020 warn(
"Integer overflow in octal number");
5022 value_nv = (NV)value;
5031 value_nv += (NV)digit;
5034 if (digit == (
'_' -
'0') && len && allow_underscores && (digit = s[1] -
'0') && (digit >= 0 && digit <= 7))
5043 if (digit == 8 || digit == 9)
5045 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
5046 warn(
"Illegal octal digit '%c' ignored", *s);
5051 if ((overflowed && value_nv > 4294967295.0)
5053 || (!overflowed && value > 0xffffffff)
5057 warn(
"Octal number > 037777777777 non-portable");
5065 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
5078 #define XCPT_TRY_START \
5079 JMPENV_PUSH(rEtV); \
5081 #define XCPT_TRY_END JMPENV_POP;
5082 #define XCPT_CATCH if (rEtV != 0)
5083 #define XCPT_RETHROW JMPENV_JUMP(rEtV)
5086 Sigjmp_buf oldTOP; \
5088 #define XCPT_TRY_START \
5089 Copy(top_env, oldTOP, 1, Sigjmp_buf); \
5090 rEtV = Sigsetjmp(top_env, 1); \
5092 #define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
5093 #define XCPT_CATCH if (rEtV != 0)
5094 #define XCPT_RETHROW Siglongjmp(top_env, rEtV)