diff --git a/EXTERN.h b/EXTERN.h index e6d97caa44df..c229033432aa 100644 --- a/EXTERN.h +++ b/EXTERN.h @@ -1,20 +1,20 @@ /* EXTERN.h * - * Copyright (C) 1991, 1992, 1993, 1995, 1996, 1997, 1998, 1999, - * 2000, 2001, by Larry Wall and others + * Copyright (C) 1991, 1992, 1993, 1995, 1996, 1997, 1998, 1999, 2000, + * 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, + * 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021, 2022 by + * Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * */ /* - * EXT: designates a global var which is defined in perl.h + * EXT: designates a global var which is defined in perl.h * - * dEXT: designates a global var which is defined in another - * file, so we can't count on finding it in perl.h - * (this practice should be avoided). - */ + * dEXT: designates a global var which is defined in another file, so we can't + * count on finding it in perl.h (this practice should be avoided). +*/ #undef EXT #undef dEXT #undef EXTCONST @@ -23,32 +23,32 @@ # if defined(WIN32) && !defined(PERL_STATIC_SYMS) /* miniperl should not export anything */ # if defined(PERL_IS_MINIPERL) -# define EXT extern -# define dEXT -# define EXTCONST extern const -# define dEXTCONST const +# define EXT extern +# define dEXT +# define EXTCONST extern const +# define dEXTCONST const # elif defined(PERLDLL) -# define EXT EXTERN_C __declspec(dllexport) -# define dEXT -# define EXTCONST EXTERN_C __declspec(dllexport) const -# define dEXTCONST const +# define EXT EXTERN_C __declspec(dllexport) +# define dEXT +# define EXTCONST EXTERN_C __declspec(dllexport) const +# define dEXTCONST const # else -# define EXT EXTERN_C __declspec(dllimport) -# define dEXT -# define EXTCONST EXTERN_C __declspec(dllimport) const -# define dEXTCONST const +# define EXT EXTERN_C __declspec(dllimport) +# define dEXT +# define EXTCONST EXTERN_C __declspec(dllimport) const +# define dEXTCONST const # endif # else # if defined(__CYGWIN__) && defined(USEIMPORTLIB) -# define EXT extern __declspec(dllimport) -# define dEXT -# define EXTCONST extern __declspec(dllimport) const -# define dEXTCONST const +# define EXT extern __declspec(dllimport) +# define dEXT +# define EXTCONST extern __declspec(dllimport) const +# define dEXTCONST const # else -# define EXT extern +# define EXT extern # define dEXT -# define EXTCONST extern const -# define dEXTCONST const +# define EXTCONST extern const +# define dEXTCONST const # endif # endif diff --git a/INTERN.h b/INTERN.h index 6a28e6020b91..a48743efe31d 100644 --- a/INTERN.h +++ b/INTERN.h @@ -1,19 +1,17 @@ /* INTERN.h * - * Copyright (C) 1991, 1992, 1993, 1995, 1996, 1998, 2000, 2001, - * by Larry Wall and others + * Copyright (C) 1991, 1992, 1993, 1995, 1996, 1998, 2000, 2001, by + * Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * */ /* - * EXT designates a global var which is defined in perl.h - * dEXT designates a global var which is defined in another - * file, so we can't count on finding it in perl.h - * (this practice should be avoided). - */ + * EXT designates a global var which is defined in perl.h dEXT designates + * a global var which is defined in another file, so we can't count on + * finding it in perl.h (this practice should be avoided). +*/ #undef EXT #undef dEXT #undef EXTCONST @@ -21,31 +19,31 @@ # if (defined(WIN32) && defined(__MINGW32__) && ! defined(PERL_IS_MINIPERL)) # ifdef __cplusplus -# define EXT __declspec(dllexport) +# define EXT __declspec(dllexport) # define dEXT -# define EXTCONST __declspec(dllexport) extern const -# define dEXTCONST const +# define EXTCONST __declspec(dllexport) extern const +# define dEXTCONST const # else -# define EXT __declspec(dllexport) +# define EXT __declspec(dllexport) # define dEXT -# define EXTCONST __declspec(dllexport) const -# define dEXTCONST const +# define EXTCONST __declspec(dllexport) const +# define dEXTCONST const # endif # else # ifdef __cplusplus # define EXT # define dEXT -# define EXTCONST EXTERN_C const -# define dEXTCONST const +# define EXTCONST EXTERN_C const +# define dEXTCONST const # else # define EXT # define dEXT -# define EXTCONST const -# define dEXTCONST const +# define EXTCONST const +# define dEXTCONST const # endif # endif #undef INIT -#define INIT(...) = __VA_ARGS__ +#define INIT(...) = __VA_ARGS__ #define DOINIT diff --git a/XSUB.h b/XSUB.h index 82cd0dc7777c..79f7c4955a9a 100644 --- a/XSUB.h +++ b/XSUB.h @@ -1,15 +1,15 @@ /* XSUB.h * - * Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, - * 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others + * Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, + * 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, + * 2016, 2017, 2018, 2019, 2020, 2021, 2022 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * */ #ifndef PERL_XSUB_H_ -#define PERL_XSUB_H_ 1 +#define PERL_XSUB_H_ 1 /* first, some documentation for xsubpp-generated items */ @@ -23,32 +23,31 @@ Some variables below are flagged with 'u' because Devel::PPPort can't currently readily test them as they spring into existence by compiling with xsubpp. =for apidoc Amnu|char*|CLASS -Variable which is setup by C to indicate the -class name for a C++ XS constructor. This is always a C. See -C>. +Variable which is setup by C to indicate the class name for a C++ XS +constructor. This is always a C. See C>. =for apidoc Amnu|type|RETVAL -Variable which is setup by C to hold the return value for an -XSUB. This is always the proper type for the XSUB. See +Variable which is setup by C to hold the return value for an XSUB. +This is always the proper type for the XSUB. See L. =for apidoc Amnu|type|THIS -Variable which is setup by C to designate the object in a C++ -XSUB. This is always the proper type for the C++ object. See C> and +Variable which is setup by C to designate the object in a C++ XSUB. +This is always the proper type for the C++ object. See C> and L. =for apidoc Amn|I32|ax -Variable which is setup by C to indicate the stack base offset, -used by the C, C and C macros. The C macro -must be called prior to setup the C variable. +Variable which is setup by C to indicate the stack base offset, used by +the C, C and C macros. The C macro must be +called prior to setup the C variable. =for apidoc Amn|I32|items -Variable which is setup by C to indicate the number of -items on the stack. See L. +Variable which is setup by C to indicate the number of items on the +stack. See L. =for apidoc Amn|I32|ix -Variable which is setup by C to indicate which of an -XSUB's aliases was used to invoke it. See L. +Variable which is setup by C to indicate which of an XSUB's aliases was +used to invoke it. See L. =for apidoc Am|SV*|ST|int ix Used to access elements on the XSUB's stack. @@ -59,37 +58,38 @@ C. It is the same as using the more explicit C macro; the latter is preferred. =for apidoc Ayu||XS_INTERNAL|name -Macro to declare an XSUB and its C parameter list without exporting the symbols. -This is handled by C and generally preferable over exporting the XSUB -symbols unnecessarily. +Macro to declare an XSUB and its C parameter list without exporting the +symbols. This is handled by C and generally preferable over exporting +the XSUB symbols unnecessarily. =for comment XS_INTERNAL marked 'u' because declaring a function static within our test function doesn't work =for apidoc Ay||XS_EXTERNAL|name -Macro to declare an XSUB and its C parameter list explicitly exporting the symbols. +Macro to declare an XSUB and its C parameter list explicitly exporting the +symbols. =for apidoc Ay||XSPROTO|name Macro used by C> and C> to declare a function prototype. You probably shouldn't be using this directly yourself. =for apidoc Amn;||dAX -Sets up the C variable. -This is usually handled automatically by C by calling C. +Sets up the C variable. This is usually handled automatically by C +by calling C. =for apidoc Amn;||dAXMARK -Sets up the C variable and stack marker variable C. -This is usually handled automatically by C by calling C. +Sets up the C variable and stack marker variable C. This is usually +handled automatically by C by calling C. =for apidoc Amn;||dITEMS -Sets up the C variable. -This is usually handled automatically by C by calling C. +Sets up the C variable. This is usually handled automatically by +C by calling C. =for apidoc Amn;||dXSARGS -Sets up stack and mark pointers for an XSUB, calling C and C. -Sets up the C and C variables by calling C and C. -This is usually handled automatically by C. +Sets up stack and mark pointers for an XSUB, calling C and C. Sets +up the C and C variables by calling C and C. This is +usually handled automatically by C. =for apidoc Amn;||dXSI32 Sets up the C variable for an XSUB which has aliases. This is usually @@ -97,24 +97,24 @@ handled automatically by C. =for apidoc Amn;||dUNDERBAR Sets up any variable needed by the C macro. It used to define -C, but it is currently a noop. However, it is strongly advised -to still use it for ensuring past and future compatibility. +C, but it is currently a noop. However, it is strongly advised to +still use it for ensuring past and future compatibility. =for apidoc AmnU||UNDERBAR -The SV* corresponding to the C<$_> variable. Works even if there -is a lexical C<$_> in scope. +The SV* corresponding to the C<$_> variable. Works even if there is a lexical +C<$_> in scope. =cut */ #ifndef PERL_UNUSED_ARG -# define PERL_UNUSED_ARG(x) ((void)sizeof(x)) +# define PERL_UNUSED_ARG(x) ((void)sizeof(x)) #endif #ifndef PERL_UNUSED_VAR -# define PERL_UNUSED_VAR(x) ((void)sizeof(x)) +# define PERL_UNUSED_VAR(x) ((void)sizeof(x)) #endif -#define ST(off) PL_stack_base[ax + (off)] +#define ST(off) PL_stack_base[ax + (off)] /* XSPROTO() is also used by SWIG like this: * @@ -123,127 +123,124 @@ is a lexical C<$_> in scope. * * This code needs to be compilable under both C and C++. * - * Don't forget to change the __attribute__unused__ version of XS() - * below too if you change XSPROTO() here. + * Don't forget to change the __attribute__unused__ version + * of XS() below too if you change XSPROTO() here. */ -/* XS_INTERNAL is the explicit static-linkage variant of the default - * XS macro. +/* XS_INTERNAL is the explicit static-linkage variant of the default XS macro. * - * XS_EXTERNAL is the same as XS_INTERNAL except it does not include - * "STATIC", ie. it exports XSUB symbols. You probably don't want that. + * XS_EXTERNAL is the same as XS_INTERNAL except it does not include "STATIC", + * ie. it exports XSUB symbols. You probably don't want that. */ -#define XSPROTO(name) void name(pTHX_ CV* cv __attribute__unused__) +#define XSPROTO(name) void name(pTHX_ CV* cv __attribute__unused__) #undef XS #undef XS_EXTERNAL #undef XS_INTERNAL #if defined(__CYGWIN__) && defined(USE_DYNAMIC_LOADING) -# define XS_EXTERNAL(name) __declspec(dllexport) XSPROTO(name) -# define XS_INTERNAL(name) STATIC XSPROTO(name) +# define XS_EXTERNAL(name) __declspec(dllexport) XSPROTO(name) +# define XS_INTERNAL(name) STATIC XSPROTO(name) #elif defined(__cplusplus) -# define XS_EXTERNAL(name) extern "C" XSPROTO(name) -# define XS_INTERNAL(name) static XSPROTO(name) +# define XS_EXTERNAL(name) extern "C" XSPROTO(name) +# define XS_INTERNAL(name) static XSPROTO(name) #elif defined(HASATTRIBUTE_UNUSED) -# define XS_EXTERNAL(name) void name(pTHX_ CV* cv __attribute__unused__) -# define XS_INTERNAL(name) STATIC void name(pTHX_ CV* cv __attribute__unused__) +# define XS_EXTERNAL(name) void name(pTHX_ CV* cv __attribute__unused__) +# define XS_INTERNAL(name) STATIC void name(pTHX_ CV* cv __attribute__unused__) #else -# define XS_EXTERNAL(name) XSPROTO(name) -# define XS_INTERNAL(name) STATIC XSPROTO(name) +# define XS_EXTERNAL(name) XSPROTO(name) +# define XS_INTERNAL(name) STATIC XSPROTO(name) #endif -/* We do export xsub symbols by default for the public XS macro. - * Try explicitly using XS_INTERNAL/XS_EXTERNAL instead, please. */ -#define XS(name) XS_EXTERNAL(name) +/* We do export xsub symbols by default for the public XS macro. Try + * explicitly using XS_INTERNAL/XS_EXTERNAL instead, please. */ +#define XS(name) XS_EXTERNAL(name) -#define dAX const I32 ax = (I32)(MARK - PL_stack_base + 1) +#define dAX const I32 ax = (I32)(MARK - PL_stack_base + 1) -#define dAXMARK \ - I32 ax = POPMARK; \ - SV **mark = PL_stack_base + ax++ +#define dAXMARK \ + I32 ax = POPMARK; \ + SV **mark = PL_stack_base + ax++ -#define dITEMS I32 items = (I32)(SP - MARK) +#define dITEMS I32 items = (I32)(SP - MARK) #define dXSARGS \ - dSP; dAXMARK; dITEMS + dSP; dAXMARK; dITEMS /* These 3 macros are replacements for dXSARGS macro only in bootstrap. - They factor out common code in every BOOT XSUB. Computation of vars mark - and items will optimize away in most BOOT functions. Var ax can never be - optimized away since BOOT must return &PL_sv_yes by default from xsubpp. - Note these macros are not drop in replacements for dXSARGS since they set - PL_xsubfilename. */ -#define dXSBOOTARGSXSAPIVERCHK \ - I32 ax = XS_BOTHVERSION_SETXSUBFN_POPMARK_BOOTCHECK; \ - SV **mark = PL_stack_base + ax - 1; dSP; dITEMS -#define dXSBOOTARGSAPIVERCHK \ - I32 ax = XS_APIVERSION_SETXSUBFN_POPMARK_BOOTCHECK; \ - SV **mark = PL_stack_base + ax - 1; dSP; dITEMS + They factor out common code in every BOOT XSUB. Computation of vars + mark and items will optimize away in most BOOT functions. Var ax can + never be optimized away since BOOT must return &PL_sv_yes by default + from xsubpp. Note these macros are not drop in replacements for + dXSARGS since they set PL_xsubfilename. */ +#define dXSBOOTARGSXSAPIVERCHK \ + I32 ax = XS_BOTHVERSION_SETXSUBFN_POPMARK_BOOTCHECK; \ + SV **mark = PL_stack_base + ax - 1; dSP; dITEMS +#define dXSBOOTARGSAPIVERCHK \ + I32 ax = XS_APIVERSION_SETXSUBFN_POPMARK_BOOTCHECK; \ + SV **mark = PL_stack_base + ax - 1; dSP; dITEMS /* dXSBOOTARGSNOVERCHK has no API in xsubpp to choose it so do #undef dXSBOOTARGSXSAPIVERCHK #define dXSBOOTARGSXSAPIVERCHK dXSBOOTARGSNOVERCHK */ -#define dXSBOOTARGSNOVERCHK \ - I32 ax = XS_SETXSUBFN_POPMARK; \ - SV **mark = PL_stack_base + ax - 1; dSP; dITEMS +#define dXSBOOTARGSNOVERCHK \ + I32 ax = XS_SETXSUBFN_POPMARK; \ + SV **mark = PL_stack_base + ax - 1; dSP; dITEMS -#define dXSTARG SV * const targ = ((PL_op->op_private & OPpENTERSUB_HASTARG) \ - ? PAD_SV(PL_op->op_targ) : sv_newmortal()) +#define dXSTARG \ + SV * const targ = ((PL_op->op_private & OPpENTERSUB_HASTARG) \ + ? PAD_SV(PL_op->op_targ) : sv_newmortal()) -/* Should be used before final PUSHi etc. if not in PPCODE section. */ -#define XSprePUSH (sp = PL_stack_base + ax - 1) +/* Should be used before final PUSHi etc. if not in PPCODE section. */ +#define XSprePUSH (sp = PL_stack_base + ax - 1) -#define XSANY CvXSUBANY(cv) +#define XSANY CvXSUBANY(cv) -#define dXSI32 I32 ix = XSANY.any_i32 +#define dXSI32 I32 ix = XSANY.any_i32 #ifdef __cplusplus -# define XSINTERFACE_CVT(ret,name) ret (*name)(...) -# define XSINTERFACE_CVT_ANON(ret) ret (*)(...) +# define XSINTERFACE_CVT(ret,name) ret (*name)(...) +# define XSINTERFACE_CVT_ANON(ret) ret (*)(...) #else -# define XSINTERFACE_CVT(ret,name) ret (*name)() -# define XSINTERFACE_CVT_ANON(ret) ret (*)() +# define XSINTERFACE_CVT(ret,name) ret (*name)() +# define XSINTERFACE_CVT_ANON(ret) ret (*)() #endif -#define dXSFUNCTION(ret) XSINTERFACE_CVT(ret,XSFUNCTION) -#define XSINTERFACE_FUNC(ret,cv,f) ((XSINTERFACE_CVT_ANON(ret))(f)) -#define XSINTERFACE_FUNC_SET(cv,f) \ - CvXSUBANY(cv).any_dxptr = (void (*) (pTHX_ void*))(f) +#define dXSFUNCTION(ret) XSINTERFACE_CVT(ret,XSFUNCTION) +#define XSINTERFACE_FUNC(ret,cv,f) ((XSINTERFACE_CVT_ANON(ret))(f)) +#define XSINTERFACE_FUNC_SET(cv,f) \ + CvXSUBANY(cv).any_dxptr = (void (*) (pTHX_ void*))(f) -#define dUNDERBAR dNOOP -#define UNDERBAR find_rundefsv() +#define dUNDERBAR dNOOP +#define UNDERBAR find_rundefsv() -/* Simple macros to put new mortal values onto the stack. */ -/* Typically used to return values from XS functions. */ +/* Simple macros to put new mortal values onto the stack. */ +/* Typically used to return values from XS functions. */ /* =for apidoc_section $stack =for apidoc Am|void|XST_mIV|int pos|IV iv -Place an integer into the specified position C on the stack. The -value is stored in a new mortal SV. +Place an integer into the specified position C on the stack. The value is +stored in a new mortal SV. =for apidoc Am|void|XST_mNV|int pos|NV nv -Place a double into the specified position C on the stack. The value -is stored in a new mortal SV. +Place a double into the specified position C on the stack. The value is +stored in a new mortal SV. =for apidoc Am|void|XST_mPV|int pos|char* str -Place a copy of a string into the specified position C on the stack. -The value is stored in a new mortal SV. +Place a copy of a string into the specified position C on the stack. The +value is stored in a new mortal SV. =for apidoc Am|void|XST_mUV|int pos|UV uv Place an unsigned integer into the specified position C on the stack. The value is stored in a new mortal SV. =for apidoc Am|void|XST_mNO|int pos -Place C<&PL_sv_no> into the specified position C on the -stack. +Place C<&PL_sv_no> into the specified position C on the stack. =for apidoc Am|void|XST_mYES|int pos -Place C<&PL_sv_yes> into the specified position C on the -stack. +Place C<&PL_sv_yes> into the specified position C on the stack. =for apidoc Am|void|XST_mUNDEF|int pos -Place C<&PL_sv_undef> into the specified position C on the -stack. +Place C<&PL_sv_undef> into the specified position C on the stack. =for apidoc Am|void|XSRETURN|int nitems Return from XSUB, indicating number of items on the stack. This is usually @@ -274,28 +271,28 @@ Return C<&PL_sv_undef> from an XSUB immediately. Uses C. Return an empty list from an XSUB immediately. =for apidoc AmU||newXSproto|char* name|XSUBADDR_t f|char* filename|const char *proto -Used by C to hook up XSUBs as Perl subs. Adds Perl prototypes to -the subs. +Used by C to hook up XSUBs as Perl subs. Adds Perl prototypes to the +subs. =for apidoc AmnU||XS_VERSION -The version identifier for an XS module. This is usually -handled automatically by C. See -C>. +The version identifier for an XS module. This is usually handled automatically +by C. See C>. =for apidoc Amn;||XS_VERSION_BOOTCHECK -Macro to verify that a PM module's C<$VERSION> variable matches the XS -module's C variable. This is usually handled automatically by -C. See L. +Macro to verify that a PM module's C<$VERSION> variable matches the XS module's +C variable. This is usually handled automatically by C. +See L. =for apidoc Amn;||XS_APIVERSION_BOOTCHECK -Macro to verify that the perl api version an XS module has been compiled against -matches the api version of the perl interpreter it's being loaded into. +Macro to verify that the perl api version an XS module has been compiled +against matches the api version of the perl interpreter it's being loaded +into. =for apidoc_section $exceptions =for apidoc Amn;||dXCPT -Set up necessary local variables for exception handling. -See L. +Set up necessary local variables for exception handling. See +L. =for apidoc AmnU||XCPT_TRY_START Starts a try block. See L. @@ -312,95 +309,99 @@ Rethrows a previously caught exception. See L. =cut */ -#define XST_mIV(i,v) (ST(i) = sv_2mortal(newSViv(v)) ) -#define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) ) -#define XST_mNV(i,v) (ST(i) = sv_2mortal(newSVnv(v)) ) -#define XST_mPV(i,v) (ST(i) = sv_2mortal(newSVpv(v,0))) -#define XST_mPVN(i,v,n) (ST(i) = newSVpvn_flags(v,n, SVs_TEMP)) -#define XST_mNO(i) (ST(i) = &PL_sv_no ) -#define XST_mYES(i) (ST(i) = &PL_sv_yes ) -#define XST_mUNDEF(i) (ST(i) = &PL_sv_undef) - -#define XSRETURN(off) \ - STMT_START { \ - const IV tmpXSoff = (off); \ - assert(tmpXSoff >= 0);\ - PL_stack_sp = PL_stack_base + ax + (tmpXSoff - 1); \ - return; \ +#define XST_mIV(i,v) (ST(i) = sv_2mortal(newSViv(v)) ) +#define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) ) +#define XST_mNV(i,v) (ST(i) = sv_2mortal(newSVnv(v)) ) +#define XST_mPV(i,v) (ST(i) = sv_2mortal(newSVpv(v,0))) +#define XST_mPVN(i,v,n) (ST(i) = newSVpvn_flags(v,n, SVs_TEMP)) +#define XST_mNO(i) (ST(i) = &PL_sv_no ) +#define XST_mYES(i) (ST(i) = &PL_sv_yes ) +#define XST_mUNDEF(i) (ST(i) = &PL_sv_undef) + +#define XSRETURN(off) \ + STMT_START { \ + const IV tmpXSoff = (off); \ + assert(tmpXSoff >= 0); \ + PL_stack_sp = PL_stack_base + ax + (tmpXSoff - 1); \ + return; \ } STMT_END -#define XSRETURN_IV(v) STMT_START { XST_mIV(0,v); XSRETURN(1); } STMT_END -#define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END -#define XSRETURN_NV(v) STMT_START { XST_mNV(0,v); XSRETURN(1); } STMT_END -#define XSRETURN_PV(v) STMT_START { XST_mPV(0,v); XSRETURN(1); } STMT_END -#define XSRETURN_PVN(v,n) STMT_START { XST_mPVN(0,v,n); XSRETURN(1); } STMT_END -#define XSRETURN_NO STMT_START { XST_mNO(0); XSRETURN(1); } STMT_END -#define XSRETURN_YES STMT_START { XST_mYES(0); XSRETURN(1); } STMT_END -#define XSRETURN_UNDEF STMT_START { XST_mUNDEF(0); XSRETURN(1); } STMT_END -#define XSRETURN_EMPTY STMT_START { XSRETURN(0); } STMT_END +#define XSRETURN_IV(v) STMT_START { XST_mIV(0,v); XSRETURN(1); } STMT_END +#define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END +#define XSRETURN_NV(v) STMT_START { XST_mNV(0,v); XSRETURN(1); } STMT_END +#define XSRETURN_PV(v) STMT_START { XST_mPV(0,v); XSRETURN(1); } STMT_END +#define XSRETURN_PVN(v,n) STMT_START { XST_mPVN(0,v,n); XSRETURN(1); } STMT_END +#define XSRETURN_NO STMT_START { XST_mNO(0); XSRETURN(1); } STMT_END +#define XSRETURN_YES STMT_START { XST_mYES(0); XSRETURN(1); } STMT_END +#define XSRETURN_UNDEF STMT_START { XST_mUNDEF(0); XSRETURN(1); } STMT_END +#define XSRETURN_EMPTY STMT_START { XSRETURN(0); } STMT_END -#define newXSproto(a,b,c,d) newXS_flags(a,b,c,d,0) +#define newXSproto(a,b,c,d) newXS_flags(a,b,c,d,0) #ifdef XS_VERSION -# define XS_VERSION_BOOTCHECK \ - Perl_xs_handshake(HS_KEY(FALSE, FALSE, "", XS_VERSION), HS_CXT, __FILE__, \ - items, ax, XS_VERSION) +# define XS_VERSION_BOOTCHECK \ + Perl_xs_handshake(HS_KEY(FALSE, FALSE, "", XS_VERSION), HS_CXT, __FILE__, \ + items, ax, XS_VERSION) #else # define XS_VERSION_BOOTCHECK #endif -#define XS_APIVERSION_BOOTCHECK \ - Perl_xs_handshake(HS_KEY(FALSE, FALSE, "v" PERL_API_VERSION_STRING, ""), \ +#define XS_APIVERSION_BOOTCHECK \ + Perl_xs_handshake(HS_KEY(FALSE, FALSE, "v" PERL_API_VERSION_STRING, ""), \ HS_CXT, __FILE__, items, ax, "v" PERL_API_VERSION_STRING) -/* public API, this is a combination of XS_VERSION_BOOTCHECK and - XS_APIVERSION_BOOTCHECK in 1, and is backportable */ +/* public API, this is a combination of XS_VERSION_BOOTCHECK + and XS_APIVERSION_BOOTCHECK in 1, and is backportable */ #ifdef XS_VERSION -# define XS_BOTHVERSION_BOOTCHECK \ - Perl_xs_handshake(HS_KEY(FALSE, FALSE, "v" PERL_API_VERSION_STRING, XS_VERSION), \ - HS_CXT, __FILE__, items, ax, "v" PERL_API_VERSION_STRING, XS_VERSION) +# define XS_BOTHVERSION_BOOTCHECK \ + Perl_xs_handshake(HS_KEY(FALSE, FALSE, "v" PERL_API_VERSION_STRING, XS_VERSION), \ + HS_CXT, __FILE__, items, ax, "v" PERL_API_VERSION_STRING, XS_VERSION) #else -/* should this be a #error? if you want both checked, you better supply XS_VERSION right? */ -# define XS_BOTHVERSION_BOOTCHECK XS_APIVERSION_BOOTCHECK +/* should this be a #error? if you want both checked, + you better supply XS_VERSION right? */ +# define XS_BOTHVERSION_BOOTCHECK XS_APIVERSION_BOOTCHECK #endif /* private API */ -#define XS_APIVERSION_POPMARK_BOOTCHECK \ - Perl_xs_handshake(HS_KEY(FALSE, TRUE, "v" PERL_API_VERSION_STRING, ""), \ +#define XS_APIVERSION_POPMARK_BOOTCHECK \ + Perl_xs_handshake(HS_KEY(FALSE, TRUE, "v" PERL_API_VERSION_STRING, ""), \ HS_CXT, __FILE__, "v" PERL_API_VERSION_STRING) #ifdef XS_VERSION -# define XS_BOTHVERSION_POPMARK_BOOTCHECK \ - Perl_xs_handshake(HS_KEY(FALSE, TRUE, "v" PERL_API_VERSION_STRING, XS_VERSION), \ - HS_CXT, __FILE__, "v" PERL_API_VERSION_STRING, XS_VERSION) +# define XS_BOTHVERSION_POPMARK_BOOTCHECK \ + Perl_xs_handshake(HS_KEY(FALSE, TRUE, "v" PERL_API_VERSION_STRING, XS_VERSION), \ + HS_CXT, __FILE__, "v" PERL_API_VERSION_STRING, XS_VERSION) #else -/* should this be a #error? if you want both checked, you better supply XS_VERSION right? */ +/* should this be a #error? if you want both checked, + you better supply XS_VERSION right? */ # define XS_BOTHVERSION_POPMARK_BOOTCHECK XS_APIVERSION_POPMARK_BOOTCHECK #endif -#define XS_APIVERSION_SETXSUBFN_POPMARK_BOOTCHECK \ - Perl_xs_handshake(HS_KEY(TRUE, TRUE, "v" PERL_API_VERSION_STRING, ""), \ +#define XS_APIVERSION_SETXSUBFN_POPMARK_BOOTCHECK \ + Perl_xs_handshake(HS_KEY(TRUE, TRUE, "v" PERL_API_VERSION_STRING, ""), \ HS_CXT, __FILE__, "v" PERL_API_VERSION_STRING) #ifdef XS_VERSION -# define XS_BOTHVERSION_SETXSUBFN_POPMARK_BOOTCHECK \ - Perl_xs_handshake(HS_KEY(TRUE, TRUE, "v" PERL_API_VERSION_STRING, XS_VERSION),\ - HS_CXT, __FILE__, "v" PERL_API_VERSION_STRING, XS_VERSION) +# define XS_BOTHVERSION_SETXSUBFN_POPMARK_BOOTCHECK \ + Perl_xs_handshake(HS_KEY(TRUE, TRUE, "v" PERL_API_VERSION_STRING, XS_VERSION), \ + HS_CXT, __FILE__, "v" PERL_API_VERSION_STRING, XS_VERSION) #else -/* should this be a #error? if you want both checked, you better supply XS_VERSION right? */ -# define XS_BOTHVERSION_SETXSUBFN_POPMARK_BOOTCHECK XS_APIVERSION_SETXSUBFN_POPMARK_BOOTCHECK +/* should this be a #error? if you want both checked, + you better supply XS_VERSION right? */ +# define XS_BOTHVERSION_SETXSUBFN_POPMARK_BOOTCHECK \ + XS_APIVERSION_SETXSUBFN_POPMARK_BOOTCHECK #endif -/* For a normal bootstrap without API or XS version checking. - Useful for static XS modules or debugging/testing scenarios. - If this macro gets heavily used in the future, it should separated into - a separate function independent of Perl_xs_handshake for efficiency */ -#define XS_SETXSUBFN_POPMARK \ +/* For a normal bootstrap without API or XS version checking. Useful + for static XS modules or debugging/testing scenarios. If this macro + gets heavily used in the future, it should separated into a separate + function independent of Perl_xs_handshake for efficiency */ +#define XS_SETXSUBFN_POPMARK \ Perl_xs_handshake(HS_KEY(TRUE, TRUE, "", "") | HSf_NOCHK, HS_CXT, __FILE__) #ifdef NO_XSLOCKS -# define dXCPT dJMPENV; int rEtV = 0 -# define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0) -# define XCPT_TRY_END JMPENV_POP; -# define XCPT_CATCH if (rEtV != 0) -# define XCPT_RETHROW JMPENV_JUMP(rEtV) +# define dXCPT dJMPENV; int rEtV = 0 +# define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0) +# define XCPT_TRY_END JMPENV_POP; +# define XCPT_CATCH if (rEtV != 0) +# define XCPT_RETHROW JMPENV_JUMP(rEtV) #endif /* @@ -408,88 +409,88 @@ Rethrows a previously caught exception. See L. the *DB*_File modules */ -#define DBM_setFilter(db_type,code) \ - STMT_START { \ - if (db_type) \ - RETVAL = sv_mortalcopy(db_type) ; \ - ST(0) = RETVAL ; \ - if (db_type && (code == &PL_sv_undef)) { \ - SvREFCNT_dec_NN(db_type) ; \ - db_type = NULL ; \ - } \ - else if (code) { \ - if (db_type) \ - sv_setsv(db_type, code) ; \ - else \ - db_type = newSVsv(code) ; \ - } \ - } STMT_END - -#define DBM_ckFilter(arg,type,name) \ - STMT_START { \ - if (db->type) { \ - if (db->filtering) { \ - croak("recursion detected in %s", name) ; \ - } \ - ENTER ; \ - SAVETMPS ; \ - SAVEINT(db->filtering) ; \ - db->filtering = TRUE ; \ - SAVE_DEFSV ; \ - if (name[7] == 's') \ - arg = newSVsv(arg); \ - DEFSV_set(arg) ; \ - SvTEMP_off(arg) ; \ - PUSHMARK(SP) ; \ - PUTBACK ; \ - (void) perl_call_sv(db->type, G_DISCARD); \ - SPAGAIN ; \ - PUTBACK ; \ - FREETMPS ; \ - LEAVE ; \ - if (name[7] == 's'){ \ - arg = sv_2mortal(arg); \ - } \ - } \ +#define DBM_setFilter(db_type,code) \ + STMT_START { \ + if (db_type) \ + RETVAL = sv_mortalcopy(db_type); \ + ST(0) = RETVAL; \ + if (db_type && (code == &PL_sv_undef)) { \ + SvREFCNT_dec_NN(db_type); \ + db_type = NULL; \ + } \ + else if (code) { \ + if (db_type) \ + sv_setsv(db_type, code); \ + else \ + db_type = newSVsv(code); \ + } \ } STMT_END -#if 1 /* for compatibility */ -# define VTBL_sv &PL_vtbl_sv -# define VTBL_env &PL_vtbl_env -# define VTBL_envelem &PL_vtbl_envelem -# define VTBL_sigelem &PL_vtbl_sigelem -# define VTBL_pack &PL_vtbl_pack -# define VTBL_packelem &PL_vtbl_packelem -# define VTBL_dbline &PL_vtbl_dbline -# define VTBL_isa &PL_vtbl_isa -# define VTBL_isaelem &PL_vtbl_isaelem -# define VTBL_arylen &PL_vtbl_arylen -# define VTBL_glob &PL_vtbl_glob -# define VTBL_mglob &PL_vtbl_mglob -# define VTBL_nkeys &PL_vtbl_nkeys -# define VTBL_taint &PL_vtbl_taint -# define VTBL_substr &PL_vtbl_substr -# define VTBL_vec &PL_vtbl_vec -# define VTBL_pos &PL_vtbl_pos -# define VTBL_bm &PL_vtbl_bm -# define VTBL_fm &PL_vtbl_fm -# define VTBL_uvar &PL_vtbl_uvar -# define VTBL_defelem &PL_vtbl_defelem -# define VTBL_regexp &PL_vtbl_regexp -# define VTBL_regdata &PL_vtbl_regdata -# define VTBL_regdatum &PL_vtbl_regdatum +#define DBM_ckFilter(arg,type,name) \ + STMT_START { \ + if (db->type) { \ + if (db->filtering) { \ + croak("recursion detected in %s", name); \ + } \ + ENTER; \ + SAVETMPS; \ + SAVEINT(db->filtering); \ + db->filtering = TRUE; \ + SAVE_DEFSV; \ + if (name[7] == 's') \ + arg = newSVsv(arg); \ + DEFSV_set(arg); \ + SvTEMP_off(arg); \ + PUSHMARK(SP); \ + PUTBACK; \ + (void) perl_call_sv(db->type, G_DISCARD); \ + SPAGAIN; \ + PUTBACK; \ + FREETMPS; \ + LEAVE; \ + if (name[7] == 's'){ \ + arg = sv_2mortal(arg); \ + } \ + } \ + } STMT_END + +#if 1 /* for compatibility */ +# define VTBL_sv &PL_vtbl_sv +# define VTBL_env &PL_vtbl_env +# define VTBL_envelem &PL_vtbl_envelem +# define VTBL_sigelem &PL_vtbl_sigelem +# define VTBL_pack &PL_vtbl_pack +# define VTBL_packelem &PL_vtbl_packelem +# define VTBL_dbline &PL_vtbl_dbline +# define VTBL_isa &PL_vtbl_isa +# define VTBL_isaelem &PL_vtbl_isaelem +# define VTBL_arylen &PL_vtbl_arylen +# define VTBL_glob &PL_vtbl_glob +# define VTBL_mglob &PL_vtbl_mglob +# define VTBL_nkeys &PL_vtbl_nkeys +# define VTBL_taint &PL_vtbl_taint +# define VTBL_substr &PL_vtbl_substr +# define VTBL_vec &PL_vtbl_vec +# define VTBL_pos &PL_vtbl_pos +# define VTBL_bm &PL_vtbl_bm +# define VTBL_fm &PL_vtbl_fm +# define VTBL_uvar &PL_vtbl_uvar +# define VTBL_defelem &PL_vtbl_defelem +# define VTBL_regexp &PL_vtbl_regexp +# define VTBL_regdata &PL_vtbl_regdata +# define VTBL_regdatum &PL_vtbl_regdatum # ifdef USE_LOCALE_COLLATE -# define VTBL_collxfrm &PL_vtbl_collxfrm +# define VTBL_collxfrm &PL_vtbl_collxfrm # endif -# define VTBL_amagic &PL_vtbl_amagic -# define VTBL_amagicelem &PL_vtbl_amagicelem +# define VTBL_amagic &PL_vtbl_amagic +# define VTBL_amagicelem &PL_vtbl_amagicelem #endif #if defined(MULTIPLICITY) && !defined(PERL_NO_GET_CONTEXT) && !defined(PERL_CORE) # undef aTHX # undef aTHX_ -# define aTHX PERL_GET_THX -# define aTHX_ aTHX, +# define aTHX PERL_GET_THX +# define aTHX_ aTHX, #endif #if defined(PERL_IMPLICIT_SYS) && !defined(PERL_CORE) @@ -517,163 +518,163 @@ Rethrows a previously caught exception. See L. # undef socketpair -# define mkdir PerlDir_mkdir -# define chdir PerlDir_chdir -# define rmdir PerlDir_rmdir -# define closedir PerlDir_close -# define opendir PerlDir_open -# define readdir PerlDir_read -# define rewinddir PerlDir_rewind -# define seekdir PerlDir_seek -# define telldir PerlDir_tell -# define putenv PerlEnv_putenv -# define getenv PerlEnv_getenv -# define uname PerlEnv_uname -# define stdin PerlSIO_stdin -# define stdout PerlSIO_stdout -# define stderr PerlSIO_stderr -# define fopen PerlSIO_fopen -# define fclose PerlSIO_fclose -# define feof PerlSIO_feof -# define ferror PerlSIO_ferror -# define clearerr PerlSIO_clearerr -# define getc PerlSIO_getc -# define fgets PerlSIO_fgets -# define fputc PerlSIO_fputc -# define fputs PerlSIO_fputs -# define fflush PerlSIO_fflush -# define ungetc PerlSIO_ungetc -# define fileno PerlSIO_fileno -# define fdopen PerlSIO_fdopen -# define freopen PerlSIO_freopen -# define fread PerlSIO_fread -# define fwrite PerlSIO_fwrite -# define setbuf PerlSIO_setbuf -# define setvbuf PerlSIO_setvbuf -# define setlinebuf PerlSIO_setlinebuf -# define stdoutf PerlSIO_stdoutf -# define vfprintf PerlSIO_vprintf -# define ftell PerlSIO_ftell -# define fseek PerlSIO_fseek -# define fgetpos PerlSIO_fgetpos -# define fsetpos PerlSIO_fsetpos -# define frewind PerlSIO_rewind -# define tmpfile PerlSIO_tmpfile -# define access PerlLIO_access -# define chmod PerlLIO_chmod -# define chsize PerlLIO_chsize -# define close PerlLIO_close -# define dup PerlLIO_dup -# define dup2 PerlLIO_dup2 -# define flock PerlLIO_flock -# define fstat PerlLIO_fstat -# define ioctl PerlLIO_ioctl -# define isatty PerlLIO_isatty -# define link PerlLIO_link -# define lseek PerlLIO_lseek -# define lstat PerlLIO_lstat -# define mktemp PerlLIO_mktemp -# define open PerlLIO_open -# define read PerlLIO_read -# define rename PerlLIO_rename -# define setmode PerlLIO_setmode -# define stat(buf,sb) PerlLIO_stat(buf,sb) -# define tmpnam PerlLIO_tmpnam -# define umask PerlLIO_umask -# define unlink PerlLIO_unlink -# define utime PerlLIO_utime -# define write PerlLIO_write -# define malloc PerlMem_malloc -# define calloc PerlMem_calloc -# define realloc PerlMem_realloc -# define free PerlMem_free -# define abort PerlProc_abort -# define exit PerlProc_exit -# define _exit PerlProc__exit -# define execl PerlProc_execl -# define execv PerlProc_execv -# define execvp PerlProc_execvp -# define getuid PerlProc_getuid -# define geteuid PerlProc_geteuid -# define getgid PerlProc_getgid -# define getegid PerlProc_getegid -# define getlogin PerlProc_getlogin -# define kill PerlProc_kill -# define killpg PerlProc_killpg -# define pause PerlProc_pause -# define popen PerlProc_popen -# define pclose PerlProc_pclose -# define pipe PerlProc_pipe -# define setuid PerlProc_setuid -# define setgid PerlProc_setgid -# define sleep PerlProc_sleep -# define times PerlProc_times -# define wait PerlProc_wait -# define setjmp PerlProc_setjmp -# define longjmp PerlProc_longjmp -# define signal PerlProc_signal -# define getpid PerlProc_getpid -# define gettimeofday PerlProc_gettimeofday -# define htonl PerlSock_htonl -# define htons PerlSock_htons -# define ntohl PerlSock_ntohl -# define ntohs PerlSock_ntohs -# define accept PerlSock_accept -# define bind PerlSock_bind -# define connect PerlSock_connect -# define endhostent PerlSock_endhostent -# define endnetent PerlSock_endnetent -# define endprotoent PerlSock_endprotoent -# define endservent PerlSock_endservent -# define gethostbyaddr PerlSock_gethostbyaddr -# define gethostbyname PerlSock_gethostbyname -# define gethostent PerlSock_gethostent -# define gethostname PerlSock_gethostname -# define getnetbyaddr PerlSock_getnetbyaddr -# define getnetbyname PerlSock_getnetbyname -# define getnetent PerlSock_getnetent -# define getpeername PerlSock_getpeername -# define getprotobyname PerlSock_getprotobyname -# define getprotobynumber PerlSock_getprotobynumber -# define getprotoent PerlSock_getprotoent -# define getservbyname PerlSock_getservbyname -# define getservbyport PerlSock_getservbyport -# define getservent PerlSock_getservent -# define getsockname PerlSock_getsockname -# define getsockopt PerlSock_getsockopt -# define inet_addr PerlSock_inet_addr -# define inet_ntoa PerlSock_inet_ntoa -# define listen PerlSock_listen -# define recv PerlSock_recv -# define recvfrom PerlSock_recvfrom -# define select PerlSock_select -# define send PerlSock_send -# define sendto PerlSock_sendto -# define sethostent PerlSock_sethostent -# define setnetent PerlSock_setnetent -# define setprotoent PerlSock_setprotoent -# define setservent PerlSock_setservent -# define setsockopt PerlSock_setsockopt -# define shutdown PerlSock_shutdown -# define socket PerlSock_socket -# define socketpair PerlSock_socketpair +# define mkdir PerlDir_mkdir +# define chdir PerlDir_chdir +# define rmdir PerlDir_rmdir +# define closedir PerlDir_close +# define opendir PerlDir_open +# define readdir PerlDir_read +# define rewinddir PerlDir_rewind +# define seekdir PerlDir_seek +# define telldir PerlDir_tell +# define putenv PerlEnv_putenv +# define getenv PerlEnv_getenv +# define uname PerlEnv_uname +# define stdin PerlSIO_stdin +# define stdout PerlSIO_stdout +# define stderr PerlSIO_stderr +# define fopen PerlSIO_fopen +# define fclose PerlSIO_fclose +# define feof PerlSIO_feof +# define ferror PerlSIO_ferror +# define clearerr PerlSIO_clearerr +# define getc PerlSIO_getc +# define fgets PerlSIO_fgets +# define fputc PerlSIO_fputc +# define fputs PerlSIO_fputs +# define fflush PerlSIO_fflush +# define ungetc PerlSIO_ungetc +# define fileno PerlSIO_fileno +# define fdopen PerlSIO_fdopen +# define freopen PerlSIO_freopen +# define fread PerlSIO_fread +# define fwrite PerlSIO_fwrite +# define setbuf PerlSIO_setbuf +# define setvbuf PerlSIO_setvbuf +# define setlinebuf PerlSIO_setlinebuf +# define stdoutf PerlSIO_stdoutf +# define vfprintf PerlSIO_vprintf +# define ftell PerlSIO_ftell +# define fseek PerlSIO_fseek +# define fgetpos PerlSIO_fgetpos +# define fsetpos PerlSIO_fsetpos +# define frewind PerlSIO_rewind +# define tmpfile PerlSIO_tmpfile +# define access PerlLIO_access +# define chmod PerlLIO_chmod +# define chsize PerlLIO_chsize +# define close PerlLIO_close +# define dup PerlLIO_dup +# define dup2 PerlLIO_dup2 +# define flock PerlLIO_flock +# define fstat PerlLIO_fstat +# define ioctl PerlLIO_ioctl +# define isatty PerlLIO_isatty +# define link PerlLIO_link +# define lseek PerlLIO_lseek +# define lstat PerlLIO_lstat +# define mktemp PerlLIO_mktemp +# define open PerlLIO_open +# define read PerlLIO_read +# define rename PerlLIO_rename +# define setmode PerlLIO_setmode +# define stat(buf,sb) PerlLIO_stat(buf,sb) +# define tmpnam PerlLIO_tmpnam +# define umask PerlLIO_umask +# define unlink PerlLIO_unlink +# define utime PerlLIO_utime +# define write PerlLIO_write +# define malloc PerlMem_malloc +# define calloc PerlMem_calloc +# define realloc PerlMem_realloc +# define free PerlMem_free +# define abort PerlProc_abort +# define exit PerlProc_exit +# define _exit PerlProc__exit +# define execl PerlProc_execl +# define execv PerlProc_execv +# define execvp PerlProc_execvp +# define getuid PerlProc_getuid +# define geteuid PerlProc_geteuid +# define getgid PerlProc_getgid +# define getegid PerlProc_getegid +# define getlogin PerlProc_getlogin +# define kill PerlProc_kill +# define killpg PerlProc_killpg +# define pause PerlProc_pause +# define popen PerlProc_popen +# define pclose PerlProc_pclose +# define pipe PerlProc_pipe +# define setuid PerlProc_setuid +# define setgid PerlProc_setgid +# define sleep PerlProc_sleep +# define times PerlProc_times +# define wait PerlProc_wait +# define setjmp PerlProc_setjmp +# define longjmp PerlProc_longjmp +# define signal PerlProc_signal +# define getpid PerlProc_getpid +# define gettimeofday PerlProc_gettimeofday +# define htonl PerlSock_htonl +# define htons PerlSock_htons +# define ntohl PerlSock_ntohl +# define ntohs PerlSock_ntohs +# define accept PerlSock_accept +# define bind PerlSock_bind +# define connect PerlSock_connect +# define endhostent PerlSock_endhostent +# define endnetent PerlSock_endnetent +# define endprotoent PerlSock_endprotoent +# define endservent PerlSock_endservent +# define gethostbyaddr PerlSock_gethostbyaddr +# define gethostbyname PerlSock_gethostbyname +# define gethostent PerlSock_gethostent +# define gethostname PerlSock_gethostname +# define getnetbyaddr PerlSock_getnetbyaddr +# define getnetbyname PerlSock_getnetbyname +# define getnetent PerlSock_getnetent +# define getpeername PerlSock_getpeername +# define getprotobyname PerlSock_getprotobyname +# define getprotobynumber PerlSock_getprotobynumber +# define getprotoent PerlSock_getprotoent +# define getservbyname PerlSock_getservbyname +# define getservbyport PerlSock_getservbyport +# define getservent PerlSock_getservent +# define getsockname PerlSock_getsockname +# define getsockopt PerlSock_getsockopt +# define inet_addr PerlSock_inet_addr +# define inet_ntoa PerlSock_inet_ntoa +# define listen PerlSock_listen +# define recv PerlSock_recv +# define recvfrom PerlSock_recvfrom +# define select PerlSock_select +# define send PerlSock_send +# define sendto PerlSock_sendto +# define sethostent PerlSock_sethostent +# define setnetent PerlSock_setnetent +# define setprotoent PerlSock_setprotoent +# define setservent PerlSock_setservent +# define setsockopt PerlSock_setsockopt +# define shutdown PerlSock_shutdown +# define socket PerlSock_socket +# define socketpair PerlSock_socketpair # undef fd_set # undef FD_SET # undef FD_CLR # undef FD_ISSET # undef FD_ZERO -# define fd_set Perl_fd_set -# define FD_SET(n,p) PERL_FD_SET(n,p) -# define FD_CLR(n,p) PERL_FD_CLR(n,p) -# define FD_ISSET(n,p) PERL_FD_ISSET(n,p) -# define FD_ZERO(p) PERL_FD_ZERO(p) +# define fd_set Perl_fd_set +# define FD_SET(n,p) PERL_FD_SET(n,p) +# define FD_CLR(n,p) PERL_FD_CLR(n,p) +# define FD_ISSET(n,p) PERL_FD_ISSET(n,p) +# define FD_ZERO(p) PERL_FD_ZERO(p) # endif /* NO_XSLOCKS */ #endif /* PERL_IMPLICIT_SYS && !PERL_CORE */ -#endif /* PERL_XSUB_H_ */ /* include guard */ +#endif /* PERL_XSUB_H_ */ /* include guard */ /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/av.h b/av.h index 6e0b24d7b3ad..882b1d968a7f 100644 --- a/av.h +++ b/av.h @@ -1,50 +1,49 @@ /* av.h * - * Copyright (C) 1991, 1992, 1993, 1995, 1996, 1997, 1998, 1999, 2000, - * 2001, 2002, 2005, 2006, 2007, 2008, by Larry Wall and others + * Copyright (C) 1991, 1992, 1993, 1995, 1996, 1997, 1998, 1999, 2000, 2001, + * 2002, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, + * 2016, 2017, 2018, 2019, 2020, 2021, 2022 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * */ struct xpvav { - HV* xmg_stash; /* class package */ - union _xmgu xmg_u; - SSize_t xav_fill; /* Index of last element present */ - SSize_t xav_max; /* max index for which array has space */ - SV** xav_alloc; /* pointer to beginning of C array of SVs */ + HV *xmg_stash; /* class package */ + union _xmgu xmg_u; + SSize_t xav_fill; /* Index of last element present */ + SSize_t xav_max; /* max index for which array has space */ + SV **xav_alloc; /* pointer to beginning of C array of SVs */ }; -/* SV* xav_arylen; */ +/* SV* xav_arylen; */ -/* SVpav_REAL is set for all AVs whose xav_array contents are refcounted - * and initialized such that any element can be retrieved as a SV*. - * Such AVs may be referred to as "real" AVs. Examples include regular - * perl arrays, tiedarrays (since v5.16), and padlist AVs. +/* SVpav_REAL is set for all AVs whose xav_array contents are refcounted and + * initialized such that any element can be retrieved as a SV*. Such AVs may + * be referred to as "real" AVs. Examples include regular perl arrays, + * tiedarrays (since v5.16), and padlist AVs. * - * Some things do not set SVpav_REAL, to indicate that they are cheating - * (for efficiency) by not refcounting the AV's contents or ensuring that - * all elements are safe for arbitrary access. This type of AV may be - * referred to as "fake" AVs. Examples include "@_" (unless tied), the - * scratchpad list, and the backrefs list on an object or stash. + * Some things do not set SVpav_REAL, to indicate that they are cheating (for + * efficiency) by not refcounting the AV's contents or ensuring that all + * elements are safe for arbitrary access. This type of AV may be referred + * to as "fake" AVs. Examples include "@_" (unless tied), the scratchpad + * list, and the backrefs list on an object or stash. * - * SVpav_REIFY is only meaningful on such "fake" AVs (i.e. where SVpav_REAL - * is not set). It indicates that the fake AV is capable of becoming - * real if the array needs to be modified in some way. Functions that - * modify fake AVs check both flags to call av_reify() as appropriate. + * SVpav_REIFY is only meaningful on such "fake" AVs (i.e. where SVpav_REAL + * is not set). It indicates that the fake AV is capable of becoming real if + * the array needs to be modified in some way. Functions that modify fake + * AVs check both flags to call av_reify() as appropriate. * * av_reify() transforms a fake AV into a real one through two actions. * Allocated but unpopulated elements are initialized to make them safe for * arbitrary retrieval and the reference counts of populated elements are * incremented. * - * Note that the Perl stack has neither flag set. (Thus, - * items that go on the stack are never refcounted.) + * Note that the Perl stack has neither flag set. (Thus, items that go on + * the stack are never refcounted.) * - * These internal details are subject to change any time. AV - * manipulations external to perl should not care about any of this. - * GSAR 1999-09-10 + * These internal details are subject to change any time. AV manipulations + * external to perl should not care about any of this. GSAR 1999-09-10 */ /* @@ -58,54 +57,55 @@ Same as C> or C>. =for apidoc Cm|SSize_t|AvFILLp|AV* av -If the array C is empty, this returns -1; otherwise it returns the maximum -value of the indices of all the array elements which are currently defined in -C. It does not handle magic, hence the C

private indication in its name. +If the array C is empty, this returns -1; otherwise it returns +the maximum value of the indices of all the array elements which are +currently defined in C. It does not handle magic, hence the C

+private indication in its name. =for apidoc Am|SV**|AvARRAY|AV* av Returns a pointer to the AV's internal SV* array. -This is useful for doing pointer arithmetic on the array. -If all you need is to look up an array element, then prefer C. +This is useful for doing pointer arithmetic on the array. If all you +need is to look up an array element, then prefer C. =cut */ #ifndef PERL_CORE -# define Nullav Null(AV*) +# define Nullav Null(AV*) #endif -#define AvARRAY(av) ((av)->sv_u.svu_array) -#define AvALLOC(av) ((XPVAV*) SvANY(av))->xav_alloc -#define AvMAX(av) ((XPVAV*) SvANY(av))->xav_max -#define AvFILLp(av) ((XPVAV*) SvANY(av))->xav_fill -#define AvARYLEN(av) (*Perl_av_arylen_p(aTHX_ MUTABLE_AV(av))) - -#define AvREAL(av) (SvFLAGS(av) & SVpav_REAL) -#define AvREAL_on(av) (SvFLAGS(av) |= SVpav_REAL) -#define AvREAL_off(av) (SvFLAGS(av) &= ~SVpav_REAL) -#define AvREAL_only(av) (AvREIFY_off(av), SvFLAGS(av) |= SVpav_REAL) -#define AvREIFY(av) (SvFLAGS(av) & SVpav_REIFY) -#define AvREIFY_on(av) (SvFLAGS(av) |= SVpav_REIFY) -#define AvREIFY_off(av) (SvFLAGS(av) &= ~SVpav_REIFY) -#define AvREIFY_only(av) (AvREAL_off(av), SvFLAGS(av) |= SVpav_REIFY) - - -#define AvREALISH(av) (SvFLAGS(av) & (SVpav_REAL|SVpav_REIFY)) - -#define AvFILL(av) ((SvRMAGICAL((const SV *) (av))) \ - ? mg_size(MUTABLE_SV(av)) : AvFILLp(av)) -#define av_top_index(av) AvFILL(av) -#define av_tindex(av) av_top_index(av) +#define AvARRAY(av) ((av)->sv_u.svu_array) +#define AvALLOC(av) ((XPVAV*) SvANY(av))->xav_alloc +#define AvMAX(av) ((XPVAV*) SvANY(av))->xav_max +#define AvFILLp(av) ((XPVAV*) SvANY(av))->xav_fill +#define AvARYLEN(av) (*Perl_av_arylen_p(aTHX_ MUTABLE_AV(av))) + +#define AvREAL(av) (SvFLAGS(av) & SVpav_REAL) +#define AvREAL_on(av) (SvFLAGS(av) |= SVpav_REAL) +#define AvREAL_off(av) (SvFLAGS(av) &= ~SVpav_REAL) +#define AvREAL_only(av) (AvREIFY_off(av), SvFLAGS(av) |= SVpav_REAL) +#define AvREIFY(av) (SvFLAGS(av) & SVpav_REIFY) +#define AvREIFY_on(av) (SvFLAGS(av) |= SVpav_REIFY) +#define AvREIFY_off(av) (SvFLAGS(av) &= ~SVpav_REIFY) +#define AvREIFY_only(av) (AvREAL_off(av), SvFLAGS(av) |= SVpav_REIFY) + + +#define AvREALISH(av) (SvFLAGS(av) & (SVpav_REAL|SVpav_REIFY)) + +#define AvFILL(av) \ + ((SvRMAGICAL((const SV *) (av))) ? mg_size(MUTABLE_SV(av)) : AvFILLp(av)) +#define av_top_index(av) AvFILL(av) +#define av_tindex(av) av_top_index(av) /* Note that it doesn't make sense to do this: - * SvGETMAGIC(av); IV x = av_tindex_nomg(av); + * SvGETMAGIC(av); IV x = av_tindex_nomg(av); */ -# define av_top_index_skip_len_mg(av) \ - (__ASSERT_(SvTYPE(av) == SVt_PVAV) AvFILLp(av)) -# define av_tindex_skip_len_mg(av) av_top_index_skip_len_mg(av) +# define av_top_index_skip_len_mg(av) \ + (__ASSERT_(SvTYPE(av) == SVt_PVAV) AvFILLp(av)) +# define av_tindex_skip_len_mg(av) av_top_index_skip_len_mg(av) -#define NEGATIVE_INDICES_VAR "NEGATIVE_INDICES" +#define NEGATIVE_INDICES_VAR "NEGATIVE_INDICES" /* @@ -151,15 +151,15 @@ create that. They differ in what else they do, as follows: 'form' above and below is because otherwise have two =items with the same name, can't link to them. -This does nothing beyond creating the whole-array data structure. -The Perl equivalent is approximately S> +This does nothing beyond creating the whole-array data structure. The Perl +equivalent is approximately S> This is useful when the minimum size of the array could be zero (perhaps there are likely code paths that will entirely skip using it). If the array does get used, the pointers data structure will need to be -allocated at that time. This will end up being done by L>, -either explicitly: +allocated at that time. This will end up being done by L>, either +explicitly: av_extend(av, len); @@ -190,7 +190,7 @@ C must be at least 1. =back The following examples all result in an array that can fit four elements -(indexes 0 .. 3): +(indexes 0 .. 3): AV *av = newAV(); av_extend(av, 3); @@ -206,13 +206,12 @@ to fit one element without extending: AV *av = newAV_alloc_xz(1); =cut - */ -#define newAV() MUTABLE_AV(newSV_type(SVt_PVAV)) -#define newAV_alloc_x(size) av_new_alloc(size,0) -#define newAV_alloc_xz(size) av_new_alloc(size,1) +#define newAV() MUTABLE_AV(newSV_type(SVt_PVAV)) +#define newAV_alloc_x(size) av_new_alloc(size,0) +#define newAV_alloc_xz(size) av_new_alloc(size,1) /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/cop.h b/cop.h index 969a17846b5f..6a44e1349319 100644 --- a/cop.h +++ b/cop.h @@ -1,16 +1,18 @@ /* cop.h * - * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, - * 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 by Larry Wall and others + * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, + * 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, + * 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021, + * 2022 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * - * Control ops (cops) are one of the two ops OP_NEXTSTATE and OP_DBSTATE, - * that (loosely speaking) are statement separators. - * They hold information important for lexical state and error reporting. - * At run time, PL_curcop is set to point to the most recently executed cop, - * and thus can be used to determine our current state. + * Control ops (cops) are one of the two ops OP_NEXTSTATE and + * OP_DBSTATE, that (loosely speaking) are statement separators. They + * hold information important for lexical state and error reporting. + * At run time, PL_curcop is set to point to the most recently executed + * cop, and thus can be used to determine our current state. */ /* A jmpenv packages the state required to perform a proper non-local jump. @@ -23,62 +25,60 @@ * null to ensure this). * * je_mustcatch, when set at any runlevel to TRUE, means eval ops must - * establish a local jmpenv to handle exception traps. Care must be taken - * to restore the previous value of je_mustcatch before exiting the - * stack frame iff JMPENV_PUSH was not called in that stack frame. - * GSAR 97-03-27 + * establish a local jmpenv to handle exception traps. Care must be taken to + * restore the previous value of je_mustcatch before exiting the stack frame + * iff JMPENV_PUSH was not called in that stack frame. GSAR 97-03-27 */ struct jmpenv { - struct jmpenv * je_prev; - Sigjmp_buf je_buf; /* uninit if je_prev is NULL */ - int je_ret; /* last exception thrown */ - bool je_mustcatch; /* longjmp()s must be caught locally */ - U16 je_old_delaymagic; /* saved PL_delaymagic */ - SSize_t je_old_stack_hwm; + struct jmpenv *je_prev; + Sigjmp_buf je_buf; /* uninit if je_prev is NULL */ + int je_ret; /* last exception thrown */ + bool je_mustcatch; /* longjmp()s must be caught locally */ + U16 je_old_delaymagic; /* saved PL_delaymagic */ + SSize_t je_old_stack_hwm; }; typedef struct jmpenv JMPENV; #if defined DEBUGGING && !defined DEBUGGING_RE_ONLY -# define JE_OLD_STACK_HWM_zero PL_start_env.je_old_stack_hwm = 0 -# define JE_OLD_STACK_HWM_save(je) \ - (je).je_old_stack_hwm = PL_curstackinfo->si_stack_hwm -# define JE_OLD_STACK_HWM_restore(je) \ - if (PL_curstackinfo->si_stack_hwm < (je).je_old_stack_hwm) \ - PL_curstackinfo->si_stack_hwm = (je).je_old_stack_hwm +# define JE_OLD_STACK_HWM_zero PL_start_env.je_old_stack_hwm = 0 +# define JE_OLD_STACK_HWM_save(je) \ + (je).je_old_stack_hwm = PL_curstackinfo->si_stack_hwm +# define JE_OLD_STACK_HWM_restore(je) \ + if (PL_curstackinfo->si_stack_hwm < (je).je_old_stack_hwm) \ + PL_curstackinfo->si_stack_hwm = (je).je_old_stack_hwm #else -# define JE_OLD_STACK_HWM_zero NOOP -# define JE_OLD_STACK_HWM_save(je) NOOP +# define JE_OLD_STACK_HWM_zero NOOP +# define JE_OLD_STACK_HWM_save(je) NOOP # define JE_OLD_STACK_HWM_restore(je) NOOP #endif /* * How to build the first jmpenv. * - * top_env needs to be non-zero. It points to an area - * in which longjmp() stuff is stored, as C callstack - * info there at least is thread specific this has to - * be per-thread. Otherwise a 'die' in a thread gives - * that thread the C stack of last thread to do an eval {}! - */ + * top_env needs to be non-zero. It points to an area in which longjmp() + * stuff is stored, as C callstack info there at least is thread specific + * this has to be per-thread. Otherwise a 'die' in a thread gives that + * thread the C stack of last thread to do an eval {}! +*/ -#define JMPENV_BOOTSTRAP \ - STMT_START { \ - PERL_POISON_EXPR(PoisonNew(&PL_start_env, 1, JMPENV));\ - PL_top_env = &PL_start_env; \ - PL_start_env.je_prev = NULL; \ - PL_start_env.je_ret = -1; \ - PL_start_env.je_mustcatch = TRUE; \ - PL_start_env.je_old_delaymagic = 0; \ - JE_OLD_STACK_HWM_zero; \ +#define JMPENV_BOOTSTRAP \ + STMT_START { \ + PERL_POISON_EXPR(PoisonNew(&PL_start_env, 1, JMPENV)); \ + PL_top_env = &PL_start_env; \ + PL_start_env.je_prev = NULL; \ + PL_start_env.je_ret = -1; \ + PL_start_env.je_mustcatch = TRUE; \ + PL_start_env.je_old_delaymagic = 0; \ + JE_OLD_STACK_HWM_zero; \ } STMT_END /* * PERL_FLEXIBLE_EXCEPTIONS * - * All the flexible exceptions code has been removed. - * See the following threads for details: + * All the flexible exceptions code has been removed. See the following + * threads for details: * * Message-Id: 20040713143217.GB1424@plum.flirble.org * https://www.nntp.perl.org/group/perl.perl5.porters/2004/07/msg93041.html @@ -96,92 +96,91 @@ typedef struct jmpenv JMPENV; * * http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1999-03/msg00520.html * - * The flaw in these patches (which went unnoticed at the time) was - * that they moved some code that could potentially die() out of the - * region protected by the setjmp()s. This caused exceptions within - * END blocks and such to not be handled by the correct setjmp(). + * The flaw in these patches (which went unnoticed at the time) was that they + * moved some code that could potentially die() out of the region protected by + * the setjmp()s. This caused exceptions within END blocks and such to not be + * handled by the correct setjmp(). * * The original patches that introduces flexible exceptions were: * * https://github.com/Perl/perl5/commit/312caa8e97f1c7ee342a9895c2f0e749625b4929 * https://github.com/Perl/perl5/commit/14dd3ad8c9bf82cf09798a22cc89a9862dfd6d1a - * - */ - -#define dJMPENV JMPENV cur_env +*/ -#define JMPENV_PUSH(v) \ - STMT_START { \ - DEBUG_l({ \ - int i = 0; \ - JMPENV *p = PL_top_env; \ - while (p) { i++; p = p->je_prev; } \ - Perl_deb(aTHX_ "JMPENV_PUSH pre level=%d in %s at %s:%d\n", \ - i, SAFE_FUNCTION__, __FILE__, __LINE__); \ - }); \ - cur_env.je_prev = PL_top_env; \ - JE_OLD_STACK_HWM_save(cur_env); \ - /* setjmp() is callable in limited contexts which does not */ \ - /* include assignment, so switch() instead */ \ - switch (PerlProc_setjmp(cur_env.je_buf, SCOPE_SAVES_SIGNAL_MASK)) { \ - case 0: cur_env.je_ret = 0; break; \ - case 1: cur_env.je_ret = 1; break; \ - case 2: cur_env.je_ret = 2; break; \ - case 3: cur_env.je_ret = 3; break; \ - default: Perl_croak(aTHX_ "panic: unexpected setjmp() result\n"); \ - } \ - JE_OLD_STACK_HWM_restore(cur_env); \ - PL_top_env = &cur_env; \ - cur_env.je_mustcatch = FALSE; \ - cur_env.je_old_delaymagic = PL_delaymagic; \ - DEBUG_l({ \ - int i = 0; \ - JMPENV *p = PL_top_env; \ - while (p) { i++; p = p->je_prev; } \ - Perl_deb(aTHX_ "JMPENV_PUSH level=%d ret=%d in %s at %s:%d\n", \ - i, cur_env.je_ret, SAFE_FUNCTION__, __FILE__, __LINE__); \ - }); \ - (v) = cur_env.je_ret; \ +#define dJMPENV JMPENV cur_env + +#define JMPENV_PUSH(v) \ + STMT_START { \ + DEBUG_l({ \ + int i = 0; \ + JMPENV *p = PL_top_env; \ + while (p) { i++; p = p->je_prev; } \ + Perl_deb(aTHX_ "JMPENV_PUSH pre level=%d in %s at %s:%d\n", \ + i, SAFE_FUNCTION__, __FILE__, __LINE__); \ + }); \ + cur_env.je_prev = PL_top_env; \ + JE_OLD_STACK_HWM_save(cur_env); \ + /* setjmp() is callable in limited contexts which does not */ \ + /* include assignment, so switch() instead */ \ + switch (PerlProc_setjmp(cur_env.je_buf, SCOPE_SAVES_SIGNAL_MASK)) { \ + case 0: cur_env.je_ret = 0; break; \ + case 1: cur_env.je_ret = 1; break; \ + case 2: cur_env.je_ret = 2; break; \ + case 3: cur_env.je_ret = 3; break; \ + default: Perl_croak(aTHX_ "panic: unexpected setjmp() result\n"); \ + } \ + JE_OLD_STACK_HWM_restore(cur_env); \ + PL_top_env = &cur_env; \ + cur_env.je_mustcatch = FALSE; \ + cur_env.je_old_delaymagic = PL_delaymagic; \ + DEBUG_l({ \ + int i = 0; \ + JMPENV *p = PL_top_env; \ + while (p) { i++; p = p->je_prev; } \ + Perl_deb(aTHX_ "JMPENV_PUSH level=%d ret=%d in %s at %s:%d\n", \ + i, cur_env.je_ret, SAFE_FUNCTION__, __FILE__, __LINE__); \ + }); \ + (v) = cur_env.je_ret; \ } STMT_END -#define JMPENV_POP \ - STMT_START { \ - DEBUG_l({ \ - int i = -1; JMPENV *p = PL_top_env; \ - while (p) { i++; p = p->je_prev; } \ - Perl_deb(aTHX_ "JMPENV_POP level=%d in %s at %s:%d\n", \ - i, SAFE_FUNCTION__, __FILE__, __LINE__);}) \ - assert(PL_top_env == &cur_env); \ - PL_delaymagic = cur_env.je_old_delaymagic; \ - PL_top_env = cur_env.je_prev; \ +#define JMPENV_POP \ + STMT_START { \ + DEBUG_l({ \ + int i = -1; JMPENV *p = PL_top_env; \ + while (p) { i++; p = p->je_prev; } \ + Perl_deb(aTHX_ "JMPENV_POP level=%d in %s at %s:%d\n", \ + i, SAFE_FUNCTION__, __FILE__, __LINE__);}) \ + assert(PL_top_env == &cur_env); \ + PL_delaymagic = cur_env.je_old_delaymagic; \ + PL_top_env = cur_env.je_prev; \ } STMT_END -#define JMPENV_JUMP(v) \ - STMT_START { \ - DEBUG_l({ \ - int i = -1; JMPENV *p = PL_top_env; \ - while (p) { i++; p = p->je_prev; } \ +#define JMPENV_JUMP(v) \ + STMT_START { \ + DEBUG_l({ \ + int i = -1; JMPENV *p = PL_top_env; \ + while (p) { i++; p = p->je_prev; } \ Perl_deb(aTHX_ "JMPENV_JUMP(%d) level=%d in %s at %s:%d\n", \ (int)(v), i, SAFE_FUNCTION__, __FILE__, __LINE__);}) \ - if (PL_top_env->je_prev) { \ - assert((v) >= 0 && (v) <= 3); \ - PerlProc_longjmp(PL_top_env->je_buf, (v)); \ - } \ - if ((v) == 2) \ - PerlProc_exit(STATUS_EXIT); \ - PerlIO_printf(PerlIO_stderr(), "panic: top_env, v=%d\n", (int)(v)); \ - PerlProc_exit(1); \ + if (PL_top_env->je_prev) { \ + assert((v) >= 0 && (v) <= 3); \ + PerlProc_longjmp(PL_top_env->je_buf, (v)); \ + } \ + if ((v) == 2) \ + PerlProc_exit(STATUS_EXIT); \ + PerlIO_printf(PerlIO_stderr(), "panic: top_env, v=%d\n", (int)(v)); \ + PerlProc_exit(1); \ } STMT_END -#define CATCH_GET (PL_top_env->je_mustcatch) -#define CATCH_SET(v) \ - STMT_START { \ - DEBUG_l( \ - Perl_deb(aTHX_ \ +#define CATCH_GET (PL_top_env->je_mustcatch) +#define CATCH_SET(v) \ + STMT_START { \ + DEBUG_l( \ + Perl_deb(aTHX_ \ "JUMPLEVEL set catch %d => %d (for %p) in %s at %s:%d\n", \ - PL_top_env->je_mustcatch, (v), (void*)PL_top_env, \ - SAFE_FUNCTION__, __FILE__, __LINE__);) \ - PL_top_env->je_mustcatch = (v); \ + PL_top_env->je_mustcatch, (v), (void*)PL_top_env, \ + SAFE_FUNCTION__, __FILE__, __LINE__);) \ + PL_top_env->je_mustcatch = (v); \ } STMT_END /* @@ -190,8 +189,8 @@ typedef struct jmpenv JMPENV; typedef struct refcounted_he COPHH; -#define COPHH_KEY_UTF8 REFCOUNTED_HE_KEY_UTF8 -#define COPHH_EXISTS REFCOUNTED_HE_EXISTS +#define COPHH_KEY_UTF8 REFCOUNTED_HE_KEY_UTF8 +#define COPHH_EXISTS REFCOUNTED_HE_EXISTS /* =for apidoc Amx|SV *|cophh_fetch_pv |const COPHH *cophh|const char *key |U32 hash|U32 flags @@ -199,97 +198,94 @@ typedef struct refcounted_he COPHH; =for apidoc_item|SV *|cophh_fetch_pvs|const COPHH *cophh| "key" |U32 flags =for apidoc_item|SV *|cophh_fetch_sv |const COPHH *cophh| SV *key |U32 hash|U32 flags -These look up the entry in the cop hints hash C with the key specified by -C (and C in the C form), returning that value as a mortal -scalar copy, or C<&PL_sv_placeholder> if there is no value associated with the -key. +These look up the entry in the cop hints hash C with the key +specified by C (and C in the C form), returning that +value as a mortal scalar copy, or C<&PL_sv_placeholder> if there is no +value associated with the key. -The forms differ in how the key is specified. -In the plain C form, the key is a C language NUL-terminated string. -In the C form, the key is a C language string literal. -In the C form, an additional parameter, C, specifies the length of -the string, which hence, may contain embedded-NUL characters. -In the C form, C<*key> is an SV, and the key is the PV extracted from that. -using C>. +The forms differ in how the key is specified. In the plain C form, +the key is a C language NUL-terminated string. In the C form, the +key is a C language string literal. In the C form, an additional +parameter, C, specifies the length of the string, which hence, may +contain embedded-NUL characters. In the C form, C<*key> is an SV, and +the key is the PV extracted from that. using C>. -C is a precomputed hash of the key string, or zero if it has not been -precomputed. This parameter is omitted from the C form, as it is computed -automatically at compile time. +C is a precomputed hash of the key string, or zero if it has not +been precomputed. This parameter is omitted from the C form, as it +is computed automatically at compile time. -The only flag currently used from the C parameter is C. -It is illegal to set this in the C form. In the C forms, it specifies -whether the key octets are interpreted as UTF-8 (if set) or as Latin-1 (if -cleared). The C form uses the underlying SV to determine the UTF-8ness of -the octets. +The only flag currently used from the C parameter is +C. It is illegal to set this in the C form. In the +C forms, it specifies whether the key octets are interpreted as UTF-8 +(if set) or as Latin-1 (if cleared). The C form uses the underlying +SV to determine the UTF-8ness of the octets. =for apidoc Amnh||COPHH_KEY_UTF8 =cut - */ -#define cophh_fetch_pvn(cophh, key, keylen, hash, flags) \ - Perl_refcounted_he_fetch_pvn(aTHX_ cophh, key, keylen, hash, \ +#define cophh_fetch_pvn(cophh, key, keylen, hash, flags) \ + Perl_refcounted_he_fetch_pvn(aTHX_ cophh, key, keylen, hash, \ (flags & COPHH_KEY_UTF8)) -#define cophh_fetch_pvs(cophh, key, flags) \ - Perl_refcounted_he_fetch_pvn(aTHX_ cophh, STR_WITH_LEN(key), 0, \ +#define cophh_fetch_pvs(cophh, key, flags) \ + Perl_refcounted_he_fetch_pvn(aTHX_ cophh, STR_WITH_LEN(key), 0, \ (flags & COPHH_KEY_UTF8)) -#define cophh_fetch_pv(cophh, key, hash, flags) \ - Perl_refcounted_he_fetch_pv(aTHX_ cophh, key, hash, \ +#define cophh_fetch_pv(cophh, key, hash, flags) \ + Perl_refcounted_he_fetch_pv(aTHX_ cophh, key, hash, \ (flags & COPHH_KEY_UTF8)) -#define cophh_fetch_sv(cophh, key, hash, flags) \ - Perl_refcounted_he_fetch_sv(aTHX_ cophh, key, hash, \ +#define cophh_fetch_sv(cophh, key, hash, flags) \ + Perl_refcounted_he_fetch_sv(aTHX_ cophh, key, hash, \ (flags & COPHH_KEY_UTF8)) /* =for apidoc Amx|bool|cophh_exists_pvn|const COPHH *cophh|const char *key|STRLEN keylen|U32 hash|U32 flags These look up the hint entry in the cop C with the key specified by -C (and C in the C form), returning true if a value exists, -and false otherwise. - -The forms differ in how the key is specified. -In the plain C form, the key is a C language NUL-terminated string. -In the C form, the key is a C language string literal. -In the C form, an additional parameter, C, specifies the length of -the string, which hence, may contain embedded-NUL characters. -In the C form, C<*key> is an SV, and the key is the PV extracted from that. -using C>. - -C is a precomputed hash of the key string, or zero if it has not been -precomputed. This parameter is omitted from the C form, as it is computed -automatically at compile time. - -The only flag currently used from the C parameter is C. -It is illegal to set this in the C form. In the C forms, it specifies -whether the key octets are interpreted as UTF-8 (if set) or as Latin-1 (if -cleared). The C form uses the underlying SV to determine the UTF-8ness of -the octets. +C (and C in the C form), returning true if a value +exists, and false otherwise. + +The forms differ in how the key is specified. In the plain C form, +the key is a C language NUL-terminated string. In the C form, the +key is a C language string literal. In the C form, an additional +parameter, C, specifies the length of the string, which hence, may +contain embedded-NUL characters. In the C form, C<*key> is an SV, and +the key is the PV extracted from that. using C>. + +C is a precomputed hash of the key string, or zero if it has not +been precomputed. This parameter is omitted from the C form, as it +is computed automatically at compile time. + +The only flag currently used from the C parameter is +C. It is illegal to set this in the C form. In the +C forms, it specifies whether the key octets are interpreted as UTF-8 +(if set) or as Latin-1 (if cleared). The C form uses the underlying +SV to determine the UTF-8ness of the octets. =cut */ -#define cophh_exists_pvn(cophh, key, keylen, hash, flags) \ +#define cophh_exists_pvn(cophh, key, keylen, hash, flags) \ cBOOL(Perl_refcounted_he_fetch_pvn(aTHX_ cophh, key, keylen, hash, flags | COPHH_EXISTS)) #define cophh_exists_pvs(cophh, key, flags) \ cBOOL(Perl_refcounted_he_fetch_pvn(aTHX_ cophh, STR_WITH_LEN(key), 0, flags | COPHH_EXISTS)) -#define cophh_exists_pv(cophh, key, hash, flags) \ +#define cophh_exists_pv(cophh, key, hash, flags) \ cBOOL(Perl_refcounted_he_fetch_pv(aTHX_ cophh, key, hash, flags | COPHH_EXISTS)) -#define cophh_exists_sv(cophh, key, hash, flags) \ +#define cophh_exists_sv(cophh, key, hash, flags) \ cBOOL(Perl_refcounted_he_fetch_sv(aTHX_ cophh, key, hash, flags | COPHH_EXISTS)) /* =for apidoc Amx|HV *|cophh_2hv|const COPHH *cophh|U32 flags -Generates and returns a standard Perl hash representing the full set of -key/value pairs in the cop hints hash C. C is currently -unused and must be zero. +Generates and returns a standard Perl hash representing the +full set of key/value pairs in the cop hints hash +C. C is currently unused and must be zero. =cut */ @@ -305,18 +301,17 @@ Make and return a complete copy of the cop hints hash C. =cut */ -#define cophh_copy(cophh) Perl_refcounted_he_inc(aTHX_ cophh) +#define cophh_copy(cophh) Perl_refcounted_he_inc(aTHX_ cophh) /* =for apidoc Amx|void|cophh_free|COPHH *cophh -Discard the cop hints hash C, freeing all resources associated -with it. +Discard the cop hints hash C, freeing all resources associated with it. =cut */ -#define cophh_free(cophh) Perl_refcounted_he_free(aTHX_ cophh) +#define cophh_free(cophh) Perl_refcounted_he_free(aTHX_ cophh) /* =for apidoc Amx|COPHH *|cophh_new_empty @@ -326,7 +321,7 @@ Generate and return a fresh cop hints hash containing no entries. =cut */ -#define cophh_new_empty() ((COPHH *)NULL) +#define cophh_new_empty() ((COPHH *)NULL) /* =for apidoc Amx|COPHH *|cophh_store_pv |COPHH *cophh|const char *key |U32 hash|SV *value|U32 flags @@ -334,36 +329,35 @@ Generate and return a fresh cop hints hash containing no entries. =for apidoc_item|COPHH *|cophh_store_pvs|COPHH *cophh| "key" |SV *value|U32 flags =for apidoc_item|COPHH *|cophh_store_sv |COPHH *cophh| SV *key |U32 hash|SV *value|U32 flags -These store a value, associated with a key, in the cop hints hash C, -and return the modified hash. The returned hash pointer is in general -not the same as the hash pointer that was passed in. The input hash is -consumed by the function, and the pointer to it must not be subsequently -used. Use L if you need both hashes. +These store a value, associated with a key, in the cop hints hash +C, and return the modified hash. The returned hash pointer is in +general not the same as the hash pointer that was passed in. The input +hash is consumed by the function, and the pointer to it must not be +subsequently used. Use L if you need both hashes. C is the scalar value to store for this key. C is copied -by these functions, which thus do not take ownership of any reference -to it, and hence later changes to the scalar will not be reflected in the value -visible in the cop hints hash. Complex types of scalar will not be stored with -referential integrity, but will be coerced to strings. - -The forms differ in how the key is specified. In all forms, the key is pointed -to by C. -In the plain C form, the key is a C language NUL-terminated string. -In the C form, the key is a C language string literal. -In the C form, an additional parameter, C, specifies the length of -the string, which hence, may contain embedded-NUL characters. -In the C form, C<*key> is an SV, and the key is the PV extracted from that. -using C>. - -C is a precomputed hash of the key string, or zero if it has not been -precomputed. This parameter is omitted from the C form, as it is computed -automatically at compile time. - -The only flag currently used from the C parameter is C. -It is illegal to set this in the C form. In the C forms, it specifies -whether the key octets are interpreted as UTF-8 (if set) or as Latin-1 (if -cleared). The C form uses the underlying SV to determine the UTF-8ness of -the octets. +by these functions, which thus do not take ownership of any reference to +it, and hence later changes to the scalar will not be reflected in the +value visible in the cop hints hash. Complex types of scalar will not +be stored with referential integrity, but will be coerced to strings. + +The forms differ in how the key is specified. In all forms, the key is +pointed to by C. In the plain C form, the key is a C language +NUL-terminated string. In the C form, the key is a C language +string literal. In the C form, an additional parameter, C, +specifies the length of the string, which hence, may contain +embedded-NUL characters. In the C form, C<*key> is an SV, and the +key is the PV extracted from that. using C>. + +C is a precomputed hash of the key string, or zero if it has not +been precomputed. This parameter is omitted from the C form, as it +is computed automatically at compile time. + +The only flag currently used from the C parameter is +C. It is illegal to set this in the C form. In the +C forms, it specifies whether the key octets are interpreted as +UTF-8 (if set) or as Latin-1 (if cleared). The C form uses the +underlying SV to determine the UTF-8ness of the octets. =cut */ @@ -371,13 +365,13 @@ the octets. #define cophh_store_pvn(cophh, key, keylen, hash, value, flags) \ Perl_refcounted_he_new_pvn(aTHX_ cophh, key, keylen, hash, value, flags) -#define cophh_store_pvs(cophh, key, value, flags) \ +#define cophh_store_pvs(cophh, key, value, flags) \ Perl_refcounted_he_new_pvn(aTHX_ cophh, STR_WITH_LEN(key), 0, value, flags) -#define cophh_store_pv(cophh, key, hash, value, flags) \ +#define cophh_store_pv(cophh, key, hash, value, flags) \ Perl_refcounted_he_new_pv(aTHX_ cophh, key, hash, value, flags) -#define cophh_store_sv(cophh, key, hash, value, flags) \ +#define cophh_store_sv(cophh, key, hash, value, flags) \ Perl_refcounted_he_new_sv(aTHX_ cophh, key, hash, value, flags) /* @@ -386,46 +380,45 @@ the octets. =for apidoc_item|COPHH *|cophh_delete_pvs|COPHH *cophh| "key" |U32 flags =for apidoc_item|COPHH *|cophh_delete_sv |COPHH *cophh| SV *key |U32 hash|U32 flags -These delete a key and its associated value from the cop hints hash C, -and return the modified hash. The returned hash pointer is in general -not the same as the hash pointer that was passed in. The input hash is -consumed by the function, and the pointer to it must not be subsequently -used. Use L if you need both hashes. - -The forms differ in how the key is specified. In all forms, the key is pointed -to by C. -In the plain C form, the key is a C language NUL-terminated string. -In the C form, the key is a C language string literal. -In the C form, an additional parameter, C, specifies the length of -the string, which hence, may contain embedded-NUL characters. -In the C form, C<*key> is an SV, and the key is the PV extracted from that. -using C>. - -C is a precomputed hash of the key string, or zero if it has not been -precomputed. This parameter is omitted from the C form, as it is computed -automatically at compile time. - -The only flag currently used from the C parameter is C. -It is illegal to set this in the C form. In the C forms, it specifies -whether the key octets are interpreted as UTF-8 (if set) or as Latin-1 (if -cleared). The C form uses the underlying SV to determine the UTF-8ness of -the octets. +These delete a key and its associated value from the cop hints hash +C, and return the modified hash. The returned hash pointer is +in general not the same as the hash pointer that was passed in. The +input hash is consumed by the function, and the pointer to it must not +be subsequently used. Use L if you need both hashes. + +The forms differ in how the key is specified. In all forms, the key is +pointed to by C. In the plain C form, the key is a C language +NUL-terminated string. In the C form, the key is a C language +string literal. In the C form, an additional parameter, +C, specifies the length of the string, which hence, may contain +embedded-NUL characters. In the C form, C<*key> is an SV, and the +key is the PV extracted from that. using C>. + +C is a precomputed hash of the key string, or zero if it has not +been precomputed. This parameter is omitted from the C form, as +it is computed automatically at compile time. + +The only flag currently used from the C parameter is +C. It is illegal to set this in the C form. In +the C forms, it specifies whether the key octets are interpreted +as UTF-8 (if set) or as Latin-1 (if cleared). The C form uses the +underlying SV to determine the UTF-8ness of the octets. =cut */ -#define cophh_delete_pvn(cophh, key, keylen, hash, flags) \ - Perl_refcounted_he_new_pvn(aTHX_ cophh, key, keylen, hash, \ +#define cophh_delete_pvn(cophh, key, keylen, hash, flags) \ + Perl_refcounted_he_new_pvn(aTHX_ cophh, key, keylen, hash, \ (SV *)NULL, flags) -#define cophh_delete_pvs(cophh, key, flags) \ - Perl_refcounted_he_new_pvn(aTHX_ cophh, STR_WITH_LEN(key), 0, \ +#define cophh_delete_pvs(cophh, key, flags) \ + Perl_refcounted_he_new_pvn(aTHX_ cophh, STR_WITH_LEN(key), 0, \ (SV *)NULL, flags) -#define cophh_delete_pv(cophh, key, hash, flags) \ +#define cophh_delete_pv(cophh, key, hash, flags) \ Perl_refcounted_he_new_pv(aTHX_ cophh, key, hash, (SV *)NULL, flags) -#define cophh_delete_sv(cophh, key, hash, flags) \ +#define cophh_delete_sv(cophh, key, hash, flags) \ Perl_refcounted_he_new_sv(aTHX_ cophh, key, hash, (SV *)NULL, flags) #include "mydtrace.h" @@ -433,35 +426,36 @@ the octets. struct cop { BASEOP /* On LP64 putting this here takes advantage of the fact that BASEOP isn't - an exact multiple of 8 bytes to save structure padding. */ - line_t cop_line; /* line # of this command */ + an exact multiple of 8 bytes to save structure padding. */ + line_t cop_line; /* line # of this command */ /* label for this construct is now stored in cop_hints_hash */ #ifdef USE_ITHREADS - PADOFFSET cop_stashoff; /* offset into PL_stashpad, for the - package the line was compiled in */ - char * cop_file; /* rcpv containing name of file this command is from */ + PADOFFSET cop_stashoff; /* offset into PL_stashpad, for the package + the line was compiled in */ + char *cop_file; /* rcpv containing name of file + this command is from */ #else - HV * cop_stash; /* package line was compiled in */ - GV * cop_filegv; /* name of GV file this command is from */ + HV *cop_stash; /* package line was compiled in */ + GV *cop_filegv; /* name of GV file this command is from */ #endif - U32 cop_hints; /* hints bits from pragmata */ - U32 cop_seq; /* parse sequence number */ - char * cop_warnings; /* Lexical warnings bitmask vector. - Refcounted shared copy of ${^WARNING_BITS}. - This pointer either points at one of the - magic values for warnings, or it points - at a buffer constructed with rcpv_new(). - Use the RCPV_LEN() macro to get its length. - */ - /* compile time state of %^H. See the comment in op.c for how this is - used to recreate a hash to return from caller. */ - COPHH * cop_hints_hash; - /* for now just a bitmask stored here. - If we get sufficient features this may become a pointer. - How these flags are stored is subject to change without - notice. Use the macros to test for features. - */ - U32 cop_features; + U32 cop_hints; /* hints bits from pragmata */ + U32 cop_seq; /* parse sequence number */ + char *cop_warnings; /* Lexical warnings bitmask vector. + Refcounted shared copy of + ${^WARNING_BITS}. This pointer either + points at one of the magic values for + warnings, or it points at a buffer + constructed with rcpv_new(). Use the + RCPV_LEN() macro to get its length. + */ + /* compile time state of %^H. See the comment in op.c for how + this is used to recreate a hash to return from caller. */ + COPHH *cop_hints_hash; + /* for now just a bitmask stored here. If we get sufficient features + this may become a pointer. How these flags are stored is subject + to change without notice. Use the macros to test for features. + */ + U32 cop_features; }; /* @@ -478,8 +472,8 @@ Returns the line number in the source code associated with the C C Returns the AV associated with the C C, creating it if necessary. =for apidoc Am|AV *|CopFILEAVn|const COP * c -Returns the AV associated with the C C, returning NULL if it -doesn't already exist. +Returns the AV associated with the C C, returning NULL if it doesn't +already exist. =for apidoc Am|SV *|CopFILESV|const COP * c Returns the SV associated with the C C @@ -491,12 +485,11 @@ Makes C the name of the file associated with the C C Makes C the name of the file associated with the C C =for apidoc Am|void|CopFILE_copy|COP * dst|COP * src -Efficiently copies the cop file name from one COP to another. Wraps -the required logic to do a refcounted copy under threads or not. +Efficiently copies the cop file name from one COP to another. Wraps the +required logic to do a refcounted copy under threads or not. =for apidoc Am|void|CopFILE_free|COP * c -Frees the file data in a cop. Under the hood this is a refcounting -operation. +Frees the file data in a cop. Under the hood this is a refcounting operation. =for apidoc Am|GV *|CopFILEGV|const COP * c Returns the GV associated with the C C @@ -509,7 +502,8 @@ associated with the C C Returns the stash associated with C. =for apidoc Am|bool|CopSTASH_eq|const COP * c|const HV * hv -Returns a boolean as to whether or not C is the stash associated with C. +Returns a boolean as to whether or not C is the stash associated with +C. =for apidoc Am|bool|CopSTASH_set|COP * c|HV * hv Set the stash associated with C to C. @@ -531,22 +525,22 @@ Returns the RCPV structure (struct rcpv) for a refcounted string pv created with C. =for apidoc Am|RCPV *|RCPV_REFCOUNT|char *pv -Returns the refcount for a pv created with C. +Returns the refcount for a pv created with C. =for apidoc Am|RCPV *|RCPV_LEN|char *pv -Returns the length of a pv created with C. -Note that this reflects the length of the string from the callers -point of view, it does not include the mandatory null which is -always injected at the end of the string by rcpv_new(). +Returns the length of a pv created with C. Note +that this reflects the length of the string from the callers +point of view, it does not include the mandatory null which +is always injected at the end of the string by rcpv_new(). =cut */ struct rcpv { - STRLEN refcount; /* UV would mean a 64 refcnt on - 32 bit builds with -Duse64bitint */ - STRLEN len; /* length of string including mandatory - null byte at end */ + STRLEN refcount; /* UV would mean a 64 refcnt on 32 bit + builds with -Duse64bitint */ + STRLEN len; /* length of string including mandatory + null byte at end */ char pv[1]; }; typedef struct rcpv RCPV; @@ -555,105 +549,116 @@ typedef struct rcpv RCPV; #define RCPVf_NO_COPY (1 << 1) #define RCPVf_ALLOW_EMPTY (1 << 2) -#define RCPVx(pv_arg) ((RCPV *)((pv_arg) - STRUCT_OFFSET(struct rcpv, pv))) +#define RCPVx(pv_arg) \ + ((RCPV *)((pv_arg) - STRUCT_OFFSET(struct rcpv, pv))) #define RCPV_REFCOUNT(pv) (RCPVx(pv)->refcount) -#define RCPV_LEN(pv) (RCPVx(pv)->len-1) /* len always includes space for a null */ +#define RCPV_LEN(pv) (RCPVx(pv)->len-1) /* len always includes + space for a null */ #ifdef USE_ITHREADS -# define CopFILE(c) ((c)->cop_file) -# define CopFILE_LEN(c) (CopFILE(c) ? RCPV_LEN(CopFILE(c)) : 0) -# define CopFILEGV(c) (CopFILE(c) \ - ? gv_fetchfile(CopFILE(c)) : NULL) +# define CopFILE(c) ((c)->cop_file) +# define CopFILE_LEN(c) (CopFILE(c) ? RCPV_LEN(CopFILE(c)) : 0) +# define CopFILEGV(c) \ + (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : NULL) -# define CopFILE_set_x(c,pv) ((c)->cop_file = rcpv_new((pv),0,RCPVf_USE_STRLEN)) -# define CopFILE_setn_x(c,pv,l) ((c)->cop_file = rcpv_new((pv),(l),0)) -# define CopFILE_free_x(c) ((c)->cop_file = rcpv_free((c)->cop_file)) -# define CopFILE_copy_x(dst,src) ((dst)->cop_file = rcpv_copy((src)->cop_file)) +# define CopFILE_set_x(c,pv) \ + ((c)->cop_file = rcpv_new((pv),0,RCPVf_USE_STRLEN)) +# define CopFILE_setn_x(c,pv,l) ((c)->cop_file = rcpv_new((pv),(l),0)) +# define CopFILE_free_x(c) ((c)->cop_file = rcpv_free((c)->cop_file)) +# define CopFILE_copy_x(dst,src) \ + ((dst)->cop_file = rcpv_copy((src)->cop_file)) /* change condition to 1 && to enable this debugging */ -# define CopFILE_debug(c,t,rk) \ - if (0 && (c)->cop_file) \ - PerlIO_printf(Perl_debug_log, \ - "%-14s THX:%p OP:%p PV:%p rc: " \ - "%6zu fn: '%.*s' at %s line %d\n", \ - (t), aTHX, (c), (c)->cop_file, \ - RCPV_REFCOUNT((c)->cop_file)-rk, \ - (int)RCPV_LEN((c)->cop_file), \ - (c)->cop_file,__FILE__,__LINE__) \ +# define CopFILE_debug(c,t,rk) \ + if (0 && (c)->cop_file) \ + PerlIO_printf(Perl_debug_log, \ + "%-14s THX:%p OP:%p PV:%p rc: " \ + "%6zu fn: '%.*s' at %s line %d\n", \ + (t), aTHX, (c), (c)->cop_file, \ + RCPV_REFCOUNT((c)->cop_file)-rk, \ + (int)RCPV_LEN((c)->cop_file), \ + (c)->cop_file,__FILE__,__LINE__) \ # define CopFILE_set(c,pv) \ - STMT_START { \ - CopFILE_set_x(c,pv); \ - CopFILE_debug(c,"CopFILE_set", 0); \ - } STMT_END + STMT_START { \ + CopFILE_set_x(c,pv); \ + CopFILE_debug(c,"CopFILE_set", 0); \ + } STMT_END # define CopFILE_setn(c,pv,l) \ - STMT_START { \ - CopFILE_setn_x(c,pv,l); \ - CopFILE_debug(c,"CopFILE_setn", 0); \ - } STMT_END - -# define CopFILE_copy(dst,src) \ - STMT_START { \ - CopFILE_copy_x((dst),(src)); \ - CopFILE_debug((dst),"CopFILE_copy", 0); \ - } STMT_END - -# define CopFILE_free(c) \ - STMT_START { \ - CopFILE_debug((c),"CopFILE_free", 1); \ - CopFILE_free_x(c); \ - } STMT_END - - -# define CopFILESV(c) (CopFILE(c) \ - ? GvSV(gv_fetchfile(CopFILE(c))) : NULL) -# define CopFILEAV(c) (CopFILE(c) \ - ? GvAV(gv_fetchfile(CopFILE(c))) : NULL) -# define CopFILEAVx(c) (assert_(CopFILE(c)) \ - GvAV(gv_fetchfile(CopFILE(c)))) -# define CopFILEAVn(c) (cop_file_avn(c)) -# define CopSTASH(c) PL_stashpad[(c)->cop_stashoff] -# define CopSTASH_set(c,hv) ((c)->cop_stashoff = (hv) \ - ? alloccopstash(hv) \ - : 0) + STMT_START { \ + CopFILE_setn_x(c,pv,l); \ + CopFILE_debug(c,"CopFILE_setn", 0); \ + } STMT_END + +# define CopFILE_copy(dst,src) \ + STMT_START { \ + CopFILE_copy_x((dst),(src)); \ + CopFILE_debug((dst),"CopFILE_copy", 0); \ + } STMT_END + +# define CopFILE_free(c) \ + STMT_START { \ + CopFILE_debug((c),"CopFILE_free", 1); \ + CopFILE_free_x(c); \ + } STMT_END + + +# define CopFILESV(c) \ + (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : NULL) +# define CopFILEAV(c) \ + (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : NULL) +# define CopFILEAVx(c) \ + (assert_(CopFILE(c)) \ + GvAV(gv_fetchfile(CopFILE(c)))) +# define CopFILEAVn(c) (cop_file_avn(c)) +# define CopSTASH(c) PL_stashpad[(c)->cop_stashoff] +# define CopSTASH_set(c,hv) \ + ((c)->cop_stashoff = (hv) \ + ? alloccopstash(hv) \ + : 0) #else /* Above: yes threads; Below no threads */ -# define CopFILEGV(c) ((c)->cop_filegv) -# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv)) -# define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv)) -# define CopFILE_copy(dst,src) CopFILEGV_set((dst),CopFILEGV(src)) -# define CopFILE_setn(c,pv,l) CopFILEGV_set((c), gv_fetchfile_flags((pv),(l),0)) -# define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : NULL) -# define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : NULL) +# define CopFILEGV(c) ((c)->cop_filegv) +# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv)) +# define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv)) +# define CopFILE_copy(dst,src) CopFILEGV_set((dst),CopFILEGV(src)) +# define CopFILE_setn(c,pv,l) \ + CopFILEGV_set((c), gv_fetchfile_flags((pv),(l),0)) +# define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : NULL) +# define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : NULL) # ifdef DEBUGGING -# define CopFILEAVx(c) (assert(CopFILEGV(c)), GvAV(CopFILEGV(c))) +# define CopFILEAVx(c) (assert(CopFILEGV(c)), GvAV(CopFILEGV(c))) # else -# define CopFILEAVx(c) (GvAV(CopFILEGV(c))) +# define CopFILEAVx(c) (GvAV(CopFILEGV(c))) # endif -# define CopFILEAVn(c) (CopFILEGV(c) ? GvAVn(CopFILEGV(c)) : NULL) -# define CopFILE(c) (CopFILEGV(c) /* +2 for '_<' */ \ - ? GvNAME(CopFILEGV(c))+2 : NULL) -# define CopFILE_LEN(c) (CopFILEGV(c) /* -2 for '_<' */ \ - ? GvNAMELEN(CopFILEGV(c))-2 : 0) -# define CopSTASH(c) ((c)->cop_stash) -# define CopSTASH_set(c,hv) ((c)->cop_stash = (hv)) -# define CopFILE_free(c) (SvREFCNT_dec(CopFILEGV(c)),(CopFILEGV(c) = NULL)) +# define CopFILEAVn(c) (CopFILEGV(c) ? GvAVn(CopFILEGV(c)) : NULL) +# define CopFILE(c) \ + (CopFILEGV(c) /* +2 for '_<' */ \ + ? GvNAME(CopFILEGV(c))+2 : NULL) +# define CopFILE_LEN(c) \ + (CopFILEGV(c) /* -2 for '_<' */ \ + ? GvNAMELEN(CopFILEGV(c))-2 : 0) +# define CopSTASH(c) ((c)->cop_stash) +# define CopSTASH_set(c,hv) ((c)->cop_stash = (hv)) +# define CopFILE_free(c) \ + (SvREFCNT_dec(CopFILEGV(c)),(CopFILEGV(c) = NULL)) #endif /* USE_ITHREADS */ -#define CopSTASHPV(c) (CopSTASH(c) ? HvNAME_get(CopSTASH(c)) : NULL) +#define CopSTASHPV(c) (CopSTASH(c) ? HvNAME_get(CopSTASH(c)) : NULL) /* cop_stash is not refcounted */ -#define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD)) -#define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv)) +#define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD)) +#define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv)) -#define CopHINTHASH_get(c) ((COPHH*)((c)->cop_hints_hash)) -#define CopHINTHASH_set(c,h) ((c)->cop_hints_hash = (h)) +#define CopHINTHASH_get(c) ((COPHH*)((c)->cop_hints_hash)) +#define CopHINTHASH_set(c,h) ((c)->cop_hints_hash = (h)) -#define CopFEATURES_setfrom(dst, src) ((dst)->cop_features = (src)->cop_features) +#define CopFEATURES_setfrom(dst, src) \ + ((dst)->cop_features = (src)->cop_features) /* =for apidoc Am|SV *|cop_hints_fetch_pv |const COP *cop|const char *key |U32 hash|U32 flags @@ -661,18 +666,16 @@ typedef struct rcpv RCPV; =for apidoc_item|SV *|cop_hints_fetch_pvs|const COP *cop| "key" |U32 flags =for apidoc_item|SV *|cop_hints_fetch_sv |const COP *cop| SV *key |U32 hash|U32 flags -These look up the hint entry in the cop C with the key specified by -C (and C in the C form), returning that value as a mortal -scalar copy, or C<&PL_sv_placeholder> if there is no value associated with the -key. - -The forms differ in how the key is specified. -In the plain C form, the key is a C language NUL-terminated string. -In the C form, the key is a C language string literal. -In the C form, an additional parameter, C, specifies the length of -the string, which hence, may contain embedded-NUL characters. -In the C form, C<*key> is an SV, and the key is the PV extracted from that. -using C>. +These look up the hint entry in the cop C with the key specified by C +(and C in the C form), returning that value as a mortal scalar +copy, or C<&PL_sv_placeholder> if there is no value associated with the key. + +The forms differ in how the key is specified. In the plain C form, the key +is a C language NUL-terminated string. In the C form, the key is a C +language string literal. In the C form, an additional parameter, +C, specifies the length of the string, which hence, may contain +embedded-NUL characters. In the C form, C<*key> is an SV, and the key is +the PV extracted from that. using C>. C is a precomputed hash of the key string, or zero if it has not been precomputed. This parameter is omitted from the C form, as it is computed @@ -687,16 +690,16 @@ the octets. =cut */ -#define cop_hints_fetch_pvn(cop, key, keylen, hash, flags) \ +#define cop_hints_fetch_pvn(cop, key, keylen, hash, flags) \ cophh_fetch_pvn(CopHINTHASH_get(cop), key, keylen, hash, flags) -#define cop_hints_fetch_pvs(cop, key, flags) \ +#define cop_hints_fetch_pvs(cop, key, flags) \ cophh_fetch_pvs(CopHINTHASH_get(cop), key, flags) -#define cop_hints_fetch_pv(cop, key, hash, flags) \ +#define cop_hints_fetch_pv(cop, key, hash, flags) \ cophh_fetch_pv(CopHINTHASH_get(cop), key, hash, flags) -#define cop_hints_fetch_sv(cop, key, hash, flags) \ +#define cop_hints_fetch_sv(cop, key, hash, flags) \ cophh_fetch_sv(CopHINTHASH_get(cop), key, hash, flags) /* @@ -705,28 +708,27 @@ the octets. =for apidoc_item|bool|cop_hints_exists_pvs|const COP *cop| "key" |U32 flags =for apidoc_item|bool|cop_hints_exists_sv |const COP *cop| SV *key |U32 hash|U32 flags -These look up the hint entry in the cop C with the key specified by -C (and C in the C form), returning true if a value exists, -and false otherwise. - -The forms differ in how the key is specified. In all forms, the key is pointed -to by C. -In the plain C form, the key is a C language NUL-terminated string. -In the C form, the key is a C language string literal. -In the C form, an additional parameter, C, specifies the length of -the string, which hence, may contain embedded-NUL characters. -In the C form, C<*key> is an SV, and the key is the PV extracted from that. -using C>. +These look up the hint entry in the cop C with the key specified +by C (and C in the C form), returning true if a value +exists, and false otherwise. -C is a precomputed hash of the key string, or zero if it has not been -precomputed. This parameter is omitted from the C form, as it is computed -automatically at compile time. +The forms differ in how the key is specified. In all forms, the key is +pointed to by C. In the plain C form, the key is a C language +NUL-terminated string. In the C form, the key is a C language +string literal. In the C form, an additional parameter, +C, specifies the length of the string, which hence, may contain +embedded-NUL characters. In the C form, C<*key> is an SV, and the +key is the PV extracted from that. using C>. -The only flag currently used from the C parameter is C. -It is illegal to set this in the C form. In the C forms, it specifies -whether the key octets are interpreted as UTF-8 (if set) or as Latin-1 (if -cleared). The C form uses the underlying SV to determine the UTF-8ness of -the octets. +C is a precomputed hash of the key string, or zero if it has not +been precomputed. This parameter is omitted from the C form, as +it is computed automatically at compile time. + +The only flag currently used from the C parameter is +C. It is illegal to set this in the C form. In +the C forms, it specifies whether the key octets are interpreted +as UTF-8 (if set) or as Latin-1 (if cleared). The C form uses the +underlying SV to determine the UTF-8ness of the octets. =cut */ @@ -734,26 +736,25 @@ the octets. #define cop_hints_exists_pvn(cop, key, keylen, hash, flags) \ cophh_exists_pvn(CopHINTHASH_get(cop), key, keylen, hash, flags) -#define cop_hints_exists_pvs(cop, key, flags) \ +#define cop_hints_exists_pvs(cop, key, flags) \ cophh_exists_pvs(CopHINTHASH_get(cop), key, flags) -#define cop_hints_exists_pv(cop, key, hash, flags) \ +#define cop_hints_exists_pv(cop, key, hash, flags) \ cophh_exists_pv(CopHINTHASH_get(cop), key, hash, flags) -#define cop_hints_exists_sv(cop, key, hash, flags) \ +#define cop_hints_exists_sv(cop, key, hash, flags) \ cophh_exists_sv(CopHINTHASH_get(cop), key, hash, flags) /* =for apidoc Am|HV *|cop_hints_2hv|const COP *cop|U32 flags -Generates and returns a standard Perl hash representing the full set of -hint entries in the cop C. C is currently unused and must -be zero. +Generates and returns a standard Perl hash representing the full set of hint +entries in the cop C. C is currently unused and must be zero. =cut */ -#define cop_hints_2hv(cop, flags) \ +#define cop_hints_2hv(cop, flags) \ cophh_2hv(CopHINTHASH_get(cop), flags) /* @@ -763,176 +764,181 @@ be zero. These return the label attached to a cop. -C and C additionally store the number of -bytes comprising the returned label into C<*len>. +C and C additionally store the +number of bytes comprising the returned label into C<*len>. -C additionally returns the UTF-8ness of the returned label, -by setting C<*flags> to 0 or C. +C additionally returns the UTF-8ness of the +returned label, by setting C<*flags> to 0 or C. =cut */ -#define CopLABEL(c) Perl_cop_fetch_label(aTHX_ (c), NULL, NULL) -#define CopLABEL_len(c,len) Perl_cop_fetch_label(aTHX_ (c), len, NULL) -#define CopLABEL_len_flags(c,len,flags) Perl_cop_fetch_label(aTHX_ (c), len, flags) -#define CopLABEL_alloc(pv) ((pv)?savepv(pv):NULL) +#define CopLABEL(c) Perl_cop_fetch_label(aTHX_ (c), NULL, NULL) +#define CopLABEL_len(c,len) Perl_cop_fetch_label(aTHX_ (c), len, NULL) +#define CopLABEL_len_flags(c,len,flags) \ + Perl_cop_fetch_label(aTHX_ (c), len, flags) +#define CopLABEL_alloc(pv) ((pv)?savepv(pv):NULL) -#define CopSTASH_ne(c,hv) (!CopSTASH_eq(c,hv)) -#define CopLINE(c) ((c)->cop_line) -#define CopLINE_inc(c) (++CopLINE(c)) -#define CopLINE_dec(c) (--CopLINE(c)) -#define CopLINE_set(c,l) (CopLINE(c) = (l)) +#define CopSTASH_ne(c,hv) (!CopSTASH_eq(c,hv)) +#define CopLINE(c) ((c)->cop_line) +#define CopLINE_inc(c) (++CopLINE(c)) +#define CopLINE_dec(c) (--CopLINE(c)) +#define CopLINE_set(c,l) (CopLINE(c) = (l)) /* OutCopFILE() is CopFILE for output (caller, die, warn, etc.) */ -#define OutCopFILE(c) CopFILE(c) +#define OutCopFILE(c) CopFILE(c) -#define CopHINTS_get(c) ((c)->cop_hints + 0) -#define CopHINTS_set(c, h) STMT_START { \ - (c)->cop_hints = (h); \ - } STMT_END +#define CopHINTS_get(c) ((c)->cop_hints + 0) +#define CopHINTS_set(c, h) \ + STMT_START { \ + (c)->cop_hints = (h); \ + } STMT_END /* * Here we have some enormously heavy (or at least ponderous) wizardry. - */ +*/ /* subroutine context */ struct block_sub { - OP * retop; /* op to execute on exit from sub */ - I32 old_cxsubix; /* previous value of si_cxsubix */ - /* Above here is the same for sub, format and eval. */ - PAD *prevcomppad; /* the caller's PL_comppad */ - CV * cv; - /* Above here is the same for sub and format. */ - I32 olddepth; - AV *savearray; + OP *retop; /* op to execute on exit from sub */ + I32 old_cxsubix; /* previous value of si_cxsubix */ + /* Above here is the same for sub, format and eval. */ + PAD *prevcomppad; /* the caller's PL_comppad */ + CV *cv; + /* Above here is the same for sub and format. */ + I32 olddepth; + AV *savearray; }; /* format context */ struct block_format { - OP * retop; /* op to execute on exit from sub */ - I32 old_cxsubix; /* previous value of si_cxsubix */ - /* Above here is the same for sub, format and eval. */ - PAD *prevcomppad; /* the caller's PL_comppad */ - CV * cv; - /* Above here is the same for sub and format. */ - GV * gv; - GV * dfoutgv; + OP *retop; /* op to execute on exit from sub */ + I32 old_cxsubix; /* previous value of si_cxsubix */ + /* Above here is the same for sub, format and eval. */ + PAD *prevcomppad; /* the caller's PL_comppad */ + CV *cv; + /* Above here is the same for sub and format. */ + GV *gv; + GV *dfoutgv; }; /* return a pointer to the current context */ -#define CX_CUR() (&cxstack[cxstack_ix]) +#define CX_CUR() (&cxstack[cxstack_ix]) /* free all savestack items back to the watermark of the specified context */ -#define CX_LEAVE_SCOPE(cx) LEAVE_SCOPE(cx->blk_oldsaveix) +#define CX_LEAVE_SCOPE(cx) LEAVE_SCOPE(cx->blk_oldsaveix) #ifdef DEBUGGING /* on debugging builds, poison cx afterwards so we know no code - * uses it - because after doing cxstack_ix--, any ties, exceptions etc - * may overwrite the current stack frame */ -# define CX_POP(cx) \ - assert(CX_CUR() == cx); \ - cxstack_ix--; \ - cx = NULL; + * uses it - because after doing cxstack_ix--, any ties, + * exceptions etc may overwrite the current stack frame */ +# define CX_POP(cx) \ + assert(CX_CUR() == cx); \ + cxstack_ix--; \ + cx = NULL; #else -# define CX_POP(cx) cxstack_ix--; +# define CX_POP(cx) cxstack_ix--; #endif -#define CX_PUSHSUB_GET_LVALUE_MASK(func) \ - /* If the context is indeterminate, then only the lvalue */ \ - /* flags that the caller also has are applicable. */ \ - ( \ - (PL_op->op_flags & OPf_WANT) \ - ? OPpENTERSUB_LVAL_MASK \ - : !(PL_op->op_private & OPpENTERSUB_LVAL_MASK) \ - ? 0 : (U8)func(aTHX) \ - ) +#define CX_PUSHSUB_GET_LVALUE_MASK(func) \ + /* If the context is indeterminate, then only the lvalue */ \ + /* flags that the caller also has are applicable. */ \ + ( \ + (PL_op->op_flags & OPf_WANT) \ + ? OPpENTERSUB_LVAL_MASK \ + : !(PL_op->op_private & OPpENTERSUB_LVAL_MASK) \ + ? 0 : (U8)func(aTHX) \ + ) /* Restore old @_ */ -#define CX_POP_SAVEARRAY(cx) \ - STMT_START { \ - AV *cx_pop_savearray_av = GvAV(PL_defgv); \ - GvAV(PL_defgv) = cx->blk_sub.savearray; \ - cx->blk_sub.savearray = NULL; \ - SvREFCNT_dec(cx_pop_savearray_av); \ +#define CX_POP_SAVEARRAY(cx) \ + STMT_START { \ + AV *cx_pop_savearray_av = GvAV(PL_defgv); \ + GvAV(PL_defgv) = cx->blk_sub.savearray; \ + cx->blk_sub.savearray = NULL; \ + SvREFCNT_dec(cx_pop_savearray_av); \ } STMT_END -/* junk in @_ spells trouble when cloning CVs and in pp_caller(), so don't - * leave any (a fast av_clear(ary), basically) */ -#define CLEAR_ARGARRAY(ary) \ - STMT_START { \ - AvMAX(ary) += AvARRAY(ary) - AvALLOC(ary); \ - AvARRAY(ary) = AvALLOC(ary); \ - AvFILLp(ary) = -1; \ +/* junk in @_ spells trouble when cloning CVs and in pp_caller(), + * so don't leave any (a fast av_clear(ary), basically) */ +#define CLEAR_ARGARRAY(ary) \ + STMT_START { \ + AvMAX(ary) += AvARRAY(ary) - AvALLOC(ary); \ + AvARRAY(ary) = AvALLOC(ary); \ + AvFILLp(ary) = -1; \ } STMT_END /* eval context */ struct block_eval { - OP * retop; /* op to execute on exit from eval */ - I32 old_cxsubix; /* previous value of si_cxsubix */ - /* Above here is the same for sub, format and eval. */ - SV * old_namesv; - OP * old_eval_root; - SV * cur_text; - CV * cv; - JMPENV * cur_top_env; /* value of PL_top_env when eval CX created */ + OP *retop; /* op to execute on exit from eval */ + I32 old_cxsubix; /* previous value of si_cxsubix */ + /* Above here is the same for sub, format and eval. */ + SV *old_namesv; + OP *old_eval_root; + SV *cur_text; + CV *cv; + JMPENV *cur_top_env; /* value of PL_top_env when eval CX created */ }; -/* If we ever need more than 512 op types, change the shift from 7. - blku_gimme is actually also only 2 bits, so could be merged with something. -*/ +/* If we ever need more than 512 op types, change the shift from 7. blku_gimme + is actually also only 2 bits, so could be merged with something. + */ /* blk_u16 bit usage for eval contexts: */ -#define CxOLD_IN_EVAL(cx) (((cx)->blk_u16) & 0x3F) /* saved PL_in_eval */ -#define CxEVAL_TXT_REFCNTED(cx) (((cx)->blk_u16) & 0x40) /* cur_text rc++ */ -#define CxOLD_OP_TYPE(cx) (((cx)->blk_u16) >> 7) /* type of eval op */ +#define CxOLD_IN_EVAL(cx) (((cx)->blk_u16) & 0x3F) /* saved PL_in_eval */ +#define CxEVAL_TXT_REFCNTED(cx) (((cx)->blk_u16) & 0x40) /* cur_text rc++ */ +#define CxOLD_OP_TYPE(cx) (((cx)->blk_u16) >> 7) /* type of eval op */ /* loop context */ struct block_loop { - LOOP * my_op; /* My op, that contains redo, next and last ops. */ - union { /* different ways of locating the iteration variable */ - SV **svp; /* for lexicals: address of pad slot */ - GV *gv; /* for package vars */ - } itervar_u; - SV *itersave; /* the original iteration var */ + LOOP *my_op; /* My op, that contains redo, + next and last ops. */ + union { /* different ways of locating the iteration variable */ + SV **svp; /* for lexicals: address of pad slot */ + GV *gv; /* for package vars */ + } itervar_u; + SV *itersave; /* the original iteration var */ union { - struct { /* CXt_LOOP_ARY, C */ - AV *ary; /* array being iterated over */ - IV ix; /* index relative to base of array */ - } ary; + struct { /* CXt_LOOP_ARY, C */ + AV *ary; /* array being iterated over */ + IV ix; /* index relative to base of array */ + } ary; struct { /* CXt_LOOP_LIST, C */ I32 basesp; /* first element of list on stack */ - IV ix; /* index relative to basesp */ - } stack; + IV ix; /* index relative to basesp */ + } stack; struct { /* CXt_LOOP_LAZYIV, C */ - IV cur; - IV end; - } lazyiv; + IV cur; + IV end; + } lazyiv; struct { /* CXt_LOOP_LAZYSV C */ - SV * cur; - SV * end; /* maximum value (or minimum in reverse) */ - } lazysv; - } state_u; + SV *cur; + SV *end; /* maximum value (or minimum in reverse) */ + } lazysv; + } state_u; #ifdef USE_ITHREADS - PAD *oldcomppad; /* needed to map itervar_u.svp during thread clone */ + PAD *oldcomppad; /* needed to map itervar_u.svp + during thread clone */ #endif }; -#define CxITERVAR(c) \ - (CxPADLOOP(c) \ - ? (c)->blk_loop.itervar_u.svp \ - : ((c)->cx_type & CXp_FOR_GV) \ - ? &GvSV((c)->blk_loop.itervar_u.gv) \ - : (SV **)&(c)->blk_loop.itervar_u.gv) +#define CxITERVAR(c) \ + (CxPADLOOP(c) \ + ? (c)->blk_loop.itervar_u.svp \ + : ((c)->cx_type & CXp_FOR_GV) \ + ? &GvSV((c)->blk_loop.itervar_u.gv) \ + : (SV **)&(c)->blk_loop.itervar_u.gv) -#define CxLABEL(c) (CopLABEL((c)->blk_oldcop)) -#define CxLABEL_len(c,len) (CopLABEL_len((c)->blk_oldcop, len)) -#define CxLABEL_len_flags(c,len,flags) ((const char *)CopLABEL_len_flags((c)->blk_oldcop, len, flags)) -#define CxHASARGS(c) (((c)->cx_type & CXp_HASARGS) == CXp_HASARGS) +#define CxLABEL(c) (CopLABEL((c)->blk_oldcop)) +#define CxLABEL_len(c,len) (CopLABEL_len((c)->blk_oldcop, len)) +#define CxLABEL_len_flags(c,len,flags) \ + ((const char *)CopLABEL_len_flags((c)->blk_oldcop, len, flags)) +#define CxHASARGS(c) (((c)->cx_type & CXp_HASARGS) == CXp_HASARGS) /* CxLVAL(): the lval flags of the call site: the relevant flag bits from * the op_private field of the calling pp_entersub (or its caller's caller @@ -945,209 +951,210 @@ struct block_loop { * Note the contrast with CvLVALUE(), which is a property of the sub * rather than the call site. */ -#define CxLVAL(c) (0 + ((U8)((c)->blk_u16))) +#define CxLVAL(c) (0 + ((U8)((c)->blk_u16))) /* given/when context */ struct block_givwhen { - OP *leave_op; - SV *defsv_save; /* the original $_ */ + OP *leave_op; + SV *defsv_save; /* the original $_ */ }; /* context common to subroutines, evals and loops */ struct block { - U8 blku_type; /* what kind of context this is */ - U8 blku_gimme; /* is this block running in list context? */ - U16 blku_u16; /* used by block_sub and block_eval (so far) */ - I32 blku_oldsaveix; /* saved PL_savestack_ix */ + U8 blku_type; /* what kind of context this is */ + U8 blku_gimme; /* is this block running in list context? */ + U16 blku_u16; /* used by block_sub and block_eval (so far) */ + I32 blku_oldsaveix; /* saved PL_savestack_ix */ /* all the fields above must be aligned with same-sized fields as sbu */ - I32 blku_oldsp; /* current sp floor: where nextstate pops to */ - I32 blku_oldmarksp; /* mark stack index */ - COP * blku_oldcop; /* old curcop pointer */ - PMOP * blku_oldpm; /* values of pattern match vars */ - SSize_t blku_old_tmpsfloor; /* saved PL_tmps_floor */ - I32 blku_oldscopesp; /* scope stack index */ + I32 blku_oldsp; /* current sp floor: where nextstate pops to */ + I32 blku_oldmarksp; /* mark stack index */ + COP *blku_oldcop; /* old curcop pointer */ + PMOP *blku_oldpm; /* values of pattern match vars */ + SSize_t blku_old_tmpsfloor; /* saved PL_tmps_floor */ + I32 blku_oldscopesp; /* scope stack index */ union { - struct block_sub blku_sub; - struct block_format blku_format; - struct block_eval blku_eval; - struct block_loop blku_loop; - struct block_givwhen blku_givwhen; - } blk_u; + struct block_sub blku_sub; + struct block_format blku_format; + struct block_eval blku_eval; + struct block_loop blku_loop; + struct block_givwhen blku_givwhen; + } blk_u; }; -#define blk_oldsp cx_u.cx_blk.blku_oldsp -#define blk_oldcop cx_u.cx_blk.blku_oldcop -#define blk_oldmarksp cx_u.cx_blk.blku_oldmarksp -#define blk_oldscopesp cx_u.cx_blk.blku_oldscopesp -#define blk_oldpm cx_u.cx_blk.blku_oldpm -#define blk_gimme cx_u.cx_blk.blku_gimme -#define blk_u16 cx_u.cx_blk.blku_u16 -#define blk_oldsaveix cx_u.cx_blk.blku_oldsaveix -#define blk_old_tmpsfloor cx_u.cx_blk.blku_old_tmpsfloor -#define blk_sub cx_u.cx_blk.blk_u.blku_sub -#define blk_format cx_u.cx_blk.blk_u.blku_format -#define blk_eval cx_u.cx_blk.blk_u.blku_eval -#define blk_loop cx_u.cx_blk.blk_u.blku_loop -#define blk_givwhen cx_u.cx_blk.blk_u.blku_givwhen - -#define CX_DEBUG(cx, action) \ - DEBUG_l( \ - Perl_deb(aTHX_ "CX %ld %s %s (scope %ld,%ld) (save %ld,%ld) in %s at %s:%d\n",\ - (long)cxstack_ix, \ - action, \ - PL_block_type[CxTYPE(cx)], \ - (long)PL_scopestack_ix, \ - (long)(cx->blk_oldscopesp), \ - (long)PL_savestack_ix, \ - (long)(cx->blk_oldsaveix), \ +#define blk_oldsp cx_u.cx_blk.blku_oldsp +#define blk_oldcop cx_u.cx_blk.blku_oldcop +#define blk_oldmarksp cx_u.cx_blk.blku_oldmarksp +#define blk_oldscopesp cx_u.cx_blk.blku_oldscopesp +#define blk_oldpm cx_u.cx_blk.blku_oldpm +#define blk_gimme cx_u.cx_blk.blku_gimme +#define blk_u16 cx_u.cx_blk.blku_u16 +#define blk_oldsaveix cx_u.cx_blk.blku_oldsaveix +#define blk_old_tmpsfloor cx_u.cx_blk.blku_old_tmpsfloor +#define blk_sub cx_u.cx_blk.blk_u.blku_sub +#define blk_format cx_u.cx_blk.blk_u.blku_format +#define blk_eval cx_u.cx_blk.blk_u.blku_eval +#define blk_loop cx_u.cx_blk.blk_u.blku_loop +#define blk_givwhen cx_u.cx_blk.blk_u.blku_givwhen + +#define CX_DEBUG(cx, action) \ + DEBUG_l( \ + Perl_deb(aTHX_ "CX %ld %s %s (scope %ld,%ld) (save %ld,%ld) in %s at %s:%d\n", \ + (long)cxstack_ix, \ + action, \ + PL_block_type[CxTYPE(cx)], \ + (long)PL_scopestack_ix, \ + (long)(cx->blk_oldscopesp), \ + (long)PL_savestack_ix, \ + (long)(cx->blk_oldsaveix), \ SAFE_FUNCTION__, __FILE__, __LINE__)); /* substitution context */ struct subst { - U8 sbu_type; /* same as blku_type */ - U8 sbu_rflags; - U16 sbu_rxtainted; - I32 sbu_oldsaveix; /* same as blku_oldsaveix */ + U8 sbu_type; /* same as blku_type */ + U8 sbu_rflags; + U16 sbu_rxtainted; + I32 sbu_oldsaveix; /* same as blku_oldsaveix */ /* all the fields above must be aligned with same-sized fields as blk_u */ - SSize_t sbu_iters; - SSize_t sbu_maxiters; - char * sbu_orig; - SV * sbu_dstr; - SV * sbu_targ; - char * sbu_s; - char * sbu_m; - char * sbu_strend; - void * sbu_rxres; - REGEXP * sbu_rx; + SSize_t sbu_iters; + SSize_t sbu_maxiters; + char *sbu_orig; + SV *sbu_dstr; + SV *sbu_targ; + char *sbu_s; + char *sbu_m; + char *sbu_strend; + void *sbu_rxres; + REGEXP *sbu_rx; }; #ifdef PERL_CORE -#define sb_iters cx_u.cx_subst.sbu_iters -#define sb_maxiters cx_u.cx_subst.sbu_maxiters -#define sb_rflags cx_u.cx_subst.sbu_rflags -#define sb_rxtainted cx_u.cx_subst.sbu_rxtainted -#define sb_orig cx_u.cx_subst.sbu_orig -#define sb_dstr cx_u.cx_subst.sbu_dstr -#define sb_targ cx_u.cx_subst.sbu_targ -#define sb_s cx_u.cx_subst.sbu_s -#define sb_m cx_u.cx_subst.sbu_m -#define sb_strend cx_u.cx_subst.sbu_strend -#define sb_rxres cx_u.cx_subst.sbu_rxres -#define sb_rx cx_u.cx_subst.sbu_rx - -# define CX_PUSHSUBST(cx) CXINC, cx = CX_CUR(), \ - cx->blk_oldsaveix = oldsave, \ - cx->sb_iters = iters, \ - cx->sb_maxiters = maxiters, \ - cx->sb_rflags = r_flags, \ - cx->sb_rxtainted = rxtainted, \ - cx->sb_orig = orig, \ - cx->sb_dstr = dstr, \ - cx->sb_targ = targ, \ - cx->sb_s = s, \ - cx->sb_m = m, \ - cx->sb_strend = strend, \ - cx->sb_rxres = NULL, \ - cx->sb_rx = rx, \ - cx->cx_type = CXt_SUBST | (once ? CXp_ONCE : 0); \ - rxres_save(&cx->sb_rxres, rx); \ - (void)ReREFCNT_inc(rx); \ - SvREFCNT_inc_void_NN(targ) - -# define CX_POPSUBST(cx) \ - STMT_START { \ - REGEXP *re; \ - assert(CxTYPE(cx) == CXt_SUBST); \ - rxres_free(&cx->sb_rxres); \ - re = cx->sb_rx; \ - cx->sb_rx = NULL; \ - ReREFCNT_dec(re); \ - SvREFCNT_dec_NN(cx->sb_targ); \ - } STMT_END +#define sb_iters cx_u.cx_subst.sbu_iters +#define sb_maxiters cx_u.cx_subst.sbu_maxiters +#define sb_rflags cx_u.cx_subst.sbu_rflags +#define sb_rxtainted cx_u.cx_subst.sbu_rxtainted +#define sb_orig cx_u.cx_subst.sbu_orig +#define sb_dstr cx_u.cx_subst.sbu_dstr +#define sb_targ cx_u.cx_subst.sbu_targ +#define sb_s cx_u.cx_subst.sbu_s +#define sb_m cx_u.cx_subst.sbu_m +#define sb_strend cx_u.cx_subst.sbu_strend +#define sb_rxres cx_u.cx_subst.sbu_rxres +#define sb_rx cx_u.cx_subst.sbu_rx + +# define CX_PUSHSUBST(cx) \ + CXINC, cx = CX_CUR(), \ + cx->blk_oldsaveix = oldsave, \ + cx->sb_iters = iters, \ + cx->sb_maxiters = maxiters, \ + cx->sb_rflags = r_flags, \ + cx->sb_rxtainted = rxtainted, \ + cx->sb_orig = orig, \ + cx->sb_dstr = dstr, \ + cx->sb_targ = targ, \ + cx->sb_s = s, \ + cx->sb_m = m, \ + cx->sb_strend = strend, \ + cx->sb_rxres = NULL, \ + cx->sb_rx = rx, \ + cx->cx_type = CXt_SUBST | (once ? CXp_ONCE : 0); \ + rxres_save(&cx->sb_rxres, rx); \ + (void)ReREFCNT_inc(rx); \ + SvREFCNT_inc_void_NN(targ) + +# define CX_POPSUBST(cx) \ + STMT_START { \ + REGEXP *re; \ + assert(CxTYPE(cx) == CXt_SUBST); \ + rxres_free(&cx->sb_rxres); \ + re = cx->sb_rx; \ + cx->sb_rx = NULL; \ + ReREFCNT_dec(re); \ + SvREFCNT_dec_NN(cx->sb_targ); \ + } STMT_END #endif -#define CxONCE(cx) ((cx)->cx_type & CXp_ONCE) +#define CxONCE(cx) ((cx)->cx_type & CXp_ONCE) struct context { union { - struct block cx_blk; - struct subst cx_subst; - } cx_u; + struct block cx_blk; + struct subst cx_subst; + } cx_u; }; -#define cx_type cx_u.cx_subst.sbu_type - -/* If you re-order these, there is also an array of uppercase names in perl.h - and a static array of context names in pp_ctl.c */ -#define CXTYPEMASK 0xf -#define CXt_NULL 0 /* currently only used for sort BLOCK */ -#define CXt_WHEN 1 -#define CXt_BLOCK 2 -/* When micro-optimising :-) keep GIVEN next to the LOOPs, as these 5 share a - jump table in pp_ctl.c - The first 4 don't have a 'case' in at least one switch statement in pp_ctl.c -*/ -#define CXt_GIVEN 3 - -/* be careful of the ordering of these five. Macros like CxTYPE_is_LOOP, - * CxFOREACH compare ranges */ -#define CXt_LOOP_ARY 4 /* for (@ary) { ...; } */ -#define CXt_LOOP_LAZYSV 5 /* for ('a'..'z') { ...; } */ -#define CXt_LOOP_LAZYIV 6 /* for (1..9) { ...; } */ -#define CXt_LOOP_LIST 7 /* for (1,2,3) { ...; } */ -#define CXt_LOOP_PLAIN 8 /* while (...) { ...; } +#define cx_type cx_u.cx_subst.sbu_type + +/* If you re-order these, there is also an array of uppercase names + in perl.h and a static array of context names in pp_ctl.c */ +#define CXTYPEMASK 0xf +#define CXt_NULL 0 /* currently only used for sort BLOCK */ +#define CXt_WHEN 1 +#define CXt_BLOCK 2 +/* When micro-optimising :-) keep GIVEN next to the LOOPs, as + these 5 share a jump table in pp_ctl.c The first 4 don't have + a 'case' in at least one switch statement in pp_ctl.c + */ +#define CXt_GIVEN 3 + +/* be careful of the ordering of these five. Macros + * like CxTYPE_is_LOOP, CxFOREACH compare ranges */ +#define CXt_LOOP_ARY 4 /* for (@ary) { ...; } */ +#define CXt_LOOP_LAZYSV 5 /* for ('a'..'z') { ...; } */ +#define CXt_LOOP_LAZYIV 6 /* for (1..9) { ...; } */ +#define CXt_LOOP_LIST 7 /* for (1,2,3) { ...; } */ +#define CXt_LOOP_PLAIN 8 /* while (...) { ...; } or plain block { ...; } */ -#define CXt_SUB 9 -#define CXt_FORMAT 10 -#define CXt_EVAL 11 /* eval'', eval{}, try{} */ -#define CXt_SUBST 12 -#define CXt_DEFER 13 -/* SUBST doesn't feature in all switch statements. */ +#define CXt_SUB 9 +#define CXt_FORMAT 10 +#define CXt_EVAL 11 /* eval'', eval{}, try{} */ +#define CXt_SUBST 12 +#define CXt_DEFER 13 +/* SUBST doesn't feature in all switch statements. */ /* private flags for CXt_SUB and CXt_FORMAT */ -#define CXp_MULTICALL 0x10 /* part of a multicall (so don't tear down - context on exit). (not CXt_FORMAT) */ -#define CXp_HASARGS 0x20 -#define CXp_SUB_RE 0x40 /* code called within regex, i.e. (?{}) */ -#define CXp_SUB_RE_FAKE 0x80 /* fake sub CX for (?{}) in current scope */ +#define CXp_MULTICALL 0x10 /* part of a multicall (so don't tear down + context on exit). (not CXt_FORMAT) */ +#define CXp_HASARGS 0x20 +#define CXp_SUB_RE 0x40 /* code called within regex, i.e. (?{}) */ +#define CXp_SUB_RE_FAKE 0x80 /* fake sub CX for (?{}) in current scope */ /* private flags for CXt_EVAL */ -#define CXp_REAL 0x20 /* truly eval'', not a lookalike */ -#define CXp_EVALBLOCK 0x40 /* eval{}, not eval'' or similar */ +#define CXp_REAL 0x20 /* truly eval'', not a lookalike */ +#define CXp_EVALBLOCK 0x40 /* eval{}, not eval'' or similar */ #define CXp_TRY 0x80 /* try {} block */ /* private flags for CXt_LOOP */ /* this is only set in conjunction with CXp_FOR_GV */ -#define CXp_FOR_DEF 0x10 /* foreach using $_ */ +#define CXp_FOR_DEF 0x10 /* foreach using $_ */ /* these 3 are mutually exclusive */ -#define CXp_FOR_LVREF 0x20 /* foreach using \$var */ -#define CXp_FOR_GV 0x40 /* foreach using package var */ -#define CXp_FOR_PAD 0x80 /* foreach using lexical var */ +#define CXp_FOR_LVREF 0x20 /* foreach using \$var */ +#define CXp_FOR_GV 0x40 /* foreach using package var */ +#define CXp_FOR_PAD 0x80 /* foreach using lexical var */ -#define CxPADLOOP(c) ((c)->cx_type & CXp_FOR_PAD) +#define CxPADLOOP(c) ((c)->cx_type & CXp_FOR_PAD) /* private flags for CXt_SUBST */ -#define CXp_ONCE 0x10 /* What was sbu_once in struct subst */ - -#define CxTYPE(c) ((c)->cx_type & CXTYPEMASK) -#define CxTYPE_is_LOOP(c) ( CxTYPE(cx) >= CXt_LOOP_ARY \ - && CxTYPE(cx) <= CXt_LOOP_PLAIN) -#define CxMULTICALL(c) ((c)->cx_type & CXp_MULTICALL) -#define CxREALEVAL(c) (((c)->cx_type & (CXTYPEMASK|CXp_REAL)) \ - == (CXt_EVAL|CXp_REAL)) -#define CxEVALBLOCK(c) (((c)->cx_type & (CXTYPEMASK|CXp_EVALBLOCK)) \ - == (CXt_EVAL|CXp_EVALBLOCK)) -#define CxTRY(c) (((c)->cx_type & (CXTYPEMASK|CXp_TRY)) \ - == (CXt_EVAL|CXp_TRY)) -#define CxFOREACH(c) ( CxTYPE(cx) >= CXt_LOOP_ARY \ - && CxTYPE(cx) <= CXt_LOOP_LIST) +#define CXp_ONCE 0x10 /* What was sbu_once in struct subst */ + +#define CxTYPE(c) ((c)->cx_type & CXTYPEMASK) +#define CxTYPE_is_LOOP(c) \ + ( CxTYPE(cx) >= CXt_LOOP_ARY && CxTYPE(cx) <= CXt_LOOP_PLAIN) +#define CxMULTICALL(c) ((c)->cx_type & CXp_MULTICALL) +#define CxREALEVAL(c) \ + (((c)->cx_type & (CXTYPEMASK|CXp_REAL)) == (CXt_EVAL|CXp_REAL)) +#define CxEVALBLOCK(c) \ + (((c)->cx_type & (CXTYPEMASK|CXp_EVALBLOCK)) == (CXt_EVAL|CXp_EVALBLOCK)) +#define CxTRY(c) \ + (((c)->cx_type & (CXTYPEMASK|CXp_TRY)) == (CXt_EVAL|CXp_TRY)) +#define CxFOREACH(c) \ + ( CxTYPE(cx) >= CXt_LOOP_ARY && CxTYPE(cx) <= CXt_LOOP_LIST) /* private flags for CXt_DEFER */ #define CXp_FINALLY 0x20 /* `finally` block; semantically identical @@ -1157,82 +1164,86 @@ struct context { #define CXp_TRYBLOCK CXp_EVALBLOCK #define CxTRYBLOCK(c) CxEVALBLOCK(c) -#define CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc())) +#define CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc())) -#define G_SCALAR 2 -#define G_LIST 3 -#define G_VOID 1 -#define G_WANT 3 +#define G_SCALAR 2 +#define G_LIST 3 +#define G_VOID 1 +#define G_WANT 3 #ifndef PERL_CORE /* name prior to 5.31.1 */ -# define G_ARRAY G_LIST +# define G_ARRAY G_LIST #endif /* extra flags for Perl_call_* routines */ -#define G_DISCARD 0x4 /* Call FREETMPS. - Don't change this without consulting the - hash actions codes defined in hv.h */ -#define G_EVAL 0x8 /* Assume eval {} around subroutine call. */ -#define G_NOARGS 0x10 /* Don't construct a @_ array. */ -#define G_KEEPERR 0x20 /* Warn for errors, don't overwrite $@ */ -#define G_NODEBUG 0x40 /* Disable debugging at toplevel. */ -#define G_METHOD 0x80 /* Calling method. */ -#define G_FAKINGEVAL 0x100 /* Faking an eval context for call_sv or - fold_constants. */ -#define G_UNDEF_FILL 0x200 /* Fill the stack with &PL_sv_undef - A special case for UNSHIFT in - Perl_magic_methcall(). */ -#define G_WRITING_TO_STDERR 0x400 /* Perl_write_to_stderr() is calling - Perl_magic_methcall(). */ -#define G_RE_REPARSING 0x800 /* compiling a run-time /(?{..})/ */ -#define G_METHOD_NAMED 0x1000 /* calling named method, eg without :: or ' */ -#define G_RETHROW 0x2000 /* eval_sv(): re-throw any error */ +#define G_DISCARD 0x4 /* Call FREETMPS. Don't change this + without consulting the hash + actions codes defined in hv.h */ +#define G_EVAL 0x8 /* Assume eval {} around + subroutine call. */ +#define G_NOARGS 0x10 /* Don't construct a @_ array. */ +#define G_KEEPERR 0x20 /* Warn for errors, don't overwrite $@ */ +#define G_NODEBUG 0x40 /* Disable debugging at toplevel. */ +#define G_METHOD 0x80 /* Calling method. */ +#define G_FAKINGEVAL 0x100 /* Faking an eval context for call_sv + or fold_constants. */ +#define G_UNDEF_FILL 0x200 /* Fill the stack with &PL_sv_undef + A special case for UNSHIFT in + Perl_magic_methcall(). */ +#define G_WRITING_TO_STDERR 0x400 /* Perl_write_to_stderr() is calling + Perl_magic_methcall(). */ +#define G_RE_REPARSING 0x800 /* compiling a run-time /(?{..})/ */ +#define G_METHOD_NAMED 0x1000 /* calling named method, eg + without :: or ' */ +#define G_RETHROW 0x2000 /* eval_sv(): re-throw any error */ /* flag bits for PL_in_eval */ -#define EVAL_NULL 0 /* not in an eval */ -#define EVAL_INEVAL 1 /* some enclosing scope is an eval */ -#define EVAL_WARNONLY 2 /* used by yywarn() when calling yyerror() */ -#define EVAL_KEEPERR 4 /* set by Perl_call_sv if G_KEEPERR */ -#define EVAL_INREQUIRE 8 /* The code is being required. */ -#define EVAL_RE_REPARSING 0x10 /* eval_sv() called with G_RE_REPARSING */ +#define EVAL_NULL 0 /* not in an eval */ +#define EVAL_INEVAL 1 /* some enclosing scope is an eval */ +#define EVAL_WARNONLY 2 /* used by yywarn() when + calling yyerror() */ +#define EVAL_KEEPERR 4 /* set by Perl_call_sv if G_KEEPERR */ +#define EVAL_INREQUIRE 8 /* The code is being required. */ +#define EVAL_RE_REPARSING 0x10 /* eval_sv() called with G_RE_REPARSING */ /* if adding extra bits, make sure they can fit in CxOLD_OP_TYPE() */ -/* Support for switching (stack and block) contexts. - * This ensures magic doesn't invalidate local stack and cx pointers. - * Which one to use (or add) is mostly, but not completely arbitrary: See - * http://nntp.perl.org/group/perl.perl5.porters/257169 +/* Support for switching (stack and block) contexts. This ensures + * magic doesn't invalidate local stack and cx pointers. Which + * one to use (or add) is mostly, but not completely arbitrary: + * See http://nntp.perl.org/group/perl.perl5.porters/257169 */ -#define PERLSI_UNKNOWN -1 -#define PERLSI_UNDEF 0 -#define PERLSI_MAIN 1 -#define PERLSI_MAGIC 2 -#define PERLSI_SORT 3 -#define PERLSI_SIGNAL 4 -#define PERLSI_OVERLOAD 5 -#define PERLSI_DESTROY 6 -#define PERLSI_WARNHOOK 7 -#define PERLSI_DIEHOOK 8 -#define PERLSI_REQUIRE 9 -#define PERLSI_MULTICALL 10 -#define PERLSI_REGCOMP 11 +#define PERLSI_UNKNOWN -1 +#define PERLSI_UNDEF 0 +#define PERLSI_MAIN 1 +#define PERLSI_MAGIC 2 +#define PERLSI_SORT 3 +#define PERLSI_SIGNAL 4 +#define PERLSI_OVERLOAD 5 +#define PERLSI_DESTROY 6 +#define PERLSI_WARNHOOK 7 +#define PERLSI_DIEHOOK 8 +#define PERLSI_REQUIRE 9 +#define PERLSI_MULTICALL 10 +#define PERLSI_REGCOMP 11 struct stackinfo { - AV * si_stack; /* stack for current runlevel */ - PERL_CONTEXT * si_cxstack; /* context stack for runlevel */ - struct stackinfo * si_prev; - struct stackinfo * si_next; - I32 si_cxix; /* current context index */ - I32 si_cxmax; /* maximum allocated index */ - I32 si_cxsubix; /* topmost sub/eval/format */ - I32 si_type; /* type of runlevel */ - I32 si_markoff; /* offset where markstack begins for us. - * currently used only with DEBUGGING, - * but not #ifdef-ed for bincompat */ + AV *si_stack; /* stack for current runlevel */ + PERL_CONTEXT *si_cxstack; /* context stack for runlevel */ + struct stackinfo *si_prev; + struct stackinfo *si_next; + I32 si_cxix; /* current context index */ + I32 si_cxmax; /* maximum allocated index */ + I32 si_cxsubix; /* topmost sub/eval/format */ + I32 si_type; /* type of runlevel */ + I32 si_markoff; /* offset where markstack begins + * for us. currently used only + * with DEBUGGING, but not + * #ifdef-ed for bincompat */ #if defined DEBUGGING && !defined DEBUGGING_RE_ONLY -/* high water mark: for checking if the stack was correctly extended / - * tested for extension by each pp function */ + /* high water mark: for checking if the stack was correctly + * extended / tested for extension by each pp function */ SSize_t si_stack_hwm; #endif @@ -1246,182 +1257,183 @@ Use this typedef to declare variables that are to hold C. */ typedef struct stackinfo PERL_SI; -#define cxstack (PL_curstackinfo->si_cxstack) -#define cxstack_ix (PL_curstackinfo->si_cxix) -#define cxstack_max (PL_curstackinfo->si_cxmax) +#define cxstack (PL_curstackinfo->si_cxstack) +#define cxstack_ix (PL_curstackinfo->si_cxix) +#define cxstack_max (PL_curstackinfo->si_cxmax) #ifdef DEBUGGING -# define SET_MARK_OFFSET \ - PL_curstackinfo->si_markoff = PL_markstack_ptr - PL_markstack +# define SET_MARK_OFFSET \ + PL_curstackinfo->si_markoff = PL_markstack_ptr - PL_markstack #else -# define SET_MARK_OFFSET NOOP +# define SET_MARK_OFFSET NOOP #endif #if defined DEBUGGING && !defined DEBUGGING_RE_ONLY -# define PUSHSTACK_INIT_HWM(si) ((si)->si_stack_hwm = 0) +# define PUSHSTACK_INIT_HWM(si) ((si)->si_stack_hwm = 0) #else -# define PUSHSTACK_INIT_HWM(si) NOOP +# define PUSHSTACK_INIT_HWM(si) NOOP #endif -#define PUSHSTACKi(type) \ - STMT_START { \ - PERL_SI *next = PL_curstackinfo->si_next; \ - DEBUG_l({ \ - int i = 0; PERL_SI *p = PL_curstackinfo; \ - while (p) { i++; p = p->si_prev; } \ +#define PUSHSTACKi(type) \ + STMT_START { \ + PERL_SI *next = PL_curstackinfo->si_next; \ + DEBUG_l({ \ + int i = 0; PERL_SI *p = PL_curstackinfo; \ + while (p) { i++; p = p->si_prev; } \ Perl_deb(aTHX_ "push STACKINFO %d in %s at %s:%d\n", \ - i, SAFE_FUNCTION__, __FILE__, __LINE__);}) \ - if (!next) { \ - next = new_stackinfo(32, 2048/sizeof(PERL_CONTEXT) - 1); \ - next->si_prev = PL_curstackinfo; \ - PL_curstackinfo->si_next = next; \ - } \ - next->si_type = type; \ - next->si_cxix = -1; \ - next->si_cxsubix = -1; \ + i, SAFE_FUNCTION__, __FILE__, __LINE__);}) \ + if (!next) { \ + next = new_stackinfo(32, 2048/sizeof(PERL_CONTEXT) - 1); \ + next->si_prev = PL_curstackinfo; \ + PL_curstackinfo->si_next = next; \ + } \ + next->si_type = type; \ + next->si_cxix = -1; \ + next->si_cxsubix = -1; \ PUSHSTACK_INIT_HWM(next); \ - AvFILLp(next->si_stack) = 0; \ - SWITCHSTACK(PL_curstack,next->si_stack); \ - PL_curstackinfo = next; \ - SET_MARK_OFFSET; \ + AvFILLp(next->si_stack) = 0; \ + SWITCHSTACK(PL_curstack,next->si_stack); \ + PL_curstackinfo = next; \ + SET_MARK_OFFSET; \ } STMT_END -#define PUSHSTACK PUSHSTACKi(PERLSI_UNKNOWN) +#define PUSHSTACK PUSHSTACKi(PERLSI_UNKNOWN) /* POPSTACK works with PL_stack_sp, so it may need to be bracketed by * PUTBACK/SPAGAIN to flush/refresh any local SP that may be active */ -#define POPSTACK \ - STMT_START { \ - dSP; \ - PERL_SI * const prev = PL_curstackinfo->si_prev; \ - DEBUG_l({ \ - int i = -1; PERL_SI *p = PL_curstackinfo; \ - while (p) { i++; p = p->si_prev; } \ - Perl_deb(aTHX_ "pop STACKINFO %d in %s at %s:%d\n", \ - i, SAFE_FUNCTION__, __FILE__, __LINE__);}) \ - if (!prev) { \ - Perl_croak_popstack(); \ - } \ - SWITCHSTACK(PL_curstack,prev->si_stack); \ - /* don't free prev here, free them all at the END{} */ \ - PL_curstackinfo = prev; \ +#define POPSTACK \ + STMT_START { \ + dSP; \ + PERL_SI * const prev = PL_curstackinfo->si_prev; \ + DEBUG_l({ \ + int i = -1; PERL_SI *p = PL_curstackinfo; \ + while (p) { i++; p = p->si_prev; } \ + Perl_deb(aTHX_ "pop STACKINFO %d in %s at %s:%d\n", \ + i, SAFE_FUNCTION__, __FILE__, __LINE__);}) \ + if (!prev) { \ + Perl_croak_popstack(); \ + } \ + SWITCHSTACK(PL_curstack,prev->si_stack); \ + /* don't free prev here, free them all at the END{} */ \ + PL_curstackinfo = prev; \ } STMT_END -#define POPSTACK_TO(s) \ - STMT_START { \ - while (PL_curstack != s) { \ - dounwind(-1); \ - POPSTACK; \ - } \ +#define POPSTACK_TO(s) \ + STMT_START { \ + while (PL_curstack != s) { \ + dounwind(-1); \ + POPSTACK; \ + } \ } STMT_END /* =for apidoc_section $utility =for apidoc Amn|bool|IN_PERL_COMPILETIME -Returns 1 if this macro is being called during the compilation phase of the -program; otherwise 0; +Returns 1 if this macro is being called during the +compilation phase of the program; otherwise 0; =for apidoc Amn|bool|IN_PERL_RUNTIME -Returns 1 if this macro is being called during the execution phase of the -program; otherwise 0; +Returns 1 if this macro is being called during the +execution phase of the program; otherwise 0; =cut */ -#define IN_PERL_COMPILETIME cBOOL(PL_curcop == &PL_compiling) -#define IN_PERL_RUNTIME cBOOL(PL_curcop != &PL_compiling) +#define IN_PERL_COMPILETIME cBOOL(PL_curcop == &PL_compiling) +#define IN_PERL_RUNTIME cBOOL(PL_curcop != &PL_compiling) /* =for apidoc_section $multicall =for apidoc Amn;||dMULTICALL -Declare local variables for a multicall. See L. +Declare local variables for a multicall. See +L. =for apidoc Am;||PUSH_MULTICALL|CV* the_cv -Opening bracket for a lightweight callback. -See L. +Opening bracket for a lightweight callback. See +L. =for apidoc Amn;||MULTICALL Make a lightweight callback. See L. =for apidoc Amn;||POP_MULTICALL -Closing bracket for a lightweight callback. -See L. +Closing bracket for a lightweight callback. See +L. =cut */ -#define dMULTICALL \ - OP *multicall_cop; \ +#define dMULTICALL \ + OP *multicall_cop; \ bool multicall_oldcatch -#define PUSH_MULTICALL(the_cv) \ +#define PUSH_MULTICALL(the_cv) \ PUSH_MULTICALL_FLAGS(the_cv, 0) -/* Like PUSH_MULTICALL, but allows you to specify extra flags - * for the CX stack entry (this isn't part of the public API) */ - -#define PUSH_MULTICALL_FLAGS(the_cv, flags) \ - STMT_START { \ - PERL_CONTEXT *cx; \ - CV * const _nOnclAshIngNamE_ = the_cv; \ - CV * const cv = _nOnclAshIngNamE_; \ - PADLIST * const padlist = CvPADLIST(cv); \ - multicall_oldcatch = CATCH_GET; \ - CATCH_SET(TRUE); \ - PUSHSTACKi(PERLSI_MULTICALL); \ - cx = cx_pushblock((CXt_SUB|CXp_MULTICALL|flags), (U8)gimme, \ - PL_stack_sp, PL_savestack_ix); \ - cx_pushsub(cx, cv, NULL, 0); \ - SAVEOP(); \ - if (!(flags & CXp_SUB_RE_FAKE)) \ - CvDEPTH(cv)++; \ - if (CvDEPTH(cv) >= 2) \ - Perl_pad_push(aTHX_ padlist, CvDEPTH(cv)); \ - PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv)); \ - multicall_cop = CvSTART(cv); \ +/* Like PUSH_MULTICALL, but allows you to specify extra flags for + * the CX stack entry (this isn't part of the public API) */ + +#define PUSH_MULTICALL_FLAGS(the_cv, flags) \ + STMT_START { \ + PERL_CONTEXT *cx; \ + CV * const _nOnclAshIngNamE_ = the_cv; \ + CV * const cv = _nOnclAshIngNamE_; \ + PADLIST * const padlist = CvPADLIST(cv); \ + multicall_oldcatch = CATCH_GET; \ + CATCH_SET(TRUE); \ + PUSHSTACKi(PERLSI_MULTICALL); \ + cx = cx_pushblock((CXt_SUB|CXp_MULTICALL|flags), (U8)gimme, \ + PL_stack_sp, PL_savestack_ix); \ + cx_pushsub(cx, cv, NULL, 0); \ + SAVEOP(); \ + if (!(flags & CXp_SUB_RE_FAKE)) \ + CvDEPTH(cv)++; \ + if (CvDEPTH(cv) >= 2) \ + Perl_pad_push(aTHX_ padlist, CvDEPTH(cv)); \ + PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv)); \ + multicall_cop = CvSTART(cv); \ } STMT_END -#define MULTICALL \ - STMT_START { \ - PL_op = multicall_cop; \ - CALLRUNOPS(aTHX); \ +#define MULTICALL \ + STMT_START { \ + PL_op = multicall_cop; \ + CALLRUNOPS(aTHX); \ } STMT_END -#define POP_MULTICALL \ - STMT_START { \ - PERL_CONTEXT *cx; \ - cx = CX_CUR(); \ - CX_LEAVE_SCOPE(cx); \ - cx_popsub_common(cx); \ - gimme = cx->blk_gimme; \ - PERL_UNUSED_VAR(gimme); /* for API */ \ - cx_popblock(cx); \ - CX_POP(cx); \ - POPSTACK; \ - CATCH_SET(multicall_oldcatch); \ - SPAGAIN; \ +#define POP_MULTICALL \ + STMT_START { \ + PERL_CONTEXT *cx; \ + cx = CX_CUR(); \ + CX_LEAVE_SCOPE(cx); \ + cx_popsub_common(cx); \ + gimme = cx->blk_gimme; \ + PERL_UNUSED_VAR(gimme); /* for API */ \ + cx_popblock(cx); \ + CX_POP(cx); \ + POPSTACK; \ + CATCH_SET(multicall_oldcatch); \ + SPAGAIN; \ } STMT_END -/* Change the CV of an already-pushed MULTICALL CxSUB block. - * (this isn't part of the public API) */ - -#define CHANGE_MULTICALL_FLAGS(the_cv, flags) \ - STMT_START { \ - CV * const _nOnclAshIngNamE_ = the_cv; \ - CV * const cv = _nOnclAshIngNamE_; \ - PADLIST * const padlist = CvPADLIST(cv); \ - PERL_CONTEXT *cx = CX_CUR(); \ - assert(CxMULTICALL(cx)); \ - cx_popsub_common(cx); \ - cx->cx_type = (CXt_SUB|CXp_MULTICALL|flags); \ - cx_pushsub(cx, cv, NULL, 0); \ - if (!(flags & CXp_SUB_RE_FAKE)) \ - CvDEPTH(cv)++; \ - if (CvDEPTH(cv) >= 2) \ - Perl_pad_push(aTHX_ padlist, CvDEPTH(cv)); \ - PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv)); \ - multicall_cop = CvSTART(cv); \ +/* Change the CV of an already-pushed MULTICALL CxSUB + * block. (this isn't part of the public API) */ + +#define CHANGE_MULTICALL_FLAGS(the_cv, flags) \ + STMT_START { \ + CV * const _nOnclAshIngNamE_ = the_cv; \ + CV * const cv = _nOnclAshIngNamE_; \ + PADLIST * const padlist = CvPADLIST(cv); \ + PERL_CONTEXT *cx = CX_CUR(); \ + assert(CxMULTICALL(cx)); \ + cx_popsub_common(cx); \ + cx->cx_type = (CXt_SUB|CXp_MULTICALL|flags); \ + cx_pushsub(cx, cv, NULL, 0); \ + if (!(flags & CXp_SUB_RE_FAKE)) \ + CvDEPTH(cv)++; \ + if (CvDEPTH(cv) >= 2) \ + Perl_pad_push(aTHX_ padlist, CvDEPTH(cv)); \ + PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv)); \ + multicall_cop = CvSTART(cv); \ } STMT_END /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/cv.h b/cv.h index 7a813f6fa19c..a250510a6b6e 100644 --- a/cv.h +++ b/cv.h @@ -1,14 +1,15 @@ /* cv.h * - * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1999, 2000, 2001, - * 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others + * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1999, 2000, + * 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, + * 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021, 2022 by + * Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * */ -/* This structure must match the beginning of XPVFM in sv.h */ +/* This structure must match the beginning of XPVFM in sv.h */ struct xpvcv { _XPV_HEAD; @@ -25,211 +26,221 @@ Null CV pointer. =for apidoc Am|HV*|CvSTASH|CV* cv Returns the stash of the CV. A stash is the symbol table hash, containing -the package-scoped variables in the package where the subroutine was defined. -For more information, see L. +the package-scoped variables in the package where the subroutine was +defined. For more information, see L. -This also has a special use with XS AUTOLOAD subs. -See L. +This also has a special use with XS AUTOLOAD subs. See +L. =cut */ #ifndef PERL_CORE -# define Nullcv Null(CV*) +# define Nullcv Null(CV*) #endif -#define CvSTASH(sv) (MUTABLE_HV(((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_stash)) -#define CvSTASH_set(cv,st) Perl_cvstash_set(aTHX_ cv, st) -#define CvSTART(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_start_u.xcv_start -#define CvROOT(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_root_u.xcv_root -#define CvXSUB(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_root_u.xcv_xsub -#define CvXSUBANY(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_start_u.xcv_xsubany -#define CvGV(sv) Perl_CvGV(aTHX_ (CV *)(sv)) -#define CvGV_set(cv,gv) Perl_cvgv_set(aTHX_ cv, gv) -#define CvHASGV(cv) cBOOL(SvANY(cv)->xcv_gv_u.xcv_gv) -#define CvFILE(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_file +#define CvSTASH(sv) \ + (MUTABLE_HV(((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_stash)) +#define CvSTASH_set(cv,st) Perl_cvstash_set(aTHX_ cv, st) +#define CvSTART(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_start_u.xcv_start +#define CvROOT(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_root_u.xcv_root +#define CvXSUB(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_root_u.xcv_xsub +#define CvXSUBANY(sv) \ + ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_start_u.xcv_xsubany +#define CvGV(sv) Perl_CvGV(aTHX_ (CV *)(sv)) +#define CvGV_set(cv,gv) Perl_cvgv_set(aTHX_ cv, gv) +#define CvHASGV(cv) cBOOL(SvANY(cv)->xcv_gv_u.xcv_gv) +#define CvFILE(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_file #ifdef USE_ITHREADS -# define CvFILE_set_from_cop(sv, cop) \ - (CvFILE(sv) = savepv(CopFILE(cop)), CvDYNFILE_on(sv)) +# define CvFILE_set_from_cop(sv, cop) \ + (CvFILE(sv) = savepv(CopFILE(cop)), CvDYNFILE_on(sv)) #else -# define CvFILE_set_from_cop(sv, cop) \ - (CvFILE(sv) = CopFILE(cop), CvDYNFILE_off(sv)) +# define CvFILE_set_from_cop(sv, cop) \ + (CvFILE(sv) = CopFILE(cop), CvDYNFILE_off(sv)) #endif -#define CvFILEGV(sv) (gv_fetchfile(CvFILE(sv))) -#define CvDEPTH(sv) (*Perl_CvDEPTH((const CV *)sv)) -/* For use when you only have a XPVCV*, not a real CV*. - Must be assert protected as in Perl_CvDEPTH before use. */ -#define CvDEPTHunsafe(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_depth - -/* these CvPADLIST/CvRESERVED asserts can be reverted one day, once stabilized */ -#define CvPADLIST(sv) (*(assert_(!CvISXSUB((CV*)(sv))) \ +#define CvFILEGV(sv) (gv_fetchfile(CvFILE(sv))) +#define CvDEPTH(sv) (*Perl_CvDEPTH((const CV *)sv)) +/* For use when you only have a XPVCV*, not a real CV*. Must + be assert protected as in Perl_CvDEPTH before use. */ +#define CvDEPTHunsafe(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_depth + +/* these CvPADLIST/CvRESERVED asserts can be + reverted one day, once stabilized */ +#define CvPADLIST(sv) \ + (*(assert_(!CvISXSUB((CV*)(sv))) \ &(((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_padlist_u.xcv_padlist))) -/* CvPADLIST_set is not public API, it can be removed one day, once stabilized */ +/* CvPADLIST_set is not public API, it can + be removed one day, once stabilized */ #ifdef DEBUGGING -# define CvPADLIST_set(sv, padlist) Perl_set_padlist((CV*)sv, padlist) +# define CvPADLIST_set(sv, padlist) Perl_set_padlist((CV*)sv, padlist) #else -# define CvPADLIST_set(sv, padlist) (CvPADLIST(sv) = (padlist)) +# define CvPADLIST_set(sv, padlist) (CvPADLIST(sv) = (padlist)) #endif -#define CvHSCXT(sv) *(assert_(CvISXSUB((CV*)(sv))) \ +#define CvHSCXT(sv) \ + *(assert_(CvISXSUB((CV*)(sv))) \ &(((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_padlist_u.xcv_hscxt)) #ifdef DEBUGGING # if PTRSIZE == 8 -# define PoisonPADLIST(sv) \ - (((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_padlist_u.xcv_padlist = (PADLIST *)UINT64_C(0xEFEFEFEFEFEFEFEF)) +# define PoisonPADLIST(sv) \ + (((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_padlist_u.xcv_padlist = (PADLIST *)UINT64_C(0xEFEFEFEFEFEFEFEF)) # elif PTRSIZE == 4 -# define PoisonPADLIST(sv) \ - (((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_padlist_u.xcv_padlist = (PADLIST *)0xEFEFEFEF) +# define PoisonPADLIST(sv) \ + (((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_padlist_u.xcv_padlist = (PADLIST *)0xEFEFEFEF) # else # error unknown pointer size # endif #else -# define PoisonPADLIST(sv) NOOP +# define PoisonPADLIST(sv) NOOP #endif -#define CvOUTSIDE(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_outside -#define CvOUTSIDE_SEQ(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_outside_seq -#define CvFLAGS(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_flags +#define CvOUTSIDE(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_outside +#define CvOUTSIDE_SEQ(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_outside_seq +#define CvFLAGS(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_flags /* These two are sometimes called on non-CVs */ -#define CvPROTO(sv) \ - ( \ - SvPOK(sv) \ - ? SvTYPE(sv) == SVt_PVCV && CvAUTOLOAD(sv) \ - ? SvEND(sv)+1 : SvPVX_const(sv) \ - : NULL \ - ) -#define CvPROTOLEN(sv) \ - ( \ - SvPOK(sv) \ - ? SvTYPE(sv) == SVt_PVCV && CvAUTOLOAD(sv) \ - ? SvLEN(sv)-SvCUR(sv)-2 \ - : SvCUR(sv) \ - : 0 \ - ) +#define CvPROTO(sv) \ + ( \ + SvPOK(sv) \ + ? SvTYPE(sv) == SVt_PVCV && CvAUTOLOAD(sv) \ + ? SvEND(sv)+1 : SvPVX_const(sv) \ + : NULL \ + ) +#define CvPROTOLEN(sv) \ + ( \ + SvPOK(sv) \ + ? SvTYPE(sv) == SVt_PVCV && CvAUTOLOAD(sv) \ + ? SvLEN(sv)-SvCUR(sv)-2 \ + : SvCUR(sv) \ + : 0 \ + ) -/* CV has the `:method` attribute. This used to be called CVf_METHOD but is - * renamed to avoid collision with CVf_IsMETHOD */ -#define CVf_NOWARN_AMBIGUOUS 0x0001 - -#define CVf_LVALUE 0x0002 /* CV return value can be used as lvalue */ -#define CVf_CONST 0x0004 /* inlinable sub */ -#define CVf_ISXSUB 0x0008 /* CV is an XSUB, not pure perl. */ - -#define CVf_WEAKOUTSIDE 0x0010 /* CvOUTSIDE isn't ref counted */ -#define CVf_CLONE 0x0020 /* anon CV uses external lexicals */ -#define CVf_CLONED 0x0040 /* a clone of one of those */ -#define CVf_ANON 0x0080 /* CV is not pointed to by a GV */ -#define CVf_UNIQUE 0x0100 /* sub is only called once (eg PL_main_cv, - require, eval). */ -#define CVf_NODEBUG 0x0200 /* no DB::sub indirection for this CV - (esp. useful for special XSUBs) */ -#define CVf_CVGV_RC 0x0400 /* CvGV is reference counted */ +/* CV has the `:method` attribute. This used to be called CVf_METHOD + * but is renamed to avoid collision with CVf_IsMETHOD */ +#define CVf_NOWARN_AMBIGUOUS 0x0001 + +#define CVf_LVALUE 0x0002 /* CV return value can be + used as lvalue */ +#define CVf_CONST 0x0004 /* inlinable sub */ +#define CVf_ISXSUB 0x0008 /* CV is an XSUB, not pure perl. */ + +#define CVf_WEAKOUTSIDE 0x0010 /* CvOUTSIDE isn't ref counted */ +#define CVf_CLONE 0x0020 /* anon CV uses external lexicals */ +#define CVf_CLONED 0x0040 /* a clone of one of those */ +#define CVf_ANON 0x0080 /* CV is not pointed to by a GV */ +#define CVf_UNIQUE 0x0100 /* sub is only called once (eg + PL_main_cv, require, eval). */ +#define CVf_NODEBUG 0x0200 /* no DB::sub indirection for this CV + (esp. useful for special XSUBs) */ +#define CVf_CVGV_RC 0x0400 /* CvGV is reference counted */ #if defined(PERL_CORE) || defined(PERL_EXT) -# define CVf_SLABBED 0x0800 /* Holds refcount on op slab */ +# define CVf_SLABBED 0x0800 /* Holds refcount on op slab */ #endif -#define CVf_DYNFILE 0x1000 /* The filename is malloced */ -#define CVf_AUTOLOAD 0x2000 /* SvPVX contains AUTOLOADed sub name */ -#define CVf_HASEVAL 0x4000 /* contains string eval */ -#define CVf_NAMED 0x8000 /* Has a name HEK */ -#define CVf_LEXICAL 0x10000 /* Omit package from name */ -#define CVf_ANONCONST 0x20000 /* :const - create anonconst op */ -#define CVf_SIGNATURE 0x40000 /* CV uses a signature */ -#define CVf_REFCOUNTED_ANYSV 0x80000 /* CvXSUBANY().any_sv is refcounted */ -#define CVf_IsMETHOD 0x100000 /* CV is a (real) method of a real class. Not - to be confused with what used to be called - CVf_METHOD; now CVf_NOWARN_AMBIGUOUS */ +#define CVf_DYNFILE 0x1000 /* The filename is malloced */ +#define CVf_AUTOLOAD 0x2000 /* SvPVX contains AUTOLOADed + sub name */ +#define CVf_HASEVAL 0x4000 /* contains string eval */ +#define CVf_NAMED 0x8000 /* Has a name HEK */ +#define CVf_LEXICAL 0x10000 /* Omit package from name */ +#define CVf_ANONCONST 0x20000 /* :const - create anonconst op */ +#define CVf_SIGNATURE 0x40000 /* CV uses a signature */ +#define CVf_REFCOUNTED_ANYSV 0x80000 /* CvXSUBANY().any_sv + is refcounted */ +#define CVf_IsMETHOD 0x100000 /* CV is a (real) method of a real + class. Not to be confused with + what used to be called CVf_METHOD; + now CVf_NOWARN_AMBIGUOUS */ /* This symbol for optimised communication between toke.c and op.c: */ -#define CVf_BUILTIN_ATTRS (CVf_NOWARN_AMBIGUOUS|CVf_LVALUE|CVf_ANONCONST) +#define CVf_BUILTIN_ATTRS (CVf_NOWARN_AMBIGUOUS|CVf_LVALUE|CVf_ANONCONST) -#define CvCLONE(cv) (CvFLAGS(cv) & CVf_CLONE) -#define CvCLONE_on(cv) (CvFLAGS(cv) |= CVf_CLONE) -#define CvCLONE_off(cv) (CvFLAGS(cv) &= ~CVf_CLONE) +#define CvCLONE(cv) (CvFLAGS(cv) & CVf_CLONE) +#define CvCLONE_on(cv) (CvFLAGS(cv) |= CVf_CLONE) +#define CvCLONE_off(cv) (CvFLAGS(cv) &= ~CVf_CLONE) -#define CvCLONED(cv) (CvFLAGS(cv) & CVf_CLONED) -#define CvCLONED_on(cv) (CvFLAGS(cv) |= CVf_CLONED) -#define CvCLONED_off(cv) (CvFLAGS(cv) &= ~CVf_CLONED) +#define CvCLONED(cv) (CvFLAGS(cv) & CVf_CLONED) +#define CvCLONED_on(cv) (CvFLAGS(cv) |= CVf_CLONED) +#define CvCLONED_off(cv) (CvFLAGS(cv) &= ~CVf_CLONED) -#define CvANON(cv) (CvFLAGS(cv) & CVf_ANON) -#define CvANON_on(cv) (CvFLAGS(cv) |= CVf_ANON) -#define CvANON_off(cv) (CvFLAGS(cv) &= ~CVf_ANON) +#define CvANON(cv) (CvFLAGS(cv) & CVf_ANON) +#define CvANON_on(cv) (CvFLAGS(cv) |= CVf_ANON) +#define CvANON_off(cv) (CvFLAGS(cv) &= ~CVf_ANON) /* CvEVAL or CvSPECIAL */ -#define CvUNIQUE(cv) (CvFLAGS(cv) & CVf_UNIQUE) -#define CvUNIQUE_on(cv) (CvFLAGS(cv) |= CVf_UNIQUE) -#define CvUNIQUE_off(cv) (CvFLAGS(cv) &= ~CVf_UNIQUE) +#define CvUNIQUE(cv) (CvFLAGS(cv) & CVf_UNIQUE) +#define CvUNIQUE_on(cv) (CvFLAGS(cv) |= CVf_UNIQUE) +#define CvUNIQUE_off(cv) (CvFLAGS(cv) &= ~CVf_UNIQUE) -#define CvNODEBUG(cv) (CvFLAGS(cv) & CVf_NODEBUG) -#define CvNODEBUG_on(cv) (CvFLAGS(cv) |= CVf_NODEBUG) -#define CvNODEBUG_off(cv) (CvFLAGS(cv) &= ~CVf_NODEBUG) +#define CvNODEBUG(cv) (CvFLAGS(cv) & CVf_NODEBUG) +#define CvNODEBUG_on(cv) (CvFLAGS(cv) |= CVf_NODEBUG) +#define CvNODEBUG_off(cv) (CvFLAGS(cv) &= ~CVf_NODEBUG) -#define CvNOWARN_AMBIGUOUS(cv) (CvFLAGS(cv) & CVf_NOWARN_AMBIGUOUS) -#define CvNOWARN_AMBIGUOUS_on(cv) (CvFLAGS(cv) |= CVf_NOWARN_AMBIGUOUS) -#define CvNOWARN_AMBIGUOUS_off(cv) (CvFLAGS(cv) &= ~CVf_NOWARN_AMBIGUOUS) +#define CvNOWARN_AMBIGUOUS(cv) (CvFLAGS(cv) & CVf_NOWARN_AMBIGUOUS) +#define CvNOWARN_AMBIGUOUS_on(cv) (CvFLAGS(cv) |= CVf_NOWARN_AMBIGUOUS) +#define CvNOWARN_AMBIGUOUS_off(cv) (CvFLAGS(cv) &= ~CVf_NOWARN_AMBIGUOUS) -#define CvLVALUE(cv) (CvFLAGS(cv) & CVf_LVALUE) -#define CvLVALUE_on(cv) (CvFLAGS(cv) |= CVf_LVALUE) -#define CvLVALUE_off(cv) (CvFLAGS(cv) &= ~CVf_LVALUE) +#define CvLVALUE(cv) (CvFLAGS(cv) & CVf_LVALUE) +#define CvLVALUE_on(cv) (CvFLAGS(cv) |= CVf_LVALUE) +#define CvLVALUE_off(cv) (CvFLAGS(cv) &= ~CVf_LVALUE) /* eval or PL_main_cv */ -#define CvEVAL(cv) (CvUNIQUE(cv) && !SvFAKE(cv)) -#define CvEVAL_on(cv) (CvUNIQUE_on(cv),SvFAKE_off(cv)) -#define CvEVAL_off(cv) CvUNIQUE_off(cv) +#define CvEVAL(cv) (CvUNIQUE(cv) && !SvFAKE(cv)) +#define CvEVAL_on(cv) (CvUNIQUE_on(cv),SvFAKE_off(cv)) +#define CvEVAL_off(cv) CvUNIQUE_off(cv) /* BEGIN|CHECK|INIT|UNITCHECK|END */ -#define CvSPECIAL(cv) (CvUNIQUE(cv) && SvFAKE(cv)) -#define CvSPECIAL_on(cv) (CvUNIQUE_on(cv),SvFAKE_on(cv)) -#define CvSPECIAL_off(cv) (CvUNIQUE_off(cv),SvFAKE_off(cv)) +#define CvSPECIAL(cv) (CvUNIQUE(cv) && SvFAKE(cv)) +#define CvSPECIAL_on(cv) (CvUNIQUE_on(cv),SvFAKE_on(cv)) +#define CvSPECIAL_off(cv) (CvUNIQUE_off(cv),SvFAKE_off(cv)) -#define CvCONST(cv) (CvFLAGS(cv) & CVf_CONST) -#define CvCONST_on(cv) (CvFLAGS(cv) |= CVf_CONST) -#define CvCONST_off(cv) (CvFLAGS(cv) &= ~CVf_CONST) +#define CvCONST(cv) (CvFLAGS(cv) & CVf_CONST) +#define CvCONST_on(cv) (CvFLAGS(cv) |= CVf_CONST) +#define CvCONST_off(cv) (CvFLAGS(cv) &= ~CVf_CONST) -#define CvWEAKOUTSIDE(cv) (CvFLAGS(cv) & CVf_WEAKOUTSIDE) -#define CvWEAKOUTSIDE_on(cv) (CvFLAGS(cv) |= CVf_WEAKOUTSIDE) -#define CvWEAKOUTSIDE_off(cv) (CvFLAGS(cv) &= ~CVf_WEAKOUTSIDE) +#define CvWEAKOUTSIDE(cv) (CvFLAGS(cv) & CVf_WEAKOUTSIDE) +#define CvWEAKOUTSIDE_on(cv) (CvFLAGS(cv) |= CVf_WEAKOUTSIDE) +#define CvWEAKOUTSIDE_off(cv) (CvFLAGS(cv) &= ~CVf_WEAKOUTSIDE) -#define CvISXSUB(cv) (CvFLAGS(cv) & CVf_ISXSUB) -#define CvISXSUB_on(cv) (CvFLAGS(cv) |= CVf_ISXSUB) -#define CvISXSUB_off(cv) (CvFLAGS(cv) &= ~CVf_ISXSUB) +#define CvISXSUB(cv) (CvFLAGS(cv) & CVf_ISXSUB) +#define CvISXSUB_on(cv) (CvFLAGS(cv) |= CVf_ISXSUB) +#define CvISXSUB_off(cv) (CvFLAGS(cv) &= ~CVf_ISXSUB) -#define CvCVGV_RC(cv) (CvFLAGS(cv) & CVf_CVGV_RC) -#define CvCVGV_RC_on(cv) (CvFLAGS(cv) |= CVf_CVGV_RC) -#define CvCVGV_RC_off(cv) (CvFLAGS(cv) &= ~CVf_CVGV_RC) +#define CvCVGV_RC(cv) (CvFLAGS(cv) & CVf_CVGV_RC) +#define CvCVGV_RC_on(cv) (CvFLAGS(cv) |= CVf_CVGV_RC) +#define CvCVGV_RC_off(cv) (CvFLAGS(cv) &= ~CVf_CVGV_RC) #ifdef PERL_CORE -# define CvSLABBED(cv) (CvFLAGS(cv) & CVf_SLABBED) -# define CvSLABBED_on(cv) (CvFLAGS(cv) |= CVf_SLABBED) -# define CvSLABBED_off(cv) (CvFLAGS(cv) &= ~CVf_SLABBED) +# define CvSLABBED(cv) (CvFLAGS(cv) & CVf_SLABBED) +# define CvSLABBED_on(cv) (CvFLAGS(cv) |= CVf_SLABBED) +# define CvSLABBED_off(cv) (CvFLAGS(cv) &= ~CVf_SLABBED) #endif -#define CvDYNFILE(cv) (CvFLAGS(cv) & CVf_DYNFILE) -#define CvDYNFILE_on(cv) (CvFLAGS(cv) |= CVf_DYNFILE) -#define CvDYNFILE_off(cv) (CvFLAGS(cv) &= ~CVf_DYNFILE) +#define CvDYNFILE(cv) (CvFLAGS(cv) & CVf_DYNFILE) +#define CvDYNFILE_on(cv) (CvFLAGS(cv) |= CVf_DYNFILE) +#define CvDYNFILE_off(cv) (CvFLAGS(cv) &= ~CVf_DYNFILE) -#define CvAUTOLOAD(cv) (CvFLAGS(cv) & CVf_AUTOLOAD) -#define CvAUTOLOAD_on(cv) (CvFLAGS(cv) |= CVf_AUTOLOAD) -#define CvAUTOLOAD_off(cv) (CvFLAGS(cv) &= ~CVf_AUTOLOAD) +#define CvAUTOLOAD(cv) (CvFLAGS(cv) & CVf_AUTOLOAD) +#define CvAUTOLOAD_on(cv) (CvFLAGS(cv) |= CVf_AUTOLOAD) +#define CvAUTOLOAD_off(cv) (CvFLAGS(cv) &= ~CVf_AUTOLOAD) -#define CvHASEVAL(cv) (CvFLAGS(cv) & CVf_HASEVAL) -#define CvHASEVAL_on(cv) (CvFLAGS(cv) |= CVf_HASEVAL) -#define CvHASEVAL_off(cv) (CvFLAGS(cv) &= ~CVf_HASEVAL) +#define CvHASEVAL(cv) (CvFLAGS(cv) & CVf_HASEVAL) +#define CvHASEVAL_on(cv) (CvFLAGS(cv) |= CVf_HASEVAL) +#define CvHASEVAL_off(cv) (CvFLAGS(cv) &= ~CVf_HASEVAL) -#define CvNAMED(cv) (CvFLAGS(cv) & CVf_NAMED) -#define CvNAMED_on(cv) (CvFLAGS(cv) |= CVf_NAMED) -#define CvNAMED_off(cv) (CvFLAGS(cv) &= ~CVf_NAMED) +#define CvNAMED(cv) (CvFLAGS(cv) & CVf_NAMED) +#define CvNAMED_on(cv) (CvFLAGS(cv) |= CVf_NAMED) +#define CvNAMED_off(cv) (CvFLAGS(cv) &= ~CVf_NAMED) -#define CvLEXICAL(cv) (CvFLAGS(cv) & CVf_LEXICAL) -#define CvLEXICAL_on(cv) (CvFLAGS(cv) |= CVf_LEXICAL) -#define CvLEXICAL_off(cv) (CvFLAGS(cv) &= ~CVf_LEXICAL) +#define CvLEXICAL(cv) (CvFLAGS(cv) & CVf_LEXICAL) +#define CvLEXICAL_on(cv) (CvFLAGS(cv) |= CVf_LEXICAL) +#define CvLEXICAL_off(cv) (CvFLAGS(cv) &= ~CVf_LEXICAL) -#define CvANONCONST(cv) (CvFLAGS(cv) & CVf_ANONCONST) -#define CvANONCONST_on(cv) (CvFLAGS(cv) |= CVf_ANONCONST) -#define CvANONCONST_off(cv) (CvFLAGS(cv) &= ~CVf_ANONCONST) +#define CvANONCONST(cv) (CvFLAGS(cv) & CVf_ANONCONST) +#define CvANONCONST_on(cv) (CvFLAGS(cv) |= CVf_ANONCONST) +#define CvANONCONST_off(cv) (CvFLAGS(cv) &= ~CVf_ANONCONST) -#define CvSIGNATURE(cv) (CvFLAGS(cv) & CVf_SIGNATURE) -#define CvSIGNATURE_on(cv) (CvFLAGS(cv) |= CVf_SIGNATURE) -#define CvSIGNATURE_off(cv) (CvFLAGS(cv) &= ~CVf_SIGNATURE) +#define CvSIGNATURE(cv) (CvFLAGS(cv) & CVf_SIGNATURE) +#define CvSIGNATURE_on(cv) (CvFLAGS(cv) |= CVf_SIGNATURE) +#define CvSIGNATURE_off(cv) (CvFLAGS(cv) &= ~CVf_SIGNATURE) /* @@ -256,24 +267,24 @@ Helper macro to turn off the C flag. =cut */ -#define CvREFCOUNTED_ANYSV(cv) (CvFLAGS(cv) & CVf_REFCOUNTED_ANYSV) -#define CvREFCOUNTED_ANYSV_on(cv) (CvFLAGS(cv) |= CVf_REFCOUNTED_ANYSV) -#define CvREFCOUNTED_ANYSV_off(cv) (CvFLAGS(cv) &= ~CVf_REFCOUNTED_ANYSV) +#define CvREFCOUNTED_ANYSV(cv) (CvFLAGS(cv) & CVf_REFCOUNTED_ANYSV) +#define CvREFCOUNTED_ANYSV_on(cv) (CvFLAGS(cv) |= CVf_REFCOUNTED_ANYSV) +#define CvREFCOUNTED_ANYSV_off(cv) (CvFLAGS(cv) &= ~CVf_REFCOUNTED_ANYSV) -#define CvIsMETHOD(cv) (CvFLAGS(cv) & CVf_IsMETHOD) -#define CvIsMETHOD_on(cv) (CvFLAGS(cv) |= CVf_IsMETHOD) -#define CvIsMETHOD_off(cv) (CvFLAGS(cv) &= ~CVf_IsMETHOD) +#define CvIsMETHOD(cv) (CvFLAGS(cv) & CVf_IsMETHOD) +#define CvIsMETHOD_on(cv) (CvFLAGS(cv) |= CVf_IsMETHOD) +#define CvIsMETHOD_off(cv) (CvFLAGS(cv) &= ~CVf_IsMETHOD) /* Back-compat */ #ifndef PERL_CORE -# define CVf_METHOD CVf_NOWARN_AMBIGUOUS -# define CvMETHOD(cv) CvNOWARN_AMBIGUOUS(cv) -# define CvMETHOD_on(cv) CvNOWARN_AMBIGUOUS_on(cv) -# define CvMETHOD_off(cv) CvNOWARN_AMBIGUOUS_off(cv) +# define CVf_METHOD CVf_NOWARN_AMBIGUOUS +# define CvMETHOD(cv) CvNOWARN_AMBIGUOUS(cv) +# define CvMETHOD_on(cv) CvNOWARN_AMBIGUOUS_on(cv) +# define CvMETHOD_off(cv) CvNOWARN_AMBIGUOUS_off(cv) #endif -/* Flags for newXS_flags */ -#define XS_DYNAMIC_FILENAME 0x01 /* The filename isn't static */ +/* Flags for newXS_flags */ +#define XS_DYNAMIC_FILENAME 0x01 /* The filename isn't static */ PERL_STATIC_INLINE HEK * CvNAME_HEK(CV *sv) @@ -283,69 +294,68 @@ CvNAME_HEK(CV *sv) : 0; } -/* helper for the common pattern: - CvNAMED(sv) ? CvNAME_HEK((CV *)sv) : GvNAME_HEK(CvGV(sv)) -*/ -#define CvGvNAME_HEK(sv) ( \ - CvNAMED((CV*)sv) ? \ - ((XPVCV*)MUTABLE_PTR(SvANY((SV*)sv)))->xcv_gv_u.xcv_hek\ - : GvNAME_HEK(CvGV( (SV*) sv)) \ +/* helper for the common pattern: CvNAMED(sv) ? + CvNAME_HEK((CV *)sv) : GvNAME_HEK(CvGV(sv)) + */ +#define CvGvNAME_HEK(sv) \ + ( \ + CvNAMED((CV*)sv) ? \ + ((XPVCV*)MUTABLE_PTR(SvANY((SV*)sv)))->xcv_gv_u.xcv_hek \ + : GvNAME_HEK(CvGV( (SV*) sv)) \ ) -/* This lowers the reference count of the previous value, but does *not* - increment the reference count of the new value. */ -#define CvNAME_HEK_set(cv, hek) ( \ - CvNAME_HEK((CV *)(cv)) \ - ? unshare_hek(SvANY((CV *)(cv))->xcv_gv_u.xcv_hek) \ - : (void)0, \ +/* This lowers the reference count of the previous value, but does + *not* increment the reference count of the new value. */ +#define CvNAME_HEK_set(cv, hek) \ + ( \ + CvNAME_HEK((CV *)(cv)) \ + ? unshare_hek(SvANY((CV *)(cv))->xcv_gv_u.xcv_hek) \ + : (void)0, \ ((XPVCV*)MUTABLE_PTR(SvANY(cv)))->xcv_gv_u.xcv_hek = (hek), \ - CvNAMED_on(cv) \ + CvNAMED_on(cv) \ ) /* =for apidoc m|bool|CvWEAKOUTSIDE|CV *cv -Each CV has a pointer, C, to its lexically enclosing -CV (if any). Because pointers to anonymous sub prototypes are -stored in C<&> pad slots, it is a possible to get a circular reference, -with the parent pointing to the child and vice-versa. To avoid the -ensuing memory leak, we do not increment the reference count of the CV -pointed to by C in the I that the parent -has a C<&> pad slot pointing back to us. In this case, we set the -C flag in the child. This allows us to determine under what -circumstances we should decrement the refcount of the parent when freeing -the child. - -There is a further complication with non-closure anonymous subs (i.e. those +Each CV has a pointer, C, to its lexically enclosing CV (if any). +Because pointers to anonymous sub prototypes are stored in C<&> pad slots, it +is a possible to get a circular reference, with the parent pointing to the +child and vice-versa. To avoid the ensuing memory leak, we do not increment +the reference count of the CV pointed to by C in the I that the parent has a C<&> pad slot pointing back to us. In this +case, we set the C flag in the child. This allows us to +determine under what circumstances we should decrement the refcount of the +parent when freeing the child. + +There is a further complication with non-closure anonymous subs (i.e. those that do not refer to any lexicals outside that sub). In this case, the anonymous prototype is shared rather than being cloned. This has the -consequence that the parent may be freed while there are still active -children, I, +consequence that the parent may be freed while there are still active children, +I, BEGIN { $a = sub { eval '$x' } } -In this case, the BEGIN is freed immediately after execution since there -are no active references to it: the anon sub prototype has -C set since it's not a closure, and $a points to the same -CV, so it doesn't contribute to BEGIN's refcount either. When $a is -executed, the C causes the chain of Cs to be followed, -and the freed BEGIN is accessed. - -To avoid this, whenever a CV and its associated pad is freed, any -C<&> entries in the pad are explicitly removed from the pad, and if the -refcount of the pointed-to anon sub is still positive, then that -child's C is set to point to its grandparent. This will only -occur in the single specific case of a non-closure anon prototype -having one or more active references (such as C<$a> above). - -One other thing to consider is that a CV may be merely undefined -rather than freed, eg C. In this case, its refcount may -not have reached zero, but we still delete its pad and its C etc. -Since various children may still have their C pointing at this -undefined CV, we keep its own C for the time being, so that -the chain of lexical scopes is unbroken. For example, the following -should print 123: +In this case, the BEGIN is freed immediately after execution since there are no +active references to it: the anon sub prototype has C set since +it's not a closure, and $a points to the same CV, so it doesn't contribute to +BEGIN's refcount either. When $a is executed, the C causes the +chain of Cs to be followed, and the freed BEGIN is accessed. + +To avoid this, whenever a CV and its associated pad is freed, any C<&> entries +in the pad are explicitly removed from the pad, and if the refcount of the +pointed-to anon sub is still positive, then that child's C is set to +point to its grandparent. This will only occur in the single specific case of +a non-closure anon prototype having one or more active references (such as +C<$a> above). + +One other thing to consider is that a CV may be merely undefined rather than +freed, eg C. In this case, its refcount may not have reached zero, +but we still delete its pad and its C etc. Since various children may +still have their C pointing at this undefined CV, we keep its own +C for the time being, so that the chain of lexical scopes is +unbroken. For example, the following should print 123: my $x = 123; sub tmp { sub { eval '$x' } } @@ -358,14 +368,14 @@ should print 123: typedef OP *(*Perl_call_checker)(pTHX_ OP *, GV *, SV *); -#define CALL_CHECKER_REQUIRE_GV MGf_REQUIRE_GV +#define CALL_CHECKER_REQUIRE_GV MGf_REQUIRE_GV -#define CV_NAME_NOTQUAL 1 +#define CV_NAME_NOTQUAL 1 #ifdef PERL_CORE -# define CV_UNDEF_KEEP_NAME 1 +# define CV_UNDEF_KEEP_NAME 1 #endif /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/dosish.h b/dosish.h index 8a1ce980484b..1f1ace78bf0d 100644 --- a/dosish.h +++ b/dosish.h @@ -1,111 +1,106 @@ /* dosish.h * - * Copyright (C) 1993, 1994, 1996, 1997, 1998, 1999, - * 2000, 2001, 2002, 2007, by Larry Wall and others + * Copyright (C) 1993, 1994, 1996, 1997, 1998, 1999, 2000, 2001, 2002, + * 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, + * 2018, 2019, 2020, 2021, 2022 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * */ -#define ABORT() abort(); +#define ABORT() abort(); #ifndef SH_PATH -#define SH_PATH "/bin/sh" +#define SH_PATH "/bin/sh" #endif #ifdef WIN32 -# define PERL_SYS_INIT_BODY(c,v) \ - MALLOC_CHECK_TAINT2(*c,*v) Perl_win32_init(c,v); PERLIO_INIT -# define PERL_SYS_TERM_BODY() Perl_win32_term() -# define BIT_BUCKET "nul" +# define PERL_SYS_INIT_BODY(c,v) \ + MALLOC_CHECK_TAINT2(*c,*v) Perl_win32_init(c,v); PERLIO_INIT +# define PERL_SYS_TERM_BODY() Perl_win32_term() +# define BIT_BUCKET "nul" #else -# define PERL_SYS_INIT_BODY(c,v) \ - MALLOC_CHECK_TAINT2(*c,*v); PERLIO_INIT -# define BIT_BUCKET "\\dev\\nul" /* "wanna be like, umm, Newlined, or somethin?" */ +# define PERL_SYS_INIT_BODY(c,v) \ + MALLOC_CHECK_TAINT2(*c,*v); PERLIO_INIT +# define BIT_BUCKET "\\dev\\nul" /* "wanna be like, umm, Newlined, + or somethin?" */ #endif -/* Generally add things last-in first-terminated. IO and memory terminations - * need to be generally last +/* Generally add things last-in first-terminated. IO and memory + * terminations need to be generally last * - * BEWARE that using PerlIO in these will be using freed memory, so may appear - * to work, but must NOT be retained in production code. */ + * BEWARE that using PerlIO in these will be using freed memory, so may + * appear to work, but must NOT be retained in production code. */ #ifndef PERL_SYS_TERM_BODY -# define PERL_SYS_TERM_BODY() \ - ENV_TERM; USER_PROP_MUTEX_TERM; LOCALE_TERM; \ - HINTS_REFCNT_TERM; KEYWORD_PLUGIN_MUTEX_TERM; \ - OP_CHECK_MUTEX_TERM; OP_REFCNT_TERM; \ - PERLIO_TERM; MALLOC_TERM; +# define PERL_SYS_TERM_BODY() \ + ENV_TERM; USER_PROP_MUTEX_TERM; LOCALE_TERM; \ + HINTS_REFCNT_TERM; KEYWORD_PLUGIN_MUTEX_TERM; \ + OP_CHECK_MUTEX_TERM; OP_REFCNT_TERM; \ + PERLIO_TERM; MALLOC_TERM; #endif -#define dXSUB_SYS dNOOP +#define dXSUB_SYS dNOOP -/* USEMYBINMODE - * This symbol, if defined, indicates that the program should - * use the routine my_binmode(FILE *fp, char iotype, int mode) to insure - * that a file is in "binary" mode -- that is, that no translation - * of bytes occurs on read or write operations. +/* USEMYBINMODE This symbol, if defined, indicates that the program + * should use the routine my_binmode(FILE *fp, char iotype, int + * mode) to insure that a file is in "binary" mode -- that is, that + * no translation of bytes occurs on read or write operations. */ #undef USEMYBINMODE -/* Stat_t: - * This symbol holds the type used to declare buffers for information - * returned by stat(). It's usually just struct stat. It may be necessary - * to include and to get any typedef'ed - * information. +/* Stat_t: This symbol holds the type used to declare buffers for information + * returned by stat(). It's usually just struct stat. It may be necessary to + * include and to get any typedef'ed information. */ #if defined(WIN32) -# define Stat_t struct w32_stat +# define Stat_t struct w32_stat #else -# define Stat_t struct _stati64 +# define Stat_t struct _stati64 #endif -/* USE_STAT_RDEV: - * This symbol is defined if this system has a stat structure declaring - * st_rdev +/* USE_STAT_RDEV: This symbol is defined if this system + * has a stat structure declaring st_rdev */ -#define USE_STAT_RDEV /**/ +#define USE_STAT_RDEV /**/ -/* ACME_MESS: - * This symbol, if defined, indicates that error messages should be - * should be generated in a format that allows the use of the Acme - * GUI/editor's autofind feature. +/* ACME_MESS: This symbol, if defined, indicates that error + * messages should be should be generated in a format that allows + * the use of the Acme GUI/editor's autofind feature. */ -#undef ACME_MESS /**/ +#undef ACME_MESS /**/ -/* ALTERNATE_SHEBANG: - * This symbol, if defined, contains a "magic" string which may be used - * as the first line of a Perl program designed to be executed directly - * by name, instead of the standard Unix #!. If ALTERNATE_SHEBANG - * begins with a character other then #, then Perl will only treat - * it as a command line if it finds the string "perl" in the first - * word; otherwise it's treated as the first line of code in the script. - * (IOW, Perl won't hand off to another interpreter via an alternate - * shebang sequence that might be legal Perl code.) +/* ALTERNATE_SHEBANG: This symbol, if defined, contains a "magic" string + * which may be used as the first line of a Perl program designed to be + * executed directly by name, instead of the standard Unix #!. If + * ALTERNATE_SHEBANG begins with a character other then #, then Perl + * will only treat it as a command line if it finds the string "perl" in + * the first word; otherwise it's treated as the first line of code in + * the script. (IOW, Perl won't hand off to another interpreter via an + * alternate shebang sequence that might be legal Perl code.) */ -/* #define ALTERNATE_SHEBANG "#!" / **/ +/* #define ALTERNATE_SHEBANG "#!" / * */ #include /* - * fwrite1() should be a routine with the same calling sequence as fwrite(), - * but which outputs all of the bytes requested as a single stream (unlike - * fwrite() itself, which on some systems outputs several distinct records - * if the number_of_items parameter is >1). - */ -#define fwrite1 fwrite + * fwrite1() should be a routine with the same calling sequence as + * fwrite(), but which outputs all of the bytes requested as a single + * stream (unlike fwrite() itself, which on some systems outputs several + * distinct records if the number_of_items parameter is >1). +*/ +#define fwrite1 fwrite -#define Fstat(fd,bufptr) fstat((fd),(bufptr)) -#define Fflush(fp) fflush(fp) -#define Mkdir(path,mode) mkdir((path),(mode)) +#define Fstat(fd,bufptr) fstat((fd),(bufptr)) +#define Fflush(fp) fflush(fp) +#define Mkdir(path,mode) mkdir((path),(mode)) #ifndef WIN32 -# define Stat(fname,bufptr) stat((fname),(bufptr)) +# define Stat(fname,bufptr) stat((fname),(bufptr)) #else # define HAS_IOCTL # define HAS_UTIME # define HAS_KILL # define HAS_WAIT # define HAS_CHOWN -#endif /* WIN32 */ +#endif /* WIN32 */ /* Don't go reading from /dev/urandom */ #define PERL_NO_DEV_RANDOM @@ -116,4 +111,4 @@ /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/fakesdio.h b/fakesdio.h index b8f972a0a98b..d22279a3aba1 100644 --- a/fakesdio.h +++ b/fakesdio.h @@ -1,19 +1,20 @@ /* fakesdio.h * - * Copyright (C) 2000, by Larry Wall and others + * Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, + * 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, + * 2020, 2021, 2022 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * */ /* - * This is "source level" stdio compatibility mode. - * We try and #define stdio functions in terms of PerlIO. - */ -#define _CANNOT "CANNOT" + * This is "source level" stdio compatibility mode. We + * try and #define stdio functions in terms of PerlIO. +*/ +#define _CANNOT "CANNOT" #undef FILE -#define FILE PerlIO +#define FILE PerlIO #undef clearerr #undef fclose #undef fdopen @@ -57,71 +58,70 @@ #undef vfprintf #undef printf -/* printf used to live in perl.h like this - more sophisticated - than the rest +/* printf used to live in perl.h like this - more sophisticated than the rest */ #if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(PERL_GCC_PEDANTIC) #define printf(fmt,args...) PerlIO_stdoutf(fmt,##args) #else -#define printf PerlIO_stdoutf +#define printf PerlIO_stdoutf #endif -#define fprintf PerlIO_printf -#define stdin PerlIO_stdin() -#define stdout PerlIO_stdout() -#define stderr PerlIO_stderr() -#define tmpfile() PerlIO_tmpfile() -#define fclose(f) PerlIO_close(f) -#define fflush(f) PerlIO_flush(f) -#define fopen(p,m) PerlIO_open(p,m) -#define vfprintf(f,fmt,a) PerlIO_vprintf(f,fmt,a) -#define fgetc(f) PerlIO_getc(f) -#define fputc(c,f) PerlIO_putc(f,c) -#define fputs(s,f) PerlIO_puts(f,s) -#define getc(f) PerlIO_getc(f) -#define getc_unlocked(f) PerlIO_getc(f) -#define putc(c,f) PerlIO_putc(f,c) -#define putc_unlocked(c,f) PerlIO_putc(c,f) -#define ungetc(c,f) PerlIO_ungetc(f,c) +#define fprintf PerlIO_printf +#define stdin PerlIO_stdin() +#define stdout PerlIO_stdout() +#define stderr PerlIO_stderr() +#define tmpfile() PerlIO_tmpfile() +#define fclose(f) PerlIO_close(f) +#define fflush(f) PerlIO_flush(f) +#define fopen(p,m) PerlIO_open(p,m) +#define vfprintf(f,fmt,a) PerlIO_vprintf(f,fmt,a) +#define fgetc(f) PerlIO_getc(f) +#define fputc(c,f) PerlIO_putc(f,c) +#define fputs(s,f) PerlIO_puts(f,s) +#define getc(f) PerlIO_getc(f) +#define getc_unlocked(f) PerlIO_getc(f) +#define putc(c,f) PerlIO_putc(f,c) +#define putc_unlocked(c,f) PerlIO_putc(c,f) +#define ungetc(c,f) PerlIO_ungetc(f,c) #if 0 /* return values of read/write need work */ -#define fread(b,s,c,f) PerlIO_read(f,b,(s*c)) -#define fwrite(b,s,c,f) PerlIO_write(f,b,(s*c)) +#define fread(b,s,c,f) PerlIO_read(f,b,(s*c)) +#define fwrite(b,s,c,f) PerlIO_write(f,b,(s*c)) #else -#define fread(b,s,c,f) _CANNOT fread -#define fwrite(b,s,c,f) _CANNOT fwrite +#define fread(b,s,c,f) _CANNOT fread +#define fwrite(b,s,c,f) _CANNOT fwrite #endif -#define fseek(f,o,w) PerlIO_seek(f,o,w) -#define ftell(f) PerlIO_tell(f) -#define rewind(f) PerlIO_rewind(f) -#define clearerr(f) PerlIO_clearerr(f) -#define feof(f) PerlIO_eof(f) -#define ferror(f) PerlIO_error(f) -#define fdopen(fd,p) PerlIO_fdopen(fd,p) -#define fileno(f) PerlIO_fileno(f) -#define popen(c,m) my_popen(c,m) -#define pclose(f) my_pclose(f) +#define fseek(f,o,w) PerlIO_seek(f,o,w) +#define ftell(f) PerlIO_tell(f) +#define rewind(f) PerlIO_rewind(f) +#define clearerr(f) PerlIO_clearerr(f) +#define feof(f) PerlIO_eof(f) +#define ferror(f) PerlIO_error(f) +#define fdopen(fd,p) PerlIO_fdopen(fd,p) +#define fileno(f) PerlIO_fileno(f) +#define popen(c,m) my_popen(c,m) +#define pclose(f) my_pclose(f) -#define fsetpos(f,p) _CANNOT _fsetpos_ -#define fgetpos(f,p) _CANNOT _fgetpos_ +#define fsetpos(f,p) _CANNOT _fsetpos_ +#define fgetpos(f,p) _CANNOT _fgetpos_ -#define __filbuf(f) _CANNOT __filbuf_ -#define _filbuf(f) _CANNOT _filbuf_ -#define __flsbuf(c,f) _CANNOT __flsbuf_ -#define _flsbuf(c,f) _CANNOT _flsbuf_ -#define getw(f) _CANNOT _getw_ -#define putw(v,f) _CANNOT _putw_ +#define __filbuf(f) _CANNOT __filbuf_ +#define _filbuf(f) _CANNOT _filbuf_ +#define __flsbuf(c,f) _CANNOT __flsbuf_ +#define _flsbuf(c,f) _CANNOT _flsbuf_ +#define getw(f) _CANNOT _getw_ +#define putw(v,f) _CANNOT _putw_ #if SFIO_VERSION < 20000101L -#define flockfile(f) _CANNOT _flockfile_ -#define ftrylockfile(f) _CANNOT _ftrylockfile_ -#define funlockfile(f) _CANNOT _funlockfile_ +#define flockfile(f) _CANNOT _flockfile_ +#define ftrylockfile(f) _CANNOT _ftrylockfile_ +#define funlockfile(f) _CANNOT _funlockfile_ #endif -#define freopen(p,m,f) _CANNOT _freopen_ -#define setbuf(f,b) _CANNOT _setbuf_ -#define setvbuf(f,b,x,s) _CANNOT _setvbuf_ -#define fscanf _CANNOT _fscanf_ -#define fgets(s,n,f) _CANNOT _fgets_ +#define freopen(p,m,f) _CANNOT _freopen_ +#define setbuf(f,b) _CANNOT _setbuf_ +#define setvbuf(f,b,x,s) _CANNOT _setvbuf_ +#define fscanf _CANNOT _fscanf_ +#define fgets(s,n,f) _CANNOT _fgets_ /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/form.h b/form.h index 7ddeb715edfe..d8140ef36679 100644 --- a/form.h +++ b/form.h @@ -1,27 +1,29 @@ /* form.h * - * Copyright (C) 1991, 1992, 1993, 2000, 2004, 2011 by Larry Wall and others + * Copyright (C) 1991, 1992, 1993, 2000, 2004, 2011, 2012, 2013, 2014, 2015, + * 2016, 2017, 2018, 2019, 2020, 2021, 2022 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * */ -#define FF_END 0 /* tidy up, then return */ -#define FF_LINEMARK 1 /* start (or end) of a line */ -#define FF_LITERAL 2 /* append literal chars */ -#define FF_SKIP 3 /* skip chars in format */ -#define FF_FETCH 4 /* get next item and set field size to */ -#define FF_CHECKNL 5 /* find max len of item (up to \n) that fits field */ -#define FF_CHECKCHOP 6 /* like CHECKNL, but up to highest split point */ -#define FF_SPACE 7 /* append padding space (diff of field, item size) */ -#define FF_HALFSPACE 8 /* like FF_SPACE, but only append half as many */ -#define FF_ITEM 9 /* append a text item, while blanking ctrl chars */ -#define FF_CHOP 10 /* (for ^*) chop the current item */ -#define FF_LINEGLOB 11 /* process @* */ -#define FF_DECIMAL 12 /* do @##, ^##, where =(precision|flags) */ -#define FF_NEWLINE 13 /* delete trailing spaces, then append \n */ -#define FF_BLANK 14 /* for arg==0: do '~'; for arg>0 : do '~~' */ -#define FF_MORE 15 /* replace long end of string with '...' */ -#define FF_0DECIMAL 16 /* like FF_DECIMAL but for 0### */ -#define FF_LINESNGL 17 /* process ^* */ +#define FF_END 0 /* tidy up, then return */ +#define FF_LINEMARK 1 /* start (or end) of a line */ +#define FF_LITERAL 2 /* append literal chars */ +#define FF_SKIP 3 /* skip chars in format */ +#define FF_FETCH 4 /* get next item and set field size to */ +#define FF_CHECKNL 5 /* find max len of item (up to + \n) that fits field */ +#define FF_CHECKCHOP 6 /* like CHECKNL, but up to highest split point */ +#define FF_SPACE 7 /* append padding space (diff + of field, item size) */ +#define FF_HALFSPACE 8 /* like FF_SPACE, but only append half as many */ +#define FF_ITEM 9 /* append a text item, while blanking ctrl chars */ +#define FF_CHOP 10 /* (for ^*) chop the current item */ +#define FF_LINEGLOB 11 /* process @* */ +#define FF_DECIMAL 12 /* do @##, ^##, where =(precision|flags) */ +#define FF_NEWLINE 13 /* delete trailing spaces, then append \n */ +#define FF_BLANK 14 /* for arg==0: do '~'; for arg>0 : do '~~' */ +#define FF_MORE 15 /* replace long end of string with '...' */ +#define FF_0DECIMAL 16 /* like FF_DECIMAL but for 0### */ +#define FF_LINESNGL 17 /* process ^* */ diff --git a/gv.h b/gv.h index 68865b99916d..411fd67e164d 100644 --- a/gv.h +++ b/gv.h @@ -1,84 +1,88 @@ /* gv.h * - * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, - * 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others + * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, + * 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, + * 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021, + * 2022 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * */ struct gp { - SV * gp_sv; /* scalar value */ - struct io * gp_io; /* filehandle value */ - CV * gp_cv; /* subroutine value */ - U32 gp_cvgen; /* generational validity of cached gp_cv */ - U32 gp_refcnt; /* how many globs point to this? */ - HV * gp_hv; /* hash value */ - AV * gp_av; /* array value */ - CV * gp_form; /* format value */ - GV * gp_egv; /* effective gv, if *glob */ - PERL_BITFIELD32 gp_line:31; /* line first declared at (for -w) */ + SV *gp_sv; /* scalar value */ + struct io *gp_io; /* filehandle value */ + CV *gp_cv; /* subroutine value */ + U32 gp_cvgen; /* generational validity of cached gp_cv */ + U32 gp_refcnt; /* how many globs point to this? */ + HV *gp_hv; /* hash value */ + AV *gp_av; /* array value */ + CV *gp_form; /* format value */ + GV *gp_egv; /* effective gv, if *glob */ + PERL_BITFIELD32 gp_line:31; /* line first declared at (for -w) */ PERL_BITFIELD32 gp_flags:1; - HEK * gp_file_hek; /* file first declared in (for -w) */ + HEK *gp_file_hek; /* file first declared in (for -w) */ }; -#define GvXPVGV(gv) ((XPVGV*)SvANY(gv)) +#define GvXPVGV(gv) ((XPVGV*)SvANY(gv)) #if defined (DEBUGGING) && defined(PERL_USE_GCC_BRACE_GROUPS) && !defined(__INTEL_COMPILER) -# define GvGP(gv) \ - ((GP *)(*({GV *const _gvgp = (GV *) (gv); \ - assert(SvTYPE(_gvgp) == SVt_PVGV || SvTYPE(_gvgp) == SVt_PVLV); \ - assert(isGV_with_GP(_gvgp)); \ - &((_gvgp)->sv_u.svu_gp);}))) -# define GvGP_set(gv,gp) \ - {GV *const _gvgp = (GV *) (gv); \ - assert(SvTYPE(_gvgp) == SVt_PVGV || SvTYPE(_gvgp) == SVt_PVLV); \ - assert(isGV_with_GP(_gvgp)); \ - (_gvgp)->sv_u.svu_gp = (gp); } -# define GvFLAGS(gv) \ - (*({GV *const _gvflags = (GV *) (gv); \ - assert(SvTYPE(_gvflags) == SVt_PVGV || SvTYPE(_gvflags) == SVt_PVLV); \ - assert(isGV_with_GP(_gvflags)); \ - &(GvXPVGV(_gvflags)->xpv_cur);})) -# define GvSTASH(gv) \ - (*({ GV * const _gvstash = (GV *) (gv); \ - assert(isGV_with_GP(_gvstash)); \ - assert(SvTYPE(_gvstash) == SVt_PVGV || SvTYPE(_gvstash) >= SVt_PVLV); \ - &(GvXPVGV(_gvstash)->xnv_u.xgv_stash); \ - })) -# define GvNAME_HEK(gv) \ - (*({ GV * const _gvname_hek = (GV *) (gv); \ - assert(isGV_with_GP(_gvname_hek)); \ - assert(SvTYPE(_gvname_hek) == SVt_PVGV || SvTYPE(_gvname_hek) >= SVt_PVLV); \ - &(GvXPVGV(_gvname_hek)->xiv_u.xivu_namehek); \ - })) -# define GvNAME_get(gv) ({ assert(GvNAME_HEK(gv)); (char *)HEK_KEY(GvNAME_HEK(gv)); }) -# define GvNAMELEN_get(gv) ({ assert(GvNAME_HEK(gv)); HEK_LEN(GvNAME_HEK(gv)); }) -# define GvNAMEUTF8(gv) ({ assert(GvNAME_HEK(gv)); HEK_UTF8(GvNAME_HEK(gv)); }) +# define GvGP(gv) \ + ((GP *)(*({GV *const _gvgp = (GV *) (gv); \ + assert(SvTYPE(_gvgp) == SVt_PVGV || SvTYPE(_gvgp) == SVt_PVLV); \ + assert(isGV_with_GP(_gvgp)); \ + &((_gvgp)->sv_u.svu_gp);}))) +# define GvGP_set(gv,gp) \ + {GV *const _gvgp = (GV *) (gv); \ + assert(SvTYPE(_gvgp) == SVt_PVGV || SvTYPE(_gvgp) == SVt_PVLV); \ + assert(isGV_with_GP(_gvgp)); \ + (_gvgp)->sv_u.svu_gp = (gp); } +# define GvFLAGS(gv) \ + (*({GV *const _gvflags = (GV *) (gv); \ + assert(SvTYPE(_gvflags) == SVt_PVGV || SvTYPE(_gvflags) == SVt_PVLV); \ + assert(isGV_with_GP(_gvflags)); \ + &(GvXPVGV(_gvflags)->xpv_cur);})) +# define GvSTASH(gv) \ + (*({ GV * const _gvstash = (GV *) (gv); \ + assert(isGV_with_GP(_gvstash)); \ + assert(SvTYPE(_gvstash) == SVt_PVGV || SvTYPE(_gvstash) >= SVt_PVLV); \ + &(GvXPVGV(_gvstash)->xnv_u.xgv_stash); \ + })) +# define GvNAME_HEK(gv) \ + (*({ GV * const _gvname_hek = (GV *) (gv); \ + assert(isGV_with_GP(_gvname_hek)); \ + assert(SvTYPE(_gvname_hek) == SVt_PVGV || SvTYPE(_gvname_hek) >= SVt_PVLV); \ + &(GvXPVGV(_gvname_hek)->xiv_u.xivu_namehek); \ + })) +# define GvNAME_get(gv) \ + ({ assert(GvNAME_HEK(gv)); (char *)HEK_KEY(GvNAME_HEK(gv)); }) +# define GvNAMELEN_get(gv) \ + ({ assert(GvNAME_HEK(gv)); HEK_LEN(GvNAME_HEK(gv)); }) +# define GvNAMEUTF8(gv) \ + ({ assert(GvNAME_HEK(gv)); HEK_UTF8(GvNAME_HEK(gv)); }) #else -# define GvGP(gv) (0+(gv)->sv_u.svu_gp) -# define GvGP_set(gv,gp) ((gv)->sv_u.svu_gp = (gp)) -# define GvFLAGS(gv) (GvXPVGV(gv)->xpv_cur) -# define GvSTASH(gv) (GvXPVGV(gv)->xnv_u.xgv_stash) -# define GvNAME_HEK(gv) (GvXPVGV(gv)->xiv_u.xivu_namehek) -# define GvNAME_get(gv) HEK_KEY(GvNAME_HEK(gv)) -# define GvNAMELEN_get(gv) HEK_LEN(GvNAME_HEK(gv)) -# define GvNAMEUTF8(gv) HEK_UTF8(GvNAME_HEK(gv)) +# define GvGP(gv) (0+(gv)->sv_u.svu_gp) +# define GvGP_set(gv,gp) ((gv)->sv_u.svu_gp = (gp)) +# define GvFLAGS(gv) (GvXPVGV(gv)->xpv_cur) +# define GvSTASH(gv) (GvXPVGV(gv)->xnv_u.xgv_stash) +# define GvNAME_HEK(gv) (GvXPVGV(gv)->xiv_u.xivu_namehek) +# define GvNAME_get(gv) HEK_KEY(GvNAME_HEK(gv)) +# define GvNAMELEN_get(gv) HEK_LEN(GvNAME_HEK(gv)) +# define GvNAMEUTF8(gv) HEK_UTF8(GvNAME_HEK(gv)) #endif -#define GvNAME(gv) GvNAME_get(gv) -#define GvNAMELEN(gv) GvNAMELEN_get(gv) +#define GvNAME(gv) GvNAME_get(gv) +#define GvNAMELEN(gv) GvNAMELEN_get(gv) /* =for apidoc Am|SV*|GvSV|GV* gv Return the SV from the GV. -Prior to Perl v5.9.3, this would add a scalar if none existed. Nowadays, use -C> for that, or compile perl with S>. See -L. +Prior to Perl v5.9.3, this would add a scalar if none existed. +Nowadays, use C> for that, or compile perl with +S>. See L. =for apidoc Am|SV*|GvSVn|GV* gv Like C>, but creates an empty scalar if none already exists. @@ -98,181 +102,188 @@ Return the CV from the GV. =cut */ -#define GvSV(gv) (GvGP(gv)->gp_sv) +#define GvSV(gv) (GvGP(gv)->gp_sv) #ifdef PERL_DONT_CREATE_GVSV -#define GvSVn(gv) (*(GvGP(gv)->gp_sv ? \ - &(GvGP(gv)->gp_sv) : \ - &(GvGP(gv_SVadd(gv))->gp_sv))) +#define GvSVn(gv) \ + (*(GvGP(gv)->gp_sv ? \ + &(GvGP(gv)->gp_sv) : \ + &(GvGP(gv_SVadd(gv))->gp_sv))) #else -#define GvSVn(gv) GvSV(gv) +#define GvSVn(gv) GvSV(gv) #endif -#define GvREFCNT(gv) (GvGP(gv)->gp_refcnt) -#define GvIO(gv) \ - ( \ - (gv) \ - && ( \ - SvTYPE((const SV*)(gv)) == SVt_PVGV \ - || SvTYPE((const SV*)(gv)) == SVt_PVLV \ - ) \ - && GvGP(gv) \ - ? GvIOp(gv) \ - : NULL \ - ) -#define GvIOp(gv) (GvGP(gv)->gp_io) -#define GvIOn(gv) (GvIO(gv) ? GvIOp(gv) : GvIOp(gv_IOadd(gv))) - -#define GvFORM(gv) (GvGP(gv)->gp_form) -#define GvAV(gv) (GvGP(gv)->gp_av) - -#define GvAVn(gv) (GvGP(gv)->gp_av ? \ - GvGP(gv)->gp_av : \ - GvGP(gv_AVadd(gv))->gp_av) -#define GvHV(gv) ((GvGP(gv))->gp_hv) - -#define GvHVn(gv) (GvGP(gv)->gp_hv ? \ - GvGP(gv)->gp_hv : \ - GvGP(gv_HVadd(gv))->gp_hv) - -#define GvCV(gv) ((CV*)GvGP(gv)->gp_cv) -#define GvCV_set(gv,cv) (GvGP(gv)->gp_cv = (cv)) -#define GvCVGEN(gv) (GvGP(gv)->gp_cvgen) -#define GvCVu(gv) (GvGP(gv)->gp_cvgen ? NULL : GvGP(gv)->gp_cv) - -#define GvGPFLAGS(gv) (GvGP(gv)->gp_flags) - -#define GvLINE(gv) (GvGP(gv)->gp_line) -#define GvFILE_HEK(gv) (GvGP(gv)->gp_file_hek) -#define GvFILEx(gv) HEK_KEY(GvFILE_HEK(gv)) -#define GvFILE(gv) (GvFILE_HEK(gv) ? GvFILEx(gv) : NULL) -#define GvFILEGV(gv) (GvFILE_HEK(gv) ? gv_fetchfile(GvFILEx(gv)) : NULL) - -#define GvEGV(gv) (GvGP(gv)->gp_egv) -#define GvEGVx(gv) (isGV_with_GP(gv) ? GvEGV(gv) : NULL) -#define GvENAME(gv) GvNAME(GvEGV(gv) ? GvEGV(gv) : gv) +#define GvREFCNT(gv) (GvGP(gv)->gp_refcnt) +#define GvIO(gv) \ + ( \ + (gv) \ + && ( \ + SvTYPE((const SV*)(gv)) == SVt_PVGV \ + || SvTYPE((const SV*)(gv)) == SVt_PVLV \ + ) \ + && GvGP(gv) \ + ? GvIOp(gv) \ + : NULL \ + ) +#define GvIOp(gv) (GvGP(gv)->gp_io) +#define GvIOn(gv) (GvIO(gv) ? GvIOp(gv) : GvIOp(gv_IOadd(gv))) + +#define GvFORM(gv) (GvGP(gv)->gp_form) +#define GvAV(gv) (GvGP(gv)->gp_av) + +#define GvAVn(gv) \ + (GvGP(gv)->gp_av ? \ + GvGP(gv)->gp_av : \ + GvGP(gv_AVadd(gv))->gp_av) +#define GvHV(gv) ((GvGP(gv))->gp_hv) + +#define GvHVn(gv) \ + (GvGP(gv)->gp_hv ? \ + GvGP(gv)->gp_hv : \ + GvGP(gv_HVadd(gv))->gp_hv) + +#define GvCV(gv) ((CV*)GvGP(gv)->gp_cv) +#define GvCV_set(gv,cv) (GvGP(gv)->gp_cv = (cv)) +#define GvCVGEN(gv) (GvGP(gv)->gp_cvgen) +#define GvCVu(gv) (GvGP(gv)->gp_cvgen ? NULL : GvGP(gv)->gp_cv) + +#define GvGPFLAGS(gv) (GvGP(gv)->gp_flags) + +#define GvLINE(gv) (GvGP(gv)->gp_line) +#define GvFILE_HEK(gv) (GvGP(gv)->gp_file_hek) +#define GvFILEx(gv) HEK_KEY(GvFILE_HEK(gv)) +#define GvFILE(gv) (GvFILE_HEK(gv) ? GvFILEx(gv) : NULL) +#define GvFILEGV(gv) (GvFILE_HEK(gv) ? gv_fetchfile(GvFILEx(gv)) : NULL) + +#define GvEGV(gv) (GvGP(gv)->gp_egv) +#define GvEGVx(gv) (isGV_with_GP(gv) ? GvEGV(gv) : NULL) +#define GvENAME(gv) GvNAME(GvEGV(gv) ? GvEGV(gv) : gv) #define GvENAMELEN(gv) GvNAMELEN(GvEGV(gv) ? GvEGV(gv) : gv) #define GvENAMEUTF8(gv) GvNAMEUTF8(GvEGV(gv) ? GvEGV(gv) : gv) #define GvENAME_HEK(gv) GvNAME_HEK(GvEGV(gv) ? GvEGV(gv) : gv) -#define GvESTASH(gv) GvSTASH(GvEGV(gv) ? GvEGV(gv) : gv) +#define GvESTASH(gv) GvSTASH(GvEGV(gv) ? GvEGV(gv) : gv) -/* GVf_INTRO is one-shot flag which indicates that the next assignment - of a reference to the glob is to be localised; it distinguishes - 'local *g = $ref' from '*g = $ref'. -*/ -#define GVf_INTRO 0x01 -#define GVf_MULTI 0x02 -#define GVf_ASSUMECV 0x04 -#define GVf_RESERVED 0x08 /* unused */ -#define GVf_IMPORTED 0xF0 -#define GVf_IMPORTED_SV 0x10 -#define GVf_IMPORTED_AV 0x20 -#define GVf_IMPORTED_HV 0x40 -#define GVf_IMPORTED_CV 0x80 - -#define GvINTRO(gv) (GvFLAGS(gv) & GVf_INTRO) -#define GvINTRO_on(gv) (GvFLAGS(gv) |= GVf_INTRO) -#define GvINTRO_off(gv) (GvFLAGS(gv) &= ~GVf_INTRO) - -#define GvMULTI(gv) (GvFLAGS(gv) & GVf_MULTI) -#define GvMULTI_on(gv) (GvFLAGS(gv) |= GVf_MULTI) -#define GvMULTI_off(gv) (GvFLAGS(gv) &= ~GVf_MULTI) - -#define GvASSUMECV(gv) (GvFLAGS(gv) & GVf_ASSUMECV) -#define GvASSUMECV_on(gv) (GvFLAGS(gv) |= GVf_ASSUMECV) -#define GvASSUMECV_off(gv) (GvFLAGS(gv) &= ~GVf_ASSUMECV) - -#define GvIMPORTED(gv) (GvFLAGS(gv) & GVf_IMPORTED) -#define GvIMPORTED_on(gv) (GvFLAGS(gv) |= GVf_IMPORTED) -#define GvIMPORTED_off(gv) (GvFLAGS(gv) &= ~GVf_IMPORTED) - -#define GvIMPORTED_SV(gv) (GvFLAGS(gv) & GVf_IMPORTED_SV) -#define GvIMPORTED_SV_on(gv) (GvFLAGS(gv) |= GVf_IMPORTED_SV) -#define GvIMPORTED_SV_off(gv) (GvFLAGS(gv) &= ~GVf_IMPORTED_SV) - -#define GvIMPORTED_AV(gv) (GvFLAGS(gv) & GVf_IMPORTED_AV) -#define GvIMPORTED_AV_on(gv) (GvFLAGS(gv) |= GVf_IMPORTED_AV) -#define GvIMPORTED_AV_off(gv) (GvFLAGS(gv) &= ~GVf_IMPORTED_AV) - -#define GvIMPORTED_HV(gv) (GvFLAGS(gv) & GVf_IMPORTED_HV) -#define GvIMPORTED_HV_on(gv) (GvFLAGS(gv) |= GVf_IMPORTED_HV) -#define GvIMPORTED_HV_off(gv) (GvFLAGS(gv) &= ~GVf_IMPORTED_HV) - -#define GvIMPORTED_CV(gv) (GvFLAGS(gv) & GVf_IMPORTED_CV) -#define GvIMPORTED_CV_on(gv) (GvFLAGS(gv) |= GVf_IMPORTED_CV) -#define GvIMPORTED_CV_off(gv) (GvFLAGS(gv) &= ~GVf_IMPORTED_CV) +/* GVf_INTRO is one-shot flag which indicates that the next + assignment of a reference to the glob is to be localised; + it distinguishes 'local *g = $ref' from '*g = $ref'. + */ +#define GVf_INTRO 0x01 +#define GVf_MULTI 0x02 +#define GVf_ASSUMECV 0x04 +#define GVf_RESERVED 0x08 /* unused */ +#define GVf_IMPORTED 0xF0 +#define GVf_IMPORTED_SV 0x10 +#define GVf_IMPORTED_AV 0x20 +#define GVf_IMPORTED_HV 0x40 +#define GVf_IMPORTED_CV 0x80 + +#define GvINTRO(gv) (GvFLAGS(gv) & GVf_INTRO) +#define GvINTRO_on(gv) (GvFLAGS(gv) |= GVf_INTRO) +#define GvINTRO_off(gv) (GvFLAGS(gv) &= ~GVf_INTRO) + +#define GvMULTI(gv) (GvFLAGS(gv) & GVf_MULTI) +#define GvMULTI_on(gv) (GvFLAGS(gv) |= GVf_MULTI) +#define GvMULTI_off(gv) (GvFLAGS(gv) &= ~GVf_MULTI) + +#define GvASSUMECV(gv) (GvFLAGS(gv) & GVf_ASSUMECV) +#define GvASSUMECV_on(gv) (GvFLAGS(gv) |= GVf_ASSUMECV) +#define GvASSUMECV_off(gv) (GvFLAGS(gv) &= ~GVf_ASSUMECV) + +#define GvIMPORTED(gv) (GvFLAGS(gv) & GVf_IMPORTED) +#define GvIMPORTED_on(gv) (GvFLAGS(gv) |= GVf_IMPORTED) +#define GvIMPORTED_off(gv) (GvFLAGS(gv) &= ~GVf_IMPORTED) + +#define GvIMPORTED_SV(gv) (GvFLAGS(gv) & GVf_IMPORTED_SV) +#define GvIMPORTED_SV_on(gv) (GvFLAGS(gv) |= GVf_IMPORTED_SV) +#define GvIMPORTED_SV_off(gv) (GvFLAGS(gv) &= ~GVf_IMPORTED_SV) + +#define GvIMPORTED_AV(gv) (GvFLAGS(gv) & GVf_IMPORTED_AV) +#define GvIMPORTED_AV_on(gv) (GvFLAGS(gv) |= GVf_IMPORTED_AV) +#define GvIMPORTED_AV_off(gv) (GvFLAGS(gv) &= ~GVf_IMPORTED_AV) + +#define GvIMPORTED_HV(gv) (GvFLAGS(gv) & GVf_IMPORTED_HV) +#define GvIMPORTED_HV_on(gv) (GvFLAGS(gv) |= GVf_IMPORTED_HV) +#define GvIMPORTED_HV_off(gv) (GvFLAGS(gv) &= ~GVf_IMPORTED_HV) + +#define GvIMPORTED_CV(gv) (GvFLAGS(gv) & GVf_IMPORTED_CV) +#define GvIMPORTED_CV_on(gv) (GvFLAGS(gv) |= GVf_IMPORTED_CV) +#define GvIMPORTED_CV_off(gv) (GvFLAGS(gv) &= ~GVf_IMPORTED_CV) #ifndef PERL_CORE -# define GvIN_PAD(gv) 0 -# define GvIN_PAD_on(gv) NOOP -# define GvIN_PAD_off(gv) NOOP -# define Nullgv Null(GV*) +# define GvIN_PAD(gv) 0 +# define GvIN_PAD_on(gv) NOOP +# define GvIN_PAD_off(gv) NOOP +# define Nullgv Null(GV*) #endif -#define DM_RUID 0x001 -#define DM_EUID 0x002 -#define DM_UID (DM_RUID|DM_EUID) -#define DM_ARRAY_ISA 0x004 -#define DM_RGID 0x010 -#define DM_EGID 0x020 -#define DM_GID (DM_RGID|DM_EGID) -#define DM_DELAY 0x100 +#define DM_RUID 0x001 +#define DM_EUID 0x002 +#define DM_UID (DM_RUID|DM_EUID) +#define DM_ARRAY_ISA 0x004 +#define DM_RGID 0x010 +#define DM_EGID 0x020 +#define DM_GID (DM_RGID|DM_EGID) +#define DM_DELAY 0x100 /* * symbol creation flags, for use in gv_fetchpv() and get_*v() - */ -#define GV_ADD 0x01 /* add, if symbol not already there - For gv_name_set, adding a HEK for the first - time, so don't try to free what's there. */ -#define GV_ADDMULTI 0x02 /* add, pretending it has been added - already; used also by gv_init_* */ -#define GV_ADDWARN 0x04 /* add, but warn if symbol wasn't already there */ - /* 0x08 UNUSED */ -#define GV_NOINIT 0x10 /* add, but don't init symbol, if type != PVGV */ +*/ +#define GV_ADD 0x01 /* add, if symbol not already there For + gv_name_set, adding a HEK for the first + time, so don't try to free what's there. */ +#define GV_ADDMULTI 0x02 /* add, pretending it has been added already; + used also by gv_init_* */ +#define GV_ADDWARN 0x04 /* add, but warn if symbol wasn't + already there */ + /* 0x08 UNUSED */ +#define GV_NOINIT 0x10 /* add, but don't init symbol, + if type != PVGV */ /* This is used by toke.c to avoid turing placeholder constants in the symbol - table into full PVGVs with attached constant subroutines. */ -#define GV_NOADD_NOINIT 0x20 /* Don't add the symbol if it's not there. + table into full PVGVs with attached constant subroutines. */ +#define GV_NOADD_NOINIT 0x20 /* Don't add the symbol if it's not there. Don't init it if it is there but ! PVGV */ -#define GV_NOEXPAND 0x40 /* Don't expand SvOK() entries to PVGV */ -#define GV_NOTQUAL 0x80 /* A plain symbol name, not qualified with a - package (so skip checks for :: and ') */ -#define GV_AUTOLOAD 0x100 /* gv_fetchmethod_flags() should AUTOLOAD */ -#define GV_CROAK 0x200 /* gv_fetchmethod_flags() should croak */ -#define GV_ADDMG 0x400 /* add if magical */ -#define GV_NO_SVGMAGIC 0x800 /* Skip get-magic on an SV argument; - used only by gv_fetchsv(_nomg) */ -#define GV_CACHE_ONLY 0x1000 /* return stash only if found in cache; - used only in flags parameter to gv_stash* family */ - -/* Flags for gv_fetchmeth_pvn and gv_autoload_pvn*/ -#define GV_SUPER 0x1000 /* SUPER::method */ +#define GV_NOEXPAND 0x40 /* Don't expand SvOK() entries to PVGV */ +#define GV_NOTQUAL 0x80 /* A plain symbol name, not qualified with a + package (so skip checks for :: and ') */ +#define GV_AUTOLOAD 0x100 /* gv_fetchmethod_flags() should AUTOLOAD */ +#define GV_CROAK 0x200 /* gv_fetchmethod_flags() should croak */ +#define GV_ADDMG 0x400 /* add if magical */ +#define GV_NO_SVGMAGIC 0x800 /* Skip get-magic on an SV argument; used + only by gv_fetchsv(_nomg) */ +#define GV_CACHE_ONLY 0x1000 /* return stash only if found in + cache; used only in flags parameter + to gv_stash* family */ + +/* Flags for gv_fetchmeth_pvn and gv_autoload_pvn */ +#define GV_SUPER 0x1000 /* SUPER::method */ #define GV_NOUNIVERSAL 0x2000 /* Skip UNIVERSAL lookup */ -/* Flags for gv_autoload_*/ -#define GV_AUTOLOAD_ISMETHOD 1 /* autoloading a method? */ +/* Flags for gv_autoload_ */ +#define GV_AUTOLOAD_ISMETHOD 1 /* autoloading a method? */ -/* SVf_UTF8 (more accurately the return value from SvUTF8) is also valid - as a flag to various gv_* functions, so ensure it lies - outside this range. -*/ +/* SVf_UTF8 (more accurately the return value from SvUTF8) is also valid as + a flag to various gv_* functions, so ensure it lies outside this range. + */ -#define GV_NOADD_MASK \ - (SVf_UTF8|GV_NOADD_NOINIT|GV_NOEXPAND|GV_NOTQUAL|GV_ADDMG|GV_NO_SVGMAGIC) -/* The bit flags that don't cause gv_fetchpv() to add a symbol if not - found (with the exception GV_ADDMG, which *might* cause the symbol - to be added) */ +#define GV_NOADD_MASK \ + (SVf_UTF8|GV_NOADD_NOINIT|GV_NOEXPAND|GV_NOTQUAL|GV_ADDMG|GV_NO_SVGMAGIC) +/* The bit flags that don't cause gv_fetchpv() to add a symbol if not found + (with the exception GV_ADDMG, which *might* cause the symbol to be added) */ /* gv_fetchfile_flags() */ -#define GVF_NOADD 0x01 /* don't add the glob if it doesn't exist */ - -#define gv_fullname3(sv,gv,prefix) gv_fullname4(sv,gv,prefix,TRUE) -#define gv_efullname3(sv,gv,prefix) gv_efullname4(sv,gv,prefix,TRUE) -#define gv_fetchmethod(stash, name) gv_fetchmethod_autoload(stash, name, TRUE) -#define gv_fetchsv_nomg(n,f,t) gv_fetchsv(n,(f)|GV_NO_SVGMAGIC,t) -#define gv_init(gv,stash,name,len,multi) \ - gv_init_pvn(gv,stash,name,len,GV_ADDMULTI*cBOOL(multi)) -#define gv_fetchmeth(stash,name,len,level) gv_fetchmeth_pvn(stash, name, len, level, 0) -#define gv_fetchmeth_autoload(stash,name,len,level) gv_fetchmeth_pvn_autoload(stash, name, len, level, 0) -#define gv_fetchmethod_flags(stash,name,flags) gv_fetchmethod_pv_flags(stash, name, flags) +#define GVF_NOADD 0x01 /* don't add the glob if it doesn't exist */ + +#define gv_fullname3(sv,gv,prefix) gv_fullname4(sv,gv,prefix,TRUE) +#define gv_efullname3(sv,gv,prefix) gv_efullname4(sv,gv,prefix,TRUE) +#define gv_fetchmethod(stash, name) gv_fetchmethod_autoload(stash, name, TRUE) +#define gv_fetchsv_nomg(n,f,t) gv_fetchsv(n,(f)|GV_NO_SVGMAGIC,t) +#define gv_init(gv,stash,name,len,multi) \ + gv_init_pvn(gv,stash,name,len,GV_ADDMULTI*cBOOL(multi)) +#define gv_fetchmeth(stash,name,len,level) \ + gv_fetchmeth_pvn(stash, name, len, level, 0) +#define gv_fetchmeth_autoload(stash,name,len,level) \ + gv_fetchmeth_pvn_autoload(stash, name, len, level, 0) +#define gv_fetchmethod_flags(stash,name,flags) \ + gv_fetchmethod_pv_flags(stash, name, flags) /* =for apidoc gv_autoload4 @@ -280,15 +291,15 @@ Equivalent to C>. =cut */ -#define gv_autoload4(stash, name, len, autoload) \ - gv_autoload_pvn(stash, name, len, cBOOL(autoload)) -#define newGVgen(pack) newGVgen_flags(pack, 0) -#define gv_method_changed(gv) \ - ( \ - assert_(isGV_with_GP(gv)) \ - GvREFCNT(gv) > 1 \ - ? (void)++PL_sub_generation \ - : mro_method_changed_in(GvSTASH(gv)) \ +#define gv_autoload4(stash, name, len, autoload) \ + gv_autoload_pvn(stash, name, len, cBOOL(autoload)) +#define newGVgen(pack) newGVgen_flags(pack, 0) +#define gv_method_changed(gv) \ + ( \ + assert_(isGV_with_GP(gv)) \ + GvREFCNT(gv) > 1 \ + ? (void)++PL_sub_generation \ + : mro_method_changed_in(GvSTASH(gv)) \ ) /* @@ -302,11 +313,11 @@ Make sure there is a slot of the given type (AV, HV, IO, SV) in the GV C. =cut */ -#define gv_AVadd(gv) gv_add_by_type((gv), SVt_PVAV) -#define gv_HVadd(gv) gv_add_by_type((gv), SVt_PVHV) -#define gv_IOadd(gv) gv_add_by_type((gv), SVt_PVIO) -#define gv_SVadd(gv) gv_add_by_type((gv), SVt_NULL) +#define gv_AVadd(gv) gv_add_by_type((gv), SVt_PVAV) +#define gv_HVadd(gv) gv_add_by_type((gv), SVt_PVHV) +#define gv_IOadd(gv) gv_add_by_type((gv), SVt_PVIO) +#define gv_SVadd(gv) gv_add_by_type((gv), SVt_NULL) /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/handy.h b/handy.h index 3e5e42d12f6e..ea082d1315de 100644 --- a/handy.h +++ b/handy.h @@ -1,27 +1,26 @@ /* handy.h * * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1999, 2000, - * 2001, 2002, 2004, 2005, 2006, 2007, 2008, 2012 by Larry Wall and others + * 2001, 2002, 2004, 2005, 2006, 2007, 2008, 2012, 2013, 2014, 2015, + * 2016, 2017, 2018, 2019, 2020, 2021, 2022 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * */ -/* IMPORTANT NOTE: Everything whose name begins with an underscore is for - * internal core Perl use only. */ +/* IMPORTANT NOTE: Everything whose name begins with an + * underscore is for internal core Perl use only. */ #ifndef PERL_HANDY_H_ /* Guard against nested #inclusion */ #define PERL_HANDY_H_ #ifndef PERL_CORE -# define Null(type) ((type)NULL) +# define Null(type) ((type)NULL) /* =for apidoc_section $string =for apidoc AmnU||Nullch -Null character pointer. (No longer available when C is -defined.) +Null character pointer. (No longer available when C is defined.) =for apidoc_section $SV =for apidoc AmnU||Nullsv @@ -29,8 +28,8 @@ Null SV pointer. (No longer available when C is defined.) =cut -Below are signatures of functions from config.h which can't easily be gleaned -from it, and are very unlikely to change +Below are signatures of functions from config.h which can't easily be +gleaned from it, and are very unlikely to change =for apidoc_section $signals =for apidoc Am|int|Sigsetjmp|jmp_buf env|int savesigs @@ -54,9 +53,9 @@ from it, and are very unlikely to change =cut */ -# define Nullch Null(char*) -# define Nullfp Null(PerlIO*) -# define Nullsv Null(SV*) +# define Nullch Null(char*) +# define Nullfp Null(PerlIO*) +# define Nullsv Null(SV*) #endif #ifdef TRUE @@ -65,8 +64,8 @@ from it, and are very unlikely to change #ifdef FALSE #undef FALSE #endif -#define TRUE (1) -#define FALSE (0) +#define TRUE (1) +#define FALSE (0) /* =for apidoc_section $SV @@ -96,17 +95,17 @@ The brace group version will raise a diagnostic if 'p' is const; the other blindly casts away const. */ #if defined(PERL_USE_GCC_BRACE_GROUPS) -# define MUTABLE_PTR(p) ({ void *p_ = (p); p_; }) +# define MUTABLE_PTR(p) ({ void *p_ = (p); p_; }) #else -# define MUTABLE_PTR(p) ((void *) (p)) +# define MUTABLE_PTR(p) ((void *) (p)) #endif -#define MUTABLE_AV(p) ((AV *)MUTABLE_PTR(p)) -#define MUTABLE_CV(p) ((CV *)MUTABLE_PTR(p)) -#define MUTABLE_GV(p) ((GV *)MUTABLE_PTR(p)) -#define MUTABLE_HV(p) ((HV *)MUTABLE_PTR(p)) -#define MUTABLE_IO(p) ((IO *)MUTABLE_PTR(p)) -#define MUTABLE_SV(p) ((SV *)MUTABLE_PTR(p)) +#define MUTABLE_AV(p) ((AV *)MUTABLE_PTR(p)) +#define MUTABLE_CV(p) ((CV *)MUTABLE_PTR(p)) +#define MUTABLE_GV(p) ((GV *)MUTABLE_PTR(p)) +#define MUTABLE_HV(p) ((HV *)MUTABLE_PTR(p)) +#define MUTABLE_IO(p) ((IO *)MUTABLE_PTR(p)) +#define MUTABLE_SV(p) ((SV *)MUTABLE_PTR(p)) /* =for apidoc_section $SV @@ -115,7 +114,7 @@ blindly casts away const. =for apidoc_item |HV *|HV_FROM_REF|SV * ref The CV_FROM_REF> macros extract the C from a given reference SV -and return a suitably-cast to pointer to the referenced SV. When running +and return a suitably-cast to pointer to the referenced SV. When running under C<-DDEBUGGING>, assertions are also applied that check that I is definitely a reference SV that refers to an SV of the right type. @@ -123,18 +122,18 @@ definitely a reference SV that refers to an SV of the right type. */ #if defined(DEBUGGING) && defined(PERL_USE_GCC_BRACE_GROUPS) -# define xV_FROM_REF(XV, ref) \ - ({ SV *_ref = ref; \ - assert(SvROK(_ref)); \ - assert(SvTYPE(SvRV(_ref)) == SVt_PV ## XV); \ - (XV *)(SvRV(_ref)); }) +# define xV_FROM_REF(XV, ref) \ + ({ SV *_ref = ref; \ + assert(SvROK(_ref)); \ + assert(SvTYPE(SvRV(_ref)) == SVt_PV ## XV); \ + (XV *)(SvRV(_ref)); }) #else -# define xV_FROM_REF(XV, ref) ((XV *)(SvRV(ref))) +# define xV_FROM_REF(XV, ref) ((XV *)(SvRV(ref))) #endif -#define AV_FROM_REF(ref) xV_FROM_REF(AV, ref) -#define CV_FROM_REF(ref) xV_FROM_REF(CV, ref) -#define HV_FROM_REF(ref) xV_FROM_REF(HV, ref) +#define AV_FROM_REF(ref) xV_FROM_REF(AV, ref) +#define CV_FROM_REF(ref) xV_FROM_REF(CV, ref) +#define HV_FROM_REF(ref) xV_FROM_REF(HV, ref) #ifndef __cplusplus # include @@ -144,50 +143,51 @@ definitely a reference SV that refers to an SV of the right type. =for apidoc_section $casting =for apidoc Am|bool|cBOOL|bool expr -Cast-to-bool. When Perl was able to be compiled on pre-C99 compilers, a -C<(bool)> cast didn't necessarily do the right thing, so this macro was -created (and made somewhat complicated to work around bugs in old +Cast-to-bool. When Perl was able to be compiled on pre-C99 compilers, +a C<(bool)> cast didn't necessarily do the right thing, so this macro +was created (and made somewhat complicated to work around bugs in old compilers). Now, many years later, and C99 is used, this is no longer required, but is kept for backwards compatibility. =cut */ -#define cBOOL(cbool) ((bool) (cbool)) - -/* Try to figure out __func__ or __FUNCTION__ equivalent, if any. - * XXX Should really be a Configure probe, with HAS__FUNCTION__ - * and FUNCTION__ as results. - * XXX Similarly, a Configure probe for __FILE__ and __LINE__ is needed. */ -#if (defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L) || (defined(__SUNPRO_C)) /* C99 or close enough. */ -# define FUNCTION__ __func__ -# define SAFE_FUNCTION__ __func__ -#elif (defined(__DECC_VER)) /* Tru64 or VMS, and strict C89 being used, but not modern enough cc (in Tru64, -c99 not known, only -std1). */ -# define FUNCTION__ ("") -# define SAFE_FUNCTION__ ("UNKNOWN") +#define cBOOL(cbool) ((bool) (cbool)) + +/* Try to figure out __func__ or __FUNCTION__ equivalent, if + * any. XXX Should really be a Configure probe, with + * HAS__FUNCTION__ and FUNCTION__ as results. XXX Similarly, a + * Configure probe for __FILE__ and __LINE__ is needed. */ +#if (defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L) || \ + (defined(__SUNPRO_C)) /* C99 or close enough. */ +# define FUNCTION__ __func__ +# define SAFE_FUNCTION__ __func__ +#elif (defined(__DECC_VER)) /* Tru64 or VMS, and strict C89 being used, + but not modern enough cc (in Tru64, -c99 + not known, only -std1). */ +# define FUNCTION__ ("") +# define SAFE_FUNCTION__ ("UNKNOWN") #else -# define FUNCTION__ __FUNCTION__ /* Common extension. */ -# define SAFE_FUNCTION__ __FUNCTION__ /* Common extension. */ +# define FUNCTION__ __FUNCTION__ /* Common extension. */ +# define SAFE_FUNCTION__ __FUNCTION__ /* Common extension. */ #endif -/* XXX A note on the perl source internal type system. The - original intent was that I32 be *exactly* 32 bits. +/* XXX A note on the perl source internal type system. The original intent + was that I32 be *exactly* 32 bits. - Currently, we only guarantee that I32 is *at least* 32 bits. - Specifically, if int is 64 bits, then so is I32. (This is the case - for the Cray.) This has the advantage of meshing nicely with - standard library calls (where we pass an I32 and the library is - expecting an int), but the disadvantage that an I32 is not 32 bits. - Andy Dougherty August 1996 + Currently, we only guarantee that I32 is *at least* 32 bits. Specifically, + if int is 64 bits, then so is I32. (This is the case for the Cray.) This + has the advantage of meshing nicely with standard library calls (where we + pass an I32 and the library is expecting an int), but the disadvantage that + an I32 is not 32 bits. Andy Dougherty August 1996 - There is no guarantee that there is *any* integral type with - exactly 32 bits. It is perfectly legal for a system to have - sizeof(short) == sizeof(int) == sizeof(long) == 8. + There is no guarantee that there is *any* integral type with exactly 32 + bits. It is perfectly legal for a system to have sizeof(short) == + sizeof(int) == sizeof(long) == 8. - Similarly, there is no guarantee that I16 and U16 have exactly 16 - bits. + Similarly, there is no guarantee that I16 and U16 have exactly 16 bits. - For dealing with issues that may arise from various 32/64-bit - systems, we will ask Configure to check out + For dealing with issues that may arise from various 32/64-bit systems, we + will ask Configure to check out SHORTSIZE == sizeof(short) INTSIZE == sizeof(int) @@ -196,18 +196,17 @@ required, but is kept for backwards compatibility. PTRSIZE == sizeof(void *) DOUBLESIZE == sizeof(double) LONG_DOUBLESIZE == sizeof(long double) (if HAS_LONG_DOUBLE). + */ -*/ - -#ifdef I_INTTYPES /* e.g. Linux has int64_t without */ +#ifdef I_INTTYPES /* e.g. Linux has int64_t without */ # include # ifdef INT32_MIN_BROKEN # undef INT32_MIN -# define INT32_MIN (-2147483647-1) +# define INT32_MIN (-2147483647-1) # endif # ifdef INT64_MIN_BROKEN # undef INT64_MIN -# define INT64_MIN (-9223372036854775807LL-1) +# define INT64_MIN (-9223372036854775807LL-1) # endif #endif @@ -223,71 +222,71 @@ typedef I64TYPE I64; typedef U64TYPE U64; #endif -/* I8_MAX and I8_MIN constants are not defined, as I8 is an ambiguous type. - Please search CHAR_MAX in perl.h for further details. */ +/* I8_MAX and I8_MIN constants are not defined, as I8 is an ambiguous + type. Please search CHAR_MAX in perl.h for further details. */ #ifdef UINT8_MAX -# define U8_MAX UINT8_MAX +# define U8_MAX UINT8_MAX #else -# define U8_MAX PERL_UCHAR_MAX +# define U8_MAX PERL_UCHAR_MAX #endif #ifdef UINT8_MIN -# define U8_MIN UINT8_MIN +# define U8_MIN UINT8_MIN #else -# define U8_MIN PERL_UCHAR_MIN +# define U8_MIN PERL_UCHAR_MIN #endif #ifdef INT16_MAX -# define I16_MAX INT16_MAX +# define I16_MAX INT16_MAX #else -# define I16_MAX PERL_SHORT_MAX +# define I16_MAX PERL_SHORT_MAX #endif #ifdef INT16_MIN -# define I16_MIN INT16_MIN +# define I16_MIN INT16_MIN #else -# define I16_MIN PERL_SHORT_MIN +# define I16_MIN PERL_SHORT_MIN #endif #ifdef UINT16_MAX -# define U16_MAX UINT16_MAX +# define U16_MAX UINT16_MAX #else -# define U16_MAX PERL_USHORT_MAX +# define U16_MAX PERL_USHORT_MAX #endif #ifdef UINT16_MIN -# define U16_MIN UINT16_MIN +# define U16_MIN UINT16_MIN #else -# define U16_MIN PERL_USHORT_MIN +# define U16_MIN PERL_USHORT_MIN #endif #ifdef INT32_MAX -# define I32_MAX INT32_MAX +# define I32_MAX INT32_MAX #elif LONGSIZE > 4 -# define I32_MAX PERL_INT_MAX +# define I32_MAX PERL_INT_MAX #else -# define I32_MAX PERL_LONG_MAX +# define I32_MAX PERL_LONG_MAX #endif #ifdef INT32_MIN -# define I32_MIN INT32_MIN +# define I32_MIN INT32_MIN #elif LONGSIZE > 4 -# define I32_MIN PERL_INT_MIN +# define I32_MIN PERL_INT_MIN #else -# define I32_MIN PERL_LONG_MIN +# define I32_MIN PERL_LONG_MIN #endif #ifdef UINT32_MAX -# ifndef UINT32_MAX_BROKEN /* e.g. HP-UX with gcc messes this up */ -# define U32_MAX UINT_MAX +# ifndef UINT32_MAX_BROKEN /* e.g. HP-UX with gcc messes this up */ +# define U32_MAX UINT_MAX # else -# define U32_MAX 4294967295U +# define U32_MAX 4294967295U # endif #elif LONGSIZE > 4 -# define U32_MAX PERL_UINT_MAX +# define U32_MAX PERL_UINT_MAX #else -# define U32_MAX PERL_ULONG_MAX +# define U32_MAX PERL_ULONG_MAX #endif #ifdef UINT32_MIN -# define U32_MIN UINT32_MIN +# define U32_MIN UINT32_MIN #elif LONGSIZE > 4 -# define U32_MIN PERL_UINT_MIN +# define U32_MIN PERL_UINT_MIN #else -# define U32_MIN PERL_ULONG_MIN +# define U32_MIN PERL_ULONG_MIN #endif /* @@ -298,8 +297,8 @@ typedef U64TYPE U64; =for apidoc_item PERL_UINT_FAST16_T These are equivalent to the correspondingly-named C99 typedefs on platforms -that have those; they evaluate to C and C on platforms that -don't, so that you can portably take advantage of this C99 feature. +that have those; they evaluate to C and C on platforms +that don't, so that you can portably take advantage of this C99 feature. =cut */ @@ -315,59 +314,59 @@ don't, so that you can portably take advantage of this C99 feature. typedef unsigned int PERL_UINT_FAST16_T; #endif -/* log(2) (i.e., log base 10 of 2) is pretty close to 0.30103, just in case - * anyone is grepping for it. So BIT_DIGITS gives the number of decimal digits - * required to represent any possible unsigned number containing N bits. - * TYPE_DIGITS gives the number of decimal digits required to represent any - * possible unsigned number of type T. */ -#define BIT_DIGITS(N) (((N)*146)/485 + 1) /* log10(2) =~ 146/485 */ -#define TYPE_DIGITS(T) BIT_DIGITS(sizeof(T) * 8) -#define TYPE_CHARS(T) (TYPE_DIGITS(T) + 2) /* sign, NUL */ +/* log(2) (i.e., log base 10 of 2) is pretty close to 0.30103, just in + * case anyone is grepping for it. So BIT_DIGITS gives the number of + * decimal digits required to represent any possible unsigned number + * containing N bits. TYPE_DIGITS gives the number of decimal digits + * required to represent any possible unsigned number of type T. */ +#define BIT_DIGITS(N) (((N)*146)/485 + 1) /* log10(2) =~ 146/485 */ +#define TYPE_DIGITS(T) BIT_DIGITS(sizeof(T) * 8) +#define TYPE_CHARS(T) (TYPE_DIGITS(T) + 2) /* sign, NUL */ /* Unused by core; should be deprecated */ -#define Ctl(ch) ((ch) & 037) +#define Ctl(ch) ((ch) & 037) #if defined(PERL_CORE) || defined(PERL_EXT) # ifndef MIN -# define MIN(a,b) ((a) < (b) ? (a) : (b)) +# define MIN(a,b) ((a) < (b) ? (a) : (b)) # endif # ifndef MAX -# define MAX(a,b) ((a) > (b) ? (a) : (b)) +# define MAX(a,b) ((a) > (b) ? (a) : (b)) # endif #endif -/* Returns a boolean as to whether the input unsigned number is a power of 2 - * (2**0, 2**1, etc). In other words if it has just a single bit set. - * If not, subtracting 1 would leave the uppermost bit set, so the & would - * yield non-zero */ +/* Returns a boolean as to whether the input unsigned number is + * a power of 2 (2**0, 2**1, etc). In other words if it has + * just a single bit set. If not, subtracting 1 would leave + * the uppermost bit set, so the & would yield non-zero */ #if defined(PERL_CORE) || defined(PERL_EXT) -# define isPOWER_OF_2(n) ((n) && ((n) & ((n)-1)) == 0) +# define isPOWER_OF_2(n) ((n) && ((n) & ((n)-1)) == 0) #endif /* Returns a mask with the lowest n bits set */ -#define nBIT_MASK(n) ((UINTMAX_C(1) << (n)) - 1) +#define nBIT_MASK(n) ((UINTMAX_C(1) << (n)) - 1) /* The largest unsigned number that will fit into n bits */ -#define nBIT_UMAX(n) nBIT_MASK(n) +#define nBIT_UMAX(n) nBIT_MASK(n) /* =for apidoc_section $directives =for apidoc Am||__ASSERT_|bool expr -This is a helper macro to avoid preprocessor issues, replaced by nothing -unless under DEBUGGING, where it expands to an assert of its argument, -followed by a comma (hence the comma operator). If we just used a straight -assert(), we would get a comma with nothing before it when not DEBUGGING. +This is a helper macro to avoid preprocessor issues, replaced by nothing unless +under DEBUGGING, where it expands to an assert of its argument, followed by a +comma (hence the comma operator). If we just used a straight assert(), we +would get a comma with nothing before it when not DEBUGGING. =cut -We also use empty definition under Coverity since the __ASSERT_ -checks often check for things that Really Cannot Happen, and Coverity -detects that and gets all excited. */ +We also use empty definition under Coverity since the __ASSERT_ checks often +check for things that Really Cannot Happen, and Coverity detects that and gets +all excited. */ -#if defined(DEBUGGING) && !defined(__COVERITY__) \ - && ! defined(PERL_SMALL_MACRO_BUFFER) -# define __ASSERT_(statement) assert(statement), +#if defined(DEBUGGING) && !defined(__COVERITY__) \ + && ! defined(PERL_SMALL_MACRO_BUFFER) +# define __ASSERT_(statement) assert(statement), #else # define __ASSERT_(statement) #endif @@ -376,64 +375,60 @@ detects that and gets all excited. */ =for apidoc_section $SV =for apidoc Ama|SV*|newSVpvs|"literal string" -Like C, but takes a literal string instead of a -string/length pair. +Like C, but takes a literal string instead of a string/length pair. =for apidoc Ama|SV*|newSVpvs_flags|"literal string"|U32 flags -Like C, but takes a literal string instead of -a string/length pair. +Like C, but takes a literal string instead of a string/length +pair. =for apidoc Ama|SV*|newSVpvs_share|"literal string" -Like C, but takes a literal string instead of -a string/length pair and omits the hash parameter. +Like C, but takes a literal string instead of a string/length +pair and omits the hash parameter. =for apidoc Am|void|sv_catpvs_flags|SV* sv|"literal string"|I32 flags -Like C, but takes a literal string instead -of a string/length pair. +Like C, but takes a literal string instead of a string/length +pair. =for apidoc Am|void|sv_catpvs_nomg|SV* sv|"literal string" -Like C, but takes a literal string instead of -a string/length pair. +Like C, but takes a literal string instead of a string/length +pair. =for apidoc Am|void|sv_catpvs|SV* sv|"literal string" -Like C, but takes a literal string instead of a -string/length pair. +Like C, but takes a literal string instead of a string/length pair. =for apidoc Am|void|sv_catpvs_mg|SV* sv|"literal string" -Like C, but takes a literal string instead of a -string/length pair. +Like C, but takes a literal string instead of a string/length +pair. =for apidoc Am|SV *|sv_setref_pvs|SV *const rv|const char *const classname|"literal string" -Like C, but takes a literal string instead of -a string/length pair. +Like C, but takes a literal string instead of a string/length +pair. =for apidoc_section $string =for apidoc Ama|char*|savepvs|"literal string" -Like C, but takes a literal string instead of a -string/length pair. +Like C, but takes a literal string instead of a string/length pair. =for apidoc Ama|char*|savesharedpvs|"literal string" -A version of C which allocates the duplicate string in memory -which is shared between threads. +A version of C which allocates the duplicate string in memory which +is shared between threads. =for apidoc_section $GV =for apidoc Am|HV*|gv_stashpvs|"name"|I32 create -Like C, but takes a literal string instead of a -string/length pair. +Like C, but takes a literal string instead of a string/length +pair. =for apidoc_section $HV =for apidoc Am|SV**|hv_fetchs|HV* tb|"key"|I32 lval -Like C, but takes a literal string instead of a -string/length pair. +Like C, but takes a literal string instead of a string/length pair. =for apidoc_section $lexer =for apidoc Amx|void|lex_stuff_pvs|"pv"|U32 flags -Like L, but takes a literal string instead of -a string/length pair. +Like L, but takes a literal string instead of a string/length +pair. =cut */ @@ -454,39 +449,40 @@ Perl_xxx(aTHX_ ...) form for any API calls where it's used. =cut */ -#define STR_WITH_LEN(s) ASSERT_IS_LITERAL(s), (sizeof(s)-1) +#define STR_WITH_LEN(s) ASSERT_IS_LITERAL(s), (sizeof(s)-1) /* STR_WITH_LEN() shortcuts */ -#define newSVpvs(str) Perl_newSVpvn(aTHX_ STR_WITH_LEN(str)) -#define newSVpvs_flags(str,flags) \ +#define newSVpvs(str) Perl_newSVpvn(aTHX_ STR_WITH_LEN(str)) +#define newSVpvs_flags(str,flags) \ Perl_newSVpvn_flags(aTHX_ STR_WITH_LEN(str), flags) #define newSVpvs_share(str) Perl_newSVpvn_share(aTHX_ STR_WITH_LEN(str), 0) #define sv_catpvs_flags(sv, str, flags) \ Perl_sv_catpvn_flags(aTHX_ sv, STR_WITH_LEN(str), flags) #define sv_catpvs_nomg(sv, str) \ Perl_sv_catpvn_flags(aTHX_ sv, STR_WITH_LEN(str), 0) -#define sv_catpvs(sv, str) \ +#define sv_catpvs(sv, str) \ Perl_sv_catpvn_flags(aTHX_ sv, STR_WITH_LEN(str), SV_GMAGIC) -#define sv_catpvs_mg(sv, str) \ +#define sv_catpvs_mg(sv, str) \ Perl_sv_catpvn_flags(aTHX_ sv, STR_WITH_LEN(str), SV_GMAGIC|SV_SMAGIC) -#define sv_setpvs(sv, str) Perl_sv_setpvn(aTHX_ sv, STR_WITH_LEN(str)) +#define sv_setpvs(sv, str) Perl_sv_setpvn(aTHX_ sv, STR_WITH_LEN(str)) #define sv_setpvs_mg(sv, str) Perl_sv_setpvn_mg(aTHX_ sv, STR_WITH_LEN(str)) -#define sv_setref_pvs(rv, classname, str) \ +#define sv_setref_pvs(rv, classname, str) \ Perl_sv_setref_pvn(aTHX_ rv, classname, STR_WITH_LEN(str)) -#define savepvs(str) Perl_savepvn(aTHX_ STR_WITH_LEN(str)) -#define savesharedpvs(str) Perl_savesharedpvn(aTHX_ STR_WITH_LEN(str)) -#define gv_stashpvs(str, create) \ +#define savepvs(str) Perl_savepvn(aTHX_ STR_WITH_LEN(str)) +#define savesharedpvs(str) Perl_savesharedpvn(aTHX_ STR_WITH_LEN(str)) +#define gv_stashpvs(str, create) \ Perl_gv_stashpvn(aTHX_ STR_WITH_LEN(str), create) -#define gv_fetchpvs(namebeg, flags, sv_type) \ +#define gv_fetchpvs(namebeg, flags, sv_type) \ Perl_gv_fetchpvn_flags(aTHX_ STR_WITH_LEN(namebeg), flags, sv_type) -#define gv_fetchpvn gv_fetchpvn_flags +#define gv_fetchpvn gv_fetchpvn_flags -#define lex_stuff_pvs(pv,flags) Perl_lex_stuff_pvn(aTHX_ STR_WITH_LEN(pv), flags) +#define lex_stuff_pvs(pv,flags) \ + Perl_lex_stuff_pvn(aTHX_ STR_WITH_LEN(pv), flags) -#define get_cvs(str, flags) \ - Perl_get_cvn_flags(aTHX_ STR_WITH_LEN(str), (flags)) +#define get_cvs(str, flags) \ + Perl_get_cvn_flags(aTHX_ STR_WITH_LEN(str), (flags)) /* internal helpers */ /* Transitional */ @@ -506,12 +502,12 @@ Perl_xxx(aTHX_ ...) form for any API calls where it's used. # undef PERL_SUBVERSION #endif -#define PERL_JNP_TO_DECIMAL_(maJor,miNor,Patch) \ - /* '10*' leaves room for things like alpha, beta, releases */ \ - (10 * ((maJor) * 1000000) + ((miNor) * 1000) + (Patch)) -#define PERL_DECIMAL_VERSION_ \ - PERL_JNP_TO_DECIMAL_(PERL_VERSION_MAJOR, PERL_VERSION_MINOR, \ - PERL_VERSION_PATCH) +#define PERL_JNP_TO_DECIMAL_(maJor,miNor,Patch) \ + /* '10*' leaves room for things like alpha, beta, releases */ \ + (10 * ((maJor) * 1000000) + ((miNor) * 1000) + (Patch)) +#define PERL_DECIMAL_VERSION_ \ + PERL_JNP_TO_DECIMAL_(PERL_VERSION_MAJOR, PERL_VERSION_MINOR, \ + PERL_VERSION_PATCH) /* =for apidoc_section $versioning @@ -533,8 +529,8 @@ relationship to the perl given by the parameters. For example, Note that this is usable in making compile-time decisions -You may use the special value '*' for the final number to mean ALL possible -values for it. Thus, +You may use the special value '*' for the final number to mean ALL +possible values for it. Thus, #if PERL_VERSION_EQ(5,31,'*') @@ -550,8 +546,8 @@ is effectively #if PERL_VERSION_LT(5,10,0) -This means you don't have to think so much when converting from the existing -deprecated C to using this macro: +This means you don't have to think so much when converting from the +existing deprecated C to using this macro: #if PERL_VERSION <= 9 @@ -562,92 +558,92 @@ becomes =cut */ -/* N.B. These don't work if the patch version is 42 or 92, as those are what - * '*' is in ASCII and EBCDIC respectively */ -# define PERL_VERSION_EQ(j,n,p) \ - (((p) == '*') \ - ? ( (j) == PERL_VERSION_MAJOR \ - && (n) == PERL_VERSION_MINOR) \ - : (PERL_DECIMAL_VERSION_ == PERL_JNP_TO_DECIMAL_(j,n,p))) -# define PERL_VERSION_NE(j,n,p) (! PERL_VERSION_EQ(j,n,p)) - -# define PERL_VERSION_LT(j,n,p) /* < '*' effectively means < 0 */ \ - (PERL_DECIMAL_VERSION_ < PERL_JNP_TO_DECIMAL_( (j), \ - (n), \ - (((p) == '*') ? 0 : p))) +/* N.B. These don't work if the patch version is 42 or 92, as + * those are what '*' is in ASCII and EBCDIC respectively */ +# define PERL_VERSION_EQ(j,n,p) \ + (((p) == '*') \ + ? ( (j) == PERL_VERSION_MAJOR \ + && (n) == PERL_VERSION_MINOR) \ + : (PERL_DECIMAL_VERSION_ == PERL_JNP_TO_DECIMAL_(j,n,p))) +# define PERL_VERSION_NE(j,n,p) (! PERL_VERSION_EQ(j,n,p)) + +# define PERL_VERSION_LT(j,n,p) \ + /* < '*' effectively means < 0 */ \ + (PERL_DECIMAL_VERSION_ < PERL_JNP_TO_DECIMAL_( (j), \ + (n), \ + (((p) == '*') ? 0 : p))) # define PERL_VERSION_GE(j,n,p) (! PERL_VERSION_LT(j,n,p)) -# define PERL_VERSION_LE(j,n,p) /* <= '*' effectively means < n+1 */ \ - (PERL_DECIMAL_VERSION_ < PERL_JNP_TO_DECIMAL_( (j), \ - (((p) == '*') ? ((n)+1) : (n)), \ - (((p) == '*') ? 0 : p))) -# define PERL_VERSION_GT(j,n,p) (! PERL_VERSION_LE(j,n,p)) +# define PERL_VERSION_LE(j,n,p) \ + /* <= '*' effectively means < n+1 */ \ + (PERL_DECIMAL_VERSION_ < PERL_JNP_TO_DECIMAL_( (j), \ + (((p) == '*') ? ((n)+1) : (n)), \ + (((p) == '*') ? 0 : p))) +# define PERL_VERSION_GT(j,n,p) (! PERL_VERSION_LE(j,n,p)) /* =for apidoc_section $string =for apidoc Am|bool|strNE|char* s1|char* s2 -Test two C-terminated strings to see if they are different. Returns true -or false. +Test two C-terminated strings to see if they are different. Returns +true or false. =for apidoc Am|bool|strEQ|char* s1|char* s2 Test two C-terminated strings to see if they are equal. Returns true or false. =for apidoc Am|bool|strLT|char* s1|char* s2 -Test two C-terminated strings to see if the first, C, is less than the -second, C. Returns true or false. +Test two C-terminated strings to see if the first, C, is less than +the second, C. Returns true or false. =for apidoc Am|bool|strLE|char* s1|char* s2 -Test two C-terminated strings to see if the first, C, is less than or -equal to the second, C. Returns true or false. +Test two C-terminated strings to see if the first, C, is less than +or equal to the second, C. Returns true or false. =for apidoc Am|bool|strGT|char* s1|char* s2 -Test two C-terminated strings to see if the first, C, is greater than -the second, C. Returns true or false. +Test two C-terminated strings to see if the first, C, is greater +than the second, C. Returns true or false. =for apidoc Am|bool|strGE|char* s1|char* s2 -Test two C-terminated strings to see if the first, C, is greater than -or equal to the second, C. Returns true or false. +Test two C-terminated strings to see if the first, C, is greater +than or equal to the second, C. Returns true or false. =for apidoc Am|bool|strnNE|char* s1|char* s2|STRLEN len Test two C-terminated strings to see if they are different. The C -parameter indicates the number of bytes to compare. Returns true or false. (A -wrapper for C). +parameter indicates the number of bytes to compare. Returns true or false. +(A wrapper for C). =for apidoc Am|bool|strnEQ|char* s1|char* s2|STRLEN len Test two C-terminated strings to see if they are equal. The C -parameter indicates the number of bytes to compare. Returns true or false. (A -wrapper for C). +parameter indicates the number of bytes to compare. Returns true or false. +(A wrapper for C). =for apidoc Am|bool|memEQ|char* s1|char* s2|STRLEN len -Test two buffers (which may contain embedded C characters, to see if they -are equal. The C parameter indicates the number of bytes to compare. -Returns true or false. It is undefined behavior if either of the buffers -doesn't contain at least C bytes. +Test two buffers (which may contain embedded C characters, to see if +they are equal. The C parameter indicates the number of bytes to +compare. Returns true or false. It is undefined behavior if either of the +buffers doesn't contain at least C bytes. =for apidoc Am|bool|memEQs|char* s1|STRLEN l1|"s2" Like L, but the second string is a literal enclosed in double quotes, -C gives the number of bytes in C. -Returns true or false. +C gives the number of bytes in C. Returns true or false. =for apidoc Am|bool|memNE|char* s1|char* s2|STRLEN len -Test two buffers (which may contain embedded C characters, to see if they -are not equal. The C parameter indicates the number of bytes to compare. -Returns true or false. It is undefined behavior if either of the buffers -doesn't contain at least C bytes. +Test two buffers (which may contain embedded C characters, to see if +they are not equal. The C parameter indicates the number of bytes to +compare. Returns true or false. It is undefined behavior if either of the +buffers doesn't contain at least C bytes. =for apidoc Am|bool|memNEs|char* s1|STRLEN l1|"s2" Like L, but the second string is a literal enclosed in double quotes, -C gives the number of bytes in C. -Returns true or false. +C gives the number of bytes in C. Returns true or false. =for apidoc Am|bool|memCHRs|"list"|char c Returns the position of the first occurrence of the byte C in the literal string C<"list">, or NULL if C doesn't appear in C<"list">. All bytes are -treated as unsigned char. Thus this macro can be used to determine if C is -in a set of particular characters. Unlike L, it works even if C -is C (and the set doesn't include C). +treated as unsigned char. Thus this macro can be used to determine if C +is in a set of particular characters. Unlike L, it works even if +C is C (and the set doesn't include C). =cut @@ -694,66 +690,66 @@ based on the underlying C library functions): substring of the 1st string. 'P' if present indicates that the substring must be a "proper" one in tha mathematical sense that the first one must be strictly larger than the 2nd. - */ -#define strNE(s1,s2) (strcmp(s1,s2) != 0) -#define strEQ(s1,s2) (strcmp(s1,s2) == 0) -#define strLT(s1,s2) (strcmp(s1,s2) < 0) -#define strLE(s1,s2) (strcmp(s1,s2) <= 0) -#define strGT(s1,s2) (strcmp(s1,s2) > 0) -#define strGE(s1,s2) (strcmp(s1,s2) >= 0) +#define strNE(s1,s2) (strcmp(s1,s2) != 0) +#define strEQ(s1,s2) (strcmp(s1,s2) == 0) +#define strLT(s1,s2) (strcmp(s1,s2) < 0) +#define strLE(s1,s2) (strcmp(s1,s2) <= 0) +#define strGT(s1,s2) (strcmp(s1,s2) > 0) +#define strGE(s1,s2) (strcmp(s1,s2) >= 0) -#define strnNE(s1,s2,l) (strncmp(s1,s2,l) != 0) -#define strnEQ(s1,s2,l) (strncmp(s1,s2,l) == 0) +#define strnNE(s1,s2,l) (strncmp(s1,s2,l) != 0) +#define strnEQ(s1,s2,l) (strncmp(s1,s2,l) == 0) -#define memEQ(s1,s2,l) (memcmp(((const void *) (s1)), ((const void *) (s2)), l) == 0) -#define memNE(s1,s2,l) (! memEQ(s1,s2,l)) +#define memEQ(s1,s2,l) \ + (memcmp(((const void *) (s1)), ((const void *) (s2)), l) == 0) +#define memNE(s1,s2,l) (! memEQ(s1,s2,l)) /* memEQ and memNE where second comparand is a string constant */ -#define memEQs(s1, l, s2) \ - (((sizeof(s2)-1) == (l)) && memEQ((s1), ASSERT_IS_LITERAL(s2), (sizeof(s2)-1))) -#define memNEs(s1, l, s2) (! memEQs(s1, l, s2)) +#define memEQs(s1, l, s2) \ + (((sizeof(s2)-1) == (l)) && memEQ((s1), ASSERT_IS_LITERAL(s2), (sizeof(s2)-1))) +#define memNEs(s1, l, s2) (! memEQs(s1, l, s2)) /* Keep these private until we decide it was a good idea */ #if defined(PERL_CORE) || defined(PERL_EXT) || defined(PERL_EXT_POSIX) -#define strBEGINs(s1,s2) (strncmp(s1,ASSERT_IS_LITERAL(s2), sizeof(s2)-1) == 0) - -#define memBEGINs(s1, l, s2) \ - ( (Ptrdiff_t) (l) >= (Ptrdiff_t) sizeof(s2) - 1 \ - && memEQ(s1, ASSERT_IS_LITERAL(s2), sizeof(s2)-1)) -#define memBEGINPs(s1, l, s2) \ - ( (Ptrdiff_t) (l) > (Ptrdiff_t) sizeof(s2) - 1 \ - && memEQ(s1, ASSERT_IS_LITERAL(s2), sizeof(s2)-1)) -#define memENDs(s1, l, s2) \ - ( (Ptrdiff_t) (l) >= (Ptrdiff_t) sizeof(s2) - 1 \ - && memEQ(s1 + (l) - (sizeof(s2) - 1), ASSERT_IS_LITERAL(s2), sizeof(s2)-1)) -#define memENDPs(s1, l, s2) \ - ( (Ptrdiff_t) (l) > (Ptrdiff_t) sizeof(s2) \ - && memEQ(s1 + (l) - (sizeof(s2) - 1), ASSERT_IS_LITERAL(s2), sizeof(s2)-1)) +#define strBEGINs(s1,s2) (strncmp(s1,ASSERT_IS_LITERAL(s2), sizeof(s2)-1) == 0) + +#define memBEGINs(s1, l, s2) \ + ( (Ptrdiff_t) (l) >= (Ptrdiff_t) sizeof(s2) - 1 \ + && memEQ(s1, ASSERT_IS_LITERAL(s2), sizeof(s2)-1)) +#define memBEGINPs(s1, l, s2) \ + ( (Ptrdiff_t) (l) > (Ptrdiff_t) sizeof(s2) - 1 \ + && memEQ(s1, ASSERT_IS_LITERAL(s2), sizeof(s2)-1)) +#define memENDs(s1, l, s2) \ + ( (Ptrdiff_t) (l) >= (Ptrdiff_t) sizeof(s2) - 1 \ + && memEQ(s1 + (l) - (sizeof(s2) - 1), ASSERT_IS_LITERAL(s2), sizeof(s2)-1)) +#define memENDPs(s1, l, s2) \ + ( (Ptrdiff_t) (l) > (Ptrdiff_t) sizeof(s2) \ + && memEQ(s1 + (l) - (sizeof(s2) - 1), ASSERT_IS_LITERAL(s2), sizeof(s2)-1)) #endif /* End of making macros private */ -#define memLT(s1,s2,l) (memcmp(s1,s2,l) < 0) -#define memLE(s1,s2,l) (memcmp(s1,s2,l) <= 0) -#define memGT(s1,s2,l) (memcmp(s1,s2,l) > 0) -#define memGE(s1,s2,l) (memcmp(s1,s2,l) >= 0) +#define memLT(s1,s2,l) (memcmp(s1,s2,l) < 0) +#define memLE(s1,s2,l) (memcmp(s1,s2,l) <= 0) +#define memGT(s1,s2,l) (memcmp(s1,s2,l) > 0) +#define memGE(s1,s2,l) (memcmp(s1,s2,l) >= 0) -#define memCHRs(s1,c) ((const char *) memchr(ASSERT_IS_LITERAL(s1) , c, sizeof(s1)-1)) +#define memCHRs(s1,c) \ + ((const char *) memchr(ASSERT_IS_LITERAL(s1) , c, sizeof(s1)-1)) /* * Character classes. * - * Unfortunately, the introduction of locales means that we - * can't trust isupper(), etc. to tell the truth. And when - * it comes to /\w+/ with tainting enabled, we *must* be able - * to trust our character classes. + * Unfortunately, the introduction of locales means that we can't trust + * isupper(), etc. to tell the truth. And when it comes to /\w+/ with + * tainting enabled, we *must* be able to trust our character classes. * - * Therefore, the default tests in the text of Perl will be independent of - * locale. Any code that wants to depend on the current locale will use the - * macros that contain _LC in their names - */ + * Therefore, the default tests in the text of Perl will be independent + * of locale. Any code that wants to depend on the current locale will + * use the macros that contain _LC in their names +*/ #ifdef USE_LOCALE_CTYPE # ifndef CTYPE256 @@ -764,13 +760,13 @@ based on the underlying C library functions): /* =head1 Character classification -This section is about functions (really macros) that classify characters -into types, such as punctuation versus alphabetic, etc. Most of these are -analogous to regular expression character classes. (See -L.) There are several variants for -each class. (Not all macros have all variants; each item below lists the -ones valid for it.) None are affected by C, and only the ones -with C in the name are affected by the current locale. +This section is about functions (really macros) that classify characters into +types, such as punctuation versus alphabetic, etc. Most of these are analogous +to regular expression character classes. (See +L.) There are several variants for +each class. (Not all macros have all variants; each item below lists the ones +valid for it.) None are affected by C, and only the ones with C +in the name are affected by the current locale. The base function, e.g., C, takes any signed or unsigned value, treating it as a code point, and returns a boolean as to whether or not the @@ -778,19 +774,19 @@ character represented by it is (or on non-ASCII platforms, corresponds to) an ASCII character in the named class based on platform, Unicode, and Perl rules. If the input is a number that doesn't fit in an octet, FALSE is returned. -Variant C_A> (e.g., C) is identical to the base function -with no suffix C<"_A">. This variant is used to emphasize by its name that -only ASCII-range characters can return TRUE. +Variant C_A> (e.g., C) is identical to the base +function with no suffix C<"_A">. This variant is used to emphasize by its name +that only ASCII-range characters can return TRUE. Variant C_L1> imposes the Latin-1 (or EBCDIC equivalent) character set onto the platform. That is, the code points that are ASCII are unaffected, since ASCII is a subset of Latin-1. But the non-ASCII code points are treated as if they are Latin-1 characters. For example, C will return true when called with the code point 0xDF, which is a word character in both -ASCII and EBCDIC (though it represents different characters in each). -If the input is a number that doesn't fit in an octet, FALSE is returned. -(Perl's documentation uses a colloquial definition of Latin-1, to include all -code points below 256.) +ASCII and EBCDIC (though it represents different characters in each). If the +input is a number that doesn't fit in an octet, FALSE is returned. (Perl's +documentation uses a colloquial definition of Latin-1, to include all code +points below 256.) Variant C_uvchr> is exactly like the C_L1> variant, for inputs below 256, but if the code point is larger than 255, Unicode rules are @@ -847,9 +843,9 @@ future releases. =for apidoc_item ||isALPHA_utf8_safe|U8 * s|U8 * end =for apidoc_item ||isALPHA_uvchr|UV ch Returns a boolean indicating whether the specified input is one of C<[A-Za-z]>, -analogous to C. -See the L for an explanation of -the variants. +analogous to C. See the +L for an explanation of the +variants. =cut @@ -866,18 +862,18 @@ that would be interested in them, such as Devel::PPPort =for apidoc_item ||isALPHANUMERIC_utf8_safe|U8 * s|U8 * end =for apidoc_item ||isALPHANUMERIC_uvchr|UV ch Returns a boolean indicating whether the specified character is one of -C<[A-Za-z0-9]>, analogous to C. -See the L for an explanation of -the variants. +C<[A-Za-z0-9]>, analogous to C. See the +L for an explanation of the +variants. =for apidoc Am|bool|isALNUMC|UV ch =for apidoc_item ||isALNUMC_A|UV ch =for apidoc_item ||isALNUMC_LC|UV ch =for apidoc_item ||isALNUMC_LC_uvchr|UV ch =for apidoc_item ||isALNUMC_L1|UV ch -These are discouraged, backward compatibility macros for L>. -That is, each returns a boolean indicating whether the specified character is -one of C<[A-Za-z0-9]>, analogous to C. +These are discouraged, backward compatibility macros for +L>. That is, each returns a boolean indicating whether the +specified character is one of C<[A-Za-z0-9]>, analogous to C. The C suffix in the names was meant to indicate that they correspond to the C language L>. @@ -892,15 +888,13 @@ C language L>. =for apidoc_item ||isASCII_utf8_safe|U8 * s|U8 * end =for apidoc_item ||isASCII_uvchr|UV ch Returns a boolean indicating whether the specified character is one of the 128 -characters in the ASCII character set, analogous to C. -On non-ASCII platforms, it returns TRUE iff this -character corresponds to an ASCII character. Variants C and -C are identical to C. -See the L for an explanation of -the variants. -Note, however, that some platforms do not have the C library routine -C. In these cases, the variants whose names contain C are the -same as the corresponding ones without. +characters in the ASCII character set, analogous to C. On +non-ASCII platforms, it returns TRUE iff this character corresponds to an ASCII +character. Variants C and C are identical to +C. See the L for an +explanation of the variants. Note, however, that some platforms do not have +the C library routine C. In these cases, the variants whose names +contain C are the same as the corresponding ones without. Also note, that because all ASCII characters are UTF-8 invariant (meaning they have the exact same representation (always a single byte) whether encoded in @@ -917,14 +911,12 @@ C will work properly on any string encoded or not in UTF-8. =for apidoc_item ||isBLANK_utf8|U8 * s|U8 * end =for apidoc_item ||isBLANK_utf8_safe|U8 * s|U8 * end =for apidoc_item ||isBLANK_uvchr|UV ch -Returns a boolean indicating whether the specified character is a -character considered to be a blank, analogous to C. -See the L for an explanation of -the variants. -Note, -however, that some platforms do not have the C library routine -C. In these cases, the variants whose names contain C are -the same as the corresponding ones without. +Returns a boolean indicating whether the specified character is a character +considered to be a blank, analogous to C. See the +L for an explanation of the +variants. Note, however, that some platforms do not have the C library routine +C. In these cases, the variants whose names contain C are the +same as the corresponding ones without. =for apidoc Am|bool|isCNTRL|UV ch =for apidoc_item ||isCNTRL_A|UV ch @@ -936,11 +928,11 @@ the same as the corresponding ones without. =for apidoc_item ||isCNTRL_utf8_safe|U8 * s|U8 * end =for apidoc_item ||isCNTRL_uvchr|UV ch -Returns a boolean indicating whether the specified character is a -control character, analogous to C. -See the L for an explanation of -the variants. -On EBCDIC platforms, you almost always want to use the C variant. +Returns a boolean indicating whether the specified character is a control +character, analogous to C. See the +L for an explanation of the +variants. On EBCDIC platforms, you almost always want to use the C +variant. =for apidoc Am|bool|isDIGIT|UV ch =for apidoc_item ||isDIGIT_A|UV ch @@ -952,11 +944,11 @@ On EBCDIC platforms, you almost always want to use the C variant. =for apidoc_item ||isDIGIT_utf8_safe|U8 * s|U8 * end =for apidoc_item ||isDIGIT_uvchr|UV ch -Returns a boolean indicating whether the specified character is a -digit, analogous to C. -Variants C and C are identical to C. -See the L for an explanation of -the variants. +Returns a boolean indicating whether the specified character is a digit, +analogous to C. Variants C and C are +identical to C. See the +L for an explanation of the +variants. =for apidoc Am|bool|isGRAPH|UV ch =for apidoc_item ||isGRAPH_A|UV ch @@ -967,10 +959,10 @@ the variants. =for apidoc_item ||isGRAPH_utf8|U8 * s|U8 * end =for apidoc_item ||isGRAPH_utf8_safe|U8 * s|U8 * end =for apidoc_item ||isGRAPH_uvchr|UV ch -Returns a boolean indicating whether the specified character is a -graphic character, analogous to C. -See the L for an explanation of -the variants. +Returns a boolean indicating whether the specified character is a graphic +character, analogous to C. See the +L for an explanation of the +variants. =for apidoc Am|bool|isLOWER|UV ch =for apidoc_item ||isLOWER_A|UV ch @@ -981,18 +973,17 @@ the variants. =for apidoc_item ||isLOWER_utf8|U8 * s|U8 * end =for apidoc_item ||isLOWER_utf8_safe|U8 * s|U8 * end =for apidoc_item ||isLOWER_uvchr|UV ch -Returns a boolean indicating whether the specified character is a -lowercase character, analogous to C. -See the L for an explanation of -the variants +Returns a boolean indicating whether the specified character is a lowercase +character, analogous to C. See the +L for an explanation of the +variants =for apidoc Am|bool|isOCTAL|UV ch =for apidoc_item ||isOCTAL_A|UV ch =for apidoc_item ||isOCTAL_L1|UV ch -Returns a boolean indicating whether the specified character is an -octal digit, [0-7]. -The only two variants are C and C; each is identical to -C. +Returns a boolean indicating whether the specified character is an octal digit, +[0-7]. The only two variants are C and C; each is +identical to C. =for apidoc Am|bool|isPUNCT|UV ch =for apidoc_item ||isPUNCT_A|UV ch @@ -1003,13 +994,12 @@ C. =for apidoc_item ||isPUNCT_utf8|U8 * s|U8 * end =for apidoc_item ||isPUNCT_utf8_safe|U8 * s|U8 * end =for apidoc_item ||isPUNCT_uvchr|UV ch -Returns a boolean indicating whether the specified character is a -punctuation character, analogous to C. -Note that the definition of what is punctuation isn't as -straightforward as one might desire. See L for details. -See the L for an explanation of -the variants. +Returns a boolean indicating whether the specified character is a punctuation +character, analogous to C. Note that the definition of what is +punctuation isn't as straightforward as one might desire. See +L for details. See the +L for an explanation of the +variants. =for apidoc Am|bool|isSPACE|UV ch =for apidoc_item ||isSPACE_A|UV ch @@ -1020,16 +1010,16 @@ the variants. =for apidoc_item ||isSPACE_utf8|U8 * s|U8 * end =for apidoc_item ||isSPACE_utf8_safe|U8 * s|U8 * end =for apidoc_item ||isSPACE_uvchr|UV ch -Returns a boolean indicating whether the specified character is a -whitespace character. This is analogous -to what C matches in a regular expression. Starting in Perl 5.18 -this also matches what C does. Prior to 5.18, only the -locale forms of this macro (the ones with C in their names) matched -precisely what C does. In those releases, the only difference, -in the non-locale variants, was that C did not match a vertical tab. -(See L for a macro that matches a vertical tab in all releases.) -See the L for an explanation of -the variants. +Returns a boolean indicating whether the specified character is a whitespace +character. This is analogous to what C matches in a regular +expression. Starting in Perl 5.18 this also matches what C +does. Prior to 5.18, only the locale forms of this macro (the ones with C +in their names) matched precisely what C does. In those +releases, the only difference, in the non-locale variants, was that +C did not match a vertical tab. (See L for a macro that +matches a vertical tab in all releases.) See the +L for an explanation of the +variants. =for apidoc Am|bool|isPSXSPC|UV ch =for apidoc_item ||isPSXSPC_A|UV ch @@ -1040,17 +1030,15 @@ the variants. =for apidoc_item ||isPSXSPC_utf8|U8 * s|U8 * end =for apidoc_item ||isPSXSPC_utf8_safe|U8 * s|U8 * end =for apidoc_item ||isPSXSPC_uvchr|UV ch -(short for Posix Space) -Starting in 5.18, this is identical in all its forms to the -corresponding C macros. -The locale forms of this macro are identical to their corresponding -C forms in all Perl releases. In releases prior to 5.18, the -non-locale forms differ from their C forms only in that the -C forms don't match a Vertical Tab, and the C forms do. -Otherwise they are identical. Thus this macro is analogous to what -C matches in a regular expression. -See the L for an explanation of -the variants. +(short for Posix Space) Starting in 5.18, this is identical in all its forms +to the corresponding C macros. The locale forms of this macro are +identical to their corresponding C forms in all Perl releases. In +releases prior to 5.18, the non-locale forms differ from their C +forms only in that the C forms don't match a Vertical Tab, and the +C forms do. Otherwise they are identical. Thus this macro is +analogous to what C matches in a regular expression. See the +L for an explanation of the +variants. =for apidoc Am|bool|isUPPER|UV ch =for apidoc_item ||isUPPER_A|UV ch @@ -1061,10 +1049,10 @@ the variants. =for apidoc_item ||isUPPER_utf8|U8 * s|U8 * end =for apidoc_item ||isUPPER_utf8_safe|U8 * s|U8 * end =for apidoc_item ||isUPPER_uvchr|UV ch -Returns a boolean indicating whether the specified character is an -uppercase character, analogous to C. -See the L for an explanation of -the variants. +Returns a boolean indicating whether the specified character is an uppercase +character, analogous to C. See the +L for an explanation of the +variants. =for apidoc Am|bool|isPRINT|UV ch =for apidoc_item ||isPRINT_A|UV ch @@ -1075,10 +1063,10 @@ the variants. =for apidoc_item ||isPRINT_utf8|U8 * s|U8 * end =for apidoc_item ||isPRINT_utf8_safe|U8 * s|U8 * end =for apidoc_item ||isPRINT_uvchr|UV ch -Returns a boolean indicating whether the specified character is a -printable character, analogous to C. -See the L for an explanation of -the variants. +Returns a boolean indicating whether the specified character is a printable +character, analogous to C. See the +L for an explanation of the +variants. =for apidoc Am|bool|isWORDCHAR|UV ch =for apidoc_item ||isWORDCHAR_A|UV ch @@ -1092,16 +1080,16 @@ the variants. Returns a boolean indicating whether the specified character is a character that is a word character, analogous to what C and C match in a regular expression. A word character is an alphabetic character, a -decimal digit, a connecting punctuation character (such as an underscore), or -a "mark" character that attaches to one of those (like some sort of accent). +decimal digit, a connecting punctuation character (such as an underscore), or a +"mark" character that attaches to one of those (like some sort of accent). See the L for an explanation of the variants. -C, C, C, -C, C, C, and -C are also as described there, but additionally -include the platform's native underscore. +C, C, C, C, +C, C, and C +are also as described there, but additionally include the platform's native +underscore. =for apidoc Am|bool|isALNUM |UV ch =for apidoc_item ||isALNUM_A |UV ch @@ -1111,9 +1099,8 @@ These are each a synonym for their respectively named L> variant. They are provided for backward compatibility, even though a word character -includes more than the standard C language meaning of alphanumeric. -To get the C language definition, use the corresponding L> -variant. +includes more than the standard C language meaning of alphanumeric. To get the +C language definition, use the corresponding L> variant. =for apidoc Am|bool|isXDIGIT|UV ch =for apidoc_item ||isXDIGIT_A|UV ch @@ -1126,9 +1113,9 @@ variant. =for apidoc_item ||isXDIGIT_uvchr|UV ch Returns a boolean indicating whether the specified character is a hexadecimal digit. In the ASCII range these are C<[0-9A-Fa-f]>. Variants C -and C are identical to C. -See the L for an explanation of -the variants. +and C are identical to C. See the +L for an explanation of the +variants. =for apidoc Am|bool|isIDFIRST|UV ch =for apidoc_item ||isIDFIRST_A|UV ch @@ -1142,9 +1129,9 @@ the variants. Returns a boolean indicating whether the specified character can be the first character of an identifier. This is very close to, but not quite the same as the official Unicode property C. The difference is that this -returns true only if the input character also matches L. -See the L for an explanation of -the variants. +returns true only if the input character also matches L. See the +L for an explanation of the +variants. =for apidoc Am|bool|isIDCONT|UV ch =for apidoc_item ||isIDCONT_A|UV ch @@ -1155,10 +1142,10 @@ the variants. =for apidoc_item ||isIDCONT_utf8|U8 * s|U8 * end =for apidoc_item ||isIDCONT_utf8_safe|U8 * s|U8 * end =for apidoc_item ||isIDCONT_uvchr|UV ch -Returns a boolean indicating whether the specified character can be the -second or succeeding character of an identifier. This is very close to, but -not quite the same as the official Unicode property C. The -difference is that this returns true only if the input character also matches +Returns a boolean indicating whether the specified character can be the second +or succeeding character of an identifier. This is very close to, but not quite +the same as the official Unicode property C. The difference is +that this returns true only if the input character also matches L. See the L for an explanation of the variants. @@ -1172,11 +1159,11 @@ Behaviour is only well defined when isXDIGIT(*str) is true. Perl uses "full" Unicode case mappings. This means that converting a single character to another case may result in a sequence of more than one character. For example, the uppercase of C> (LATIN SMALL LETTER SHARP S) is the two -character sequence C. This presents some complications The lowercase of +character sequence C. This presents some complications The lowercase of all characters in the range 0..255 is a single character, and thus C> is furnished. But, C can't exist, as it couldn't return a valid result for all legal inputs. Instead C> has -an API that does allow every possible legal result to be returned.) Likewise +an API that does allow every possible legal result to be returned.) Likewise no other function that is crippled by not being able to give the correct results for the full range of possible inputs has been implemented here. @@ -1190,7 +1177,7 @@ These all return the uppercase of a character. The differences are what domain they operate on, and whether the input is specified as a code point (those forms with a C parameter) or as a UTF-8 string (the others). In the latter case, the code point to use is the first one in the buffer of UTF-8 encoded -code points, delineated by the arguments S>. +code points, delineated by the arguments S>. C and C are synonyms of each other. They return the uppercase of any lowercase ASCII-range code point. All other inputs are @@ -1236,20 +1223,20 @@ change in future releases. =for apidoc_item |UV|toFOLD_uvchr|UV cp|U8* s|STRLEN* lenp These all return the foldcase of a character. "foldcase" is an internal case -for C pattern matching. If the foldcase of character A and the foldcase of +for C pattern matching. If the foldcase of character A and the foldcase of character B are the same, they match caselessly; otherwise they don't. The differences in the forms are what domain they operate on, and whether the input is specified as a code point (those forms with a C parameter) or as a UTF-8 string (the others). In the latter case, the code point to use is the first one in the buffer of UTF-8 encoded code points, delineated by the -arguments S>. +arguments S>. -C and C are synonyms of each other. They return the -foldcase of any ASCII-range code point. In this range, the foldcase is -identical to the lowercase. All other inputs are returned unchanged. Since -these are macros, the input type may be any integral one, and the output will -occupy the same number of bits as the input. +C and C are synonyms of each other. They return the foldcase +of any ASCII-range code point. In this range, the foldcase is identical to the +lowercase. All other inputs are returned unchanged. Since these are macros, +the input type may be any integral one, and the output will occupy the same +number of bits as the input. There is no C nor C as the foldcase of some code points in the 0..255 range is above that range or consists of multiple @@ -1257,17 +1244,17 @@ characters. Instead use C. C returns the foldcase of any Unicode code point. The return value is identical to that of C for input code points in the ASCII -range. The foldcase of the vast majority of Unicode code points is the same -as the code point itself. For these, and for code points above the legal -Unicode maximum, this returns the input code point unchanged. It additionally -stores the UTF-8 of the result into the buffer beginning at C, and its -length in bytes into C<*lenp>. The caller must have made C large enough to -contain at least C bytes to avoid possible overflow. - -NOTE: the foldcase of a code point may be more than one code point. The -return value of this function is only the first of these. The entire foldcase -is returned in C. To determine if the result is more than a single code -point, you can do something like this: +range. The foldcase of the vast majority of Unicode code points is the same as +the code point itself. For these, and for code points above the legal Unicode +maximum, this returns the input code point unchanged. It additionally stores +the UTF-8 of the result into the buffer beginning at C, and its length in +bytes into C<*lenp>. The caller must have made C large enough to contain at +least C bytes to avoid possible overflow. + +NOTE: the foldcase of a code point may be more than one code point. The return +value of this function is only the first of these. The entire foldcase is +returned in C. To determine if the result is more than a single code point, +you can do something like this: uc = toFOLD_uvchr(cp, s, &len); if (len > UTF8SKIP(s)) { is multiple code points } @@ -1296,7 +1283,7 @@ These all return the lowercase of a character. The differences are what domain they operate on, and whether the input is specified as a code point (those forms with a C parameter) or as a UTF-8 string (the others). In the latter case, the code point to use is the first one in the buffer of UTF-8 encoded -code points, delineated by the arguments S>. +code points, delineated by the arguments S>. C and C are synonyms of each other. They return the lowercase of any uppercase ASCII-range code point. All other inputs are @@ -1313,13 +1300,14 @@ rules of the current POSIX locale. Input code points outside the range 0..255 are returned unchanged. C returns the lowercase of any Unicode code point. The return -value is identical to that of C for input code points in the 0..255 -range. The lowercase of the vast majority of Unicode code points is the same -as the code point itself. For these, and for code points above the legal -Unicode maximum, this returns the input code point unchanged. It additionally -stores the UTF-8 of the result into the buffer beginning at C, and its -length in bytes into C<*lenp>. The caller must have made C large enough to -contain at least C bytes to avoid possible overflow. +value is identical to that of C for input code points in the +0..255 range. The lowercase of the vast majority of Unicode code points is +the same as the code point itself. For these, and for code points above the +legal Unicode maximum, this returns the input code point unchanged. It +additionally stores the UTF-8 of the result into the buffer beginning at C, +and its length in bytes into C<*lenp>. The caller must have made C large +enough to contain at least C bytes to avoid possible +overflow. NOTE: the lowercase of a code point may be more than one code point. The return value of this function is only the first of these. The entire lowercase @@ -1350,7 +1338,7 @@ These all return the titlecase of a character. The differences are what domain they operate on, and whether the input is specified as a code point (those forms with a C parameter) or as a UTF-8 string (the others). In the latter case, the code point to use is the first one in the buffer of UTF-8 encoded -code points, delineated by the arguments S>. +code points, delineated by the arguments S>. C and C are synonyms of each other. They return the titlecase of any lowercase ASCII-range code point. In this range, the @@ -1394,12 +1382,11 @@ change in future releases. XXX Still undocumented isVERTWS_uvchr and _utf8; it's unclear what their names really should be. Also toUPPER_LC and toFOLD_LC, which are subject to change, -and aren't general purpose as they don't work on U+DF, and assert against that. -and isCASED_LC, as it really is more of an internal thing. - -Note that these macros are repeated in Devel::PPPort, so should also be -patched there. The file as of this writing is cpan/Devel-PPPort/parts/inc/misc +and aren't general purpose as they don't work on U+DF, and assert against +that. and isCASED_LC, as it really is more of an internal thing. +Note that these macros are repeated in Devel::PPPort, so should also be patched +there. The file as of this writing is cpan/Devel-PPPort/parts/inc/misc */ /* @@ -1417,171 +1404,170 @@ or casts my_uv = (WIDEST_UTYPE) val; =cut - */ -#define WIDEST_UTYPE PERL_UINTMAX_T +#define WIDEST_UTYPE PERL_UINTMAX_T -/* Where there could be some confusion, use this as a static assert in macros - * to make sure that a parameter isn't a pointer. But some compilers can't - * handle this. The only one known so far that doesn't is gcc 3.3.6; the check - * below isn't thorough for such an old compiler, so may have to be revised if - * experience so dictates. */ +/* Where there could be some confusion, use this as a static assert in + * macros to make sure that a parameter isn't a pointer. But some + * compilers can't handle this. The only one known so far that doesn't + * is gcc 3.3.6; the check below isn't thorough for such an old + * compiler, so may have to be revised if experience so dictates. */ #if ! PERL_IS_GCC || PERL_GCC_VERSION_GT(3,3,6) -# define ASSERT_NOT_PTR(x) ((x) | 0) +# define ASSERT_NOT_PTR(x) ((x) | 0) #else -# define ASSERT_NOT_PTR(x) (x) +# define ASSERT_NOT_PTR(x) (x) #endif -/* Likewise, this is effectively a static assert to be used to guarantee the - * parameter is a pointer +/* Likewise, this is effectively a static assert to + * be used to guarantee the parameter is a pointer * - * NOT suitable for void* + * NOT suitable for void* */ -#define ASSERT_IS_PTR(x) (__ASSERT_(sizeof(*(x))) (x)) +#define ASSERT_IS_PTR(x) (__ASSERT_(sizeof(*(x))) (x)) -/* FITS_IN_8_BITS(c) returns true if c doesn't have a bit set other than in - * the lower 8. It is designed to be hopefully bomb-proof, making sure that no +/* FITS_IN_8_BITS(c) returns true if c doesn't have a bit set other than in the + * lower 8. It is designed to be hopefully bomb-proof, making sure that no * bits of information are lost even on a 64-bit machine, but to get the * compiler to optimize it out if possible. This is because Configure makes * sure that the machine has an 8-bit byte, so if c is stored in a byte, the * sizeof() guarantees that this evaluates to a constant true at compile time. * - * For Coverity, be always true, because otherwise Coverity thinks - * it finds several expressions that are always true, independent - * of operands. Well, they are, but that is kind of the point. + * For Coverity, be always true, because otherwise Coverity thinks it finds + * several expressions that are always true, independent of operands. Well, + * they are, but that is kind of the point. */ #ifndef __COVERITY__ - /* The '| 0' part in ASSERT_NOT_PTR ensures a compiler error if c is not - * integer (like e.g., a pointer) */ -# define FITS_IN_8_BITS(c) ( (sizeof(c) == 1) \ - || (((WIDEST_UTYPE) ASSERT_NOT_PTR(c)) >> 8) == 0) + /* The '| 0' part in ASSERT_NOT_PTR ensures a compiler error + * if c is not integer (like e.g., a pointer) */ +# define FITS_IN_8_BITS(c) \ + ( (sizeof(c) == 1) || (((WIDEST_UTYPE) ASSERT_NOT_PTR(c)) >> 8) == 0) #else -# define FITS_IN_8_BITS(c) (1) +# define FITS_IN_8_BITS(c) (1) #endif -/* Returns true if l <= c <= (l + n), where 'l' and 'n' are non-negative - * Written this way so that after optimization, only one conditional test is - * needed. (The NV casts stop any warnings about comparison always being true - * if called with an unsigned. The cast preserves the sign, which is all we - * care about.) */ -#define withinCOUNT(c, l, n) (__ASSERT_((NV) (l) >= 0) \ - __ASSERT_((NV) (n) >= 0) \ - withinCOUNT_KNOWN_VALID_((c), (l), (n))) +/* Returns true if l <= c <= (l + n), where 'l' and 'n' are + * non-negative Written this way so that after optimization, only one + * conditional test is needed. (The NV casts stop any warnings about + * comparison always being true if called with an unsigned. The cast + * preserves the sign, which is all we care about.) */ +#define withinCOUNT(c, l, n) \ + (__ASSERT_((NV) (l) >= 0) \ + __ASSERT_((NV) (n) >= 0) \ + withinCOUNT_KNOWN_VALID_((c), (l), (n))) /* For internal use only, this can be used in places where it is known that the * parameters to withinCOUNT() are valid, to avoid the asserts. For example, * inRANGE() below, calls this several times, but does all the necessary * asserts itself, once. The reason that this is necessary is that the * duplicate asserts were exceeding the internal limits of some compilers */ -#define withinCOUNT_KNOWN_VALID_(c, l, n) \ - ((((WIDEST_UTYPE) (c)) - ASSERT_NOT_PTR(l)) \ +#define withinCOUNT_KNOWN_VALID_(c, l, n) \ + ((((WIDEST_UTYPE) (c)) - ASSERT_NOT_PTR(l)) \ <= ((WIDEST_UTYPE) ASSERT_NOT_PTR(n))) -/* Returns true if c is in the range l..u, where 'l' is non-negative - * Written this way so that after optimization, only one conditional test is - * needed. */ -#define inRANGE(c, l, u) (__ASSERT_((NV) (l) >= 0) __ASSERT_((u) >= (l)) \ - ( (sizeof(c) == sizeof(U8)) ? inRANGE_helper_(U8, (c), (l), ((u))) \ - : (sizeof(c) == sizeof(U16)) ? inRANGE_helper_(U16,(c), (l), ((u))) \ - : (sizeof(c) == sizeof(U32)) ? inRANGE_helper_(U32,(c), (l), ((u))) \ - : (__ASSERT_(sizeof(c) == sizeof(WIDEST_UTYPE)) \ - inRANGE_helper_(WIDEST_UTYPE,(c), (l), ((u)))))) +/* Returns true if c is in the range l..u, where 'l' is + * non-negative Written this way so that after optimization, + * only one conditional test is needed. */ +#define inRANGE(c, l, u) \ + (__ASSERT_((NV) (l) >= 0) __ASSERT_((u) >= (l)) \ + ( (sizeof(c) == sizeof(U8)) ? inRANGE_helper_(U8, (c), (l), ((u))) \ + : (sizeof(c) == sizeof(U16)) ? inRANGE_helper_(U16,(c), (l), ((u))) \ + : (sizeof(c) == sizeof(U32)) ? inRANGE_helper_(U32,(c), (l), ((u))) \ + : (__ASSERT_(sizeof(c) == sizeof(WIDEST_UTYPE)) \ + inRANGE_helper_(WIDEST_UTYPE,(c), (l), ((u)))))) /* For internal use, this is used by machine-generated code which generates - * known valid calls, with a known sizeof(). This avoids the extra code and - * asserts that were exceeding internal limits of some compilers. */ -#define inRANGE_helper_(cast, c, l, u) \ - withinCOUNT_KNOWN_VALID_(((cast) (c)), (l), ((u) - (l))) + * known valid calls, with a known sizeof(). This avoids the extra code + * and asserts that were exceeding internal limits of some compilers. */ +#define inRANGE_helper_(cast, c, l, u) \ + withinCOUNT_KNOWN_VALID_(((cast) (c)), (l), ((u) - (l))) #ifdef EBCDIC # ifndef _ALL_SOURCE - /* The native libc isascii() et.al. functions return the wrong results - * on at least z/OS unless this is defined. */ + /* The native libc isascii() et.al. functions return the wrong + * results on at least z/OS unless this is defined. */ # error _ALL_SOURCE should probably be defined # endif #else /* There is a simple definition of ASCII for ASCII platforms. But the - * EBCDIC one isn't so simple, so is defined using table look-up like the - * other macros below. + * EBCDIC one isn't so simple, so is defined using table look-up like + * the other macros below. * - * The cast here is used instead of '(c) >= 0', because some compilers emit - * a warning that that test is always true when the parameter is an - * unsigned type. khw supposes that it could be written as - * && ((c) == '\0' || (c) > 0) - * to avoid the message, but the cast will likely avoid extra branches even - * with stupid compilers. */ -# define isASCII(c) (((WIDEST_UTYPE) ASSERT_NOT_PTR(c)) < 128) + * The cast here is used instead of '(c) >= 0', because some compilers + * emit a warning that that test is always true when the parameter is + * an unsigned type. khw supposes that it could be written as && ((c) + * == '\0' || (c) > 0) to avoid the message, but the cast will likely + * avoid extra branches even with stupid compilers. */ +# define isASCII(c) (((WIDEST_UTYPE) ASSERT_NOT_PTR(c)) < 128) #endif /* Take the eight possible bit patterns of the lower 3 bits and you get the - * lower 3 bits of the 8 octal digits, in both ASCII and EBCDIC, so those bits - * can be ignored. If the rest match '0', we have an octal */ -#define isOCTAL_A(c) ((((WIDEST_UTYPE) ASSERT_NOT_PTR(c)) & ~7) == '0') + * lower 3 bits of the 8 octal digits, in both ASCII and EBCDIC, so those + * bits can be ignored. If the rest match '0', we have an octal */ +#define isOCTAL_A(c) ((((WIDEST_UTYPE) ASSERT_NOT_PTR(c)) & ~7) == '0') #ifdef H_PERL /* If have access to perl.h, lookup in its table */ -/* Character class numbers. For internal core Perl use only. The ones less - * than 32 are used in PL_charclass[] and the ones up through the one that - * corresponds to are used by regcomp.h and - * related files. PL_charclass ones use names used in l1_char_class_tab.h but - * their actual definitions are here. If that file has a name not used here, - * it won't compile. +/* Character class numbers. For internal core Perl use only. The ones + * less than 32 are used in PL_charclass[] and the ones up through the + * one that corresponds to are used by + * regcomp.h and related files. PL_charclass ones use names used in + * l1_char_class_tab.h but their actual definitions are here. If that + * file has a name not used here, it won't compile. * * The first group of these is ordered in what I (khw) estimate to be the - * frequency of their use. This gives a slight edge to exiting a loop earlier - * (in reginclass() in regexec.c). Except \v should be last, as it isn't a - * real Posix character class, and some (small) inefficiencies in regular - * expression handling would be introduced by putting it in the middle of those - * that are. Also, cntrl and ascii come after the others as it may be useful - * to group these which have no members that match above Latin1, (or above - * ASCII in the latter case) */ - -# define CC_WORDCHAR_ 0 /* \w and [:word:] */ -# define CC_DIGIT_ 1 /* \d and [:digit:] */ -# define CC_ALPHA_ 2 /* [:alpha:] */ -# define CC_LOWER_ 3 /* [:lower:] */ -# define CC_UPPER_ 4 /* [:upper:] */ -# define CC_PUNCT_ 5 /* [:punct:] */ -# define CC_PRINT_ 6 /* [:print:] */ -# define CC_ALPHANUMERIC_ 7 /* [:alnum:] */ -# define CC_GRAPH_ 8 /* [:graph:] */ -# define CC_CASED_ 9 /* [:lower:] or [:upper:] under /i */ -# define CC_SPACE_ 10 /* \s, [:space:] */ -# define CC_BLANK_ 11 /* [:blank:] */ -# define CC_XDIGIT_ 12 /* [:xdigit:] */ -# define CC_CNTRL_ 13 /* [:cntrl:] */ -# define CC_ASCII_ 14 /* [:ascii:] */ -# define CC_VERTSPACE_ 15 /* \v */ - -# define HIGHEST_REGCOMP_DOT_H_SYNC_ CC_VERTSPACE_ - -/* The members of the third group below do not need to be coordinated with data - * structures in regcomp.[ch] and regexec.c. */ -# define CC_IDFIRST_ 16 -# define CC_CHARNAME_CONT_ 17 -# define CC_NONLATIN1_FOLD_ 18 -# define CC_NONLATIN1_SIMPLE_FOLD_ 19 -# define CC_QUOTEMETA_ 20 -# define CC_NON_FINAL_FOLD_ 21 -# define CC_IS_IN_SOME_FOLD_ 22 -# define CC_BINDIGIT_ 23 -# define CC_OCTDIGIT_ 24 -# define CC_MNEMONIC_CNTRL_ 25 - -/* Unused: 26-31 - * If more bits are needed, one could add a second word for non-64bit - * QUAD_IS_INT systems, using some #ifdefs to distinguish between having a 2nd - * word or not. The IS_IN_SOME_FOLD bit is the most easily expendable, as it - * is used only for optimization (as of this writing), and differs in the - * Latin1 range from the ALPHA bit only in two relatively unimportant - * characters: the masculine and feminine ordinal indicators, so removing it - * would just cause /i regexes which match them to run less efficiently. - * Similarly the EBCDIC-only bits are used just for speed, and could be - * replaced by other means */ + * frequency of their use. This gives a slight edge to exiting a loop + * earlier (in reginclass() in regexec.c). Except \v should be last, as + * it isn't a real Posix character class, and some (small) inefficiencies + * in regular expression handling would be introduced by putting it in + * the middle of those that are. Also, cntrl and ascii come after the + * others as it may be useful to group these which have no members that + * match above Latin1, (or above ASCII in the latter case) */ + +# define CC_WORDCHAR_ 0 /* \w and [:word:] */ +# define CC_DIGIT_ 1 /* \d and [:digit:] */ +# define CC_ALPHA_ 2 /* [:alpha:] */ +# define CC_LOWER_ 3 /* [:lower:] */ +# define CC_UPPER_ 4 /* [:upper:] */ +# define CC_PUNCT_ 5 /* [:punct:] */ +# define CC_PRINT_ 6 /* [:print:] */ +# define CC_ALPHANUMERIC_ 7 /* [:alnum:] */ +# define CC_GRAPH_ 8 /* [:graph:] */ +# define CC_CASED_ 9 /* [:lower:] or [:upper:] under /i */ +# define CC_SPACE_ 10 /* \s, [:space:] */ +# define CC_BLANK_ 11 /* [:blank:] */ +# define CC_XDIGIT_ 12 /* [:xdigit:] */ +# define CC_CNTRL_ 13 /* [:cntrl:] */ +# define CC_ASCII_ 14 /* [:ascii:] */ +# define CC_VERTSPACE_ 15 /* \v */ + +# define HIGHEST_REGCOMP_DOT_H_SYNC_ CC_VERTSPACE_ + +/* The members of the third group below do not need to be coordinated + * with data structures in regcomp.[ch] and regexec.c. */ +# define CC_IDFIRST_ 16 +# define CC_CHARNAME_CONT_ 17 +# define CC_NONLATIN1_FOLD_ 18 +# define CC_NONLATIN1_SIMPLE_FOLD_ 19 +# define CC_QUOTEMETA_ 20 +# define CC_NON_FINAL_FOLD_ 21 +# define CC_IS_IN_SOME_FOLD_ 22 +# define CC_BINDIGIT_ 23 +# define CC_OCTDIGIT_ 24 +# define CC_MNEMONIC_CNTRL_ 25 + +/* Unused: 26-31 If more bits are needed, one could add a second word for + * non-64bit QUAD_IS_INT systems, using some #ifdefs to distinguish + * between having a 2nd word or not. The IS_IN_SOME_FOLD bit is the most + * easily expendable, as it is used only for optimization (as of this + * writing), and differs in the Latin1 range from the ALPHA bit only in + * two relatively unimportant characters: the masculine and feminine + * ordinal indicators, so removing it would just cause /i regexes which + * match them to run less efficiently. Similarly the EBCDIC-only bits + * are used just for speed, and could be replaced by other means */ #if defined(PERL_CORE) || defined(PERL_EXT) -/* An enum version of the character class numbers, to help compilers - * optimize */ +/* An enum version of the character class numbers, + * to help compilers optimize */ typedef enum { CC_ENUM_ALPHA_ = CC_ALPHA_, CC_ENUM_ALPHANUMERIC_ = CC_ALPHANUMERIC_, @@ -1602,7 +1588,7 @@ typedef enum { } char_class_number_; #endif -#define POSIX_CC_COUNT (HIGHEST_REGCOMP_DOT_H_SYNC_ + 1) +#define POSIX_CC_COUNT (HIGHEST_REGCOMP_DOT_H_SYNC_ + 1) START_EXTERN_C # ifdef DOINIT @@ -1615,88 +1601,92 @@ EXTCONST U32 PL_charclass[]; # endif END_EXTERN_C - /* The 1U keeps Solaris from griping when shifting sets the uppermost bit */ -# define CC_mask_(classnum) (1U << (classnum)) + /* The 1U keeps Solaris from griping when + shifting sets the uppermost bit */ +# define CC_mask_(classnum) (1U << (classnum)) - /* For internal core Perl use only: the base macro for defining macros like - * isALPHA */ -# define generic_isCC_(c, classnum) cBOOL(FITS_IN_8_BITS(c) \ - && (PL_charclass[(U8) (c)] & CC_mask_(classnum))) + /* For internal core Perl use only: the base macro + * for defining macros like isALPHA */ +# define generic_isCC_(c, classnum) \ + cBOOL(FITS_IN_8_BITS(c) \ + && (PL_charclass[(U8) (c)] & CC_mask_(classnum))) - /* The mask for the _A versions of the macros; it just adds in the bit for - * ASCII. */ -# define CC_mask_A_(classnum) (CC_mask_(classnum) | CC_mask_(CC_ASCII_)) + /* The mask for the _A versions of the macros; + * it just adds in the bit for ASCII. */ +# define CC_mask_A_(classnum) (CC_mask_(classnum) | CC_mask_(CC_ASCII_)) - /* For internal core Perl use only: the base macro for defining macros like - * isALPHA_A. The foo_A version makes sure that both the desired bit and - * the ASCII bit are present */ -# define generic_isCC_A_(c, classnum) (FITS_IN_8_BITS(c) \ - && ((PL_charclass[(U8) (c)] & CC_mask_A_(classnum)) \ - == CC_mask_A_(classnum))) + /* For internal core Perl use only: the base macro for defining + * macros like isALPHA_A. The foo_A version makes sure that + * both the desired bit and the ASCII bit are present */ +# define generic_isCC_A_(c, classnum) \ + (FITS_IN_8_BITS(c) \ + && ((PL_charclass[(U8) (c)] & CC_mask_A_(classnum)) \ + == CC_mask_A_(classnum))) /* On ASCII platforms certain classes form a single range. It's faster to * special case these. isDIGIT is a single range on all platforms */ # ifdef EBCDIC -# define isALPHA_A(c) generic_isCC_A_(c, CC_ALPHA_) -# define isGRAPH_A(c) generic_isCC_A_(c, CC_GRAPH_) -# define isLOWER_A(c) generic_isCC_A_(c, CC_LOWER_) -# define isPRINT_A(c) generic_isCC_A_(c, CC_PRINT_) -# define isUPPER_A(c) generic_isCC_A_(c, CC_UPPER_) +# define isALPHA_A(c) generic_isCC_A_(c, CC_ALPHA_) +# define isGRAPH_A(c) generic_isCC_A_(c, CC_GRAPH_) +# define isLOWER_A(c) generic_isCC_A_(c, CC_LOWER_) +# define isPRINT_A(c) generic_isCC_A_(c, CC_PRINT_) +# define isUPPER_A(c) generic_isCC_A_(c, CC_UPPER_) # else /* By folding the upper and lowercase, we can use a single range */ -# define isALPHA_A(c) inRANGE((~('A' ^ 'a') & (c)), 'A', 'Z') -# define isGRAPH_A(c) inRANGE(c, ' ' + 1, 0x7e) -# define isLOWER_A(c) inRANGE(c, 'a', 'z') -# define isPRINT_A(c) inRANGE(c, ' ', 0x7e) -# define isUPPER_A(c) inRANGE(c, 'A', 'Z') +# define isALPHA_A(c) inRANGE((~('A' ^ 'a') & (c)), 'A', 'Z') +# define isGRAPH_A(c) inRANGE(c, ' ' + 1, 0x7e) +# define isLOWER_A(c) inRANGE(c, 'a', 'z') +# define isPRINT_A(c) inRANGE(c, ' ', 0x7e) +# define isUPPER_A(c) inRANGE(c, 'A', 'Z') # endif -# define isALPHANUMERIC_A(c) generic_isCC_A_(c, CC_ALPHANUMERIC_) -# define isBLANK_A(c) generic_isCC_A_(c, CC_BLANK_) -# define isCNTRL_A(c) generic_isCC_A_(c, CC_CNTRL_) -# define isDIGIT_A(c) inRANGE(c, '0', '9') -# define isPUNCT_A(c) generic_isCC_A_(c, CC_PUNCT_) -# define isSPACE_A(c) generic_isCC_A_(c, CC_SPACE_) -# define isWORDCHAR_A(c) generic_isCC_A_(c, CC_WORDCHAR_) -# define isXDIGIT_A(c) generic_isCC_(c, CC_XDIGIT_) /* No non-ASCII xdigits */ -# define isIDFIRST_A(c) generic_isCC_A_(c, CC_IDFIRST_) -# define isALPHA_L1(c) generic_isCC_(c, CC_ALPHA_) -# define isALPHANUMERIC_L1(c) generic_isCC_(c, CC_ALPHANUMERIC_) -# define isBLANK_L1(c) generic_isCC_(c, CC_BLANK_) +# define isALPHANUMERIC_A(c) generic_isCC_A_(c, CC_ALPHANUMERIC_) +# define isBLANK_A(c) generic_isCC_A_(c, CC_BLANK_) +# define isCNTRL_A(c) generic_isCC_A_(c, CC_CNTRL_) +# define isDIGIT_A(c) inRANGE(c, '0', '9') +# define isPUNCT_A(c) generic_isCC_A_(c, CC_PUNCT_) +# define isSPACE_A(c) generic_isCC_A_(c, CC_SPACE_) +# define isWORDCHAR_A(c) generic_isCC_A_(c, CC_WORDCHAR_) +# define isXDIGIT_A(c) generic_isCC_(c, CC_XDIGIT_) /* No non-ASCII + xdigits */ +# define isIDFIRST_A(c) generic_isCC_A_(c, CC_IDFIRST_) +# define isALPHA_L1(c) generic_isCC_(c, CC_ALPHA_) +# define isALPHANUMERIC_L1(c) generic_isCC_(c, CC_ALPHANUMERIC_) +# define isBLANK_L1(c) generic_isCC_(c, CC_BLANK_) /* continuation character for legal NAME in \N{NAME} */ -# define isCHARNAME_CONT(c) generic_isCC_(c, CC_CHARNAME_CONT_) - -# define isCNTRL_L1(c) generic_isCC_(c, CC_CNTRL_) -# define isGRAPH_L1(c) generic_isCC_(c, CC_GRAPH_) -# define isLOWER_L1(c) generic_isCC_(c, CC_LOWER_) -# define isPRINT_L1(c) generic_isCC_(c, CC_PRINT_) -# define isPSXSPC_L1(c) isSPACE_L1(c) -# define isPUNCT_L1(c) generic_isCC_(c, CC_PUNCT_) -# define isSPACE_L1(c) generic_isCC_(c, CC_SPACE_) -# define isUPPER_L1(c) generic_isCC_(c, CC_UPPER_) -# define isWORDCHAR_L1(c) generic_isCC_(c, CC_WORDCHAR_) -# define isIDFIRST_L1(c) generic_isCC_(c, CC_IDFIRST_) +# define isCHARNAME_CONT(c) generic_isCC_(c, CC_CHARNAME_CONT_) + +# define isCNTRL_L1(c) generic_isCC_(c, CC_CNTRL_) +# define isGRAPH_L1(c) generic_isCC_(c, CC_GRAPH_) +# define isLOWER_L1(c) generic_isCC_(c, CC_LOWER_) +# define isPRINT_L1(c) generic_isCC_(c, CC_PRINT_) +# define isPSXSPC_L1(c) isSPACE_L1(c) +# define isPUNCT_L1(c) generic_isCC_(c, CC_PUNCT_) +# define isSPACE_L1(c) generic_isCC_(c, CC_SPACE_) +# define isUPPER_L1(c) generic_isCC_(c, CC_UPPER_) +# define isWORDCHAR_L1(c) generic_isCC_(c, CC_WORDCHAR_) +# define isIDFIRST_L1(c) generic_isCC_(c, CC_IDFIRST_) # ifdef EBCDIC -# define isASCII(c) generic_isCC_(c, CC_ASCII_) +# define isASCII(c) generic_isCC_(c, CC_ASCII_) # endif /* Participates in a single-character fold with a character above 255 */ # if defined(PERL_IN_REGCOMP_ANY) || defined(PERL_IN_REGEXEC_C) -# define HAS_NONLATIN1_SIMPLE_FOLD_CLOSURE(c) \ - (( ! cBOOL(FITS_IN_8_BITS(c))) \ - || (PL_charclass[(U8) (c)] & CC_mask_(CC_NONLATIN1_SIMPLE_FOLD_))) +# define HAS_NONLATIN1_SIMPLE_FOLD_CLOSURE(c) \ + (( ! cBOOL(FITS_IN_8_BITS(c))) \ + || (PL_charclass[(U8) (c)] & CC_mask_(CC_NONLATIN1_SIMPLE_FOLD_))) -# define IS_NON_FINAL_FOLD(c) generic_isCC_(c, CC_NON_FINAL_FOLD_) -# define IS_IN_SOME_FOLD_L1(c) generic_isCC_(c, CC_IS_IN_SOME_FOLD_) +# define IS_NON_FINAL_FOLD(c) generic_isCC_(c, CC_NON_FINAL_FOLD_) +# define IS_IN_SOME_FOLD_L1(c) generic_isCC_(c, CC_IS_IN_SOME_FOLD_) # endif /* Like the above, but also can be part of a multi-char fold */ -# define HAS_NONLATIN1_FOLD_CLOSURE(c) \ - ( (! cBOOL(FITS_IN_8_BITS(c))) \ - || (PL_charclass[(U8) (c)] & CC_mask_(CC_NONLATIN1_FOLD_))) +# define HAS_NONLATIN1_FOLD_CLOSURE(c) \ + ( (! cBOOL(FITS_IN_8_BITS(c))) \ + || (PL_charclass[(U8) (c)] & CC_mask_(CC_NONLATIN1_FOLD_))) -# define _isQUOTEMETA(c) generic_isCC_(c, CC_QUOTEMETA_) +# define _isQUOTEMETA(c) generic_isCC_(c, CC_QUOTEMETA_) /* is c a control character for which we have a mnemonic? */ # if defined(PERL_CORE) || defined(PERL_EXT) @@ -1705,129 +1695,142 @@ END_EXTERN_C #else /* else we don't have perl.h H_PERL */ /* If we don't have perl.h, we are compiling a utility program. Below we - * hard-code various macro definitions that wouldn't otherwise be available - * to it. Most are coded based on first principles. These are written to - * avoid EBCDIC vs. ASCII #ifdef's as much as possible. */ -# define isDIGIT_A(c) inRANGE(c, '0', '9') -# define isBLANK_A(c) ((c) == ' ' || (c) == '\t') -# define isSPACE_A(c) (isBLANK_A(c) \ - || (c) == '\n' \ - || (c) == '\r' \ - || (c) == '\v' \ - || (c) == '\f') - /* On EBCDIC, there are gaps between 'i' and 'j'; 'r' and 's'. Same for - * uppercase. The tests for those aren't necessary on ASCII, but hurt only - * performance (if optimization isn't on), and allow the same code to be - * used for both platform types */ -# define isLOWER_A(c) inRANGE((c), 'a', 'i') \ - || inRANGE((c), 'j', 'r') \ - || inRANGE((c), 's', 'z') -# define isUPPER_A(c) inRANGE((c), 'A', 'I') \ - || inRANGE((c), 'J', 'R') \ - || inRANGE((c), 'S', 'Z') -# define isALPHA_A(c) (isUPPER_A(c) || isLOWER_A(c)) -# define isALPHANUMERIC_A(c) (isALPHA_A(c) || isDIGIT_A(c)) -# define isWORDCHAR_A(c) (isALPHANUMERIC_A(c) || (c) == '_') -# define isIDFIRST_A(c) (isALPHA_A(c) || (c) == '_') -# define isXDIGIT_A(c) ( isDIGIT_A(c) \ - || inRANGE((c), 'a', 'f') \ - || inRANGE((c), 'A', 'F') -# define isPUNCT_A(c) ((c) == '-' || (c) == '!' || (c) == '"' \ - || (c) == '#' || (c) == '$' || (c) == '%' \ - || (c) == '&' || (c) == '\'' || (c) == '(' \ - || (c) == ')' || (c) == '*' || (c) == '+' \ - || (c) == ',' || (c) == '.' || (c) == '/' \ - || (c) == ':' || (c) == ';' || (c) == '<' \ - || (c) == '=' || (c) == '>' || (c) == '?' \ - || (c) == '@' || (c) == '[' || (c) == '\\' \ - || (c) == ']' || (c) == '^' || (c) == '_' \ - || (c) == '`' || (c) == '{' || (c) == '|' \ - || (c) == '}' || (c) == '~') -# define isGRAPH_A(c) (isALPHANUMERIC_A(c) || isPUNCT_A(c)) -# define isPRINT_A(c) (isGRAPH_A(c) || (c) == ' ') + * hard-code various macro definitions that wouldn't otherwise be + * available to it. Most are coded based on first principles. These are + * written to avoid EBCDIC vs. ASCII #ifdef's as much as possible. */ +# define isDIGIT_A(c) inRANGE(c, '0', '9') +# define isBLANK_A(c) ((c) == ' ' || (c) == '\t') +# define isSPACE_A(c) \ + (isBLANK_A(c) \ + || (c) == '\n' \ + || (c) == '\r' \ + || (c) == '\v' \ + || (c) == '\f') + /* On EBCDIC, there are gaps between 'i' and 'j'; 'r' and 's'. + * Same for uppercase. The tests for those aren't necessary on + * ASCII, but hurt only performance (if optimization isn't on), and + * allow the same code to be used for both platform types */ +# define isLOWER_A(c) \ + inRANGE((c), 'a', 'i') \ + || inRANGE((c), 'j', 'r') \ + || inRANGE((c), 's', 'z') +# define isUPPER_A(c) \ + inRANGE((c), 'A', 'I') \ + || inRANGE((c), 'J', 'R') \ + || inRANGE((c), 'S', 'Z') +# define isALPHA_A(c) (isUPPER_A(c) || isLOWER_A(c)) +# define isALPHANUMERIC_A(c) (isALPHA_A(c) || isDIGIT_A(c)) +# define isWORDCHAR_A(c) (isALPHANUMERIC_A(c) || (c) == '_') +# define isIDFIRST_A(c) (isALPHA_A(c) || (c) == '_') +# define isXDIGIT_A(c) \ + ( isDIGIT_A(c) \ + || inRANGE((c), 'a', 'f') \ + || inRANGE((c), 'A', 'F') +# define isPUNCT_A(c) \ + ((c) == '-' || (c) == '!' || (c) == '"' \ + || (c) == '#' || (c) == '$' || (c) == '%' \ + || (c) == '&' || (c) == '\'' || (c) == '(' \ + || (c) == ')' || (c) == '*' || (c) == '+' \ + || (c) == ',' || (c) == '.' || (c) == '/' \ + || (c) == ':' || (c) == ';' || (c) == '<' \ + || (c) == '=' || (c) == '>' || (c) == '?' \ + || (c) == '@' || (c) == '[' || (c) == '\\' \ + || (c) == ']' || (c) == '^' || (c) == '_' \ + || (c) == '`' || (c) == '{' || (c) == '|' \ + || (c) == '}' || (c) == '~') +# define isGRAPH_A(c) (isALPHANUMERIC_A(c) || isPUNCT_A(c)) +# define isPRINT_A(c) (isGRAPH_A(c) || (c) == ' ') # ifdef EBCDIC /* The below is accurate for the 3 EBCDIC code pages traditionally * supported by perl. The only difference between them in the controls * is the position of \n, and that is represented symbolically below */ -# define isCNTRL_A(c) ((c) == '\0' || (c) == '\a' || (c) == '\b' \ - || (c) == '\f' || (c) == '\n' || (c) == '\r' \ - || (c) == '\t' || (c) == '\v' \ - || inRANGE((c), 1, 3) /* SOH, STX, ETX */ \ - || (c) == 7F /* U+7F DEL */ \ - || inRANGE((c), 0x0E, 0x13) /* SO SI DLE \ - DC[1-3] */ \ - || (c) == 0x18 /* U+18 CAN */ \ - || (c) == 0x19 /* U+19 EOM */ \ - || inRANGE((c), 0x1C, 0x1F) /* [FGRU]S */ \ - || (c) == 0x26 /* U+17 ETB */ \ - || (c) == 0x27 /* U+1B ESC */ \ - || (c) == 0x2D /* U+05 ENQ */ \ - || (c) == 0x2E /* U+06 ACK */ \ - || (c) == 0x32 /* U+16 SYN */ \ - || (c) == 0x37 /* U+04 EOT */ \ - || (c) == 0x3C /* U+14 DC4 */ \ - || (c) == 0x3D /* U+15 NAK */ \ - || (c) == 0x3F)/* U+1A SUB */ -# define isASCII(c) (isCNTRL_A(c) || isPRINT_A(c)) -# else /* isASCII is already defined for ASCII platforms, so can use that to - define isCNTRL */ -# define isCNTRL_A(c) (isASCII(c) && ! isPRINT_A(c)) +# define isCNTRL_A(c) \ + ((c) == '\0' || (c) == '\a' || (c) == '\b' \ + || (c) == '\f' || (c) == '\n' || (c) == '\r' \ + || (c) == '\t' || (c) == '\v' \ + || inRANGE((c), 1, 3) /* SOH, STX, ETX */ \ + || (c) == 7F /* U+7F DEL */ \ + || inRANGE((c), 0x0E, 0x13) /* SO SI DLE \ + DC[1-3] */ \ + || (c) == 0x18 /* U+18 CAN */ \ + || (c) == 0x19 /* U+19 EOM */ \ + || inRANGE((c), 0x1C, 0x1F) /* [FGRU]S */ \ + || (c) == 0x26 /* U+17 ETB */ \ + || (c) == 0x27 /* U+1B ESC */ \ + || (c) == 0x2D /* U+05 ENQ */ \ + || (c) == 0x2E /* U+06 ACK */ \ + || (c) == 0x32 /* U+16 SYN */ \ + || (c) == 0x37 /* U+04 EOT */ \ + || (c) == 0x3C /* U+14 DC4 */ \ + || (c) == 0x3D /* U+15 NAK */ \ + || (c) == 0x3F)/* U+1A SUB */ +# define isASCII(c) (isCNTRL_A(c) || isPRINT_A(c)) +# else /* isASCII is already defined for ASCII platforms, + so can use that to define isCNTRL */ +# define isCNTRL_A(c) (isASCII(c) && ! isPRINT_A(c)) # endif - /* The _L1 macros may be unnecessary for the utilities; I (khw) added them - * during debugging, and it seems best to keep them. We may be called - * without NATIVE_TO_LATIN1 being defined. On ASCII platforms, it doesn't - * do anything anyway, so make it not a problem */ + /* The _L1 macros may be unnecessary for the utilities; I (khw) added + * them during debugging, and it seems best to keep them. We may be + * called without NATIVE_TO_LATIN1 being defined. On ASCII platforms, + * it doesn't do anything anyway, so make it not a problem */ # if ! defined(EBCDIC) && ! defined(NATIVE_TO_LATIN1) # define NATIVE_TO_LATIN1(ch) (ch) # endif -# define isALPHA_L1(c) (isUPPER_L1(c) || isLOWER_L1(c)) -# define isALPHANUMERIC_L1(c) (isALPHA_L1(c) || isDIGIT_A(c)) -# define isBLANK_L1(c) (isBLANK_A(c) \ - || (FITS_IN_8_BITS(c) \ - && NATIVE_TO_LATIN1((U8) c) == 0xA0)) -# define isCNTRL_L1(c) (FITS_IN_8_BITS(c) && (! isPRINT_L1(c))) -# define isGRAPH_L1(c) (isPRINT_L1(c) && (! isBLANK_L1(c))) -# define isLOWER_L1(c) (isLOWER_A(c) \ - || (FITS_IN_8_BITS(c) \ - && (( NATIVE_TO_LATIN1((U8) c) >= 0xDF \ - && NATIVE_TO_LATIN1((U8) c) != 0xF7) \ - || NATIVE_TO_LATIN1((U8) c) == 0xAA \ - || NATIVE_TO_LATIN1((U8) c) == 0xBA \ - || NATIVE_TO_LATIN1((U8) c) == 0xB5))) -# define isPRINT_L1(c) (isPRINT_A(c) \ - || (FITS_IN_8_BITS(c) \ - && NATIVE_TO_LATIN1((U8) c) >= 0xA0)) -# define isPUNCT_L1(c) (isPUNCT_A(c) \ - || (FITS_IN_8_BITS(c) \ - && ( NATIVE_TO_LATIN1((U8) c) == 0xA1 \ - || NATIVE_TO_LATIN1((U8) c) == 0xA7 \ - || NATIVE_TO_LATIN1((U8) c) == 0xAB \ - || NATIVE_TO_LATIN1((U8) c) == 0xB6 \ - || NATIVE_TO_LATIN1((U8) c) == 0xB7 \ - || NATIVE_TO_LATIN1((U8) c) == 0xBB \ - || NATIVE_TO_LATIN1((U8) c) == 0xBF))) -# define isSPACE_L1(c) (isSPACE_A(c) \ - || (FITS_IN_8_BITS(c) \ - && ( NATIVE_TO_LATIN1((U8) c) == 0x85 \ - || NATIVE_TO_LATIN1((U8) c) == 0xA0))) -# define isUPPER_L1(c) (isUPPER_A(c) \ - || (FITS_IN_8_BITS(c) \ - && ( IN_RANGE(NATIVE_TO_LATIN1((U8) c), \ - 0xC0, 0xDE) \ - && NATIVE_TO_LATIN1((U8) c) != 0xD7))) -# define isWORDCHAR_L1(c) (isIDFIRST_L1(c) || isDIGIT_A(c)) -# define isIDFIRST_L1(c) (isALPHA_L1(c) || NATIVE_TO_LATIN1(c) == '_') -# define isCHARNAME_CONT(c) (isWORDCHAR_L1(c) \ - || isBLANK_L1(c) \ - || (c) == '-' \ - || (c) == '(' \ - || (c) == ')') - /* The following are not fully accurate in the above-ASCII range. I (khw) - * don't think it's necessary to be so for the purposes where this gets - * compiled */ -# define isQUOTEMETA_(c) (FITS_IN_8_BITS(c) && ! isWORDCHAR_L1(c)) +# define isALPHA_L1(c) (isUPPER_L1(c) || isLOWER_L1(c)) +# define isALPHANUMERIC_L1(c) (isALPHA_L1(c) || isDIGIT_A(c)) +# define isBLANK_L1(c) \ + (isBLANK_A(c) \ + || (FITS_IN_8_BITS(c) \ + && NATIVE_TO_LATIN1((U8) c) == 0xA0)) +# define isCNTRL_L1(c) (FITS_IN_8_BITS(c) && (! isPRINT_L1(c))) +# define isGRAPH_L1(c) (isPRINT_L1(c) && (! isBLANK_L1(c))) +# define isLOWER_L1(c) \ + (isLOWER_A(c) \ + || (FITS_IN_8_BITS(c) \ + && (( NATIVE_TO_LATIN1((U8) c) >= 0xDF \ + && NATIVE_TO_LATIN1((U8) c) != 0xF7) \ + || NATIVE_TO_LATIN1((U8) c) == 0xAA \ + || NATIVE_TO_LATIN1((U8) c) == 0xBA \ + || NATIVE_TO_LATIN1((U8) c) == 0xB5))) +# define isPRINT_L1(c) \ + (isPRINT_A(c) \ + || (FITS_IN_8_BITS(c) \ + && NATIVE_TO_LATIN1((U8) c) >= 0xA0)) +# define isPUNCT_L1(c) \ + (isPUNCT_A(c) \ + || (FITS_IN_8_BITS(c) \ + && ( NATIVE_TO_LATIN1((U8) c) == 0xA1 \ + || NATIVE_TO_LATIN1((U8) c) == 0xA7 \ + || NATIVE_TO_LATIN1((U8) c) == 0xAB \ + || NATIVE_TO_LATIN1((U8) c) == 0xB6 \ + || NATIVE_TO_LATIN1((U8) c) == 0xB7 \ + || NATIVE_TO_LATIN1((U8) c) == 0xBB \ + || NATIVE_TO_LATIN1((U8) c) == 0xBF))) +# define isSPACE_L1(c) \ + (isSPACE_A(c) \ + || (FITS_IN_8_BITS(c) \ + && ( NATIVE_TO_LATIN1((U8) c) == 0x85 \ + || NATIVE_TO_LATIN1((U8) c) == 0xA0))) +# define isUPPER_L1(c) \ + (isUPPER_A(c) \ + || (FITS_IN_8_BITS(c) \ + && ( IN_RANGE(NATIVE_TO_LATIN1((U8) c), \ + 0xC0, 0xDE) \ + && NATIVE_TO_LATIN1((U8) c) != 0xD7))) +# define isWORDCHAR_L1(c) (isIDFIRST_L1(c) || isDIGIT_A(c)) +# define isIDFIRST_L1(c) (isALPHA_L1(c) || NATIVE_TO_LATIN1(c) == '_') +# define isCHARNAME_CONT(c) \ + (isWORDCHAR_L1(c) \ + || isBLANK_L1(c) \ + || (c) == '-' \ + || (c) == '(' \ + || (c) == ')') + /* The following are not fully accurate in the above-ASCII + * range. I (khw) don't think it's necessary to be so for + * the purposes where this gets compiled */ +# define isQUOTEMETA_(c) (FITS_IN_8_BITS(c) && ! isWORDCHAR_L1(c)) /* Many of the macros later in this file are defined in terms of these. By * implementing them with a function, which converts the class number into @@ -1836,101 +1839,104 @@ END_EXTERN_C * perl.h), and so a compiler error will be generated if one is attempted * to be used. And the above-Latin1 code points require Unicode tables to * be present, something unlikely to be the case when bootstrapping */ -# define generic_isCC_(c, classnum) \ - (FITS_IN_8_BITS(c) && S_bootstrap_ctype((U8) (c), (classnum), TRUE)) -# define generic_isCC_A_(c, classnum) \ - (FITS_IN_8_BITS(c) && S_bootstrap_ctype((U8) (c), (classnum), FALSE)) +# define generic_isCC_(c, classnum) \ + (FITS_IN_8_BITS(c) && S_bootstrap_ctype((U8) (c), (classnum), TRUE)) +# define generic_isCC_A_(c, classnum) \ + (FITS_IN_8_BITS(c) && S_bootstrap_ctype((U8) (c), (classnum), FALSE)) #endif /* End of no perl.h H_PERL */ -#define isALPHANUMERIC(c) isALPHANUMERIC_A(c) -#define isALPHA(c) isALPHA_A(c) -#define isASCII_A(c) isASCII(c) -#define isASCII_L1(c) isASCII(c) -#define isBLANK(c) isBLANK_A(c) -#define isCNTRL(c) isCNTRL_A(c) -#define isDIGIT(c) isDIGIT_A(c) -#define isGRAPH(c) isGRAPH_A(c) -#define isIDFIRST(c) isIDFIRST_A(c) -#define isLOWER(c) isLOWER_A(c) -#define isPRINT(c) isPRINT_A(c) -#define isPSXSPC_A(c) isSPACE_A(c) -#define isPSXSPC(c) isPSXSPC_A(c) -#define isPSXSPC_L1(c) isSPACE_L1(c) -#define isPUNCT(c) isPUNCT_A(c) -#define isSPACE(c) isSPACE_A(c) -#define isUPPER(c) isUPPER_A(c) -#define isWORDCHAR(c) isWORDCHAR_A(c) -#define isXDIGIT(c) isXDIGIT_A(c) - -/* ASCII casing. These could also be written as - #define toLOWER(c) (isASCII(c) ? toLOWER_LATIN1(c) : (c)) - #define toUPPER(c) (isASCII(c) ? toUPPER_LATIN1_MOD(c) : (c)) - which uses table lookup and mask instead of subtraction. (This would - work because the _MOD does not apply in the ASCII range). +#define isALPHANUMERIC(c) isALPHANUMERIC_A(c) +#define isALPHA(c) isALPHA_A(c) +#define isASCII_A(c) isASCII(c) +#define isASCII_L1(c) isASCII(c) +#define isBLANK(c) isBLANK_A(c) +#define isCNTRL(c) isCNTRL_A(c) +#define isDIGIT(c) isDIGIT_A(c) +#define isGRAPH(c) isGRAPH_A(c) +#define isIDFIRST(c) isIDFIRST_A(c) +#define isLOWER(c) isLOWER_A(c) +#define isPRINT(c) isPRINT_A(c) +#define isPSXSPC_A(c) isSPACE_A(c) +#define isPSXSPC(c) isPSXSPC_A(c) +#define isPSXSPC_L1(c) isSPACE_L1(c) +#define isPUNCT(c) isPUNCT_A(c) +#define isSPACE(c) isSPACE_A(c) +#define isUPPER(c) isUPPER_A(c) +#define isWORDCHAR(c) isWORDCHAR_A(c) +#define isXDIGIT(c) isXDIGIT_A(c) + +/* ASCII casing. These could also be written as #define toLOWER(c) + (isASCII(c) ? toLOWER_LATIN1(c) : (c)) #define toUPPER(c) (isASCII(c) ? + toUPPER_LATIN1_MOD(c) : (c)) which uses table lookup and mask instead of + subtraction. (This would work because the _MOD does not apply in the ASCII + range). These actually are UTF-8 invariant casing, not just ASCII, as any non-ASCII - UTF-8 invariants are neither upper nor lower. (Only on EBCDIC platforms are - there non-ASCII invariants, and all of them are controls.) */ -#define toLOWER(c) (isUPPER(c) ? (U8)((c) + ('a' - 'A')) : (c)) -#define toUPPER(c) (isLOWER(c) ? (U8)((c) - ('a' - 'A')) : (c)) - -/* In the ASCII range, these are equivalent to what they're here defined to be. - * But by creating these definitions, other code doesn't have to be aware of - * this detail. Actually this works for all UTF-8 invariants, not just the - * ASCII range. (EBCDIC platforms can have non-ASCII invariants.) */ -#define toFOLD(c) toLOWER(c) -#define toTITLE(c) toUPPER(c) - -#define toLOWER_A(c) toLOWER(c) -#define toUPPER_A(c) toUPPER(c) -#define toFOLD_A(c) toFOLD(c) -#define toTITLE_A(c) toTITLE(c) + UTF-8 invariants are neither upper nor lower. (Only on EBCDIC platforms + are there non-ASCII invariants, and all of them are controls.) */ +#define toLOWER(c) (isUPPER(c) ? (U8)((c) + ('a' - 'A')) : (c)) +#define toUPPER(c) (isLOWER(c) ? (U8)((c) - ('a' - 'A')) : (c)) + +/* In the ASCII range, these are equivalent to what they're here defined to + * be. But by creating these definitions, other code doesn't have to be aware + * of this detail. Actually this works for all UTF-8 invariants, not just the + * ASCII range. (EBCDIC platforms can have non-ASCII invariants.) */ +#define toFOLD(c) toLOWER(c) +#define toTITLE(c) toUPPER(c) + +#define toLOWER_A(c) toLOWER(c) +#define toUPPER_A(c) toUPPER(c) +#define toFOLD_A(c) toFOLD(c) +#define toTITLE_A(c) toTITLE(c) /* Use table lookup for speed; returns the input itself if is out-of-range */ -#define toLOWER_LATIN1(c) ((! FITS_IN_8_BITS(c)) \ - ? (c) \ - : PL_latin1_lc[ (U8) (c) ]) -#define toLOWER_L1(c) toLOWER_LATIN1(c) /* Synonym for consistency */ - -/* Modified uc. Is correct uc except for three non-ascii chars which are - * all mapped to one of them, and these need special handling; returns the - * input itself if is out-of-range */ -#define toUPPER_LATIN1_MOD(c) ((! FITS_IN_8_BITS(c)) \ - ? (c) \ - : PL_mod_latin1_uc[ (U8) (c) ]) +#define toLOWER_LATIN1(c) \ + ((! FITS_IN_8_BITS(c)) \ + ? (c) \ + : PL_latin1_lc[ (U8) (c) ]) +#define toLOWER_L1(c) toLOWER_LATIN1(c) /* Synonym for + consistency */ + +/* Modified uc. Is correct uc except for three non-ascii chars + * which are all mapped to one of them, and these need special + * handling; returns the input itself if is out-of-range */ +#define toUPPER_LATIN1_MOD(c) \ + ((! FITS_IN_8_BITS(c)) \ + ? (c) \ + : PL_mod_latin1_uc[ (U8) (c) ]) #ifdef USE_LOCALE_CTYPE -# define IN_UTF8_CTYPE_LOCALE PL_in_utf8_CTYPE_locale -# define IN_UTF8_TURKIC_LOCALE PL_in_utf8_turkic_locale +# define IN_UTF8_CTYPE_LOCALE PL_in_utf8_CTYPE_locale +# define IN_UTF8_TURKIC_LOCALE PL_in_utf8_turkic_locale #else -# define IN_UTF8_CTYPE_LOCALE false -# define IN_UTF8_TURKIC_LOCALE false +# define IN_UTF8_CTYPE_LOCALE false +# define IN_UTF8_TURKIC_LOCALE false #endif -/* Use foo_LC_uvchr() instead of these for beyond the Latin1 range */ +/* Use foo_LC_uvchr() instead of these for beyond the Latin1 range */ /* For internal core Perl use only: the base macro for defining macros like * isALPHA_LC, which uses the current LC_CTYPE locale. 'c' is the code point * (0-255) to check. In a UTF-8 locale, the result is the same as calling * isFOO_L1(); 'classnum' is something like CC_UPPER_, which gives the class * number for doing this. For non-UTF-8 locales, the code to actually do the - * test this is passed in 'non_utf8'. If 'c' is above 255, 0 is returned. For - * accessing the full range of possible code points under locale rules, use the - * macros based on generic_LC_uvchr_ instead of this. */ -#define generic_LC_base_(c, classnum, non_utf8_func) \ - (! FITS_IN_8_BITS(c) \ - ? 0 \ - : IN_UTF8_CTYPE_LOCALE \ - ? cBOOL(PL_charclass[(U8) (c)] & CC_mask_(classnum)) \ - : cBOOL(non_utf8_func(c))) - -/* A helper macro for defining macros like isALPHA_LC. On systems without - * proper locales, these reduce to, e.g., isALPHA_A */ + * test this is passed in 'non_utf8'. If 'c' is above 255, 0 is returned. + * For accessing the full range of possible code points under locale rules, + * use the macros based on generic_LC_uvchr_ instead of this. */ +#define generic_LC_base_(c, classnum, non_utf8_func) \ + (! FITS_IN_8_BITS(c) \ + ? 0 \ + : IN_UTF8_CTYPE_LOCALE \ + ? cBOOL(PL_charclass[(U8) (c)] & CC_mask_(classnum)) \ + : cBOOL(non_utf8_func(c))) + +/* A helper macro for defining macros like isALPHA_LC. On systems + * without proper locales, these reduce to, e.g., isALPHA_A */ #ifdef CTYPE256 # define generic_LC_(c, classnum, non_utf8_func) \ - generic_LC_base_(c, classnum, non_utf8_func) + generic_LC_base_(c, classnum, non_utf8_func) #else # define generic_LC_(c, classnum, non_utf8_func) \ - generic_isCC_A_(c, classnum) + generic_isCC_A_(c, classnum) #endif /* Below are the definitions for the locale-sensitive character classification @@ -1947,454 +1953,466 @@ END_EXTERN_C * The first two aren't in C89, so the fallback is to use the non-locale * sensitive versions; these are the same for all platforms */ #if defined(HAS_ISASCII) -# define is_posix_ASCII(c) isascii((U8) (c)) +# define is_posix_ASCII(c) isascii((U8) (c)) #else -# define is_posix_ASCII(c) isASCII(c) +# define is_posix_ASCII(c) isASCII(c) #endif #if defined(HAS_ISBLANK) -# define is_posix_BLANK(c) isblank((U8) (c)) +# define is_posix_BLANK(c) isblank((U8) (c)) #else -# define is_posix_BLANK(c) isBLANK(c) +# define is_posix_BLANK(c) isBLANK(c) #endif /* The next few are the same in all platforms. */ -#define is_posix_CNTRL(c) iscntrl((U8) (c)) -#define is_posix_IDFIRST(c) (UNLIKELY((c) == '_') || is_posix_ALPHA(c)) -#define is_posix_SPACE(c) isspace((U8) (c)) -#define is_posix_WORDCHAR(c) (UNLIKELY((c) == '_') || is_posix_ALPHANUMERIC(c)) +#define is_posix_CNTRL(c) iscntrl((U8) (c)) +#define is_posix_IDFIRST(c) (UNLIKELY((c) == '_') || is_posix_ALPHA(c)) +#define is_posix_SPACE(c) isspace((U8) (c)) +#define is_posix_WORDCHAR(c) (UNLIKELY((c) == '_') || is_posix_ALPHANUMERIC(c)) /* The base-level case changing macros are also the same in all platforms */ -#define to_posix_LOWER(c) tolower((U8) (c)) -#define to_posix_UPPER(c) toupper((U8) (c)) -#define to_posix_FOLD(c) to_posix_LOWER(c) +#define to_posix_LOWER(c) tolower((U8) (c)) +#define to_posix_UPPER(c) toupper((U8) (c)) +#define to_posix_FOLD(c) to_posix_LOWER(c) #ifdef WIN32 -/* The Windows functions don't bother to follow the POSIX standard, which for - * example says that something can't both be a printable and a control. But - * Windows treats \t as both a control and a printable, and does such things as - * making superscripts into both digits and punctuation. These #defines tame - * these flaws by assuming that the definitions of controls (and the other few - * ones defined above) are correct, and then making sure that other definitions - * don't have weirdnesses, by adding a check that \w and its subsets aren't - * ispunct(), and things that are \W, like ispunct(), arent't controls. Not - * all possible weirdnesses are checked for, just ones that were detected on - * actual Microsoft code pages */ -# define is_posix_ALPHA(c) \ - (isalpha((U8) (c)) && ! is_posix_PUNCT(c)) -# define is_posix_ALPHANUMERIC(c) \ - (isalnum((U8) (c)) && ! is_posix_PUNCT(c)) -# define is_posix_CASED(c) \ - ((isupper((U8) (c)) || islower((U8) (c))) && ! is_posix_PUNCT(c)) -# define is_posix_DIGIT(c) \ - (isdigit((U8) (c)) && ! is_posix_PUNCT(c)) -# define is_posix_GRAPH(c) \ - (isgraph((U8) (c)) && ! is_posix_CNTRL(c)) -# define is_posix_LOWER(c) \ - (islower((U8) (c)) && ! is_posix_PUNCT(c)) -# define is_posix_PRINT(c) \ - (isprint((U8) (c)) && ! is_posix_CNTRL(c)) -# define is_posix_PUNCT(c) \ - (ispunct((U8) (c)) && ! is_posix_CNTRL(c)) -# define is_posix_UPPER(c) \ - (isupper((U8) (c)) && ! is_posix_PUNCT(c)) -# define is_posix_XDIGIT(c) \ - (isxdigit((U8) (c)) && ! is_posix_PUNCT(c)) +/* The Windows functions don't bother to follow the POSIX standard, which + * for example says that something can't both be a printable and a control. + * But Windows treats \t as both a control and a printable, and does such + * things as making superscripts into both digits and punctuation. These + * #defines tame these flaws by assuming that the definitions of controls + * (and the other few ones defined above) are correct, and then making sure + * that other definitions don't have weirdnesses, by adding a check that \w + * and its subsets aren't ispunct(), and things that are \W, like ispunct(), + * arent't controls. Not all possible weirdnesses are checked for, just + * ones that were detected on actual Microsoft code pages */ +# define is_posix_ALPHA(c) \ + (isalpha((U8) (c)) && ! is_posix_PUNCT(c)) +# define is_posix_ALPHANUMERIC(c) \ + (isalnum((U8) (c)) && ! is_posix_PUNCT(c)) +# define is_posix_CASED(c) \ + ((isupper((U8) (c)) || islower((U8) (c))) && ! is_posix_PUNCT(c)) +# define is_posix_DIGIT(c) \ + (isdigit((U8) (c)) && ! is_posix_PUNCT(c)) +# define is_posix_GRAPH(c) \ + (isgraph((U8) (c)) && ! is_posix_CNTRL(c)) +# define is_posix_LOWER(c) \ + (islower((U8) (c)) && ! is_posix_PUNCT(c)) +# define is_posix_PRINT(c) \ + (isprint((U8) (c)) && ! is_posix_CNTRL(c)) +# define is_posix_PUNCT(c) \ + (ispunct((U8) (c)) && ! is_posix_CNTRL(c)) +# define is_posix_UPPER(c) \ + (isupper((U8) (c)) && ! is_posix_PUNCT(c)) +# define is_posix_XDIGIT(c) \ + (isxdigit((U8) (c)) && ! is_posix_PUNCT(c)) #else -/* For all other platforms, as far as we know, isdigit(), etc. work sanely - * enough */ -# define is_posix_ALPHA(c) isalpha((U8) (c)) -# define is_posix_ALPHANUMERIC(c) isalnum((U8) (c)) -# define is_posix_CASED(c) (islower((U8) (c)) || isupper((U8) (c))) -# define is_posix_DIGIT(c) isdigit((U8) (c)) +/* For all other platforms, as far as we know, + * isdigit(), etc. work sanely enough */ +# define is_posix_ALPHA(c) isalpha((U8) (c)) +# define is_posix_ALPHANUMERIC(c) isalnum((U8) (c)) +# define is_posix_CASED(c) (islower((U8) (c)) || isupper((U8) (c))) +# define is_posix_DIGIT(c) isdigit((U8) (c)) /* ... But it seems that IBM products treat NBSP as both a space and a * graphic; these are the two platforms that we have active test beds for. */ # if defined(OS390) || defined(_AIX) -# define is_posix_GRAPH(c) (isgraph((U8) (c)) && ! isspace((U8) (c))) +# define is_posix_GRAPH(c) (isgraph((U8) (c)) && ! isspace((U8) (c))) # else -# define is_posix_GRAPH(c) isgraph((U8) (c)) +# define is_posix_GRAPH(c) isgraph((U8) (c)) # endif -# define is_posix_LOWER(c) islower((U8) (c)) -# define is_posix_PRINT(c) isprint((U8) (c)) -# define is_posix_PUNCT(c) ispunct((U8) (c)) -# define is_posix_UPPER(c) isupper((U8) (c)) -# define is_posix_XDIGIT(c) isxdigit((U8) (c)) +# define is_posix_LOWER(c) islower((U8) (c)) +# define is_posix_PRINT(c) isprint((U8) (c)) +# define is_posix_PUNCT(c) ispunct((U8) (c)) +# define is_posix_UPPER(c) isupper((U8) (c)) +# define is_posix_XDIGIT(c) isxdigit((U8) (c)) #endif -/* Below is the next level up, which currently expands to nothing more - * than the previous layer. These are the macros to use if you really need - * something whose input domain is a byte, and the locale isn't UTF-8; that is, - * where you normally would have to use things like bare isalnum(). +/* Below is the next level up, which currently expands to nothing more than + * the previous layer. These are the macros to use if you really need + * something whose input domain is a byte, and the locale isn't UTF-8; that + * is, where you normally would have to use things like bare isalnum(). * - * But most likely you should instead use the layer defined further below which - * has names like isALPHA_LC. They deal with larger-than-byte inputs, and - * UTF-8 locales. + * But most likely you should instead use the layer defined further below + * which has names like isALPHA_LC. They deal with larger-than-byte + * inputs, and UTF-8 locales. * - * (Note, proper general operation of the bare libc functions requires you to - * cast to U8. These do that for you automatically.) */ - -# define WRAP_U8_LC_(c, classnum, posix) posix(c) - -#define isU8_ALPHANUMERIC_LC(c) \ - WRAP_U8_LC_((c), CC_ALPHANUMERIC_, is_posix_ALPHANUMERIC) -#define isU8_ALPHA_LC(c) WRAP_U8_LC_((c), CC_ALPHA_, is_posix_ALPHA) -#define isU8_ASCII_LC(c) WRAP_U8_LC_((c), CC_ASCII_, is_posix_ASCII) -#define isU8_BLANK_LC(c) WRAP_U8_LC_((c), CC_BLANK_, is_posix_BLANK) -#define isU8_CASED_LC(c) WRAP_U8_LC_((c), CC_CASED_, is_posix_CASED) -#define isU8_CNTRL_LC(c) WRAP_U8_LC_((c), CC_CNTRL_, is_posix_CNTRL) -#define isU8_DIGIT_LC(c) WRAP_U8_LC_((c), CC_DIGIT_, is_posix_DIGIT) -#define isU8_GRAPH_LC(c) WRAP_U8_LC_((c), CC_GRAPH_, is_posix_GRAPH) -#define isU8_IDFIRST_LC(c) WRAP_U8_LC_((c), CC_IDFIRST_, is_posix_IDFIRST) -#define isU8_LOWER_LC(c) WRAP_U8_LC_((c), CC_LOWER_, is_posix_LOWER) -#define isU8_PRINT_LC(c) WRAP_U8_LC_((c), CC_PRINT_, is_posix_PRINT) -#define isU8_PUNCT_LC(c) WRAP_U8_LC_((c), CC_PUNCT_, is_posix_PUNCT) -#define isU8_SPACE_LC(c) WRAP_U8_LC_((c), CC_SPACE_, is_posix_SPACE) -#define isU8_UPPER_LC(c) WRAP_U8_LC_((c), CC_UPPER_, is_posix_UPPER) -#define isU8_WORDCHAR_LC(c) WRAP_U8_LC_((c), CC_WORDCHAR_, is_posix_WORDCHAR) -#define isU8_XDIGIT_LC(c) WRAP_U8_LC_((c), CC_XDIGIT_, is_posix_XDIGIT) - -#define toU8_LOWER_LC(c) WRAP_U8_LC_((c), CC_TOLOWER_, to_posix_LOWER) -#define toU8_UPPER_LC(c) WRAP_U8_LC_((c), CC_TOUPPER_, to_posix_UPPER) -#define toU8_FOLD_LC(c) toU8_LOWER_LC(c) + * (Note, proper general operation of the bare libc functions requires you + * to cast to U8. These do that for you automatically.) */ + +# define WRAP_U8_LC_(c, classnum, posix) posix(c) + +#define isU8_ALPHANUMERIC_LC(c) \ + WRAP_U8_LC_((c), CC_ALPHANUMERIC_, is_posix_ALPHANUMERIC) +#define isU8_ALPHA_LC(c) WRAP_U8_LC_((c), CC_ALPHA_, is_posix_ALPHA) +#define isU8_ASCII_LC(c) WRAP_U8_LC_((c), CC_ASCII_, is_posix_ASCII) +#define isU8_BLANK_LC(c) WRAP_U8_LC_((c), CC_BLANK_, is_posix_BLANK) +#define isU8_CASED_LC(c) WRAP_U8_LC_((c), CC_CASED_, is_posix_CASED) +#define isU8_CNTRL_LC(c) WRAP_U8_LC_((c), CC_CNTRL_, is_posix_CNTRL) +#define isU8_DIGIT_LC(c) WRAP_U8_LC_((c), CC_DIGIT_, is_posix_DIGIT) +#define isU8_GRAPH_LC(c) WRAP_U8_LC_((c), CC_GRAPH_, is_posix_GRAPH) +#define isU8_IDFIRST_LC(c) WRAP_U8_LC_((c), CC_IDFIRST_, is_posix_IDFIRST) +#define isU8_LOWER_LC(c) WRAP_U8_LC_((c), CC_LOWER_, is_posix_LOWER) +#define isU8_PRINT_LC(c) WRAP_U8_LC_((c), CC_PRINT_, is_posix_PRINT) +#define isU8_PUNCT_LC(c) WRAP_U8_LC_((c), CC_PUNCT_, is_posix_PUNCT) +#define isU8_SPACE_LC(c) WRAP_U8_LC_((c), CC_SPACE_, is_posix_SPACE) +#define isU8_UPPER_LC(c) WRAP_U8_LC_((c), CC_UPPER_, is_posix_UPPER) +#define isU8_WORDCHAR_LC(c) WRAP_U8_LC_((c), CC_WORDCHAR_, is_posix_WORDCHAR) +#define isU8_XDIGIT_LC(c) WRAP_U8_LC_((c), CC_XDIGIT_, is_posix_XDIGIT) + +#define toU8_LOWER_LC(c) WRAP_U8_LC_((c), CC_TOLOWER_, to_posix_LOWER) +#define toU8_UPPER_LC(c) WRAP_U8_LC_((c), CC_TOUPPER_, to_posix_UPPER) +#define toU8_FOLD_LC(c) toU8_LOWER_LC(c) /* The definitions below use the ones above to create versions in which the - * input domain isn't restricted to bytes (though always returning false if the - * input doesn't fit in a byte), and to behave properly should the locale be - * UTF-8. These are the documented ones, suitable for general use (though - * toUPPER_LC and toFOLD_LC aren't documented because they need special - * handling to deal with SHARP S expanding to two characters). */ + * input domain isn't restricted to bytes (though always returning false if + * the input doesn't fit in a byte), and to behave properly should the + * locale be UTF-8. These are the documented ones, suitable for general + * use (though toUPPER_LC and toFOLD_LC aren't documented because they need + * special handling to deal with SHARP S expanding to two characters). */ #define isASCII_LC(c) (FITS_IN_8_BITS(c) && isU8_ASCII_LC(c)) #define isALPHA_LC(c) generic_LC_(c, CC_ALPHA_, isU8_ALPHA_LC) -#define isALPHANUMERIC_LC(c) \ - generic_LC_(c, CC_ALPHANUMERIC_, isU8_ALPHANUMERIC_LC) +#define isALPHANUMERIC_LC(c) \ + generic_LC_(c, CC_ALPHANUMERIC_, isU8_ALPHANUMERIC_LC) #define isBLANK_LC(c) generic_LC_(c, CC_BLANK_, isU8_BLANK_LC) #define isCASED_LC(c) generic_LC_(c, CC_CASED_, isU8_CASED_LC) #define isCNTRL_LC(c) generic_LC_(c, CC_CNTRL_, isU8_CNTRL_LC) #define isDIGIT_LC(c) generic_LC_(c, CC_DIGIT_, isU8_DIGIT_LC) #define isGRAPH_LC(c) generic_LC_(c, CC_GRAPH_, isU8_GRAPH_LC) -#define isIDFIRST_LC(c) generic_LC_(c, CC_IDFIRST_, isU8_IDFIRST_LC) +#define isIDFIRST_LC(c) generic_LC_(c, CC_IDFIRST_, isU8_IDFIRST_LC) #define isLOWER_LC(c) generic_LC_(c, CC_LOWER_, isU8_LOWER_LC) #define isPRINT_LC(c) generic_LC_(c, CC_PRINT_, isU8_PRINT_LC) #define isPUNCT_LC(c) generic_LC_(c, CC_PUNCT_, isU8_PUNCT_LC) #define isSPACE_LC(c) generic_LC_(c, CC_SPACE_, isU8_SPACE_LC) #define isUPPER_LC(c) generic_LC_(c, CC_UPPER_, isU8_UPPER_LC) -#define isWORDCHAR_LC(c) generic_LC_(c, CC_WORDCHAR_, isU8_WORDCHAR_LC) -#define isXDIGIT_LC(c) generic_LC_(c, CC_XDIGIT_, isU8_XDIGIT_LC) +#define isWORDCHAR_LC(c) generic_LC_(c, CC_WORDCHAR_, isU8_WORDCHAR_LC) +#define isXDIGIT_LC(c) generic_LC_(c, CC_XDIGIT_, isU8_XDIGIT_LC) #ifndef CTYPE256 -# define toLOWER_LC(c) toLOWER_A(c) -# define toUPPER_LC(c) toUPPER_A(c) -# define toFOLD_LC(c) toFOLD_A(c) +# define toLOWER_LC(c) toLOWER_A(c) +# define toUPPER_LC(c) toUPPER_A(c) +# define toFOLD_LC(c) toFOLD_A(c) #else -/* In the next three macros, the reason for using the PL_latin arrays is in - * case the system function is defective; it ensures uniform results that - * conform to the Unicode standard. */ +/* In the next three macros, the reason for using the PL_latin + * arrays is in case the system function is defective; it ensures + * uniform results that conform to the Unicode standard. */ /* This does not handle the anomalies in UTF-8 Turkic locales. */ -# define toLOWER_LC(c) ((! FITS_IN_8_BITS(c)) \ - ? (c) \ - : ((IN_UTF8_CTYPE_LOCALE) \ - ? PL_latin1_lc[ (U8) (c) ] \ - : ((U8) toU8_LOWER_LC(c)))) - -/* In this macro, note that the result can be larger than a byte in a UTF-8 - * locale. It returns a single value, so can't adequately return the upper - * case of LATIN SMALL LETTER SHARP S in a UTF-8 locale (which should be a - * string of two values "SS"); instead it asserts against that under - * DEBUGGING, and otherwise returns its input. It does not handle the - * anomalies in UTF-8 Turkic locales. */ -# define toUPPER_LC(c) \ - ((! FITS_IN_8_BITS(c)) \ - ? (c) \ - : ((! IN_UTF8_CTYPE_LOCALE) \ - ? ((U8) toU8_UPPER_LC(c)) \ - : (UNLIKELY(((U8)(c)) == MICRO_SIGN) \ - ? GREEK_CAPITAL_LETTER_MU \ - : ((UNLIKELY(((U8) (c)) == LATIN_SMALL_LETTER_Y_WITH_DIAERESIS) \ - ? LATIN_CAPITAL_LETTER_Y_WITH_DIAERESIS \ - : (UNLIKELY(((U8)(c)) == LATIN_SMALL_LETTER_SHARP_S) \ - ? (__ASSERT_(0) (c)) /* Fail on Sharp S in DEBUGGING */ \ - : PL_mod_latin1_uc[ (U8) (c) ])))))) - -/* In this macro, note that the result can be larger than a byte in a UTF-8 - * locale. It returns a single value, so can't adequately return the fold case - * of LATIN SMALL LETTER SHARP S in a UTF-8 locale (which should be a string of - * two values "ss"); instead it asserts against that under DEBUGGING, and - * otherwise returns its input. It does not handle the anomalies in UTF-8 - * Turkic locales */ -# define toFOLD_LC(c) \ - ((UNLIKELY((c) == MICRO_SIGN) && IN_UTF8_CTYPE_LOCALE) \ - ? GREEK_SMALL_LETTER_MU \ - : (__ASSERT_( ! IN_UTF8_CTYPE_LOCALE \ - || LIKELY((c) != LATIN_SMALL_LETTER_SHARP_S)) \ - toLOWER_LC(c))) +# define toLOWER_LC(c) \ + ((! FITS_IN_8_BITS(c)) \ + ? (c) \ + : ((IN_UTF8_CTYPE_LOCALE) \ + ? PL_latin1_lc[ (U8) (c) ] \ + : ((U8) toU8_LOWER_LC(c)))) + +/* In this macro, note that the result can be larger than a byte in a + * UTF-8 locale. It returns a single value, so can't adequately return + * the upper case of LATIN SMALL LETTER SHARP S in a UTF-8 locale + * (which should be a string of two values "SS"); instead it asserts + * against that under DEBUGGING, and otherwise returns its input. It + * does not handle the anomalies in UTF-8 Turkic locales. */ +# define toUPPER_LC(c) \ + ((! FITS_IN_8_BITS(c)) \ + ? (c) \ + : ((! IN_UTF8_CTYPE_LOCALE) \ + ? ((U8) toU8_UPPER_LC(c)) \ + : (UNLIKELY(((U8)(c)) == MICRO_SIGN) \ + ? GREEK_CAPITAL_LETTER_MU \ + : ((UNLIKELY(((U8) (c)) == LATIN_SMALL_LETTER_Y_WITH_DIAERESIS) \ + ? LATIN_CAPITAL_LETTER_Y_WITH_DIAERESIS \ + : (UNLIKELY(((U8)(c)) == LATIN_SMALL_LETTER_SHARP_S) \ + ? (__ASSERT_(0) (c)) /* Fail on Sharp S in DEBUGGING */ \ + : PL_mod_latin1_uc[ (U8) (c) ])))))) + +/* In this macro, note that the result can be larger than a byte in a + * UTF-8 locale. It returns a single value, so can't adequately return + * the fold case of LATIN SMALL LETTER SHARP S in a UTF-8 locale (which + * should be a string of two values "ss"); instead it asserts against + * that under DEBUGGING, and otherwise returns its input. It does not + * handle the anomalies in UTF-8 Turkic locales */ +# define toFOLD_LC(c) \ + ((UNLIKELY((c) == MICRO_SIGN) && IN_UTF8_CTYPE_LOCALE) \ + ? GREEK_SMALL_LETTER_MU \ + : (__ASSERT_( ! IN_UTF8_CTYPE_LOCALE \ + || LIKELY((c) != LATIN_SMALL_LETTER_SHARP_S)) \ + toLOWER_LC(c))) #endif -#define isIDCONT(c) isWORDCHAR(c) -#define isIDCONT_A(c) isWORDCHAR_A(c) -#define isIDCONT_L1(c) isWORDCHAR_L1(c) -#define isIDCONT_LC(c) isWORDCHAR_LC(c) -#define isPSXSPC_LC(c) isSPACE_LC(c) +#define isIDCONT(c) isWORDCHAR(c) +#define isIDCONT_A(c) isWORDCHAR_A(c) +#define isIDCONT_L1(c) isWORDCHAR_L1(c) +#define isIDCONT_LC(c) isWORDCHAR_LC(c) +#define isPSXSPC_LC(c) isSPACE_LC(c) /* For internal core Perl use only: the base macros for defining macros like - * isALPHA_uvchr. 'c' is the code point to check. 'classnum' is the POSIX class - * number defined earlier in this file. generic_uvchr_() is used for POSIX - * classes where there is a macro or function 'above_latin1' that takes the - * single argument 'c' and returns the desired value. These exist for those - * classes which have simple definitions, avoiding the overhead of an inversion - * list binary search. generic_invlist_uvchr_() can be used - * for classes where that overhead is faster than a direct lookup. - * generic_uvchr_() won't compile if 'c' isn't unsigned, as it won't match the - * 'above_latin1' prototype. generic_isCC_() macro does bounds checking, so - * have duplicate checks here, so could create versions of the macros that + * isALPHA_uvchr. 'c' is the code point to check. 'classnum' is the POSIX + * class number defined earlier in this file. generic_uvchr_() is used for + * POSIX classes where there is a macro or function 'above_latin1' that takes + * the single argument 'c' and returns the desired value. These exist for + * those classes which have simple definitions, avoiding the overhead of an + * inversion list binary search. generic_invlist_uvchr_() can be used for + * classes where that overhead is faster than a direct lookup. + * generic_uvchr_() won't compile if 'c' isn't unsigned, as it won't match + * the 'above_latin1' prototype. generic_isCC_() macro does bounds checking, + * so have duplicate checks here, so could create versions of the macros that * don't, but experiments show that gcc optimizes them out anyway. */ /* Note that all ignore 'use bytes' */ -#define generic_uvchr_(classnum, above_latin1, c) ((c) < 256 \ +#define generic_uvchr_(classnum, above_latin1, c) \ + ((c) < 256 \ ? generic_isCC_(c, classnum) \ : above_latin1(c)) -#define generic_invlist_uvchr_(classnum, c) ((c) < 256 \ - ? generic_isCC_(c, classnum) \ - : _is_uni_FOO(classnum, c)) -#define isALPHA_uvchr(c) generic_invlist_uvchr_(CC_ALPHA_, c) -#define isALPHANUMERIC_uvchr(c) generic_invlist_uvchr_(CC_ALPHANUMERIC_, c) -#define isASCII_uvchr(c) isASCII(c) -#define isBLANK_uvchr(c) generic_uvchr_(CC_BLANK_, is_HORIZWS_cp_high, c) -#define isCNTRL_uvchr(c) isCNTRL_L1(c) /* All controls are in Latin1 */ -#define isDIGIT_uvchr(c) generic_invlist_uvchr_(CC_DIGIT_, c) -#define isGRAPH_uvchr(c) generic_invlist_uvchr_(CC_GRAPH_, c) -#define isIDCONT_uvchr(c) \ - generic_uvchr_(CC_WORDCHAR_, _is_uni_perl_idcont, c) -#define isIDFIRST_uvchr(c) \ - generic_uvchr_(CC_IDFIRST_, _is_uni_perl_idstart, c) -#define isLOWER_uvchr(c) generic_invlist_uvchr_(CC_LOWER_, c) -#define isPRINT_uvchr(c) generic_invlist_uvchr_(CC_PRINT_, c) - -#define isPUNCT_uvchr(c) generic_invlist_uvchr_(CC_PUNCT_, c) -#define isSPACE_uvchr(c) generic_uvchr_(CC_SPACE_, is_XPERLSPACE_cp_high, c) -#define isPSXSPC_uvchr(c) isSPACE_uvchr(c) - -#define isUPPER_uvchr(c) generic_invlist_uvchr_(CC_UPPER_, c) -#define isVERTWS_uvchr(c) generic_uvchr_(CC_VERTSPACE_, is_VERTWS_cp_high, c) -#define isWORDCHAR_uvchr(c) generic_invlist_uvchr_(CC_WORDCHAR_, c) -#define isXDIGIT_uvchr(c) generic_uvchr_(CC_XDIGIT_, is_XDIGIT_cp_high, c) - -#define toFOLD_uvchr(c,s,l) to_uni_fold(c,s,l) -#define toLOWER_uvchr(c,s,l) to_uni_lower(c,s,l) -#define toTITLE_uvchr(c,s,l) to_uni_title(c,s,l) -#define toUPPER_uvchr(c,s,l) to_uni_upper(c,s,l) - -/* For backwards compatibility, even though '_uni' should mean official Unicode - * code points, in Perl it means native for those below 256 */ -#define isALPHA_uni(c) isALPHA_uvchr(c) -#define isALPHANUMERIC_uni(c) isALPHANUMERIC_uvchr(c) -#define isASCII_uni(c) isASCII_uvchr(c) -#define isBLANK_uni(c) isBLANK_uvchr(c) -#define isCNTRL_uni(c) isCNTRL_uvchr(c) -#define isDIGIT_uni(c) isDIGIT_uvchr(c) -#define isGRAPH_uni(c) isGRAPH_uvchr(c) -#define isIDCONT_uni(c) isIDCONT_uvchr(c) -#define isIDFIRST_uni(c) isIDFIRST_uvchr(c) -#define isLOWER_uni(c) isLOWER_uvchr(c) -#define isPRINT_uni(c) isPRINT_uvchr(c) -#define isPUNCT_uni(c) isPUNCT_uvchr(c) -#define isSPACE_uni(c) isSPACE_uvchr(c) -#define isPSXSPC_uni(c) isPSXSPC_uvchr(c) -#define isUPPER_uni(c) isUPPER_uvchr(c) -#define isVERTWS_uni(c) isVERTWS_uvchr(c) -#define isWORDCHAR_uni(c) isWORDCHAR_uvchr(c) -#define isXDIGIT_uni(c) isXDIGIT_uvchr(c) -#define toFOLD_uni(c,s,l) toFOLD_uvchr(c,s,l) -#define toLOWER_uni(c,s,l) toLOWER_uvchr(c,s,l) -#define toTITLE_uni(c,s,l) toTITLE_uvchr(c,s,l) -#define toUPPER_uni(c,s,l) toUPPER_uvchr(c,s,l) - -/* For internal core Perl use only: the base macros for defining macros like - * isALPHA_LC_uvchr. These are like isALPHA_LC, but the input can be any code - * point, not just 0-255. Like generic_uvchr_, there are two versions, one for - * simple class definitions; the other for more complex. These are like - * generic_uvchr_, so see it for more info. */ -#define generic_LC_uvchr_(latin1, above_latin1, c) \ - (c < 256 ? latin1(c) : above_latin1(c)) -#define generic_LC_invlist_uvchr_(latin1, classnum, c) \ - (c < 256 ? latin1(c) : _is_uni_FOO(classnum, c)) - -#define isALPHA_LC_uvchr(c) generic_LC_invlist_uvchr_(isALPHA_LC, CC_ALPHA_, c) -#define isALPHANUMERIC_LC_uvchr(c) generic_LC_invlist_uvchr_(isALPHANUMERIC_LC, \ - CC_ALPHANUMERIC_, c) -#define isASCII_LC_uvchr(c) isASCII_LC(c) -#define isBLANK_LC_uvchr(c) generic_LC_uvchr_(isBLANK_LC, \ - is_HORIZWS_cp_high, c) -#define isCNTRL_LC_uvchr(c) (c < 256 ? isCNTRL_LC(c) : 0) -#define isDIGIT_LC_uvchr(c) generic_LC_invlist_uvchr_(isDIGIT_LC, CC_DIGIT_, c) -#define isGRAPH_LC_uvchr(c) generic_LC_invlist_uvchr_(isGRAPH_LC, CC_GRAPH_, c) -#define isIDCONT_LC_uvchr(c) generic_LC_uvchr_(isIDCONT_LC, \ - _is_uni_perl_idcont, c) -#define isIDFIRST_LC_uvchr(c) generic_LC_uvchr_(isIDFIRST_LC, \ - _is_uni_perl_idstart, c) -#define isLOWER_LC_uvchr(c) generic_LC_invlist_uvchr_(isLOWER_LC, CC_LOWER_, c) -#define isPRINT_LC_uvchr(c) generic_LC_invlist_uvchr_(isPRINT_LC, CC_PRINT_, c) -#define isPSXSPC_LC_uvchr(c) isSPACE_LC_uvchr(c) -#define isPUNCT_LC_uvchr(c) generic_LC_invlist_uvchr_(isPUNCT_LC, CC_PUNCT_, c) -#define isSPACE_LC_uvchr(c) generic_LC_uvchr_(isSPACE_LC, \ - is_XPERLSPACE_cp_high, c) -#define isUPPER_LC_uvchr(c) generic_LC_invlist_uvchr_(isUPPER_LC, CC_UPPER_, c) -#define isWORDCHAR_LC_uvchr(c) generic_LC_invlist_uvchr_(isWORDCHAR_LC, \ - CC_WORDCHAR_, c) -#define isXDIGIT_LC_uvchr(c) generic_LC_uvchr_(isXDIGIT_LC, \ - is_XDIGIT_cp_high, c) - -#define isBLANK_LC_uni(c) isBLANK_LC_uvchr(UNI_TO_NATIVE(c)) - -/* The "_safe" macros make sure that we don't attempt to read beyond 'e', but - * they don't otherwise go out of their way to look for malformed UTF-8. If - * they can return accurate results without knowing if the input is otherwise - * malformed, they do so. For example isASCII is accurate in spite of any - * non-length malformations because it looks only at a single byte. Likewise - * isDIGIT looks just at the first byte for code points 0-255, as all UTF-8 - * variant ones return FALSE. But, if the input has to be well-formed in order - * for the results to be accurate, the macros will test and if malformed will - * call a routine to die +#define generic_invlist_uvchr_(classnum, c) \ + ((c) < 256 \ + ? generic_isCC_(c, classnum) \ + : _is_uni_FOO(classnum, c)) +#define isALPHA_uvchr(c) generic_invlist_uvchr_(CC_ALPHA_, c) +#define isALPHANUMERIC_uvchr(c) generic_invlist_uvchr_(CC_ALPHANUMERIC_, c) +#define isASCII_uvchr(c) isASCII(c) +#define isBLANK_uvchr(c) generic_uvchr_(CC_BLANK_, is_HORIZWS_cp_high, c) +#define isCNTRL_uvchr(c) isCNTRL_L1(c) /* All controls are + in Latin1 */ +#define isDIGIT_uvchr(c) generic_invlist_uvchr_(CC_DIGIT_, c) +#define isGRAPH_uvchr(c) generic_invlist_uvchr_(CC_GRAPH_, c) +#define isIDCONT_uvchr(c) \ + generic_uvchr_(CC_WORDCHAR_, _is_uni_perl_idcont, c) +#define isIDFIRST_uvchr(c) \ + generic_uvchr_(CC_IDFIRST_, _is_uni_perl_idstart, c) +#define isLOWER_uvchr(c) generic_invlist_uvchr_(CC_LOWER_, c) +#define isPRINT_uvchr(c) generic_invlist_uvchr_(CC_PRINT_, c) + +#define isPUNCT_uvchr(c) generic_invlist_uvchr_(CC_PUNCT_, c) +#define isSPACE_uvchr(c) \ + generic_uvchr_(CC_SPACE_, is_XPERLSPACE_cp_high, c) +#define isPSXSPC_uvchr(c) isSPACE_uvchr(c) + +#define isUPPER_uvchr(c) generic_invlist_uvchr_(CC_UPPER_, c) +#define isVERTWS_uvchr(c) \ + generic_uvchr_(CC_VERTSPACE_, is_VERTWS_cp_high, c) +#define isWORDCHAR_uvchr(c) generic_invlist_uvchr_(CC_WORDCHAR_, c) +#define isXDIGIT_uvchr(c) generic_uvchr_(CC_XDIGIT_, is_XDIGIT_cp_high, c) + +#define toFOLD_uvchr(c,s,l) to_uni_fold(c,s,l) +#define toLOWER_uvchr(c,s,l) to_uni_lower(c,s,l) +#define toTITLE_uvchr(c,s,l) to_uni_title(c,s,l) +#define toUPPER_uvchr(c,s,l) to_uni_upper(c,s,l) + +/* For backwards compatibility, even though '_uni' should mean official + * Unicode code points, in Perl it means native for those below 256 */ +#define isALPHA_uni(c) isALPHA_uvchr(c) +#define isALPHANUMERIC_uni(c) isALPHANUMERIC_uvchr(c) +#define isASCII_uni(c) isASCII_uvchr(c) +#define isBLANK_uni(c) isBLANK_uvchr(c) +#define isCNTRL_uni(c) isCNTRL_uvchr(c) +#define isDIGIT_uni(c) isDIGIT_uvchr(c) +#define isGRAPH_uni(c) isGRAPH_uvchr(c) +#define isIDCONT_uni(c) isIDCONT_uvchr(c) +#define isIDFIRST_uni(c) isIDFIRST_uvchr(c) +#define isLOWER_uni(c) isLOWER_uvchr(c) +#define isPRINT_uni(c) isPRINT_uvchr(c) +#define isPUNCT_uni(c) isPUNCT_uvchr(c) +#define isSPACE_uni(c) isSPACE_uvchr(c) +#define isPSXSPC_uni(c) isPSXSPC_uvchr(c) +#define isUPPER_uni(c) isUPPER_uvchr(c) +#define isVERTWS_uni(c) isVERTWS_uvchr(c) +#define isWORDCHAR_uni(c) isWORDCHAR_uvchr(c) +#define isXDIGIT_uni(c) isXDIGIT_uvchr(c) +#define toFOLD_uni(c,s,l) toFOLD_uvchr(c,s,l) +#define toLOWER_uni(c,s,l) toLOWER_uvchr(c,s,l) +#define toTITLE_uni(c,s,l) toTITLE_uvchr(c,s,l) +#define toUPPER_uni(c,s,l) toUPPER_uvchr(c,s,l) + +/* For internal core Perl use only: the base macros for defining macros + * like isALPHA_LC_uvchr. These are like isALPHA_LC, but the input can be + * any code point, not just 0-255. Like generic_uvchr_, there are two + * versions, one for simple class definitions; the other for more complex. + * These are like generic_uvchr_, so see it for more info. */ +#define generic_LC_uvchr_(latin1, above_latin1, c) \ + (c < 256 ? latin1(c) : above_latin1(c)) +#define generic_LC_invlist_uvchr_(latin1, classnum, c) \ + (c < 256 ? latin1(c) : _is_uni_FOO(classnum, c)) + +#define isALPHA_LC_uvchr(c) generic_LC_invlist_uvchr_(isALPHA_LC, CC_ALPHA_, c) +#define isALPHANUMERIC_LC_uvchr(c) \ + generic_LC_invlist_uvchr_(isALPHANUMERIC_LC, \ + CC_ALPHANUMERIC_, c) +#define isASCII_LC_uvchr(c) isASCII_LC(c) +#define isBLANK_LC_uvchr(c) \ + generic_LC_uvchr_(isBLANK_LC, \ + is_HORIZWS_cp_high, c) +#define isCNTRL_LC_uvchr(c) (c < 256 ? isCNTRL_LC(c) : 0) +#define isDIGIT_LC_uvchr(c) generic_LC_invlist_uvchr_(isDIGIT_LC, CC_DIGIT_, c) +#define isGRAPH_LC_uvchr(c) generic_LC_invlist_uvchr_(isGRAPH_LC, CC_GRAPH_, c) +#define isIDCONT_LC_uvchr(c) \ + generic_LC_uvchr_(isIDCONT_LC, \ + _is_uni_perl_idcont, c) +#define isIDFIRST_LC_uvchr(c) \ + generic_LC_uvchr_(isIDFIRST_LC, \ + _is_uni_perl_idstart, c) +#define isLOWER_LC_uvchr(c) generic_LC_invlist_uvchr_(isLOWER_LC, CC_LOWER_, c) +#define isPRINT_LC_uvchr(c) generic_LC_invlist_uvchr_(isPRINT_LC, CC_PRINT_, c) +#define isPSXSPC_LC_uvchr(c) isSPACE_LC_uvchr(c) +#define isPUNCT_LC_uvchr(c) generic_LC_invlist_uvchr_(isPUNCT_LC, CC_PUNCT_, c) +#define isSPACE_LC_uvchr(c) \ + generic_LC_uvchr_(isSPACE_LC, \ + is_XPERLSPACE_cp_high, c) +#define isUPPER_LC_uvchr(c) generic_LC_invlist_uvchr_(isUPPER_LC, CC_UPPER_, c) +#define isWORDCHAR_LC_uvchr(c) \ + generic_LC_invlist_uvchr_(isWORDCHAR_LC, \ + CC_WORDCHAR_, c) +#define isXDIGIT_LC_uvchr(c) \ + generic_LC_uvchr_(isXDIGIT_LC, \ + is_XDIGIT_cp_high, c) + +#define isBLANK_LC_uni(c) isBLANK_LC_uvchr(UNI_TO_NATIVE(c)) + +/* The "_safe" macros make sure that we don't attempt to read beyond 'e', + * but they don't otherwise go out of their way to look for malformed + * UTF-8. If they can return accurate results without knowing if the + * input is otherwise malformed, they do so. For example isASCII is + * accurate in spite of any non-length malformations because it looks only + * at a single byte. Likewise isDIGIT looks just at the first byte for + * code points 0-255, as all UTF-8 variant ones return FALSE. But, if the + * input has to be well-formed in order for the results to be accurate, + * the macros will test and if malformed will call a routine to die * * Except for toke.c, the macros do assume that e > p, asserting that on - * DEBUGGING builds. Much code that calls these depends on this being true, - * for other reasons. toke.c is treated specially as using the regular - * assertion breaks it in many ways. All strings that these operate on there - * are supposed to have an extra NUL character at the end, so that *e = \0. A - * bunch of code in toke.c assumes that this is true, so the assertion allows - * for that */ + * DEBUGGING builds. Much code that calls these depends on this being + * true, for other reasons. toke.c is treated specially as using the + * regular assertion breaks it in many ways. All strings that these + * operate on there are supposed to have an extra NUL character at the + * end, so that *e = \0. A bunch of code in toke.c assumes that this is + * true, so the assertion allows for that */ #ifdef PERL_IN_TOKE_C -# define _utf8_safe_assert(p,e) ((e) > (p) || ((e) == (p) && *(p) == '\0')) +# define _utf8_safe_assert(p,e) ((e) > (p) || ((e) == (p) && *(p) == '\0')) #else -# define _utf8_safe_assert(p,e) ((e) > (p)) +# define _utf8_safe_assert(p,e) ((e) > (p)) #endif -#define generic_utf8_safe_(classnum, p, e, above_latin1) \ - ((! _utf8_safe_assert(p, e)) \ - ? (_force_out_malformed_utf8_message((U8 *) (p), (U8 *) (e), 0, 1), 0)\ - : (UTF8_IS_INVARIANT(*(p))) \ - ? generic_isCC_(*(p), classnum) \ - : (UTF8_IS_DOWNGRADEABLE_START(*(p)) \ - ? ((LIKELY((e) - (p) > 1 && UTF8_IS_CONTINUATION(*((p)+1)))) \ - ? generic_isCC_(EIGHT_BIT_UTF8_TO_NATIVE(*(p), *((p)+1 )), \ - classnum) \ - : (_force_out_malformed_utf8_message( \ - (U8 *) (p), (U8 *) (e), 0, 1), 0)) \ +#define generic_utf8_safe_(classnum, p, e, above_latin1) \ + ((! _utf8_safe_assert(p, e)) \ + ? (_force_out_malformed_utf8_message((U8 *) (p), (U8 *) (e), 0, 1), 0) \ + : (UTF8_IS_INVARIANT(*(p))) \ + ? generic_isCC_(*(p), classnum) \ + : (UTF8_IS_DOWNGRADEABLE_START(*(p)) \ + ? ((LIKELY((e) - (p) > 1 && UTF8_IS_CONTINUATION(*((p)+1)))) \ + ? generic_isCC_(EIGHT_BIT_UTF8_TO_NATIVE(*(p), *((p)+1 )), \ + classnum) \ + : (_force_out_malformed_utf8_message( \ + (U8 *) (p), (U8 *) (e), 0, 1), 0)) \ : above_latin1)) -/* Like the above, but calls 'above_latin1(p)' to get the utf8 value. - * 'above_latin1' can be a macro */ -#define generic_func_utf8_safe_(classnum, above_latin1, p, e) \ - generic_utf8_safe_(classnum, p, e, above_latin1(p, e)) -#define generic_non_invlist_utf8_safe_(classnum, above_latin1, p, e) \ - generic_utf8_safe_(classnum, p, e, \ - (UNLIKELY((e) - (p) < UTF8SKIP(p)) \ - ? (_force_out_malformed_utf8_message( \ - (U8 *) (p), (U8 *) (e), 0, 1), 0) \ - : above_latin1(p))) -/* Like the above, but passes classnum to _isFOO_utf8(), instead of having an - * 'above_latin1' parameter */ -#define generic_invlist_utf8_safe_(classnum, p, e) \ - generic_utf8_safe_(classnum, p, e, _is_utf8_FOO(classnum, p, e)) - -/* Like the above, but should be used only when it is known that there are no - * characters in the upper-Latin1 range (128-255 on ASCII platforms) which the - * class is TRUE for. Hence it can skip the tests for this range. - * 'above_latin1' should include its arguments */ +/* Like the above, but calls 'above_latin1(p)' to get + * the utf8 value. 'above_latin1' can be a macro */ +#define generic_func_utf8_safe_(classnum, above_latin1, p, e) \ + generic_utf8_safe_(classnum, p, e, above_latin1(p, e)) +#define generic_non_invlist_utf8_safe_(classnum, above_latin1, p, e) \ + generic_utf8_safe_(classnum, p, e, \ + (UNLIKELY((e) - (p) < UTF8SKIP(p)) \ + ? (_force_out_malformed_utf8_message( \ + (U8 *) (p), (U8 *) (e), 0, 1), 0) \ + : above_latin1(p))) +/* Like the above, but passes classnum to _isFOO_utf8(), + * instead of having an 'above_latin1' parameter */ +#define generic_invlist_utf8_safe_(classnum, p, e) \ + generic_utf8_safe_(classnum, p, e, _is_utf8_FOO(classnum, p, e)) + +/* Like the above, but should be used only when it is known that there + * are no characters in the upper-Latin1 range (128-255 on ASCII + * platforms) which the class is TRUE for. Hence it can skip the tests + * for this range. 'above_latin1' should include its arguments */ #define generic_utf8_safe_no_upper_latin1_(classnum, p, e, above_latin1) \ - (__ASSERT_(_utf8_safe_assert(p, e)) \ - (isASCII(*(p))) \ - ? generic_isCC_(*(p), classnum) \ - : (UTF8_IS_DOWNGRADEABLE_START(*(p))) \ - ? 0 /* Note that doesn't check validity for latin1 */ \ - : above_latin1) - - -#define isALPHA_utf8(p, e) isALPHA_utf8_safe(p, e) -#define isALPHANUMERIC_utf8(p, e) isALPHANUMERIC_utf8_safe(p, e) -#define isASCII_utf8(p, e) isASCII_utf8_safe(p, e) -#define isBLANK_utf8(p, e) isBLANK_utf8_safe(p, e) -#define isCNTRL_utf8(p, e) isCNTRL_utf8_safe(p, e) -#define isDIGIT_utf8(p, e) isDIGIT_utf8_safe(p, e) -#define isGRAPH_utf8(p, e) isGRAPH_utf8_safe(p, e) -#define isIDCONT_utf8(p, e) isIDCONT_utf8_safe(p, e) -#define isIDFIRST_utf8(p, e) isIDFIRST_utf8_safe(p, e) -#define isLOWER_utf8(p, e) isLOWER_utf8_safe(p, e) -#define isPRINT_utf8(p, e) isPRINT_utf8_safe(p, e) -#define isPSXSPC_utf8(p, e) isPSXSPC_utf8_safe(p, e) -#define isPUNCT_utf8(p, e) isPUNCT_utf8_safe(p, e) -#define isSPACE_utf8(p, e) isSPACE_utf8_safe(p, e) -#define isUPPER_utf8(p, e) isUPPER_utf8_safe(p, e) -#define isVERTWS_utf8(p, e) isVERTWS_utf8_safe(p, e) -#define isWORDCHAR_utf8(p, e) isWORDCHAR_utf8_safe(p, e) -#define isXDIGIT_utf8(p, e) isXDIGIT_utf8_safe(p, e) - -#define isALPHA_utf8_safe(p, e) generic_invlist_utf8_safe_(CC_ALPHA_, p, e) -#define isALPHANUMERIC_utf8_safe(p, e) \ - generic_invlist_utf8_safe_(CC_ALPHANUMERIC_, p, e) + (__ASSERT_(_utf8_safe_assert(p, e)) \ + (isASCII(*(p))) \ + ? generic_isCC_(*(p), classnum) \ + : (UTF8_IS_DOWNGRADEABLE_START(*(p))) \ + ? 0 /* Note that doesn't check validity for latin1 */ \ + : above_latin1) + + +#define isALPHA_utf8(p, e) isALPHA_utf8_safe(p, e) +#define isALPHANUMERIC_utf8(p, e) isALPHANUMERIC_utf8_safe(p, e) +#define isASCII_utf8(p, e) isASCII_utf8_safe(p, e) +#define isBLANK_utf8(p, e) isBLANK_utf8_safe(p, e) +#define isCNTRL_utf8(p, e) isCNTRL_utf8_safe(p, e) +#define isDIGIT_utf8(p, e) isDIGIT_utf8_safe(p, e) +#define isGRAPH_utf8(p, e) isGRAPH_utf8_safe(p, e) +#define isIDCONT_utf8(p, e) isIDCONT_utf8_safe(p, e) +#define isIDFIRST_utf8(p, e) isIDFIRST_utf8_safe(p, e) +#define isLOWER_utf8(p, e) isLOWER_utf8_safe(p, e) +#define isPRINT_utf8(p, e) isPRINT_utf8_safe(p, e) +#define isPSXSPC_utf8(p, e) isPSXSPC_utf8_safe(p, e) +#define isPUNCT_utf8(p, e) isPUNCT_utf8_safe(p, e) +#define isSPACE_utf8(p, e) isSPACE_utf8_safe(p, e) +#define isUPPER_utf8(p, e) isUPPER_utf8_safe(p, e) +#define isVERTWS_utf8(p, e) isVERTWS_utf8_safe(p, e) +#define isWORDCHAR_utf8(p, e) isWORDCHAR_utf8_safe(p, e) +#define isXDIGIT_utf8(p, e) isXDIGIT_utf8_safe(p, e) + +#define isALPHA_utf8_safe(p, e) generic_invlist_utf8_safe_(CC_ALPHA_, p, e) +#define isALPHANUMERIC_utf8_safe(p, e) \ + generic_invlist_utf8_safe_(CC_ALPHANUMERIC_, p, e) #define isASCII_utf8_safe(p, e) \ - /* Because ASCII is invariant under utf8, the non-utf8 macro \ - * works */ \ + /* Because ASCII is invariant under utf8, the non-utf8 macro works */ \ (__ASSERT_(_utf8_safe_assert(p, e)) isASCII(*(p))) -#define isBLANK_utf8_safe(p, e) \ - generic_non_invlist_utf8_safe_(CC_BLANK_, is_HORIZWS_high, p, e) +#define isBLANK_utf8_safe(p, e) \ + generic_non_invlist_utf8_safe_(CC_BLANK_, is_HORIZWS_high, p, e) #ifdef EBCDIC - /* Because all controls are UTF-8 invariants in EBCDIC, we can use this - * more efficient macro instead of the more general one */ -# define isCNTRL_utf8_safe(p, e) \ - (__ASSERT_(_utf8_safe_assert(p, e)) isCNTRL_L1(*(p))) + /* Because all controls are UTF-8 invariants in EBCDIC, we can use + * this more efficient macro instead of the more general one */ +# define isCNTRL_utf8_safe(p, e) \ + (__ASSERT_(_utf8_safe_assert(p, e)) isCNTRL_L1(*(p))) #else -# define isCNTRL_utf8_safe(p, e) generic_utf8_safe_(CC_CNTRL_, p, e, 0) +# define isCNTRL_utf8_safe(p, e) generic_utf8_safe_(CC_CNTRL_, p, e, 0) #endif -#define isDIGIT_utf8_safe(p, e) \ - generic_utf8_safe_no_upper_latin1_(CC_DIGIT_, p, e, \ - _is_utf8_FOO(CC_DIGIT_, p, e)) -#define isGRAPH_utf8_safe(p, e) generic_invlist_utf8_safe_(CC_GRAPH_, p, e) -#define isIDCONT_utf8_safe(p, e) generic_func_utf8_safe_(CC_WORDCHAR_, \ - _is_utf8_perl_idcont, p, e) +#define isDIGIT_utf8_safe(p, e) \ + generic_utf8_safe_no_upper_latin1_(CC_DIGIT_, p, e, \ + _is_utf8_FOO(CC_DIGIT_, p, e)) +#define isGRAPH_utf8_safe(p, e) generic_invlist_utf8_safe_(CC_GRAPH_, p, e) +#define isIDCONT_utf8_safe(p, e) \ + generic_func_utf8_safe_(CC_WORDCHAR_, \ + _is_utf8_perl_idcont, p, e) /* To prevent S_scan_word in toke.c from hanging, we have to make sure that - * IDFIRST is an alnum. See - * https://github.com/Perl/perl5/issues/10275 for more detail than you - * ever wanted to know about. (In the ASCII range, there isn't a difference.) - * This used to be not the XID version, but we decided to go with the more - * modern Unicode definition */ -#define isIDFIRST_utf8_safe(p, e) \ - generic_func_utf8_safe_(CC_IDFIRST_, \ + * IDFIRST is an alnum. See https://github.com/Perl/perl5/issues/10275 for + * more detail than you ever wanted to know about. (In the ASCII range, + * there isn't a difference.) This used to be not the XID version, but we + * decided to go with the more modern Unicode definition */ +#define isIDFIRST_utf8_safe(p, e) \ + generic_func_utf8_safe_(CC_IDFIRST_, \ _is_utf8_perl_idstart, (U8 *) (p), (U8 *) (e)) #define isLOWER_utf8_safe(p, e) generic_invlist_utf8_safe_(CC_LOWER_, p, e) #define isPRINT_utf8_safe(p, e) generic_invlist_utf8_safe_(CC_PRINT_, p, e) -#define isPSXSPC_utf8_safe(p, e) isSPACE_utf8_safe(p, e) +#define isPSXSPC_utf8_safe(p, e) isSPACE_utf8_safe(p, e) #define isPUNCT_utf8_safe(p, e) generic_invlist_utf8_safe_(CC_PUNCT_, p, e) -#define isSPACE_utf8_safe(p, e) \ +#define isSPACE_utf8_safe(p, e) \ generic_non_invlist_utf8_safe_(CC_SPACE_, is_XPERLSPACE_high, p, e) -#define isUPPER_utf8_safe(p, e) generic_invlist_utf8_safe_(CC_UPPER_, p, e) -#define isVERTWS_utf8_safe(p, e) \ - generic_non_invlist_utf8_safe_(CC_VERTSPACE_, is_VERTWS_high, p, e) -#define isWORDCHAR_utf8_safe(p, e) \ - generic_invlist_utf8_safe_(CC_WORDCHAR_, p, e) -#define isXDIGIT_utf8_safe(p, e) \ - generic_utf8_safe_no_upper_latin1_(CC_XDIGIT_, p, e, \ - (UNLIKELY((e) - (p) < UTF8SKIP(p)) \ - ? (_force_out_malformed_utf8_message( \ - (U8 *) (p), (U8 *) (e), 0, 1), 0) \ - : is_XDIGIT_high(p))) - -#define toFOLD_utf8(p,e,s,l) toFOLD_utf8_safe(p,e,s,l) -#define toLOWER_utf8(p,e,s,l) toLOWER_utf8_safe(p,e,s,l) -#define toTITLE_utf8(p,e,s,l) toTITLE_utf8_safe(p,e,s,l) -#define toUPPER_utf8(p,e,s,l) toUPPER_utf8_safe(p,e,s,l) +#define isUPPER_utf8_safe(p, e) generic_invlist_utf8_safe_(CC_UPPER_, p, e) +#define isVERTWS_utf8_safe(p, e) \ + generic_non_invlist_utf8_safe_(CC_VERTSPACE_, is_VERTWS_high, p, e) +#define isWORDCHAR_utf8_safe(p, e) \ + generic_invlist_utf8_safe_(CC_WORDCHAR_, p, e) +#define isXDIGIT_utf8_safe(p, e) \ + generic_utf8_safe_no_upper_latin1_(CC_XDIGIT_, p, e, \ + (UNLIKELY((e) - (p) < UTF8SKIP(p)) \ + ? (_force_out_malformed_utf8_message( \ + (U8 *) (p), (U8 *) (e), 0, 1), 0) \ + : is_XDIGIT_high(p))) + +#define toFOLD_utf8(p,e,s,l) toFOLD_utf8_safe(p,e,s,l) +#define toLOWER_utf8(p,e,s,l) toLOWER_utf8_safe(p,e,s,l) +#define toTITLE_utf8(p,e,s,l) toTITLE_utf8_safe(p,e,s,l) +#define toUPPER_utf8(p,e,s,l) toUPPER_utf8_safe(p,e,s,l) /* For internal core use only, subject to change */ -#define _toFOLD_utf8_flags(p,e,s,l,f) _to_utf8_fold_flags (p,e,s,l,f) +#define _toFOLD_utf8_flags(p,e,s,l,f) _to_utf8_fold_flags (p,e,s,l,f) #define _toLOWER_utf8_flags(p,e,s,l,f) _to_utf8_lower_flags(p,e,s,l,f) #define _toTITLE_utf8_flags(p,e,s,l,f) _to_utf8_title_flags(p,e,s,l,f) #define _toUPPER_utf8_flags(p,e,s,l,f) _to_utf8_upper_flags(p,e,s,l,f) @@ -2404,137 +2422,139 @@ END_EXTERN_C #define toTITLE_utf8_safe(p,e,s,l) _toTITLE_utf8_flags(p,e,s,l, 0) #define toUPPER_utf8_safe(p,e,s,l) _toUPPER_utf8_flags(p,e,s,l, 0) -#define isALPHA_LC_utf8(p, e) isALPHA_LC_utf8_safe(p, e) -#define isALPHANUMERIC_LC_utf8(p, e) isALPHANUMERIC_LC_utf8_safe(p, e) -#define isASCII_LC_utf8(p, e) isASCII_LC_utf8_safe(p, e) -#define isBLANK_LC_utf8(p, e) isBLANK_LC_utf8_safe(p, e) -#define isCNTRL_LC_utf8(p, e) isCNTRL_LC_utf8_safe(p, e) -#define isDIGIT_LC_utf8(p, e) isDIGIT_LC_utf8_safe(p, e) -#define isGRAPH_LC_utf8(p, e) isGRAPH_LC_utf8_safe(p, e) -#define isIDCONT_LC_utf8(p, e) isIDCONT_LC_utf8_safe(p, e) -#define isIDFIRST_LC_utf8(p, e) isIDFIRST_LC_utf8_safe(p, e) -#define isLOWER_LC_utf8(p, e) isLOWER_LC_utf8_safe(p, e) -#define isPRINT_LC_utf8(p, e) isPRINT_LC_utf8_safe(p, e) -#define isPSXSPC_LC_utf8(p, e) isPSXSPC_LC_utf8_safe(p, e) -#define isPUNCT_LC_utf8(p, e) isPUNCT_LC_utf8_safe(p, e) -#define isSPACE_LC_utf8(p, e) isSPACE_LC_utf8_safe(p, e) -#define isUPPER_LC_utf8(p, e) isUPPER_LC_utf8_safe(p, e) -#define isWORDCHAR_LC_utf8(p, e) isWORDCHAR_LC_utf8_safe(p, e) -#define isXDIGIT_LC_utf8(p, e) isXDIGIT_LC_utf8_safe(p, e) - -/* For internal core Perl use only: the base macros for defining macros like - * isALPHA_LC_utf8_safe. These are like generic_utf8_, but if the first code - * point in 'p' is within the 0-255 range, it uses locale rules from the - * passed-in 'macro' parameter */ -#define generic_LC_utf8_safe_(macro, p, e, above_latin1) \ - (__ASSERT_(_utf8_safe_assert(p, e)) \ - (UTF8_IS_INVARIANT(*(p))) \ - ? macro(*(p)) \ - : (UTF8_IS_DOWNGRADEABLE_START(*(p)) \ - ? ((LIKELY((e) - (p) > 1 && UTF8_IS_CONTINUATION(*((p)+1)))) \ - ? macro(EIGHT_BIT_UTF8_TO_NATIVE(*(p), *((p)+1))) \ - : (_force_out_malformed_utf8_message( \ - (U8 *) (p), (U8 *) (e), 0, 1), 0)) \ - : above_latin1)) - -#define generic_LC_invlist_utf8_safe_(macro, classnum, p, e) \ - generic_LC_utf8_safe_(macro, p, e, \ - _is_utf8_FOO(classnum, p, e)) - -#define generic_LC_func_utf8_safe_(macro, above_latin1, p, e) \ - generic_LC_utf8_safe_(macro, p, e, above_latin1(p, e)) - -#define generic_LC_non_invlist_utf8_safe_(classnum, above_latin1, p, e) \ - generic_LC_utf8_safe_(classnum, p, e, \ - (UNLIKELY((e) - (p) < UTF8SKIP(p)) \ - ? (_force_out_malformed_utf8_message( \ - (U8 *) (p), (U8 *) (e), 0, 1), 0) \ - : above_latin1(p))) - -#define isALPHANUMERIC_LC_utf8_safe(p, e) \ - generic_LC_invlist_utf8_safe_(isALPHANUMERIC_LC, \ - CC_ALPHANUMERIC_, p, e) -#define isALPHA_LC_utf8_safe(p, e) \ - generic_LC_invlist_utf8_safe_(isALPHA_LC, CC_ALPHA_, p, e) -#define isASCII_LC_utf8_safe(p, e) \ - (__ASSERT_(_utf8_safe_assert(p, e)) isASCII_LC(*(p))) -#define isBLANK_LC_utf8_safe(p, e) \ - generic_LC_non_invlist_utf8_safe_(isBLANK_LC, is_HORIZWS_high, p, e) -#define isCNTRL_LC_utf8_safe(p, e) \ - generic_LC_utf8_safe_(isCNTRL_LC, p, e, 0) -#define isDIGIT_LC_utf8_safe(p, e) \ - generic_LC_invlist_utf8_safe_(isDIGIT_LC, CC_DIGIT_, p, e) -#define isGRAPH_LC_utf8_safe(p, e) \ - generic_LC_invlist_utf8_safe_(isGRAPH_LC, CC_GRAPH_, p, e) -#define isIDCONT_LC_utf8_safe(p, e) \ - generic_LC_func_utf8_safe_(isIDCONT_LC, \ - _is_utf8_perl_idcont, p, e) -#define isIDFIRST_LC_utf8_safe(p, e) \ - generic_LC_func_utf8_safe_(isIDFIRST_LC, \ - _is_utf8_perl_idstart, p, e) -#define isLOWER_LC_utf8_safe(p, e) \ - generic_LC_invlist_utf8_safe_(isLOWER_LC, CC_LOWER_, p, e) -#define isPRINT_LC_utf8_safe(p, e) \ - generic_LC_invlist_utf8_safe_(isPRINT_LC, CC_PRINT_, p, e) -#define isPSXSPC_LC_utf8_safe(p, e) isSPACE_LC_utf8_safe(p, e) -#define isPUNCT_LC_utf8_safe(p, e) \ - generic_LC_invlist_utf8_safe_(isPUNCT_LC, CC_PUNCT_, p, e) -#define isSPACE_LC_utf8_safe(p, e) \ +#define isALPHA_LC_utf8(p, e) isALPHA_LC_utf8_safe(p, e) +#define isALPHANUMERIC_LC_utf8(p, e) isALPHANUMERIC_LC_utf8_safe(p, e) +#define isASCII_LC_utf8(p, e) isASCII_LC_utf8_safe(p, e) +#define isBLANK_LC_utf8(p, e) isBLANK_LC_utf8_safe(p, e) +#define isCNTRL_LC_utf8(p, e) isCNTRL_LC_utf8_safe(p, e) +#define isDIGIT_LC_utf8(p, e) isDIGIT_LC_utf8_safe(p, e) +#define isGRAPH_LC_utf8(p, e) isGRAPH_LC_utf8_safe(p, e) +#define isIDCONT_LC_utf8(p, e) isIDCONT_LC_utf8_safe(p, e) +#define isIDFIRST_LC_utf8(p, e) isIDFIRST_LC_utf8_safe(p, e) +#define isLOWER_LC_utf8(p, e) isLOWER_LC_utf8_safe(p, e) +#define isPRINT_LC_utf8(p, e) isPRINT_LC_utf8_safe(p, e) +#define isPSXSPC_LC_utf8(p, e) isPSXSPC_LC_utf8_safe(p, e) +#define isPUNCT_LC_utf8(p, e) isPUNCT_LC_utf8_safe(p, e) +#define isSPACE_LC_utf8(p, e) isSPACE_LC_utf8_safe(p, e) +#define isUPPER_LC_utf8(p, e) isUPPER_LC_utf8_safe(p, e) +#define isWORDCHAR_LC_utf8(p, e) isWORDCHAR_LC_utf8_safe(p, e) +#define isXDIGIT_LC_utf8(p, e) isXDIGIT_LC_utf8_safe(p, e) + +/* For internal core Perl use only: the base macros for defining + * macros like isALPHA_LC_utf8_safe. These are like generic_utf8_, + * but if the first code point in 'p' is within the 0-255 range, it + * uses locale rules from the passed-in 'macro' parameter */ +#define generic_LC_utf8_safe_(macro, p, e, above_latin1) \ + (__ASSERT_(_utf8_safe_assert(p, e)) \ + (UTF8_IS_INVARIANT(*(p))) \ + ? macro(*(p)) \ + : (UTF8_IS_DOWNGRADEABLE_START(*(p)) \ + ? ((LIKELY((e) - (p) > 1 && UTF8_IS_CONTINUATION(*((p)+1)))) \ + ? macro(EIGHT_BIT_UTF8_TO_NATIVE(*(p), *((p)+1))) \ + : (_force_out_malformed_utf8_message( \ + (U8 *) (p), (U8 *) (e), 0, 1), 0)) \ + : above_latin1)) + +#define generic_LC_invlist_utf8_safe_(macro, classnum, p, e) \ + generic_LC_utf8_safe_(macro, p, e, \ + _is_utf8_FOO(classnum, p, e)) + +#define generic_LC_func_utf8_safe_(macro, above_latin1, p, e) \ + generic_LC_utf8_safe_(macro, p, e, above_latin1(p, e)) + +#define generic_LC_non_invlist_utf8_safe_(classnum, above_latin1, p, e) \ + generic_LC_utf8_safe_(classnum, p, e, \ + (UNLIKELY((e) - (p) < UTF8SKIP(p)) \ + ? (_force_out_malformed_utf8_message( \ + (U8 *) (p), (U8 *) (e), 0, 1), 0) \ + : above_latin1(p))) + +#define isALPHANUMERIC_LC_utf8_safe(p, e) \ + generic_LC_invlist_utf8_safe_(isALPHANUMERIC_LC, \ + CC_ALPHANUMERIC_, p, e) +#define isALPHA_LC_utf8_safe(p, e) \ + generic_LC_invlist_utf8_safe_(isALPHA_LC, CC_ALPHA_, p, e) +#define isASCII_LC_utf8_safe(p, e) \ + (__ASSERT_(_utf8_safe_assert(p, e)) isASCII_LC(*(p))) +#define isBLANK_LC_utf8_safe(p, e) \ + generic_LC_non_invlist_utf8_safe_(isBLANK_LC, is_HORIZWS_high, p, e) +#define isCNTRL_LC_utf8_safe(p, e) \ + generic_LC_utf8_safe_(isCNTRL_LC, p, e, 0) +#define isDIGIT_LC_utf8_safe(p, e) \ + generic_LC_invlist_utf8_safe_(isDIGIT_LC, CC_DIGIT_, p, e) +#define isGRAPH_LC_utf8_safe(p, e) \ + generic_LC_invlist_utf8_safe_(isGRAPH_LC, CC_GRAPH_, p, e) +#define isIDCONT_LC_utf8_safe(p, e) \ + generic_LC_func_utf8_safe_(isIDCONT_LC, \ + _is_utf8_perl_idcont, p, e) +#define isIDFIRST_LC_utf8_safe(p, e) \ + generic_LC_func_utf8_safe_(isIDFIRST_LC, \ + _is_utf8_perl_idstart, p, e) +#define isLOWER_LC_utf8_safe(p, e) \ + generic_LC_invlist_utf8_safe_(isLOWER_LC, CC_LOWER_, p, e) +#define isPRINT_LC_utf8_safe(p, e) \ + generic_LC_invlist_utf8_safe_(isPRINT_LC, CC_PRINT_, p, e) +#define isPSXSPC_LC_utf8_safe(p, e) isSPACE_LC_utf8_safe(p, e) +#define isPUNCT_LC_utf8_safe(p, e) \ + generic_LC_invlist_utf8_safe_(isPUNCT_LC, CC_PUNCT_, p, e) +#define isSPACE_LC_utf8_safe(p, e) \ generic_LC_non_invlist_utf8_safe_(isSPACE_LC, is_XPERLSPACE_high, p, e) -#define isUPPER_LC_utf8_safe(p, e) \ - generic_LC_invlist_utf8_safe_(isUPPER_LC, CC_UPPER_, p, e) -#define isWORDCHAR_LC_utf8_safe(p, e) \ - generic_LC_invlist_utf8_safe_(isWORDCHAR_LC, CC_WORDCHAR_, p, e) -#define isXDIGIT_LC_utf8_safe(p, e) \ - generic_LC_non_invlist_utf8_safe_(isXDIGIT_LC, is_XDIGIT_high, p, e) - -/* Macros for backwards compatibility and for completeness when the ASCII and - * Latin1 values are identical */ -#define isALPHAU(c) isALPHA_L1(c) -#define isDIGIT_L1(c) isDIGIT_A(c) -#define isOCTAL(c) isOCTAL_A(c) -#define isOCTAL_L1(c) isOCTAL_A(c) -#define isXDIGIT_L1(c) isXDIGIT_A(c) -#define isALNUM(c) isWORDCHAR(c) -#define isALNUM_A(c) isALNUM(c) -#define isALNUMU(c) isWORDCHAR_L1(c) -#define isALNUM_LC(c) isWORDCHAR_LC(c) -#define isALNUM_uni(c) isWORDCHAR_uni(c) -#define isALNUM_LC_uvchr(c) isWORDCHAR_LC_uvchr(c) -#define isALNUM_utf8(p,e) isWORDCHAR_utf8(p,e) -#define isALNUM_utf8_safe(p,e) isWORDCHAR_utf8_safe(p,e) -#define isALNUM_LC_utf8(p,e)isWORDCHAR_LC_utf8(p,e) -#define isALNUM_LC_utf8_safe(p,e)isWORDCHAR_LC_utf8_safe(p,e) -#define isALNUMC_A(c) isALPHANUMERIC_A(c) /* Mnemonic: "C's alnum" */ -#define isALNUMC_L1(c) isALPHANUMERIC_L1(c) -#define isALNUMC(c) isALPHANUMERIC(c) -#define isALNUMC_LC(c) isALPHANUMERIC_LC(c) -#define isALNUMC_uni(c) isALPHANUMERIC_uni(c) -#define isALNUMC_LC_uvchr(c) isALPHANUMERIC_LC_uvchr(c) -#define isALNUMC_utf8(p,e) isALPHANUMERIC_utf8(p,e) -#define isALNUMC_utf8_safe(p,e) isALPHANUMERIC_utf8_safe(p,e) -#define isALNUMC_LC_utf8_safe(p,e) isALPHANUMERIC_LC_utf8_safe(p,e) - -/* On EBCDIC platforms, CTRL-@ is 0, CTRL-A is 1, etc, just like on ASCII, - * except that they don't necessarily mean the same characters, e.g. CTRL-D is - * 4 on both systems, but that is EOT on ASCII; ST on EBCDIC. - * '?' is special-cased on EBCDIC to APC, which is the control there that is - * the outlier from the block that contains the other controls, just like - * toCTRL('?') on ASCII yields DEL, the control that is the outlier from the C0 - * block. If it weren't special cased, it would yield a non-control. - * The conversion works both ways, so toCTRL('D') is 4, and toCTRL(4) is D, - * etc. */ +#define isUPPER_LC_utf8_safe(p, e) \ + generic_LC_invlist_utf8_safe_(isUPPER_LC, CC_UPPER_, p, e) +#define isWORDCHAR_LC_utf8_safe(p, e) \ + generic_LC_invlist_utf8_safe_(isWORDCHAR_LC, CC_WORDCHAR_, p, e) +#define isXDIGIT_LC_utf8_safe(p, e) \ + generic_LC_non_invlist_utf8_safe_(isXDIGIT_LC, is_XDIGIT_high, p, e) + +/* Macros for backwards compatibility and for completeness + * when the ASCII and Latin1 values are identical */ +#define isALPHAU(c) isALPHA_L1(c) +#define isDIGIT_L1(c) isDIGIT_A(c) +#define isOCTAL(c) isOCTAL_A(c) +#define isOCTAL_L1(c) isOCTAL_A(c) +#define isXDIGIT_L1(c) isXDIGIT_A(c) +#define isALNUM(c) isWORDCHAR(c) +#define isALNUM_A(c) isALNUM(c) +#define isALNUMU(c) isWORDCHAR_L1(c) +#define isALNUM_LC(c) isWORDCHAR_LC(c) +#define isALNUM_uni(c) isWORDCHAR_uni(c) +#define isALNUM_LC_uvchr(c) isWORDCHAR_LC_uvchr(c) +#define isALNUM_utf8(p,e) isWORDCHAR_utf8(p,e) +#define isALNUM_utf8_safe(p,e) isWORDCHAR_utf8_safe(p,e) +#define isALNUM_LC_utf8(p,e) isWORDCHAR_LC_utf8(p,e) +#define isALNUM_LC_utf8_safe(p,e) isWORDCHAR_LC_utf8_safe(p,e) +#define isALNUMC_A(c) isALPHANUMERIC_A(c) /* Mnemonic: "C's + alnum" */ +#define isALNUMC_L1(c) isALPHANUMERIC_L1(c) +#define isALNUMC(c) isALPHANUMERIC(c) +#define isALNUMC_LC(c) isALPHANUMERIC_LC(c) +#define isALNUMC_uni(c) isALPHANUMERIC_uni(c) +#define isALNUMC_LC_uvchr(c) isALPHANUMERIC_LC_uvchr(c) +#define isALNUMC_utf8(p,e) isALPHANUMERIC_utf8(p,e) +#define isALNUMC_utf8_safe(p,e) isALPHANUMERIC_utf8_safe(p,e) +#define isALNUMC_LC_utf8_safe(p,e) isALPHANUMERIC_LC_utf8_safe(p,e) + +/* On EBCDIC platforms, CTRL-@ is 0, CTRL-A is 1, etc, just like on + * ASCII, except that they don't necessarily mean the same characters, + * e.g. CTRL-D is 4 on both systems, but that is EOT on ASCII; ST on + * EBCDIC. '?' is special-cased on EBCDIC to APC, which is the + * control there that is the outlier from the block that contains the + * other controls, just like toCTRL('?') on ASCII yields DEL, the + * control that is the outlier from the C0 block. If it weren't + * special cased, it would yield a non-control. The conversion works + * both ways, so toCTRL('D') is 4, and toCTRL(4) is D, etc. */ #ifndef EBCDIC -# define toCTRL(c) (__ASSERT_(FITS_IN_8_BITS(c)) toUPPER(((U8)(c))) ^ 64) +# define toCTRL(c) (__ASSERT_(FITS_IN_8_BITS(c)) toUPPER(((U8)(c))) ^ 64) #else -# define toCTRL(c) (__ASSERT_(FITS_IN_8_BITS(c)) \ - ((isPRINT_A(c)) \ - ? (UNLIKELY((c) == '?') \ - ? QUESTION_MARK_CTRL \ - : (NATIVE_TO_LATIN1(toUPPER((U8) (c))) ^ 64)) \ - : (UNLIKELY((c) == QUESTION_MARK_CTRL) \ - ? '?' \ - : (LATIN1_TO_NATIVE(((U8) (c)) ^ 64))))) +# define toCTRL(c) \ + (__ASSERT_(FITS_IN_8_BITS(c)) \ + ((isPRINT_A(c)) \ + ? (UNLIKELY((c) == '?') \ + ? QUESTION_MARK_CTRL \ + : (NATIVE_TO_LATIN1(toUPPER((U8) (c))) ^ 64)) \ + : (UNLIKELY((c) == QUESTION_MARK_CTRL) \ + ? '?' \ + : (LATIN1_TO_NATIVE(((U8) (c)) ^ 64))))) #endif /* @@ -2546,21 +2566,21 @@ The typedef to use to declare variables that are to hold line numbers. Line numbers are unsigned, 32 bits. */ typedef U32 line_t; -#define LINE_Tf U32uf -#define NOLINE ((line_t) 4294967295UL) /* = FFFFFFFF */ +#define LINE_Tf U32uf +#define NOLINE ((line_t) 4294967295UL) /* = FFFFFFFF */ /* Helpful alias for version prescan */ #define is_LAX_VERSION(a,b) \ - (a != Perl_prescan_version(aTHX_ a, FALSE, b, NULL, NULL, NULL, NULL)) + (a != Perl_prescan_version(aTHX_ a, FALSE, b, NULL, NULL, NULL, NULL)) -#define is_STRICT_VERSION(a,b) \ - (a != Perl_prescan_version(aTHX_ a, TRUE, b, NULL, NULL, NULL, NULL)) +#define is_STRICT_VERSION(a,b) \ + (a != Perl_prescan_version(aTHX_ a, TRUE, b, NULL, NULL, NULL, NULL)) -#define BADVERSION(a,b,c) \ - if (b) { \ - *b = c; \ - } \ - return a; +#define BADVERSION(a,b,c) \ + if (b) { \ + *b = c; \ + } \ + return a; /* Converts a character KNOWN to represent a hexadecimal digit (0-9, A-F, or * a-f) to its numeric value without using any branches. The input is @@ -2568,21 +2588,23 @@ typedef U32 line_t; * * It works by right shifting and isolating the bit that is 0 for the digits, * and 1 for at least the alphas A-F, a-f. The bit is shifted to the ones - * position, and then to the eights position. Both are added together to form - * 0 if the input is '0'-'9' and to form 9 if alpha. This is added to the - * final four bits of the input to form the correct value. */ -#define XDIGIT_VALUE(c) (__ASSERT_(isXDIGIT(c)) \ - ((NATIVE_TO_LATIN1(c) >> 6) & 1) /* 1 if alpha; 0 if not */ \ - + ((NATIVE_TO_LATIN1(c) >> 3) & 8) /* 8 if alpha; 0 if not */ \ + * position, and then to the eights position. Both are added together to + * form 0 if the input is '0'-'9' and to form 9 if alpha. This is added to + * the final four bits of the input to form the correct value. */ +#define XDIGIT_VALUE(c) \ + (__ASSERT_(isXDIGIT(c)) \ + ((NATIVE_TO_LATIN1(c) >> 6) & 1) /* 1 if alpha; 0 if not */ \ + + ((NATIVE_TO_LATIN1(c) >> 3) & 8) /* 8 if alpha; 0 if not */ \ + ((c) & 0xF)) /* 0-9 if input valid hex digit */ /* The argument is a string pointer, which is advanced. */ -#define READ_XDIGIT(s) ((s)++, XDIGIT_VALUE(*((s) - 1))) +#define READ_XDIGIT(s) ((s)++, XDIGIT_VALUE(*((s) - 1))) -/* Converts a character known to represent an octal digit (0-7) to its numeric - * value. The input is validated only by an assert() in DEBUGGING builds. In - * both ASCII and EBCDIC the last 3 bits of the octal digits range from 0-7. */ -#define OCTAL_VALUE(c) (__ASSERT_(isOCTAL(c)) (7 & (c))) +/* Converts a character known to represent an octal digit (0-7) + * to its numeric value. The input is validated only by an + * assert() in DEBUGGING builds. In both ASCII and EBCDIC the + * last 3 bits of the octal digits range from 0-7. */ +#define OCTAL_VALUE(c) (__ASSERT_(isOCTAL(c)) (7 & (c))) /* Efficiently returns a boolean as to if two native characters are equivalent * case-insensitively. At least one of the characters must be one of [A-Za-z]; @@ -2597,11 +2619,11 @@ typedef U32 line_t; * are 32 apart; on EBCDIC, they are 64. At compile time, this uses an * exclusive 'or' to find that bit and then inverts it to form a mask, with * just a single 0, in the bit position where the upper- and lowercase differ. - * */ -#define isALPHA_FOLD_EQ(c1, c2) \ - (__ASSERT_(isALPHA_A(c1) || isALPHA_A(c2)) \ - ((c1) & ~('A' ^ 'a')) == ((c2) & ~('A' ^ 'a'))) -#define isALPHA_FOLD_NE(c1, c2) (! isALPHA_FOLD_EQ((c1), (c2))) + */ +#define isALPHA_FOLD_EQ(c1, c2) \ + (__ASSERT_(isALPHA_A(c1) || isALPHA_A(c2)) \ + ((c1) & ~('A' ^ 'a')) == ((c2) & ~('A' ^ 'a'))) +#define isALPHA_FOLD_NE(c1, c2) (! isALPHA_FOLD_EQ((c1), (c2))) /* =for apidoc_section $memory @@ -2613,23 +2635,23 @@ The XSUB-writer's interface to the C C function. Memory obtained by this should B be freed with L. -In 5.9.3, Newx() and friends replace the older New() API, and drops -the first parameter, I, a debug aid which allowed callers to identify -themselves. This aid has been superseded by a new build option, -PERL_MEM_LOG (see L). The older API is still -there for use in XS modules supporting older perls. +In 5.9.3, Newx() and friends replace the older New() API, and drops the first +parameter, I, a debug aid which allowed callers to identify themselves. +This aid has been superseded by a new build option, PERL_MEM_LOG (see +L). The older API is still there for use in XS +modules supporting older perls. =for apidoc Am|void|Newxc|void* ptr|int nitems|type|cast -The XSUB-writer's interface to the C C function, with -cast. See also C>. +The XSUB-writer's interface to the C C function, with cast. See also +C>. Memory obtained by this should B be freed with L. =for apidoc Am|void|Newxz|void* ptr|int nitems|type =for apidoc_item |void*|safecalloc|size_t nitems|size_t item_size -The XSUB-writer's interface to the C C function. The allocated -memory is zeroed with C. See also C>. +The XSUB-writer's interface to the C C function. The allocated memory +is zeroed with C. See also C>. Memory obtained by this should B be freed with L. @@ -2641,8 +2663,7 @@ The XSUB-writer's interface to the C C function. Memory obtained by this should B be freed with L. =for apidoc Am|void|Renewc|void* ptr|int nitems|type|cast -The XSUB-writer's interface to the C C function, with -cast. +The XSUB-writer's interface to the C C function, with cast. Memory obtained by this should B be freed with L. @@ -2658,9 +2679,8 @@ The XSUB-writer's interface to the C C function. The C is the source, C is the destination, C is the number of items, and C is the type. Can do overlapping moves. See also C>. -C is like C but returns C. Useful -for encouraging compilers to tail-call -optimise. +C is like C but returns C. Useful for encouraging compilers +to tail-call optimise. =for apidoc Am|void |Copy |void* src|void* dest|int nitems|type =for apidoc_item |void *|CopyD|void* src|void* dest|int nitems|type @@ -2668,13 +2688,12 @@ The XSUB-writer's interface to the C C function. The C is the source, C is the destination, C is the number of items, and C is the type. May fail on overlapping copies. See also C>. -C is like C but returns C. Useful -for encouraging compilers to tail-call -optimise. +C is like C but returns C. Useful for encouraging compilers +to tail-call optimise. =for apidoc Am|void |NewCopy |void* src|void* dest|int nitems|type -Combines Newx() and Copy() into a single macro. Dest will be allocated -using Newx() and then src will be copied into it. +Combines Newx() and Copy() into a single macro. Dest will be allocated using +Newx() and then src will be copied into it. =for apidoc Am|void |Zero |void* dest|int nitems|type =for apidoc_item |void *|ZeroD|void* dest|int nitems|type @@ -2682,9 +2701,8 @@ using Newx() and then src will be copied into it. The XSUB-writer's interface to the C C function. The C is the destination, C is the number of items, and C is the type. -C is like C but returns C. Useful -for encouraging compilers to tail-call -optimise. +C is like C but returns C. Useful for encouraging compilers +to tail-call optimise. =for apidoc_section $utility =for apidoc Amu|void|StructCopy|type *src|type *dest|type @@ -2692,8 +2710,8 @@ This is an architecture-independent macro to copy one structure to another. =for apidoc Am|void|PoisonWith|void* dest|int nitems|type|U8 byte -Fill up memory with a byte pattern (a byte repeated over and over -again) that hopefully catches attempts to access uninitialized memory. +Fill up memory with a byte pattern (a byte repeated over and over again) that +hopefully catches attempts to access uninitialized memory. =for apidoc Am|void|PoisonNew|void* dest|int nitems|type @@ -2709,68 +2727,67 @@ PoisonWith(0xEF) for catching access to freed memory. =cut */ -/* Maintained for backwards-compatibility only. Use newSV() instead. */ +/* Maintained for backwards-compatibility only. Use newSV() instead. */ #ifndef PERL_CORE -#define NEWSV(x,len) newSV(len) +#define NEWSV(x,len) newSV(len) #endif -#define MEM_SIZE_MAX ((MEM_SIZE)-1) +#define MEM_SIZE_MAX ((MEM_SIZE)-1) -#define _PERL_STRLEN_ROUNDUP_UNCHECKED(n) (((n) - 1 + PERL_STRLEN_ROUNDUP_QUANTUM) & ~((MEM_SIZE)PERL_STRLEN_ROUNDUP_QUANTUM - 1)) +#define _PERL_STRLEN_ROUNDUP_UNCHECKED(n) \ + (((n) - 1 + PERL_STRLEN_ROUNDUP_QUANTUM) & ~((MEM_SIZE)PERL_STRLEN_ROUNDUP_QUANTUM - 1)) #ifdef PERL_MALLOC_WRAP /* This expression will be constant-folded at compile time. It checks - * whether or not the type of the count n is so small (e.g. U8 or U16, or - * U32 on 64-bit systems) that there's no way a wrap-around could occur. - * As well as avoiding the need for a run-time check in some cases, it's - * designed to avoid compiler warnings like: - * comparison is always false due to limited range of data type - * It's mathematically equivalent to - * max(n) * sizeof(t) > MEM_SIZE_MAX + * whether or not the type of the count n is so small (e.g. U8 or + * U16, or U32 on 64-bit systems) that there's no way a wrap-around + * could occur. As well as avoiding the need for a run-time check in + * some cases, it's designed to avoid compiler warnings like: + * comparison is always false due to limited range of data type It's + * mathematically equivalent to max(n) * sizeof(t) > MEM_SIZE_MAX */ -# define _MEM_WRAP_NEEDS_RUNTIME_CHECK(n,t) \ - ( sizeof(MEM_SIZE) < sizeof(n) \ - || sizeof(t) > ((MEM_SIZE)1 << 8*(sizeof(MEM_SIZE) - sizeof(n)))) +# define _MEM_WRAP_NEEDS_RUNTIME_CHECK(n,t) \ + ( sizeof(MEM_SIZE) < sizeof(n) \ + || sizeof(t) > ((MEM_SIZE)1 << 8*(sizeof(MEM_SIZE) - sizeof(n)))) /* This is written in a slightly odd way to avoid various spurious - * compiler warnings. We *want* to write the expression as - * _MEM_WRAP_NEEDS_RUNTIME_CHECK(n,t) && (n > C) - * (for some compile-time constant C), but even when the LHS - * constant-folds to false at compile-time, g++ insists on emitting - * warnings about the RHS (e.g. "comparison is always false"), so instead - * we write it as + * compiler warnings. We *want* to write the expression as + * _MEM_WRAP_NEEDS_RUNTIME_CHECK(n,t) && (n > C) (for some compile-time + * constant C), but even when the LHS constant-folds to false at + * compile-time, g++ insists on emitting warnings about the RHS (e.g. + * "comparison is always false"), so instead we write it as * * (cond ? n : X) > C * - * where X is a constant with X > C always false. Choosing a value for X - * is tricky. If 0, some compilers will complain about 0 > C always being - * false; if 1, Coverity complains when n happens to be the constant value - * '1', that cond ? 1 : 1 has the same value on both branches; so use C - * for X and hope that nothing else whines. + * where X is a constant with X > C always false. Choosing a value for + * X is tricky. If 0, some compilers will complain about 0 > C always + * being false; if 1, Coverity complains when n happens to be the + * constant value '1', that cond ? 1 : 1 has the same value on both + * branches; so use C for X and hope that nothing else whines. */ -# define _MEM_WRAP_WILL_WRAP(n,t) \ - ((_MEM_WRAP_NEEDS_RUNTIME_CHECK(n,t) ? (MEM_SIZE)(n) : \ - MEM_SIZE_MAX/sizeof(t)) > MEM_SIZE_MAX/sizeof(t)) +# define _MEM_WRAP_WILL_WRAP(n,t) \ + ((_MEM_WRAP_NEEDS_RUNTIME_CHECK(n,t) ? (MEM_SIZE)(n) : \ + MEM_SIZE_MAX/sizeof(t)) > MEM_SIZE_MAX/sizeof(t)) -# define MEM_WRAP_CHECK(n,t) \ - (void)(UNLIKELY(_MEM_WRAP_WILL_WRAP(n,t)) \ - && (croak_memory_wrap(),0)) +# define MEM_WRAP_CHECK(n,t) \ + (void)(UNLIKELY(_MEM_WRAP_WILL_WRAP(n,t)) && (croak_memory_wrap(),0)) -# define MEM_WRAP_CHECK_1(n,t,a) \ - (void)(UNLIKELY(_MEM_WRAP_WILL_WRAP(n,t)) \ - && (Perl_croak_nocontext("%s",(a)),0)) +# define MEM_WRAP_CHECK_1(n,t,a) \ + (void)(UNLIKELY(_MEM_WRAP_WILL_WRAP(n,t)) \ + && (Perl_croak_nocontext("%s",(a)),0)) /* "a" arg must be a string literal */ -# define MEM_WRAP_CHECK_s(n,t,a) \ - ( (void) (UNLIKELY(_MEM_WRAP_WILL_WRAP(n,t)) \ - && (Perl_croak_nocontext(ASSERT_IS_LITERAL(a)), 0))) +# define MEM_WRAP_CHECK_s(n,t,a) \ + ( (void) (UNLIKELY(_MEM_WRAP_WILL_WRAP(n,t)) \ + && (Perl_croak_nocontext(ASSERT_IS_LITERAL(a)), 0))) -# define MEM_WRAP_CHECK_(n,t) MEM_WRAP_CHECK(n,t), +# define MEM_WRAP_CHECK_(n,t) MEM_WRAP_CHECK(n,t), -# define PERL_STRLEN_ROUNDUP(n) ((void)(((n) > MEM_SIZE_MAX - 2 * PERL_STRLEN_ROUNDUP_QUANTUM) ? (croak_memory_wrap(),0) : 0), _PERL_STRLEN_ROUNDUP_UNCHECKED(n)) +# define PERL_STRLEN_ROUNDUP(n) \ + ((void)(((n) > MEM_SIZE_MAX - 2 * PERL_STRLEN_ROUNDUP_QUANTUM) ? (croak_memory_wrap(),0) : 0), _PERL_STRLEN_ROUNDUP_UNCHECKED(n)) #else # define MEM_WRAP_CHECK(n,t) @@ -2778,7 +2795,7 @@ PoisonWith(0xEF) for catching access to freed memory. # define MEM_WRAP_CHECK_s(n,t,a) # define MEM_WRAP_CHECK_(n,t) -# define PERL_STRLEN_ROUNDUP(n) _PERL_STRLEN_ROUNDUP_UNCHECKED(n) +# define PERL_STRLEN_ROUNDUP(n) _PERL_STRLEN_ROUNDUP_UNCHECKED(n) #endif @@ -2830,77 +2847,91 @@ enum mem_log_type { #endif #ifdef PERL_MEM_LOG -#define MEM_LOG_ALLOC(n,t,a) Perl_mem_log_alloc(n,sizeof(t),STRINGIFY(t),a,__FILE__,__LINE__,FUNCTION__) -#define MEM_LOG_REALLOC(n,t,v,a) Perl_mem_log_realloc(n,sizeof(t),STRINGIFY(t),v,a,__FILE__,__LINE__,FUNCTION__) -#define MEM_LOG_FREE(a) Perl_mem_log_free(a,__FILE__,__LINE__,FUNCTION__) +#define MEM_LOG_ALLOC(n,t,a) \ + Perl_mem_log_alloc(n,sizeof(t),STRINGIFY(t),a,__FILE__,__LINE__,FUNCTION__) +#define MEM_LOG_REALLOC(n,t,v,a) \ + Perl_mem_log_realloc(n,sizeof(t),STRINGIFY(t),v,a,__FILE__,__LINE__,FUNCTION__) +#define MEM_LOG_FREE(a) \ + Perl_mem_log_free(a,__FILE__,__LINE__,FUNCTION__) #endif #ifndef MEM_LOG_ALLOC -#define MEM_LOG_ALLOC(n,t,a) (a) +#define MEM_LOG_ALLOC(n,t,a) (a) #endif #ifndef MEM_LOG_REALLOC -#define MEM_LOG_REALLOC(n,t,v,a) (a) +#define MEM_LOG_REALLOC(n,t,v,a) (a) #endif #ifndef MEM_LOG_FREE -#define MEM_LOG_FREE(a) (a) +#define MEM_LOG_FREE(a) (a) #endif -#define Newx(v,n,t) (v = (MEM_WRAP_CHECK_(n,t) (t*)MEM_LOG_ALLOC(n,t,safemalloc((MEM_SIZE)((n)*sizeof(t)))))) -#define Newxc(v,n,t,c) (v = (MEM_WRAP_CHECK_(n,t) (c*)MEM_LOG_ALLOC(n,t,safemalloc((MEM_SIZE)((n)*sizeof(t)))))) -#define Newxz(v,n,t) (v = (MEM_WRAP_CHECK_(n,t) (t*)MEM_LOG_ALLOC(n,t,safecalloc((n),sizeof(t))))) +#define Newx(v,n,t) \ + (v = (MEM_WRAP_CHECK_(n,t) (t*)MEM_LOG_ALLOC(n,t,safemalloc((MEM_SIZE)((n)*sizeof(t)))))) +#define Newxc(v,n,t,c) \ + (v = (MEM_WRAP_CHECK_(n,t) (c*)MEM_LOG_ALLOC(n,t,safemalloc((MEM_SIZE)((n)*sizeof(t)))))) +#define Newxz(v,n,t) \ + (v = (MEM_WRAP_CHECK_(n,t) (t*)MEM_LOG_ALLOC(n,t,safecalloc((n),sizeof(t))))) #ifndef PERL_CORE /* pre 5.9.x compatibility */ -#define New(x,v,n,t) Newx(v,n,t) -#define Newc(x,v,n,t,c) Newxc(v,n,t,c) -#define Newz(x,v,n,t) Newxz(v,n,t) +#define New(x,v,n,t) Newx(v,n,t) +#define Newc(x,v,n,t,c) Newxc(v,n,t,c) +#define Newz(x,v,n,t) Newxz(v,n,t) #endif -#define Renew(v,n,t) \ - (v = (MEM_WRAP_CHECK_(n,t) (t*)MEM_LOG_REALLOC(n,t,v,saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))))) +#define Renew(v,n,t) \ + (v = (MEM_WRAP_CHECK_(n,t) (t*)MEM_LOG_REALLOC(n,t,v,saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))))) #define Renewc(v,n,t,c) \ - (v = (MEM_WRAP_CHECK_(n,t) (c*)MEM_LOG_REALLOC(n,t,v,saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))))) + (v = (MEM_WRAP_CHECK_(n,t) (c*)MEM_LOG_REALLOC(n,t,v,saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))))) #ifdef PERL_POISON #define Safefree(d) \ - ((d) ? (void)(safefree(MEM_LOG_FREE((Malloc_t)(d))), Poison(&(d), 1, Malloc_t)) : (void) 0) + ((d) ? (void)(safefree(MEM_LOG_FREE((Malloc_t)(d))), Poison(&(d), 1, Malloc_t)) : (void) 0) #else -#define Safefree(d) safefree(MEM_LOG_FREE((Malloc_t)(d))) +#define Safefree(d) safefree(MEM_LOG_FREE((Malloc_t)(d))) #endif -/* assert that a valid ptr has been supplied - use this instead of assert(ptr) * - * as it handles cases like constant string arguments without throwing warnings * - * the cast is required, as is the inequality check, to avoid warnings */ -#define perl_assert_ptr(p) assert( ((void*)(p)) != 0 ) +/* assert that a valid ptr has been supplied - use this instead of assert(ptr) + * as it handles cases like constant string arguments without throwing warnings + * the cast is required, as is the inequality check, to avoid warnings */ +#define perl_assert_ptr(p) assert( ((void*)(p)) != 0 ) -#define Move(s,d,n,t) (MEM_WRAP_CHECK_(n,t) perl_assert_ptr(d), perl_assert_ptr(s), (void)memmove((char*)(d),(const char*)(s), (n) * sizeof(t))) -#define Copy(s,d,n,t) (MEM_WRAP_CHECK_(n,t) perl_assert_ptr(d), perl_assert_ptr(s), (void)memcpy((char*)(d),(const char*)(s), (n) * sizeof(t))) -#define Zero(d,n,t) (MEM_WRAP_CHECK_(n,t) perl_assert_ptr(d), (void)memzero((char*)(d), (n) * sizeof(t))) +#define Move(s,d,n,t) \ + (MEM_WRAP_CHECK_(n,t) perl_assert_ptr(d), perl_assert_ptr(s), (void)memmove((char*)(d),(const char*)(s), (n) * sizeof(t))) +#define Copy(s,d,n,t) \ + (MEM_WRAP_CHECK_(n,t) perl_assert_ptr(d), perl_assert_ptr(s), (void)memcpy((char*)(d),(const char*)(s), (n) * sizeof(t))) +#define Zero(d,n,t) \ + (MEM_WRAP_CHECK_(n,t) perl_assert_ptr(d), (void)memzero((char*)(d), (n) * sizeof(t))) /* Like above, but returns a pointer to 'd' */ -#define MoveD(s,d,n,t) (MEM_WRAP_CHECK_(n,t) perl_assert_ptr(d), perl_assert_ptr(s), memmove((char*)(d),(const char*)(s), (n) * sizeof(t))) -#define CopyD(s,d,n,t) (MEM_WRAP_CHECK_(n,t) perl_assert_ptr(d), perl_assert_ptr(s), memcpy((char*)(d),(const char*)(s), (n) * sizeof(t))) -#define ZeroD(d,n,t) (MEM_WRAP_CHECK_(n,t) perl_assert_ptr(d), memzero((char*)(d), (n) * sizeof(t))) - -#define NewCopy(s,d,n,t) STMT_START { \ - Newx(d,n,t); \ - Copy(s,d,n,t); \ -} STMT_END - -#define PoisonWith(d,n,t,b) (MEM_WRAP_CHECK_(n,t) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))) -#define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB) -#define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF) -#define Poison(d,n,t) PoisonFree(d,n,t) +#define MoveD(s,d,n,t) \ + (MEM_WRAP_CHECK_(n,t) perl_assert_ptr(d), perl_assert_ptr(s), memmove((char*)(d),(const char*)(s), (n) * sizeof(t))) +#define CopyD(s,d,n,t) \ + (MEM_WRAP_CHECK_(n,t) perl_assert_ptr(d), perl_assert_ptr(s), memcpy((char*)(d),(const char*)(s), (n) * sizeof(t))) +#define ZeroD(d,n,t) \ + (MEM_WRAP_CHECK_(n,t) perl_assert_ptr(d), memzero((char*)(d), (n) * sizeof(t))) + +#define NewCopy(s,d,n,t) \ + STMT_START { \ + Newx(d,n,t); \ + Copy(s,d,n,t); \ + } STMT_END + +#define PoisonWith(d,n,t,b) \ + (MEM_WRAP_CHECK_(n,t) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))) +#define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB) +#define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF) +#define Poison(d,n,t) PoisonFree(d,n,t) #ifdef PERL_POISON -# define PERL_POISON_EXPR(x) x +# define PERL_POISON_EXPR(x) x #else # define PERL_POISON_EXPR(x) #endif /* Shallow copy */ -#define StructCopy(s,d,t) (*((t*)(d)) = *((t*)(s))) +#define StructCopy(s,d,t) (*((t*)(d)) = *((t*)(s))) /* =for apidoc_section $utility @@ -2919,33 +2950,33 @@ Returns a pointer to one element past the final element of the input C array. C_ARRAY_END is one past the last: half-open/half-closed range, not last-inclusive range. */ -#define C_ARRAY_LENGTH(a) (sizeof(a)/sizeof((a)[0])) -#define C_ARRAY_END(a) ((a) + C_ARRAY_LENGTH(a)) +#define C_ARRAY_LENGTH(a) (sizeof(a)/sizeof((a)[0])) +#define C_ARRAY_END(a) ((a) + C_ARRAY_LENGTH(a)) #if defined(PERL_CORE) || defined(PERL_EXT_RE_BUILD) /* strlen() of a literal string constant. Restricting this to core, in part * because it can generate compiler warnings about comparing unlike signs */ -# define STRLENs(s) (sizeof("" s "") - 1) +# define STRLENs(s) (sizeof("" s "") - 1) #endif #ifdef NEED_VA_COPY # ifdef va_copy -# define Perl_va_copy(s, d) va_copy(d, s) +# define Perl_va_copy(s, d) va_copy(d, s) # elif defined(__va_copy) -# define Perl_va_copy(s, d) __va_copy(d, s) +# define Perl_va_copy(s, d) __va_copy(d, s) # else -# define Perl_va_copy(s, d) Copy(s, d, 1, va_list) +# define Perl_va_copy(s, d) Copy(s, d, 1, va_list) # endif #endif /* convenience debug macros */ #ifdef USE_ITHREADS -#define pTHX_FORMAT "Perl interpreter: 0x%p" -#define pTHX__FORMAT ", Perl interpreter: 0x%p" -#define pTHX_VALUE_ (void *)my_perl, -#define pTHX_VALUE (void *)my_perl -#define pTHX__VALUE_ ,(void *)my_perl, -#define pTHX__VALUE ,(void *)my_perl +#define pTHX_FORMAT "Perl interpreter: 0x%p" +#define pTHX__FORMAT ", Perl interpreter: 0x%p" +#define pTHX_VALUE_ (void *)my_perl, +#define pTHX_VALUE (void *)my_perl +#define pTHX__VALUE_ ,(void *)my_perl, +#define pTHX__VALUE ,(void *)my_perl #else #define pTHX_FORMAT #define pTHX__FORMAT @@ -2955,128 +2986,122 @@ last-inclusive range. #define pTHX__VALUE #endif /* USE_ITHREADS */ -/* Perl_deprecate was not part of the public API, and did not have a deprecate() - shortcut macro defined without -DPERL_CORE. Neither codesearch.google.com nor - CPAN::Unpack show any users outside the core. */ +/* Perl_deprecate was not part of the public API, and did + not have a deprecate() shortcut macro defined without + -DPERL_CORE. Neither codesearch.google.com nor + CPAN::Unpack show any users outside the core. */ #ifdef PERL_CORE -# define deprecate(s) Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), \ - "Use of " s " is deprecated") -# define deprecate_disappears_in(when,message) \ - Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), \ - message " is deprecated, and will disappear in Perl " when) -# define deprecate_fatal_in(when,message) \ - Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), \ - message " is deprecated, and will become fatal in Perl " when) +# define deprecate(s) \ + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), \ + "Use of " s " is deprecated") +# define deprecate_disappears_in(when,message) \ + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), \ + message " is deprecated, and will disappear in Perl " when) +# define deprecate_fatal_in(when,message) \ + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), \ + message " is deprecated, and will become fatal in Perl " when) #endif /* Internal macros to deal with gids and uids */ #ifdef PERL_CORE # if Uid_t_size > IVSIZE -# define sv_setuid(sv, uid) sv_setnv((sv), (NV)(uid)) -# define SvUID(sv) SvNV(sv) +# define sv_setuid(sv, uid) sv_setnv((sv), (NV)(uid)) +# define SvUID(sv) SvNV(sv) # elif Uid_t_sign <= 0 -# define sv_setuid(sv, uid) sv_setiv((sv), (IV)(uid)) -# define SvUID(sv) SvIV(sv) +# define sv_setuid(sv, uid) sv_setiv((sv), (IV)(uid)) +# define SvUID(sv) SvIV(sv) # else -# define sv_setuid(sv, uid) sv_setuv((sv), (UV)(uid)) -# define SvUID(sv) SvUV(sv) +# define sv_setuid(sv, uid) sv_setuv((sv), (UV)(uid)) +# define SvUID(sv) SvUV(sv) # endif /* Uid_t_size */ # if Gid_t_size > IVSIZE -# define sv_setgid(sv, gid) sv_setnv((sv), (NV)(gid)) -# define SvGID(sv) SvNV(sv) +# define sv_setgid(sv, gid) sv_setnv((sv), (NV)(gid)) +# define SvGID(sv) SvNV(sv) # elif Gid_t_sign <= 0 -# define sv_setgid(sv, gid) sv_setiv((sv), (IV)(gid)) -# define SvGID(sv) SvIV(sv) +# define sv_setgid(sv, gid) sv_setiv((sv), (IV)(gid)) +# define SvGID(sv) SvIV(sv) # else -# define sv_setgid(sv, gid) sv_setuv((sv), (UV)(gid)) -# define SvGID(sv) SvUV(sv) +# define sv_setgid(sv, gid) sv_setuv((sv), (UV)(gid)) +# define SvGID(sv) SvUV(sv) # endif /* Gid_t_size */ #endif -/* These are simple Marsaglia XOR-SHIFT RNG's for 64 and 32 bits. These - * RNG's are of reasonable quality, very fast, and have the interesting - * property that provided 'x' is non-zero they create a cycle of 2^32-1 - * or 2^64-1 "random" like numbers, with the exception of 0. Thus they - * are very useful when you want an integer to "dance" in a random way, - * but you also never want it to become 0 and thus false. +/* These are simple Marsaglia XOR-SHIFT RNG's for 64 and 32 bits. These RNG's + * are of reasonable quality, very fast, and have the interesting property that + * provided 'x' is non-zero they create a cycle of 2^32-1 or 2^64-1 "random" + * like numbers, with the exception of 0. Thus they are very useful when you + * want an integer to "dance" in a random way, but you also never want it to + * become 0 and thus false. * * Obviously they leave x unchanged if it starts out as 0. * - * We have two variants just because that can be helpful in certain - * places. There is no advantage to either, they are equally bad as each - * other as far RNG's go. Sufficiently random for many purposes, but - * insufficiently random for serious use as they fail important tests in - * the Test01 BigCrush RNG test suite by L’Ecuyer and Simard. (Note - * that Drand48 also fails BigCrush). The main point is they produce - * different sequences and in places where we want some randomlike - * behavior they are cheap and easy. + * We have two variants just because that can be helpful in certain places. + * There is no advantage to either, they are equally bad as each other as far + * RNG's go. Sufficiently random for many purposes, but insufficiently random + * for serious use as they fail important tests in the Test01 BigCrush RNG test + * suite by L’Ecuyer and Simard. (Note that Drand48 also fails BigCrush). + * The main point is they produce different sequences and in places where we + * want some randomlike behavior they are cheap and easy. * - * Marsaglia was one of the early researchers into RNG testing and wrote - * the Diehard RNG test suite, which after his death become the - * Dieharder RNG suite, and was generally supplanted by the Test01 suite - * by L'Ecruyer and associates. + * Marsaglia was one of the early researchers into RNG testing and wrote the + * Diehard RNG test suite, which after his death become the Dieharder RNG + * suite, and was generally supplanted by the Test01 suite by L'Ecruyer and + * associates. * - * There are dozens of shift parameters that create a pseudo random ring - * of integers 1..2^N-1, if you need a different sequence just read the - * paper and select a set of parameters. In fact, simply reversing the - * shift order from L/R/L to R/L/R should result in another valid - * example, but read the paper before you do that. + * There are dozens of shift parameters that create a pseudo random ring of + * integers 1..2^N-1, if you need a different sequence just read the paper and + * select a set of parameters. In fact, simply reversing the shift order from + * L/R/L to R/L/R should result in another valid example, but read the paper + * before you do that. * * PDF of the original paper: - * https://www.jstatsoft.org/article/download/v008i14/916 - * Wikipedia: - * https://en.wikipedia.org/wiki/Xorshift - * Criticism: - * https://www.iro.umontreal.ca/~lecuyer/myftp/papers/xorshift.pdf - * Test01: - * http://simul.iro.umontreal.ca/testu01/tu01.html - * Diehard: - * https://en.wikipedia.org/wiki/Diehard_tests - * Dieharder: - * https://webhome.phy.duke.edu/~rgb/General/rand_rate/rand_rate.abs - * + * https://www.jstatsoft.org/article/download/v008i14/916 Wikipedia: + * https://en.wikipedia.org/wiki/Xorshift Criticism: + * https://www.iro.umontreal.ca/~lecuyer/myftp/papers/xorshift.pdf Test01: + * http://simul.iro.umontreal.ca/testu01/tu01.html Diehard: + * https://en.wikipedia.org/wiki/Diehard_tests Dieharder: + * https://webhome.phy.duke.edu/~rgb/General/rand_rate/rand_rate.abs */ /* 32 bit version */ #define PERL_XORSHIFT32_A(x) \ -STMT_START { \ - (x) ^= ((x) << 13); \ - (x) ^= ((x) >> 17); \ - (x) ^= ((x) << 5); \ -} STMT_END + STMT_START { \ + (x) ^= ((x) << 13); \ + (x) ^= ((x) >> 17); \ + (x) ^= ((x) << 5); \ + } STMT_END /* 64 bit version */ #define PERL_XORSHIFT64_A(x) \ -STMT_START { \ - (x) ^= ((x) << 13); \ - (x) ^= ((x) >> 7); \ - (x) ^= ((x) << 17); \ -} STMT_END + STMT_START { \ + (x) ^= ((x) << 13); \ + (x) ^= ((x) >> 7); \ + (x) ^= ((x) << 17); \ + } STMT_END /* 32 bit version */ #define PERL_XORSHIFT32_B(x) \ -STMT_START { \ - (x) ^= ((x) << 5); \ - (x) ^= ((x) >> 27); \ - (x) ^= ((x) << 8); \ -} STMT_END - -/* 64 bit version - currently this is unused, - * it is provided here to complement the 32 bit _B - * variant which IS used. */ + STMT_START { \ + (x) ^= ((x) << 5); \ + (x) ^= ((x) >> 27); \ + (x) ^= ((x) << 8); \ + } STMT_END + +/* 64 bit version - currently this is unused, it is provided here + * to complement the 32 bit _B variant which IS used. */ #define PERL_XORSHIFT64_B(x) \ -STMT_START { \ - (x) ^= ((x) << 15); \ - (x) ^= ((x) >> 49); \ - (x) ^= ((x) << 26); \ -} STMT_END + STMT_START { \ + (x) ^= ((x) << 15); \ + (x) ^= ((x) >> 49); \ + (x) ^= ((x) << 26); \ + } STMT_END #endif /* PERL_HANDY_H_ */ /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/hv.h b/hv.h index ba9f9e4dbc5e..4da8207a61d0 100644 --- a/hv.h +++ b/hv.h @@ -1,182 +1,205 @@ /* hv.h * - * Copyright (C) 1991, 1992, 1993, 1996, 1997, 1998, 1999, - * 2000, 2001, 2002, 2003, 2005, 2006, 2007, 2008, by Larry Wall and others + * Copyright (C) 1991, 1992, 1993, 1996, 1997, 1998, 1999, 2000, 2001, 2002, + * 2003, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, + * 2016, 2017, 2018, 2019, 2020, 2021, 2022 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * */ -/* These control hash traversal randomization and the environment variable PERL_PERTURB_KEYS. - * Currently disabling this functionality will break a few tests, but should otherwise work fine. - * See perlrun for more details. */ +/* These control hash traversal randomization and the environment variable + * PERL_PERTURB_KEYS. Currently disabling this functionality will break a few + * tests, but should otherwise work fine. See perlrun for more details. */ #if defined(PERL_PERTURB_KEYS_DISABLED) -# define PL_HASH_RAND_BITS_ENABLED 0 -# define PERL_HASH_ITER_BUCKET(iter) ((iter)->xhv_riter) +# define PL_HASH_RAND_BITS_ENABLED 0 +# define PERL_HASH_ITER_BUCKET(iter) ((iter)->xhv_riter) #else -# define PERL_HASH_RANDOMIZE_KEYS 1 +# define PERL_HASH_RANDOMIZE_KEYS 1 # if defined(PERL_PERTURB_KEYS_RANDOM) -# define PL_HASH_RAND_BITS_ENABLED 1 +# define PL_HASH_RAND_BITS_ENABLED 1 # elif defined(PERL_PERTURB_KEYS_DETERMINISTIC) -# define PL_HASH_RAND_BITS_ENABLED 2 +# define PL_HASH_RAND_BITS_ENABLED 2 # else -# define USE_PERL_PERTURB_KEYS 1 -# define PL_HASH_RAND_BITS_ENABLED PL_hash_rand_bits_enabled +# define USE_PERL_PERTURB_KEYS 1 +# define PL_HASH_RAND_BITS_ENABLED PL_hash_rand_bits_enabled # endif -# define PERL_HASH_ITER_BUCKET(iter) (((iter)->xhv_riter) ^ ((iter)->xhv_rand)) +# define PERL_HASH_ITER_BUCKET(iter) \ + (((iter)->xhv_riter) ^ ((iter)->xhv_rand)) #endif #ifdef PERL_USE_UNSHARED_KEYS_IN_LARGE_HASHES -#define LARGE_HASH_HEURISTIC(hv,new_max) S_large_hash_heuristic(aTHX_ (hv), (new_max)) +#define LARGE_HASH_HEURISTIC(hv,new_max) \ + S_large_hash_heuristic(aTHX_ (hv), (new_max)) #else -#define LARGE_HASH_HEURISTIC(hv,new_max) 0 +#define LARGE_HASH_HEURISTIC(hv,new_max) 0 #endif /* entry in hash value chain */ -struct he { - /* Keep hent_next first in this structure, because sv_free_arenas take - advantage of this to share code between the he arenas and the SV - body arenas */ - HE *hent_next; /* next entry in chain */ - HEK *hent_hek; /* hash key */ +struct he { /* Keep hent_next first in this structure, because + sv_free_arenas take advantage of this to share code between + the he arenas and the SV body arenas */ + HE *hent_next; /* next entry in chain */ + HEK *hent_hek; /* hash key */ union { - SV *hent_val; /* scalar value that was hashed */ - Size_t hent_refcount; /* references for this shared hash key */ - } he_valu; + SV *hent_val; /* scalar value that was hashed */ + Size_t hent_refcount; /* references for this shared hash key */ + } he_valu; }; /* hash key -- defined separately for use as shared pointer */ struct hek { - U32 hek_hash; /* computed hash of key */ - I32 hek_len; /* length of the hash key */ - /* Be careful! Sometimes we store a pointer in the hek_key - * buffer, which means it must be 8 byte aligned or things - * dont work on aligned platforms like HPUX - * Also beware, the last byte of the hek_key buffer is a - * hidden flags byte about the key. */ - char hek_key[1]; /* variable-length hash key */ + U32 hek_hash; /* computed hash of key */ + I32 hek_len; /* length of the hash key */ + /* Be careful! Sometimes we store a pointer in the hek_key buffer, + * which means it must be 8 byte aligned or things dont work on + * aligned platforms like HPUX Also beware, the last byte of the + * hek_key buffer is a hidden flags byte about the key. */ + char hek_key[1]; /* variable-length hash key */ /* the hash-key is \0-terminated */ - /* after the \0 there is a byte for flags, such as whether the key - is UTF-8 or WAS-UTF-8, or an SV */ + /* after the \0 there is a byte for flags, such as whether + the key is UTF-8 or WAS-UTF-8, or an SV */ }; struct shared_he { - struct he shared_he_he; - struct hek shared_he_hek; + struct he shared_he_he; + struct hek shared_he_hek; }; -/* Subject to change. - Don't access this directly. +/* Subject to change. Don't access this directly. Use the funcs in mro_core.c -*/ + */ struct mro_alg { - AV *(*resolve)(pTHX_ HV* stash, U32 level); - const char *name; - U16 length; - U16 kflags; /* For the hash API - set HVhek_UTF8 if name is UTF-8 */ - U32 hash; /* or 0 */ + AV *(*resolve)(pTHX_ HV* stash, U32 level); + const char *name; + U16 length; + U16 kflags; /* For the hash API - set + HVhek_UTF8 if name is UTF-8 */ + U32 hash; /* or 0 */ }; -struct mro_meta { - /* a hash holding the different MROs private data. */ - HV *mro_linear_all; +struct mro_meta { /* a hash holding the different MROs private data. */ + HV *mro_linear_all; /* a pointer directly to the current MROs private data. If mro_linear_all is NULL, this owns the SV reference, else it is just a pointer to a - value stored in and owned by mro_linear_all. */ - SV *mro_linear_current; - HV *mro_nextmethod; /* next::method caching */ - U32 cache_gen; /* Bumping this invalidates our method cache */ - U32 pkg_gen; /* Bumps when local methods/@ISA change */ - const struct mro_alg *mro_which; /* which mro alg is in use? */ - HV *isa; /* Everything this class @ISA */ - HV *super; /* SUPER method cache */ - CV *destroy; /* DESTROY method if destroy_gen non-zero */ - U32 destroy_gen; /* Generation number of DESTROY cache */ + value stored in and owned by mro_linear_all. */ + SV *mro_linear_current; + HV *mro_nextmethod; /* next::method caching */ + U32 cache_gen; /* Bumping this invalidates + our method cache */ + U32 pkg_gen; /* Bumps when local + methods/@ISA change */ + const struct mro_alg *mro_which; /* which mro alg is + in use? */ + HV *isa; /* Everything this + class @ISA */ + HV *super; /* SUPER method cache */ + CV *destroy; /* DESTROY method if + destroy_gen non-zero */ + U32 destroy_gen; /* Generation number of + DESTROY cache */ }; -#define MRO_GET_PRIVATE_DATA(smeta, which) \ - (((smeta)->mro_which && (which) == (smeta)->mro_which) \ - ? (smeta)->mro_linear_current \ +#define MRO_GET_PRIVATE_DATA(smeta, which) \ + (((smeta)->mro_which && (which) == (smeta)->mro_which) \ + ? (smeta)->mro_linear_current \ : Perl_mro_get_private_data(aTHX_ (smeta), (which))) -/* Subject to change. - Don't access this directly. -*/ +/* Subject to change. Don't access this directly. + */ union _xhvnameu { - HEK *xhvnameu_name; /* When xhv_name_count is 0 */ - HEK **xhvnameu_names; /* When xhv_name_count is non-0 */ + HEK *xhvnameu_name; /* When xhv_name_count is 0 */ + HEK **xhvnameu_names; /* When xhv_name_count is non-0 */ }; /* A struct defined by pad.h and used within class.c */ struct suspended_compcv; struct xpvhv_aux { - union _xhvnameu xhv_name_u; /* name, if a symbol table */ - AV *xhv_backreferences; /* back references for weak references */ - HE *xhv_eiter; /* current entry of iterator */ - I32 xhv_riter; /* current root of iterator */ - -/* Concerning xhv_name_count: When non-zero, xhv_name_u contains a pointer - * to an array of HEK pointers, this being the length. The first element is - * the name of the stash, which may be NULL. If xhv_name_count is positive, - * then *xhv_name is one of the effective names. If xhv_name_count is nega- - * tive, then xhv_name_u.xhvnameu_names[1] is the first effective name. - */ - I32 xhv_name_count; - struct mro_meta *xhv_mro_meta; + union _xhvnameu xhv_name_u; /* name, if a symbol + table */ + AV *xhv_backreferences; /* back references for + weak references */ + HE *xhv_eiter; /* current entry of + iterator */ + I32 xhv_riter; /* current root of + iterator */ + + /* Concerning xhv_name_count: When non-zero, xhv_name_u contains + * a pointer to an array of HEK pointers, this being the length. + * The first element is the name of the stash, which may be + * NULL. If xhv_name_count is positive, then *xhv_name is one of + * the effective names. If xhv_name_count is nega- tive, then + * xhv_name_u.xhvnameu_names[1] is the first effective name. + */ + I32 xhv_name_count; + struct mro_meta *xhv_mro_meta; #ifdef PERL_HASH_RANDOMIZE_KEYS - U32 xhv_rand; /* random value for hash traversal */ - U32 xhv_last_rand; /* last random value for hash traversal, - used to detect each() after insert for warnings */ + U32 xhv_rand; /* random value for + hash traversal */ + U32 xhv_last_rand; /* last random value + for hash traversal, + used to detect + each() after insert + for warnings */ #endif - U32 xhv_aux_flags; /* assorted extra flags */ - - /* The following fields are only valid if we have the flag HvAUXf_IS_CLASS */ - HV *xhv_class_superclass; /* STASH of the :isa() base class */ - CV *xhv_class_initfields_cv; /* CV for running initfields */ - AV *xhv_class_adjust_blocks; /* CVs containing the ADJUST blocks */ - PADNAMELIST *xhv_class_fields; /* PADNAMEs with PadnameIsFIELD() */ - PADOFFSET xhv_class_next_fieldix; - HV *xhv_class_param_map; /* Maps param names to field index stored in UV */ - - struct suspended_compcv - *xhv_class_suspended_initfields_compcv; + U32 xhv_aux_flags; /* assorted extra + flags */ + + /* The following fields are only valid if + we have the flag HvAUXf_IS_CLASS */ + HV *xhv_class_superclass; /* STASH of the :isa() + base class */ + CV *xhv_class_initfields_cv; /* CV for running + initfields */ + AV *xhv_class_adjust_blocks; /* CVs containing the + ADJUST blocks */ + PADNAMELIST *xhv_class_fields; /* PADNAMEs with + PadnameIsFIELD() */ + PADOFFSET xhv_class_next_fieldix; + HV *xhv_class_param_map; /* Maps param names + to field index + stored in UV */ + + struct suspended_compcv *xhv_class_suspended_initfields_compcv; }; -#define HvAUXf_SCAN_STASH 0x1 /* stash is being scanned by gv_check */ -#define HvAUXf_NO_DEREF 0x2 /* @{}, %{} etc (and nomethod) not present */ -#define HvAUXf_IS_CLASS 0x4 /* the package is a 'class' */ +#define HvAUXf_SCAN_STASH 0x1 /* stash is being scanned + by gv_check */ +#define HvAUXf_NO_DEREF 0x2 /* @{}, %{} etc (and nomethod) + not present */ +#define HvAUXf_IS_CLASS 0x4 /* the package is a 'class' */ -#define HvSTASH_IS_CLASS(hv) \ +#define HvSTASH_IS_CLASS(hv) \ (HvHasAUX(hv) && HvAUX(hv)->xhv_aux_flags & HvAUXf_IS_CLASS) /* hash structure: */ /* This structure must match the beginning of struct xpvmg in sv.h. */ struct xpvhv { - HV* xmg_stash; /* class package */ - union _xmgu xmg_u; - STRLEN xhv_keys; /* total keys, including placeholders */ - STRLEN xhv_max; /* subscript of last element of xhv_array */ + HV *xmg_stash; /* class package */ + union _xmgu xmg_u; + STRLEN xhv_keys; /* total keys, including placeholders */ + STRLEN xhv_max; /* subscript of last element of xhv_array */ }; struct xpvhv_with_aux { - HV *xmg_stash; /* class package */ - union _xmgu xmg_u; - STRLEN xhv_keys; /* total keys, including placeholders */ - STRLEN xhv_max; /* subscript of last element of xhv_array */ - struct xpvhv_aux xhv_aux; + HV *xmg_stash; /* class package */ + union _xmgu xmg_u; + STRLEN xhv_keys; /* total keys, including placeholders */ + STRLEN xhv_max; /* subscript of last element + of xhv_array */ + struct xpvhv_aux xhv_aux; }; /* =for apidoc AmnU||HEf_SVKEY This flag, used in the length slot of hash entries and magic structures, -specifies the structure contains an C pointer where a C pointer -is to be expected. (For information only--not to be used). +specifies the structure contains an C pointer where a C pointer is +to be expected. (For information only--not to be used). =for apidoc ADmnU||Nullhv Null HV pointer. @@ -184,8 +207,8 @@ Null HV pointer. (deprecated - use C<(HV *)NULL> instead) =for apidoc Am|char*|HvNAME|HV* stash -Returns the package name of a stash, or C if C isn't a stash. -See C>, C>. +Returns the package name of a stash, or C if C isn't a stash. See +C>, C>. =for apidoc Am|STRLEN|HvNAMELEN|HV *stash Returns the length of the stash's name. @@ -198,12 +221,11 @@ Disfavored forms of HvNAME and HvNAMELEN; suppress mention of them Returns true if the name is in UTF-8 encoding. =for apidoc Am|char*|HvENAME|HV* stash -Returns the effective name of a stash, or NULL if there is none. The -effective name represents a location in the symbol table where this stash -resides. It is updated automatically when packages are aliased or deleted. -A stash that is no longer in the symbol table has no effective name. This -name is preferable to C for use in MRO linearisations and isa -caches. +Returns the effective name of a stash, or NULL if there is none. The effective +name represents a location in the symbol table where this stash resides. It is +updated automatically when packages are aliased or deleted. A stash that is no +longer in the symbol table has no effective name. This name is preferable to +C for use in MRO linearisations and isa caches. =for apidoc Am|STRLEN|HvENAMELEN|HV *stash Returns the length of the stash's effective name. @@ -218,14 +240,12 @@ C. Can be assigned to. The C or C macros are usually preferable for finding the value of a key. =for apidoc Am|STRLEN|HeKLEN|HE* he -If this is negative, and amounts to C, it indicates the entry -holds an C key. Otherwise, holds the actual length of the key. Can -be assigned to. The C macro is usually preferable for finding key -lengths. +If this is negative, and amounts to C, it indicates the entry holds +an C key. Otherwise, holds the actual length of the key. Can be assigned +to. The C macro is usually preferable for finding key lengths. =for apidoc Am|SV*|HeVAL|HE* he -Returns the value slot (type C) -stored in the hash entry. Can be assigned +Returns the value slot (type C) stored in the hash entry. Can be assigned to. SV *foo= HeVAL(hv); @@ -236,18 +256,18 @@ to. Returns the computed hash stored in the hash entry. =for apidoc Am|char*|HePV|HE* he|STRLEN len -Returns the key slot of the hash entry as a C value, doing any -necessary dereferencing of possibly C keys. The length of the string -is placed in C (this is a macro, so do I use C<&len>). If you do -not care about what the length of the key is, you may use the global -variable C, though this is rather less efficient than using a local -variable. Remember though, that hash keys in perl are free to contain -embedded nulls, so using C or similar is not a good way to find -the length of hash keys. This is very similar to the C macro -described elsewhere in this document. See also C>. - -If you are using C to get values to pass to C to create a -new SV, you should consider using C as it is more +Returns the key slot of the hash entry as a C value, doing any necessary +dereferencing of possibly C keys. The length of the string is placed in +C (this is a macro, so do I use C<&len>). If you do not care about +what the length of the key is, you may use the global variable C, though +this is rather less efficient than using a local variable. Remember though, +that hash keys in perl are free to contain embedded nulls, so using C +or similar is not a good way to find the length of hash keys. This is very +similar to the C macro described elsewhere in this document. See also +C>. + +If you are using C to get values to pass to C to create a new +SV, you should consider using C as it is more efficient. =for apidoc Am|U32|HeUTF8|HE* he @@ -258,30 +278,29 @@ so B blindly assign this to a C variable, as C may be a typedef for C. =for apidoc Am|SV*|HeSVKEY|HE* he -Returns the key as an C, or C if the hash entry does not -contain an C key. +Returns the key as an C, or C if the hash entry does not contain an +C key. =for apidoc Am|SV*|HeSVKEY_force|HE* he -Returns the key as an C. Will create and return a temporary mortal -C if the hash entry contains only a C key. +Returns the key as an C. Will create and return a temporary mortal C +if the hash entry contains only a C key. =for apidoc Am|SV*|HeSVKEY_set|HE* he|SV* sv Sets the key to a given C, taking care to set the appropriate flags to -indicate the presence of an C key, and returns the same -C. +indicate the presence of an C key, and returns the same C. =cut */ -#define PERL_HASH_DEFAULT_HvMAX 7 +#define PERL_HASH_DEFAULT_HvMAX 7 /* these hash entry flags ride on hent_klen (for use only in magic/tied HVs) */ -#define HEf_SVKEY -2 /* hent_key is an SV* */ +#define HEf_SVKEY -2 /* hent_key is an SV* */ #ifndef PERL_CORE -# define Nullhv Null(HV*) +# define Nullhv Null(HV*) #endif -#define HvARRAY(hv) ((hv)->sv_u.svu_hash) +#define HvARRAY(hv) ((hv)->sv_u.svu_hash) /* @@ -289,333 +308,339 @@ C. Returns the number of hash buckets that happen to be in use. -As of perl 5.25 this function is used only for debugging -purposes, and the number of used hash buckets is not -in any way cached, thus this function can be costly -to execute as it must iterate over all the buckets in the -hash. +As of perl 5.25 this function is used only for debugging purposes, and the +number of used hash buckets is not in any way cached, thus this function can +be costly to execute as it must iterate over all the buckets in the hash. =cut - */ -#define HvFILL(hv) Perl_hv_fill(aTHX_ MUTABLE_HV(hv)) -#define HvMAX(hv) ((XPVHV*) SvANY(hv))->xhv_max +#define HvFILL(hv) Perl_hv_fill(aTHX_ MUTABLE_HV(hv)) +#define HvMAX(hv) ((XPVHV*) SvANY(hv))->xhv_max /* =for apidoc Am|bool|HvHasAUX|HV *const hv -Returns true if the HV has a C extension. Use this to check -whether it is valid to call C. +Returns true if the HV has a C extension. +Use this to check whether it is valid to call C. =cut - */ -#define HvHasAUX(hv) (SvFLAGS(hv) & SVphv_HasAUX) - -/* This quite intentionally does no flag checking first. That's your - responsibility. Use HvHasAUX() first */ -#define HvAUX(hv) (&(((struct xpvhv_with_aux*) SvANY(hv))->xhv_aux)) -#define HvRITER(hv) (*Perl_hv_riter_p(aTHX_ MUTABLE_HV(hv))) -#define HvEITER(hv) (*Perl_hv_eiter_p(aTHX_ MUTABLE_HV(hv))) -#define HvRITER_set(hv,r) Perl_hv_riter_set(aTHX_ MUTABLE_HV(hv), r) -#define HvEITER_set(hv,e) Perl_hv_eiter_set(aTHX_ MUTABLE_HV(hv), e) -#define HvRITER_get(hv) (HvHasAUX(hv) ? HvAUX(hv)->xhv_riter : -1) -#define HvEITER_get(hv) (HvHasAUX(hv) ? HvAUX(hv)->xhv_eiter : NULL) -#define HvRAND_get(hv) (HvHasAUX(hv) ? HvAUX(hv)->xhv_rand : 0) -#define HvLASTRAND_get(hv) (HvHasAUX(hv) ? HvAUX(hv)->xhv_last_rand : 0) - -#define HvNAME(hv) HvNAME_get(hv) -#define HvNAMELEN(hv) HvNAMELEN_get(hv) -#define HvENAME(hv) HvENAME_get(hv) -#define HvENAMELEN(hv) HvENAMELEN_get(hv) - -/* Checking that hv is a valid package stash is the - caller's responsibility */ -#define HvMROMETA(hv) (HvAUX(hv)->xhv_mro_meta \ - ? HvAUX(hv)->xhv_mro_meta \ - : Perl_mro_meta_init(aTHX_ hv)) - -#define HvNAME_HEK_NN(hv) \ - ( \ - HvAUX(hv)->xhv_name_count \ - ? *HvAUX(hv)->xhv_name_u.xhvnameu_names \ - : HvAUX(hv)->xhv_name_u.xhvnameu_name \ - ) -/* This macro may go away without notice. */ -#define HvNAME_HEK(hv) \ - (HvHasAUX(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name ? HvNAME_HEK_NN(hv) : NULL) -#define HvHasNAME(hv) \ - (HvHasAUX(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvNAME_HEK_NN(hv)) -#define HvNAME_get(hv) \ - (HvHasNAME(hv) ? HEK_KEY(HvNAME_HEK_NN(hv)) : NULL) -#define HvNAMELEN_get(hv) \ - ((HvHasAUX(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvNAME_HEK_NN(hv)) \ - ? HEK_LEN(HvNAME_HEK_NN(hv)) : 0) -#define HvNAMEUTF8(hv) \ - ((HvHasAUX(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvNAME_HEK_NN(hv)) \ - ? HEK_UTF8(HvNAME_HEK_NN(hv)) : 0) -#define HvENAME_HEK_NN(hv) \ - ( \ - HvAUX(hv)->xhv_name_count > 0 ? HvAUX(hv)->xhv_name_u.xhvnameu_names[0] : \ - HvAUX(hv)->xhv_name_count < -1 ? HvAUX(hv)->xhv_name_u.xhvnameu_names[1] : \ - HvAUX(hv)->xhv_name_count == -1 ? NULL : \ - HvAUX(hv)->xhv_name_u.xhvnameu_name \ - ) -#define HvHasENAME_HEK(hv) \ - (HvHasAUX(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name) +#define HvHasAUX(hv) (SvFLAGS(hv) & SVphv_HasAUX) + +/* This quite intentionally does no flag checking first. + That's your responsibility. Use HvHasAUX() first */ +#define HvAUX(hv) (&(((struct xpvhv_with_aux*) SvANY(hv))->xhv_aux)) +#define HvRITER(hv) (*Perl_hv_riter_p(aTHX_ MUTABLE_HV(hv))) +#define HvEITER(hv) (*Perl_hv_eiter_p(aTHX_ MUTABLE_HV(hv))) +#define HvRITER_set(hv,r) Perl_hv_riter_set(aTHX_ MUTABLE_HV(hv), r) +#define HvEITER_set(hv,e) Perl_hv_eiter_set(aTHX_ MUTABLE_HV(hv), e) +#define HvRITER_get(hv) (HvHasAUX(hv) ? HvAUX(hv)->xhv_riter : -1) +#define HvEITER_get(hv) (HvHasAUX(hv) ? HvAUX(hv)->xhv_eiter : NULL) +#define HvRAND_get(hv) (HvHasAUX(hv) ? HvAUX(hv)->xhv_rand : 0) +#define HvLASTRAND_get(hv) (HvHasAUX(hv) ? HvAUX(hv)->xhv_last_rand : 0) + +#define HvNAME(hv) HvNAME_get(hv) +#define HvNAMELEN(hv) HvNAMELEN_get(hv) +#define HvENAME(hv) HvENAME_get(hv) +#define HvENAMELEN(hv) HvENAMELEN_get(hv) + +/* Checking that hv is a valid package stash is the caller's responsibility */ +#define HvMROMETA(hv) \ + (HvAUX(hv)->xhv_mro_meta \ + ? HvAUX(hv)->xhv_mro_meta \ + : Perl_mro_meta_init(aTHX_ hv)) + +#define HvNAME_HEK_NN(hv) \ + ( \ + HvAUX(hv)->xhv_name_count \ + ? *HvAUX(hv)->xhv_name_u.xhvnameu_names \ + : HvAUX(hv)->xhv_name_u.xhvnameu_name \ + ) +/* This macro may go away without notice. */ +#define HvNAME_HEK(hv) \ + (HvHasAUX(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name ? HvNAME_HEK_NN(hv) : NULL) +#define HvHasNAME(hv) \ + (HvHasAUX(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvNAME_HEK_NN(hv)) +#define HvNAME_get(hv) \ + (HvHasNAME(hv) ? HEK_KEY(HvNAME_HEK_NN(hv)) : NULL) +#define HvNAMELEN_get(hv) \ + ((HvHasAUX(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvNAME_HEK_NN(hv)) \ + ? HEK_LEN(HvNAME_HEK_NN(hv)) : 0) +#define HvNAMEUTF8(hv) \ + ((HvHasAUX(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvNAME_HEK_NN(hv)) \ + ? HEK_UTF8(HvNAME_HEK_NN(hv)) : 0) +#define HvENAME_HEK_NN(hv) \ + ( \ + HvAUX(hv)->xhv_name_count > 0 ? HvAUX(hv)->xhv_name_u.xhvnameu_names[0] : \ + HvAUX(hv)->xhv_name_count < -1 ? HvAUX(hv)->xhv_name_u.xhvnameu_names[1] : \ + HvAUX(hv)->xhv_name_count == -1 ? NULL : \ + HvAUX(hv)->xhv_name_u.xhvnameu_name \ + ) +#define HvHasENAME_HEK(hv) \ + (HvHasAUX(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name) #define HvENAME_HEK(hv) \ - (HvHasENAME_HEK(hv) ? HvENAME_HEK_NN(hv) : NULL) -#define HvHasENAME(hv) \ - (HvHasENAME_HEK(hv) && HvAUX(hv)->xhv_name_count != -1) + (HvHasENAME_HEK(hv) ? HvENAME_HEK_NN(hv) : NULL) +#define HvHasENAME(hv) \ + (HvHasENAME_HEK(hv) && HvAUX(hv)->xhv_name_count != -1) #define HvENAME_get(hv) \ - (HvHasENAME(hv) ? HEK_KEY(HvENAME_HEK_NN(hv)) : NULL) -#define HvENAMELEN_get(hv) \ - (HvHasENAME(hv) ? HEK_LEN(HvENAME_HEK_NN(hv)) : 0) + (HvHasENAME(hv) ? HEK_KEY(HvENAME_HEK_NN(hv)) : NULL) +#define HvENAMELEN_get(hv) \ + (HvHasENAME(hv) ? HEK_LEN(HvENAME_HEK_NN(hv)) : 0) #define HvENAMEUTF8(hv) \ - (HvHasENAME(hv) ? HEK_UTF8(HvENAME_HEK_NN(hv)) : 0) + (HvHasENAME(hv) ? HEK_UTF8(HvENAME_HEK_NN(hv)) : 0) /* - * HvKEYS gets the number of keys that actually exist(), and is provided - * for backwards compatibility with old XS code. The core uses HvUSEDKEYS + * HvKEYS gets the number of keys that actually exist(), and is provided for + * backwards compatibility with old XS code. The core uses HvUSEDKEYS * (keys, excluding placeholders) and HvTOTALKEYS (including placeholders) - */ -#define HvKEYS(hv) HvUSEDKEYS(hv) -#define HvUSEDKEYS(hv) (HvTOTALKEYS(hv) - HvPLACEHOLDERS_get(hv)) -#define HvTOTALKEYS(hv) (((XPVHV*) SvANY(hv))->xhv_keys) -#define HvPLACEHOLDERS(hv) (*Perl_hv_placeholders_p(aTHX_ MUTABLE_HV(hv))) -#define HvPLACEHOLDERS_get(hv) (SvMAGIC(hv) ? Perl_hv_placeholders_get(aTHX_ (const HV *)hv) : 0) -#define HvPLACEHOLDERS_set(hv,p) Perl_hv_placeholders_set(aTHX_ MUTABLE_HV(hv), p) +*/ +#define HvKEYS(hv) HvUSEDKEYS(hv) +#define HvUSEDKEYS(hv) (HvTOTALKEYS(hv) - HvPLACEHOLDERS_get(hv)) +#define HvTOTALKEYS(hv) (((XPVHV*) SvANY(hv))->xhv_keys) +#define HvPLACEHOLDERS(hv) (*Perl_hv_placeholders_p(aTHX_ MUTABLE_HV(hv))) +#define HvPLACEHOLDERS_get(hv) \ + (SvMAGIC(hv) ? Perl_hv_placeholders_get(aTHX_ (const HV *)hv) : 0) +#define HvPLACEHOLDERS_set(hv,p) \ + Perl_hv_placeholders_set(aTHX_ MUTABLE_HV(hv), p) /* This (now) flags whether *new* keys in the hash will be allocated from the - * shared string table. We have a heuristic to call HvSHAREKEYS_off() if a hash - * is "getting large". After which, the first keys in that hash will be from - * the shared string table, but subsequent keys will not be. + * shared string table. We have a heuristic to call HvSHAREKEYS_off() if a + * hash is "getting large". After which, the first keys in that hash will be + * from the shared string table, but subsequent keys will not be. * - * If we didn't do this, we'd have to reallocate all keys when we switched this - * flag, which would be work for no real gain. */ -#define HvSHAREKEYS(hv) (SvFLAGS(hv) & SVphv_SHAREKEYS) -#define HvSHAREKEYS_on(hv) (SvFLAGS(hv) |= SVphv_SHAREKEYS) -#define HvSHAREKEYS_off(hv) (SvFLAGS(hv) &= ~SVphv_SHAREKEYS) - -/* This is an optimisation flag. It won't be set if all hash keys have a 0 - * flag. Currently the only flags relate to utf8. - * Hence it won't be set if all keys are 8 bit only. It will be set if any key - * is utf8 (including 8 bit keys that were entered as utf8, and need upgrading - * when retrieved during iteration. It may still be set when there are no longer - * any utf8 keys. - * See HVhek_ENABLEHVKFLAGS for the trigger. + * If we didn't do this, we'd have to reallocate all keys when we switched + * this flag, which would be work for no real gain. */ +#define HvSHAREKEYS(hv) (SvFLAGS(hv) & SVphv_SHAREKEYS) +#define HvSHAREKEYS_on(hv) (SvFLAGS(hv) |= SVphv_SHAREKEYS) +#define HvSHAREKEYS_off(hv) (SvFLAGS(hv) &= ~SVphv_SHAREKEYS) + +/* This is an optimisation flag. It won't be set if all hash keys have + * a 0 flag. Currently the only flags relate to utf8. Hence it won't + * be set if all keys are 8 bit only. It will be set if any key is utf8 + * (including 8 bit keys that were entered as utf8, and need upgrading + * when retrieved during iteration. It may still be set when there are + * no longer any utf8 keys. See HVhek_ENABLEHVKFLAGS for the trigger. */ -#define HvHASKFLAGS(hv) (SvFLAGS(hv) & SVphv_HASKFLAGS) -#define HvHASKFLAGS_on(hv) (SvFLAGS(hv) |= SVphv_HASKFLAGS) -#define HvHASKFLAGS_off(hv) (SvFLAGS(hv) &= ~SVphv_HASKFLAGS) +#define HvHASKFLAGS(hv) (SvFLAGS(hv) & SVphv_HASKFLAGS) +#define HvHASKFLAGS_on(hv) (SvFLAGS(hv) |= SVphv_HASKFLAGS) +#define HvHASKFLAGS_off(hv) (SvFLAGS(hv) &= ~SVphv_HASKFLAGS) -#define HvLAZYDEL(hv) (SvFLAGS(hv) & SVphv_LAZYDEL) -#define HvLAZYDEL_on(hv) (SvFLAGS(hv) |= SVphv_LAZYDEL) -#define HvLAZYDEL_off(hv) (SvFLAGS(hv) &= ~SVphv_LAZYDEL) +#define HvLAZYDEL(hv) (SvFLAGS(hv) & SVphv_LAZYDEL) +#define HvLAZYDEL_on(hv) (SvFLAGS(hv) |= SVphv_LAZYDEL) +#define HvLAZYDEL_off(hv) (SvFLAGS(hv) &= ~SVphv_LAZYDEL) #ifndef PERL_CORE -# define Nullhe Null(HE*) +# define Nullhe Null(HE*) #endif -#define HeNEXT(he) (he)->hent_next -#define HeKEY_hek(he) (he)->hent_hek -#define HeKEY(he) HEK_KEY(HeKEY_hek(he)) -#define HeKEY_sv(he) (*(SV**)HeKEY(he)) -#define HeKLEN(he) HEK_LEN(HeKEY_hek(he)) -#define HeKUTF8(he) HEK_UTF8(HeKEY_hek(he)) -#define HeKWASUTF8(he) HEK_WASUTF8(HeKEY_hek(he)) -#define HeKLEN_UTF8(he) (HeKUTF8(he) ? -HeKLEN(he) : HeKLEN(he)) -#define HeKFLAGS(he) HEK_FLAGS(HeKEY_hek(he)) -#define HeVAL(he) (he)->he_valu.hent_val -#define HeHASH(he) HEK_HASH(HeKEY_hek(he)) -#define HePV(he,lp) ((HeKLEN(he) == HEf_SVKEY) ? \ - SvPV(HeKEY_sv(he),lp) : \ - ((lp = HeKLEN(he)), HeKEY(he))) -#define HeUTF8(he) ((HeKLEN(he) == HEf_SVKEY) ? \ - SvUTF8(HeKEY_sv(he)) : \ - (U32)HeKUTF8(he)) - -#define HeSVKEY(he) ((HeKEY(he) && \ - HeKLEN(he) == HEf_SVKEY) ? \ - HeKEY_sv(he) : NULL) - -#define HeSVKEY_force(he) (HeKEY(he) ? \ - ((HeKLEN(he) == HEf_SVKEY) ? \ - HeKEY_sv(he) : \ - newSVpvn_flags(HeKEY(he), \ - HeKLEN(he), \ - SVs_TEMP | \ - ( HeKUTF8(he) ? SVf_UTF8 : 0 ))) : \ - &PL_sv_undef) -#define HeSVKEY_set(he,sv) ((HeKLEN(he) = HEf_SVKEY), (HeKEY_sv(he) = sv)) +#define HeNEXT(he) (he)->hent_next +#define HeKEY_hek(he) (he)->hent_hek +#define HeKEY(he) HEK_KEY(HeKEY_hek(he)) +#define HeKEY_sv(he) (*(SV**)HeKEY(he)) +#define HeKLEN(he) HEK_LEN(HeKEY_hek(he)) +#define HeKUTF8(he) HEK_UTF8(HeKEY_hek(he)) +#define HeKWASUTF8(he) HEK_WASUTF8(HeKEY_hek(he)) +#define HeKLEN_UTF8(he) (HeKUTF8(he) ? -HeKLEN(he) : HeKLEN(he)) +#define HeKFLAGS(he) HEK_FLAGS(HeKEY_hek(he)) +#define HeVAL(he) (he)->he_valu.hent_val +#define HeHASH(he) HEK_HASH(HeKEY_hek(he)) +#define HePV(he,lp) \ + ((HeKLEN(he) == HEf_SVKEY) ? \ + SvPV(HeKEY_sv(he),lp) : \ + ((lp = HeKLEN(he)), HeKEY(he))) +#define HeUTF8(he) \ + ((HeKLEN(he) == HEf_SVKEY) ? \ + SvUTF8(HeKEY_sv(he)) : \ + (U32)HeKUTF8(he)) + +#define HeSVKEY(he) \ + ((HeKEY(he) && \ + HeKLEN(he) == HEf_SVKEY) ? \ + HeKEY_sv(he) : NULL) + +#define HeSVKEY_force(he) \ + (HeKEY(he) ? \ + ((HeKLEN(he) == HEf_SVKEY) ? \ + HeKEY_sv(he) : \ + newSVpvn_flags(HeKEY(he), \ + HeKLEN(he), \ + SVs_TEMP | \ + ( HeKUTF8(he) ? SVf_UTF8 : 0 ))) : \ + &PL_sv_undef) +#define HeSVKEY_set(he,sv) ((HeKLEN(he) = HEf_SVKEY), (HeKEY_sv(he) = sv)) #ifndef PERL_CORE -# define Nullhek Null(HEK*) +# define Nullhek Null(HEK*) #endif -#define HEK_BASESIZE STRUCT_OFFSET(HEK, hek_key[0]) -#define HEK_HASH(hek) (hek)->hek_hash -#define HEK_LEN(hek) (hek)->hek_len -#define HEK_KEY(hek) (hek)->hek_key -#define HEK_FLAGS(hek) (*((unsigned char *)(HEK_KEY(hek))+HEK_LEN(hek)+1)) - -#define HVhek_UTF8 0x01 /* Key is utf8 encoded. */ -#define HVhek_WASUTF8 0x02 /* Key is bytes here, but was supplied as utf8. */ -#define HVhek_NOTSHARED 0x04 /* This key isn't a shared hash key. */ -/* the following flags are options for functions, they are not stored in heks */ -#define HVhek_FREEKEY 0x100 /* Internal flag to say key is Newx()ed. */ -#define HVhek_PLACEHOLD 0x200 /* Internal flag to create placeholder. - * (may change, but Storable is a core module) */ -#define HVhek_KEYCANONICAL 0x400 /* Internal flag - key is in canonical form. - If the string is UTF-8, it cannot be - converted to bytes. */ -#define HVhek_ENABLEHVKFLAGS (HVhek_UTF8|HVhek_WASUTF8) - -#define HEK_UTF8(hek) (HEK_FLAGS(hek) & HVhek_UTF8) -#define HEK_UTF8_on(hek) (HEK_FLAGS(hek) |= HVhek_UTF8) -#define HEK_UTF8_off(hek) (HEK_FLAGS(hek) &= ~HVhek_UTF8) -#define HEK_WASUTF8(hek) (HEK_FLAGS(hek) & HVhek_WASUTF8) -#define HEK_WASUTF8_on(hek) (HEK_FLAGS(hek) |= HVhek_WASUTF8) -#define HEK_WASUTF8_off(hek) (HEK_FLAGS(hek) &= ~HVhek_WASUTF8) +#define HEK_BASESIZE STRUCT_OFFSET(HEK, hek_key[0]) +#define HEK_HASH(hek) (hek)->hek_hash +#define HEK_LEN(hek) (hek)->hek_len +#define HEK_KEY(hek) (hek)->hek_key +#define HEK_FLAGS(hek) (*((unsigned char *)(HEK_KEY(hek))+HEK_LEN(hek)+1)) + +#define HVhek_UTF8 0x01 /* Key is utf8 encoded. */ +#define HVhek_WASUTF8 0x02 /* Key is bytes here, but was + supplied as utf8. */ +#define HVhek_NOTSHARED 0x04 /* This key isn't a shared hash key. */ +/* the following flags are options for functions, + they are not stored in heks */ +#define HVhek_FREEKEY 0x100 /* Internal flag to say key + is Newx()ed. */ +#define HVhek_PLACEHOLD 0x200 /* Internal flag to create placeholder. + * (may change, but Storable is a core + * module) */ +#define HVhek_KEYCANONICAL 0x400 /* Internal flag - key is in canonical + form. If the string is UTF-8, it + cannot be converted to bytes. */ +#define HVhek_ENABLEHVKFLAGS (HVhek_UTF8|HVhek_WASUTF8) + +#define HEK_UTF8(hek) (HEK_FLAGS(hek) & HVhek_UTF8) +#define HEK_UTF8_on(hek) (HEK_FLAGS(hek) |= HVhek_UTF8) +#define HEK_UTF8_off(hek) (HEK_FLAGS(hek) &= ~HVhek_UTF8) +#define HEK_WASUTF8(hek) (HEK_FLAGS(hek) & HVhek_WASUTF8) +#define HEK_WASUTF8_on(hek) (HEK_FLAGS(hek) |= HVhek_WASUTF8) +#define HEK_WASUTF8_off(hek) (HEK_FLAGS(hek) &= ~HVhek_WASUTF8) /* calculate HV array allocation */ #ifndef PERL_USE_LARGE_HV_ALLOC /* Default to allocating the correct size - default to assuming that malloc() is not broken and is efficient at allocating blocks sized at powers-of-two. -*/ -# define PERL_HV_ARRAY_ALLOC_BYTES(size) ((size) * sizeof(HE*)) + */ +# define PERL_HV_ARRAY_ALLOC_BYTES(size) ((size) * sizeof(HE*)) #else -# define MALLOC_OVERHEAD 16 -# define PERL_HV_ARRAY_ALLOC_BYTES(size) \ - (((size) < 64) \ - ? (size) * sizeof(HE*) \ - : (size) * sizeof(HE*) * 2 - MALLOC_OVERHEAD) +# define MALLOC_OVERHEAD 16 +# define PERL_HV_ARRAY_ALLOC_BYTES(size) \ + (((size) < 64) \ + ? (size) * sizeof(HE*) \ + : (size) * sizeof(HE*) * 2 - MALLOC_OVERHEAD) #endif -/* Flags for hv_iternext_flags. */ -#define HV_ITERNEXT_WANTPLACEHOLDERS 0x01 /* Don't skip placeholders. */ +/* Flags for hv_iternext_flags. */ +#define HV_ITERNEXT_WANTPLACEHOLDERS 0x01 /* Don't skip placeholders. */ -#define hv_iternext(hv) hv_iternext_flags(hv, 0) -#define hv_magic(hv, gv, how) sv_magic(MUTABLE_SV(hv), MUTABLE_SV(gv), how, NULL, 0) -#define hv_undef(hv) Perl_hv_undef_flags(aTHX_ hv, 0) +#define hv_iternext(hv) hv_iternext_flags(hv, 0) +#define hv_magic(hv, gv, how) \ + sv_magic(MUTABLE_SV(hv), MUTABLE_SV(gv), how, NULL, 0) +#define hv_undef(hv) Perl_hv_undef_flags(aTHX_ hv, 0) #define Perl_sharepvn(pv, len, hash) HEK_KEY(share_hek(pv, len, hash)) -#define sharepvn(pv, len, hash) Perl_sharepvn(pv, len, hash) +#define sharepvn(pv, len, hash) Perl_sharepvn(pv, len, hash) -#define share_hek_hek(hek) \ - (++(((struct shared_he *)(((char *)hek) \ - - STRUCT_OFFSET(struct shared_he, \ - shared_he_hek))) \ - ->shared_he_he.he_valu.hent_refcount), \ +#define share_hek_hek(hek) \ + (++(((struct shared_he *)(((char *)hek) \ + - STRUCT_OFFSET(struct shared_he, \ + shared_he_hek))) \ + ->shared_he_he.he_valu.hent_refcount), \ hek) -#define hv_store_ent(hv, keysv, val, hash) \ - ((HE *) hv_common((hv), (keysv), NULL, 0, 0, HV_FETCH_ISSTORE, \ +#define hv_store_ent(hv, keysv, val, hash) \ + ((HE *) hv_common((hv), (keysv), NULL, 0, 0, HV_FETCH_ISSTORE, \ (val), (hash))) -#define hv_exists_ent(hv, keysv, hash) \ +#define hv_exists_ent(hv, keysv, hash) \ cBOOL(hv_common((hv), (keysv), NULL, 0, 0, HV_FETCH_ISEXISTS, 0, (hash))) -#define hv_fetch_ent(hv, keysv, lval, hash) \ - ((HE *) hv_common((hv), (keysv), NULL, 0, 0, \ +#define hv_fetch_ent(hv, keysv, lval, hash) \ + ((HE *) hv_common((hv), (keysv), NULL, 0, 0, \ ((lval) ? HV_FETCH_LVALUE : 0), NULL, (hash))) -#define hv_delete_ent(hv, key, flags, hash) \ - (MUTABLE_SV(hv_common((hv), (key), NULL, 0, 0, (flags) | HV_DELETE, \ +#define hv_delete_ent(hv, key, flags, hash) \ + (MUTABLE_SV(hv_common((hv), (key), NULL, 0, 0, (flags) | HV_DELETE, \ NULL, (hash)))) -#define hv_store_flags(hv, key, klen, val, hash, flags) \ - ((SV**) hv_common((hv), NULL, (key), (klen), (flags), \ - (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), (val), \ +#define hv_store_flags(hv, key, klen, val, hash, flags) \ + ((SV**) hv_common((hv), NULL, (key), (klen), (flags), \ + (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), (val), \ (hash))) -#define hv_store(hv, key, klen, val, hash) \ - ((SV**) hv_common_key_len((hv), (key), (klen), \ - (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), \ +#define hv_store(hv, key, klen, val, hash) \ + ((SV**) hv_common_key_len((hv), (key), (klen), \ + (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), \ (val), (hash))) -#define hv_exists(hv, key, klen) \ +#define hv_exists(hv, key, klen) \ cBOOL(hv_common_key_len((hv), (key), (klen), HV_FETCH_ISEXISTS, NULL, 0)) -#define hv_fetch(hv, key, klen, lval) \ - ((SV**) hv_common_key_len((hv), (key), (klen), (lval) \ - ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE) \ +#define hv_fetch(hv, key, klen, lval) \ + ((SV**) hv_common_key_len((hv), (key), (klen), (lval) \ + ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE) \ : HV_FETCH_JUST_SV, NULL, 0)) -#define hv_delete(hv, key, klen, flags) \ - (MUTABLE_SV(hv_common_key_len((hv), (key), (klen), \ +#define hv_delete(hv, key, klen, flags) \ + (MUTABLE_SV(hv_common_key_len((hv), (key), (klen), \ (flags) | HV_DELETE, NULL, 0))) /* Provide 's' suffix subs for constant strings (and avoid needing to count - * chars). See STR_WITH_LEN in handy.h - because these are macros we cant use - * STR_WITH_LEN to do the work, we have to unroll it. */ + * chars). See STR_WITH_LEN in handy.h - because these are macros we cant + * use STR_WITH_LEN to do the work, we have to unroll it. */ #define hv_existss(hv, key) \ hv_exists((hv), ASSERT_IS_LITERAL(key), (sizeof(key)-1)) -#define hv_fetchs(hv, key, lval) \ +#define hv_fetchs(hv, key, lval) \ hv_fetch((hv), ASSERT_IS_LITERAL(key), (sizeof(key)-1), (lval)) -#define hv_deletes(hv, key, flags) \ +#define hv_deletes(hv, key, flags) \ hv_delete((hv), ASSERT_IS_LITERAL(key), (sizeof(key)-1), (flags)) -#define hv_name_sets(hv, name, flags) \ +#define hv_name_sets(hv, name, flags) \ hv_name_set((hv),ASSERT_IS_LITERAL(name),(sizeof(name)-1), flags) #define hv_stores(hv, key, val) \ hv_store((hv), ASSERT_IS_LITERAL(key), (sizeof(key)-1), (val), 0) #ifdef PERL_CORE -# define hv_storehek(hv, hek, val) \ - hv_common((hv), NULL, HEK_KEY(hek), HEK_LEN(hek), HEK_UTF8(hek), \ - HV_FETCH_ISSTORE|HV_FETCH_JUST_SV, (val), HEK_HASH(hek)) -# define hv_fetchhek(hv, hek, lval) \ - ((SV **) \ - hv_common((hv), NULL, HEK_KEY(hek), HEK_LEN(hek), HEK_UTF8(hek), \ - (lval) \ - ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE) \ - : HV_FETCH_JUST_SV, \ - NULL, HEK_HASH(hek))) -# define hv_deletehek(hv, hek, flags) \ - hv_common((hv), NULL, HEK_KEY(hek), HEK_LEN(hek), HEK_UTF8(hek), \ - (flags)|HV_DELETE, NULL, HEK_HASH(hek)) -#define hv_existshek(hv, hek) \ - cBOOL(hv_common((hv), NULL, HEK_KEY(hek), HEK_LEN(hek), HEK_UTF8(hek), \ +# define hv_storehek(hv, hek, val) \ + hv_common((hv), NULL, HEK_KEY(hek), HEK_LEN(hek), HEK_UTF8(hek), \ + HV_FETCH_ISSTORE|HV_FETCH_JUST_SV, (val), HEK_HASH(hek)) +# define hv_fetchhek(hv, hek, lval) \ + ((SV **) \ + hv_common((hv), NULL, HEK_KEY(hek), HEK_LEN(hek), HEK_UTF8(hek), \ + (lval) \ + ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE) \ + : HV_FETCH_JUST_SV, \ + NULL, HEK_HASH(hek))) +# define hv_deletehek(hv, hek, flags) \ + hv_common((hv), NULL, HEK_KEY(hek), HEK_LEN(hek), HEK_UTF8(hek), \ + (flags)|HV_DELETE, NULL, HEK_HASH(hek)) +#define hv_existshek(hv, hek) \ + cBOOL(hv_common((hv), NULL, HEK_KEY(hek), HEK_LEN(hek), HEK_UTF8(hek), \ HV_FETCH_ISEXISTS, NULL, HEK_HASH(hek))) #endif -/* This refcounted he structure is used for storing the hints used for lexical - pragmas. Without threads, it's basically struct he + refcount. - With threads, life gets more complex as the structure needs to be shared - between threads (because it hangs from OPs, which are shared), hence the - alternate definition and mutex. */ +/* This refcounted he structure is used for storing the hints used for + lexical pragmas. Without threads, it's basically struct he + + refcount. With threads, life gets more complex as the structure + needs to be shared between threads (because it hangs from OPs, + which are shared), hence the alternate definition and mutex. */ struct refcounted_he; /* flags for the refcounted_he API */ -#define REFCOUNTED_HE_KEY_UTF8 0x00000001 -#define REFCOUNTED_HE_EXISTS 0x00000002 +#define REFCOUNTED_HE_KEY_UTF8 0x00000001 +#define REFCOUNTED_HE_EXISTS 0x00000002 #ifdef PERL_CORE -/* Gosh. This really isn't a good name any longer. */ +/* Gosh. This really isn't a good name any longer. */ struct refcounted_he { - struct refcounted_he *refcounted_he_next; /* next entry in chain */ + struct refcounted_he *refcounted_he_next; /* next entry in chain */ #ifdef USE_ITHREADS - U32 refcounted_he_hash; - U32 refcounted_he_keylen; + U32 refcounted_he_hash; + U32 refcounted_he_keylen; #else - HEK *refcounted_he_hek; /* hint key */ + HEK *refcounted_he_hek; /* hint key */ #endif union { - IV refcounted_he_u_iv; - UV refcounted_he_u_uv; - STRLEN refcounted_he_u_len; - void *refcounted_he_u_ptr; /* Might be useful in future */ - } refcounted_he_val; - U32 refcounted_he_refcnt; /* reference count */ - /* First byte is flags. Then NUL-terminated value. Then for ithreads, - non-NUL terminated key. */ - char refcounted_he_data[1]; + IV refcounted_he_u_iv; + UV refcounted_he_u_uv; + STRLEN refcounted_he_u_len; + void *refcounted_he_u_ptr; /* Might be useful in future */ + } refcounted_he_val; + U32 refcounted_he_refcnt; /* reference count */ + /* First byte is flags. Then NUL-terminated value. + Then for ithreads, non-NUL terminated key. */ + char refcounted_he_data[1]; }; /* @@ -627,7 +652,7 @@ instead of a string/length pair, and no precomputed hash. =cut */ -#define refcounted_he_fetch_pvs(chain, key, flags) \ +#define refcounted_he_fetch_pvs(chain, key, flags) \ Perl_refcounted_he_fetch_pvn(aTHX_ chain, STR_WITH_LEN(key), 0, flags) /* @@ -639,60 +664,60 @@ instead of a string/length pair, and no precomputed hash. =cut */ -#define refcounted_he_new_pvs(parent, key, value, flags) \ +#define refcounted_he_new_pvs(parent, key, value, flags) \ Perl_refcounted_he_new_pvn(aTHX_ parent, STR_WITH_LEN(key), 0, value, flags) /* Flag bits are HVhek_UTF8, HVhek_WASUTF8, then */ -#define HVrhek_undef 0x00 /* Value is undef. */ -#define HVrhek_delete 0x10 /* Value is placeholder - signifies delete. */ -#define HVrhek_IV 0x20 /* Value is IV. */ -#define HVrhek_UV 0x30 /* Value is UV. */ -#define HVrhek_PV 0x40 /* Value is a (byte) string. */ -#define HVrhek_PV_UTF8 0x50 /* Value is a (utf8) string. */ -/* Two spare. As these have to live in the optree, you can't store anything - interpreter specific, such as SVs. :-( */ -#define HVrhek_typemask 0x70 +#define HVrhek_undef 0x00 /* Value is undef. */ +#define HVrhek_delete 0x10 /* Value is placeholder - + signifies delete. */ +#define HVrhek_IV 0x20 /* Value is IV. */ +#define HVrhek_UV 0x30 /* Value is UV. */ +#define HVrhek_PV 0x40 /* Value is a (byte) string. */ +#define HVrhek_PV_UTF8 0x50 /* Value is a (utf8) string. */ +/* Two spare. As these have to live in the optree, you can't + store anything interpreter specific, such as SVs. :-( */ +#define HVrhek_typemask 0x70 #ifdef USE_ITHREADS /* A big expression to find the key offset */ -#define REF_HE_KEY(chain) \ - ((((chain->refcounted_he_data[0] & 0x60) == 0x40) \ - ? chain->refcounted_he_val.refcounted_he_u_len + 1 : 0) \ - + 1 + chain->refcounted_he_data) +#define REF_HE_KEY(chain) \ + ((((chain->refcounted_he_data[0] & 0x60) == 0x40) \ + ? chain->refcounted_he_val.refcounted_he_u_len + 1 : 0) \ + + 1 + chain->refcounted_he_data) #endif # ifdef USE_ITHREADS -# define HINTS_REFCNT_LOCK MUTEX_LOCK(&PL_hints_mutex) -# define HINTS_REFCNT_UNLOCK MUTEX_UNLOCK(&PL_hints_mutex) +# define HINTS_REFCNT_LOCK MUTEX_LOCK(&PL_hints_mutex) +# define HINTS_REFCNT_UNLOCK MUTEX_UNLOCK(&PL_hints_mutex) # else -# define HINTS_REFCNT_LOCK NOOP -# define HINTS_REFCNT_UNLOCK NOOP +# define HINTS_REFCNT_LOCK NOOP +# define HINTS_REFCNT_UNLOCK NOOP # endif #endif #ifdef USE_ITHREADS -# define HINTS_REFCNT_INIT MUTEX_INIT(&PL_hints_mutex) -# define HINTS_REFCNT_TERM MUTEX_DESTROY(&PL_hints_mutex) +# define HINTS_REFCNT_INIT MUTEX_INIT(&PL_hints_mutex) +# define HINTS_REFCNT_TERM MUTEX_DESTROY(&PL_hints_mutex) #else -# define HINTS_REFCNT_INIT NOOP -# define HINTS_REFCNT_TERM NOOP +# define HINTS_REFCNT_INIT NOOP +# define HINTS_REFCNT_TERM NOOP #endif -/* Hash actions - * Passed in PERL_MAGIC_uvar calls +/* Hash actions Passed in PERL_MAGIC_uvar calls */ -#define HV_DISABLE_UVAR_XKEY 0x01 -/* We need to ensure that these don't clash with G_DISCARD, which is 2, as it - is documented as being passed to hv_delete(). */ -#define HV_FETCH_ISSTORE 0x04 -#define HV_FETCH_ISEXISTS 0x08 -#define HV_FETCH_LVALUE 0x10 -#define HV_FETCH_JUST_SV 0x20 -#define HV_DELETE 0x40 -#define HV_FETCH_EMPTY_HE 0x80 /* Leave HeVAL null. */ +#define HV_DISABLE_UVAR_XKEY 0x01 +/* We need to ensure that these don't clash with G_DISCARD, which + is 2, as it is documented as being passed to hv_delete(). */ +#define HV_FETCH_ISSTORE 0x04 +#define HV_FETCH_ISEXISTS 0x08 +#define HV_FETCH_LVALUE 0x10 +#define HV_FETCH_JUST_SV 0x20 +#define HV_DELETE 0x40 +#define HV_FETCH_EMPTY_HE 0x80 /* Leave HeVAL null. */ /* Must not conflict with HVhek_UTF8 */ -#define HV_NAME_SETALL 0x02 +#define HV_NAME_SETALL 0x02 /* =for apidoc newHV @@ -702,10 +727,10 @@ Creates a new HV. The reference count is set to 1. =cut */ -#define newHV() MUTABLE_HV(newSV_type(SVt_PVHV)) +#define newHV() MUTABLE_HV(newSV_type(SVt_PVHV)) #include "hv_func.h" /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/hv_func.h b/hv_func.h index a4e70d52bc6e..d8991123c12a 100644 --- a/hv_func.h +++ b/hv_func.h @@ -1,19 +1,20 @@ /* hash a key - *-------------------------------------------------------------------------------------- - * The "hash seed" feature was added in Perl 5.8.1 to perturb the results - * to avoid "algorithmic complexity attacks". + * -------------------------------------------------------------------------------------- + * The "hash seed" feature was added in Perl 5.8.1 to perturb the results to + * avoid "algorithmic complexity attacks". * - * If USE_HASH_SEED is defined, hash randomisation is done by default - * (see also perl.c:perl_parse() and S_init_tls_and_interp() and util.c:get_hash_seed()) + * If USE_HASH_SEED is defined, hash randomisation is done by default (see also + * perl.c:perl_parse() and S_init_tls_and_interp() and + * util.c:get_hash_seed()) */ #ifndef PERL_SEEN_HV_FUNC_H_ /* compile once */ #define PERL_SEEN_HV_FUNC_H_ #include "hv_macro.h" -#if !( 0 \ - || defined(PERL_HASH_FUNC_SIPHASH) \ - || defined(PERL_HASH_FUNC_SIPHASH13) \ - || defined(PERL_HASH_FUNC_ZAPHOD32) \ +#if !( 0 \ + || defined(PERL_HASH_FUNC_SIPHASH) \ + || defined(PERL_HASH_FUNC_SIPHASH13) \ + || defined(PERL_HASH_FUNC_ZAPHOD32) \ ) # ifdef CAN64BITHASH # define PERL_HASH_FUNC_SIPHASH13 @@ -24,9 +25,9 @@ #ifndef PERL_HASH_USE_SBOX32_ALSO # if defined(PERL_HASH_USE_SBOX32) || !defined(PERL_HASH_NO_SBOX32) -# define PERL_HASH_USE_SBOX32_ALSO 1 +# define PERL_HASH_USE_SBOX32_ALSO 1 # else -# define PERL_HASH_USE_SBOX32_ALSO 0 +# define PERL_HASH_USE_SBOX32_ALSO 0 # endif #endif @@ -39,39 +40,44 @@ #endif #ifndef SBOX32_MAX_LEN -#define SBOX32_MAX_LEN 24 +#define SBOX32_MAX_LEN 24 #endif /* this must be after the SBOX32_MAX_LEN define */ #include "sbox32_hash.h" #if defined(PERL_HASH_FUNC_SIPHASH) -# define PERL_HASH_FUNC_DEFINE "PERL_HASH_FUNC_SIPHASH" -# define PVT__PERL_HASH_FUNC "SIPHASH_2_4" -# define PVT__PERL_HASH_WORD_TYPE U64 -# define PVT__PERL_HASH_WORD_SIZE sizeof(PVT__PERL_HASH_WORD_TYPE) -# define PVT__PERL_HASH_SEED_BYTES (PVT__PERL_HASH_WORD_SIZE * 2) -# define PVT__PERL_HASH_STATE_BYTES (PVT__PERL_HASH_WORD_SIZE * 4) -# define PVT__PERL_HASH_SEED_STATE(seed,state) S_perl_siphash_seed_state(seed,state) -# define PVT__PERL_HASH_WITH_STATE(state,str,len) S_perl_hash_siphash_2_4_with_state((state),(U8*)(str),(len)) +# define PERL_HASH_FUNC_DEFINE "PERL_HASH_FUNC_SIPHASH" +# define PVT__PERL_HASH_FUNC "SIPHASH_2_4" +# define PVT__PERL_HASH_WORD_TYPE U64 +# define PVT__PERL_HASH_WORD_SIZE sizeof(PVT__PERL_HASH_WORD_TYPE) +# define PVT__PERL_HASH_SEED_BYTES (PVT__PERL_HASH_WORD_SIZE * 2) +# define PVT__PERL_HASH_STATE_BYTES (PVT__PERL_HASH_WORD_SIZE * 4) +# define PVT__PERL_HASH_SEED_STATE(seed,state) \ + S_perl_siphash_seed_state(seed,state) +# define PVT__PERL_HASH_WITH_STATE(state,str,len) \ + S_perl_hash_siphash_2_4_with_state((state),(U8*)(str),(len)) #elif defined(PERL_HASH_FUNC_SIPHASH13) -# define PERL_HASH_FUNC_DEFINE "PERL_HASH_FUNC_SIPHASH13" -# define PVT__PERL_HASH_FUNC "SIPHASH_1_3" -# define PVT__PERL_HASH_WORD_TYPE U64 -# define PVT__PERL_HASH_WORD_SIZE sizeof(PVT__PERL_HASH_WORD_TYPE) -# define PVT__PERL_HASH_SEED_BYTES (PVT__PERL_HASH_WORD_SIZE * 2) -# define PVT__PERL_HASH_STATE_BYTES (PVT__PERL_HASH_WORD_SIZE * 4) -# define PVT__PERL_HASH_SEED_STATE(seed,state) S_perl_siphash_seed_state(seed,state) -# define PVT__PERL_HASH_WITH_STATE(state,str,len) S_perl_hash_siphash_1_3_with_state((state),(const U8*)(str),(len)) +# define PERL_HASH_FUNC_DEFINE "PERL_HASH_FUNC_SIPHASH13" +# define PVT__PERL_HASH_FUNC "SIPHASH_1_3" +# define PVT__PERL_HASH_WORD_TYPE U64 +# define PVT__PERL_HASH_WORD_SIZE sizeof(PVT__PERL_HASH_WORD_TYPE) +# define PVT__PERL_HASH_SEED_BYTES (PVT__PERL_HASH_WORD_SIZE * 2) +# define PVT__PERL_HASH_STATE_BYTES (PVT__PERL_HASH_WORD_SIZE * 4) +# define PVT__PERL_HASH_SEED_STATE(seed,state) \ + S_perl_siphash_seed_state(seed,state) +# define PVT__PERL_HASH_WITH_STATE(state,str,len) \ + S_perl_hash_siphash_1_3_with_state((state),(const U8*)(str),(len)) #elif defined(PERL_HASH_FUNC_ZAPHOD32) -# define PERL_HASH_FUNC_DEFINE "PERL_HASH_FUNC_ZAPHOD32" -# define PVT__PERL_HASH_FUNC "ZAPHOD32" -# define PVT__PERL_HASH_WORD_TYPE U32 -# define PVT__PERL_HASH_WORD_SIZE sizeof(PVT__PERL_HASH_WORD_TYPE) -# define PVT__PERL_HASH_SEED_BYTES (PVT__PERL_HASH_WORD_SIZE * 3) -# define PVT__PERL_HASH_STATE_BYTES (PVT__PERL_HASH_WORD_SIZE * 3) +# define PERL_HASH_FUNC_DEFINE "PERL_HASH_FUNC_ZAPHOD32" +# define PVT__PERL_HASH_FUNC "ZAPHOD32" +# define PVT__PERL_HASH_WORD_TYPE U32 +# define PVT__PERL_HASH_WORD_SIZE sizeof(PVT__PERL_HASH_WORD_TYPE) +# define PVT__PERL_HASH_SEED_BYTES (PVT__PERL_HASH_WORD_SIZE * 3) +# define PVT__PERL_HASH_STATE_BYTES (PVT__PERL_HASH_WORD_SIZE * 3) # define PVT__PERL_HASH_SEED_STATE(seed,state) zaphod32_seed_state(seed,state) -# define PVT__PERL_HASH_WITH_STATE(state,str,len) (U32)zaphod32_hash_with_state((state),(U8*)(str),(len)) +# define PVT__PERL_HASH_WITH_STATE(state,str,len) \ + (U32)zaphod32_hash_with_state((state),(U8*)(str),(len)) # include "zaphod32_hash.h" #endif @@ -85,60 +91,69 @@ #error "PVT__PERL_HASH_FUNC not defined" #endif -/* Some siphash static functions are needed by XS::APItest even when - siphash isn't the current hash. For SipHash builds this needs to - be before the S_perl_hash_with_seed() definition. -*/ +/* Some siphash static functions are needed by XS::APItest even + when siphash isn't the current hash. For SipHash builds this + needs to be before the S_perl_hash_with_seed() definition. + */ #include "perl_siphash.h" -#define PVT__PERL_HASH_SEED_roundup(x, y) ( ( ( (x) + ( (y) - 1 ) ) / (y) ) * (y) ) -#define PVT_PERL_HASH_SEED_roundup(x) PVT__PERL_HASH_SEED_roundup(x,PVT__PERL_HASH_WORD_SIZE) +#define PVT__PERL_HASH_SEED_roundup(x, y) \ + ( ( ( (x) + ( (y) - 1 ) ) / (y) ) * (y) ) +#define PVT_PERL_HASH_SEED_roundup(x) \ + PVT__PERL_HASH_SEED_roundup(x,PVT__PERL_HASH_WORD_SIZE) -#define PL_hash_seed ((U8 *)PL_hash_seed_w) -#define PL_hash_state ((U8 *)PL_hash_state_w) +#define PL_hash_seed ((U8 *)PL_hash_seed_w) +#define PL_hash_state ((U8 *)PL_hash_state_w) #if PERL_HASH_USE_SBOX32_ALSO == 0 -# define PVT_PERL_HASH_FUNC PVT__PERL_HASH_FUNC -# define PVT_PERL_HASH_SEED_BYTES PVT__PERL_HASH_SEED_BYTES -# define PVT_PERL_HASH_STATE_BYTES PVT__PERL_HASH_STATE_BYTES -# define PVT_PERL_HASH_SEED_STATE(seed,state) PVT__PERL_HASH_SEED_STATE(seed,state) -# define PVT_PERL_HASH_WITH_STATE(state,str,len) PVT__PERL_HASH_WITH_STATE(state,str,len) +# define PVT_PERL_HASH_FUNC PVT__PERL_HASH_FUNC +# define PVT_PERL_HASH_SEED_BYTES PVT__PERL_HASH_SEED_BYTES +# define PVT_PERL_HASH_STATE_BYTES PVT__PERL_HASH_STATE_BYTES +# define PVT_PERL_HASH_SEED_STATE(seed,state) \ + PVT__PERL_HASH_SEED_STATE(seed,state) +# define PVT_PERL_HASH_WITH_STATE(state,str,len) \ + PVT__PERL_HASH_WITH_STATE(state,str,len) #else -#define PVT_PERL_HASH_FUNC "SBOX32_WITH_" PVT__PERL_HASH_FUNC -/* note the 4 in the below code comes from the fact the seed to initialize the SBOX is 128 bits */ -#define PVT_PERL_HASH_SEED_BYTES ( PVT__PERL_HASH_SEED_BYTES + (int)( 4 * sizeof(U32)) ) +#define PVT_PERL_HASH_FUNC "SBOX32_WITH_" PVT__PERL_HASH_FUNC +/* note the 4 in the below code comes from the fact + the seed to initialize the SBOX is 128 bits */ +#define PVT_PERL_HASH_SEED_BYTES \ + ( PVT__PERL_HASH_SEED_BYTES + (int)( 4 * sizeof(U32)) ) -#define PVT_PERL_HASH_STATE_BYTES \ +#define PVT_PERL_HASH_STATE_BYTES \ ( PVT__PERL_HASH_STATE_BYTES + ( ( 1 + ( 256 * SBOX32_MAX_LEN ) ) * sizeof(U32) ) ) -#define PVT_PERL_HASH_SEED_STATE(seed,state) STMT_START { \ - PVT__PERL_HASH_SEED_STATE(seed,state); \ - sbox32_seed_state128(seed + PVT__PERL_HASH_SEED_BYTES, state + PVT__PERL_HASH_STATE_BYTES); \ -} STMT_END +#define PVT_PERL_HASH_SEED_STATE(seed,state) \ + STMT_START { \ + PVT__PERL_HASH_SEED_STATE(seed,state); \ + sbox32_seed_state128(seed + PVT__PERL_HASH_SEED_BYTES, state + PVT__PERL_HASH_STATE_BYTES); \ + } STMT_END -#define PVT_PERL_HASH_WITH_STATE(state,str,len) \ - (LIKELY(len <= SBOX32_MAX_LEN) \ - ? sbox32_hash_with_state((state + PVT__PERL_HASH_STATE_BYTES),(const U8*)(str),(len)) \ +#define PVT_PERL_HASH_WITH_STATE(state,str,len) \ + (LIKELY(len <= SBOX32_MAX_LEN) \ + ? sbox32_hash_with_state((state + PVT__PERL_HASH_STATE_BYTES),(const U8*)(str),(len)) \ : PVT__PERL_HASH_WITH_STATE((state),(str),(len))) #endif -#define PERL_HASH_WITH_SEED(seed,hash,str,len) \ +#define PERL_HASH_WITH_SEED(seed,hash,str,len) \ (hash) = S_perl_hash_with_seed((const U8 *) seed, (const U8 *) str,len) -#define PERL_HASH_WITH_STATE(state,hash,str,len) \ +#define PERL_HASH_WITH_STATE(state,hash,str,len) \ (hash) = PVT_PERL_HASH_WITH_STATE((state),(const U8*)(str),(len)) -#define PERL_HASH_SEED_STATE(seed,state) PVT_PERL_HASH_SEED_STATE(seed,state) -#define PERL_HASH_SEED_BYTES PVT_PERL_HASH_SEED_roundup(PVT_PERL_HASH_SEED_BYTES) -#define PERL_HASH_STATE_BYTES PVT_PERL_HASH_SEED_roundup(PVT_PERL_HASH_STATE_BYTES) -#define PERL_HASH_FUNC PVT_PERL_HASH_FUNC +#define PERL_HASH_SEED_STATE(seed,state) PVT_PERL_HASH_SEED_STATE(seed,state) +#define PERL_HASH_SEED_BYTES \ + PVT_PERL_HASH_SEED_roundup(PVT_PERL_HASH_SEED_BYTES) +#define PERL_HASH_STATE_BYTES \ + PVT_PERL_HASH_SEED_roundup(PVT_PERL_HASH_STATE_BYTES) +#define PERL_HASH_FUNC PVT_PERL_HASH_FUNC -#define PERL_HASH_SEED_WORDS (PERL_HASH_SEED_BYTES/PVT__PERL_HASH_WORD_SIZE) -#define PERL_HASH_STATE_WORDS (PERL_HASH_STATE_BYTES/PVT__PERL_HASH_WORD_SIZE) +#define PERL_HASH_SEED_WORDS (PERL_HASH_SEED_BYTES/PVT__PERL_HASH_WORD_SIZE) +#define PERL_HASH_STATE_WORDS (PERL_HASH_STATE_BYTES/PVT__PERL_HASH_WORD_SIZE) #ifdef PERL_USE_SINGLE_CHAR_HASH_CACHE -#define PERL_HASH(state,str,len) \ +#define PERL_HASH(state,str,len) \ (hash) = ((len) < 2 ? ( (len) == 0 ? PL_hash_chars[256] : PL_hash_chars[(U8)(str)[0]] ) \ : PVT_PERL_HASH_WITH_STATE(PL_hash_state,(U8*)(str),(len))) #else @@ -147,32 +162,32 @@ #endif /* Setup the hash seed, either we do things dynamically at start up, - * including reading from the environment, or we randomly setup the - * seed. The seed will be passed into the PERL_HASH_SEED_STATE() function + * including reading from the environment, or we randomly setup the seed. + * The seed will be passed into the PERL_HASH_SEED_STATE() function * defined for the configuration defined for this perl, which will then * initialize whatever state it might need later in hashing. */ #ifndef PERL_HASH_SEED # if defined(USE_HASH_SEED) -# define PERL_HASH_SEED PL_hash_seed +# define PERL_HASH_SEED PL_hash_seed # else - /* this is a 512 bit seed, which should be more than enough for the - * configuration of any of our hash functions (with or without sbox). - * If you actually use a hard coded seed, you are strongly encouraged - * to replace this with something else of the correct length - * for the hash function you are using (24-32 bytes depending on build - * options). Repeat, you are *STRONGLY* encouraged not to use the value - * provided here. + /* this is a 512 bit seed, which should be more than enough for + * the configuration of any of our hash functions (with or + * without sbox). If you actually use a hard coded seed, you + * are strongly encouraged to replace this with something else + * of the correct length for the hash function you are using + * (24-32 bytes depending on build options). Repeat, you are + * *STRONGLY* encouraged not to use the value provided here. */ -# define PERL_HASH_SEED \ - ((const U8 *)"A long string of pseudorandomly " \ - "chosen bytes for hashing in Perl") +# define PERL_HASH_SEED \ + ((const U8 *)"A long string of pseudorandomly " \ + "chosen bytes for hashing in Perl") # endif #endif -/* legacy - only mod_perl should be doing this. */ +/* legacy - only mod_perl should be doing this. */ #ifdef PERL_HASH_INTERNAL_ACCESS -#define PERL_HASH_INTERNAL(hash,str,len) PERL_HASH(hash,str,len) +#define PERL_HASH_INTERNAL(hash,str,len) PERL_HASH(hash,str,len) #endif PERL_STATIC_INLINE U32 @@ -182,8 +197,8 @@ S_perl_hash_with_seed(const U8 * seed, const U8 *str, STRLEN len) { return PVT_PERL_HASH_WITH_STATE((U8*)state,str,len); } -#endif /*compile once*/ +#endif /*compile once */ /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/hv_macro.h b/hv_macro.h index 5bf02a80ed2d..a892ecf0356d 100644 --- a/hv_macro.h +++ b/hv_macro.h @@ -7,76 +7,78 @@ #ifdef CAN64BITHASH #ifndef U64TYPE - /* This probably isn't going to work, but failing with a compiler error due to - lack of uint64_t is no worse than failing right now with an #error. */ - #define U64 uint64_t + /* This probably isn't going to work, but failing with a compiler error due + to lack of uint64_t is no worse than failing right now with an #error. */ + #define U64 uint64_t #endif #endif -/*----------------------------------------------------------------------------- +/* ----------------------------------------------------------------------------- * Endianess and util macros * - * The following 3 macros are defined in this section. The other macros defined - * are only needed to help derive these 3. + * The following 3 macros are defined in this section. The other macros + * defined are only needed to help derive these 3. * - * U8TO16_LE(x) Read a little endian unsigned 16-bit int - * U8TO32_LE(x) Read a little endian unsigned 32-bit int - * U8TO64_LE(x) Read a little endian unsigned 64-bit int - * ROTL32(x,r) Rotate x left by r bits - * ROTL64(x,r) Rotate x left by r bits - * ROTR32(x,r) Rotate x right by r bits - * ROTR64(x,r) Rotate x right by r bits + * U8TO16_LE(x) Read a little endian unsigned 16-bit int U8TO32_LE(x) Read a + * little endian unsigned 32-bit int U8TO64_LE(x) Read a little endian unsigned + * 64-bit int ROTL32(x,r) Rotate x left by r bits ROTL64(x,r) Rotate x left by + * r bits ROTR32(x,r) Rotate x right by r bits ROTR64(x,r) Rotate x right by r + * bits */ #ifndef U8TO16_LE - #define _shifted_octet(type,ptr,idx,shift) (((type)(((const U8*)(ptr))[(idx)]))<<(shift)) + #define _shifted_octet(type,ptr,idx,shift) \ + (((type)(((const U8*)(ptr))[(idx)]))<<(shift)) #if defined(USE_UNALIGNED_PTR_DEREF) && (BYTEORDER == 0x1234 || BYTEORDER == 0x12345678) - #define U8TO16_LE(ptr) (*((const U16*)(ptr))) - #define U8TO32_LE(ptr) (*((const U32*)(ptr))) - #define U8TO64_LE(ptr) (*((const U64*)(ptr))) + #define U8TO16_LE(ptr) (*((const U16*)(ptr))) + #define U8TO32_LE(ptr) (*((const U32*)(ptr))) + #define U8TO64_LE(ptr) (*((const U64*)(ptr))) #else - #define U8TO16_LE(ptr) (_shifted_octet(U16,(ptr),0, 0)|\ - _shifted_octet(U16,(ptr),1, 8)) + #define U8TO16_LE(ptr) \ + (_shifted_octet(U16,(ptr),0, 0)| _shifted_octet(U16,(ptr),1, 8)) - #define U8TO32_LE(ptr) (_shifted_octet(U32,(ptr),0, 0)|\ - _shifted_octet(U32,(ptr),1, 8)|\ - _shifted_octet(U32,(ptr),2,16)|\ - _shifted_octet(U32,(ptr),3,24)) + #define U8TO32_LE(ptr) \ + (_shifted_octet(U32,(ptr),0, 0)| \ + _shifted_octet(U32,(ptr),1, 8)| \ + _shifted_octet(U32,(ptr),2,16)| \ + _shifted_octet(U32,(ptr),3,24)) - #define U8TO64_LE(ptr) (_shifted_octet(U64,(ptr),0, 0)|\ - _shifted_octet(U64,(ptr),1, 8)|\ - _shifted_octet(U64,(ptr),2,16)|\ - _shifted_octet(U64,(ptr),3,24)|\ - _shifted_octet(U64,(ptr),4,32)|\ - _shifted_octet(U64,(ptr),5,40)|\ - _shifted_octet(U64,(ptr),6,48)|\ - _shifted_octet(U64,(ptr),7,56)) + #define U8TO64_LE(ptr) \ + (_shifted_octet(U64,(ptr),0, 0)| \ + _shifted_octet(U64,(ptr),1, 8)| \ + _shifted_octet(U64,(ptr),2,16)| \ + _shifted_octet(U64,(ptr),3,24)| \ + _shifted_octet(U64,(ptr),4,32)| \ + _shifted_octet(U64,(ptr),5,40)| \ + _shifted_octet(U64,(ptr),6,48)| \ + _shifted_octet(U64,(ptr),7,56)) #endif #endif /* Find best way to ROTL32/ROTL64 */ #if defined(_MSC_VER) #include /* Microsoft put _rotl declaration in here */ - #define ROTL32(x,r) _rotl(x,r) - #define ROTR32(x,r) _rotr(x,r) - #define ROTL64(x,r) _rotl64(x,r) - #define ROTR64(x,r) _rotr64(x,r) + #define ROTL32(x,r) _rotl(x,r) + #define ROTR32(x,r) _rotr(x,r) + #define ROTL64(x,r) _rotl64(x,r) + #define ROTR64(x,r) _rotr64(x,r) #else - /* gcc recognises this code and generates a rotate instruction for CPUs with one */ - #define ROTL32(x,r) (((U32)(x) << (r)) | ((U32)(x) >> (32 - (r)))) - #define ROTR32(x,r) (((U32)(x) << (32 - (r))) | ((U32)(x) >> (r))) - #define ROTL64(x,r) ( ( (U64)(x) << (r) ) | ( (U64)(x) >> ( 64 - (r) ) ) ) - #define ROTR64(x,r) ( ( (U64)(x) << ( 64 - (r) ) ) | ( (U64)(x) >> (r) ) ) + /* gcc recognises this code and generates a + rotate instruction for CPUs with one */ + #define ROTL32(x,r) (((U32)(x) << (r)) | ((U32)(x) >> (32 - (r)))) + #define ROTR32(x,r) (((U32)(x) << (32 - (r))) | ((U32)(x) >> (r))) + #define ROTL64(x,r) ( ( (U64)(x) << (r) ) | ( (U64)(x) >> ( 64 - (r) ) ) ) + #define ROTR64(x,r) ( ( (U64)(x) << ( 64 - (r) ) ) | ( (U64)(x) >> (r) ) ) #endif #ifdef UV_IS_QUAD -#define ROTL_UV(x,r) ROTL64(x,r) -#define ROTR_UV(x,r) ROTL64(x,r) +#define ROTL_UV(x,r) ROTL64(x,r) +#define ROTR_UV(x,r) ROTL64(x,r) #else -#define ROTL_UV(x,r) ROTL32(x,r) -#define ROTR_UV(x,r) ROTR32(x,r) +#define ROTL_UV(x,r) ROTL32(x,r) +#define ROTR_UV(x,r) ROTR32(x,r) #endif #if IVSIZE == 8 #define CAN64BITHASH diff --git a/inline.h b/inline.h index b09da6c38382..c84dd4d5be1d 100644 --- a/inline.h +++ b/inline.h @@ -1,44 +1,36 @@ -/* inline.h - * - * Copyright (C) 2012 by Larry Wall and others - * - * You may distribute under the terms of either the GNU General Public - * License or the Artistic License, as specified in the README file. - * - * This file contains tables and code adapted from - * https://bjoern.hoehrmann.de/utf-8/decoder/dfa/, which requires this - * copyright notice: - -Copyright (c) 2008-2009 Bjoern Hoehrmann - -Permission is hereby granted, free of charge, to any person obtaining a copy of -this software and associated documentation files (the "Software"), to deal in -the Software without restriction, including without limitation the rights to -use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies -of the Software, and to permit persons to whom the Software is furnished to do -so, subject to the following conditions: - -The above copyright notice and this permission notice shall be included in all -copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE -SOFTWARE. - - * - * This file is a home for static inline functions that cannot go in other - * header files, because they depend on proto.h (included after most other - * headers) or struct definitions. - * - * Note also perlstatic.h for functions that can't or shouldn't be inlined, but - * whose details should be exposed to the compiler, for such things as tail - * call optimization. - * - * Each section names the header file that the functions "belong" to. +/* inline.h * * Copyright (C) 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, + 2020, 2021, 2022 by Larry Wall and others * * You may distribute under the + terms of either the GNU General Public * License or the Artistic License, + as specified in the README file. * * This file contains tables and code + adapted from * https://bjoern.hoehrmann.de/utf-8/decoder/dfa/, which + requires this * copyright notice: + + Copyright (c) 2008-2009 Bjoern Hoehrmann + + Permission is hereby granted, free of charge, to any person obtaining a + copy of this software and associated documentation files (the "Software"), + to deal in the Software without restriction, including without limitation + the rights to use, copy, modify, merge, publish, distribute, sublicense, + and/or sell copies of the Software, and to permit persons to whom the + Software is furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING + FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER + DEALINGS IN THE SOFTWARE. + + * * This file is a home for static inline functions that cannot go in other + * header files, because they depend on proto.h (included after most other + * headers) or struct definitions. * * Note also perlstatic.h for + functions that can't or shouldn't be inlined, but * whose details should be + exposed to the compiler, for such things as tail * call optimization. * * + Each section names the header file that the functions "belong" to. */ /* ------------------------------- av.h ------------------------------- */ @@ -46,9 +38,9 @@ SOFTWARE. /* =for apidoc_section $AV =for apidoc av_count -Returns the number of elements in the array C. This is the true length of -the array, including any undefined elements. It is always the same as -S>. +Returns the number of elements in the array C. This is the +true length of the array, including any undefined elements. It +is always the same as S>. =cut */ @@ -66,16 +58,16 @@ Perl_av_count(pTHX_ AV *av) /* =for apidoc av_store_simple -This is a cut-down version of av_store that assumes that the array is -very straightforward - no magic, not readonly, and AvREAL - and that -C is not negative. This function MUST NOT be used in situations -where any of those assumptions may not hold. +This is a cut-down version of av_store that assumes that the array is very +straightforward - no magic, not readonly, and AvREAL - and that C is +not negative. This function MUST NOT be used in situations where any of +those assumptions may not hold. -Stores an SV in an array. The array index is specified as C. It -can be dereferenced to get the C that was stored there (= C)). +Stores an SV in an array. The array index is specified as C. It can +be dereferenced to get the C that was stored there (= C)). -Note that the caller is responsible for suitably incrementing the reference -count of C before the call. +Note that the caller is responsible for suitably incrementing the +reference count of C before the call. Approximate Perl equivalent: C. @@ -114,13 +106,13 @@ Perl_av_store_simple(pTHX_ AV *av, SSize_t key, SV *val) This is a cut-down version of av_fetch that assumes that the array is very straightforward - no magic, not readonly, and AvREAL - and that -C is not negative. This function MUST NOT be used in situations +C is not negative. This function MUST NOT be used in situations where any of those assumptions may not hold. Returns the SV at the specified index in the array. The C is the -index. If lval is true, you are guaranteed to get a real SV back (in case -it wasn't real before), which you can then modify. Check that the return -value is non-null before dereferencing it to a C. +index. If lval is true, you are guaranteed to get a real SV back (in +case it wasn't real before), which you can then modify. Check that +the return value is non-null before dereferencing it to a C. The rough perl equivalent is C<$myarray[$key]>. @@ -148,9 +140,9 @@ Perl_av_fetch_simple(pTHX_ AV *av, SSize_t key, I32 lval) =for apidoc av_push_simple This is a cut-down version of av_push that assumes that the array is very -straightforward - no magic, not readonly, and AvREAL - and that C is -not less than -1. This function MUST NOT be used in situations where any -of those assumptions may not hold. +straightforward - no magic, not readonly, and AvREAL - and that C is not +less than -1. This function MUST NOT be used in situations where any of those +assumptions may not hold. Pushes an SV (transferring control of one reference count) onto the end of the array. The array will grow automatically to accommodate the addition. @@ -176,9 +168,8 @@ Perl_av_push_simple(pTHX_ AV *av, SV *val) /* =for apidoc av_new_alloc -This implements L> -and L>, which are the public API for this -functionality. +This implements L> and L>, +which are the public API for this functionality. Creates a new AV and allocates its SV* array. @@ -187,8 +178,8 @@ This is similar to, but more efficient than doing: AV *av = newAV(); av_extend(av, key); -The size parameter is used to pre-allocate a SV* array large enough to -hold at least elements C<0..(size-1)>. C must be at least 1. +The size parameter is used to pre-allocate a SV* array large enough to hold +at least elements C<0..(size-1)>. C must be at least 1. The C parameter controls whether or not the array is NULL initialized. @@ -237,8 +228,8 @@ Perl_CvGV(pTHX_ CV *sv) /* =for apidoc CvDEPTH -Returns the recursion level of the CV C. Hence >= 2 indicates we are in a -recursive call. +Returns the recursion level of the CV C. Hence +>= 2 indicates we are in a recursive call. =cut */ @@ -260,7 +251,7 @@ Perl_CvDEPTH(const CV * const sv) provides a temporary copy at parse time with spaces removed. I is the start of the original buffer, I is the length of the prototype and will be updated when this returns. - */ +*/ #ifdef PERL_CORE PERL_STATIC_INLINE char * @@ -328,9 +319,8 @@ S_PadnameIN_SCOPE(const PADNAME * const pn, const U32 seq) { PERL_ARGS_ASSERT_PADNAMEIN_SCOPE; - /* is seq within the range _LOW to _HIGH ? - * This is complicated by the fact that PL_cop_seqmax - * may have wrapped around at some point */ + /* is seq within the range _LOW to _HIGH ? This is complicated by the + * fact that PL_cop_seqmax may have wrapped around at some point */ if (COP_SEQ_RANGE_LOW(pn) == PERL_PADSEQ_INTRO) return FALSE; /* not yet introduced */ @@ -383,17 +373,17 @@ Perl_POPMARK(pTHX) /* ----------------------------- regexp.h ----------------------------- */ /* PVLVs need to act as a superset of all scalar types - they are basically - * PVMGs with a few extra fields. - * REGEXPs are first class scalars, but have many fields that can't be copied - * into a PVLV body. + * PVMGs with a few extra fields. REGEXPs are first class scalars, but + * have many fields that can't be copied into a PVLV body. * - * Hence we take a different approach - instead of a copy, PVLVs store a pointer - * back to the original body. To avoid increasing the size of PVLVs just for the - * rare case of REGEXP assignment, this pointer is stored in the memory usually - * used for SvLEN(). Hence the check for SVt_PVLV below, and the ? : ternary to - * read the pointer from the two possible locations. The macro SvLEN() wraps the - * access to the union's member xpvlenu_len, but there is no equivalent macro - * for wrapping the union's member xpvlenu_rx, hence the direct reference here. + * Hence we take a different approach - instead of a copy, PVLVs store a + * pointer back to the original body. To avoid increasing the size of + * PVLVs just for the rare case of REGEXP assignment, this pointer is + * stored in the memory usually used for SvLEN(). Hence the check for + * SVt_PVLV below, and the ? : ternary to read the pointer from the two + * possible locations. The macro SvLEN() wraps the access to the union's + * member xpvlenu_len, but there is no equivalent macro for wrapping the + * union's member xpvlenu_rx, hence the direct reference here. * * See commit df6b4bd56551f2d3 for more details. */ @@ -433,14 +423,13 @@ Perl_append_utf8_from_native_byte(const U8 byte, U8** dest) /* =for apidoc valid_utf8_to_uvchr -Like C>, but should only be called when it is -known that the next character in the input UTF-8 string C is well-formed -(I, it passes C>. Surrogates, non-character code -points, and non-Unicode code points are allowed. +Like C>, but should only be called when it +is known that the next character in the input UTF-8 string C is +well-formed (I, it passes C>. Surrogates, +non-character code points, and non-Unicode code points are allowed. =cut - - */ +*/ PERL_STATIC_INLINE UV Perl_valid_utf8_to_uvchr(const U8 *s, STRLEN *retlen) @@ -460,13 +449,13 @@ Perl_valid_utf8_to_uvchr(const U8 *s, STRLEN *retlen) return uv; } - /* Remove the leading bits that indicate the number of bytes, leaving just - * the bits that are part of the value */ + /* Remove the leading bits that indicate the number of bytes, + * leaving just the bits that are part of the value */ uv = NATIVE_UTF8_TO_I8(uv) & UTF_START_MASK(expectlen); - /* Now, loop through the remaining bytes, accumulating each into the - * working total as we go. (I khw tried unrolling the loop for up to 4 - * bytes, but there was no performance improvement) */ + /* Now, loop through the remaining bytes, accumulating each into + * the working total as we go. (I khw tried unrolling the loop for + * up to 4 bytes, but there was no performance improvement) */ for (++s; s < send; s++) { uv = UTF8_ACCUMULATE(uv, *s); } @@ -489,30 +478,20 @@ If C is 0, it will be calculated using C, (which means if you use this option, that C can't have embedded C characters and has to have a terminating C byte). -See also -C>, -C>, -C>, -C>, -C>, -C>, -C>, -C>, -C>, -C>, -C>, -C>, -C>, -C>, -and +See also C>, C>, +C>, C>, +C>, C>, +C>, C>, +C>, C>, +C>, C>, +C>, C>, and C>. =cut - */ -#define is_utf8_invariant_string(s, len) \ - is_utf8_invariant_string_loc(s, len, NULL) +#define is_utf8_invariant_string(s, len) \ + is_utf8_invariant_string_loc(s, len, NULL) /* =for apidoc is_utf8_invariant_string_loc @@ -522,7 +501,6 @@ the first UTF-8 variant character in the C pointer; if all characters are UTF-8 invariant, this function does not change the contents of C<*ep>. =cut - */ PERL_STATIC_INLINE bool @@ -540,28 +518,29 @@ Perl_is_utf8_invariant_string_loc(const U8* const s, STRLEN len, const U8 ** ep) send = s + len; /* This looks like 0x010101... */ -# define PERL_COUNT_MULTIPLIER (~ (UINTMAX_C(0)) / 0xFF) +# define PERL_COUNT_MULTIPLIER (~ (UINTMAX_C(0)) / 0xFF) /* This looks like 0x808080... */ -# define PERL_VARIANTS_WORD_MASK (PERL_COUNT_MULTIPLIER * 0x80) -# define PERL_WORDSIZE sizeof(PERL_UINTMAX_T) -# define PERL_WORD_BOUNDARY_MASK (PERL_WORDSIZE - 1) - -/* Evaluates to 0 if 'x' is at a word boundary; otherwise evaluates to 1, by - * or'ing together the lowest bits of 'x'. Hopefully the final term gets - * optimized out completely on a 32-bit system, and its mask gets optimized out - * on a 64-bit system */ -# define PERL_IS_SUBWORD_ADDR(x) (1 & ( PTR2nat(x) \ - | ( PTR2nat(x) >> 1) \ - | ( ( (PTR2nat(x) \ - & PERL_WORD_BOUNDARY_MASK) >> 2)))) +# define PERL_VARIANTS_WORD_MASK (PERL_COUNT_MULTIPLIER * 0x80) +# define PERL_WORDSIZE sizeof(PERL_UINTMAX_T) +# define PERL_WORD_BOUNDARY_MASK (PERL_WORDSIZE - 1) + +/* Evaluates to 0 if 'x' is at a word boundary; otherwise evaluates + * to 1, by or'ing together the lowest bits of 'x'. Hopefully the + * final term gets optimized out completely on a 32-bit system, and + * its mask gets optimized out on a 64-bit system */ +# define PERL_IS_SUBWORD_ADDR(x) \ + (1 & ( PTR2nat(x) \ + | ( PTR2nat(x) >> 1) \ + | ( ( (PTR2nat(x) \ + & PERL_WORD_BOUNDARY_MASK) >> 2)))) #ifndef EBCDIC - /* Do the word-at-a-time iff there is at least one usable full word. That - * means that after advancing to a word boundary, there still is at least a - * full word left. The number of bytes needed to advance is 'wordsize - - * offset' unless offset is 0. */ + /* Do the word-at-a-time iff there is at least one usable full + * word. That means that after advancing to a word boundary, there + * still is at least a full word left. The number of bytes needed + * to advance is 'wordsize - offset' unless offset is 0. */ if ((STRLEN) (send - x) >= PERL_WORDSIZE /* This term is wordsize if subword; 0 if not */ @@ -589,22 +568,22 @@ Perl_is_utf8_invariant_string_loc(const U8* const s, STRLEN len, const U8 ** ep) do { if ((* (const PERL_UINTMAX_T *) x) & PERL_VARIANTS_WORD_MASK) { - /* Found a variant. Just return if caller doesn't want its - * exact position */ + /* Found a variant. Just return if caller + * doesn't want its exact position */ if (! ep) { return FALSE; } -# if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678 \ - || BYTEORDER == 0x4321 || BYTEORDER == 0x87654321 +# if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678 \ + || BYTEORDER == 0x4321 || BYTEORDER == 0x87654321 *ep = x + variant_byte_number(* (const PERL_UINTMAX_T *) x); assert(*ep >= s && *ep < send); return FALSE; -# else /* If weird byte order, drop into next loop to do byte-at-a-time - checks. */ +# else /* If weird byte order, drop into next loop + to do byte-at-a-time checks. */ break; # endif @@ -633,56 +612,56 @@ Perl_is_utf8_invariant_string_loc(const U8* const s, STRLEN len, const U8 ** ep) return TRUE; } -/* See if the platform has builtins for finding the most/least significant bit, - * and which one is right for using on 32 and 64 bit operands */ +/* See if the platform has builtins for finding the most/least significant + * bit, and which one is right for using on 32 and 64 bit operands */ #if (__has_builtin(__builtin_clz) || PERL_GCC_VERSION_GE(3,4,0)) # if U32SIZE == INTSIZE -# define PERL_CLZ_32 __builtin_clz +# define PERL_CLZ_32 __builtin_clz # endif # if defined(U64TYPE) && U64SIZE == INTSIZE -# define PERL_CLZ_64 __builtin_clz +# define PERL_CLZ_64 __builtin_clz # endif #endif #if (__has_builtin(__builtin_ctz) || PERL_GCC_VERSION_GE(3,4,0)) # if U32SIZE == INTSIZE -# define PERL_CTZ_32 __builtin_ctz +# define PERL_CTZ_32 __builtin_ctz # endif # if defined(U64TYPE) && U64SIZE == INTSIZE -# define PERL_CTZ_64 __builtin_ctz +# define PERL_CTZ_64 __builtin_ctz # endif #endif #if (__has_builtin(__builtin_clzl) || PERL_GCC_VERSION_GE(3,4,0)) # if U32SIZE == LONGSIZE && ! defined(PERL_CLZ_32) -# define PERL_CLZ_32 __builtin_clzl +# define PERL_CLZ_32 __builtin_clzl # endif # if defined(U64TYPE) && U64SIZE == LONGSIZE && ! defined(PERL_CLZ_64) -# define PERL_CLZ_64 __builtin_clzl +# define PERL_CLZ_64 __builtin_clzl # endif #endif #if (__has_builtin(__builtin_ctzl) || PERL_GCC_VERSION_GE(3,4,0)) # if U32SIZE == LONGSIZE && ! defined(PERL_CTZ_32) -# define PERL_CTZ_32 __builtin_ctzl +# define PERL_CTZ_32 __builtin_ctzl # endif # if defined(U64TYPE) && U64SIZE == LONGSIZE && ! defined(PERL_CTZ_64) -# define PERL_CTZ_64 __builtin_ctzl +# define PERL_CTZ_64 __builtin_ctzl # endif #endif #if (__has_builtin(__builtin_clzll) || PERL_GCC_VERSION_GE(3,4,0)) # if U32SIZE == LONGLONGSIZE && ! defined(PERL_CLZ_32) -# define PERL_CLZ_32 __builtin_clzll +# define PERL_CLZ_32 __builtin_clzll # endif # if defined(U64TYPE) && U64SIZE == LONGLONGSIZE && ! defined(PERL_CLZ_64) -# define PERL_CLZ_64 __builtin_clzll +# define PERL_CLZ_64 __builtin_clzll # endif #endif #if (__has_builtin(__builtin_ctzll) || PERL_GCC_VERSION_GE(3,4,0)) # if U32SIZE == LONGLONGSIZE && ! defined(PERL_CTZ_32) -# define PERL_CTZ_32 __builtin_ctzll +# define PERL_CTZ_32 __builtin_ctzll # endif # if defined(U64TYPE) && U64SIZE == LONGLONGSIZE && ! defined(PERL_CTZ_64) -# define PERL_CTZ_64 __builtin_ctzll +# define PERL_CTZ_64 __builtin_ctzll # endif #endif @@ -696,14 +675,14 @@ Perl_is_utf8_invariant_string_loc(const U8* const s, STRLEN len, const U8 ** ep) # endif #endif -/* The reason there are not checks to see if ffs() and ffsl() are available for - * determining the lsb, is because these don't improve on the deBruijn method - * fallback, which is just a branchless integer multiply, array element +/* The reason there are not checks to see if ffs() and ffsl() are available + * for determining the lsb, is because these don't improve on the deBruijn + * method fallback, which is just a branchless integer multiply, array element * retrieval, and shift. The others, even if the function call overhead is * optimized out, have to cope with the possibility of the input being all * zeroes, and almost certainly will have conditionals for this eventuality. - * khw, at the time of this commit, looked at the source for both gcc and clang - * to verify this. (gcc used a method inferior to deBruijn.) */ + * khw, at the time of this commit, looked at the source for both gcc and + * clang to verify this. (gcc used a method inferior to deBruijn.) */ /* Below are functions to find the first, last, or only set bit in a word. On * platforms with 64-bit capability, there is a pair for each operation; the @@ -715,13 +694,13 @@ Perl_is_utf8_invariant_string_loc(const U8* const s, STRLEN len, const U8 ** ep) PERL_STATIC_INLINE unsigned Perl_lsbit_pos64(U64 word) { - /* Find the position (0..63) of the least significant set bit in the input - * word */ + /* Find the position (0..63) of the least significant + * set bit in the input word */ ASSUME(word != 0); - /* If we can determine that the platform has a usable fast method to get - * this info, use that */ + /* If we can determine that the platform has a usable + * fast method to get this info, use that */ # if defined(PERL_CTZ_64) # define PERL_HAS_FAST_GET_LSB_POS64 @@ -747,12 +726,9 @@ Perl_lsbit_pos64(U64 word) * https://stackoverflow.com/questions/757059/position-of-least-significant-bit-that-is-set * * The word will look like this, with a rightmost set bit in position 's': - * ('x's are don't cares, and 'y's are their complements) - * s - * x..x100..00 - * y..y011..11 Complement - * y..y100..00 Add 1 - * 0..0100..00 And with the original + * ('x's are don't cares, and 'y's are their complements) s x..x100..00 + * y..y011..11 Complement y..y100..00 Add 1 0..0100..00 And with the + * original * * (Yes, complementing and adding 1 is just taking the negative on 2's * complement machines, but not on 1's complement ones, and some compilers @@ -764,16 +740,16 @@ Perl_lsbit_pos64(U64 word) } -# define lsbit_pos_uintmax_(word) lsbit_pos64(word) +# define lsbit_pos_uintmax_(word) lsbit_pos64(word) #else /* ! QUAD */ -# define lsbit_pos_uintmax_(word) lsbit_pos32(word) +# define lsbit_pos_uintmax_(word) lsbit_pos32(word) #endif PERL_STATIC_INLINE unsigned /* Like above for 32 bit word */ Perl_lsbit_pos32(U32 word) { - /* Find the position (0..31) of the least significant set bit in the input - * word */ + /* Find the position (0..31) of the least significant + * set bit in the input word */ ASSUME(word != 0); @@ -801,27 +777,27 @@ Perl_lsbit_pos32(U32 word) /* Convert the leading zeros count to the bit position of the first set bit. - * This just subtracts from the highest position, 31 or 63. But some compilers - * don't optimize this optimally, and so a bit of bit twiddling encourages them - * to do the right thing. It turns out that subtracting a smaller non-negative - * number 'x' from 2**n-1 for any n is the same as taking the exclusive-or of - * the two numbers. To see why, first note that the sum of any number, x, and - * its complement, x', is all ones. So all ones minus x is x'. Then note that - * the xor of x and all ones is x'. */ -#define LZC_TO_MSBIT_POS_(size, lzc) ((size##SIZE * CHARBITS - 1) ^ (lzc)) + * This just subtracts from the highest position, 31 or 63. But some + * compilers don't optimize this optimally, and so a bit of bit twiddling + * encourages them to do the right thing. It turns out that subtracting a + * smaller non-negative number 'x' from 2**n-1 for any n is the same as + * taking the exclusive-or of the two numbers. To see why, first note that + * the sum of any number, x, and its complement, x', is all ones. So all + * ones minus x is x'. Then note that the xor of x and all ones is x'. */ +#define LZC_TO_MSBIT_POS_(size, lzc) ((size##SIZE * CHARBITS - 1) ^ (lzc)) #ifdef U64TYPE /* HAS_QUAD not usable outside the core */ PERL_STATIC_INLINE unsigned Perl_msbit_pos64(U64 word) { - /* Find the position (0..63) of the most significant set bit in the input - * word */ + /* Find the position (0..63) of the most significant + * set bit in the input word */ ASSUME(word != 0); - /* If we can determine that the platform has a usable fast method to get - * this, use that */ + /* If we can determine that the platform has a usable + * fast method to get this, use that */ # if defined(PERL_CLZ_64) # define PERL_HAS_FAST_GET_MSB_POS64 @@ -856,8 +832,8 @@ Perl_msbit_pos64(U64 word) word |= (word >> 16); word |= (word >> 32); - /* Then subtracting the right shift by 1 clears all but the left-most of - * the 1 bits, which is our desired result */ + /* Then subtracting the right shift by 1 clears all but the + * left-most of the 1 bits, which is our desired result */ word -= (word >> 1); /* Now we have a single bit set */ @@ -867,16 +843,16 @@ Perl_msbit_pos64(U64 word) } -# define msbit_pos_uintmax_(word) msbit_pos64(word) +# define msbit_pos_uintmax_(word) msbit_pos64(word) #else /* ! QUAD */ -# define msbit_pos_uintmax_(word) msbit_pos32(word) +# define msbit_pos_uintmax_(word) msbit_pos32(word) #endif PERL_STATIC_INLINE unsigned Perl_msbit_pos32(U32 word) { - /* Find the position (0..31) of the most significant set bit in the input - * word */ + /* Find the position (0..31) of the most significant + * set bit in the input word */ ASSUME(word != 0); @@ -909,11 +885,11 @@ Perl_msbit_pos32(U32 word) } #if UVSIZE == U64SIZE -# define msbit_pos(word) msbit_pos64(word) -# define lsbit_pos(word) lsbit_pos64(word) +# define msbit_pos(word) msbit_pos64(word) +# define lsbit_pos(word) lsbit_pos64(word) #elif UVSIZE == U32SIZE -# define msbit_pos(word) msbit_pos32(word) -# define lsbit_pos(word) lsbit_pos32(word) +# define msbit_pos(word) msbit_pos32(word) +# define lsbit_pos(word) lsbit_pos32(word) #endif #ifdef U64TYPE /* HAS_QUAD not usable outside the core */ @@ -921,8 +897,8 @@ Perl_msbit_pos32(U32 word) PERL_STATIC_INLINE unsigned Perl_single_1bit_pos64(U64 word) { - /* Given a 64-bit word known to contain all zero bits except one 1 bit, - * find and return the 1's position: 0..63 */ + /* Given a 64-bit word known to contain all zero bits except + * one 1 bit, find and return the 1's position: 0..63 */ # ifdef PERL_CORE /* macro not exported */ ASSUME(isPOWER_OF_2(word)); @@ -930,11 +906,11 @@ Perl_single_1bit_pos64(U64 word) ASSUME(word && (word & (word-1)) == 0); # endif - /* The only set bit is both the most and least significant bit. If we have - * a fast way of finding either one, use that. + /* The only set bit is both the most and least significant bit. + * If we have a fast way of finding either one, use that. * - * It may appear at first glance that those functions call this one, but - * they don't if the corresponding #define is set */ + * It may appear at first glance that those functions call this + * one, but they don't if the corresponding #define is set */ # ifdef PERL_HAS_FAST_GET_MSB_POS64 @@ -946,8 +922,8 @@ Perl_single_1bit_pos64(U64 word) # else - /* The position of the only set bit in a word can be quickly calculated - * using deBruijn sequences. See for example + /* The position of the only set bit in a word can be quickly + * calculated using deBruijn sequences. See for example * https://en.wikipedia.org/wiki/De_Bruijn_sequence */ return PL_deBruijn_bitpos_tab64[(word * PERL_deBruijnMagic64_) >> PERL_deBruijnShift64_]; @@ -960,8 +936,8 @@ Perl_single_1bit_pos64(U64 word) PERL_STATIC_INLINE unsigned Perl_single_1bit_pos32(U32 word) { - /* Given a 32-bit word known to contain all zero bits except one 1 bit, - * find and return the 1's position: 0..31 */ + /* Given a 32-bit word known to contain all zero bits except + * one 1 bit, find and return the 1's position: 0..31 */ #ifdef PERL_CORE /* macro not exported */ ASSUME(isPOWER_OF_2(word)); @@ -976,10 +952,10 @@ Perl_single_1bit_pos32(U32 word) return lsbit_pos32(word); -/* Unlikely, but possible for the platform to have a wider fast operation but - * not a narrower one. But easy enough to handle the case by widening the - * parameter size. (Going the other way, emulating 64 bit by two 32 bit ops - * would be slower than the deBruijn method.) */ +/* Unlikely, but possible for the platform to have a wider fast operation + * but not a narrower one. But easy enough to handle the case by + * widening the parameter size. (Going the other way, emulating 64 bit + * by two 32 bit ops would be slower than the deBruijn method.) */ #elif defined(PERL_HAS_FAST_GET_MSB_POS64) return msbit_pos64(word); @@ -1007,8 +983,8 @@ Perl_variant_byte_number(PERL_UINTMAX_T word) /* Get just the msb bits of each byte */ word &= PERL_VARIANTS_WORD_MASK; - /* This should only be called if we know there is a variant byte in the - * word */ + /* This should only be called if we know there + * is a variant byte in the word */ assert(word); # if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678 @@ -1037,8 +1013,8 @@ Perl_variant_byte_number(PERL_UINTMAX_T word) * to 0..7 */ word = ((word + 1) >> 3) - 1; - /* And invert the result because of the reversed byte order on this - * platform */ + /* And invert the result because of the reversed + * byte order on this platform */ word = CHARBITS - word - 1; return (unsigned int) word; @@ -1055,28 +1031,25 @@ Perl_variant_byte_number(PERL_UINTMAX_T word) /* =for apidoc variant_under_utf8_count -This function looks at the sequence of bytes between C and C, which are -assumed to be encoded in ASCII/Latin1, and returns how many of them would -change should the string be translated into UTF-8. Due to the nature of UTF-8, -each of these would occupy two bytes instead of the single one in the input -string. Thus, this function returns the precise number of bytes the string -would expand by when translated to UTF-8. +This function looks at the sequence of bytes between C and C, which +are assumed to be encoded in ASCII/Latin1, and returns how many of them +would change should the string be translated into UTF-8. Due to the +nature of UTF-8, each of these would occupy two bytes instead of the +single one in the input string. Thus, this function returns the precise +number of bytes the string would expand by when translated to UTF-8. -Unlike most of the other functions that have C in their name, the input -to this function is NOT a UTF-8-encoded string. The function name is slightly -I to emphasize this. +Unlike most of the other functions that have C in their name, the +input to this function is NOT a UTF-8-encoded string. The function name +is slightly I to emphasize this. -This function is internal to Perl because khw thinks that any XS code that -would want this is probably operating too close to the internals. Presenting a -valid use case could change that. +This function is internal to Perl because khw thinks that any XS code +that would want this is probably operating too close to the internals. +Presenting a valid use case could change that. -See also -C> -and +See also C> and C>, =cut - */ PERL_STATIC_INLINE Size_t @@ -1089,8 +1062,8 @@ S_variant_under_utf8_count(const U8* const s, const U8* const e) # ifndef EBCDIC - /* Test if the string is long enough to use word-at-a-time. (Logic is the - * same as for is_utf8_invariant_string()) */ + /* Test if the string is long enough to use word-at-a-time. (Logic + * is the same as for is_utf8_invariant_string()) */ if ((STRLEN) (e - x) >= PERL_WORDSIZE + PERL_WORDSIZE * PERL_IS_SUBWORD_ADDR(x) - (PTR2nat(x) & PERL_WORD_BOUNDARY_MASK)) @@ -1103,8 +1076,8 @@ S_variant_under_utf8_count(const U8* const s, const U8* const e) } /* Process per-word as long as we have at least a full word left */ - do { /* Commit 03c1e4ab1d6ee9062fb3f94b0ba31db6698724b1 contains an - explanation of how this works */ + do { /* Commit 03c1e4ab1d6ee9062fb3f94b0ba31db6698724b1 + contains an explanation of how this works */ PERL_UINTMAX_T increment = ((((* (PERL_UINTMAX_T *) x) & PERL_VARIANTS_WORD_MASK) >> 7) * PERL_COUNT_MULTIPLIER) @@ -1130,7 +1103,7 @@ S_variant_under_utf8_count(const U8* const s, const U8* const e) #endif - /* Keep these around for these files */ + /* Keep these around for these files */ #if ! defined(PERL_IN_REGEXEC_C) && ! defined(PERL_IN_UTF8_C) # undef PERL_WORDSIZE # undef PERL_COUNT_MULTIPLIER @@ -1145,7 +1118,8 @@ Returns TRUE if the first C bytes of string C form a valid Perl-extended-UTF-8 string; returns FALSE otherwise. If C is 0, it will be calculated using C (which means if you use this option, that C can't have embedded C characters and has to have a terminating C -byte). Note that all characters being ASCII constitute 'a valid UTF-8 string'. +byte). Note that all characters being ASCII constitute 'a valid UTF-8 +string'. This function considers Perl's extended UTF-8 to be valid. That means that code points above Unicode, surrogates, and non-character code points are @@ -1153,37 +1127,31 @@ considered valid by this function. Use C>, C>, or C> to restrict what code points are considered valid. -See also -C>, -C>, -C>, -C>, -C>, -C>, +See also C>, C>, +C>, C>, +C>, C>, C>, =cut */ -#define is_utf8_string(s, len) is_utf8_string_loclen(s, len, NULL, NULL) +#define is_utf8_string(s, len) is_utf8_string_loclen(s, len, NULL, NULL) #if defined(PERL_CORE) || defined (PERL_EXT) /* =for apidoc is_utf8_non_invariant_string -Returns TRUE if L returns FALSE for the first -C bytes of the string C, but they are, nonetheless, legal Perl-extended -UTF-8; otherwise returns FALSE. +Returns TRUE if L returns FALSE for the +first C bytes of the string C, but they are, nonetheless, legal +Perl-extended UTF-8; otherwise returns FALSE. A TRUE return means that at least one code point represented by the sequence either is a wide character not representable as a single byte, or the -representation differs depending on whether the sequence is encoded in UTF-8 or -not. +representation differs depending on whether the sequence is encoded in UTF-8 +or not. -See also -C>, -C> +See also C>, C> =cut @@ -1191,9 +1159,8 @@ This is commonly used to determine if a SV's UTF-8 flag should be turned on. It generally needn't be if its string is entirely UTF-8 invariant, and it shouldn't be if it otherwise contains invalid UTF-8. -It is an internal function because khw thinks that XS code shouldn't be working -at this low a level. A valid use case could change that. - +It is an internal function because khw thinks that XS code shouldn't be +working at this low a level. A valid use case could change that. */ PERL_STATIC_INLINE bool @@ -1220,35 +1187,26 @@ UTF-8-encoded string that is fully interchangeable by any application using Unicode rules; otherwise it returns FALSE. If C is 0, it will be calculated using C (which means if you use this option, that C can't have embedded C characters and has to have a terminating C -byte). Note that all characters being ASCII constitute 'a valid UTF-8 string'. - -This function returns FALSE for strings containing any -code points above the Unicode max of 0x10FFFF, surrogate code points, or -non-character code points. - -See also -C>, -C>, -C>, -C>, -C>, -C>, -C>, -C>, -C>, +byte). Note that all characters being ASCII constitute 'a valid UTF-8 +string'. + +This function returns FALSE for strings containing any code points above the +Unicode max of 0x10FFFF, surrogate code points, or non-character code points. + +See also C>, C>, +C>, C>, C>, +C>, C>, +C>, C>, C>, -C>, -C>, -C>, -C>, -C>, -and -C>. +C>, C>, +C>, C>, +C>, and C>. =cut */ -#define is_strict_utf8_string(s, len) is_strict_utf8_string_loclen(s, len, NULL, NULL) +#define is_strict_utf8_string(s, len) \ + is_strict_utf8_string_loclen(s, len, NULL, NULL) /* =for apidoc is_c9strict_utf8_string @@ -1266,65 +1224,47 @@ Unicode max of 0x10FFFF or surrogate code points, but accepts non-character code points per L. -See also -C>, -C>, -C>, -C>, -C>, -C>, -C>, -C>, -C>, +See also C>, C>, +C>, C>, C>, +C>, C>, +C>, C>, C>, -C>, -C>, -C>, -C>, -C>, -and -C>. +C>, C>, +C>, C>, +C>, and C>. =cut */ -#define is_c9strict_utf8_string(s, len) is_c9strict_utf8_string_loclen(s, len, NULL, 0) +#define is_c9strict_utf8_string(s, len) \ + is_c9strict_utf8_string_loclen(s, len, NULL, 0) /* =for apidoc is_utf8_string_flags -Returns TRUE if the first C bytes of string C form a valid -UTF-8 string, subject to the restrictions imposed by C; -returns FALSE otherwise. If C is 0, it will be calculated -using C (which means if you use this option, that C can't have -embedded C characters and has to have a terminating C byte). Note -that all characters being ASCII constitute 'a valid UTF-8 string'. +Returns TRUE if the first C bytes of string C form a valid UTF-8 +string, subject to the restrictions imposed by C; returns FALSE +otherwise. If C is 0, it will be calculated using C (which +means if you use this option, that C can't have embedded C characters +and has to have a terminating C byte). Note that all characters being +ASCII constitute 'a valid UTF-8 string'. If C is 0, this gives the same results as C>; if C is C, this gives the same results as C>; and if C is C, this gives the same results as -C>. Otherwise C may be any -combination of the C> flags understood by -C>, with the same meanings. - -See also -C>, -C>, -C>, -C>, -C>, -C>, -C>, -C>, +C>. Otherwise C may be any combination of +the C> flags understood by C>, with +the same meanings. + +See also C>, C>, +C>, C>, +C>, C>, +C>, C>, C>, -C>, -C>, -C>, -C>, -C>, -C>, -and +C>, C>, +C>, C>, +C>, C>, and C>. =cut @@ -1379,9 +1319,9 @@ Perl_is_utf8_string_flags(const U8 *s, STRLEN len, const U32 flags) =for apidoc is_utf8_string_loc -Like C> but stores the location of the failure (in the -case of "utf8ness failure") or the location C+C (in the case of -"utf8ness success") in the C pointer. +Like C> but stores the location of the failure +(in the case of "utf8ness failure") or the location C+C +(in the case of "utf8ness success") in the C pointer. See also C>. @@ -1394,10 +1334,10 @@ See also C>. =for apidoc is_utf8_string_loclen -Like C> but stores the location of the failure (in the -case of "utf8ness failure") or the location C+C (in the case of -"utf8ness success") in the C pointer, and the number of UTF-8 -encoded characters in the C pointer. +Like C> but stores the location of the failure +(in the case of "utf8ness failure") or the location C+C +(in the case of "utf8ness success") in the C pointer, and the +number of UTF-8 encoded characters in the C pointer. See also C>. @@ -1451,16 +1391,16 @@ Perl_is_utf8_string_loclen(const U8 *s, STRLEN len, const U8 **ep, STRLEN *el) } } -/* The perl core arranges to never call the DFA below without there being at - * least one byte available to look at. This allows the DFA to use a do {} - * while loop which means that calling it with a UTF-8 invariant has a single - * conditional, same as the calling code checking for invariance ahead of time. - * And having the calling code remove that conditional speeds up by that - * conditional, the case where it wasn't invariant. So there's no reason to - * check before caling this. +/* The perl core arranges to never call the DFA below without there being + * at least one byte available to look at. This allows the DFA to use a + * do {} while loop which means that calling it with a UTF-8 invariant + * has a single conditional, same as the calling code checking for + * invariance ahead of time. And having the calling code remove that + * conditional speeds up by that conditional, the case where it wasn't + * invariant. So there's no reason to check before caling this. * - * But we don't know this for non-core calls, so have to retain the check for - * them. */ + * But we don't know this for non-core calls, so have to retain the check + * for them. */ #ifdef PERL_CORE # define PERL_NON_CORE_CHECK_EMPTY(s,e) assert((e) > (s)) #else @@ -1471,85 +1411,77 @@ Perl_is_utf8_string_loclen(const U8 *s, STRLEN len, const U8 **ep, STRLEN *el) * DFA for checking input is valid UTF-8 syntax. * * This uses adaptations of the table and algorithm given in - * https://bjoern.hoehrmann.de/utf-8/decoder/dfa/, which provides comprehensive - * documentation of the original version. A copyright notice for the original - * version is given at the beginning of this file. The Perl adaptations are - * documented at the definition of PL_extended_utf8_dfa_tab[]. + * https://bjoern.hoehrmann.de/utf-8/decoder/dfa/, which provides + * comprehensive documentation of the original version. A copyright notice for + * the original version is given at the beginning of this file. The Perl + * adaptations are documented at the definition of PL_extended_utf8_dfa_tab[]. * - * This dfa is fast. There are three exit conditions: - * 1) a well-formed code point, acceptable to the table - * 2) the beginning bytes of an incomplete character, whose completion might - * or might not be acceptable - * 3) unacceptable to the table. Some of the adaptations have certain, - * hopefully less likely to occur, legal inputs be unacceptable to the - * table, so these must be sorted out afterwards. + * This dfa is fast. There are three exit conditions: 1) a well-formed code + * point, acceptable to the table 2) the beginning bytes of an incomplete + * character, whose completion might or might not be acceptable 3) unacceptable + * to the table. Some of the adaptations have certain, hopefully less likely + * to occur, legal inputs be unacceptable to the table, so these must be sorted + * out afterwards. * * This macro is a complete implementation of the code executing the DFA. It - * is passed the input sequence bounds and the table to use, and what to do - * for each of the exit conditions. There are three canned actions, likely to - * be the ones you want: - * DFA_RETURN_SUCCESS_ - * DFA_RETURN_FAILURE_ - * DFA_GOTO_TEASE_APART_FF_ + * is passed the input sequence bounds and the table to use, and what to do for + * each of the exit conditions. There are three canned actions, likely to be + * the ones you want: DFA_RETURN_SUCCESS_ DFA_RETURN_FAILURE_ + * DFA_GOTO_TEASE_APART_FF_ * * You pass a parameter giving the action to take for each of the three * possible exit conditions: * - * 'accept_action' This is executed when the DFA accepts the input. - * DFA_RETURN_SUCCESS_ is the most likely candidate. - * 'reject_action' This is executed when the DFA rejects the input. - * DFA_RETURN_FAILURE_ is a candidate, or 'goto label' where - * you have written code to distinguish the rejecting state - * results. Because it happens in several places, and - * involves #ifdefs, the special action - * DFA_GOTO_TEASE_APART_FF_ is what you want with - * PL_extended_utf8_dfa_tab. On platforms without - * EXTRA_LONG_UTF8, there is no need to tease anything apart, - * so this evaluates to DFA_RETURN_FAILURE_; otherwise you - * need to have a label 'tease_apart_FF' that it will transfer - * to. - * 'incomplete_char_action' This is executed when the DFA ran off the end - * before accepting or rejecting the input. - * DFA_RETURN_FAILURE_ is the likely action, but you could - * have a 'goto', or NOOP. In the latter case the DFA drops - * off the end, and you place your code to handle this case - * immediately after it. - */ + * 'accept_action' This is executed when the DFA accepts the input. + * DFA_RETURN_SUCCESS_ is the most likely candidate. 'reject_action' This is + * executed when the DFA rejects the input. DFA_RETURN_FAILURE_ is a + * candidate, or 'goto label' where you have written code to distinguish the + * rejecting state results. Because it happens in several places, and involves + * #ifdefs, the special action DFA_GOTO_TEASE_APART_FF_ is what you want with + * PL_extended_utf8_dfa_tab. On platforms without EXTRA_LONG_UTF8, there is no + * need to tease anything apart, so this evaluates to DFA_RETURN_FAILURE_; + * otherwise you need to have a label 'tease_apart_FF' that it will transfer + * to. 'incomplete_char_action' This is executed when the DFA ran off the end + * before accepting or rejecting the input. DFA_RETURN_FAILURE_ is the likely + * action, but you could have a 'goto', or NOOP. In the latter case the DFA + * drops off the end, and you place your code to handle this case immediately + * after it. +*/ -#define DFA_RETURN_SUCCESS_ return s - s0 -#define DFA_RETURN_FAILURE_ return 0 +#define DFA_RETURN_SUCCESS_ return s - s0 +#define DFA_RETURN_FAILURE_ return 0 #ifdef HAS_EXTRA_LONG_UTF8 -# define DFA_TEASE_APART_FF_ goto tease_apart_FF +# define DFA_TEASE_APART_FF_ goto tease_apart_FF #else -# define DFA_TEASE_APART_FF_ DFA_RETURN_FAILURE_ +# define DFA_TEASE_APART_FF_ DFA_RETURN_FAILURE_ #endif -#define PERL_IS_UTF8_CHAR_DFA(s0, e, dfa_tab, \ - accept_action, \ - reject_action, \ - incomplete_char_action) \ - STMT_START { \ - const U8 * s = s0; \ - const U8 * e_ = e; \ - UV state = 0; \ - \ - PERL_NON_CORE_CHECK_EMPTY(s, e_); \ - \ - do { \ - state = dfa_tab[256 + state + dfa_tab[*s]]; \ - s++; \ - \ - if (state == 0) { /* Accepting state */ \ - accept_action; \ - } \ - \ - if (UNLIKELY(state == 1)) { /* Rejecting state */ \ - reject_action; \ - } \ - } while (s < e_); \ - \ - /* Here, dropped out of loop before end-of-char */ \ - incomplete_char_action; \ +#define PERL_IS_UTF8_CHAR_DFA(s0, e, dfa_tab, \ + accept_action, \ + reject_action, \ + incomplete_char_action) \ + STMT_START { \ + const U8 * s = s0; \ + const U8 * e_ = e; \ + UV state = 0; \ + \ + PERL_NON_CORE_CHECK_EMPTY(s, e_); \ + \ + do { \ + state = dfa_tab[256 + state + dfa_tab[*s]]; \ + s++; \ + \ + if (state == 0) { /* Accepting state */ \ + accept_action; \ + } \ + \ + if (UNLIKELY(state == 1)) { /* Rejecting state */ \ + reject_action; \ + } \ + } while (s < e_); \ + \ + /* Here, dropped out of loop before end-of-char */ \ + incomplete_char_action; \ } STMT_END @@ -1600,18 +1532,18 @@ Perl_isUTF8_CHAR(const U8 * const s0, const U8 * const e) DFA_TEASE_APART_FF_, DFA_RETURN_FAILURE_); - /* Here, we didn't return success, but dropped out of the loop. In the - * case of PL_extended_utf8_dfa_tab, this means the input is either - * malformed, or the start byte was FF on a platform that the dfa doesn't - * handle FF's. Call a helper function. */ + /* Here, we didn't return success, but dropped out of the loop. In + * the case of PL_extended_utf8_dfa_tab, this means the input is + * either malformed, or the start byte was FF on a platform that + * the dfa doesn't handle FF's. Call a helper function. */ #ifdef HAS_EXTRA_LONG_UTF8 tease_apart_FF: - /* In the case of PL_extended_utf8_dfa_tab, getting here means the input is - * either malformed, or was for the largest possible start byte, which we - * now check, not inline */ + /* In the case of PL_extended_utf8_dfa_tab, getting here means + * the input is either malformed, or was for the largest + * possible start byte, which we now check, not inline */ if (*s0 != I8_TO_NATIVE_UTF8(0xFF)) { return 0; } @@ -1671,12 +1603,12 @@ Perl_isSTRICT_UTF8_CHAR(const U8 * const s0, const U8 * const e) DFA_RETURN_FAILURE_); check_hanguls: - /* Here, we didn't return success, but dropped out of the loop. In the - * case of PL_strict_utf8_dfa_tab, this means the input is either + /* Here, we didn't return success, but dropped out of the loop. In + * the case of PL_strict_utf8_dfa_tab, this means the input is either * malformed, or was for certain Hanguls; handle them specially */ - /* The dfa above drops out for incomplete or illegal inputs, and certain - * legal Hanguls; check and return accordingly */ + /* The dfa above drops out for incomplete or illegal inputs, and + * certain legal Hanguls; check and return accordingly */ return is_HANGUL_ED_utf8_safe(s0, e); } @@ -1684,12 +1616,12 @@ Perl_isSTRICT_UTF8_CHAR(const U8 * const s0, const U8 * const e) =for apidoc isC9_STRICT_UTF8_CHAR -Evaluates to non-zero if the first few bytes of the string starting at C and -looking no further than S> are well-formed UTF-8 that represents some -Unicode non-surrogate code point; otherwise it evaluates to 0. If non-zero, -the value gives how many bytes starting at C comprise the code point's -representation. Any bytes remaining before C, but beyond the ones needed to -form the first code point in C, are not examined. +Evaluates to non-zero if the first few bytes of the string starting at C +and looking no further than S> are well-formed UTF-8 that represents +some Unicode non-surrogate code point; otherwise it evaluates to 0. If +non-zero, the value gives how many bytes starting at C comprise the code +point's representation. Any bytes remaining before C, but beyond the ones +needed to form the first code point in C, are not examined. The largest acceptable code point is the Unicode maximum 0x10FFFF. This differs from C> only in that it accepts non-character @@ -1712,7 +1644,6 @@ This uses an adaptation of the tables and algorithm given in documentation of the original version. A copyright notice for the original version is given at the beginning of this file. The Perl adaptation is documented at the definition of PL_c9_utf8_dfa_tab[]. - */ PERL_STATIC_INLINE Size_t @@ -1730,26 +1661,26 @@ Perl_isC9_STRICT_UTF8_CHAR(const U8 * const s0, const U8 * const e) =for apidoc is_strict_utf8_string_loc -Like C> but stores the location of the failure (in the -case of "utf8ness failure") or the location C+C (in the case of -"utf8ness success") in the C pointer. +Like C> but stores the location of the +failure (in the case of "utf8ness failure") or the location C+C +(in the case of "utf8ness success") in the C pointer. See also C>. =cut */ -#define is_strict_utf8_string_loc(s, len, ep) \ - is_strict_utf8_string_loclen(s, len, ep, 0) +#define is_strict_utf8_string_loc(s, len, ep) \ + is_strict_utf8_string_loclen(s, len, ep, 0) /* =for apidoc is_strict_utf8_string_loclen -Like C> but stores the location of the failure (in the -case of "utf8ness failure") or the location C+C (in the case of -"utf8ness success") in the C pointer, and the number of UTF-8 -encoded characters in the C pointer. +Like C> but stores the location of the +failure (in the case of "utf8ness failure") or the location C+C +(in the case of "utf8ness success") in the C pointer, and the +number of UTF-8 encoded characters in the C pointer. See also C>. @@ -1807,26 +1738,26 @@ Perl_is_strict_utf8_string_loclen(const U8 *s, STRLEN len, const U8 **ep, STRLEN =for apidoc is_c9strict_utf8_string_loc -Like C> but stores the location of the failure (in -the case of "utf8ness failure") or the location C+C (in the case of -"utf8ness success") in the C pointer. +Like C> but stores the location of the +failure (in the case of "utf8ness failure") or the location C+C +(in the case of "utf8ness success") in the C pointer. See also C>. =cut */ -#define is_c9strict_utf8_string_loc(s, len, ep) \ - is_c9strict_utf8_string_loclen(s, len, ep, 0) +#define is_c9strict_utf8_string_loc(s, len, ep) \ + is_c9strict_utf8_string_loclen(s, len, ep, 0) /* =for apidoc is_c9strict_utf8_string_loclen -Like C> but stores the location of the failure (in -the case of "utf8ness failure") or the location C+C (in the case of -"utf8ness success") in the C pointer, and the number of UTF-8 encoded -characters in the C pointer. +Like C> but stores the location of the +failure (in the case of "utf8ness failure") or the location +C+C (in the case of "utf8ness success") in the C pointer, +and the number of UTF-8 encoded characters in the C pointer. See also C>. @@ -1884,17 +1815,17 @@ Perl_is_c9strict_utf8_string_loclen(const U8 *s, STRLEN len, const U8 **ep, STRL =for apidoc is_utf8_string_loc_flags -Like C> but stores the location of the failure (in the -case of "utf8ness failure") or the location C+C (in the case of -"utf8ness success") in the C pointer. +Like C> but stores the location of the failure +(in the case of "utf8ness failure") or the location C+C (in the +case of "utf8ness success") in the C pointer. See also C>. =cut */ -#define is_utf8_string_loc_flags(s, len, ep, flags) \ - is_utf8_string_loclen_flags(s, len, ep, 0, flags) +#define is_utf8_string_loc_flags(s, len, ep, flags) \ + is_utf8_string_loclen_flags(s, len, ep, 0, flags) /* The above 3 actual functions could have been moved into the more general one @@ -1905,10 +1836,10 @@ See also C>. =for apidoc is_utf8_string_loclen_flags -Like C> but stores the location of the failure (in the -case of "utf8ness failure") or the location C+C (in the case of -"utf8ness success") in the C pointer, and the number of UTF-8 -encoded characters in the C pointer. +Like C> but stores the location of the failure +(in the case of "utf8ness failure") or the location C+C (in the +case of "utf8ness success") in the C pointer, and the number of +UTF-8 encoded characters in the C pointer. See also C>. @@ -1983,11 +1914,11 @@ Perl_is_utf8_string_loclen_flags(const U8 *s, STRLEN len, const U8 **ep, STRLEN /* =for apidoc utf8_distance -Returns the number of UTF-8 characters between the UTF-8 pointers C -and C. +Returns the number of UTF-8 characters between +the UTF-8 pointers C and C. -WARNING: use only if you *know* that the pointers point inside the -same UTF-8 buffer. +WARNING: use only if you *know* that the pointers +point inside the same UTF-8 buffer. =cut */ @@ -2003,17 +1934,17 @@ Perl_utf8_distance(pTHX_ const U8 *a, const U8 *b) /* =for apidoc utf8_hop -Return the UTF-8 pointer C displaced by C characters, either -forward (if C is positive) or backward (if negative). C does not need -to be pointing to the starting byte of a character. If it isn't, one count of +Return the UTF-8 pointer C displaced by C characters, either forward +(if C is positive) or backward (if negative). C does not need to be +pointing to the starting byte of a character. If it isn't, one count of C will be used up to get to the start of the next character for forward hops, and to the start of the current character for negative ones. WARNING: Prefer L to this one. -Do NOT use this function unless you B C is within -the UTF-8 data pointed to by C B that on entry C is aligned -on the first byte of a character or just after the last byte of a character. +Do NOT use this function unless you B C is within the UTF-8 data +pointed to by C B that on entry C is aligned on the first byte of +a character or just after the last byte of a character. =cut */ @@ -2058,9 +1989,9 @@ Perl_utf8_hop(const U8 *s, SSize_t off) =for apidoc utf8_hop_forward Return the UTF-8 pointer C displaced by up to C characters, -forward. C does not need to be pointing to the starting byte of a -character. If it isn't, one count of C will be used up to get to the -start of the next character. +forward. C does not need to be pointing to the starting byte of +a character. If it isn't, one count of C will be used up to +get to the start of the next character. C must be non-negative. @@ -2112,10 +2043,9 @@ Perl_utf8_hop_forward(const U8 *s, SSize_t off, const U8 *end) /* =for apidoc utf8_hop_back -Return the UTF-8 pointer C displaced by up to C characters, -backward. C does not need to be pointing to the starting byte of a -character. If it isn't, one count of C will be used up to get to that -start. +Return the UTF-8 pointer C displaced by up to C characters, backward. +C does not need to be pointing to the starting byte of a character. If it +isn't, one count of C will be used up to get to that start. C must be non-positive. @@ -2141,12 +2071,12 @@ Perl_utf8_hop_back(const U8 *s, SSize_t off, const U8 *start) assert(off <= 0); /* Note: if we know that the input is well-formed, we can do per-word - * hop-back. Commit d6ad3b72778369a84a215b498d8d60d5b03aa1af implemented - * that. But it was reverted because doing per-word has some - * start-up/tear-down overhead, so only makes sense if the distance to be - * moved is large, and core perl doesn't currently move more than a few - * characters at a time. You can reinstate it if it does become - * advantageous. */ + * hop-back. Commit d6ad3b72778369a84a215b498d8d60d5b03aa1af + * implemented that. But it was reverted because doing per-word has + * some start-up/tear-down overhead, so only makes sense if the + * distance to be moved is large, and core perl doesn't currently + * move more than a few characters at a time. You can reinstate it + * if it does become advantageous. */ while (off++ && s > start) { do { s--; @@ -2162,10 +2092,10 @@ Perl_utf8_hop_back(const U8 *s, SSize_t off, const U8 *start) =for apidoc utf8_hop_safe Return the UTF-8 pointer C displaced by up to C characters, -either forward or backward. C does not need to be pointing to the starting -byte of a character. If it isn't, one count of C will be used up to get -to the start of the next character for forward hops, and to the start of the -current character for negative ones. +either forward or backward. C does not need to be pointing to the +starting byte of a character. If it isn't, one count of C will +be used up to get to the start of the next character for forward hops, +and to the start of the current character for negative ones. When moving backward it will not move before C. @@ -2199,25 +2129,25 @@ Perl_utf8_hop_safe(const U8 *s, SSize_t off, const U8 *start, const U8 *end) =for apidoc isUTF8_CHAR_flags -Evaluates to non-zero if the first few bytes of the string starting at C and -looking no further than S> are well-formed UTF-8, as extended by Perl, -that represents some code point, subject to the restrictions given by C; -otherwise it evaluates to 0. If non-zero, the value gives how many bytes -starting at C comprise the code point's representation. Any bytes remaining -before C, but beyond the ones needed to form the first code point in C, -are not examined. - -If C is 0, this gives the same results as C>; -if C is C, this gives the same results -as C>; -and if C is C, this gives -the same results as C>. -Otherwise C may be any combination of the C> flags -understood by C>, with the same meanings. - -The three alternative macros are for the most commonly needed validations; they -are likely to run somewhat faster than this more general one, as they can be -inlined into your code. +Evaluates to non-zero if the first few bytes of the string starting at +C and looking no further than S> are well-formed UTF-8, as +extended by Perl, that represents some code point, subject to the +restrictions given by C; otherwise it evaluates to 0. If non-zero, +the value gives how many bytes starting at C comprise the code point's +representation. Any bytes remaining before C, but beyond the ones +needed to form the first code point in C, are not examined. + +If C is 0, this gives the same results as C>; if +C is C, this gives the same +results as C>; and if C is +C, this gives the same results as +C>. Otherwise C may be any combination +of the C> flags understood by C>, +with the same meanings. + +The three alternative macros are for the most commonly needed validations; +they are likely to run somewhat faster than this more general one, as they +can be inlined into your code. Use L, L, and L to check entire strings. @@ -2245,8 +2175,8 @@ Perl_isUTF8_CHAR_flags(const U8 * const s0, const U8 * const e, const U32 flags) tease_apart_FF: - /* In the case of PL_extended_utf8_dfa_tab, getting here means the input is - * either malformed, or was for the largest possible start byte, which + /* In the case of PL_extended_utf8_dfa_tab, getting here means the input + * is either malformed, or was for the largest possible start byte, which * indicates perl extended UTF-8, well above the Unicode maximum */ if ( *s0 != I8_TO_NATIVE_UTF8(0xFF) || (flags & (UTF8_DISALLOW_SUPER|UTF8_DISALLOW_PERL_EXTENDED))) @@ -2280,23 +2210,23 @@ This is useful when a fixed-length buffer is being tested for being well-formed UTF-8, but the final few bytes in it don't comprise a full character; that is, it is split somewhere in the middle of the final code point's UTF-8 representation. (Presumably when the buffer is refreshed with the next chunk -of data, the new first bytes will complete the partial code point.) This +of data, the new first bytes will complete the partial code point.) This function is used to verify that the final bytes in the current buffer are in fact the legal beginning of some code point, so that if they aren't, the failure can be signalled without having to wait for the next read. =cut */ -#define is_utf8_valid_partial_char(s, e) \ - is_utf8_valid_partial_char_flags(s, e, 0) +#define is_utf8_valid_partial_char(s, e) \ + is_utf8_valid_partial_char_flags(s, e, 0) /* =for apidoc is_utf8_valid_partial_char_flags -Like C>, it returns a boolean giving whether -or not the input is a valid UTF-8 encoded partial character, but it takes an -extra parameter, C, which can further restrict which code points are +Like C>, it returns a boolean giving whether or +not the input is a valid UTF-8 encoded partial character, but it takes an extra +parameter, C, which can further restrict which code points are considered valid. If C is 0, this behaves identically to @@ -2305,11 +2235,11 @@ of the C> flags accepted by C>. If there is any sequence of bytes that can complete the input partial character in such a way that a non-prohibited character is formed, the function returns TRUE; otherwise FALSE. Non character code points cannot be determined based on -partial character input. But many of the other possible excluded types can be +partial character input. But many of the other possible excluded types can be determined from just the first one or two bytes. =cut - */ +*/ PERL_STATIC_INLINE bool Perl_is_utf8_valid_partial_char_flags(const U8 * const s0, const U8 * const e, const U32 flags) @@ -2323,10 +2253,10 @@ Perl_is_utf8_valid_partial_char_flags(const U8 * const s0, const U8 * const e, c DFA_TEASE_APART_FF_, NOOP); - /* The NOOP above causes the DFA to drop down here iff the input was a - * partial character. flags=0 => can return TRUE immediately; otherwise we - * need to check (not inline) if the partial character is the beginning of - * a disallowed one */ + /* The NOOP above causes the DFA to drop down here iff the input + * was a partial character. flags=0 => can return TRUE + * immediately; otherwise we need to check (not inline) if the + * partial character is the beginning of a disallowed one */ if (flags == 0) { return TRUE; } @@ -2337,10 +2267,10 @@ Perl_is_utf8_valid_partial_char_flags(const U8 * const s0, const U8 * const e, c tease_apart_FF: - /* Getting here means the input is either malformed, or, in the case of - * PL_extended_utf8_dfa_tab, was for the largest possible start byte. The - * latter case has to be extended UTF-8, so can fail immediately if that is - * forbidden */ + /* Getting here means the input is either malformed, or, in + * the case of PL_extended_utf8_dfa_tab, was for the largest + * possible start byte. The latter case has to be extended + * UTF-8, so can fail immediately if that is forbidden */ if ( *s0 != I8_TO_NATIVE_UTF8(0xFF) || (flags & (UTF8_DISALLOW_SUPER|UTF8_DISALLOW_PERL_EXTENDED))) @@ -2359,9 +2289,9 @@ Perl_is_utf8_valid_partial_char_flags(const U8 * const s0, const U8 * const e, c =for apidoc is_utf8_fixed_width_buf_flags -Returns TRUE if the fixed-width buffer starting at C with length C -is entirely valid UTF-8, subject to the restrictions given by C; -otherwise it returns FALSE. +Returns TRUE if the fixed-width buffer starting at C with length +C is entirely valid UTF-8, subject to the restrictions given by +C; otherwise it returns FALSE. If C is 0, any well-formed UTF-8, as extended by Perl, is accepted without restriction. If the final few bytes of the buffer do not form a @@ -2369,41 +2299,41 @@ complete code point, this will return TRUE anyway, provided that C> returns TRUE for them. If C in non-zero, it can be any combination of the -C> flags accepted by C>, and with the -same meanings. +C> flags accepted by C>, and with +the same meanings. -This function differs from C> only in that the latter -returns FALSE if the final few bytes of the string don't form a complete code -point. +This function differs from C> only in that the +latter returns FALSE if the final few bytes of the string don't form a +complete code point. =cut - */ -#define is_utf8_fixed_width_buf_flags(s, len, flags) \ - is_utf8_fixed_width_buf_loclen_flags(s, len, 0, 0, flags) +*/ +#define is_utf8_fixed_width_buf_flags(s, len, flags) \ + is_utf8_fixed_width_buf_loclen_flags(s, len, 0, 0, flags) /* =for apidoc is_utf8_fixed_width_buf_loc_flags Like C> but stores the location of the -failure in the C pointer. If the function returns TRUE, C<*ep> will point -to the beginning of any partial character at the end of the buffer; if there is -no partial character C<*ep> will contain C+C. +failure in the C pointer. If the function returns TRUE, C<*ep> will +point to the beginning of any partial character at the end of the buffer; +if there is no partial character C<*ep> will contain C+C. See also C>. =cut */ -#define is_utf8_fixed_width_buf_loc_flags(s, len, loc, flags) \ - is_utf8_fixed_width_buf_loclen_flags(s, len, loc, 0, flags) +#define is_utf8_fixed_width_buf_loc_flags(s, len, loc, flags) \ + is_utf8_fixed_width_buf_loclen_flags(s, len, loc, 0, flags) /* =for apidoc is_utf8_fixed_width_buf_loclen_flags -Like C> but stores the number of -complete, valid characters found in the C pointer. +Like C> but stores the number +of complete, valid characters found in the C pointer. =cut */ @@ -2423,8 +2353,8 @@ Perl_is_utf8_fixed_width_buf_loclen_flags(const U8 * const s, ep = &maybe_partial; } - /* If it's entirely valid, return that; otherwise see if the only error is - * that the final few bytes are for a partial character */ + /* If it's entirely valid, return that; otherwise see if the only error + * is that the final few bytes are for a partial character */ return is_utf8_string_loclen_flags(s, len, ep, el, flags) || is_utf8_valid_partial_char_flags(*ep, s + len, flags); } @@ -2437,17 +2367,18 @@ Perl_utf8n_to_uvchr_msgs(const U8 *s, U32 * errors, AV ** msgs) { - /* This is the inlined portion of utf8n_to_uvchr_msgs. It handles the - * simple cases, and, if necessary calls a helper function to deal with the - * more complex ones. Almost all well-formed non-problematic code points - * are considered simple, so that it's unlikely that the helper function - * will need to be called. + /* This is the inlined portion of utf8n_to_uvchr_msgs. It handles + * the simple cases, and, if necessary calls a helper function to + * deal with the more complex ones. Almost all well-formed + * non-problematic code points are considered simple, so that it's + * unlikely that the helper function will need to be called. * * This is an adaptation of the tables and algorithm given in - * https://bjoern.hoehrmann.de/utf-8/decoder/dfa/, which provides - * comprehensive documentation of the original version. A copyright notice - * for the original version is given at the beginning of this file. The - * Perl adaptation is documented at the definition of PL_strict_utf8_dfa_tab[]. + * https://bjoern.hoehrmann.de/utf-8/decoder/dfa/, which + * provides comprehensive documentation of the original version. + * A copyright notice for the original version is given at the + * beginning of this file. The Perl adaptation is documented at + * the definition of PL_strict_utf8_dfa_tab[]. */ const U8 * const s0 = s; @@ -2457,10 +2388,10 @@ Perl_utf8n_to_uvchr_msgs(const U8 *s, PERL_ARGS_ASSERT_UTF8N_TO_UVCHR_MSGS; - /* This dfa is fast. If it accepts the input, it was for a well-formed, - * non-problematic code point, which can be returned immediately. - * Otherwise we call a helper function to figure out the more complicated - * cases. */ + /* This dfa is fast. If it accepts the input, it was for a + * well-formed, non-problematic code point, which can be + * returned immediately. Otherwise we call a helper + * function to figure out the more complicated cases. */ /* No calls from core pass in an empty string; non-core need a check */ #ifdef PERL_CORE @@ -2550,10 +2481,9 @@ Perl_utf8_to_uvchr_buf_helper(pTHX_ const U8 *s, const U8 *send, STRLEN *retlen) =for apidoc is_safe_syscall -Test that the given C (with length C) doesn't contain any internal -C characters. -If it does, set C to C, optionally warn using the C -category, and return FALSE. +Test that the given C (with length C) doesn't contain any +internal C characters. If it does, set C to C, +optionally warn using the C category, and return FALSE. Return TRUE if the name is safe. @@ -2592,16 +2522,15 @@ Perl_is_safe_syscall(pTHX_ const char *pv, STRLEN len, const char *what, const c Return true if the supplied filename has a newline character immediately before the first (hopefully only) NUL. -My original look at this incorrectly used the len from SvPV(), but -that's incorrect, since we allow for a NUL in pv[len-1]. +My original look at this incorrectly used the len from SvPV(), +but that's incorrect, since we allow for a NUL in pv[len-1]. So instead, strlen() and work from there. -This allow for the user reading a filename, forgetting to chomp it, -then calling: +This allow for the user reading a filename, forgetting to +chomp it, then calling: open my $foo, "$file\0"; - */ #ifdef PERL_CORE @@ -2625,23 +2554,23 @@ S_should_warn_nl(const char *pv) PERL_STATIC_INLINE bool S_lossless_NV_to_IV(const NV nv, IV *ivp) { - /* This function determines if the input NV 'nv' may be converted without - * loss of data to an IV. If not, it returns FALSE taking no other action. - * But if it is possible, it does the conversion, returning TRUE, and - * storing the converted result in '*ivp' */ + /* This function determines if the input NV 'nv' may be converted + * without loss of data to an IV. If not, it returns FALSE taking + * no other action. But if it is possible, it does the conversion, + * returning TRUE, and storing the converted result in '*ivp' */ PERL_ARGS_ASSERT_LOSSLESS_NV_TO_IV; # if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan) - /* Normally any comparison with a NaN returns false; if we can't rely - * on that behaviour, check explicitly */ + /* Normally any comparison with a NaN returns false; if we + * can't rely on that behaviour, check explicitly */ if (UNLIKELY(Perl_isnan(nv))) { return FALSE; } # endif - /* Written this way so that with an always-false NaN comparison we - * return false */ + /* Written this way so that with an always-false + * NaN comparison we return false */ if (!(LIKELY(nv >= (NV) IV_MIN) && LIKELY(nv < IV_MAX_P1))) { return FALSE; } @@ -2658,18 +2587,21 @@ S_lossless_NV_to_IV(const NV nv, IV *ivp) /* ------------------ pp.c, regcomp.c, toke.c, universal.c ------------ */ -#if defined(PERL_IN_PP_C) || defined(PERL_IN_REGCOMP_ANY) || defined(PERL_IN_TOKE_C) || defined(PERL_IN_UNIVERSAL_C) +#if defined(PERL_IN_PP_C) || \ + defined(PERL_IN_REGCOMP_ANY) || \ + defined(PERL_IN_TOKE_C) || \ + defined(PERL_IN_UNIVERSAL_C) -#define MAX_CHARSET_NAME_LENGTH 2 +#define MAX_CHARSET_NAME_LENGTH 2 PERL_STATIC_INLINE const char * S_get_regex_charset_name(const U32 flags, STRLEN* const lenp) { PERL_ARGS_ASSERT_GET_REGEX_CHARSET_NAME; - /* Returns a string that corresponds to the name of the regex character set - * given by 'flags', and *lenp is set the length of that string, which - * cannot exceed MAX_CHARSET_NAME_LENGTH characters */ + /* Returns a string that corresponds to the name of the regex character + * set given by 'flags', and *lenp is set the length of that string, + * which cannot exceed MAX_CHARSET_NAME_LENGTH characters */ *lenp = 1; switch (get_regex_charset(flags)) { @@ -2681,10 +2613,10 @@ S_get_regex_charset_name(const U32 flags, STRLEN* const lenp) *lenp = 2; return ASCII_MORE_RESTRICT_PAT_MODS; } - /* The NOT_REACHED; hides an assert() which has a rather complex - * definition in perl.h. */ + /* The NOT_REACHED; hides an assert() which has + * a rather complex definition in perl.h. */ NOT_REACHED; /* NOTREACHED */ - return "?"; /* Unknown */ + return "?"; /* Unknown */ } #endif @@ -2692,7 +2624,6 @@ S_get_regex_charset_name(const U32 flags, STRLEN* const lenp) /* Return false if any get magic is on the SV other than taint magic. - */ PERL_STATIC_INLINE bool @@ -2734,7 +2665,7 @@ Perl_gimme_V(pTHX) } -/* Enter a block. Push a new base context and return its address. */ +/* Enter a block. Push a new base context and return its address. */ PERL_STATIC_INLINE PERL_CONTEXT * Perl_cx_pushblock(pTHX_ U8 type, U8 gimme, SV** sp, I32 saveix) @@ -2774,19 +2705,18 @@ Perl_cx_popblock(pTHX_ PERL_CONTEXT *cx) PL_scopestack_ix = cx->blk_oldscopesp; PL_curpm = cx->blk_oldpm; - /* LEAVE_SCOPE() should have made this true. /(?{})/ cheats - * and leaves a CX entry lying around for repeated use, so - * skip for multicall */ \ + /* LEAVE_SCOPE() should have made this true. /(?{})/ cheats and leaves + * a CX entry lying around for repeated use, so skip for multicall */ \ assert( (CxTYPE(cx) == CXt_SUB && CxMULTICALL(cx)) || PL_savestack_ix == cx->blk_oldsaveix); PL_curcop = cx->blk_oldcop; PL_tmps_floor = cx->blk_old_tmpsfloor; } -/* Continue a block elsewhere (e.g. NEXT, REDO, GOTO). - * Whereas cx_popblock() restores the state to the point just before - * cx_pushblock() was called, cx_topblock() restores it to the point just - * *after* cx_pushblock() was called. */ +/* Continue a block elsewhere (e.g. NEXT, REDO, GOTO). Whereas + * cx_popblock() restores the state to the point just before + * cx_pushblock() was called, cx_topblock() restores it to the + * point just *after* cx_pushblock() was called. */ PERL_STATIC_INLINE void Perl_cx_topblock(pTHX_ PERL_CONTEXT *cx) @@ -2958,8 +2888,8 @@ Perl_cx_pushtry(pTHX_ PERL_CONTEXT *cx, OP *retop) Perl_push_evalortry_common(aTHX_ cx, retop, NULL); - /* Don't actually change it, just store the current value so it's restored - * by the common popeval */ + /* Don't actually change it, just store the current + * value so it's restored by the common popeval */ cx->blk_eval.old_cxsubix = PL_curstackinfo->si_cxsubix; } @@ -2990,11 +2920,8 @@ Perl_cx_popeval(pTHX_ PERL_CONTEXT *cx) } -/* push a plain loop, i.e. - * { block } - * while (cond) { block } - * for (init;cond;continue) { block } - * This loop can be last/redo'ed etc. +/* push a plain loop, i.e. { block } while (cond) { block } for + * (init;cond;continue) { block } This loop can be last/redo'ed etc. */ PERL_STATIC_INLINE void @@ -3005,8 +2932,7 @@ Perl_cx_pushloop_plain(pTHX_ PERL_CONTEXT *cx) } -/* push a true for loop, i.e. - * for var (list) { block } +/* push a true for loop, i.e. for var (list) { block } */ PERL_STATIC_INLINE void @@ -3036,8 +2962,8 @@ Perl_cx_poploop(pTHX_ PERL_CONTEXT *cx) if ( CxTYPE(cx) == CXt_LOOP_ARY || CxTYPE(cx) == CXt_LOOP_LAZYSV) { - /* Free ary or cur. This assumes that state_u.ary.ary - * aligns with state_u.lazysv.cur. See cx_dup() */ + /* Free ary or cur. This assumes that state_u.ary.ary + * aligns with state_u.lazysv.cur. See cx_dup() */ SV *sv = cx->blk_loop.state_u.lazysv.cur; cx->blk_loop.state_u.lazysv.cur = NULL; SvREFCNT_dec_NN(sv); @@ -3108,14 +3034,14 @@ Perl_cx_popgiven(pTHX_ PERL_CONTEXT *cx) /* =for apidoc newPADxVOP -Constructs, checks and returns an op containing a pad offset. C is -the opcode, which should be one of C, C, C -or C. The returned op will have the C field set by -the C argument. +Constructs, checks and returns an op containing a pad offset. +C is the opcode, which should be one of C, +C, C or C. The returned op will +have the C field set by the C argument. -This is convenient when constructing a large optree in nested function -calls, as it avoids needing to store the pad op directly to set the -C field as a side-effect. For example +This is convenient when constructing a large optree in nested +function calls, as it avoids needing to store the pad op directly +to set the C field as a side-effect. For example o = op_append_elem(OP_LINESEQ, o, newPADxVOP(OP_PADSV, 0, padix)); @@ -3142,11 +3068,10 @@ Perl_newPADxVOP(pTHX_ I32 type, I32 flags, PADOFFSET padix) =for apidoc foldEQ -Returns true if the leading C bytes of the strings C and C are the -same -case-insensitively; false otherwise. Uppercase and lowercase ASCII range bytes -match themselves and their opposite case counterparts. Non-cased and non-ASCII -range bytes match only themselves. +Returns true if the leading C bytes of the strings C and C +are the same case-insensitively; false otherwise. Uppercase and lowercase +ASCII range bytes match themselves and their opposite case counterparts. +Non-cased and non-ASCII range bytes match only themselves. =cut */ @@ -3172,10 +3097,10 @@ Perl_foldEQ(pTHX_ const char *s1, const char *s2, I32 len) PERL_STATIC_INLINE I32 Perl_foldEQ_latin1(pTHX_ const char *s1, const char *s2, I32 len) { - /* Compare non-UTF-8 using Unicode (Latin1) semantics. Works on all folds - * representable without UTF-8, except for LATIN_SMALL_LETTER_SHARP_S, and - * does not check for this. Nor does it check that the strings each have - * at least 'len' characters. */ + /* Compare non-UTF-8 using Unicode (Latin1) semantics. Works on all + * folds representable without UTF-8, except for + * LATIN_SMALL_LETTER_SHARP_S, and does not check for this. Nor does it + * check that the strings each have at least 'len' characters. */ const U8 *a = (const U8 *)s1; const U8 *b = (const U8 *)s2; @@ -3197,8 +3122,8 @@ Perl_foldEQ_latin1(pTHX_ const char *s1, const char *s2, I32 len) =for apidoc_section $locale =for apidoc foldEQ_locale -Returns true if the leading C bytes of the strings C and C are the -same case-insensitively in the current locale; false otherwise. +Returns true if the leading C bytes of the strings C and C are +the same case-insensitively in the current locale; false otherwise. =cut */ @@ -3233,15 +3158,14 @@ Perl_foldEQ_locale(pTHX_ const char *s1, const char *s2, I32 len) The C library C if available, or a Perl implementation of it. -C computes the length of the string, up to C -characters. It will never attempt to address more than C -characters, making it suitable for use with strings that are not -guaranteed to be NUL-terminated. +C computes the length of the string, up to C characters. +It will never attempt to address more than C characters, making it +suitable for use with strings that are not guaranteed to be NUL-terminated. =cut -Description stolen from http://man.openbsd.org/strnlen.3, -implementation stolen from PostgreSQL. +Description stolen from http://man.openbsd.org/strnlen.3, implementation +stolen from PostgreSQL. */ #ifndef HAS_STRNLEN @@ -3323,9 +3247,9 @@ Perl_mortal_getenv(const char * str) PERL_ARGS_ASSERT_MORTAL_GETENV; - /* Can't mortalize without stacks. khw believes that no other threads - * should be running, so no need to lock things, and this may be during a - * phase when locking isn't even available */ + /* Can't mortalize without stacks. khw believes that no other + * threads should be running, so no need to lock things, and this + * may be during a phase when locking isn't even available */ if (UNLIKELY(PL_scopestack_ix == 0)) { return getenv(str); } @@ -3333,47 +3257,46 @@ Perl_mortal_getenv(const char * str) #ifdef PERL_MEM_LOG /* A major complication arises under PERL_MEM_LOG. When that is active, - * every memory allocation may result in logging, depending on the value of - * ENV{PERL_MEM_LOG} at the moment. That means, as we create the SV for - * saving ENV{foo}'s value (but before saving it), the logging code will - * call us recursively to find out what ENV{PERL_MEM_LOG} is. Without some - * care that could lead to: 1) infinite recursion; or 2) deadlock (trying to - * lock a boolean mutex recursively); 3) destroying the getenv() static - * buffer; or 4) destroying the temporary created by this for the copy - * causes a log entry to be made which could cause a new temporary to be - * created, which will need to be destroyed at some point, leading to an - * infinite loop. + * every memory allocation may result in logging, depending on the value + * of ENV{PERL_MEM_LOG} at the moment. That means, as we create the SV + * for saving ENV{foo}'s value (but before saving it), the logging code + * will call us recursively to find out what ENV{PERL_MEM_LOG} is. + * Without some care that could lead to: 1) infinite recursion; or 2) + * deadlock (trying to lock a boolean mutex recursively); 3) destroying + * the getenv() static buffer; or 4) destroying the temporary created by + * this for the copy causes a log entry to be made which could cause a + * new temporary to be created, which will need to be destroyed at some + * point, leading to an infinite loop. * * The solution adopted here (after some gnashing of teeth) is to detect - * the recursive calls and calls from the logger, and treat them specially. - * Let's say we want to do getenv("foo"). We first find + * the recursive calls and calls from the logger, and treat them + * specially. Let's say we want to do getenv("foo"). We first find * getenv(PERL_MEM_LOG) and save it to a fixed-length per-interpreter * variable, so no temporary is required. Then we do getenv(foo}, and in * the process of creating a temporary to save it, this function will be - * called recursively to do a getenv(PERL_MEM_LOG). On the recursed call, - * we detect that it is such a call and return our saved value instead of - * locking and doing a new getenv(). This solves all of problems 1), 2), - * and 3). Because all the getenv()s are done while the mutex is locked, - * the state cannot have changed. To solve 4), we don't create a temporary - * when this is called from the logging code. That code disposes of the - * return value while the mutex is still locked. + * called recursively to do a getenv(PERL_MEM_LOG). On the recursed + * call, we detect that it is such a call and return our saved value + * instead of locking and doing a new getenv(). This solves all of + * problems 1), 2), and 3). Because all the getenv()s are done while the + * mutex is locked, the state cannot have changed. To solve 4), we don't + * create a temporary when this is called from the logging code. That + * code disposes of the return value while the mutex is still locked. * * The value of getenv(PERL_MEM_LOG) can be anything, but only initial - * digits and 3 particular letters are significant; the rest are ignored by - * the memory logging code. Thus the per-interpreter variable only needs - * to be large enough to save the significant information, the size of - * which is known at compile time. The first byte is extra, reserved for - * flags for our use. To protect against overflowing, only the reserved - * byte, as many digits as don't overflow, and the three letters are - * stored. + * digits and 3 particular letters are significant; the rest are ignored + * by the memory logging code. Thus the per-interpreter variable only + * needs to be large enough to save the significant information, the size + * of which is known at compile time. The first byte is extra, reserved + * for flags for our use. To protect against overflowing, only the + * reserved byte, as many digits as don't overflow, and the three letters + * are stored. * - * The reserved byte has two bits: - * 0x1 if set indicates that if we get here, it is a recursive call of - * getenv() - * 0x2 if set indicates that the call is from the logging code. + * The reserved byte has two bits: 0x1 if set indicates that if we get + * here, it is a recursive call of getenv() 0x2 if set indicates that the + * call is from the logging code. * * If the flag indicates this is a recursive call, just return the stored - * value of PL_mem_log; An empty value gets turned into NULL. */ + * value of PL_mem_log; An empty value gets turned into NULL. */ if (strEQ(str, "PERL_MEM_LOG") && PL_mem_log[0] & 0x1) { if (PL_mem_log[1] == '\0') { return NULL; @@ -3388,8 +3311,8 @@ Perl_mortal_getenv(const char * str) #ifdef PERL_MEM_LOG - /* Here we are in a critical section. As explained above, we do our own - * getenv(PERL_MEM_LOG), saving the result safely. */ + /* Here we are in a critical section. As explained above, we do + * our own getenv(PERL_MEM_LOG), saving the result safely. */ ret = getenv("PERL_MEM_LOG"); if (ret == NULL) { /* No logging active */ @@ -3404,16 +3327,17 @@ Perl_mortal_getenv(const char * str) else { char *mem_log_meat = PL_mem_log + 1; /* first byte reserved */ - /* There is nothing to prevent the value of PERL_MEM_LOG from being an - * extremely long string. But we want only a few characters from it. - * PL_mem_log has been made large enough to hold just the ones we need. - * First the file descriptor. */ + /* There is nothing to prevent the value of PERL_MEM_LOG from being + * an extremely long string. But we want only a few characters + * from it. PL_mem_log has been made large enough to hold just the + * ones we need. First the file descriptor. */ if (isDIGIT(*ret)) { const char * s = ret; if (UNLIKELY(*s == '0')) { - /* Reduce multiple leading zeros to a single one. This is to - * allow the caller to change what to do with leading zeros. */ + /* Reduce multiple leading zeros to a single + * one. This is to allow the caller to change + * what to do with leading zeros. */ *mem_log_meat++ = '0'; s++; while (*s == '0') { @@ -3421,8 +3345,8 @@ Perl_mortal_getenv(const char * str) } } - /* If the input overflows, copy just enough for the result to also - * overflow, plus 1 to make sure */ + /* If the input overflows, copy just enough for the + * result to also overflow, plus 1 to make sure */ while (isDIGIT(*s) && s < ret + TYPE_DIGITS(UV) + 1) { *mem_log_meat++ = *s++; } @@ -3485,8 +3409,8 @@ Perl_mortal_getenv(const char * str) PERL_STATIC_INLINE bool Perl_sv_isbool(pTHX_ const SV *sv) { - /* change to the following in 5.37, logically the same but - * more efficient and more future proof */ + /* change to the following in 5.37, logically the same + * but more efficient and more future proof */ #if 0 return (SvBoolFlagsOK(sv) && BOOL_INTERNALS_sv_isbool(sv)); #else @@ -3538,13 +3462,12 @@ Perl_padnamelist_refcnt_inc(PADNAMELIST *pnl) =for apidoc_section $string =for apidoc savepv -Perl's version of C. Returns a pointer to a newly allocated -string which is a duplicate of C. The size of the string is -determined by C, which means it may not contain embedded C -characters and must have a trailing C. To prevent memory leaks, the -memory allocated for the new string needs to be freed when no longer needed. -This can be done with the C> function, or -L|perlguts/SAVEFREEPV(p)>. +Perl's version of C. Returns a pointer to a newly allocated string +which is a duplicate of C. The size of the string is determined by +C, which means it may not contain embedded C characters and must +have a trailing C. To prevent memory leaks, the memory allocated for the +new string needs to be freed when no longer needed. This can be done with the +C> function, or L|perlguts/SAVEFREEPV(p)>. On some platforms, Windows for example, all allocated memory owned by a thread is deallocated when that thread ends. So if you need that not to happen, you @@ -3572,11 +3495,10 @@ Perl_savepv(pTHX_ const char *pv) /* =for apidoc savepvn -Perl's version of what C would be if it existed. Returns a -pointer to a newly allocated string which is a duplicate of the first -C bytes from C, plus a trailing -C byte. The memory allocated for -the new string can be freed with the C function. +Perl's version of what C would be if it existed. Returns a pointer +to a newly allocated string which is a duplicate of the first C bytes +from C, plus a trailing C byte. The memory allocated for the new +string can be freed with the C function. On some platforms, Windows for example, all allocated memory owned by a thread is deallocated when that thread ends. So if you need that not to happen, you @@ -3633,8 +3555,8 @@ Perl_savesvpv(pTHX_ SV *sv) /* =for apidoc savesharedsvpv -A version of C which allocates the duplicate string in -memory which is shared between threads. +A version of C which allocates the duplicate +string in memory which is shared between threads. =cut */ @@ -3653,8 +3575,8 @@ Perl_savesharedsvpv(pTHX_ SV *sv) /* =for apidoc my_strlcat -The C library C if available, or a Perl implementation of it. -This operates on C C-terminated strings. +The C library C if available, or a Perl implementation of it. This +operates on C C-terminated strings. C appends string C to the end of C. It will append at most S> characters. It will then C-terminate, @@ -3662,9 +3584,9 @@ unless C is 0 or the original C string was longer than C (in practice this should not happen as it means that either C is incorrect or that C is not a proper C-terminated string). -Note that C is the full size of the destination buffer and -the result is guaranteed to be C-terminated if there is room. Note that -room for the C should be included in C. +Note that C is the full size of the destination buffer and the result is +guaranteed to be C-terminated if there is room. Note that room for the +C should be included in C. The return value is the total length that C would have if C is sufficiently large. Thus it is the initial length of C plus the length of @@ -3698,8 +3620,8 @@ Perl_my_strlcat(char *dst, const char *src, Size_t size) The C library C if available, or a Perl implementation of it. This operates on C C-terminated strings. -C copies up to S> characters from the string C -to C, C-terminating the result if C is not 0. +C copies up to S> characters from the string +C to C, C-terminating the result if C is not 0. The return value is the total length C would be if the copy completely succeeded. If it is larger than C, the excess was not copied. @@ -3726,4 +3648,4 @@ Perl_my_strlcpy(char *dst, const char *src, Size_t size) /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/intrpvar.h b/intrpvar.h index e16dfc493194..14be3235534a 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -1,18 +1,17 @@ -/* intrpvar.h +/* intrpvar.h * * Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, - * 2006, 2007, 2008 by Larry Wall and others + * 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021, 2022 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * */ #include "handy.h" -/* These variables are per-interpreter in threaded/multiplicity builds, - * global otherwise. - +/* These variables are per-interpreter in threaded/multiplicity + * builds, global otherwise. + * * Don't forget to re-run regen/embed.pl to propagate changes! */ /* New variables must be added to the very end for binary compatibility. */ @@ -20,62 +19,63 @@ /* DON'T FORGET to add your variable also to perl_clone()! (in sv.c) */ /* The 'I' prefix is only needed for vars that need appropriate #defines - * generated when built with or without MULTIPLICITY. It is also used - * to generate the appropriate export list for win32. If the variable - * needs to be initialized, use PERLVARI. + * generated when built with or without MULTIPLICITY. It is also used to + * generate the appropriate export list for win32. If the variable needs to + * be initialized, use PERLVARI. * * When building without MULTIPLICITY, these variables will be truly global. * * Important ones in the first cache line (if alignment is done right) */ -PERLVAR(I, stack_sp, SV **) /* top of the stack */ -PERLVAR(I, op, OP *) /* currently executing op */ -PERLVAR(I, curpad, SV **) /* active pad (lexicals+tmps) */ +PERLVAR(I, stack_sp, SV **) /* top of the stack */ +PERLVAR(I, op, OP *) /* currently executing op */ +PERLVAR(I, curpad, SV **) /* active pad (lexicals+tmps) */ -PERLVAR(I, stack_base, SV **) -PERLVAR(I, stack_max, SV **) +PERLVAR(I, stack_base, SV **) +PERLVAR(I, stack_max, SV **) -PERLVAR(I, savestack, ANY *) /* items that need to be restored when +PERLVAR(I, savestack, ANY *) /* items that need to be restored when LEAVEing scopes we've ENTERed */ PERLVAR(I, savestack_ix, I32) PERLVAR(I, savestack_max, I32) -PERLVAR(I, scopestack, I32 *) /* scopes we've ENTERed */ +PERLVAR(I, scopestack, I32 *) /* scopes we've ENTERed */ PERLVAR(I, scopestack_ix, I32) PERLVAR(I, scopestack_max, I32) -PERLVAR(I, tmps_stack, SV **) /* mortals we've made */ -PERLVARI(I, tmps_ix, SSize_t, -1) -PERLVARI(I, tmps_floor, SSize_t, -1) -PERLVAR(I, tmps_max, SSize_t) /* first unalloced slot in tmps stack */ +PERLVAR(I, tmps_stack, SV **) /* mortals we've made */ +PERLVARI(I, tmps_ix, SSize_t, -1) +PERLVARI(I, tmps_floor, SSize_t, -1) +PERLVAR(I, tmps_max, SSize_t) /* first unalloced slot + in tmps stack */ -PERLVAR(I, markstack, I32 *) /* stack_sp locations we're +PERLVAR(I, markstack, I32 *) /* stack_sp locations we're remembering */ PERLVAR(I, markstack_ptr, I32 *) PERLVAR(I, markstack_max, I32 *) -PERLVARI(I, sub_generation, U32, 1) /* incr to invalidate method cache */ +PERLVARI(I, sub_generation, U32, 1) /* incr to invalidate method cache */ #ifdef PERL_HASH_RANDOMIZE_KEYS #ifdef USE_PERL_PERTURB_KEYS PERLVARI(I, hash_rand_bits_enabled, U8, 1) /* used to randomize hash stuff - 0. no-random - 1. random - 2. deterministic */ + 0. no-random 1. random 2. + deterministic */ #endif PERLVARI(I, hash_rand_bits, UV, 0) /* used to randomize hash stuff */ #endif -PERLVAR(I, strtab, HV *) /* shared string table */ -/* prog counter for the currently executing OP_MULTIDEREF Used to signal - * to S_find_uninit_var() where we are */ +PERLVAR(I, strtab, HV *) /* shared string table */ +/* prog counter for the currently executing OP_MULTIDEREF + * Used to signal to S_find_uninit_var() where we are */ PERLVAR(I, multideref_pc, UNOP_AUX_item *) /* Fields used by magic variables such as $@, $/ and so on */ -PERLVAR(I, curpm, PMOP *) /* what to do \ interps in REs from */ -PERLVAR(I, curpm_under, PMOP *) /* what to do \ interps in REs from */ +PERLVAR(I, curpm, PMOP *) /* what to do \ interps in REs from */ +PERLVAR(I, curpm_under, PMOP *) /* what to do \ interps + in REs from */ -PERLVAR(I, tainting, bool) /* ? doing taint checks */ -PERLVARI(I, tainted, bool, FALSE) /* using variables controlled by $< */ +PERLVAR(I, tainting, bool) /* ? doing taint checks */ +PERLVARI(I, tainted, bool, FALSE) /* using variables controlled by $< */ /* PL_delaymagic is currently used for two purposes: to assure simultaneous * updates in ($<,$>) = ..., and to assure atomic update in push/unshift @@ -90,31 +90,31 @@ PERLVARI(I, tainted, bool, FALSE) /* using variables controlled by $< */ * / POP. This removes the need to do ENTER/SAVEI16(PL_delaymagic)/LEAVE * in hot code like pp_push. */ -PERLVAR(I, delaymagic, U16) /* ($<,$>) = ... */ +PERLVAR(I, delaymagic, U16) /* ($<,$>) = ... */ /* =for apidoc_section $warning =for apidoc mn|U8|PL_dowarn -The C variable that roughly corresponds to Perl's C<$^W> warning variable. -However, C<$^W> is treated as a boolean, whereas C is a -collection of flag bits. +The C variable that roughly corresponds to Perl's C<$^W> +warning variable. However, C<$^W> is treated as a boolean, +whereas C is a collection of flag bits. -On threaded perls, each thread has an independent copy of this variable; -each initialized at creation time with the current value of the creating -thread's copy. +On threaded perls, each thread has an independent copy of +this variable; each initialized at creation time with the +current value of the creating thread's copy. =cut */ -PERLVAR(I, dowarn, U8) +PERLVAR(I, dowarn, U8) #if defined (PERL_UTF8_CACHE_ASSERT) || defined (DEBUGGING) -# define PERL___I -1 +# define PERL___I -1 #else -# define PERL___I 1 +# define PERL___I 1 #endif -PERLVARI(I, utf8cache, I8, PERL___I) /* Is the utf8 caching code enabled? */ +PERLVARI(I, utf8cache, I8, PERL___I) /* Is the utf8 caching code enabled? */ #undef PERL___I /* @@ -123,16 +123,16 @@ PERLVARI(I, utf8cache, I8, PERL___I) /* Is the utf8 caching code enabled? */ The GV representing C<*_>. Useful for access to C<$_>. -On threaded perls, each thread has an independent copy of this variable; -each initialized at creation time with the current value of the creating -thread's copy. +On threaded perls, each thread has an independent copy +of this variable; each initialized at creation time with +the current value of the creating thread's copy. =cut */ -PERLVAR(I, localizing, U8) /* are we processing a local() list? */ -PERLVAR(I, in_eval, U8) /* trap "fatal" errors? */ -PERLVAR(I, defgv, GV *) /* the *_ glob */ +PERLVAR(I, localizing, U8) /* are we processing a local() list? */ +PERLVAR(I, in_eval, U8) /* trap "fatal" errors? */ +PERLVAR(I, defgv, GV *) /* the *_ glob */ /* =for apidoc_section $GV @@ -140,54 +140,58 @@ PERLVAR(I, defgv, GV *) /* the *_ glob */ The stash for the package code will be compiled into. -On threaded perls, each thread has an independent copy of this variable; -each initialized at creation time with the current value of the creating -thread's copy. +On threaded perls, each thread has an independent copy +of this variable; each initialized at creation time +with the current value of the creating thread's copy. =cut */ /* Stashes */ -PERLVAR(I, defstash, HV *) /* main symbol table */ -PERLVAR(I, curstash, HV *) /* symbol table for current package */ +PERLVAR(I, defstash, HV *) /* main symbol table */ +PERLVAR(I, curstash, HV *) /* symbol table for current package */ /* =for apidoc_section $COP =for apidoc Amn|COP*|PL_curcop -The currently active COP (control op) roughly representing the current -statement in the source. +The currently active COP (control op) roughly representing +the current statement in the source. -On threaded perls, each thread has an independent copy of this variable; -each initialized at creation time with the current value of the creating -thread's copy. +On threaded perls, each thread has an independent copy of +this variable; each initialized at creation time with the +current value of the creating thread's copy. =cut */ -PERLVAR(I, curcop, COP *) -PERLVAR(I, curstack, AV *) /* THE STACK */ -PERLVAR(I, curstackinfo, PERL_SI *) /* current stack + context */ -PERLVAR(I, mainstack, AV *) /* the stack when nothing funny is - happening */ +PERLVAR(I, curcop, COP *) +PERLVAR(I, curstack, AV *) /* THE STACK */ +PERLVAR(I, curstackinfo, PERL_SI *) /* current stack + context */ +PERLVAR(I, mainstack, AV *) /* the stack when nothing + funny is happening */ /* memory management */ -PERLVAR(I, sv_count, IV) /* how many SV* are currently allocated */ +PERLVAR(I, sv_count, IV) /* how many SV* are currently + allocated */ -PERLVAR(I, sv_root, SV *) /* storage for SVs belonging to interp */ -PERLVAR(I, sv_arenaroot, SV *) /* list of areas for garbage collection */ +PERLVAR(I, sv_root, SV *) /* storage for SVs belonging + to interp */ +PERLVAR(I, sv_arenaroot, SV *) /* list of areas for garbage + collection */ /* fake PMOP that PL_curpm points to while in (?{}) so $1 et al are visible */ PERLVARI(I, reg_curpm, PMOP*, NULL) /* the currently active slab in a chain of slabs of regmatch states, - * and the currently active state within that slab. This stack of states - * is shared amongst re-entrant calls to the regex engine */ + * and the currently active state within that slab. This stack of + * states is shared amongst re-entrant calls to the regex engine */ -PERLVARI(I, regmatch_slab, regmatch_slab *, NULL) +PERLVARI(I, regmatch_slab, regmatch_slab *, NULL) PERLVAR(I, regmatch_state, regmatch_state *) -PERLVAR(I, comppad, PAD *) /* storage for lexically scoped temporaries */ +PERLVAR(I, comppad, PAD *) /* storage for lexically scoped + temporaries */ /* =for apidoc_section $SV @@ -196,86 +200,86 @@ This is the C SV. It is readonly. Always refer to this as C<&PL_sv_undef>. =for apidoc Amn|SV|PL_sv_no -This is the C SV. It is readonly. See C>. Always refer -to this as C<&PL_sv_no>. +This is the C SV. It is readonly. See C>. +Always refer to this as C<&PL_sv_no>. =for apidoc Amn|SV|PL_sv_yes -This is the C SV. It is readonly. See C>. Always refer to -this as C<&PL_sv_yes>. +This is the C SV. It is readonly. See C>. +Always refer to this as C<&PL_sv_yes>. =for apidoc Amn|SV|PL_sv_zero -This readonly SV has a zero numeric value and a C<"0"> string value. It's -similar to C> except for its string value. Can be used as a -cheap alternative to C for example. Always refer to this as -C<&PL_sv_zero>. Introduced in 5.28. +This readonly SV has a zero numeric value and a C<"0"> string value. +It's similar to C> except for its string value. Can be +used as a cheap alternative to C for example. Always +refer to this as C<&PL_sv_zero>. Introduced in 5.28. =cut */ #ifdef MULTIPLICITY -PERLVAR(I, sv_yes, SV) -PERLVAR(I, sv_undef, SV) -PERLVAR(I, sv_no, SV) -PERLVAR(I, sv_zero, SV) +PERLVAR(I, sv_yes, SV) +PERLVAR(I, sv_undef, SV) +PERLVAR(I, sv_no, SV) +PERLVAR(I, sv_zero, SV) #else -/* store the immortals as an array to ensure they are contiguous in - * memory: makes SvIMMORTAL_INTERP(sv) possible */ +/* store the immortals as an array to ensure they are contiguous + * in memory: makes SvIMMORTAL_INTERP(sv) possible */ PERLVARA(I, sv_immortals, 4, SV) #endif -PERLVAR(I, padname_undef, PADNAME) -PERLVAR(I, padname_const, PADNAME) +PERLVAR(I, padname_undef, PADNAME) +PERLVAR(I, padname_const, PADNAME) /* =for apidoc_section $SV =for apidoc Cmn||PL_Sv -A scratch pad SV for whatever temporary use you need. Chiefly used as a -fallback by macros on platforms where L> is -unavailable, and which would otherwise evaluate their SV parameter more than -once. +A scratch pad SV for whatever temporary use you need. Chiefly used +as a fallback by macros on platforms where +L> is unavailable, and which would +otherwise evaluate their SV parameter more than once. -B, if this is used in a situation where something that is using it -is in a call stack with something else that is using it, this variable would -get zapped, leading to hard-to-diagnose errors. +B, if this is used in a situation where something that is +using it is in a call stack with something else that is using it, +this variable would get zapped, leading to hard-to-diagnose errors. =cut */ -PERLVAR(I, Sv, SV *) +PERLVAR(I, Sv, SV *) -PERLVAR(I, parser, yy_parser *) /* current parser state */ +PERLVAR(I, parser, yy_parser *) /* current parser state */ -PERLVAR(I, stashcache, HV *) /* Cache to speed up S_method_common */ +PERLVAR(I, stashcache, HV *) /* Cache to speed up S_method_common */ /* =for apidoc_section $string =for apidoc Amn|STRLEN|PL_na -A scratch pad variable in which to store a C value. If would have been -better named something like C. +A scratch pad variable in which to store a C value. If would +have been better named something like C. -It is is typically used with C when one is actually planning to discard -the returned length, (hence the length is "Not Applicable", which is how this -variable got its name). +It is is typically used with C when one is actually planning to +discard the returned length, (hence the length is "Not Applicable", +which is how this variable got its name). -B, if this is used in a situation where something that is using it -is in a call stack with something else that is using it, this variable would -get zapped, leading to hard-to-diagnose errors. +B, if this is used in a situation where something that is +using it is in a call stack with something else that is using it, +this variable would get zapped, leading to hard-to-diagnose errors. -It is usually more efficient to either declare a local variable and use that -instead, or to use the C macro. +It is usually more efficient to either declare a local variable and +use that instead, or to use the C macro. =cut */ -PERLVAR(I, na, STRLEN) /* for use in SvPV when length is - Not Applicable */ +PERLVAR(I, na, STRLEN) /* for use in SvPV when length + is Not Applicable */ /* stat stuff */ -PERLVAR(I, statcache, Stat_t) /* _ */ -PERLVAR(I, statgv, GV *) -PERLVARI(I, statname, SV *, NULL) +PERLVAR(I, statcache, Stat_t) /* _ */ +PERLVAR(I, statgv, GV *) +PERLVARI(I, statname, SV *, NULL) /* =for apidoc_section $io @@ -308,39 +312,39 @@ thread's copy. =cut */ -PERLVAR(I, rs, SV *) /* input record separator $/ */ -PERLVAR(I, last_in_gv, GV *) /* GV used in last */ -PERLVAR(I, ofsgv, GV *) /* GV of output field separator *, */ -PERLVAR(I, defoutgv, GV *) /* default FH for output */ -PERLVARI(I, chopset, const char *, " \n-") /* $: */ -PERLVAR(I, formtarget, SV *) -PERLVAR(I, bodytarget, SV *) -PERLVAR(I, toptarget, SV *) +PERLVAR(I, rs, SV *) /* input record separator $/ */ +PERLVAR(I, last_in_gv, GV *) /* GV used in last */ +PERLVAR(I, ofsgv, GV *) /* GV of output field separator *, */ +PERLVAR(I, defoutgv, GV *) /* default FH for output */ +PERLVARI(I, chopset, const char *, " \n-") /* $: */ +PERLVAR(I, formtarget, SV *) +PERLVAR(I, bodytarget, SV *) +PERLVAR(I, toptarget, SV *) -PERLVAR(I, restartop, OP *) /* propagating an error from croak? */ -PERLVAR(I, restartjmpenv, JMPENV *) /* target frame for longjmp in die */ +PERLVAR(I, restartop, OP *) /* propagating an error from croak? */ +PERLVAR(I, restartjmpenv, JMPENV *) /* target frame for longjmp in die */ -PERLVAR(I, top_env, JMPENV *) /* ptr to current sigjmp environment */ -PERLVAR(I, start_env, JMPENV) /* empty startup sigjmp environment */ -PERLVARI(I, errors, SV *, NULL) /* outstanding queued errors */ +PERLVAR(I, top_env, JMPENV *) /* ptr to current sigjmp environment */ +PERLVAR(I, start_env, JMPENV) /* empty startup sigjmp environment */ +PERLVARI(I, errors, SV *, NULL) /* outstanding queued errors */ /* statics "owned" by various functions */ -PERLVAR(I, hv_fetch_ent_mh, HE*) /* owned by hv_fetch_ent() */ +PERLVAR(I, hv_fetch_ent_mh, HE*) /* owned by hv_fetch_ent() */ -PERLVAR(I, lastgotoprobe, OP*) /* from pp_ctl.c */ +PERLVAR(I, lastgotoprobe, OP*) /* from pp_ctl.c */ /* sort stuff */ -PERLVAR(I, sortcop, OP *) /* user defined sort routine */ -PERLVAR(I, sortstash, HV *) /* which is in some package or other */ -PERLVAR(I, firstgv, GV *) /* $a */ -PERLVAR(I, secondgv, GV *) /* $b */ +PERLVAR(I, sortcop, OP *) /* user defined sort routine */ +PERLVAR(I, sortstash, HV *) /* which is in some package or other */ +PERLVAR(I, firstgv, GV *) /* $a */ +PERLVAR(I, secondgv, GV *) /* $b */ /* float buffer */ -PERLVAR(I, efloatbuf, char *) -PERLVAR(I, efloatsize, STRLEN) +PERLVAR(I, efloatbuf, char *) +PERLVAR(I, efloatsize, STRLEN) -PERLVARI(I, dumpindent, U16, 4) /* number of blanks per dump +PERLVARI(I, dumpindent, U16, 4) /* number of blanks per dump indentation level */ /* @@ -353,9 +357,8 @@ Contains flags controlling perl's behaviour on exit(): =item * C -If set, END blocks are executed when the interpreter is destroyed. -This is normally set by perl itself after the interpreter is -constructed. +If set, END blocks are executed when the interpreter is destroyed. This +is normally set by perl itself after the interpreter is constructed. =item * C @@ -384,9 +387,9 @@ thread's copy. =cut */ -PERLVAR(I, exit_flags, U8) /* was exit() unexpected, etc. */ +PERLVAR(I, exit_flags, U8) /* was exit() unexpected, etc. */ -PERLVAR(I, utf8locale, bool) /* utf8 locale detected */ +PERLVAR(I, utf8locale, bool) /* utf8 locale detected */ #if defined(USE_LOCALE) && defined(USE_LOCALE_THREADS) PERLVARI(I, locale_mutex_depth, int, 0) /* Emulate general semaphore */ @@ -398,26 +401,26 @@ PERLVAR(I, in_utf8_CTYPE_locale, bool) PERLVAR(I, in_utf8_turkic_locale, bool) #endif -PERLVARA(I, colors,6, char *) /* values from PERL_RE_COLORS env var */ +PERLVARA(I, colors,6, char *) /* values from PERL_RE_COLORS + env var */ /* =for apidoc_section $optree_construction =for apidoc Amn|peep_t|PL_peepp -Pointer to the per-subroutine peephole optimiser. This is a function -that gets called at the end of compilation of a Perl subroutine (or -equivalently independent piece of Perl code) to perform fixups of -some ops and to perform small-scale optimisations. The function is -called once for each subroutine that is compiled, and is passed, as sole -parameter, a pointer to the op that is the entry point to the subroutine. -It modifies the op tree in place. - -The peephole optimiser should never be completely replaced. Rather, -add code to it by wrapping the existing optimiser. The basic way to do -this can be seen in L. -If the new code wishes to operate on ops throughout the subroutine's -structure, rather than just at the top level, it is likely to be more -convenient to wrap the L hook. +Pointer to the per-subroutine peephole optimiser. This is a function that +gets called at the end of compilation of a Perl subroutine (or equivalently +independent piece of Perl code) to perform fixups of some ops and to perform +small-scale optimisations. The function is called once for each subroutine +that is compiled, and is passed, as sole parameter, a pointer to the op that +is the entry point to the subroutine. It modifies the op tree in place. + +The peephole optimiser should never be completely replaced. Rather, add +code to it by wrapping the existing optimiser. The basic way to do this can +be seen in L. If the new +code wishes to operate on ops throughout the subroutine's structure, rather +than just at the top level, it is likely to be more convenient to wrap the +L hook. On threaded perls, each thread has an independent copy of this variable; each initialized at creation time with the current value of the creating @@ -426,221 +429,226 @@ thread's copy. =cut */ -PERLVARI(I, peepp, peep_t, Perl_peep) +PERLVARI(I, peepp, peep_t, Perl_peep) /* =for apidoc_section $optree_construction =for apidoc Amn|peep_t|PL_rpeepp -Pointer to the recursive peephole optimiser. This is a function -that gets called at the end of compilation of a Perl subroutine (or -equivalently independent piece of Perl code) to perform fixups of some -ops and to perform small-scale optimisations. The function is called -once for each chain of ops linked through their C fields; -it is recursively called to handle each side chain. It is passed, as -sole parameter, a pointer to the op that is at the head of the chain. -It modifies the op tree in place. - -The peephole optimiser should never be completely replaced. Rather, -add code to it by wrapping the existing optimiser. The basic way to do -this can be seen in L. -If the new code wishes to operate only on ops at a subroutine's top level, -rather than throughout the structure, it is likely to be more convenient -to wrap the L hook. +Pointer to the recursive peephole optimiser. This is a function that gets +called at the end of compilation of a Perl subroutine (or equivalently +independent piece of Perl code) to perform fixups of some ops and to perform +small-scale optimisations. The function is called once for each chain of ops +linked through their C fields; it is recursively called to handle each +side chain. It is passed, as sole parameter, a pointer to the op that is at +the head of the chain. It modifies the op tree in place. -On threaded perls, each thread has an independent copy of this variable; -each initialized at creation time with the current value of the creating -thread's copy. +The peephole optimiser should never be completely replaced. Rather, add code +to it by wrapping the existing optimiser. The basic way to do this can be seen +in L. If the new code wishes +to operate only on ops at a subroutine's top level, rather than throughout the +structure, it is likely to be more convenient to wrap the L hook. + +On threaded perls, each thread has an independent copy of this variable; each +initialized at creation time with the current value of the creating thread's +copy. =cut */ -PERLVARI(I, rpeepp, peep_t, Perl_rpeep) +PERLVARI(I, rpeepp, peep_t, Perl_rpeep) /* =for apidoc_section $optrees =for apidoc Amn|Perl_ophook_t|PL_opfreehook -When non-C, the function pointed by this variable will be called each time an OP is freed with the corresponding OP as the argument. -This allows extensions to free any extra attribute they have locally attached to an OP. +When non-C, the function pointed by this variable will be called each +time an OP is freed with the corresponding OP as the argument. This allows +extensions to free any extra attribute they have locally attached to an OP. It is also assured to first fire for the parent OP and then for its kids. -When you replace this variable, it is considered a good practice to store the possibly previously installed hook and that you recall it inside your own. +When you replace this variable, it is considered a good practice to store the +possibly previously installed hook and that you recall it inside your own. -On threaded perls, each thread has an independent copy of this variable; -each initialized at creation time with the current value of the creating -thread's copy. +On threaded perls, each thread has an independent copy of this variable; each +initialized at creation time with the current value of the creating thread's +copy. =cut */ -PERLVARI(I, opfreehook, Perl_ophook_t, 0) /* op_free() hook */ +PERLVARI(I, opfreehook, Perl_ophook_t, 0) /* op_free() hook */ -PERLVARI(I, watchaddr, char **, 0) -PERLVAR(I, watchok, char *) +PERLVARI(I, watchaddr, char **, 0) +PERLVAR(I, watchok, char *) -PERLVAR(I, perldb, U32) +PERLVAR(I, perldb, U32) -PERLVAR(I, signals, U32) /* Using which pre-5.8 signals */ +PERLVAR(I, signals, U32) /* Using which pre-5.8 signals */ -PERLVAR(I, reentrant_retint, int) /* Integer return value from reentrant functions */ +PERLVAR(I, reentrant_retint, int) /* Integer return value from + reentrant functions */ /* pseudo environmental stuff */ -PERLVAR(I, origargc, int) -PERLVAR(I, origargv, char **) -PERLVAR(I, envgv, GV *) -PERLVAR(I, incgv, GV *) -PERLVAR(I, hintgv, GV *) +PERLVAR(I, origargc, int) +PERLVAR(I, origargv, char **) +PERLVAR(I, envgv, GV *) +PERLVAR(I, incgv, GV *) +PERLVAR(I, hintgv, GV *) PERLVAR(I, origfilename, char *) PERLVARI(I, xsubfilename, const char *, NULL) -PERLVAR(I, diehook, SV *) -PERLVAR(I, warnhook, SV *) +PERLVAR(I, diehook, SV *) +PERLVAR(I, warnhook, SV *) /* switches */ -PERLVAR(I, patchlevel, SV *) +PERLVAR(I, patchlevel, SV *) PERLVAR(I, localpatches, const char * const *) -PERLVARI(I, splitstr, char *, NULL) +PERLVARI(I, splitstr, char *, NULL) -PERLVAR(I, minus_c, bool) -PERLVAR(I, minus_n, bool) -PERLVAR(I, minus_p, bool) -PERLVAR(I, minus_l, bool) -PERLVAR(I, minus_a, bool) -PERLVAR(I, minus_F, bool) -PERLVAR(I, doswitches, bool) -PERLVAR(I, minus_E, bool) +PERLVAR(I, minus_c, bool) +PERLVAR(I, minus_n, bool) +PERLVAR(I, minus_p, bool) +PERLVAR(I, minus_l, bool) +PERLVAR(I, minus_a, bool) +PERLVAR(I, minus_F, bool) +PERLVAR(I, doswitches, bool) +PERLVAR(I, minus_E, bool) -PERLVAR(I, inplace, char *) -PERLVAR(I, e_script, SV *) +PERLVAR(I, inplace, char *) +PERLVAR(I, e_script, SV *) -PERLVAR(I, basetime, Time_t) /* $^T */ +PERLVAR(I, basetime, Time_t) /* $^T */ -PERLVARI(I, maxsysfd, I32, MAXSYSFD) +PERLVARI(I, maxsysfd, I32, MAXSYSFD) /* top fd to pass to subprocesses */ -PERLVAR(I, statusvalue, I32) /* $? */ +PERLVAR(I, statusvalue, I32) /* $? */ #ifdef VMS PERLVAR(I, statusvalue_vms, U32) #else PERLVAR(I, statusvalue_posix, I32) #endif -PERLVARI(I, sig_pending, int, 0) /* Number if highest signal pending */ -PERLVAR(I, psig_pend, int *) /* per-signal "count" of pending */ +PERLVARI(I, sig_pending, int, 0) /* Number if highest signal pending */ +PERLVAR(I, psig_pend, int *) /* per-signal "count" of pending */ /* shortcuts to various I/O objects */ -PERLVAR(I, stdingv, GV *) /* *STDIN */ -PERLVAR(I, stderrgv, GV *) /* *STDERR */ -PERLVAR(I, argvgv, GV *) /* *ARGV */ -PERLVAR(I, argvoutgv, GV *) /* *ARGVOUT */ +PERLVAR(I, stdingv, GV *) /* *STDIN */ +PERLVAR(I, stderrgv, GV *) /* *STDERR */ +PERLVAR(I, argvgv, GV *) /* *ARGV */ +PERLVAR(I, argvoutgv, GV *) /* *ARGVOUT */ PERLVAR(I, argvout_stack, AV *) /* shortcuts to regexp stuff */ -PERLVAR(I, replgv, GV *) /* *^R */ +PERLVAR(I, replgv, GV *) /* *^R */ /* shortcuts to misc objects */ -PERLVAR(I, errgv, GV *) /* *@ */ +PERLVAR(I, errgv, GV *) /* *@ */ /* shortcuts to debugging objects */ -PERLVAR(I, DBgv, GV *) /* *DB::DB */ -PERLVAR(I, DBline, GV *) /* *DB::line */ +PERLVAR(I, DBgv, GV *) /* *DB::DB */ +PERLVAR(I, DBline, GV *) /* *DB::line */ /* =for apidoc_section $debugging =for apidoc mn|GV *|PL_DBsub -When Perl is run in debugging mode, with the B<-d> switch, this GV contains -the SV which holds the name of the sub being debugged. This is the C -variable which corresponds to Perl's $DB::sub variable. See -C>. +When Perl is run in debugging mode, with the B<-d> switch, this GV contains the +SV which holds the name of the sub being debugged. This is the C variable +which corresponds to Perl's $DB::sub variable. See C>. -On threaded perls, each thread has an independent copy of this variable; -each initialized at creation time with the current value of the creating -thread's copy. +On threaded perls, each thread has an independent copy of this variable; each +initialized at creation time with the current value of the creating thread's +copy. =for apidoc mn|SV *|PL_DBsingle -When Perl is run in debugging mode, with the B<-d> switch, this SV is a -boolean which indicates whether subs are being single-stepped. -Single-stepping is automatically turned on after every step. This is the C -variable which corresponds to Perl's $DB::single variable. See -C>. +When Perl is run in debugging mode, with the B<-d> switch, this SV is a boolean +which indicates whether subs are being single-stepped. Single-stepping is +automatically turned on after every step. This is the C variable which +corresponds to Perl's $DB::single variable. See C>. -On threaded perls, each thread has an independent copy of this variable; -each initialized at creation time with the current value of the creating -thread's copy. +On threaded perls, each thread has an independent copy of this variable; each +initialized at creation time with the current value of the creating thread's +copy. =for apidoc mn|SV *|PL_DBtrace -Trace variable used when Perl is run in debugging mode, with the B<-d> -switch. This is the C variable which corresponds to Perl's $DB::trace -variable. See C>. +Trace variable used when Perl is run in debugging mode, with the B<-d> switch. +This is the C variable which corresponds to Perl's $DB::trace variable. See +C>. -On threaded perls, each thread has an independent copy of this variable; -each initialized at creation time with the current value of the creating -thread's copy. +On threaded perls, each thread has an independent copy of this variable; each +initialized at creation time with the current value of the creating thread's +copy. =cut */ -PERLVAR(I, DBsub, GV *) /* *DB::sub */ -PERLVAR(I, DBsingle, SV *) /* $DB::single */ -PERLVAR(I, DBtrace, SV *) /* $DB::trace */ -PERLVAR(I, DBsignal, SV *) /* $DB::signal */ -PERLVAR(I, dbargs, AV *) /* args to call listed by caller function */ +PERLVAR(I, DBsub, GV *) /* *DB::sub */ +PERLVAR(I, DBsingle, SV *) /* $DB::single */ +PERLVAR(I, DBtrace, SV *) /* $DB::trace */ +PERLVAR(I, DBsignal, SV *) /* $DB::signal */ +PERLVAR(I, dbargs, AV *) /* args to call listed by + caller function */ -PERLVARA(I, DBcontrol, DBVARMG_COUNT, IV) /* IV versions of $DB::single, trace, signal */ +PERLVARA(I, DBcontrol, DBVARMG_COUNT, IV) /* IV versions of $DB::single, + trace, signal */ /* symbol tables */ -PERLVAR(I, debstash, HV *) /* symbol table for perldb package */ -PERLVAR(I, globalstash, HV *) /* global keyword overrides imported here */ -PERLVAR(I, curstname, SV *) /* name of current package */ -PERLVAR(I, beginav, AV *) /* names of BEGIN subroutines */ -PERLVAR(I, endav, AV *) /* names of END subroutines */ -PERLVAR(I, unitcheckav, AV *) /* names of UNITCHECK subroutines */ -PERLVAR(I, checkav, AV *) /* names of CHECK subroutines */ -PERLVAR(I, initav, AV *) /* names of INIT subroutines */ +PERLVAR(I, debstash, HV *) /* symbol table for perldb package */ +PERLVAR(I, globalstash, HV *) /* global keyword overrides + imported here */ +PERLVAR(I, curstname, SV *) /* name of current package */ +PERLVAR(I, beginav, AV *) /* names of BEGIN subroutines */ +PERLVAR(I, endav, AV *) /* names of END subroutines */ +PERLVAR(I, unitcheckav, AV *) /* names of UNITCHECK subroutines */ +PERLVAR(I, checkav, AV *) /* names of CHECK subroutines */ +PERLVAR(I, initav, AV *) /* names of INIT subroutines */ /* subprocess state */ -PERLVAR(I, fdpid, AV *) /* keep fd-to-pid mappings for my_popen */ +PERLVAR(I, fdpid, AV *) /* keep fd-to-pid mappings + for my_popen */ /* internal state */ -PERLVARI(I, op_mask, char *, NULL) /* masked operations for safe evals */ +PERLVARI(I, op_mask, char *, NULL) /* masked operations for safe evals */ /* current interpreter roots */ -PERLVAR(I, main_cv, CV *) -PERLVAR(I, main_root, OP *) -PERLVAR(I, main_start, OP *) -PERLVAR(I, eval_root, OP *) -PERLVAR(I, eval_start, OP *) +PERLVAR(I, main_cv, CV *) +PERLVAR(I, main_root, OP *) +PERLVAR(I, main_start, OP *) +PERLVAR(I, eval_root, OP *) +PERLVAR(I, eval_start, OP *) /* runtime control stuff */ -PERLVARI(I, curcopdb, COP *, NULL) - -PERLVAR(I, filemode, int) /* so nextargv() can preserve mode */ -PERLVAR(I, lastfd, int) /* what to preserve mode on */ -PERLVAR(I, oldname, char *) /* what to preserve mode on */ -/* Elements in this array have ';' appended and are injected as a single line - into the tokeniser. You can't put any (literal) newlines into any program - you stuff in into this array, as the point where it's injected is expecting - a single physical line. */ -PERLVAR(I, preambleav, AV *) -PERLVAR(I, mess_sv, SV *) -PERLVAR(I, ors_sv, SV *) /* output record separator $\ */ +PERLVARI(I, curcopdb, COP *, NULL) + +PERLVAR(I, filemode, int) /* so nextargv() can preserve mode */ +PERLVAR(I, lastfd, int) /* what to preserve mode on */ +PERLVAR(I, oldname, char *) /* what to preserve mode on */ +/* Elements in this array have ';' appended and are injected as a + single line into the tokeniser. You can't put any (literal) + newlines into any program you stuff in into this array, as the point + where it's injected is expecting a single physical line. */ +PERLVAR(I, preambleav, AV *) +PERLVAR(I, mess_sv, SV *) +PERLVAR(I, ors_sv, SV *) /* output record separator $\ */ /* funky return mechanisms */ -PERLVAR(I, forkprocess, int) /* so do_open |- can return proc# */ +PERLVAR(I, forkprocess, int) /* so do_open |- can return proc# */ /* statics moved here for shared library purposes */ -PERLVARI(I, gensym, I32, 0) /* next symbol for getsym() to define */ -PERLVARI(I, cv_has_eval, bool, FALSE) /* PL_compcv includes an entereval or similar */ -PERLVAR(I, taint_warn, bool) /* taint warns instead of dying */ -PERLVARI(I, laststype, U16, OP_STAT) +PERLVARI(I, gensym, I32, 0) /* next symbol for getsym() + to define */ +PERLVARI(I, cv_has_eval, bool, FALSE) /* PL_compcv includes an entereval + or similar */ +PERLVAR(I, taint_warn, bool) /* taint warns instead of dying */ +PERLVARI(I, laststype, U16, OP_STAT) -PERLVARI(I, laststatval, int, -1) +PERLVARI(I, laststatval, int, -1) -PERLVAR(I, modcount, I32) /* how much op_lvalue()ification in - assignment? */ +PERLVAR(I, modcount, I32) /* how much op_lvalue()ification + in assignment? */ /* interpreter atexit processing */ -PERLVARI(I, exitlistlen, I32, 0) /* length of same */ -PERLVARI(I, exitlist, PerlExitListEntry *, NULL) +PERLVARI(I, exitlistlen, I32, 0) /* length of same */ +PERLVARI(I, exitlist, PerlExitListEntry *, NULL) /* list of exit functions */ /* @@ -649,105 +657,117 @@ PERLVARI(I, exitlist, PerlExitListEntry *, NULL) C is a general purpose, interpreter global HV for use by extensions that need to keep information on a per-interpreter basis. -In a pinch, it can also be used as a symbol table for extensions -to share data among each other. It is a good idea to use keys -prefixed by the package name of the extension that owns the data. +In a pinch, it can also be used as a symbol table for extensions to +share data among each other. It is a good idea to use keys prefixed +by the package name of the extension that owns the data. -On threaded perls, each thread has an independent copy of this variable; -each initialized at creation time with the current value of the creating -thread's copy. +On threaded perls, each thread has an independent copy of this +variable; each initialized at creation time with the current value of +the creating thread's copy. =cut */ -PERLVAR(I, modglobal, HV *) /* per-interp module data */ +PERLVAR(I, modglobal, HV *) /* per-interp module data */ /* these used to be in global before 5.004_68 */ -PERLVARI(I, profiledata, U32 *, NULL) /* table of ops, counts */ +PERLVARI(I, profiledata, U32 *, NULL) /* table of ops, counts */ -PERLVAR(I, compiling, COP) /* compiling/done executing marker */ +PERLVAR(I, compiling, COP) /* compiling/done executing marker */ -PERLVAR(I, compcv, CV *) /* currently compiling subroutine */ -PERLVAR(I, comppad_name, PADNAMELIST *) /* variable names for "my" variables */ -PERLVAR(I, comppad_name_fill, PADOFFSET)/* last "introduced" variable offset */ -PERLVAR(I, comppad_name_floor, PADOFFSET)/* start of vars in innermost block */ +PERLVAR(I, compcv, CV *) /* currently compiling subroutine */ +PERLVAR(I, comppad_name, PADNAMELIST *) /* variable names for "my" variables */ +PERLVAR(I, comppad_name_fill, PADOFFSET)/* last "introduced" variable + offset */ +PERLVAR(I, comppad_name_floor, PADOFFSET)/* start of vars in innermost + block */ #ifdef HAVE_INTERP_INTERN -PERLVAR(I, sys_intern, struct interp_intern) +PERLVAR(I, sys_intern, struct interp_intern) /* platform internals */ #endif /* more statics moved here */ -PERLVAR(I, DBcv, CV *) /* from perl.c */ -PERLVARI(I, generation, int, 100) /* scan sequence# for OP_AASSIGN - compile-time common elem detection */ - -PERLVAR(I, unicode, U32) /* Unicode features: $ENV{PERL_UNICODE} or -C */ - -PERLVARI(I, in_clean_objs,bool, FALSE) /* from sv.c */ -PERLVARI(I, in_clean_all, bool, FALSE) /* ptrs to freed SVs now legal */ -PERLVAR(I, nomemok, bool) /* let malloc context handle nomem */ -PERLVARI(I, savebegin, bool, FALSE) /* save BEGINs for compiler */ - - -PERLVAR(I, delaymagic_uid, Uid_t) /* current real user id, only for delaymagic */ -PERLVAR(I, delaymagic_euid, Uid_t) /* current effective user id, only for delaymagic */ -PERLVAR(I, delaymagic_gid, Gid_t) /* current real group id, only for delaymagic */ -PERLVAR(I, delaymagic_egid, Gid_t) /* current effective group id, only for delaymagic */ -PERLVARI(I, an, U32, 0) /* malloc sequence number */ - -/* Perl_Ibreakable_sub_generation_ptr was too long for VMS, hence "gen" */ +PERLVAR(I, DBcv, CV *) /* from perl.c */ +PERLVARI(I, generation, int, 100) /* scan sequence# for OP_AASSIGN + compile-time common elem + detection */ + +PERLVAR(I, unicode, U32) /* Unicode features: $ENV{PERL_UNICODE} + or -C */ + +PERLVARI(I, in_clean_objs,bool, FALSE) /* from sv.c */ +PERLVARI(I, in_clean_all, bool, FALSE) /* ptrs to freed SVs + now legal */ +PERLVAR(I, nomemok, bool) /* let malloc context handle nomem */ +PERLVARI(I, savebegin, bool, FALSE) /* save BEGINs for compiler */ + + +PERLVAR(I, delaymagic_uid, Uid_t) /* current real user id, only + for delaymagic */ +PERLVAR(I, delaymagic_euid, Uid_t) /* current effective user id, + only for delaymagic */ +PERLVAR(I, delaymagic_gid, Gid_t) /* current real group id, only + for delaymagic */ +PERLVAR(I, delaymagic_egid, Gid_t) /* current effective group id, + only for delaymagic */ +PERLVARI(I, an, U32, 0) /* malloc sequence number */ + +/* Perl_Ibreakable_sub_generation_ptr was too long for VMS, hence "gen" */ PERLVARI(I, breakable_sub_gen, U32, 0) #ifdef DEBUGGING /* exercise wrap-around */ - #define PERL_COP_SEQMAX (U32_MAX-50) + #define PERL_COP_SEQMAX (U32_MAX-50) #else - #define PERL_COP_SEQMAX 0 + #define PERL_COP_SEQMAX 0 #endif -PERLVARI(I, cop_seqmax, U32, PERL_COP_SEQMAX) /* statement sequence number */ +PERLVARI(I, cop_seqmax, U32, PERL_COP_SEQMAX) /* statement sequence + number */ #undef PERL_COP_SEQMAX -PERLVARI(I, evalseq, U32, 0) /* eval sequence number */ -PERLVAR(I, origalen, U32) +PERLVARI(I, evalseq, U32, 0) /* eval sequence number */ +PERLVAR(I, origalen, U32) #ifdef PERL_USES_PL_PIDSTATUS -PERLVAR(I, pidstatus, HV *) /* pid-to-status mappings for waitpid */ +PERLVAR(I, pidstatus, HV *) /* pid-to-status mappings + for waitpid */ #endif -PERLVAR(I, osname, char *) /* operating system */ +PERLVAR(I, osname, char *) /* operating system */ -PERLVAR(I, sighandlerp, Sighandler_t) -/* these two are provided only to solve library linkage issues; they - * should not be hooked by user code */ +PERLVAR(I, sighandlerp, Sighandler_t) +/* these two are provided only to solve library linkage + * issues; they should not be hooked by user code */ PERLVAR(I, sighandler1p, Sighandler1_t) PERLVAR(I, sighandler3p, Sighandler3_t) -PERLVARA(I, body_roots, PERL_ARENA_ROOTS_SIZE, void*) /* array of body roots */ +PERLVARA(I, body_roots, PERL_ARENA_ROOTS_SIZE, void*) /* array of body roots */ -PERLVAR(I, debug, volatile U32) /* flags given to -D switch */ +PERLVAR(I, debug, volatile U32) /* flags given to -D switch */ -PERLVARI(I, padlist_generation, U32, 1) /* id to identify padlist clones */ +PERLVARI(I, padlist_generation, U32, 1) /* id to identify padlist clones */ -PERLVARI(I, runops, runops_proc_t, RUNOPS_DEFAULT) +PERLVARI(I, runops, runops_proc_t, RUNOPS_DEFAULT) -PERLVAR(I, subname, SV *) /* name of current subroutine */ +PERLVAR(I, subname, SV *) /* name of current subroutine */ -PERLVAR(I, subline, I32) /* line this subroutine began on */ +PERLVAR(I, subline, I32) /* line this subroutine began on */ PERLVAR(I, min_intro_pending, PADOFFSET)/* start of vars to introduce */ PERLVAR(I, max_intro_pending, PADOFFSET)/* end of vars to introduce */ -PERLVAR(I, padix, PADOFFSET) /* lowest unused index - 1 - in current "register" pad */ -PERLVAR(I, constpadix, PADOFFSET) /* lowest unused for constants */ +PERLVAR(I, padix, PADOFFSET) /* lowest unused index - 1 in + current "register" pad */ +PERLVAR(I, constpadix, PADOFFSET) /* lowest unused for constants */ -PERLVAR(I, padix_floor, PADOFFSET) /* how low may inner block reset padix */ +PERLVAR(I, padix_floor, PADOFFSET) /* how low may inner block + reset padix */ #if defined(USE_POSIX_2008_LOCALE) && defined(MULTIPLICITY) PERLVARI(I, cur_locale_obj, locale_t, NULL) #endif #ifdef USE_PL_CURLOCALES -/* This is the most number of categories we've encountered so far on any - * platform, doesn't include LC_ALL */ +/* This is the most number of categories we've encountered + * so far on any platform, doesn't include LC_ALL */ PERLVARA(I, curlocales, 12, const char *) #endif @@ -760,15 +780,14 @@ PERLVARI(I, cur_LC_ALL, const char *, NULL) /* The emory needed to store the collxfrm transformation of a string with * length 'x' is predicted by the linear equation mx+b; m=mult, b=base */ -PERLVARI(I, collxfrm_mult,Size_t, 0) /* Expansion factor in *xfrm(); - 0 => unknown or bad, depending on - base */ -PERLVAR(I, collxfrm_base, Size_t) /* Basic overhead in *xfrm(); - mult == 0, base == 0 => need to compute - mult == 0, base != 0 => ill-formed; +PERLVARI(I, collxfrm_mult,Size_t, 0) /* Expansion factor in *xfrm(); 0 => + unknown or bad, depending on base */ +PERLVAR(I, collxfrm_base, Size_t) /* Basic overhead in *xfrm(); mult == + 0, base == 0 => need to compute mult + == 0, base != 0 => ill-formed; */ -PERLVAR(I, collation_name, char *) /* Name of current collation */ -PERLVARI(I, collation_ix, U32, 0) /* Collation generation index */ +PERLVAR(I, collation_name, char *) /* Name of current collation */ +PERLVARI(I, collation_ix, U32, 0) /* Collation generation index */ PERLVARI(I, strxfrm_NUL_replacement, U8, 0) /* Code point to replace NULs */ PERLVARI(I, strxfrm_is_behaved, bool, TRUE) /* Assume until proven otherwise that it works */ @@ -786,20 +805,20 @@ PERLVARI(I, stdize_locale_buf, const char *, NULL) PERLVARI(I, stdize_locale_bufsize, Size_t, 0) #ifdef PERL_SAWAMPERSAND -PERLVAR(I, sawampersand, U8) /* must save all match strings */ +PERLVAR(I, sawampersand, U8) /* must save all match strings */ #endif -/* current phase the interpreter is in - for ordering this structure to remove holes, we're assuming that this is 4 - bytes. */ -PERLVARI(I, phase, enum perl_phase, PERL_PHASE_CONSTRUCT) +/* current phase the interpreter is in for ordering this structure + to remove holes, we're assuming that this is 4 bytes. */ +PERLVARI(I, phase, enum perl_phase, PERL_PHASE_CONSTRUCT) -PERLVARI(I, in_load_module, bool, FALSE) /* to prevent recursions in PerlIO_find_layer */ +PERLVARI(I, in_load_module, bool, FALSE) /* to prevent recursions in + PerlIO_find_layer */ PERLVARI(I, eval_begin_nest_depth, U32, 0) -PERLVAR(I, unsafe, bool) -PERLVAR(I, colorset, bool) /* PERL_RE_COLORS env var is in use */ +PERLVAR(I, unsafe, bool) +PERLVAR(I, colorset, bool) /* PERL_RE_COLORS env var is in use */ /* =for apidoc_section $embedding @@ -822,19 +841,21 @@ Possible values: If C<$ENV{PERL_DESTRUCT_LEVEL}> is set to an integer greater than the value of C its value is used instead. -On threaded perls, each thread has an independent copy of this variable; -each initialized at creation time with the current value of the creating -thread's copy. +On threaded perls, each thread has an independent copy of this +variable; each initialized at creation time with the current value of +the creating thread's copy. =cut */ /* mod_perl is special, and also assigns a meaning -1 */ -PERLVARI(I, perl_destruct_level, signed char, 0) +PERLVARI(I, perl_destruct_level, signed char, 0) -PERLVAR(I, pad_reset_pending, bool) /* reset pad on next attempted alloc */ +PERLVAR(I, pad_reset_pending, bool) /* reset pad on next attempted alloc */ -PERLVARI(I, srand_called, bool, false) /* has random_state been initialized yet? */ -PERLVARI(I, srand_override, U32, 0) /* Should we use a deterministic sequence? */ +PERLVARI(I, srand_called, bool, false) /* has random_state been + initialized yet? */ +PERLVARI(I, srand_override, U32, 0) /* Should we use a deterministic + sequence? */ PERLVARI(I, srand_override_next, U32, 0) /* Next item in the sequence */ PERLVARI(I, numeric_underlying, bool, TRUE) @@ -843,8 +864,9 @@ PERLVARI(I, numeric_underlying_is_standard, bool, TRUE) PERLVARI(I, numeric_standard, int, TRUE) /* Assume C locale numerics */ PERLVAR(I, numeric_name, char *) /* Name of current numeric locale */ -PERLVAR(I, numeric_radix_sv, SV *) /* The radix separator */ -PERLVAR(I, underlying_radix_sv, SV *) /* The radix in the program's current underlying locale */ +PERLVAR(I, numeric_radix_sv, SV *) /* The radix separator */ +PERLVAR(I, underlying_radix_sv, SV *) /* The radix in the program's current + underlying locale */ #if defined(USE_LOCALE_NUMERIC) && defined(USE_POSIX_2008_LOCALE) @@ -857,131 +879,134 @@ PERLVARI(I, scratch_locale_obj, locale_t, 0) #ifdef USE_LOCALE_CTYPE -PERLVARI(I, ctype_name, const char *, NULL) /* Name of current ctype locale */ +PERLVARI(I, ctype_name, const char *, NULL) /* Name of current ctype + locale */ # endif -/* Array of signal handlers, indexed by signal number, through which the C - signal handler dispatches. */ -PERLVAR(I, psig_ptr, SV **) -/* Array of names of signals, indexed by signal number, for (re)use as the first - argument to a signal handler. Only one block of memory is allocated for - both psig_name and psig_ptr. */ -PERLVAR(I, psig_name, SV **) +/* Array of signal handlers, indexed by signal number, + through which the C signal handler dispatches. */ +PERLVAR(I, psig_ptr, SV **) +/* Array of names of signals, indexed by signal number, for (re)use + as the first argument to a signal handler. Only one block of + memory is allocated for both psig_name and psig_ptr. */ +PERLVAR(I, psig_name, SV **) #if defined(PERL_IMPLICIT_SYS) -PERLVAR(I, Mem, struct IPerlMem *) -PERLVAR(I, MemShared, struct IPerlMem *) -PERLVAR(I, MemParse, struct IPerlMem *) -PERLVAR(I, Env, struct IPerlEnv *) -PERLVAR(I, StdIO, struct IPerlStdIO *) -PERLVAR(I, LIO, struct IPerlLIO *) -PERLVAR(I, Dir, struct IPerlDir *) -PERLVAR(I, Sock, struct IPerlSock *) -PERLVAR(I, Proc, struct IPerlProc *) +PERLVAR(I, Mem, struct IPerlMem *) +PERLVAR(I, MemShared, struct IPerlMem *) +PERLVAR(I, MemParse, struct IPerlMem *) +PERLVAR(I, Env, struct IPerlEnv *) +PERLVAR(I, StdIO, struct IPerlStdIO *) +PERLVAR(I, LIO, struct IPerlLIO *) +PERLVAR(I, Dir, struct IPerlDir *) +PERLVAR(I, Sock, struct IPerlSock *) +PERLVAR(I, Proc, struct IPerlProc *) #endif -PERLVAR(I, ptr_table, PTR_TBL_t *) -PERLVARI(I, beginav_save, AV *, NULL) /* save BEGIN{}s when compiling */ +PERLVAR(I, ptr_table, PTR_TBL_t *) +PERLVARI(I, beginav_save, AV *, NULL) /* save BEGIN{}s when compiling */ -PERLVAR(I, body_arenas, void *) /* pointer to list of body-arenas */ +PERLVAR(I, body_arenas, void *) /* pointer to list of body-arenas */ #if defined(USE_ITHREADS) -PERLVAR(I, regex_pad, SV **) /* Shortcut into the array of - regex_padav */ -PERLVAR(I, regex_padav, AV *) /* All regex objects, indexed via the +PERLVAR(I, regex_pad, SV **) /* Shortcut into the array + of regex_padav */ +PERLVAR(I, regex_padav, AV *) /* All regex objects, indexed via the values in op_pmoffset of pmop. Entry 0 is an SV whose PV is a - "packed" list of IVs listing - the now-free slots in the array */ -PERLVAR(I, stashpad, HV **) /* for CopSTASH */ + "packed" list of IVs listing the + now-free slots in the array */ +PERLVAR(I, stashpad, HV **) /* for CopSTASH */ PERLVARI(I, stashpadmax, PADOFFSET, 64) PERLVARI(I, stashpadix, PADOFFSET, 0) #endif #ifdef USE_REENTRANT_API -PERLVAR(I, reentrant_buffer, REENTR *) /* here we store the _r buffers */ +PERLVAR(I, reentrant_buffer, REENTR *) /* here we store the _r buffers */ #endif -PERLVAR(I, custom_op_names, HV *) /* Names of user defined ops */ -PERLVAR(I, custom_op_descs, HV *) /* Descriptions of user defined ops */ +PERLVAR(I, custom_op_names, HV *) /* Names of user defined ops */ +PERLVAR(I, custom_op_descs, HV *) /* Descriptions of user defined ops */ #ifdef PERLIO_LAYERS -PERLVARI(I, perlio, PerlIOl *, NULL) +PERLVARI(I, perlio, PerlIOl *, NULL) PERLVARI(I, known_layers, PerlIO_list_t *, NULL) PERLVARI(I, def_layerlist, PerlIO_list_t *, NULL) #endif -PERLVARI(I, checkav_save, AV *, NULL) /* save CHECK{}s when compiling */ +PERLVARI(I, checkav_save, AV *, NULL) /* save CHECK{}s when compiling */ PERLVARI(I, unitcheckav_save, AV *, NULL) /* save UNITCHECK{}s when compiling */ -PERLVARI(I, clocktick, long, 0) /* this many times() ticks in a second */ +PERLVARI(I, clocktick, long, 0) /* this many times() ticks + in a second */ /* Hooks to shared SVs and locks. */ -PERLVARI(I, sharehook, share_proc_t, Perl_sv_nosharing) -PERLVARI(I, lockhook, share_proc_t, Perl_sv_nosharing) +PERLVARI(I, sharehook, share_proc_t, Perl_sv_nosharing) +PERLVARI(I, lockhook, share_proc_t, Perl_sv_nosharing) GCC_DIAG_IGNORE(-Wdeprecated-declarations) #ifdef NO_MATHOMS -# define PERL_UNLOCK_HOOK Perl_sv_nosharing +# define PERL_UNLOCK_HOOK Perl_sv_nosharing #else /* This reference ensures that the mathoms are linked with perl */ -# define PERL_UNLOCK_HOOK Perl_sv_nounlocking +# define PERL_UNLOCK_HOOK Perl_sv_nounlocking #endif -PERLVARI(I, unlockhook, share_proc_t, PERL_UNLOCK_HOOK) +PERLVARI(I, unlockhook, share_proc_t, PERL_UNLOCK_HOOK) GCC_DIAG_RESTORE -PERLVARI(I, threadhook, thrhook_proc_t, Perl_nothreadhook) +PERLVARI(I, threadhook, thrhook_proc_t, Perl_nothreadhook) /* Can shared object be destroyed */ PERLVARI(I, destroyhook, destroyable_proc_t, Perl_sv_destroyable) #ifndef PERL_MICRO -PERLVARI(I, signalhook, despatch_signals_proc_t, Perl_despatch_signals) +PERLVARI(I, signalhook, despatch_signals_proc_t, Perl_despatch_signals) #endif -PERLVARI(I, isarev, HV *, NULL) /* Reverse map of @ISA dependencies */ +PERLVARI(I, isarev, HV *, NULL) /* Reverse map of @ISA dependencies */ -/* Register of known Method Resolution Orders. - What this actually points to is an implementation detail (it may change to - a structure incorporating a reference count - use mro_get_from_name to - retrieve a C */ +/* Register of known Method Resolution Orders. What this actually points to is + an implementation detail (it may change to a structure incorporating a + reference count - use mro_get_from_name to retrieve a C */ PERLVAR(I, registered_mros, HV *) /* Compile-time block start/end hooks */ -PERLVAR(I, blockhooks, AV *) +PERLVAR(I, blockhooks, AV *) -PERLVAR(I, custom_ops, HV *) /* custom op registrations */ +PERLVAR(I, custom_ops, HV *) /* custom op registrations */ -PERLVAR(I, Xpv, XPV *) /* (unused) held temporary value */ +PERLVAR(I, Xpv, XPV *) /* (unused) held temporary value */ -/* name of the scopes we've ENTERed. Only used with -DDEBUGGING, but needs to be - present always, as -DDEBUGGING must be binary compatible with non. */ +/* name of the scopes we've ENTERed. Only used with -DDEBUGGING, but needs to + be present always, as -DDEBUGGING must be binary compatible with non. */ PERLVARI(I, scopestack_name, const char **, NULL) -PERLVAR(I, debug_pad, struct perl_debug_pad) /* always needed because of the re extension */ +PERLVAR(I, debug_pad, struct perl_debug_pad) /* always needed because of + the re extension */ /* Hook for File::Glob */ -PERLVARI(I, globhook, globhook_t, NULL) +PERLVARI(I, globhook, globhook_t, NULL) #if defined(MULTIPLICITY) -/* The last unconditional member of the interpreter structure when 5.18.0 was - released. The offset of the end of this is baked into a global variable in - any shared perl library which will allow a sanity test in future perl - releases. */ -# define PERL_LAST_5_18_0_INTERP_MEMBER Iglobhook +/* The last unconditional member of the interpreter structure + when 5.18.0 was released. The offset of the end of this is + baked into a global variable in any shared perl library which + will allow a sanity test in future perl releases. */ +# define PERL_LAST_5_18_0_INTERP_MEMBER Iglobhook #endif #ifdef MULTIPLICITY -PERLVARI(I, my_cxt_list, void **, NULL) /* per-module array of MY_CXT pointers */ -PERLVARI(I, my_cxt_size, int, 0) /* size of PL_my_cxt_list */ +PERLVARI(I, my_cxt_list, void **, NULL) /* per-module array of + MY_CXT pointers */ +PERLVARI(I, my_cxt_size, int, 0) /* size of PL_my_cxt_list */ #endif #if defined(MULTIPLICITY) || defined(PERL_DEBUG_READONLY_COW) -/* For use with the memory debugging code in util.c. This is used only in +/* For use with the memory debugging code in util.c. This is used only in * DEBUGGING builds (as long as the relevant structure is defined), but * defining it in non-debug builds too means that we retain binary * compatibility between otherwise-compatible plain and debug builds. */ @@ -989,32 +1014,33 @@ PERLVAR(I, memory_debug_header, struct perl_memory_debug_header) #endif #ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP -/* File descriptor to talk to the child which dumps scalars. */ -PERLVARI(I, dumper_fd, int, -1) +/* File descriptor to talk to the child which dumps scalars. */ +PERLVARI(I, dumper_fd, int, -1) #endif #ifdef DEBUG_LEAKING_SCALARS -PERLVARI(I, sv_serial, U32, 0) /* SV serial number, used in sv.c */ +PERLVARI(I, sv_serial, U32, 0) /* SV serial number, used in sv.c */ #endif -PERLVARA(I, sv_consts, SV_CONSTS_COUNT, SV*) /* constant SVs with precomputed hash value */ +PERLVARA(I, sv_consts, SV_CONSTS_COUNT, SV*) /* constant SVs with + precomputed hash value */ #ifdef PERL_TRACE_OPS -PERLVARA(I, op_exec_cnt, OP_max+2, UV) /* Counts of executed OPs of the given type. - If PERL_TRACE_OPS is enabled, we'll dump - a summary count of all ops executed in the - program at perl_destruct time. Used only - for profiling in DEBUGGING mode. */ +PERLVARA(I, op_exec_cnt, OP_max+2, UV) /* Counts of executed OPs of the given + type. If PERL_TRACE_OPS is enabled, + we'll dump a summary count of all + ops executed in the program at + perl_destruct time. Used only for + profiling in DEBUGGING mode. */ #endif PERLVAR(I, random_state, PL_RANDOM_STATE_TYPE) PERLVARI(I, dump_re_max_len, STRLEN, 60) -/* For internal uses of randomness, this ensures the sequence of - * random numbers returned by rand() isn't modified by perl's internal - * use of randomness. +/* For internal uses of randomness, this ensures the sequence of random numbers + * returned by rand() isn't modified by perl's internal use of randomness. * This is important if the user has called srand() with a seed. */ @@ -1022,27 +1048,27 @@ PERLVAR(I, internal_random_state, PL_RANDOM_STATE_TYPE) PERLVARA(I, TR_SPECIAL_HANDLING_UTF8, UTF8_MAXBYTES, char) -PERLVAR(I, AboveLatin1, SV *) +PERLVAR(I, AboveLatin1, SV *) PERLVAR(I, Assigned_invlist, SV *) PERLVAR(I, GCB_invlist, SV *) PERLVAR(I, HasMultiCharFold, SV *) PERLVAR(I, InMultiCharFold, SV *) -PERLVAR(I, Latin1, SV *) +PERLVAR(I, Latin1, SV *) PERLVAR(I, LB_invlist, SV *) PERLVAR(I, SB_invlist, SV *) PERLVAR(I, SCX_invlist, SV *) -PERLVAR(I, UpperLatin1, SV *) /* Code points 128 - 255 */ +PERLVAR(I, UpperLatin1, SV *) /* Code points 128 - 255 */ PERLVARA(I, fold_locale, 256, U8) /* List of characters that participate in any fold defined by Unicode */ PERLVAR(I, in_some_fold, SV *) -/* Everything that folds to a given character, for case insensitivity regex - * matching */ +/* Everything that folds to a given character, + * for case insensitivity regex matching */ PERLVAR(I, utf8_foldclosures, SV *) -PERLVAR(I, utf8_idcont, SV *) +PERLVAR(I, utf8_idcont, SV *) PERLVAR(I, utf8_idstart, SV *) PERLVAR(I, utf8_perl_idcont, SV *) PERLVAR(I, utf8_perl_idstart, SV *) @@ -1054,14 +1080,14 @@ PERLVARA(I, Posix_ptrs, POSIX_CC_COUNT, SV *) PERLVAR(I, utf8_toupper, SV *) PERLVAR(I, utf8_totitle, SV *) PERLVAR(I, utf8_tolower, SV *) -PERLVAR(I, utf8_tofold, SV *) -PERLVAR(I, utf8_tosimplefold, SV *) +PERLVAR(I, utf8_tofold, SV *) +PERLVAR(I, utf8_tosimplefold, SV *) PERLVAR(I, utf8_charname_begin, SV *) PERLVAR(I, utf8_charname_continue, SV *) -PERLVAR(I, utf8_mark, SV *) -PERLVARI(I, InBitmap, SV *, NULL) -PERLVAR(I, CCC_non0_non230, SV *) -PERLVAR(I, Private_Use, SV *) +PERLVAR(I, utf8_mark, SV *) +PERLVARI(I, InBitmap, SV *, NULL) +PERLVAR(I, CCC_non0_non230, SV *) +PERLVAR(I, Private_Use, SV *) #ifdef HAS_MBRLEN PERLVAR(I, mbrlen_ps, mbstate_t) @@ -1073,24 +1099,23 @@ PERLVAR(I, mbrtowc_ps, mbstate_t) PERLVAR(I, wcrtomb_ps, mbstate_t) #endif #ifdef PERL_MEM_LOG -/* Enough space for the reserved byte, 1 for a potential leading 0, then enough - * for the longest representable integer plus an extra, the 3 flag characters, - * and NUL */ -#define PERL_MEM_LOG_ARYLEN (1 + 1 + TYPE_DIGITS(UV) + 1 + 3 + 1) +/* Enough space for the reserved byte, 1 for a potential + * leading 0, then enough for the longest representable integer + * plus an extra, the 3 flag characters, and NUL */ +#define PERL_MEM_LOG_ARYLEN (1 + 1 + TYPE_DIGITS(UV) + 1 + 3 + 1) PERLVARA(I, mem_log, PERL_MEM_LOG_ARYLEN, char) #endif /* The most recently seen `use VERSION` declaration, encoded in a single - * U16 as (major << 8) | minor. We do this rather than store an entire SV - * version object so we can fit the U16 into the uv of a SAVEHINTS and not - * have to worry about SV refcounts during scope enter/exit. */ + * U16 as (major << 8) | minor. We do this rather than store an entire + * SV version object so we can fit the U16 into the uv of a SAVEHINTS and + * not have to worry about SV refcounts during scope enter/exit. */ PERLVAR(I, prevailing_version, U16) /* If you are adding a U8 or U16, check to see if there are 'Space' comments - * above on where there are gaps which currently will be structure padding. */ + * above on where there are gaps which currently will be structure padding. */ /* Within a stable branch, new variables must be added to the very end, before * this comment, for binary compatibility (the offsets of the old members must - * not change). - * (Don't forget to add your variable also to perl_clone()!) + * not change). (Don't forget to add your variable also to perl_clone()!) */ diff --git a/invlist_inline.h b/invlist_inline.h index 8b28c2188528..957309e625e3 100644 --- a/invlist_inline.h +++ b/invlist_inline.h @@ -1,6 +1,7 @@ /* invlist_inline.h * - * Copyright (C) 2012 by Larry Wall and others + * Copyright (C) 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, + * 2021, 2022 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -9,22 +10,22 @@ #ifndef PERL_INVLIST_INLINE_H_ #define PERL_INVLIST_INLINE_H_ -#if defined(PERL_IN_UTF8_C) \ - || defined(PERL_IN_REGCOMP_ANY) \ - || defined(PERL_IN_REGEXEC_C) \ - || defined(PERL_IN_TOKE_C) \ - || defined(PERL_IN_PP_C) \ - || defined(PERL_IN_OP_C) \ - || defined(PERL_IN_DOOP_C) +#if defined(PERL_IN_UTF8_C) \ + || defined(PERL_IN_REGCOMP_ANY) \ + || defined(PERL_IN_REGEXEC_C) \ + || defined(PERL_IN_TOKE_C) \ + || defined(PERL_IN_PP_C) \ + || defined(PERL_IN_OP_C) \ + || defined(PERL_IN_DOOP_C) -/* An element is in an inversion list iff its index is even numbered: 0, 2, 4, - * etc */ +/* An element is in an inversion list iff its + * index is even numbered: 0, 2, 4, etc */ #define ELEMENT_RANGE_MATCHES_INVLIST(i) (! ((i) & 1)) -#define PREV_RANGE_MATCHES_INVLIST(i) (! ELEMENT_RANGE_MATCHES_INVLIST(i)) +#define PREV_RANGE_MATCHES_INVLIST(i) (! ELEMENT_RANGE_MATCHES_INVLIST(i)) /* This converts to/from our UVs to what the SV code is expecting: bytes. */ -#define TO_INTERNAL_SIZE(x) ((x) * sizeof(UV)) -#define FROM_INTERNAL_SIZE(x) ((x)/ sizeof(UV)) +#define TO_INTERNAL_SIZE(x) ((x) * sizeof(UV)) +#define FROM_INTERNAL_SIZE(x) ((x)/ sizeof(UV)) PERL_STATIC_INLINE bool S_is_invlist(const SV* const invlist) @@ -35,8 +36,8 @@ S_is_invlist(const SV* const invlist) PERL_STATIC_INLINE bool* S_get_invlist_offset_addr(SV* invlist) { - /* Return the address of the field that says whether the inversion list is - * offset (it contains 1) or not (contains 0) */ + /* Return the address of the field that says whether the inversion + * list is offset (it contains 1) or not (contains 0) */ PERL_ARGS_ASSERT_GET_INVLIST_OFFSET_ADDR; assert(is_invlist(invlist)); @@ -47,8 +48,8 @@ S_get_invlist_offset_addr(SV* invlist) PERL_STATIC_INLINE UV S__invlist_len(SV* const invlist) { - /* Returns the current number of elements stored in the inversion list's - * array */ + /* Returns the current number of elements stored + * in the inversion list's array */ PERL_ARGS_ASSERT__INVLIST_LEN; @@ -74,26 +75,28 @@ S__invlist_contains_cp(SV* const invlist, const UV cp) PERL_STATIC_INLINE UV* S_invlist_array(SV* const invlist) { - /* Returns the pointer to the inversion list's array. Every time the - * length changes, this needs to be called in case malloc or realloc moved - * it */ + /* Returns the pointer to the inversion list's array. + * Every time the length changes, this needs to be + * called in case malloc or realloc moved it */ PERL_ARGS_ASSERT_INVLIST_ARRAY; - /* Must not be empty. If these fail, you probably didn't check for - * being non-zero before trying to get the array */ + /* Must not be empty. If these fail, you probably didn't check + * for being non-zero before trying to get the array */ assert(_invlist_len(invlist)); - /* The very first element always contains zero, The array begins either - * there, or if the inversion list is offset, at the element after it. - * The offset header field determines which; it contains 0 or 1 to indicate - * how much additionally to add */ + /* The very first element always contains zero, The array begins + * either there, or if the inversion list is offset, at the + * element after it. The offset header field determines which; it + * contains 0 or 1 to indicate how much additionally to add */ assert(0 == *(SvPVX(invlist))); return ((UV *) SvPVX(invlist) + *get_invlist_offset_addr(invlist)); } #endif -#if defined(PERL_IN_REGCOMP_ANY) || defined(PERL_IN_OP_C) || defined(PERL_IN_DOOP_C) +#if defined(PERL_IN_REGCOMP_ANY) || \ + defined(PERL_IN_OP_C) || \ + defined(PERL_IN_DOOP_C) PERL_STATIC_INLINE void S_invlist_extend(pTHX_ SV* const invlist, const UV new_max) @@ -104,16 +107,16 @@ S_invlist_extend(pTHX_ SV* const invlist, const UV new_max) assert(SvTYPE(invlist) == SVt_INVLIST); - /* Add one to account for the zero element at the beginning which may not - * be counted by the calling parameters */ + /* Add one to account for the zero element at the beginning + * which may not be counted by the calling parameters */ SvGROW((SV *)invlist, TO_INTERNAL_SIZE(new_max + 1)); } PERL_STATIC_INLINE void S_invlist_set_len(pTHX_ SV* const invlist, const UV len, const bool offset) { - /* Sets the current number of elements stored in the inversion list. - * Updates SvCUR correspondingly */ + /* Sets the current number of elements stored in the inversion + * list. Updates SvCUR correspondingly */ PERL_UNUSED_CONTEXT; PERL_ARGS_ASSERT_INVLIST_SET_LEN; @@ -134,10 +137,10 @@ S_add_cp_to_invlist(pTHX_ SV* invlist, const UV cp) { PERL_STATIC_INLINE UV S_invlist_highest(SV* const invlist) { - /* Returns the highest code point that matches an inversion list. This API - * has an ambiguity, as it returns 0 under either the highest is actually - * 0, or if the list is empty. If this distinction matters to you, check - * for emptiness before calling this function */ + /* Returns the highest code point that matches an inversion list. This + * API has an ambiguity, as it returns 0 under either the highest is + * actually 0, or if the list is empty. If this distinction matters to + * you, check for emptiness before calling this function */ UV len = _invlist_len(invlist); UV *array; @@ -150,12 +153,12 @@ S_invlist_highest(SV* const invlist) array = invlist_array(invlist); - /* The last element in the array in the inversion list always starts a - * range that goes to infinity. That range may be for code points that are - * matched in the inversion list, or it may be for ones that aren't - * matched. In the latter case, the highest code point in the set is one - * less than the beginning of this range; otherwise it is the final element - * of this range: infinity */ + /* The last element in the array in the inversion list always starts + * a range that goes to infinity. That range may be for code points + * that are matched in the inversion list, or it may be for ones + * that aren't matched. In the latter case, the highest code point + * in the set is one less than the beginning of this range; + * otherwise it is the final element of this range: infinity */ return (ELEMENT_RANGE_MATCHES_INVLIST(len - 1)) ? UV_MAX : array[len - 1] - 1; @@ -166,11 +169,11 @@ S_invlist_highest(SV* const invlist) PERL_STATIC_INLINE UV S_invlist_highest_range_start(SV* const invlist) { - /* Returns the lowest code point of the highest range in the inversion - * list parameter. This API has an ambiguity: it returns 0 either when - * the lowest such point is actually 0 or when the list is empty. If this - * distinction matters to you, check for emptiness before calling this - * function. */ + /* Returns the lowest code point of the highest range in the + * inversion list parameter. This API has an ambiguity: it + * returns 0 either when the lowest such point is actually 0 or + * when the list is empty. If this distinction matters to you, + * check for emptiness before calling this function. */ UV len = _invlist_len(invlist); UV *array; @@ -183,13 +186,13 @@ S_invlist_highest_range_start(SV* const invlist) array = invlist_array(invlist); - /* The last element in the array in the inversion list always starts a - * range that goes to infinity. That range may be for code points that are - * matched in the inversion list, or it may be for ones that aren't - * matched. In the first case, the lowest code point in the matching range - * is that the one that started the range. If the other case, the final - * matching range begins at the next element down (which may be 0 in the - * edge case). */ + /* The last element in the array in the inversion list always starts + * a range that goes to infinity. That range may be for code points + * that are matched in the inversion list, or it may be for ones + * that aren't matched. In the first case, the lowest code point in + * the matching range is that the one that started the range. If + * the other case, the final matching range begins at the next + * element down (which may be 0 in the edge case). */ return (ELEMENT_RANGE_MATCHES_INVLIST(len - 1)) ? array[len - 1] : len == 1 @@ -204,8 +207,8 @@ S_invlist_highest_range_start(SV* const invlist) PERL_STATIC_INLINE STRLEN* S_get_invlist_iter_addr(SV* invlist) { - /* Return the address of the UV that contains the current iteration - * position */ + /* Return the address of the UV that contains + * the current iteration position */ PERL_ARGS_ASSERT_GET_INVLIST_ITER_ADDR; @@ -215,7 +218,7 @@ S_get_invlist_iter_addr(SV* invlist) } PERL_STATIC_INLINE void -S_invlist_iterinit(SV* invlist) /* Initialize iterator for invlist */ +S_invlist_iterinit(SV* invlist) /* Initialize iterator for invlist */ { PERL_ARGS_ASSERT_INVLIST_ITERINIT; @@ -225,13 +228,13 @@ S_invlist_iterinit(SV* invlist) /* Initialize iterator for invlist */ PERL_STATIC_INLINE void S_invlist_iterfinish(SV* invlist) { - /* Terminate iterator for invlist. This is to catch development errors. - * Any iteration that is interrupted before completed should call this - * function. Functions that add code points anywhere else but to the end - * of an inversion list assert that they are not in the middle of an - * iteration. If they were, the addition would make the iteration - * problematical: if the iteration hadn't reached the place where things - * were being added, it would be ok */ + /* Terminate iterator for invlist. This is to catch development + * errors. Any iteration that is interrupted before completed should + * call this function. Functions that add code points anywhere else + * but to the end of an inversion list assert that they are not in + * the middle of an iteration. If they were, the addition would make + * the iteration problematical: if the iteration hadn't reached the + * place where things were being added, it would be ok */ PERL_ARGS_ASSERT_INVLIST_ITERFINISH; @@ -255,7 +258,7 @@ S_invlist_iternext(SV* invlist, UV* start, UV* end) PERL_ARGS_ASSERT_INVLIST_ITERNEXT; if (*pos >= len) { - *pos = (STRLEN) UV_MAX; /* Force iterinit() to be required next time */ + *pos = (STRLEN) UV_MAX; /* Force iterinit() to be required next time */ return FALSE; } @@ -289,9 +292,9 @@ S_invlist_is_iterating(const SV* const invlist) { PERL_ARGS_ASSERT_INVLIST_IS_ITERATING; - /* get_invlist_iter_addr()'s sv is non-const only because it returns a - * value that can be used to modify the invlist, it doesn't modify the - * invlist itself */ + /* get_invlist_iter_addr()'s sv is non-const only because + * it returns a value that can be used to modify the + * invlist, it doesn't modify the invlist itself */ return *(get_invlist_iter_addr((SV*)invlist)) < (STRLEN) UV_MAX; } @@ -299,11 +302,11 @@ PERL_STATIC_INLINE SV * S_invlist_contents(pTHX_ SV* const invlist, const bool traditional_style) { - /* Get the contents of an inversion list into a string SV so that they can - * be printed out. If 'traditional_style' is TRUE, it uses the format - * traditionally done for debug tracing; otherwise it uses a format - * suitable for just copying to the output, with blanks between ranges and - * a dash between range components */ + /* Get the contents of an inversion list into a string SV so that + * they can be printed out. If 'traditional_style' is TRUE, it + * uses the format traditionally done for debug tracing; otherwise + * it uses a format suitable for just copying to the output, with + * blanks between ranges and a dash between range components */ UV start, end; SV* output; @@ -351,10 +354,10 @@ PERL_STATIC_INLINE UV S_invlist_lowest(SV* const invlist) { - /* Returns the lowest code point that matches an inversion list. This API - * has an ambiguity, as it returns 0 under either the lowest is actually - * 0, or if the list is empty. If this distinction matters to you, check - * for emptiness before calling this function */ + /* Returns the lowest code point that matches an inversion list. This + * API has an ambiguity, as it returns 0 under either the lowest is + * actually 0, or if the list is empty. If this distinction matters + * to you, check for emptiness before calling this function */ UV len = _invlist_len(invlist); UV *array; diff --git a/iperlsys.h b/iperlsys.h index 40ff8a310399..56de78738cc0 100644 --- a/iperlsys.h +++ b/iperlsys.h @@ -7,7 +7,7 @@ * #defined to the system-level function (or a wrapper provided elsewhere). * * GSAR 21-JUN-98 - */ +*/ #ifndef __Inc__IPerl___ #define __Inc__IPerl___ @@ -15,33 +15,25 @@ /* * PerlXXX_YYY explained - DickH and DougL @ ActiveState.com * - * XXX := functional group - * YYY := stdlib/OS function name + * XXX := functional group YYY := stdlib/OS function name * * Continuing with the theme of PerlIO, all OS functionality was encapsulated * into one of several interfaces. * - * PerlIO - stdio - * PerlLIO - low level I/O - * PerlMem - malloc, realloc, free - * PerlDir - directory related - * PerlEnv - process environment handling - * PerlProc - process control - * PerlSock - socket functions - * + * PerlIO - stdio PerlLIO - low level I/O PerlMem - malloc, realloc, free + * PerlDir - directory related PerlEnv - process environment handling PerlProc + * - process control PerlSock - socket functions * - * The features of this are: - * 1. All OS dependant code is in the Perl Host and not the Perl Core. - * (At least this is the holy grail goal of this work) - * 2. The Perl Host (see perl.h for description) can provide a new and - * improved interface to OS functionality if required. - * 3. Developers can easily hook into the OS calls for instrumentation - * or diagnostic purposes. * - * What was changed to do this: - * 1. All calls to OS functions were replaced with PerlXXX_YYY + * The features of this are: 1. All OS dependant code is in the Perl Host and + * not the Perl Core. (At least this is the holy grail goal of this work) 2. + * The Perl Host (see perl.h for description) can provide a new and improved + * interface to OS functionality if required. 3. Developers can easily hook + * into the OS calls for instrumentation or diagnostic purposes. * - */ + * What was changed to do this: 1. All calls to OS functions were replaced + * with PerlXXX_YYY +*/ /* Interface for perl stdio functions, or whatever we are Configure-d @@ -63,7 +55,7 @@ typedef Sighandler1_t Sighandler_t; #if defined(PERL_IMPLICIT_SYS) -/* IPerlStdIO */ +/* IPerlStdIO */ struct IPerlStdIO; struct IPerlStdIOInfo; typedef FILE* (*LPStdin)(struct IPerlStdIO*); @@ -166,12 +158,12 @@ struct IPerlStdIOInfo /* These do not belong here ... NI-S, 14 Nov 2000 */ # ifdef USE_STDIO_PTR -# define PerlSIO_has_cntptr(f) 1 +# define PerlSIO_has_cntptr(f) 1 # ifdef STDIO_PTR_LVALUE # ifdef STDIO_CNT_LVALUE # define PerlSIO_canset_cnt(f) 1 # ifdef STDIO_PTR_LVAL_NOCHANGE_CNT -# define PerlSIO_fast_gets(f) 1 +# define PerlSIO_fast_gets(f) 1 # endif # else /* STDIO_CNT_LVALUE */ # define PerlSIO_canset_cnt(f) 0 @@ -182,189 +174,192 @@ struct IPerlStdIOInfo # endif # endif # else /* USE_STDIO_PTR */ -# define PerlSIO_has_cntptr(f) 0 -# define PerlSIO_canset_cnt(f) 0 +# define PerlSIO_has_cntptr(f) 0 +# define PerlSIO_canset_cnt(f) 0 # endif /* USE_STDIO_PTR */ # ifndef PerlSIO_fast_gets -# define PerlSIO_fast_gets(f) 0 +# define PerlSIO_fast_gets(f) 0 # endif # ifdef FILE_base -# define PerlSIO_has_base(f) 1 +# define PerlSIO_has_base(f) 1 # else -# define PerlSIO_has_base(f) 0 +# define PerlSIO_has_base(f) 0 # endif /* Now take FILE * via function table */ -# define PerlSIO_stdin \ - (*PL_StdIO->pStdin)(PL_StdIO) -# define PerlSIO_stdout \ - (*PL_StdIO->pStdout)(PL_StdIO) -# define PerlSIO_stderr \ - (*PL_StdIO->pStderr)(PL_StdIO) -# define PerlSIO_fopen(x,y) \ - (*PL_StdIO->pOpen)(PL_StdIO, (x),(y)) -# define PerlSIO_fclose(f) \ - (*PL_StdIO->pClose)(PL_StdIO, (f)) -# define PerlSIO_feof(f) \ - (*PL_StdIO->pEof)(PL_StdIO, (f)) -# define PerlSIO_ferror(f) \ - (*PL_StdIO->pError)(PL_StdIO, (f)) -# define PerlSIO_clearerr(f) \ - (*PL_StdIO->pClearerr)(PL_StdIO, (f)) -# define PerlSIO_fgetc(f) \ - (*PL_StdIO->pGetc)(PL_StdIO, (f)) -# define PerlSIO_get_base(f) \ - (*PL_StdIO->pGetBase)(PL_StdIO, (f)) -# define PerlSIO_get_bufsiz(f) \ - (*PL_StdIO->pGetBufsiz)(PL_StdIO, (f)) -# define PerlSIO_get_cnt(f) \ - (*PL_StdIO->pGetCnt)(PL_StdIO, (f)) -# define PerlSIO_get_ptr(f) \ - (*PL_StdIO->pGetPtr)(PL_StdIO, (f)) -# define PerlSIO_fputc(c,f) \ - (*PL_StdIO->pPutc)(PL_StdIO, (c),(f)) -# define PerlSIO_fputs(s,f) \ - (*PL_StdIO->pPuts)(PL_StdIO, (s),(f)) -# define PerlSIO_fflush(f) \ - (*PL_StdIO->pFlush)(PL_StdIO, (f)) -# define PerlSIO_fgets(s, n, f) \ - (*PL_StdIO->pGets)(PL_StdIO, s, n, (f)) -# define PerlSIO_ungetc(c,f) \ - (*PL_StdIO->pUngetc)(PL_StdIO, (c),(f)) -# define PerlSIO_fileno(f) \ - (*PL_StdIO->pFileno)(PL_StdIO, (f)) -# define PerlSIO_fdopen(f, s) \ - (*PL_StdIO->pFdopen)(PL_StdIO, (f),(s)) -# define PerlSIO_freopen(p, m, f) \ - (*PL_StdIO->pReopen)(PL_StdIO, (p), (m), (f)) -# define PerlSIO_fread(buf,sz,count,f) \ - (*PL_StdIO->pRead)(PL_StdIO, (buf), (sz), (count), (f)) -# define PerlSIO_fwrite(buf,sz,count,f) \ - (*PL_StdIO->pWrite)(PL_StdIO, (buf), (sz), (count), (f)) -# define PerlSIO_setbuf(f,b) \ - (*PL_StdIO->pSetBuf)(PL_StdIO, (f), (b)) -# define PerlSIO_setvbuf(f,b,t,s) \ - (*PL_StdIO->pSetVBuf)(PL_StdIO, (f),(b),(t),(s)) -# define PerlSIO_set_cnt(f,c) \ - (*PL_StdIO->pSetCnt)(PL_StdIO, (f), (c)) -# define PerlSIO_set_ptr(f,p) \ - (*PL_StdIO->pSetPtr)(PL_StdIO, (f), (p)) -# define PerlSIO_setlinebuf(f) \ - (*PL_StdIO->pSetlinebuf)(PL_StdIO, (f)) -# define PerlSIO_printf Perl_fprintf_nocontext -# define PerlSIO_stdoutf Perl_printf_nocontext -# define PerlSIO_vprintf(f,fmt,a) \ - (*PL_StdIO->pVprintf)(PL_StdIO, (f),(fmt),a) -# define PerlSIO_ftell(f) \ - (*PL_StdIO->pTell)(PL_StdIO, (f)) -# define PerlSIO_fseek(f,o,w) \ - (*PL_StdIO->pSeek)(PL_StdIO, (f),(o),(w)) -# define PerlSIO_fgetpos(f,p) \ - (*PL_StdIO->pGetpos)(PL_StdIO, (f),(p)) -# define PerlSIO_fsetpos(f,p) \ - (*PL_StdIO->pSetpos)(PL_StdIO, (f),(p)) -# define PerlSIO_rewind(f) \ - (*PL_StdIO->pRewind)(PL_StdIO, (f)) -# define PerlSIO_tmpfile() \ - (*PL_StdIO->pTmpfile)(PL_StdIO) -# define PerlSIO_init() \ - (*PL_StdIO->pInit)(PL_StdIO) +# define PerlSIO_stdin \ + (*PL_StdIO->pStdin)(PL_StdIO) +# define PerlSIO_stdout \ + (*PL_StdIO->pStdout)(PL_StdIO) +# define PerlSIO_stderr \ + (*PL_StdIO->pStderr)(PL_StdIO) +# define PerlSIO_fopen(x,y) \ + (*PL_StdIO->pOpen)(PL_StdIO, (x),(y)) +# define PerlSIO_fclose(f) \ + (*PL_StdIO->pClose)(PL_StdIO, (f)) +# define PerlSIO_feof(f) \ + (*PL_StdIO->pEof)(PL_StdIO, (f)) +# define PerlSIO_ferror(f) \ + (*PL_StdIO->pError)(PL_StdIO, (f)) +# define PerlSIO_clearerr(f) \ + (*PL_StdIO->pClearerr)(PL_StdIO, (f)) +# define PerlSIO_fgetc(f) \ + (*PL_StdIO->pGetc)(PL_StdIO, (f)) +# define PerlSIO_get_base(f) \ + (*PL_StdIO->pGetBase)(PL_StdIO, (f)) +# define PerlSIO_get_bufsiz(f) \ + (*PL_StdIO->pGetBufsiz)(PL_StdIO, (f)) +# define PerlSIO_get_cnt(f) \ + (*PL_StdIO->pGetCnt)(PL_StdIO, (f)) +# define PerlSIO_get_ptr(f) \ + (*PL_StdIO->pGetPtr)(PL_StdIO, (f)) +# define PerlSIO_fputc(c,f) \ + (*PL_StdIO->pPutc)(PL_StdIO, (c),(f)) +# define PerlSIO_fputs(s,f) \ + (*PL_StdIO->pPuts)(PL_StdIO, (s),(f)) +# define PerlSIO_fflush(f) \ + (*PL_StdIO->pFlush)(PL_StdIO, (f)) +# define PerlSIO_fgets(s, n, f) \ + (*PL_StdIO->pGets)(PL_StdIO, s, n, (f)) +# define PerlSIO_ungetc(c,f) \ + (*PL_StdIO->pUngetc)(PL_StdIO, (c),(f)) +# define PerlSIO_fileno(f) \ + (*PL_StdIO->pFileno)(PL_StdIO, (f)) +# define PerlSIO_fdopen(f, s) \ + (*PL_StdIO->pFdopen)(PL_StdIO, (f),(s)) +# define PerlSIO_freopen(p, m, f) \ + (*PL_StdIO->pReopen)(PL_StdIO, (p), (m), (f)) +# define PerlSIO_fread(buf,sz,count,f) \ + (*PL_StdIO->pRead)(PL_StdIO, (buf), (sz), (count), (f)) +# define PerlSIO_fwrite(buf,sz,count,f) \ + (*PL_StdIO->pWrite)(PL_StdIO, (buf), (sz), (count), (f)) +# define PerlSIO_setbuf(f,b) \ + (*PL_StdIO->pSetBuf)(PL_StdIO, (f), (b)) +# define PerlSIO_setvbuf(f,b,t,s) \ + (*PL_StdIO->pSetVBuf)(PL_StdIO, (f),(b),(t),(s)) +# define PerlSIO_set_cnt(f,c) \ + (*PL_StdIO->pSetCnt)(PL_StdIO, (f), (c)) +# define PerlSIO_set_ptr(f,p) \ + (*PL_StdIO->pSetPtr)(PL_StdIO, (f), (p)) +# define PerlSIO_setlinebuf(f) \ + (*PL_StdIO->pSetlinebuf)(PL_StdIO, (f)) +# define PerlSIO_printf Perl_fprintf_nocontext +# define PerlSIO_stdoutf Perl_printf_nocontext +# define PerlSIO_vprintf(f,fmt,a) \ + (*PL_StdIO->pVprintf)(PL_StdIO, (f),(fmt),a) +# define PerlSIO_ftell(f) \ + (*PL_StdIO->pTell)(PL_StdIO, (f)) +# define PerlSIO_fseek(f,o,w) \ + (*PL_StdIO->pSeek)(PL_StdIO, (f),(o),(w)) +# define PerlSIO_fgetpos(f,p) \ + (*PL_StdIO->pGetpos)(PL_StdIO, (f),(p)) +# define PerlSIO_fsetpos(f,p) \ + (*PL_StdIO->pSetpos)(PL_StdIO, (f),(p)) +# define PerlSIO_rewind(f) \ + (*PL_StdIO->pRewind)(PL_StdIO, (f)) +# define PerlSIO_tmpfile() \ + (*PL_StdIO->pTmpfile)(PL_StdIO) +# define PerlSIO_init() \ + (*PL_StdIO->pInit)(PL_StdIO) # undef init_os_extras -# define init_os_extras() \ - (*PL_StdIO->pInitOSExtras)(PL_StdIO) -# define PerlSIO_fdupopen(f) \ - (*PL_StdIO->pFdupopen)(PL_StdIO, (f)) +# define init_os_extras() \ + (*PL_StdIO->pInitOSExtras)(PL_StdIO) +# define PerlSIO_fdupopen(f) \ + (*PL_StdIO->pFdupopen)(PL_StdIO, (f)) #else /* ! PERL_IMPLICIT_SYS */ -# define PerlSIO_stdin stdin -# define PerlSIO_stdout stdout -# define PerlSIO_stderr stderr -# define PerlSIO_fopen(x,y) fopen(x,y) +# define PerlSIO_stdin stdin +# define PerlSIO_stdout stdout +# define PerlSIO_stderr stderr +# define PerlSIO_fopen(x,y) fopen(x,y) # ifdef __VOS__ - /* Work around VOS bug posix-979, wrongly setting errno when at end of file. */ -# define PerlSIO_fclose(f) (((errno==1025)?errno=0:0),fclose(f)) -# define PerlSIO_feof(f) (((errno==1025)?errno=0:0),feof(f)) -# define PerlSIO_ferror(f) (((errno==1025)?errno=0:0),ferror(f)) + /* Work around VOS bug posix-979, wrongly setting + errno when at end of file. */ +# define PerlSIO_fclose(f) (((errno==1025)?errno=0:0),fclose(f)) +# define PerlSIO_feof(f) \ + (((errno==1025)?errno=0:0),feof(f)) +# define PerlSIO_ferror(f) (((errno==1025)?errno=0:0),ferror(f)) # else -# define PerlSIO_fclose(f) fclose(f) -# define PerlSIO_feof(f) feof(f) -# define PerlSIO_ferror(f) ferror(f) +# define PerlSIO_fclose(f) fclose(f) +# define PerlSIO_feof(f) feof(f) +# define PerlSIO_ferror(f) ferror(f) # endif -# define PerlSIO_clearerr(f) clearerr(f) -# define PerlSIO_fgetc(f) fgetc(f) +# define PerlSIO_clearerr(f) clearerr(f) +# define PerlSIO_fgetc(f) fgetc(f) # ifdef FILE_base -# define PerlSIO_get_base(f) FILE_base(f) -# define PerlSIO_get_bufsiz(f) FILE_bufsiz(f) +# define PerlSIO_get_base(f) FILE_base(f) +# define PerlSIO_get_bufsiz(f) FILE_bufsiz(f) # else -# define PerlSIO_get_base(f) NULL -# define PerlSIO_get_bufsiz(f) 0 +# define PerlSIO_get_base(f) NULL +# define PerlSIO_get_bufsiz(f) 0 # endif # ifdef USE_STDIO_PTR -# define PerlSIO_get_cnt(f) FILE_cnt(f) -# define PerlSIO_get_ptr(f) FILE_ptr(f) +# define PerlSIO_get_cnt(f) FILE_cnt(f) +# define PerlSIO_get_ptr(f) FILE_ptr(f) # else -# define PerlSIO_get_cnt(f) 0 -# define PerlSIO_get_ptr(f) NULL +# define PerlSIO_get_cnt(f) 0 +# define PerlSIO_get_ptr(f) NULL # endif -# define PerlSIO_fputc(c,f) fputc(c,f) -# define PerlSIO_fputs(s,f) fputs(s,f) -# define PerlSIO_fflush(f) Fflush(f) -# define PerlSIO_fgets(s, n, f) fgets(s,n,f) +# define PerlSIO_fputc(c,f) fputc(c,f) +# define PerlSIO_fputs(s,f) fputs(s,f) +# define PerlSIO_fflush(f) Fflush(f) +# define PerlSIO_fgets(s, n, f) fgets(s,n,f) # if defined(__VMS) /* Unusual definition of ungetc() here to accommodate fast_sv_gets()' * belief that it can mix getc/ungetc with reads from stdio buffer */ START_EXTERN_C int decc$ungetc(int __c, FILE *__stream); END_EXTERN_C -# define PerlSIO_ungetc(c,f) ((c) == EOF ? EOF : \ - ((*(f) && !((*(f))->_flag & _IONBF) && \ - ((*(f))->_ptr > (*(f))->_base)) ? \ - ((*(f))->_cnt++, *(--(*(f))->_ptr) = (c)) : decc$ungetc(c,f))) +# define PerlSIO_ungetc(c,f) \ + ((c) == EOF ? EOF : \ + ((*(f) && !((*(f))->_flag & _IONBF) && \ + ((*(f))->_ptr > (*(f))->_base)) ? \ + ((*(f))->_cnt++, *(--(*(f))->_ptr) = (c)) : decc$ungetc(c,f))) # else -# define PerlSIO_ungetc(c,f) ungetc(c,f) +# define PerlSIO_ungetc(c,f) ungetc(c,f) # endif -# define PerlSIO_fileno(f) fileno(f) -# define PerlSIO_fdopen(f, s) fdopen(f,s) -# define PerlSIO_freopen(p, m, f) freopen(p,m,f) -# define PerlSIO_fread(buf,sz,count,f) fread(buf,sz,count,f) -# define PerlSIO_fwrite(buf,sz,count,f) fwrite(buf,sz,count,f) -# define PerlSIO_setbuf(f,b) setbuf(f,b) -# define PerlSIO_setvbuf(f,b,t,s) setvbuf(f,b,t,s) +# define PerlSIO_fileno(f) fileno(f) +# define PerlSIO_fdopen(f, s) fdopen(f,s) +# define PerlSIO_freopen(p, m, f) freopen(p,m,f) +# define PerlSIO_fread(buf,sz,count,f) fread(buf,sz,count,f) +# define PerlSIO_fwrite(buf,sz,count,f) fwrite(buf,sz,count,f) +# define PerlSIO_setbuf(f,b) setbuf(f,b) +# define PerlSIO_setvbuf(f,b,t,s) setvbuf(f,b,t,s) # if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE) -# define PerlSIO_set_cnt(f,c) FILE_cnt(f) = (c) +# define PerlSIO_set_cnt(f,c) FILE_cnt(f) = (c) # else -# define PerlSIO_set_cnt(f,c) PerlIOProc_abort() +# define PerlSIO_set_cnt(f,c) PerlIOProc_abort() # endif # if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) -# define PerlSIO_set_ptr(f,p) (FILE_ptr(f) = (p)) +# define PerlSIO_set_ptr(f,p) (FILE_ptr(f) = (p)) # else -# define PerlSIO_set_ptr(f,p) PerlIOProc_abort() +# define PerlSIO_set_ptr(f,p) PerlIOProc_abort() # endif -# define PerlSIO_setlinebuf(f) setlinebuf(f) -# define PerlSIO_printf fprintf -# define PerlSIO_stdoutf printf -# define PerlSIO_vprintf(f,fmt,a) vfprintf(f,fmt,a) -# define PerlSIO_ftell(f) ftell(f) -# define PerlSIO_fseek(f,o,w) fseek(f,o,w) -# define PerlSIO_fgetpos(f,p) fgetpos(f,p) -# define PerlSIO_fsetpos(f,p) fsetpos(f,p) -# define PerlSIO_rewind(f) rewind(f) -# define PerlSIO_tmpfile() tmpfile() -# define PerlSIO_fdupopen(f) (f) +# define PerlSIO_setlinebuf(f) setlinebuf(f) +# define PerlSIO_printf fprintf +# define PerlSIO_stdoutf printf +# define PerlSIO_vprintf(f,fmt,a) vfprintf(f,fmt,a) +# define PerlSIO_ftell(f) ftell(f) +# define PerlSIO_fseek(f,o,w) fseek(f,o,w) +# define PerlSIO_fgetpos(f,p) fgetpos(f,p) +# define PerlSIO_fsetpos(f,p) fsetpos(f,p) +# define PerlSIO_rewind(f) rewind(f) +# define PerlSIO_tmpfile() tmpfile() +# define PerlSIO_fdupopen(f) (f) #endif /* PERL_IMPLICIT_SYS */ /* * Interface for directory functions - */ +*/ #if defined(PERL_IMPLICIT_SYS) -/* IPerlDir */ +/* IPerlDir */ struct IPerlDir; struct IPerlDirInfo; typedef int (*LPMakedir)(struct IPerlDir*, const char*, int); @@ -404,49 +399,49 @@ struct IPerlDirInfo struct IPerlDir perlDirList; }; -# define PerlDir_mkdir(name, mode) \ - (*PL_Dir->pMakedir)(PL_Dir, (name), (mode)) -# define PerlDir_chdir(name) \ - (*PL_Dir->pChdir)(PL_Dir, (name)) -# define PerlDir_rmdir(name) \ - (*PL_Dir->pRmdir)(PL_Dir, (name)) -# define PerlDir_close(dir) \ - (*PL_Dir->pClose)(PL_Dir, (dir)) -# define PerlDir_open(name) \ - (*PL_Dir->pOpen)(PL_Dir, (name)) -# define PerlDir_read(dir) \ - (*PL_Dir->pRead)(PL_Dir, (dir)) -# define PerlDir_rewind(dir) \ - (*PL_Dir->pRewind)(PL_Dir, (dir)) -# define PerlDir_seek(dir, loc) \ - (*PL_Dir->pSeek)(PL_Dir, (dir), (loc)) -# define PerlDir_tell(dir) \ - (*PL_Dir->pTell)(PL_Dir, (dir)) +# define PerlDir_mkdir(name, mode) \ + (*PL_Dir->pMakedir)(PL_Dir, (name), (mode)) +# define PerlDir_chdir(name) \ + (*PL_Dir->pChdir)(PL_Dir, (name)) +# define PerlDir_rmdir(name) \ + (*PL_Dir->pRmdir)(PL_Dir, (name)) +# define PerlDir_close(dir) \ + (*PL_Dir->pClose)(PL_Dir, (dir)) +# define PerlDir_open(name) \ + (*PL_Dir->pOpen)(PL_Dir, (name)) +# define PerlDir_read(dir) \ + (*PL_Dir->pRead)(PL_Dir, (dir)) +# define PerlDir_rewind(dir) \ + (*PL_Dir->pRewind)(PL_Dir, (dir)) +# define PerlDir_seek(dir, loc) \ + (*PL_Dir->pSeek)(PL_Dir, (dir), (loc)) +# define PerlDir_tell(dir) \ + (*PL_Dir->pTell)(PL_Dir, (dir)) # ifdef WIN32 -# define PerlDir_mapA(dir) \ - (*PL_Dir->pMapPathA)(PL_Dir, (dir)) -# define PerlDir_mapW(dir) \ - (*PL_Dir->pMapPathW)(PL_Dir, (dir)) +# define PerlDir_mapA(dir) \ + (*PL_Dir->pMapPathA)(PL_Dir, (dir)) +# define PerlDir_mapW(dir) \ + (*PL_Dir->pMapPathW)(PL_Dir, (dir)) # endif # else /* ! PERL_IMPLICIT_SYS */ -# define PerlDir_mkdir(name, mode) Mkdir((name), (mode)) +# define PerlDir_mkdir(name, mode) Mkdir((name), (mode)) # ifdef VMS -# define PerlDir_chdir(n) Chdir((n)) +# define PerlDir_chdir(n) Chdir((n)) # else -# define PerlDir_chdir(name) chdir((name)) +# define PerlDir_chdir(name) chdir((name)) # endif -# define PerlDir_rmdir(name) rmdir((name)) -# define PerlDir_close(dir) closedir((dir)) -# define PerlDir_open(name) opendir((name)) -# define PerlDir_read(dir) readdir((dir)) -# define PerlDir_rewind(dir) rewinddir((dir)) -# define PerlDir_seek(dir, loc) seekdir((dir), (loc)) -# define PerlDir_tell(dir) telldir((dir)) +# define PerlDir_rmdir(name) rmdir((name)) +# define PerlDir_close(dir) closedir((dir)) +# define PerlDir_open(name) opendir((name)) +# define PerlDir_read(dir) readdir((dir)) +# define PerlDir_rewind(dir) rewinddir((dir)) +# define PerlDir_seek(dir, loc) seekdir((dir), (loc)) +# define PerlDir_tell(dir) telldir((dir)) # ifdef WIN32 -# define PerlDir_mapA(dir) dir -# define PerlDir_mapW(dir) dir +# define PerlDir_mapA(dir) dir +# define PerlDir_mapW(dir) dir # endif #endif /* PERL_IMPLICIT_SYS */ @@ -457,7 +452,7 @@ struct IPerlDirInfo #if defined(PERL_IMPLICIT_SYS) -/* IPerlEnv */ +/* IPerlEnv */ struct IPerlEnv; struct IPerlEnvInfo; typedef char* (*LPEnvGetenv)(struct IPerlEnv*, const char*); @@ -516,82 +511,84 @@ struct IPerlEnvInfo struct IPerlEnv perlEnvList; }; -# define PerlEnv_putenv(str) \ - (*PL_Env->pPutenv)(PL_Env,(str)) -# define PerlEnv_getenv(str) \ - (*PL_Env->pGetenv)(PL_Env,(str)) -# define PerlEnv_getenv_len(str,l) \ - (*PL_Env->pGetenv_len)(PL_Env,(str), (l)) -# define PerlEnv_clearenv() \ - (*PL_Env->pClearenv)(PL_Env) -# define PerlEnv_get_childenv() \ - (*PL_Env->pGetChildenv)(PL_Env) -# define PerlEnv_free_childenv(e) \ - (*PL_Env->pFreeChildenv)(PL_Env, (e)) -# define PerlEnv_get_childdir() \ - (*PL_Env->pGetChilddir)(PL_Env) -# define PerlEnv_free_childdir(d) \ - (*PL_Env->pFreeChilddir)(PL_Env, (d)) +# define PerlEnv_putenv(str) \ + (*PL_Env->pPutenv)(PL_Env,(str)) +# define PerlEnv_getenv(str) \ + (*PL_Env->pGetenv)(PL_Env,(str)) +# define PerlEnv_getenv_len(str,l) \ + (*PL_Env->pGetenv_len)(PL_Env,(str), (l)) +# define PerlEnv_clearenv() \ + (*PL_Env->pClearenv)(PL_Env) +# define PerlEnv_get_childenv() \ + (*PL_Env->pGetChildenv)(PL_Env) +# define PerlEnv_free_childenv(e) \ + (*PL_Env->pFreeChildenv)(PL_Env, (e)) +# define PerlEnv_get_childdir() \ + (*PL_Env->pGetChilddir)(PL_Env) +# define PerlEnv_free_childdir(d) \ + (*PL_Env->pFreeChilddir)(PL_Env, (d)) # ifdef HAS_ENVGETENV -# define PerlEnv_ENVgetenv(str) \ - (*PL_Env->pENVGetenv)(PL_Env,(str)) -# define PerlEnv_ENVgetenv_len(str,l) \ - (*PL_Env->pENVGetenv_len)(PL_Env,(str), (l)) +# define PerlEnv_ENVgetenv(str) \ + (*PL_Env->pENVGetenv)(PL_Env,(str)) +# define PerlEnv_ENVgetenv_len(str,l) \ + (*PL_Env->pENVGetenv_len)(PL_Env,(str), (l)) # else -# define PerlEnv_ENVgetenv(str) \ - PerlEnv_getenv((str)) -# define PerlEnv_ENVgetenv_len(str,l) \ - PerlEnv_getenv_len((str),(l)) +# define PerlEnv_ENVgetenv(str) \ + PerlEnv_getenv((str)) +# define PerlEnv_ENVgetenv_len(str,l) \ + PerlEnv_getenv_len((str),(l)) # endif -# define PerlEnv_uname(name) \ - (*PL_Env->pEnvUname)(PL_Env,(name)) +# define PerlEnv_uname(name) \ + (*PL_Env->pEnvUname)(PL_Env,(name)) # ifdef WIN32 -# define PerlEnv_os_id() \ - (*PL_Env->pEnvOsID)(PL_Env) -# define PerlEnv_lib_path(str, lenp) \ - (*PL_Env->pLibPath)(PL_Env,WIN32_NO_REGISTRY_M_(str)(lenp)) -# define PerlEnv_sitelib_path(str, lenp) \ - (*PL_Env->pSiteLibPath)(PL_Env,(str),(lenp)) -# define PerlEnv_vendorlib_path(str, lenp) \ - (*PL_Env->pVendorLibPath)(PL_Env,(str),(lenp)) -# define PerlEnv_get_child_IO(ptr) \ - (*PL_Env->pGetChildIO)(PL_Env, ptr) +# define PerlEnv_os_id() \ + (*PL_Env->pEnvOsID)(PL_Env) +# define PerlEnv_lib_path(str, lenp) \ + (*PL_Env->pLibPath)(PL_Env,WIN32_NO_REGISTRY_M_(str)(lenp)) +# define PerlEnv_sitelib_path(str, lenp) \ + (*PL_Env->pSiteLibPath)(PL_Env,(str),(lenp)) +# define PerlEnv_vendorlib_path(str, lenp) \ + (*PL_Env->pVendorLibPath)(PL_Env,(str),(lenp)) +# define PerlEnv_get_child_IO(ptr) \ + (*PL_Env->pGetChildIO)(PL_Env, ptr) # endif #else /* below is ! PERL_IMPLICIT_SYS */ # ifndef USE_ITHREADS /* Threaded is an inline function in inline.h */ -# define PerlEnv_putenv(str) putenv(str) +# define PerlEnv_putenv(str) putenv(str) # endif -# define PerlEnv_getenv(str) mortal_getenv(str) -# define PerlEnv_getenv_len(str,l) getenv_len((str), (l)) +# define PerlEnv_getenv(str) mortal_getenv(str) +# define PerlEnv_getenv_len(str,l) getenv_len((str), (l)) # ifdef HAS_ENVGETENV -# define PerlEnv_ENVgetenv(str) ENVgetenv((str)) -# define PerlEnv_ENVgetenv_len(str,l) ENVgetenv_len((str), (l)) +# define PerlEnv_ENVgetenv(str) ENVgetenv((str)) +# define PerlEnv_ENVgetenv_len(str,l) ENVgetenv_len((str), (l)) # else -# define PerlEnv_ENVgetenv(str) PerlEnv_getenv((str)) -# define PerlEnv_ENVgetenv_len(str,l) PerlEnv_getenv_len((str), (l)) +# define PerlEnv_ENVgetenv(str) PerlEnv_getenv((str)) +# define PerlEnv_ENVgetenv_len(str,l) PerlEnv_getenv_len((str), (l)) # endif -# define PerlEnv_uname(name) uname((name)) +# define PerlEnv_uname(name) uname((name)) # ifdef WIN32 -# define PerlEnv_os_id() win32_os_id() -# define PerlEnv_lib_path(str, lenp) win32_get_privlib(WIN32_NO_REGISTRY_M_(str) lenp) -# define PerlEnv_sitelib_path(str, lenp) win32_get_sitelib(str, lenp) -# define PerlEnv_vendorlib_path(str, lenp) win32_get_vendorlib(str, lenp) -# define PerlEnv_get_child_IO(ptr) win32_get_child_IO(ptr) -# define PerlEnv_clearenv() win32_clearenv() -# define PerlEnv_get_childenv() win32_get_childenv() -# define PerlEnv_free_childenv(e) win32_free_childenv((e)) -# define PerlEnv_get_childdir() win32_get_childdir() -# define PerlEnv_free_childdir(d) win32_free_childdir((d)) +# define PerlEnv_os_id() win32_os_id() +# define PerlEnv_lib_path(str, lenp) \ + win32_get_privlib(WIN32_NO_REGISTRY_M_(str) lenp) +# define PerlEnv_sitelib_path(str, lenp) win32_get_sitelib(str, lenp) +# define PerlEnv_vendorlib_path(str, lenp) win32_get_vendorlib(str, lenp) +# define PerlEnv_get_child_IO(ptr) win32_get_child_IO(ptr) +# define PerlEnv_clearenv() win32_clearenv() +# define PerlEnv_get_childenv() win32_get_childenv() +# define PerlEnv_free_childenv(e) win32_free_childenv((e)) +# define PerlEnv_get_childdir() win32_get_childdir() +# define PerlEnv_free_childdir(d) win32_free_childdir((d)) # else -# define PerlEnv_clearenv(str) (ENV_LOCK, (clearenv(str) \ - ? (ENV_UNLOCK, 1) \ - : (ENV_UNLOCK, 0))) -# define PerlEnv_get_childenv() get_childenv() -# define PerlEnv_free_childenv(e) free_childenv((e)) -# define PerlEnv_get_childdir() get_childdir() -# define PerlEnv_free_childdir(d) free_childdir((d)) +# define PerlEnv_clearenv(str) \ + (ENV_LOCK, (clearenv(str) \ + ? (ENV_UNLOCK, 1) \ + : (ENV_UNLOCK, 0))) +# define PerlEnv_get_childenv() get_childenv() +# define PerlEnv_free_childenv(e) free_childenv((e)) +# define PerlEnv_get_childdir() get_childdir() +# define PerlEnv_free_childdir(d) free_childdir((d)) # endif #endif /* PERL_IMPLICIT_SYS */ @@ -604,7 +601,7 @@ struct IPerlEnvInfo struct utimbuf; /* prevent gcc warning about the use below */ -/* IPerlLIO */ +/* IPerlLIO */ struct IPerlLIO; struct IPerlLIOInfo; typedef int (*LPLIOAccess)(struct IPerlLIO*, const char*, int); @@ -626,8 +623,8 @@ typedef Off_t (*LPLIOLseek)(struct IPerlLIO*, int, Off_t, int); typedef int (*LPLIOLstat)(struct IPerlLIO*, const char*, Stat_t*); typedef char* (*LPLIOMktemp)(struct IPerlLIO*, char*); -typedef int (*LPLIOOpen)(struct IPerlLIO*, const char*, int); -typedef int (*LPLIOOpen3)(struct IPerlLIO*, const char*, int, int); +typedef int (*LPLIOOpen)(struct IPerlLIO*, const char*, int); +typedef int (*LPLIOOpen3)(struct IPerlLIO*, const char*, int, int); typedef int (*LPLIORead)(struct IPerlLIO*, int, void*, unsigned int); typedef int (*LPLIORename)(struct IPerlLIO*, const char*, const char*); @@ -683,116 +680,118 @@ struct IPerlLIOInfo struct IPerlLIO perlLIOList; }; -# define PerlLIO_access(file, mode) \ - (*PL_LIO->pAccess)(PL_LIO, (file), (mode)) -# define PerlLIO_chmod(file, mode) \ - (*PL_LIO->pChmod)(PL_LIO, (file), (mode)) -# define PerlLIO_chown(file, owner, group) \ - (*PL_LIO->pChown)(PL_LIO, (file), (owner), (group)) -# define PerlLIO_chsize(fd, size) \ - (*PL_LIO->pChsize)(PL_LIO, (fd), (size)) -# define PerlLIO_close(fd) \ - (*PL_LIO->pClose)(PL_LIO, (fd)) -# define PerlLIO_dup(fd) \ - (*PL_LIO->pDup)(PL_LIO, (fd)) -# define PerlLIO_dup2(fd1, fd2) \ - (*PL_LIO->pDup2)(PL_LIO, (fd1), (fd2)) -# define PerlLIO_flock(fd, op) \ - (*PL_LIO->pFlock)(PL_LIO, (fd), (op)) -# define PerlLIO_fstat(fd, buf) \ - (*PL_LIO->pFileStat)(PL_LIO, (fd), (buf)) -# define PerlLIO_ioctl(fd, u, buf) \ - (*PL_LIO->pIOCtl)(PL_LIO, (fd), (u), (buf)) -# define PerlLIO_isatty(fd) \ - (*PL_LIO->pIsatty)(PL_LIO, (fd)) -# define PerlLIO_link(oldname, newname) \ - (*PL_LIO->pLink)(PL_LIO, (oldname), (newname)) -# define PerlLIO_symlink(oldname, newname) \ - (*PL_LIO->pSymLink)(PL_LIO, (oldname), (newname)) -# define PerlLIO_readlink(path, buf, bufsiz) \ - (*PL_LIO->pReadLink)(PL_LIO, (path), (buf), (bufsiz)) -# define PerlLIO_lseek(fd, offset, mode) \ - (*PL_LIO->pLseek)(PL_LIO, (fd), (offset), (mode)) -# define PerlLIO_lstat(name, buf) \ - (*PL_LIO->pLstat)(PL_LIO, (name), (buf)) -# define PerlLIO_mktemp(file) \ - (*PL_LIO->pMktemp)(PL_LIO, (file)) -# define PerlLIO_open(file, flag) \ - (*PL_LIO->pOpen)(PL_LIO, (file), (flag)) -# define PerlLIO_open3(file, flag, perm) \ - (*PL_LIO->pOpen3)(PL_LIO, (file), (flag), (perm)) -# define PerlLIO_read(fd, buf, count) \ - (*PL_LIO->pRead)(PL_LIO, (fd), (buf), (count)) -# define PerlLIO_rename(oname, newname) \ - (*PL_LIO->pRename)(PL_LIO, (oname), (newname)) -# define PerlLIO_setmode(fd, mode) \ - (*PL_LIO->pSetmode)(PL_LIO, (fd), (mode)) -# define PerlLIO_stat(name, buf) \ - (*PL_LIO->pNameStat)(PL_LIO, (name), (buf)) -# define PerlLIO_tmpnam(str) \ - (*PL_LIO->pTmpnam)(PL_LIO, (str)) -# define PerlLIO_umask(mode) \ - (*PL_LIO->pUmask)(PL_LIO, (mode)) -# define PerlLIO_unlink(file) \ - (*PL_LIO->pUnlink)(PL_LIO, (file)) -# define PerlLIO_utime(file, time) \ - (*PL_LIO->pUtime)(PL_LIO, (file), (time)) -# define PerlLIO_write(fd, buf, count) \ - (*PL_LIO->pWrite)(PL_LIO, (fd), (buf), (count)) +# define PerlLIO_access(file, mode) \ + (*PL_LIO->pAccess)(PL_LIO, (file), (mode)) +# define PerlLIO_chmod(file, mode) \ + (*PL_LIO->pChmod)(PL_LIO, (file), (mode)) +# define PerlLIO_chown(file, owner, group) \ + (*PL_LIO->pChown)(PL_LIO, (file), (owner), (group)) +# define PerlLIO_chsize(fd, size) \ + (*PL_LIO->pChsize)(PL_LIO, (fd), (size)) +# define PerlLIO_close(fd) \ + (*PL_LIO->pClose)(PL_LIO, (fd)) +# define PerlLIO_dup(fd) \ + (*PL_LIO->pDup)(PL_LIO, (fd)) +# define PerlLIO_dup2(fd1, fd2) \ + (*PL_LIO->pDup2)(PL_LIO, (fd1), (fd2)) +# define PerlLIO_flock(fd, op) \ + (*PL_LIO->pFlock)(PL_LIO, (fd), (op)) +# define PerlLIO_fstat(fd, buf) \ + (*PL_LIO->pFileStat)(PL_LIO, (fd), (buf)) +# define PerlLIO_ioctl(fd, u, buf) \ + (*PL_LIO->pIOCtl)(PL_LIO, (fd), (u), (buf)) +# define PerlLIO_isatty(fd) \ + (*PL_LIO->pIsatty)(PL_LIO, (fd)) +# define PerlLIO_link(oldname, newname) \ + (*PL_LIO->pLink)(PL_LIO, (oldname), (newname)) +# define PerlLIO_symlink(oldname, newname) \ + (*PL_LIO->pSymLink)(PL_LIO, (oldname), (newname)) +# define PerlLIO_readlink(path, buf, bufsiz) \ + (*PL_LIO->pReadLink)(PL_LIO, (path), (buf), (bufsiz)) +# define PerlLIO_lseek(fd, offset, mode) \ + (*PL_LIO->pLseek)(PL_LIO, (fd), (offset), (mode)) +# define PerlLIO_lstat(name, buf) \ + (*PL_LIO->pLstat)(PL_LIO, (name), (buf)) +# define PerlLIO_mktemp(file) \ + (*PL_LIO->pMktemp)(PL_LIO, (file)) +# define PerlLIO_open(file, flag) \ + (*PL_LIO->pOpen)(PL_LIO, (file), (flag)) +# define PerlLIO_open3(file, flag, perm) \ + (*PL_LIO->pOpen3)(PL_LIO, (file), (flag), (perm)) +# define PerlLIO_read(fd, buf, count) \ + (*PL_LIO->pRead)(PL_LIO, (fd), (buf), (count)) +# define PerlLIO_rename(oname, newname) \ + (*PL_LIO->pRename)(PL_LIO, (oname), (newname)) +# define PerlLIO_setmode(fd, mode) \ + (*PL_LIO->pSetmode)(PL_LIO, (fd), (mode)) +# define PerlLIO_stat(name, buf) \ + (*PL_LIO->pNameStat)(PL_LIO, (name), (buf)) +# define PerlLIO_tmpnam(str) \ + (*PL_LIO->pTmpnam)(PL_LIO, (str)) +# define PerlLIO_umask(mode) \ + (*PL_LIO->pUmask)(PL_LIO, (mode)) +# define PerlLIO_unlink(file) \ + (*PL_LIO->pUnlink)(PL_LIO, (file)) +# define PerlLIO_utime(file, time) \ + (*PL_LIO->pUtime)(PL_LIO, (file), (time)) +# define PerlLIO_write(fd, buf, count) \ + (*PL_LIO->pWrite)(PL_LIO, (fd), (buf), (count)) #else /* ! PERL_IMPLICIT_SYS */ -# define PerlLIO_access(file, mode) access((file), (mode)) -# define PerlLIO_chmod(file, mode) chmod((file), (mode)) -# define PerlLIO_chown(file, owner, grp) chown((file), (owner), (grp)) +# define PerlLIO_access(file, mode) access((file), (mode)) +# define PerlLIO_chmod(file, mode) chmod((file), (mode)) +# define PerlLIO_chown(file, owner, grp) chown((file), (owner), (grp)) # if defined(HAS_TRUNCATE) -# define PerlLIO_chsize(fd, size) ftruncate((fd), (size)) +# define PerlLIO_chsize(fd, size) ftruncate((fd), (size)) # elif defined(HAS_CHSIZE) -# define PerlLIO_chsize(fd, size) chsize((fd), (size)) +# define PerlLIO_chsize(fd, size) chsize((fd), (size)) # else -# define PerlLIO_chsize(fd, size) my_chsize((fd), (size)) +# define PerlLIO_chsize(fd, size) my_chsize((fd), (size)) # endif -# define PerlLIO_close(fd) close((fd)) -# define PerlLIO_dup(fd) dup((fd)) -# define PerlLIO_dup2(fd1, fd2) dup2((fd1), (fd2)) -# define PerlLIO_flock(fd, op) FLOCK((fd), (op)) -# define PerlLIO_fstat(fd, buf) Fstat((fd), (buf)) -# define PerlLIO_ioctl(fd, u, buf) ioctl((fd), (u), (buf)) -# define PerlLIO_isatty(fd) isatty((fd)) -# define PerlLIO_link(oldname, newname) link((oldname), (newname)) -# define PerlLIO_symlink(oldname, newname) symlink((oldname), (newname)) -# define PerlLIO_readlink(path, buf, bufsiz) readlink((path), (buf), (bufsiz)) -# define PerlLIO_lseek(fd, offset, mode) lseek((fd), (offset), (mode)) -# define PerlLIO_stat(name, buf) Stat((name), (buf)) +# define PerlLIO_close(fd) close((fd)) +# define PerlLIO_dup(fd) dup((fd)) +# define PerlLIO_dup2(fd1, fd2) dup2((fd1), (fd2)) +# define PerlLIO_flock(fd, op) FLOCK((fd), (op)) +# define PerlLIO_fstat(fd, buf) Fstat((fd), (buf)) +# define PerlLIO_ioctl(fd, u, buf) ioctl((fd), (u), (buf)) +# define PerlLIO_isatty(fd) isatty((fd)) +# define PerlLIO_link(oldname, newname) link((oldname), (newname)) +# define PerlLIO_symlink(oldname, newname) symlink((oldname), (newname)) +# define PerlLIO_readlink(path, buf, bufsiz) \ + readlink((path), (buf), (bufsiz)) +# define PerlLIO_lseek(fd, offset, mode) lseek((fd), (offset), (mode)) +# define PerlLIO_stat(name, buf) Stat((name), (buf)) # ifdef HAS_LSTAT -# define PerlLIO_lstat(name, buf) lstat((name), (buf)) +# define PerlLIO_lstat(name, buf) lstat((name), (buf)) # else -# define PerlLIO_lstat(name, buf) PerlLIO_stat((name), (buf)) +# define PerlLIO_lstat(name, buf) PerlLIO_stat((name), (buf)) # endif -# define PerlLIO_mktemp(file) mktemp((file)) +# define PerlLIO_mktemp(file) mktemp((file)) # if defined(OEMVS) # if (__CHARSET_LIB == 1) int asciiopen(const char* path, int oflag); int asciiopen3(const char* path, int oflag, int perm); -# define PerlLIO_open(file, flag) asciiopen((file), (flag)) -# define PerlLIO_open3(file, flag, perm) asciiopen3((file), (flag), (perm)) +# define PerlLIO_open(file, flag) asciiopen((file), (flag)) +# define PerlLIO_open3(file, flag, perm) \ + asciiopen3((file), (flag), (perm)) # else -# define PerlLIO_open(file, flag) open((file), (flag)) -# define PerlLIO_open3(file, flag, perm) open((file), (flag), (perm)) +# define PerlLIO_open(file, flag) open((file), (flag)) +# define PerlLIO_open3(file, flag, perm) open((file), (flag), (perm)) # endif # else -# define PerlLIO_open(file, flag) open((file), (flag)) -# define PerlLIO_open3(file, flag, perm) open((file), (flag), (perm)) +# define PerlLIO_open(file, flag) open((file), (flag)) +# define PerlLIO_open3(file, flag, perm) open((file), (flag), (perm)) # endif -# define PerlLIO_read(fd, buf, count) read((fd), (buf), (count)) -# define PerlLIO_rename(old, new) rename((old), (new)) -# define PerlLIO_setmode(fd, mode) setmode((fd), (mode)) -# define PerlLIO_tmpnam(str) tmpnam((str)) -# define PerlLIO_umask(mode) umask((mode)) -# define PerlLIO_unlink(file) unlink((file)) -# define PerlLIO_utime(file, time) utime((file), (time)) -# define PerlLIO_write(fd, buf, count) write((fd), (buf), (count)) +# define PerlLIO_read(fd, buf, count) read((fd), (buf), (count)) +# define PerlLIO_rename(old, new) rename((old), (new)) +# define PerlLIO_setmode(fd, mode) setmode((fd), (mode)) +# define PerlLIO_tmpnam(str) tmpnam((str)) +# define PerlLIO_umask(mode) umask((mode)) +# define PerlLIO_unlink(file) unlink((file)) +# define PerlLIO_utime(file, time) utime((file), (time)) +# define PerlLIO_write(fd, buf, count) write((fd), (buf), (count)) #endif /* PERL_IMPLICIT_SYS */ @@ -802,7 +801,7 @@ struct IPerlLIOInfo #if defined(PERL_IMPLICIT_SYS) -/* IPerlMem */ +/* IPerlMem */ struct IPerlMem; struct IPerlMemInfo; typedef void* (*LPMemMalloc)(struct IPerlMem*, size_t); @@ -831,82 +830,82 @@ struct IPerlMemInfo }; /* Interpreter specific memory macros */ -# define PerlMem_malloc(size) \ - (*PL_Mem->pMalloc)(PL_Mem, (size)) -# define PerlMem_realloc(buf, size) \ - (*PL_Mem->pRealloc)(PL_Mem, (buf), (size)) -# define PerlMem_free(buf) \ - (*PL_Mem->pFree)(PL_Mem, (buf)) -# define PerlMem_calloc(num, size) \ - (*PL_Mem->pCalloc)(PL_Mem, (num), (size)) -# define PerlMem_get_lock() \ - (*PL_Mem->pGetLock)(PL_Mem) -# define PerlMem_free_lock() \ - (*PL_Mem->pFreeLock)(PL_Mem) -# define PerlMem_is_locked() \ - (*PL_Mem->pIsLocked)(PL_Mem) +# define PerlMem_malloc(size) \ + (*PL_Mem->pMalloc)(PL_Mem, (size)) +# define PerlMem_realloc(buf, size) \ + (*PL_Mem->pRealloc)(PL_Mem, (buf), (size)) +# define PerlMem_free(buf) \ + (*PL_Mem->pFree)(PL_Mem, (buf)) +# define PerlMem_calloc(num, size) \ + (*PL_Mem->pCalloc)(PL_Mem, (num), (size)) +# define PerlMem_get_lock() \ + (*PL_Mem->pGetLock)(PL_Mem) +# define PerlMem_free_lock() \ + (*PL_Mem->pFreeLock)(PL_Mem) +# define PerlMem_is_locked() \ + (*PL_Mem->pIsLocked)(PL_Mem) /* Shared memory macros */ -# define PerlMemShared_malloc(size) \ - (*PL_MemShared->pMalloc)(PL_MemShared, (size)) -# define PerlMemShared_realloc(buf, size) \ - (*PL_MemShared->pRealloc)(PL_MemShared, (buf), (size)) -# define PerlMemShared_free(buf) \ - (*PL_MemShared->pFree)(PL_MemShared, (buf)) -# define PerlMemShared_calloc(num, size) \ - (*PL_MemShared->pCalloc)(PL_MemShared, (num), (size)) -# define PerlMemShared_get_lock() \ - (*PL_MemShared->pGetLock)(PL_MemShared) -# define PerlMemShared_free_lock() \ - (*PL_MemShared->pFreeLock)(PL_MemShared) -# define PerlMemShared_is_locked() \ - (*PL_MemShared->pIsLocked)(PL_MemShared) +# define PerlMemShared_malloc(size) \ + (*PL_MemShared->pMalloc)(PL_MemShared, (size)) +# define PerlMemShared_realloc(buf, size) \ + (*PL_MemShared->pRealloc)(PL_MemShared, (buf), (size)) +# define PerlMemShared_free(buf) \ + (*PL_MemShared->pFree)(PL_MemShared, (buf)) +# define PerlMemShared_calloc(num, size) \ + (*PL_MemShared->pCalloc)(PL_MemShared, (num), (size)) +# define PerlMemShared_get_lock() \ + (*PL_MemShared->pGetLock)(PL_MemShared) +# define PerlMemShared_free_lock() \ + (*PL_MemShared->pFreeLock)(PL_MemShared) +# define PerlMemShared_is_locked() \ + (*PL_MemShared->pIsLocked)(PL_MemShared) /* Parse tree memory macros */ -# define PerlMemParse_malloc(size) \ - (*PL_MemParse->pMalloc)(PL_MemParse, (size)) -# define PerlMemParse_realloc(buf, size) \ - (*PL_MemParse->pRealloc)(PL_MemParse, (buf), (size)) -# define PerlMemParse_free(buf) \ - (*PL_MemParse->pFree)(PL_MemParse, (buf)) -# define PerlMemParse_calloc(num, size) \ - (*PL_MemParse->pCalloc)(PL_MemParse, (num), (size)) -# define PerlMemParse_get_lock() \ - (*PL_MemParse->pGetLock)(PL_MemParse) -# define PerlMemParse_free_lock() \ - (*PL_MemParse->pFreeLock)(PL_MemParse) -# define PerlMemParse_is_locked() \ - (*PL_MemParse->pIsLocked)(PL_MemParse) +# define PerlMemParse_malloc(size) \ + (*PL_MemParse->pMalloc)(PL_MemParse, (size)) +# define PerlMemParse_realloc(buf, size) \ + (*PL_MemParse->pRealloc)(PL_MemParse, (buf), (size)) +# define PerlMemParse_free(buf) \ + (*PL_MemParse->pFree)(PL_MemParse, (buf)) +# define PerlMemParse_calloc(num, size) \ + (*PL_MemParse->pCalloc)(PL_MemParse, (num), (size)) +# define PerlMemParse_get_lock() \ + (*PL_MemParse->pGetLock)(PL_MemParse) +# define PerlMemParse_free_lock() \ + (*PL_MemParse->pFreeLock)(PL_MemParse) +# define PerlMemParse_is_locked() \ + (*PL_MemParse->pIsLocked)(PL_MemParse) #else /* ! PERL_IMPLICIT_SYS */ /* Interpreter specific memory macros */ -# define PerlMem_malloc(size) malloc((size)) -# define PerlMem_realloc(buf, size) realloc((buf), (size)) -# define PerlMem_free(buf) free((buf)) -# define PerlMem_calloc(num, size) calloc((num), (size)) -# define PerlMem_get_lock() +# define PerlMem_malloc(size) malloc((size)) +# define PerlMem_realloc(buf, size) realloc((buf), (size)) +# define PerlMem_free(buf) free((buf)) +# define PerlMem_calloc(num, size) calloc((num), (size)) +# define PerlMem_get_lock() # define PerlMem_free_lock() -# define PerlMem_is_locked() 0 +# define PerlMem_is_locked() 0 /* Shared memory macros */ -# define PerlMemShared_malloc(size) malloc((size)) -# define PerlMemShared_realloc(buf, size) realloc((buf), (size)) -# define PerlMemShared_free(buf) free((buf)) -# define PerlMemShared_calloc(num, size) calloc((num), (size)) -# define PerlMemShared_get_lock() +# define PerlMemShared_malloc(size) malloc((size)) +# define PerlMemShared_realloc(buf, size) realloc((buf), (size)) +# define PerlMemShared_free(buf) free((buf)) +# define PerlMemShared_calloc(num, size) calloc((num), (size)) +# define PerlMemShared_get_lock() # define PerlMemShared_free_lock() -# define PerlMemShared_is_locked() 0 +# define PerlMemShared_is_locked() 0 /* Parse tree memory macros */ -# define PerlMemParse_malloc(size) malloc((size)) -# define PerlMemParse_realloc(buf, size) realloc((buf), (size)) -# define PerlMemParse_free(buf) free((buf)) -# define PerlMemParse_calloc(num, size) calloc((num), (size)) -# define PerlMemParse_get_lock() +# define PerlMemParse_malloc(size) malloc((size)) +# define PerlMemParse_realloc(buf, size) realloc((buf), (size)) +# define PerlMemParse_free(buf) free((buf)) +# define PerlMemParse_calloc(num, size) calloc((num), (size)) +# define PerlMemParse_get_lock() # define PerlMemParse_free_lock() -# define PerlMemParse_is_locked() 0 +# define PerlMemParse_is_locked() 0 #endif /* PERL_IMPLICIT_SYS */ @@ -921,7 +920,7 @@ struct IPerlMemInfo # include # endif -/* IPerlProc */ +/* IPerlProc */ struct IPerlProc; struct IPerlProcInfo; typedef void (*LPProcAbort)(struct IPerlProc*); @@ -1017,122 +1016,122 @@ struct IPerlProcInfo struct IPerlProc perlProcList; }; -# define PerlProc_abort() \ - (*PL_Proc->pAbort)(PL_Proc) -# define PerlProc_crypt(c,s) \ - (*PL_Proc->pCrypt)(PL_Proc, (c), (s)) -# define PerlProc_exit(s) \ - (*PL_Proc->pExit)(PL_Proc, (s)) -# define PerlProc__exit(s) \ - (*PL_Proc->p_Exit)(PL_Proc, (s)) -# define PerlProc_execl(c, w, x, y, z) \ - (*PL_Proc->pExecl)(PL_Proc, (c), (w), (x), (y), (z)) -# define PerlProc_execv(c, a) \ - (*PL_Proc->pExecv)(PL_Proc, (c), (a)) -# define PerlProc_execvp(c, a) \ - (*PL_Proc->pExecvp)(PL_Proc, (c), (a)) -# define PerlProc_getuid() \ - (*PL_Proc->pGetuid)(PL_Proc) -# define PerlProc_geteuid() \ - (*PL_Proc->pGeteuid)(PL_Proc) -# define PerlProc_getgid() \ - (*PL_Proc->pGetgid)(PL_Proc) -# define PerlProc_getegid() \ - (*PL_Proc->pGetegid)(PL_Proc) -# define PerlProc_getlogin() \ - (*PL_Proc->pGetlogin)(PL_Proc) -# define PerlProc_kill(i, a) \ - (*PL_Proc->pKill)(PL_Proc, (i), (a)) -# define PerlProc_killpg(i, a) \ - (*PL_Proc->pKillpg)(PL_Proc, (i), (a)) -# define PerlProc_pause() \ - (*PL_Proc->pPauseProc)(PL_Proc) -# define PerlProc_popen(c, m) \ - (*PL_Proc->pPopen)(PL_Proc, (c), (m)) -# define PerlProc_popen_list(m, n, a) \ - (*PL_Proc->pPopenList)(PL_Proc, (m), (n), (a)) -# define PerlProc_pclose(f) \ - (*PL_Proc->pPclose)(PL_Proc, (f)) -# define PerlProc_pipe(fd) \ - (*PL_Proc->pPipe)(PL_Proc, (fd)) -# define PerlProc_setuid(u) \ - (*PL_Proc->pSetuid)(PL_Proc, (u)) -# define PerlProc_setgid(g) \ - (*PL_Proc->pSetgid)(PL_Proc, (g)) -# define PerlProc_sleep(t) \ - (*PL_Proc->pSleep)(PL_Proc, (t)) -# define PerlProc_times(t) \ - (*PL_Proc->pTimes)(PL_Proc, (t)) -# define PerlProc_wait(t) \ - (*PL_Proc->pWait)(PL_Proc, (t)) -# define PerlProc_waitpid(p,s,f) \ - (*PL_Proc->pWaitpid)(PL_Proc, (p), (s), (f)) -# define PerlProc_signal(n, h) \ - (*PL_Proc->pSignal)(PL_Proc, (n), (h)) -# define PerlProc_fork() \ - (*PL_Proc->pFork)(PL_Proc) -# define PerlProc_getpid() \ - (*PL_Proc->pGetpid)(PL_Proc) -# define PerlProc_setjmp(b, n) Sigsetjmp((b), (n)) -# define PerlProc_longjmp(b, n) Siglongjmp((b), (n)) +# define PerlProc_abort() \ + (*PL_Proc->pAbort)(PL_Proc) +# define PerlProc_crypt(c,s) \ + (*PL_Proc->pCrypt)(PL_Proc, (c), (s)) +# define PerlProc_exit(s) \ + (*PL_Proc->pExit)(PL_Proc, (s)) +# define PerlProc__exit(s) \ + (*PL_Proc->p_Exit)(PL_Proc, (s)) +# define PerlProc_execl(c, w, x, y, z) \ + (*PL_Proc->pExecl)(PL_Proc, (c), (w), (x), (y), (z)) +# define PerlProc_execv(c, a) \ + (*PL_Proc->pExecv)(PL_Proc, (c), (a)) +# define PerlProc_execvp(c, a) \ + (*PL_Proc->pExecvp)(PL_Proc, (c), (a)) +# define PerlProc_getuid() \ + (*PL_Proc->pGetuid)(PL_Proc) +# define PerlProc_geteuid() \ + (*PL_Proc->pGeteuid)(PL_Proc) +# define PerlProc_getgid() \ + (*PL_Proc->pGetgid)(PL_Proc) +# define PerlProc_getegid() \ + (*PL_Proc->pGetegid)(PL_Proc) +# define PerlProc_getlogin() \ + (*PL_Proc->pGetlogin)(PL_Proc) +# define PerlProc_kill(i, a) \ + (*PL_Proc->pKill)(PL_Proc, (i), (a)) +# define PerlProc_killpg(i, a) \ + (*PL_Proc->pKillpg)(PL_Proc, (i), (a)) +# define PerlProc_pause() \ + (*PL_Proc->pPauseProc)(PL_Proc) +# define PerlProc_popen(c, m) \ + (*PL_Proc->pPopen)(PL_Proc, (c), (m)) +# define PerlProc_popen_list(m, n, a) \ + (*PL_Proc->pPopenList)(PL_Proc, (m), (n), (a)) +# define PerlProc_pclose(f) \ + (*PL_Proc->pPclose)(PL_Proc, (f)) +# define PerlProc_pipe(fd) \ + (*PL_Proc->pPipe)(PL_Proc, (fd)) +# define PerlProc_setuid(u) \ + (*PL_Proc->pSetuid)(PL_Proc, (u)) +# define PerlProc_setgid(g) \ + (*PL_Proc->pSetgid)(PL_Proc, (g)) +# define PerlProc_sleep(t) \ + (*PL_Proc->pSleep)(PL_Proc, (t)) +# define PerlProc_times(t) \ + (*PL_Proc->pTimes)(PL_Proc, (t)) +# define PerlProc_wait(t) \ + (*PL_Proc->pWait)(PL_Proc, (t)) +# define PerlProc_waitpid(p,s,f) \ + (*PL_Proc->pWaitpid)(PL_Proc, (p), (s), (f)) +# define PerlProc_signal(n, h) \ + (*PL_Proc->pSignal)(PL_Proc, (n), (h)) +# define PerlProc_fork() \ + (*PL_Proc->pFork)(PL_Proc) +# define PerlProc_getpid() \ + (*PL_Proc->pGetpid)(PL_Proc) +# define PerlProc_setjmp(b, n) Sigsetjmp((b), (n)) +# define PerlProc_longjmp(b, n) Siglongjmp((b), (n)) # ifdef WIN32 -# define PerlProc_DynaLoad(f) \ - (*PL_Proc->pDynaLoader)(PL_Proc, (f)) -# define PerlProc_GetOSError(s,e) \ - (*PL_Proc->pGetOSError)(PL_Proc, (s), (e)) -# define PerlProc_spawnvp(m, c, a) \ - (*PL_Proc->pSpawnvp)(PL_Proc, (m), (c), (a)) +# define PerlProc_DynaLoad(f) \ + (*PL_Proc->pDynaLoader)(PL_Proc, (f)) +# define PerlProc_GetOSError(s,e) \ + (*PL_Proc->pGetOSError)(PL_Proc, (s), (e)) +# define PerlProc_spawnvp(m, c, a) \ + (*PL_Proc->pSpawnvp)(PL_Proc, (m), (c), (a)) # endif -# define PerlProc_lasthost() \ - (*PL_Proc->pLastHost)(PL_Proc) -# define PerlProc_gettimeofday(t,z) \ - (*PL_Proc->pGetTimeOfDay)(PL_Proc,(t),(z)) +# define PerlProc_lasthost() \ + (*PL_Proc->pLastHost)(PL_Proc) +# define PerlProc_gettimeofday(t,z) \ + (*PL_Proc->pGetTimeOfDay)(PL_Proc,(t),(z)) #else /* ! PERL_IMPLICIT_SYS */ -# define PerlProc_abort() abort() -# define PerlProc_crypt(c,s) crypt((c), (s)) -# define PerlProc_exit(s) exit((s)) -# define PerlProc__exit(s) _exit((s)) -# define PerlProc_execl(c,w,x,y,z) \ - execl((c), (w), (x), (y), (z)) -# define PerlProc_execv(c, a) execv((c), (a)) -# define PerlProc_execvp(c, a) execvp((c), (a)) -# define PerlProc_getuid() getuid() -# define PerlProc_geteuid() geteuid() -# define PerlProc_getgid() getgid() -# define PerlProc_getegid() getegid() -# define PerlProc_getlogin() getlogin() -# define PerlProc_kill(i, a) kill((i), (a)) -# define PerlProc_killpg(i, a) killpg((i), (a)) -# define PerlProc_pause() Pause() -# define PerlProc_popen(c, m) my_popen((c), (m)) -# define PerlProc_popen_list(m,n,a) my_popen_list((m),(n),(a)) -# define PerlProc_pclose(f) my_pclose((f)) -# define PerlProc_pipe(fd) pipe((fd)) -# define PerlProc_setuid(u) setuid((u)) -# define PerlProc_setgid(g) setgid((g)) -# define PerlProc_sleep(t) sleep((t)) -# define PerlProc_times(t) times((t)) -# define PerlProc_wait(t) wait((t)) -# define PerlProc_waitpid(p,s,f) waitpid((p), (s), (f)) -# define PerlProc_setjmp(b, n) Sigsetjmp((b), (n)) -# define PerlProc_longjmp(b, n)Siglongjmp((b), (n)) -# define PerlProc_signal(n, h) signal((n), (h)) -# define PerlProc_fork() my_fork() -# define PerlProc_getpid() getpid() -# define PerlProc_gettimeofday(t,z) gettimeofday((t),(z)) +# define PerlProc_abort() abort() +# define PerlProc_crypt(c,s) crypt((c), (s)) +# define PerlProc_exit(s) exit((s)) +# define PerlProc__exit(s) _exit((s)) +# define PerlProc_execl(c,w,x,y,z) \ + execl((c), (w), (x), (y), (z)) +# define PerlProc_execv(c, a) execv((c), (a)) +# define PerlProc_execvp(c, a) execvp((c), (a)) +# define PerlProc_getuid() getuid() +# define PerlProc_geteuid() geteuid() +# define PerlProc_getgid() getgid() +# define PerlProc_getegid() getegid() +# define PerlProc_getlogin() getlogin() +# define PerlProc_kill(i, a) kill((i), (a)) +# define PerlProc_killpg(i, a) killpg((i), (a)) +# define PerlProc_pause() Pause() +# define PerlProc_popen(c, m) my_popen((c), (m)) +# define PerlProc_popen_list(m,n,a) my_popen_list((m),(n),(a)) +# define PerlProc_pclose(f) my_pclose((f)) +# define PerlProc_pipe(fd) pipe((fd)) +# define PerlProc_setuid(u) setuid((u)) +# define PerlProc_setgid(g) setgid((g)) +# define PerlProc_sleep(t) sleep((t)) +# define PerlProc_times(t) times((t)) +# define PerlProc_wait(t) wait((t)) +# define PerlProc_waitpid(p,s,f) waitpid((p), (s), (f)) +# define PerlProc_setjmp(b, n) Sigsetjmp((b), (n)) +# define PerlProc_longjmp(b, n) Siglongjmp((b), (n)) +# define PerlProc_signal(n, h) signal((n), (h)) +# define PerlProc_fork() my_fork() +# define PerlProc_getpid() getpid() +# define PerlProc_gettimeofday(t,z) gettimeofday((t),(z)) # ifdef WIN32 -# define PerlProc_DynaLoad(f) \ - win32_dynaload((f)) -# define PerlProc_GetOSError(s,e) \ - win32_str_os_error((s), (e)) -# define PerlProc_spawnvp(m, c, a) \ - win32_spawnvp((m), (c), (a)) +# define PerlProc_DynaLoad(f) \ + win32_dynaload((f)) +# define PerlProc_GetOSError(s,e) \ + win32_str_os_error((s), (e)) +# define PerlProc_spawnvp(m, c, a) \ + win32_spawnvp((m), (c), (a)) # undef PerlProc_signal -# define PerlProc_signal(n, h) win32_signal((n), (h)) +# define PerlProc_signal(n, h) win32_signal((n), (h)) # endif #endif /* PERL_IMPLICIT_SYS */ @@ -1142,7 +1141,7 @@ struct IPerlProcInfo #if defined(PERL_IMPLICIT_SYS) -/* PerlSock */ +/* PerlSock */ struct IPerlSock; struct IPerlSockInfo; typedef u_long (*LPHtonl)(struct IPerlSock*, u_long); @@ -1263,154 +1262,154 @@ struct IPerlSockInfo struct IPerlSock perlSockList; }; -# define PerlSock_htonl(x) \ - (*PL_Sock->pHtonl)(PL_Sock, x) -# define PerlSock_htons(x) \ - (*PL_Sock->pHtons)(PL_Sock, x) -# define PerlSock_ntohl(x) \ - (*PL_Sock->pNtohl)(PL_Sock, x) -# define PerlSock_ntohs(x) \ - (*PL_Sock->pNtohs)(PL_Sock, x) -# define PerlSock_accept(s, a, l) \ - (*PL_Sock->pAccept)(PL_Sock, s, a, l) -# define PerlSock_bind(s, n, l) \ - (*PL_Sock->pBind)(PL_Sock, s, n, l) -# define PerlSock_connect(s, n, l) \ - (*PL_Sock->pConnect)(PL_Sock, s, n, l) -# define PerlSock_endhostent() \ - (*PL_Sock->pEndhostent)(PL_Sock) -# define PerlSock_endnetent() \ - (*PL_Sock->pEndnetent)(PL_Sock) -# define PerlSock_endprotoent() \ - (*PL_Sock->pEndprotoent)(PL_Sock) -# define PerlSock_endservent() \ - (*PL_Sock->pEndservent)(PL_Sock) -# define PerlSock_gethostbyaddr(a, l, t) \ - (*PL_Sock->pGethostbyaddr)(PL_Sock, a, l, t) -# define PerlSock_gethostbyname(n) \ - (*PL_Sock->pGethostbyname)(PL_Sock, n) -# define PerlSock_gethostent() \ - (*PL_Sock->pGethostent)(PL_Sock) -# define PerlSock_gethostname(n, l) \ - (*PL_Sock->pGethostname)(PL_Sock, n, l) -# define PerlSock_getnetbyaddr(n, t) \ - (*PL_Sock->pGetnetbyaddr)(PL_Sock, n, t) -# define PerlSock_getnetbyname(c) \ - (*PL_Sock->pGetnetbyname)(PL_Sock, c) -# define PerlSock_getnetent() \ - (*PL_Sock->pGetnetent)(PL_Sock) -# define PerlSock_getpeername(s, n, l) \ - (*PL_Sock->pGetpeername)(PL_Sock, s, n, l) -# define PerlSock_getprotobyname(n) \ - (*PL_Sock->pGetprotobyname)(PL_Sock, n) -# define PerlSock_getprotobynumber(n) \ - (*PL_Sock->pGetprotobynumber)(PL_Sock, n) -# define PerlSock_getprotoent() \ - (*PL_Sock->pGetprotoent)(PL_Sock) -# define PerlSock_getservbyname(n, p) \ - (*PL_Sock->pGetservbyname)(PL_Sock, n, p) -# define PerlSock_getservbyport(port, p) \ - (*PL_Sock->pGetservbyport)(PL_Sock, port, p) -# define PerlSock_getservent() \ - (*PL_Sock->pGetservent)(PL_Sock) -# define PerlSock_getsockname(s, n, l) \ - (*PL_Sock->pGetsockname)(PL_Sock, s, n, l) -# define PerlSock_getsockopt(s,l,n,v,i) \ - (*PL_Sock->pGetsockopt)(PL_Sock, s, l, n, v, i) -# define PerlSock_inet_addr(c) \ - (*PL_Sock->pInetAddr)(PL_Sock, c) -# define PerlSock_inet_ntoa(i) \ - (*PL_Sock->pInetNtoa)(PL_Sock, i) -# define PerlSock_listen(s, b) \ - (*PL_Sock->pListen)(PL_Sock, s, b) -# define PerlSock_recv(s, b, l, f) \ - (*PL_Sock->pRecv)(PL_Sock, s, b, l, f) -# define PerlSock_recvfrom(s,b,l,f,from,fromlen) \ - (*PL_Sock->pRecvfrom)(PL_Sock, s, b, l, f, from, fromlen) -# define PerlSock_select(n, r, w, e, t) \ - (*PL_Sock->pSelect)(PL_Sock, n, (char*)r, (char*)w, (char*)e, t) -# define PerlSock_send(s, b, l, f) \ - (*PL_Sock->pSend)(PL_Sock, s, b, l, f) -# define PerlSock_sendto(s, b, l, f, t, tlen) \ - (*PL_Sock->pSendto)(PL_Sock, s, b, l, f, t, tlen) -# define PerlSock_sethostent(f) \ - (*PL_Sock->pSethostent)(PL_Sock, f) -# define PerlSock_setnetent(f) \ - (*PL_Sock->pSetnetent)(PL_Sock, f) -# define PerlSock_setprotoent(f) \ - (*PL_Sock->pSetprotoent)(PL_Sock, f) -# define PerlSock_setservent(f) \ - (*PL_Sock->pSetservent)(PL_Sock, f) -# define PerlSock_setsockopt(s, l, n, v, len) \ - (*PL_Sock->pSetsockopt)(PL_Sock, s, l, n, v, len) -# define PerlSock_shutdown(s, h) \ - (*PL_Sock->pShutdown)(PL_Sock, s, h) -# define PerlSock_socket(a, t, p) \ - (*PL_Sock->pSocket)(PL_Sock, a, t, p) -# define PerlSock_socketpair(a, t, p, f) \ - (*PL_Sock->pSocketpair)(PL_Sock, a, t, p, f) +# define PerlSock_htonl(x) \ + (*PL_Sock->pHtonl)(PL_Sock, x) +# define PerlSock_htons(x) \ + (*PL_Sock->pHtons)(PL_Sock, x) +# define PerlSock_ntohl(x) \ + (*PL_Sock->pNtohl)(PL_Sock, x) +# define PerlSock_ntohs(x) \ + (*PL_Sock->pNtohs)(PL_Sock, x) +# define PerlSock_accept(s, a, l) \ + (*PL_Sock->pAccept)(PL_Sock, s, a, l) +# define PerlSock_bind(s, n, l) \ + (*PL_Sock->pBind)(PL_Sock, s, n, l) +# define PerlSock_connect(s, n, l) \ + (*PL_Sock->pConnect)(PL_Sock, s, n, l) +# define PerlSock_endhostent() \ + (*PL_Sock->pEndhostent)(PL_Sock) +# define PerlSock_endnetent() \ + (*PL_Sock->pEndnetent)(PL_Sock) +# define PerlSock_endprotoent() \ + (*PL_Sock->pEndprotoent)(PL_Sock) +# define PerlSock_endservent() \ + (*PL_Sock->pEndservent)(PL_Sock) +# define PerlSock_gethostbyaddr(a, l, t) \ + (*PL_Sock->pGethostbyaddr)(PL_Sock, a, l, t) +# define PerlSock_gethostbyname(n) \ + (*PL_Sock->pGethostbyname)(PL_Sock, n) +# define PerlSock_gethostent() \ + (*PL_Sock->pGethostent)(PL_Sock) +# define PerlSock_gethostname(n, l) \ + (*PL_Sock->pGethostname)(PL_Sock, n, l) +# define PerlSock_getnetbyaddr(n, t) \ + (*PL_Sock->pGetnetbyaddr)(PL_Sock, n, t) +# define PerlSock_getnetbyname(c) \ + (*PL_Sock->pGetnetbyname)(PL_Sock, c) +# define PerlSock_getnetent() \ + (*PL_Sock->pGetnetent)(PL_Sock) +# define PerlSock_getpeername(s, n, l) \ + (*PL_Sock->pGetpeername)(PL_Sock, s, n, l) +# define PerlSock_getprotobyname(n) \ + (*PL_Sock->pGetprotobyname)(PL_Sock, n) +# define PerlSock_getprotobynumber(n) \ + (*PL_Sock->pGetprotobynumber)(PL_Sock, n) +# define PerlSock_getprotoent() \ + (*PL_Sock->pGetprotoent)(PL_Sock) +# define PerlSock_getservbyname(n, p) \ + (*PL_Sock->pGetservbyname)(PL_Sock, n, p) +# define PerlSock_getservbyport(port, p) \ + (*PL_Sock->pGetservbyport)(PL_Sock, port, p) +# define PerlSock_getservent() \ + (*PL_Sock->pGetservent)(PL_Sock) +# define PerlSock_getsockname(s, n, l) \ + (*PL_Sock->pGetsockname)(PL_Sock, s, n, l) +# define PerlSock_getsockopt(s,l,n,v,i) \ + (*PL_Sock->pGetsockopt)(PL_Sock, s, l, n, v, i) +# define PerlSock_inet_addr(c) \ + (*PL_Sock->pInetAddr)(PL_Sock, c) +# define PerlSock_inet_ntoa(i) \ + (*PL_Sock->pInetNtoa)(PL_Sock, i) +# define PerlSock_listen(s, b) \ + (*PL_Sock->pListen)(PL_Sock, s, b) +# define PerlSock_recv(s, b, l, f) \ + (*PL_Sock->pRecv)(PL_Sock, s, b, l, f) +# define PerlSock_recvfrom(s,b,l,f,from,fromlen) \ + (*PL_Sock->pRecvfrom)(PL_Sock, s, b, l, f, from, fromlen) +# define PerlSock_select(n, r, w, e, t) \ + (*PL_Sock->pSelect)(PL_Sock, n, (char*)r, (char*)w, (char*)e, t) +# define PerlSock_send(s, b, l, f) \ + (*PL_Sock->pSend)(PL_Sock, s, b, l, f) +# define PerlSock_sendto(s, b, l, f, t, tlen) \ + (*PL_Sock->pSendto)(PL_Sock, s, b, l, f, t, tlen) +# define PerlSock_sethostent(f) \ + (*PL_Sock->pSethostent)(PL_Sock, f) +# define PerlSock_setnetent(f) \ + (*PL_Sock->pSetnetent)(PL_Sock, f) +# define PerlSock_setprotoent(f) \ + (*PL_Sock->pSetprotoent)(PL_Sock, f) +# define PerlSock_setservent(f) \ + (*PL_Sock->pSetservent)(PL_Sock, f) +# define PerlSock_setsockopt(s, l, n, v, len) \ + (*PL_Sock->pSetsockopt)(PL_Sock, s, l, n, v, len) +# define PerlSock_shutdown(s, h) \ + (*PL_Sock->pShutdown)(PL_Sock, s, h) +# define PerlSock_socket(a, t, p) \ + (*PL_Sock->pSocket)(PL_Sock, a, t, p) +# define PerlSock_socketpair(a, t, p, f) \ + (*PL_Sock->pSocketpair)(PL_Sock, a, t, p, f) # ifdef WIN32 -# define PerlSock_closesocket(s) \ - (*PL_Sock->pClosesocket)(PL_Sock, s) +# define PerlSock_closesocket(s) \ + (*PL_Sock->pClosesocket)(PL_Sock, s) # endif #else /* ! PERL_IMPLICIT_SYS below */ -# define PerlSock_htonl(x) htonl(x) -# define PerlSock_htons(x) htons(x) -# define PerlSock_ntohl(x) ntohl(x) -# define PerlSock_ntohs(x) ntohs(x) -# define PerlSock_accept(s, a, l) accept(s, a, l) -# define PerlSock_bind(s, n, l) bind(s, n, l) -# define PerlSock_connect(s, n, l) connect(s, n, l) +# define PerlSock_htonl(x) htonl(x) +# define PerlSock_htons(x) htons(x) +# define PerlSock_ntohl(x) ntohl(x) +# define PerlSock_ntohs(x) ntohs(x) +# define PerlSock_accept(s, a, l) accept(s, a, l) +# define PerlSock_bind(s, n, l) bind(s, n, l) +# define PerlSock_connect(s, n, l) connect(s, n, l) # define PerlSock_gethostbyaddr(a, l, t) gethostbyaddr(a, l, t) -# define PerlSock_gethostbyname(n) gethostbyname(n) -# define PerlSock_gethostent gethostent -# define PerlSock_endhostent endhostent -# define PerlSock_gethostname(n, l) gethostname(n, l) - -# define PerlSock_getnetbyaddr(n, t) getnetbyaddr(n, t) -# define PerlSock_getnetbyname(n) getnetbyname(n) -# define PerlSock_getnetent getnetent -# define PerlSock_endnetent endnetent -# define PerlSock_getpeername(s, n, l) getpeername(s, n, l) - -# define PerlSock_getprotobyname(n) getprotobyname(n) -# define PerlSock_getprotobynumber(n) getprotobynumber(n) -# define PerlSock_getprotoent getprotoent -# define PerlSock_endprotoent endprotoent - -# define PerlSock_getservbyname(n, p) getservbyname(n, p) +# define PerlSock_gethostbyname(n) gethostbyname(n) +# define PerlSock_gethostent gethostent +# define PerlSock_endhostent endhostent +# define PerlSock_gethostname(n, l) gethostname(n, l) + +# define PerlSock_getnetbyaddr(n, t) getnetbyaddr(n, t) +# define PerlSock_getnetbyname(n) getnetbyname(n) +# define PerlSock_getnetent getnetent +# define PerlSock_endnetent endnetent +# define PerlSock_getpeername(s, n, l) getpeername(s, n, l) + +# define PerlSock_getprotobyname(n) getprotobyname(n) +# define PerlSock_getprotobynumber(n) getprotobynumber(n) +# define PerlSock_getprotoent getprotoent +# define PerlSock_endprotoent endprotoent + +# define PerlSock_getservbyname(n, p) getservbyname(n, p) # define PerlSock_getservbyport(port, p) getservbyport(port, p) -# define PerlSock_getservent getservent -# define PerlSock_endservent endservent +# define PerlSock_getservent getservent +# define PerlSock_endservent endservent -# define PerlSock_getsockname(s, n, l) getsockname(s, n, l) +# define PerlSock_getsockname(s, n, l) getsockname(s, n, l) # define PerlSock_getsockopt(s,l,n,v,i) getsockopt(s, l, n, v, i) -# define PerlSock_inet_addr(c) inet_addr(c) -# define PerlSock_inet_ntoa(i) inet_ntoa(i) -# define PerlSock_listen(s, b) listen(s, b) -# define PerlSock_recv(s, b, l, f) recv(s, b, l, f) -# define PerlSock_recvfrom(s, b, l, f, from, fromlen) \ - recvfrom(s, b, l, f, from, fromlen) -# define PerlSock_select(n, r, w, e, t) select(n, r, w, e, t) -# define PerlSock_send(s, b, l, f) send(s, b, l, f) -# define PerlSock_sendto(s, b, l, f, t, tlen) \ - sendto(s, b, l, f, t, tlen) -# define PerlSock_sethostent(f) sethostent(f) -# define PerlSock_setnetent(f) setnetent(f) -# define PerlSock_setprotoent(f) setprotoent(f) -# define PerlSock_setservent(f) setservent(f) -# define PerlSock_setsockopt(s, l, n, v, len) \ - setsockopt(s, l, n, v, len) -# define PerlSock_shutdown(s, h) shutdown(s, h) -# define PerlSock_socket(a, t, p) socket(a, t, p) +# define PerlSock_inet_addr(c) inet_addr(c) +# define PerlSock_inet_ntoa(i) inet_ntoa(i) +# define PerlSock_listen(s, b) listen(s, b) +# define PerlSock_recv(s, b, l, f) recv(s, b, l, f) +# define PerlSock_recvfrom(s, b, l, f, from, fromlen) \ + recvfrom(s, b, l, f, from, fromlen) +# define PerlSock_select(n, r, w, e, t) select(n, r, w, e, t) +# define PerlSock_send(s, b, l, f) send(s, b, l, f) +# define PerlSock_sendto(s, b, l, f, t, tlen) \ + sendto(s, b, l, f, t, tlen) +# define PerlSock_sethostent(f) sethostent(f) +# define PerlSock_setnetent(f) setnetent(f) +# define PerlSock_setprotoent(f) setprotoent(f) +# define PerlSock_setservent(f) setservent(f) +# define PerlSock_setsockopt(s, l, n, v, len) \ + setsockopt(s, l, n, v, len) +# define PerlSock_shutdown(s, h) shutdown(s, h) +# define PerlSock_socket(a, t, p) socket(a, t, p) # define PerlSock_socketpair(a, t, p, f) socketpair(a, t, p, f) # ifdef WIN32 -# define PerlSock_closesocket(s) closesocket(s) +# define PerlSock_closesocket(s) closesocket(s) # endif #endif /* PERL_IMPLICIT_SYS */ @@ -1419,4 +1418,4 @@ struct IPerlSockInfo /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/malloc_ctl.h b/malloc_ctl.h index 0c72e9afcfcb..a9f9e77e695c 100644 --- a/malloc_ctl.h +++ b/malloc_ctl.h @@ -2,15 +2,15 @@ # define PERL_MALLOC_CTL_H_ struct perl_mstats { - UV *nfree; - UV *ntotal; - IV topbucket, topbucket_ev, topbucket_odd, totfree, total, total_chain; - IV total_sbrk, sbrks, sbrk_good, sbrk_slack, start_slack, sbrked_remains; - IV minbucket; + UV *nfree; + UV *ntotal; + IV topbucket, topbucket_ev, topbucket_odd, totfree, total, total_chain; + IV total_sbrk, sbrks, sbrk_good, sbrk_slack, start_slack, sbrked_remains; + IV minbucket; /* Level 1 info */ - UV *bucket_mem_size; - UV *bucket_available_size; - UV nbuckets; + UV *bucket_mem_size; + UV *bucket_available_size; + UV nbuckets; }; typedef struct perl_mstats perl_mstats_t; diff --git a/mg.h b/mg.h index a25641d10c1c..fa8b6d6b0aad 100644 --- a/mg.h +++ b/mg.h @@ -1,89 +1,94 @@ /* mg.h * - * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1999, - * 2000, 2002, 2005, 2006, 2007, 2008 by Larry Wall and others + * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1999, 2000, + * 2002, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, + * 2016, 2017, 2018, 2019, 2020, 2021, 2022 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * */ struct mgvtbl { - int (*svt_get) (pTHX_ SV *sv, MAGIC* mg); - int (*svt_set) (pTHX_ SV *sv, MAGIC* mg); - U32 (*svt_len) (pTHX_ SV *sv, MAGIC* mg); - int (*svt_clear) (pTHX_ SV *sv, MAGIC* mg); - int (*svt_free) (pTHX_ SV *sv, MAGIC* mg); - int (*svt_copy) (pTHX_ SV *sv, MAGIC* mg, - SV *nsv, const char *name, I32 namlen); - int (*svt_dup) (pTHX_ MAGIC *mg, CLONE_PARAMS *param); - int (*svt_local)(pTHX_ SV *nsv, MAGIC *mg); + int (*svt_get) (pTHX_ SV *sv, MAGIC* mg); + int (*svt_set) (pTHX_ SV *sv, MAGIC* mg); + U32 (*svt_len) (pTHX_ SV *sv, MAGIC* mg); + int (*svt_clear)(pTHX_ SV *sv, MAGIC* mg); + int (*svt_free) (pTHX_ SV *sv, MAGIC* mg); + int (*svt_copy) (pTHX_ SV *sv, MAGIC* mg, + SV *nsv, const char *name, I32 namlen); + int (*svt_dup) (pTHX_ MAGIC *mg, CLONE_PARAMS *param); + int (*svt_local)(pTHX_ SV *nsv, MAGIC *mg); }; struct magic { - MAGIC* mg_moremagic; - MGVTBL* mg_virtual; /* pointer to magic functions */ - U16 mg_private; - char mg_type; - U8 mg_flags; - SSize_t mg_len; - SV* mg_obj; - char* mg_ptr; + MAGIC *mg_moremagic; + MGVTBL *mg_virtual; /* pointer to magic functions */ + U16 mg_private; + char mg_type; + U8 mg_flags; + SSize_t mg_len; + SV *mg_obj; + char *mg_ptr; }; -#define MGf_TAINTEDDIR 1 /* PERL_MAGIC_envelem only */ -#define MGf_MINMATCH 1 /* PERL_MAGIC_regex_global only */ -#define MGf_REQUIRE_GV 1 /* PERL_MAGIC_checkcall only */ -#define MGf_REFCOUNTED 2 -#define MGf_GSKIP 4 /* skip further GETs until after next SET */ -#define MGf_COPY 8 /* has an svt_copy MGVTBL entry */ -#define MGf_DUP 0x10 /* has an svt_dup MGVTBL entry */ -#define MGf_LOCAL 0x20 /* has an svt_local MGVTBL entry */ -#define MGf_BYTES 0x40 /* PERL_MAGIC_regex_global only */ -#define MGf_PERSIST 0x80 /* PERL_MAGIC_lvref only */ +#define MGf_TAINTEDDIR 1 /* PERL_MAGIC_envelem only */ +#define MGf_MINMATCH 1 /* PERL_MAGIC_regex_global only */ +#define MGf_REQUIRE_GV 1 /* PERL_MAGIC_checkcall only */ +#define MGf_REFCOUNTED 2 +#define MGf_GSKIP 4 /* skip further GETs until after next SET */ +#define MGf_COPY 8 /* has an svt_copy MGVTBL entry */ +#define MGf_DUP 0x10 /* has an svt_dup MGVTBL entry */ +#define MGf_LOCAL 0x20 /* has an svt_local MGVTBL entry */ +#define MGf_BYTES 0x40 /* PERL_MAGIC_regex_global only */ +#define MGf_PERSIST 0x80 /* PERL_MAGIC_lvref only */ -#define MgTAINTEDDIR(mg) (mg->mg_flags & MGf_TAINTEDDIR) -#define MgTAINTEDDIR_on(mg) (mg->mg_flags |= MGf_TAINTEDDIR) -#define MgTAINTEDDIR_off(mg) (mg->mg_flags &= ~MGf_TAINTEDDIR) +#define MgTAINTEDDIR(mg) (mg->mg_flags & MGf_TAINTEDDIR) +#define MgTAINTEDDIR_on(mg) (mg->mg_flags |= MGf_TAINTEDDIR) +#define MgTAINTEDDIR_off(mg) (mg->mg_flags &= ~MGf_TAINTEDDIR) /* Extracts the SV stored in mg, or NULL. */ -#define MgSV(mg) (((int)((mg)->mg_len) == HEf_SVKEY) ? \ - MUTABLE_SV((mg)->mg_ptr) : \ - NULL) +#define MgSV(mg) \ + (((int)((mg)->mg_len) == HEf_SVKEY) ? \ + MUTABLE_SV((mg)->mg_ptr) : \ + NULL) /* If mg contains an SV, these extract the PV stored in that SV; - otherwise, these extract the mg's mg_ptr/mg_len. - These do NOT account for the SV's UTF8 flag, so handle with care. -*/ -#define MgPV(mg,lp) ((((int)(lp = (mg)->mg_len)) == HEf_SVKEY) ? \ - SvPV(MUTABLE_SV((mg)->mg_ptr),lp) : \ - (mg)->mg_ptr) -#define MgPV_const(mg,lp) ((((int)(lp = (mg)->mg_len)) == HEf_SVKEY) ? \ - SvPV_const(MUTABLE_SV((mg)->mg_ptr),lp) : \ - (const char*)(mg)->mg_ptr) -#define MgPV_nolen_const(mg) (((((int)(mg)->mg_len)) == HEf_SVKEY) ? \ - SvPV_nolen_const(MUTABLE_SV((mg)->mg_ptr)) : \ - (const char*)(mg)->mg_ptr) + otherwise, these extract the mg's mg_ptr/mg_len. These do + NOT account for the SV's UTF8 flag, so handle with care. + */ +#define MgPV(mg,lp) \ + ((((int)(lp = (mg)->mg_len)) == HEf_SVKEY) ? \ + SvPV(MUTABLE_SV((mg)->mg_ptr),lp) : \ + (mg)->mg_ptr) +#define MgPV_const(mg,lp) \ + ((((int)(lp = (mg)->mg_len)) == HEf_SVKEY) ? \ + SvPV_const(MUTABLE_SV((mg)->mg_ptr),lp) : \ + (const char*)(mg)->mg_ptr) +#define MgPV_nolen_const(mg) \ + (((((int)(mg)->mg_len)) == HEf_SVKEY) ? \ + SvPV_nolen_const(MUTABLE_SV((mg)->mg_ptr)) : \ + (const char*)(mg)->mg_ptr) -#define SvTIED_mg(sv,how) (SvRMAGICAL(sv) ? mg_find((sv),(how)) : NULL) -#define SvTIED_obj(sv,mg) \ +#define SvTIED_mg(sv,how) (SvRMAGICAL(sv) ? mg_find((sv),(how)) : NULL) +#define SvTIED_obj(sv,mg) \ ((mg)->mg_obj ? (mg)->mg_obj : sv_2mortal(newRV(sv))) #if defined(PERL_CORE) || defined(PERL_EXT) -# define MgBYTEPOS(mg,sv,pv,len) S_MgBYTEPOS(aTHX_ mg,sv,pv,len) +# define MgBYTEPOS(mg,sv,pv,len) S_MgBYTEPOS(aTHX_ mg,sv,pv,len) /* assumes get-magic and stringification have already occurred */ -# define MgBYTEPOS_set(mg,sv,pv,off) ( \ - assert_((mg)->mg_type == PERL_MAGIC_regex_global) \ - SvPOK(sv) && (!SvGMAGICAL(sv) || sv_only_taint_gmagic(sv)) \ - ? (mg)->mg_len = (off), (mg)->mg_flags |= MGf_BYTES \ - : ((mg)->mg_len = DO_UTF8(sv) \ - ? (SSize_t)utf8_length((U8 *)(pv), (U8 *)(pv)+(off)) \ - : (SSize_t)(off), \ - (mg)->mg_flags &= ~MGf_BYTES)) +# define MgBYTEPOS_set(mg,sv,pv,off) \ + ( \ + assert_((mg)->mg_type == PERL_MAGIC_regex_global) \ + SvPOK(sv) && (!SvGMAGICAL(sv) || sv_only_taint_gmagic(sv)) \ + ? (mg)->mg_len = (off), (mg)->mg_flags |= MGf_BYTES \ + : ((mg)->mg_len = DO_UTF8(sv) \ + ? (SSize_t)utf8_length((U8 *)(pv), (U8 *)(pv)+(off)) \ + : (SSize_t)(off), \ + (mg)->mg_flags &= ~MGf_BYTES)) #endif -#define whichsig(pv) whichsig_pv(pv) +#define whichsig(pv) whichsig_pv(pv) /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/mydtrace.h b/mydtrace.h index 6c66a0850980..96136d060af6 100644 --- a/mydtrace.h +++ b/mydtrace.h @@ -1,41 +1,42 @@ /* mydtrace.h * - * Copyright (C) 2008, 2010, 2011 by Larry Wall and others + * Copyright (C) 2008, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, + * 2018, 2019, 2020, 2021, 2022 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * - * Provides macros that wrap the various DTrace probes we use. We add - * an extra level of wrapping to encapsulate the _ENABLED tests. + * Provides macros that wrap the various DTrace probes we use. We add + * an extra level of wrapping to encapsulate the _ENABLED tests. */ #if defined(USE_DTRACE) && defined(PERL_CORE) # include "perldtrace.h" -# define PERL_DTRACE_PROBE_ENTRY(cv) \ - if (PERL_SUB_ENTRY_ENABLED()) \ - Perl_dtrace_probe_call(aTHX_ cv, TRUE); +# define PERL_DTRACE_PROBE_ENTRY(cv) \ + if (PERL_SUB_ENTRY_ENABLED()) \ + Perl_dtrace_probe_call(aTHX_ cv, TRUE); -# define PERL_DTRACE_PROBE_RETURN(cv) \ - if (PERL_SUB_ENTRY_ENABLED()) \ - Perl_dtrace_probe_call(aTHX_ cv, FALSE); +# define PERL_DTRACE_PROBE_RETURN(cv) \ + if (PERL_SUB_ENTRY_ENABLED()) \ + Perl_dtrace_probe_call(aTHX_ cv, FALSE); -# define PERL_DTRACE_PROBE_FILE_LOADING(name) \ - if (PERL_SUB_ENTRY_ENABLED()) \ - Perl_dtrace_probe_load(aTHX_ name, TRUE); +# define PERL_DTRACE_PROBE_FILE_LOADING(name) \ + if (PERL_SUB_ENTRY_ENABLED()) \ + Perl_dtrace_probe_load(aTHX_ name, TRUE); -# define PERL_DTRACE_PROBE_FILE_LOADED(name) \ - if (PERL_SUB_ENTRY_ENABLED()) \ - Perl_dtrace_probe_load(aTHX_ name, FALSE); +# define PERL_DTRACE_PROBE_FILE_LOADED(name) \ + if (PERL_SUB_ENTRY_ENABLED()) \ + Perl_dtrace_probe_load(aTHX_ name, FALSE); -# define PERL_DTRACE_PROBE_OP(op) \ - if (PERL_OP_ENTRY_ENABLED()) \ - Perl_dtrace_probe_op(aTHX_ op); +# define PERL_DTRACE_PROBE_OP(op) \ + if (PERL_OP_ENTRY_ENABLED()) \ + Perl_dtrace_probe_op(aTHX_ op); -# define PERL_DTRACE_PROBE_PHASE(phase) \ - if (PERL_OP_ENTRY_ENABLED()) \ - Perl_dtrace_probe_phase(aTHX_ phase); +# define PERL_DTRACE_PROBE_PHASE(phase) \ + if (PERL_OP_ENTRY_ENABLED()) \ + Perl_dtrace_probe_phase(aTHX_ phase); #else @@ -51,4 +52,4 @@ /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/nostdio.h b/nostdio.h index 10bd2b050380..85093f932a90 100644 --- a/nostdio.h +++ b/nostdio.h @@ -1,33 +1,33 @@ /* nostdio.h * - * Copyright (C) 1996, 2000, 2001, 2005, by Larry Wall and others + * Copyright (C) 1996, 2000, 2001, 2005, 2006, 2007, 2008, 2009, 2010, + * 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021, + * 2022 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * */ /* * Strong denial of stdio - make all stdio calls (we can think of) errors - */ -/* This is a 1st attempt to stop other include files pulling - in real . - A more ambitious set of possible symbols can be found in - sfio.h (inside an _cplusplus gard). - It is completely pointless as we have already included it ourselves. */ +/* This is a 1st attempt to stop other include files pulling in real + . A more ambitious set of possible symbols can be + found in sfio.h (inside an _cplusplus gard). It is completely + pointless as we have already included it ourselves. + */ #if !defined(_STDIO_H) && !defined(FILE) && !defined(_STDIO_INCLUDED) && !defined(__STDIO_LOADED) #define _STDIO_H #define _STDIO_INCLUDED #define __STDIO_LOADED struct _FILE; -#define FILE struct _FILE +#define FILE struct _FILE #endif #if !defined(OEMVS) -#define _CANNOT "CANNOT" +#define _CANNOT "CANNOT" #undef clearerr #undef fclose @@ -72,63 +72,63 @@ struct _FILE; #undef vfprintf #undef printf -#define fprintf _CANNOT _fprintf_ -#define printf _CANNOT _printf_ -#define stdin _CANNOT _stdin_ -#define stdout _CANNOT _stdout_ -#define stderr _CANNOT _stderr_ +#define fprintf _CANNOT _fprintf_ +#define printf _CANNOT _printf_ +#define stdin _CANNOT _stdin_ +#define stdout _CANNOT _stdout_ +#define stderr _CANNOT _stderr_ #ifndef OS2 -#define tmpfile() _CANNOT _tmpfile_ +#define tmpfile() _CANNOT _tmpfile_ #endif -#define fclose(f) _CANNOT _fclose_ -#define fflush(f) _CANNOT _fflush_ -#define fopen(p,m) _CANNOT _fopen_ -#define freopen(p,m,f) _CANNOT _freopen_ -#define setbuf(f,b) _CANNOT _setbuf_ -#define setvbuf(f,b,x,s) _CANNOT _setvbuf_ -#define fscanf _CANNOT _fscanf_ -#define vfprintf(f,fmt,a) _CANNOT _vfprintf_ -#define fgetc(f) _CANNOT _fgetc_ -#define fgets(s,n,f) _CANNOT _fgets_ -#define fputc(c,f) _CANNOT _fputc_ -#define fputs(s,f) _CANNOT _fputs_ -#define getc(f) _CANNOT _getc_ -#define putc(c,f) _CANNOT _putc_ +#define fclose(f) _CANNOT _fclose_ +#define fflush(f) _CANNOT _fflush_ +#define fopen(p,m) _CANNOT _fopen_ +#define freopen(p,m,f) _CANNOT _freopen_ +#define setbuf(f,b) _CANNOT _setbuf_ +#define setvbuf(f,b,x,s) _CANNOT _setvbuf_ +#define fscanf _CANNOT _fscanf_ +#define vfprintf(f,fmt,a) _CANNOT _vfprintf_ +#define fgetc(f) _CANNOT _fgetc_ +#define fgets(s,n,f) _CANNOT _fgets_ +#define fputc(c,f) _CANNOT _fputc_ +#define fputs(s,f) _CANNOT _fputs_ +#define getc(f) _CANNOT _getc_ +#define putc(c,f) _CANNOT _putc_ #ifndef OS2 -#define ungetc(c,f) _CANNOT _ungetc_ +#define ungetc(c,f) _CANNOT _ungetc_ #endif -#define fread(b,s,c,f) _CANNOT _fread_ -#define fwrite(b,s,c,f) _CANNOT _fwrite_ -#define fgetpos(f,p) _CANNOT _fgetpos_ -#define fseek(f,o,w) _CANNOT _fseek_ -#define fsetpos(f,p) _CANNOT _fsetpos_ -#define ftell(f) _CANNOT _ftell_ -#define rewind(f) _CANNOT _rewind_ -#define clearerr(f) _CANNOT _clearerr_ -#define feof(f) _CANNOT _feof_ -#define ferror(f) _CANNOT _ferror_ -#define __filbuf(f) _CANNOT __filbuf_ -#define __flsbuf(c,f) _CANNOT __flsbuf_ -#define _filbuf(f) _CANNOT _filbuf_ -#define _flsbuf(c,f) _CANNOT _flsbuf_ -#define fdopen(fd,p) _CANNOT _fdopen_ -#define fileno(f) _CANNOT _fileno_ +#define fread(b,s,c,f) _CANNOT _fread_ +#define fwrite(b,s,c,f) _CANNOT _fwrite_ +#define fgetpos(f,p) _CANNOT _fgetpos_ +#define fseek(f,o,w) _CANNOT _fseek_ +#define fsetpos(f,p) _CANNOT _fsetpos_ +#define ftell(f) _CANNOT _ftell_ +#define rewind(f) _CANNOT _rewind_ +#define clearerr(f) _CANNOT _clearerr_ +#define feof(f) _CANNOT _feof_ +#define ferror(f) _CANNOT _ferror_ +#define __filbuf(f) _CANNOT __filbuf_ +#define __flsbuf(c,f) _CANNOT __flsbuf_ +#define _filbuf(f) _CANNOT _filbuf_ +#define _flsbuf(c,f) _CANNOT _flsbuf_ +#define fdopen(fd,p) _CANNOT _fdopen_ +#define fileno(f) _CANNOT _fileno_ #if defined(SFIO_VERSION) && SFIO_VERSION < 20000101L -#define flockfile(f) _CANNOT _flockfile_ -#define ftrylockfile(f) _CANNOT _ftrylockfile_ -#define funlockfile(f) _CANNOT _funlockfile_ +#define flockfile(f) _CANNOT _flockfile_ +#define ftrylockfile(f) _CANNOT _ftrylockfile_ +#define funlockfile(f) _CANNOT _funlockfile_ #endif -#define getc_unlocked(f) _CANNOT _getc_unlocked_ +#define getc_unlocked(f) _CANNOT _getc_unlocked_ #define putc_unlocked(c,f) _CANNOT _putc_unlocked_ -#define popen(c,m) _CANNOT _popen_ -#define getw(f) _CANNOT _getw_ -#define putw(v,f) _CANNOT _putw_ +#define popen(c,m) _CANNOT _popen_ +#define getw(f) _CANNOT _getw_ +#define putw(v,f) _CANNOT _putw_ #ifndef OS2 -#define pclose(f) _CANNOT _pclose_ +#define pclose(f) _CANNOT _pclose_ #endif #endif /*not define EBCDIC */ /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/op.h b/op.h index eca5fa03a657..e496f85fe885 100644 --- a/op.h +++ b/op.h @@ -1,199 +1,191 @@ /* op.h * - * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, - * 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others + * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, + * 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, + * 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021, + * 2022 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * */ /* - * The fields of BASEOP are: - * op_next Pointer to next ppcode to execute after this one. - * (Top level pre-grafted op points to first op, - * but this is replaced when op is grafted in, when - * this op will point to the real next op, and the new - * parent takes over role of remembering starting op.) - * op_sibparent Pointer to the op's next sibling, or to the parent - * if there are no more siblings. - * op_ppaddr Pointer to current ppcode's function. - * op_targ An index into the current pad, identifying an SV - * that is typically used to store the OP's result - * (such as a lexical variable, or a SVs_PADTMP - * temporary intermediate value). - * op_type The type of the operation. - * op_opt Whether or not the op has been optimised by the - * peephole optimiser. - * op_slabbed allocated via opslab - * op_static tell op_free() to skip PerlMemShared_free(), when - * !op_slabbed. - * op_savefree on savestack via SAVEFREEOP - * op_folded Result/remainder of a constant fold operation. - * op_moresib this op is not the last sibling - * op_spare One spare bit - * op_flags Flags common to all operations. See OPf_* below. - * op_private Flags peculiar to a particular operation (BUT, - * by default, set to the number of children until - * the operation is privatized by a check routine, - * which may or may not check number of children). - */ + * The fields of BASEOP are: op_next Pointer to next ppcode to execute + * after this one. (Top level pre-grafted op points to first op, but this + * is replaced when op is grafted in, when this op will point to the real + * next op, and the new parent takes over role of remembering starting + * op.) op_sibparent Pointer to the op's next sibling, or to the parent if + * there are no more siblings. op_ppaddr Pointer to current ppcode's + * function. op_targ An index into the current pad, identifying an SV that + * is typically used to store the OP's result (such as a lexical variable, + * or a SVs_PADTMP temporary intermediate value). op_type The type of the + * operation. op_opt Whether or not the op has been optimised by the + * peephole optimiser. op_slabbed allocated via opslab op_static tell + * op_free() to skip PerlMemShared_free(), when !op_slabbed. op_savefree + * on savestack via SAVEFREEOP op_folded Result/remainder of a constant + * fold operation. op_moresib this op is not the last sibling op_spare One + * spare bit op_flags Flags common to all operations. See OPf_* below. + * op_private Flags peculiar to a particular operation (BUT, by default, + * set to the number of children until the operation is privatized by a + * check routine, which may or may not check number of children). +*/ #include "op_reg_common.h" -#define OPCODE U16 +#define OPCODE U16 typedef PERL_BITFIELD16 Optype; #ifdef BASEOP_DEFINITION -#define BASEOP BASEOP_DEFINITION +#define BASEOP BASEOP_DEFINITION #else -#define BASEOP \ - OP* op_next; \ - OP* op_sibparent; \ - OP* (*op_ppaddr)(pTHX); \ - PADOFFSET op_targ; \ - PERL_BITFIELD16 op_type:9; \ - PERL_BITFIELD16 op_opt:1; \ - PERL_BITFIELD16 op_slabbed:1; \ - PERL_BITFIELD16 op_savefree:1; \ - PERL_BITFIELD16 op_static:1; \ - PERL_BITFIELD16 op_folded:1; \ - PERL_BITFIELD16 op_moresib:1; \ - PERL_BITFIELD16 op_spare:1; \ - U8 op_flags; \ - U8 op_private; +#define BASEOP \ + OP* op_next; \ + OP* op_sibparent; \ + OP* (*op_ppaddr)(pTHX); \ + PADOFFSET op_targ; \ + PERL_BITFIELD16 op_type:9; \ + PERL_BITFIELD16 op_opt:1; \ + PERL_BITFIELD16 op_slabbed:1; \ + PERL_BITFIELD16 op_savefree:1; \ + PERL_BITFIELD16 op_static:1; \ + PERL_BITFIELD16 op_folded:1; \ + PERL_BITFIELD16 op_moresib:1; \ + PERL_BITFIELD16 op_spare:1; \ + U8 op_flags; \ + U8 op_private; #endif -#define OpTYPE_set(o,type) \ - STMT_START { \ - OP *o_ = (OP *)o; \ - OPCODE type_ = type; \ - o_->op_type = type_; \ - o_->op_ppaddr = PL_ppaddr[type_]; \ +#define OpTYPE_set(o,type) \ + STMT_START { \ + OP *o_ = (OP *)o; \ + OPCODE type_ = type; \ + o_->op_type = type_; \ + o_->op_ppaddr = PL_ppaddr[type_]; \ } STMT_END -/* If op_type:9 is changed to :10, also change cx_pusheval() - Also, if the type of op_type is ever changed (e.g. to PERL_BITFIELD32) +/* If op_type:9 is changed to :10, also change cx_pusheval() Also, if + the type of op_type is ever changed (e.g. to PERL_BITFIELD32) then all the other bit-fields before/after it should change their - types too to let VC pack them into the same 4 byte integer.*/ + types too to let VC pack them into the same 4 byte integer. */ /* for efficiency, requires OPf_WANT_VOID == G_VOID etc */ -#define OP_GIMME(op,dfl) \ - (((op)->op_flags & OPf_WANT) ? ((op)->op_flags & OPf_WANT) : dfl) +#define OP_GIMME(op,dfl) \ + (((op)->op_flags & OPf_WANT) ? ((op)->op_flags & OPf_WANT) : dfl) -#define OP_GIMME_REVERSE(flags) ((flags) & G_WANT) +#define OP_GIMME_REVERSE(flags) ((flags) & G_WANT) /* =for apidoc_section $callback =for apidoc Amn|U32|GIMME_V -The XSUB-writer's equivalent to Perl's C. Returns C, -C or C for void, scalar or list context, -respectively. See L for a usage example. +The XSUB-writer's equivalent to Perl's C. Returns +C, C or C for void, scalar or list +context, respectively. See L for a usage example. =for apidoc AmnD|U32|GIMME -A backward-compatible version of C which can only return -C or C; in a void context, it returns C. -Deprecated. Use C instead. +A backward-compatible version of C which can only +return C or C; in a void context, it returns +C. Deprecated. Use C instead. =cut */ -#define GIMME_V Perl_gimme_V(aTHX) +#define GIMME_V Perl_gimme_V(aTHX) /* Public flags */ -#define OPf_WANT 3 /* Mask for "want" bits: */ -#define OPf_WANT_VOID 1 /* Want nothing */ -#define OPf_WANT_SCALAR 2 /* Want single value */ -#define OPf_WANT_LIST 3 /* Want list of any length */ -#define OPf_KIDS 4 /* There is a firstborn child. */ -#define OPf_PARENS 8 /* This operator was parenthesized. */ - /* (Or block needs explicit scope entry.) */ -#define OPf_REF 16 /* Certified reference. */ - /* (Return container, not containee). */ -#define OPf_MOD 32 /* Will modify (lvalue). */ - -#define OPf_STACKED 64 /* Some arg is arriving on the stack. */ +#define OPf_WANT 3 /* Mask for "want" bits: */ +#define OPf_WANT_VOID 1 /* Want nothing */ +#define OPf_WANT_SCALAR 2 /* Want single value */ +#define OPf_WANT_LIST 3 /* Want list of any length */ +#define OPf_KIDS 4 /* There is a firstborn child. */ +#define OPf_PARENS 8 /* This operator was parenthesized. */ + /* (Or block needs explicit scope entry.) */ +#define OPf_REF 16 /* Certified reference. */ + /* (Return container, not containee). */ +#define OPf_MOD 32 /* Will modify (lvalue). */ + +#define OPf_STACKED 64 /* Some arg is arriving on the stack. */ /* Indicates mutator-variant of op for those - * ops which support them, e.g. $x += 1 + * ops which support them, e.g. $x += 1 */ -#define OPf_SPECIAL 128 /* Do something weird for this op: */ - /* On local LVAL, don't init local value. */ - /* On OP_SORT, subroutine is inlined. */ - /* On OP_NOT, inversion was implicit. */ +#define OPf_SPECIAL 128 /* Do something weird for this op: */ + /* On local LVAL, don't init local value. */ + /* On OP_SORT, subroutine is inlined. */ + /* On OP_NOT, inversion was implicit. */ /* On OP_LEAVE, don't restore curpm, e.g. * /(...)/ while ...>; */ - /* On truncate, we truncate filehandle */ - /* On control verbs, we saw no label */ + /* On truncate, we truncate filehandle */ + /* On control verbs, we saw no label */ /* On flipflop, we saw ... instead of .. */ - /* On UNOPs, saw bare parens, e.g. eof(). */ - /* On OP_CHDIR, handle (or bare parens) */ - /* On OP_NULL, saw a "do". */ - /* On OP_EXISTS, treat av as av, not avhv. */ - /* On OP_(ENTER|LEAVE)EVAL, don't clear $@ */ - /* On regcomp, "use re 'eval'" was in scope */ - /* On RV2[ACGHS]V, don't create GV--in - defined()*/ + /* On UNOPs, saw bare parens, e.g. eof(). */ + /* On OP_CHDIR, handle (or bare parens) */ + /* On OP_NULL, saw a "do". */ + /* On OP_EXISTS, treat av as av, not avhv. */ + /* On OP_(ENTER|LEAVE)EVAL, don't clear $@ */ + /* On regcomp, "use re 'eval'" was in scope */ + /* On RV2[ACGHS]V, don't create + GV--in defined() */ /* On OP_DBSTATE, indicates breakpoint - * (runtime property) */ - /* On OP_REQUIRE, was seen as CORE::require */ - /* On OP_(ENTER|LEAVE)WHEN, there's - no condition */ - /* On OP_SMARTMATCH, an implicit smartmatch */ - /* On OP_ANONHASH and OP_ANONLIST, create a - reference to the new anon hash or array */ - /* On OP_HELEM, OP_MULTIDEREF and OP_HSLICE, - localization will be followed by assignment, - so do not wipe the target if it is special - (e.g. a glob or a magic SV) */ - /* On OP_MATCH, OP_SUBST & OP_TRANS, the - operand of a logical or conditional - that was optimised away, so it should - not be bound via =~ */ - /* On OP_CONST, from a constant CV */ - /* On OP_GLOB, two meanings: - - Before ck_glob, called as CORE::glob - - After ck_glob, use Perl glob function + * (runtime property) */ + /* On OP_REQUIRE, was seen as CORE::require */ + /* On OP_(ENTER|LEAVE)WHEN, + there's no condition */ + /* On OP_SMARTMATCH, an implicit smartmatch */ + /* On OP_ANONHASH and OP_ANONLIST, create a + reference to the new anon hash or array */ + /* On OP_HELEM, OP_MULTIDEREF and OP_HSLICE, + localization will be followed by assignment, + so do not wipe the target if it is special + (e.g. a glob or a magic SV) */ + /* On OP_MATCH, OP_SUBST & OP_TRANS, the + operand of a logical or conditional + that was optimised away, so it should + not be bound via =~ */ + /* On OP_CONST, from a constant CV */ + /* On OP_GLOB, two meanings: - Before + ck_glob, called as CORE::glob - After + ck_glob, use Perl glob function */ - /* On OP_PADRANGE, push @_ */ - /* On OP_DUMP, has no label */ - /* On OP_UNSTACK, in a C-style for loop */ - /* On OP_READLINE, it's for <<>>, not <> */ - /* On OP_RETURN, module_true is in effect */ - /* On OP_NEXT/OP_LAST/OP_REDO, there is no - * loop label */ -/* There is no room in op_flags for this one, so it has its own bit- - field member (op_folded) instead. The flag is only used to tell - op_convert_list to set op_folded. */ + /* On OP_PADRANGE, push @_ */ + /* On OP_DUMP, has no label */ + /* On OP_UNSTACK, in a C-style for loop */ + /* On OP_READLINE, it's for <<>>, not <> */ + /* On OP_RETURN, module_true is in effect */ + /* On OP_NEXT/OP_LAST/OP_REDO, + * there is no loop label */ +/* There is no room in op_flags for this one, so it has its + own bit- field member (op_folded) instead. The flag is + only used to tell op_convert_list to set op_folded. */ #define OPf_FOLDED (1<<16) /* old names; don't use in new code, but don't break them, either */ -#define OPf_LIST OPf_WANT_LIST -#define OPf_KNOW OPf_WANT +#define OPf_LIST OPf_WANT_LIST +#define OPf_KNOW OPf_WANT #if !defined(PERL_CORE) && !defined(PERL_EXT) -# define GIMME \ - (PL_op->op_flags & OPf_WANT \ - ? ((PL_op->op_flags & OPf_WANT) == OPf_WANT_LIST \ - ? G_LIST \ - : G_SCALAR) \ - : dowantarray()) +# define GIMME \ + (PL_op->op_flags & OPf_WANT \ + ? ((PL_op->op_flags & OPf_WANT) == OPf_WANT_LIST \ + ? G_LIST \ + : G_SCALAR) \ + : dowantarray()) #endif -/* NOTE: OPp* flags are now auto-generated and defined in opcode.h, - * from data in regen/op_private */ +/* NOTE: OPp* flags are now auto-generated and defined + * in opcode.h, from data in regen/op_private */ -#define OPpTRANS_ALL (OPpTRANS_USE_SVOP|OPpTRANS_CAN_FORCE_UTF8|OPpTRANS_IDENTICAL|OPpTRANS_SQUASH|OPpTRANS_COMPLEMENT|OPpTRANS_GROWS|OPpTRANS_DELETE) -#define OPpTRANS_FROM_UTF OPpTRANS_USE_SVOP -#define OPpTRANS_TO_UTF OPpTRANS_CAN_FORCE_UTF8 +#define OPpTRANS_ALL \ + (OPpTRANS_USE_SVOP|OPpTRANS_CAN_FORCE_UTF8|OPpTRANS_IDENTICAL|OPpTRANS_SQUASH|OPpTRANS_COMPLEMENT|OPpTRANS_GROWS|OPpTRANS_DELETE) +#define OPpTRANS_FROM_UTF OPpTRANS_USE_SVOP +#define OPpTRANS_TO_UTF OPpTRANS_CAN_FORCE_UTF8 -/* Mask for OP_ENTERSUB flags, the absence of which must be propagated - in dynamic context */ +/* Mask for OP_ENTERSUB flags, the absence of which + must be propagated in dynamic context */ #define OPpENTERSUB_LVAL_MASK (OPpLVAL_INTRO|OPpENTERSUB_INARGS) @@ -208,9 +200,9 @@ typedef union { } UNOP_AUX_item; #ifdef USE_ITHREADS -# define UNOP_AUX_item_sv(item) PAD_SVl((item)->pad_offset); +# define UNOP_AUX_item_sv(item) PAD_SVl((item)->pad_offset); #else -# define UNOP_AUX_item_sv(item) ((item)->sv); +# define UNOP_AUX_item_sv(item) ((item)->sv); #endif @@ -222,177 +214,178 @@ struct op { struct unop { BASEOP - OP * op_first; + OP *op_first; }; struct unop_aux { BASEOP - OP *op_first; - UNOP_AUX_item *op_aux; + OP *op_first; + UNOP_AUX_item *op_aux; }; struct binop { BASEOP - OP * op_first; - OP * op_last; + OP *op_first; + OP *op_last; }; struct logop { BASEOP - OP * op_first; + OP *op_first; /* Note that op->op_other is the *next* op in execution order of the - * alternate branch, not the root of the subtree. I.e. imagine it being - * called ->op_otherfirst. - * To find the structural subtree root (what could be called - * ->op_otherroot), use OpSIBLING of ->op_first */ - OP * op_other; + * alternate branch, not the root of the subtree. I.e. imagine it being + * called ->op_otherfirst. To find the structural subtree root (what + * could be called ->op_otherroot), use OpSIBLING of ->op_first */ + OP *op_other; }; struct listop { BASEOP - OP * op_first; - OP * op_last; + OP *op_first; + OP *op_last; }; struct methop { BASEOP - union { - /* op_u.op_first *must* be aligned the same as the op_first - * field of the other op types */ - OP* op_first; /* optree for method name */ - SV* op_meth_sv; /* static method name */ - } op_u; + union { /* op_u.op_first *must* be aligned the same as the + * op_first field of the other op types */ + OP *op_first; /* optree for method name */ + SV *op_meth_sv; /* static method name */ + } op_u; #ifdef USE_ITHREADS - PADOFFSET op_rclass_targ; /* pad index for redirect class */ + PADOFFSET op_rclass_targ; /* pad index for redirect class */ #else - SV* op_rclass_sv; /* static redirect class $o->A::meth() */ + SV *op_rclass_sv; /* static redirect class $o->A::meth() */ #endif }; struct pmop { BASEOP - OP * op_first; - OP * op_last; + OP *op_first; + OP *op_last; #ifdef USE_ITHREADS PADOFFSET op_pmoffset; #else - REGEXP * op_pmregexp; /* compiled expression */ + REGEXP *op_pmregexp; /* compiled expression */ #endif U32 op_pmflags; union { - OP * op_pmreplroot; /* For OP_SUBST */ - PADOFFSET op_pmtargetoff; /* For OP_SPLIT lex ary or thr GV */ - GV * op_pmtargetgv; /* For OP_SPLIT non-threaded GV */ - } op_pmreplrootu; + OP *op_pmreplroot; /* For OP_SUBST */ + PADOFFSET op_pmtargetoff; /* For OP_SPLIT lex ary or thr GV */ + GV *op_pmtargetgv; /* For OP_SPLIT non-threaded GV */ + } op_pmreplrootu; union { - OP * op_pmreplstart; /* Only used in OP_SUBST */ + OP *op_pmreplstart; /* Only used in OP_SUBST */ #ifdef USE_ITHREADS - PADOFFSET op_pmstashoff; /* Only used in OP_MATCH, with PMf_ONCE set */ + PADOFFSET op_pmstashoff; /* Only used in OP_MATCH, + with PMf_ONCE set */ #else - HV * op_pmstash; + HV *op_pmstash; #endif - } op_pmstashstartu; - OP * op_code_list; /* list of (?{}) code blocks */ + } op_pmstashstartu; + OP *op_code_list; /* list of (?{}) code blocks */ }; #ifdef USE_ITHREADS -#define PM_GETRE(o) (SvTYPE(PL_regex_pad[(o)->op_pmoffset]) == SVt_REGEXP \ - ? (REGEXP*)(PL_regex_pad[(o)->op_pmoffset]) : NULL) +#define PM_GETRE(o) \ + (SvTYPE(PL_regex_pad[(o)->op_pmoffset]) == SVt_REGEXP \ + ? (REGEXP*)(PL_regex_pad[(o)->op_pmoffset]) : NULL) /* The assignment is just to enforce type safety (or at least get a warning). */ /* With first class regexps not via a reference one needs to assign - &PL_sv_undef under ithreads. (This would probably work unthreaded, but NULL - is cheaper. I guess we could allow NULL, but the check above would get - more complex, and we'd have an AV with (SV*)NULL in it, which feels bad */ -/* BEWARE - something that calls this macro passes (r) which has a side - effect. */ -#define PM_SETRE(o,r) STMT_START { \ - REGEXP *const _pm_setre = (r); \ - assert(_pm_setre); \ - PL_regex_pad[(o)->op_pmoffset] = MUTABLE_SV(_pm_setre); \ - } STMT_END + &PL_sv_undef under ithreads. (This would probably work unthreaded, but NULL + is cheaper. I guess we could allow NULL, but the check above would get more + complex, and we'd have an AV with (SV*)NULL in it, which feels bad */ +/* BEWARE - something that calls this macro + passes (r) which has a side effect. */ +#define PM_SETRE(o,r) \ + STMT_START { \ + REGEXP *const _pm_setre = (r); \ + assert(_pm_setre); \ + PL_regex_pad[(o)->op_pmoffset] = MUTABLE_SV(_pm_setre); \ + } STMT_END #else #define PM_GETRE(o) ((o)->op_pmregexp) #define PM_SETRE(o,r) ((o)->op_pmregexp = (r)) #endif /* Currently these PMf flags occupy a single 32-bit word. Not all bits are - * currently used. The lower bits are shared with their corresponding RXf flag - * bits, up to but not including _RXf_PMf_SHIFT_NEXT. The unused bits - * immediately follow; finally the used Pmf-only (unshared) bits, so that the - * highest bit in the word is used. This gathers all the unused bits as a pool - * in the middle, like so: 11111111111111110000001111111111 - * where the '1's represent used bits, and the '0's unused. This design allows - * us to allocate off one end of the pool if we need to add a shared bit, and - * off the other end if we need a non-shared bit, without disturbing the other - * bits. This maximizes the likelihood of being able to change things without - * breaking binary compatibility. + * currently used. The lower bits are shared with their corresponding RXf + * flag bits, up to but not including _RXf_PMf_SHIFT_NEXT. The unused bits + * immediately follow; finally the used Pmf-only (unshared) bits, so that + * the highest bit in the word is used. This gathers all the unused bits as + * a pool in the middle, like so: 11111111111111110000001111111111 where the + * '1's represent used bits, and the '0's unused. This design allows us to + * allocate off one end of the pool if we need to add a shared bit, and off + * the other end if we need a non-shared bit, without disturbing the other + * bits. This maximizes the likelihood of being able to change things + * without breaking binary compatibility. * * To add shared bits, do so in op_reg_common.h. This should change - * _RXf_PMf_SHIFT_NEXT so that things won't compile. Then come to regexp.h and - * op.h and adjust the constant adders in the definitions of PMf_BASE_SHIFT and - * Pmf_BASE_SHIFT down by the number of shared bits you added. That's it. - * Things should be binary compatible. But if either of these gets to having - * to subtract rather than add, leave at 0 and adjust all the entries below - * that are in terms of this according. But if the first one of those is - * already PMf_BASE_SHIFT+0, there are no bits left, and a redesign is in - * order. + * _RXf_PMf_SHIFT_NEXT so that things won't compile. Then come to regexp.h + * and op.h and adjust the constant adders in the definitions of + * PMf_BASE_SHIFT and Pmf_BASE_SHIFT down by the number of shared bits you + * added. That's it. Things should be binary compatible. But if either of + * these gets to having to subtract rather than add, leave at 0 and adjust + * all the entries below that are in terms of this according. But if the + * first one of those is already PMf_BASE_SHIFT+0, there are no bits left, + * and a redesign is in order. * * To remove unshared bits, just delete its entry. If you're where breaking * binary compatibility is ok to do, you might want to adjust things to move * the newly opened space so that it gets absorbed into the common pool. * * To add unshared bits, first use up any gaps in the middle. Otherwise, - * allocate off the low end until you get to PMf_BASE_SHIFT+0. If that isn't - * enough, move PMf_BASE_SHIFT down (if possible) and add the new bit at the - * other end instead; this preserves binary compatibility. */ -#define PMf_BASE_SHIFT (_RXf_PMf_SHIFT_NEXT+2) + * allocate off the low end until you get to PMf_BASE_SHIFT+0. If that + * isn't enough, move PMf_BASE_SHIFT down (if possible) and add the new bit + * at the other end instead; this preserves binary compatibility. */ +#define PMf_BASE_SHIFT (_RXf_PMf_SHIFT_NEXT+2) -/* Set by the parser if it discovers an error, so the regex shouldn't be - * compiled */ -#define PMf_HAS_ERROR (1U<<(PMf_BASE_SHIFT+3)) +/* Set by the parser if it discovers an error, + * so the regex shouldn't be compiled */ +#define PMf_HAS_ERROR (1U<<(PMf_BASE_SHIFT+3)) -/* 'use re "taint"' in scope: taint $1 etc. if target tainted */ -#define PMf_RETAINT (1U<<(PMf_BASE_SHIFT+4)) +/* 'use re "taint"' in scope: taint $1 etc. if target tainted */ +#define PMf_RETAINT (1U<<(PMf_BASE_SHIFT+4)) -/* match successfully only once per reset, with related flag RXf_USED in - * re->extflags holding state. This is used only for ?? matches, and only on - * OP_MATCH and OP_QR */ -#define PMf_ONCE (1U<<(PMf_BASE_SHIFT+5)) +/* match successfully only once per reset, with related flag + * RXf_USED in re->extflags holding state. This is used + * only for ?? matches, and only on OP_MATCH and OP_QR */ +#define PMf_ONCE (1U<<(PMf_BASE_SHIFT+5)) -/* PMf_ONCE, i.e. ?pat?, has matched successfully. Not used under threading. */ +/* PMf_ONCE, i.e. ?pat?, has matched successfully. + Not used under threading. */ #define PMf_USED (1U<<(PMf_BASE_SHIFT+6)) /* subst replacement is constant */ -#define PMf_CONST (1U<<(PMf_BASE_SHIFT+7)) +#define PMf_CONST (1U<<(PMf_BASE_SHIFT+7)) /* keep 1st runtime pattern forever */ -#define PMf_KEEP (1U<<(PMf_BASE_SHIFT+8)) +#define PMf_KEEP (1U<<(PMf_BASE_SHIFT+8)) -#define PMf_GLOBAL (1U<<(PMf_BASE_SHIFT+9)) /* pattern had a g modifier */ +#define PMf_GLOBAL (1U<<(PMf_BASE_SHIFT+9)) /* pattern had a g modifier */ /* don't reset pos() if //g fails */ -#define PMf_CONTINUE (1U<<(PMf_BASE_SHIFT+10)) +#define PMf_CONTINUE (1U<<(PMf_BASE_SHIFT+10)) /* evaluating replacement as expr */ -#define PMf_EVAL (1U<<(PMf_BASE_SHIFT+11)) +#define PMf_EVAL (1U<<(PMf_BASE_SHIFT+11)) /* Return substituted string instead of modifying it. */ -#define PMf_NONDESTRUCT (1U<<(PMf_BASE_SHIFT+12)) +#define PMf_NONDESTRUCT (1U<<(PMf_BASE_SHIFT+12)) /* the pattern has a CV attached (currently only under qr/...(?{}).../) */ -#define PMf_HAS_CV (1U<<(PMf_BASE_SHIFT+13)) +#define PMf_HAS_CV (1U<<(PMf_BASE_SHIFT+13)) -/* op_code_list is private; don't free it etc. It may well point to - * code within another sub, with different pad etc */ -#define PMf_CODELIST_PRIVATE (1U<<(PMf_BASE_SHIFT+14)) +/* op_code_list is private; don't free it etc. It may well point + * to code within another sub, with different pad etc */ +#define PMf_CODELIST_PRIVATE (1U<<(PMf_BASE_SHIFT+14)) -/* the PMOP is a QR (we should be able to detect that from the op type, - * but the regex compilation API passes just the pm flags, not the op - * itself */ -#define PMf_IS_QR (1U<<(PMf_BASE_SHIFT+15)) -#define PMf_USE_RE_EVAL (1U<<(PMf_BASE_SHIFT+16)) /* use re'eval' in scope */ +/* the PMOP is a QR (we should be able to detect that from the op type, but the + * regex compilation API passes just the pm flags, not the op itself */ +#define PMf_IS_QR (1U<<(PMf_BASE_SHIFT+15)) +#define PMf_USE_RE_EVAL (1U<<(PMf_BASE_SHIFT+16)) /* use re'eval' in scope */ /* Means that this is a subpattern being compiled while processing a \p{} * wildcard. This isn't called from op.c, but it is passed as a pm flag. */ @@ -408,103 +401,105 @@ struct pmop { #ifdef USE_ITHREADS -# define PmopSTASH(o) ((o)->op_pmflags & PMf_ONCE \ - ? PL_stashpad[(o)->op_pmstashstartu.op_pmstashoff] \ - : NULL) -# define PmopSTASH_set(o,hv) \ - (assert_((o)->op_pmflags & PMf_ONCE) \ - (o)->op_pmstashstartu.op_pmstashoff = \ - (hv) ? alloccopstash(hv) : 0) +# define PmopSTASH(o) \ + ((o)->op_pmflags & PMf_ONCE \ + ? PL_stashpad[(o)->op_pmstashstartu.op_pmstashoff] \ + : NULL) +# define PmopSTASH_set(o,hv) \ + (assert_((o)->op_pmflags & PMf_ONCE) \ + (o)->op_pmstashstartu.op_pmstashoff = \ + (hv) ? alloccopstash(hv) : 0) #else -# define PmopSTASH(o) \ - (((o)->op_pmflags & PMf_ONCE) ? (o)->op_pmstashstartu.op_pmstash : NULL) +# define PmopSTASH(o) \ + (((o)->op_pmflags & PMf_ONCE) ? (o)->op_pmstashstartu.op_pmstash : NULL) # if defined (DEBUGGING) && defined(PERL_USE_GCC_BRACE_GROUPS) -# define PmopSTASH_set(o,hv) ({ \ - assert((o)->op_pmflags & PMf_ONCE); \ - ((o)->op_pmstashstartu.op_pmstash = (hv)); \ - }) +# define PmopSTASH_set(o,hv) \ + ({ \ + assert((o)->op_pmflags & PMf_ONCE); \ + ((o)->op_pmstashstartu.op_pmstash = (hv)); \ + }) # else -# define PmopSTASH_set(o,hv) ((o)->op_pmstashstartu.op_pmstash = (hv)) +# define PmopSTASH_set(o,hv) ((o)->op_pmstashstartu.op_pmstash = (hv)) # endif #endif -#define PmopSTASHPV(o) (PmopSTASH(o) ? HvNAME_get(PmopSTASH(o)) : NULL) +#define PmopSTASHPV(o) (PmopSTASH(o) ? HvNAME_get(PmopSTASH(o)) : NULL) /* op_pmstashstartu.op_pmstash is not refcounted */ -#define PmopSTASHPV_set(o,pv) PmopSTASH_set((o), gv_stashpv(pv,GV_ADD)) +#define PmopSTASHPV_set(o,pv) PmopSTASH_set((o), gv_stashpv(pv,GV_ADD)) struct svop { BASEOP - SV * op_sv; + SV *op_sv; }; struct padop { BASEOP - PADOFFSET op_padix; + PADOFFSET op_padix; }; struct pvop { BASEOP - char * op_pv; + char *op_pv; }; struct loop { BASEOP - OP * op_first; - OP * op_last; - OP * op_redoop; - OP * op_nextop; - OP * op_lastop; + OP *op_first; + OP *op_last; + OP *op_redoop; + OP *op_nextop; + OP *op_lastop; }; -#define cUNOPx(o) ((UNOP*)(o)) -#define cUNOP_AUXx(o) ((UNOP_AUX*)(o)) -#define cBINOPx(o) ((BINOP*)(o)) -#define cLISTOPx(o) ((LISTOP*)(o)) -#define cLOGOPx(o) ((LOGOP*)(o)) -#define cPMOPx(o) ((PMOP*)(o)) -#define cSVOPx(o) ((SVOP*)(o)) -#define cPADOPx(o) ((PADOP*)(o)) -#define cPVOPx(o) ((PVOP*)(o)) -#define cCOPx(o) ((COP*)(o)) -#define cLOOPx(o) ((LOOP*)(o)) -#define cMETHOPx(o) ((METHOP*)(o)) - -#define cUNOP cUNOPx(PL_op) -#define cUNOP_AUX cUNOP_AUXx(PL_op) -#define cBINOP cBINOPx(PL_op) -#define cLISTOP cLISTOPx(PL_op) -#define cLOGOP cLOGOPx(PL_op) -#define cPMOP cPMOPx(PL_op) -#define cSVOP cSVOPx(PL_op) -#define cPADOP cPADOPx(PL_op) -#define cPVOP cPVOPx(PL_op) -#define cCOP cCOPx(PL_op) -#define cLOOP cLOOPx(PL_op) +#define cUNOPx(o) ((UNOP*)(o)) +#define cUNOP_AUXx(o) ((UNOP_AUX*)(o)) +#define cBINOPx(o) ((BINOP*)(o)) +#define cLISTOPx(o) ((LISTOP*)(o)) +#define cLOGOPx(o) ((LOGOP*)(o)) +#define cPMOPx(o) ((PMOP*)(o)) +#define cSVOPx(o) ((SVOP*)(o)) +#define cPADOPx(o) ((PADOP*)(o)) +#define cPVOPx(o) ((PVOP*)(o)) +#define cCOPx(o) ((COP*)(o)) +#define cLOOPx(o) ((LOOP*)(o)) +#define cMETHOPx(o) ((METHOP*)(o)) + +#define cUNOP cUNOPx(PL_op) +#define cUNOP_AUX cUNOP_AUXx(PL_op) +#define cBINOP cBINOPx(PL_op) +#define cLISTOP cLISTOPx(PL_op) +#define cLOGOP cLOGOPx(PL_op) +#define cPMOP cPMOPx(PL_op) +#define cSVOP cSVOPx(PL_op) +#define cPADOP cPADOPx(PL_op) +#define cPVOP cPVOPx(PL_op) +#define cCOP cCOPx(PL_op) +#define cLOOP cLOOPx(PL_op) #define cMETHOP cMETHOPx(PL_op) -#define cUNOPo cUNOPx(o) -#define cUNOP_AUXo cUNOP_AUXx(o) -#define cBINOPo cBINOPx(o) -#define cLISTOPo cLISTOPx(o) -#define cLOGOPo cLOGOPx(o) -#define cPMOPo cPMOPx(o) -#define cSVOPo cSVOPx(o) -#define cPADOPo cPADOPx(o) -#define cPVOPo cPVOPx(o) -#define cCOPo cCOPx(o) -#define cLOOPo cLOOPx(o) +#define cUNOPo cUNOPx(o) +#define cUNOP_AUXo cUNOP_AUXx(o) +#define cBINOPo cBINOPx(o) +#define cLISTOPo cLISTOPx(o) +#define cLOGOPo cLOGOPx(o) +#define cPMOPo cPMOPx(o) +#define cSVOPo cSVOPx(o) +#define cPADOPo cPADOPx(o) +#define cPVOPo cPVOPx(o) +#define cCOPo cCOPx(o) +#define cLOOPo cLOOPx(o) #define cMETHOPo cMETHOPx(o) -#define kUNOP cUNOPx(kid) -#define kUNOP_AUX cUNOP_AUXx(kid) -#define kBINOP cBINOPx(kid) -#define kLISTOP cLISTOPx(kid) -#define kLOGOP cLOGOPx(kid) -#define kPMOP cPMOPx(kid) -#define kSVOP cSVOPx(kid) -#define kPADOP cPADOPx(kid) -#define kPVOP cPVOPx(kid) -#define kCOP cCOPx(kid) -#define kLOOP cLOOPx(kid) +#define kUNOP cUNOPx(kid) +#define kUNOP_AUX cUNOP_AUXx(kid) +#define kBINOP cBINOPx(kid) +#define kLISTOP cLISTOPx(kid) +#define kLOGOP cLOGOPx(kid) +#define kPMOP cPMOPx(kid) +#define kSVOP cSVOPx(kid) +#define kPADOP cPADOPx(kid) +#define kPVOP cPVOPx(kid) +#define kCOP cCOPx(kid) +#define kLOOP cLOOPx(kid) #define kMETHOP cMETHOPx(kid) @@ -527,139 +522,137 @@ typedef enum { #ifdef USE_ITHREADS -# define cGVOPx_gv(o) ((GV*)PAD_SVl(cPADOPx(o)->op_padix)) +# define cGVOPx_gv(o) ((GV*)PAD_SVl(cPADOPx(o)->op_padix)) # ifndef PERL_CORE -# define IS_PADGV(v) (v && isGV(v)) -# define IS_PADCONST(v) \ - (v && (SvREADONLY(v) || (SvIsCOW(v) && !SvLEN(v)))) +# define IS_PADGV(v) (v && isGV(v)) +# define IS_PADCONST(v) \ + (v && (SvREADONLY(v) || (SvIsCOW(v) && !SvLEN(v)))) # endif -# define cSVOPx_sv(v) (cSVOPx(v)->op_sv \ - ? cSVOPx(v)->op_sv : PAD_SVl((v)->op_targ)) -# define cSVOPx_svp(v) (cSVOPx(v)->op_sv \ - ? &cSVOPx(v)->op_sv : &PAD_SVl((v)->op_targ)) -# define cMETHOPx_meth(v) (cMETHOPx(v)->op_u.op_meth_sv \ - ? cMETHOPx(v)->op_u.op_meth_sv : PAD_SVl((v)->op_targ)) -# define cMETHOPx_rclass(v) PAD_SVl(cMETHOPx(v)->op_rclass_targ) +# define cSVOPx_sv(v) \ + (cSVOPx(v)->op_sv ? cSVOPx(v)->op_sv : PAD_SVl((v)->op_targ)) +# define cSVOPx_svp(v) \ + (cSVOPx(v)->op_sv ? &cSVOPx(v)->op_sv : &PAD_SVl((v)->op_targ)) +# define cMETHOPx_meth(v) \ + (cMETHOPx(v)->op_u.op_meth_sv \ + ? cMETHOPx(v)->op_u.op_meth_sv : PAD_SVl((v)->op_targ)) +# define cMETHOPx_rclass(v) PAD_SVl(cMETHOPx(v)->op_rclass_targ) #else -# define cGVOPx_gv(o) ((GV*)cSVOPx(o)->op_sv) +# define cGVOPx_gv(o) ((GV*)cSVOPx(o)->op_sv) # ifndef PERL_CORE -# define IS_PADGV(v) FALSE -# define IS_PADCONST(v) FALSE +# define IS_PADGV(v) FALSE +# define IS_PADCONST(v) FALSE # endif -# define cSVOPx_sv(v) (cSVOPx(v)->op_sv) -# define cSVOPx_svp(v) (&cSVOPx(v)->op_sv) -# define cMETHOPx_meth(v) (cMETHOPx(v)->op_u.op_meth_sv) -# define cMETHOPx_rclass(v) (cMETHOPx(v)->op_rclass_sv) +# define cSVOPx_sv(v) (cSVOPx(v)->op_sv) +# define cSVOPx_svp(v) (&cSVOPx(v)->op_sv) +# define cMETHOPx_meth(v) (cMETHOPx(v)->op_u.op_meth_sv) +# define cMETHOPx_rclass(v) (cMETHOPx(v)->op_rclass_sv) #endif -#define cMETHOP_meth cMETHOPx_meth(PL_op) -#define cMETHOP_rclass cMETHOPx_rclass(PL_op) +#define cMETHOP_meth cMETHOPx_meth(PL_op) +#define cMETHOP_rclass cMETHOPx_rclass(PL_op) -#define cMETHOPo_meth cMETHOPx_meth(o) -#define cMETHOPo_rclass cMETHOPx_rclass(o) +#define cMETHOPo_meth cMETHOPx_meth(o) +#define cMETHOPo_rclass cMETHOPx_rclass(o) -#define cGVOP_gv cGVOPx_gv(PL_op) -#define cGVOPo_gv cGVOPx_gv(o) -#define kGVOP_gv cGVOPx_gv(kid) -#define cSVOP_sv cSVOPx_sv(PL_op) -#define cSVOPo_sv cSVOPx_sv(o) -#define kSVOP_sv cSVOPx_sv(kid) +#define cGVOP_gv cGVOPx_gv(PL_op) +#define cGVOPo_gv cGVOPx_gv(o) +#define kGVOP_gv cGVOPx_gv(kid) +#define cSVOP_sv cSVOPx_sv(PL_op) +#define cSVOPo_sv cSVOPx_sv(o) +#define kSVOP_sv cSVOPx_sv(kid) #ifndef PERL_CORE -# define Nullop ((OP*)NULL) +# define Nullop ((OP*)NULL) #endif /* Lowest byte of PL_opargs */ -#define OA_MARK 1 -#define OA_FOLDCONST 2 -#define OA_RETSCALAR 4 -#define OA_TARGET 8 -#define OA_TARGLEX 16 -#define OA_OTHERINT 32 -#define OA_DANGEROUS 64 -#define OA_DEFGV 128 +#define OA_MARK 1 +#define OA_FOLDCONST 2 +#define OA_RETSCALAR 4 +#define OA_TARGET 8 +#define OA_TARGLEX 16 +#define OA_OTHERINT 32 +#define OA_DANGEROUS 64 +#define OA_DEFGV 128 /* The next 4 bits (8..11) encode op class information */ -#define OCSHIFT 8 - -#define OA_CLASS_MASK (15 << OCSHIFT) - -#define OA_BASEOP (0 << OCSHIFT) -#define OA_UNOP (1 << OCSHIFT) -#define OA_BINOP (2 << OCSHIFT) -#define OA_LOGOP (3 << OCSHIFT) -#define OA_LISTOP (4 << OCSHIFT) -#define OA_PMOP (5 << OCSHIFT) -#define OA_SVOP (6 << OCSHIFT) -#define OA_PADOP (7 << OCSHIFT) +#define OCSHIFT 8 + +#define OA_CLASS_MASK (15 << OCSHIFT) + +#define OA_BASEOP (0 << OCSHIFT) +#define OA_UNOP (1 << OCSHIFT) +#define OA_BINOP (2 << OCSHIFT) +#define OA_LOGOP (3 << OCSHIFT) +#define OA_LISTOP (4 << OCSHIFT) +#define OA_PMOP (5 << OCSHIFT) +#define OA_SVOP (6 << OCSHIFT) +#define OA_PADOP (7 << OCSHIFT) #define OA_PVOP_OR_SVOP (8 << OCSHIFT) -#define OA_LOOP (9 << OCSHIFT) -#define OA_COP (10 << OCSHIFT) +#define OA_LOOP (9 << OCSHIFT) +#define OA_COP (10 << OCSHIFT) #define OA_BASEOP_OR_UNOP (11 << OCSHIFT) -#define OA_FILESTATOP (12 << OCSHIFT) -#define OA_LOOPEXOP (13 << OCSHIFT) -#define OA_METHOP (14 << OCSHIFT) -#define OA_UNOP_AUX (15 << OCSHIFT) - -/* Each remaining nybble of PL_opargs (i.e. bits 12..15, 16..19 etc) - * encode the type for each arg */ -#define OASHIFT 12 - -#define OA_SCALAR 1 -#define OA_LIST 2 -#define OA_AVREF 3 -#define OA_HVREF 4 -#define OA_CVREF 5 -#define OA_FILEREF 6 -#define OA_SCALARREF 7 -#define OA_OPTIONAL 8 - -/* Op_REFCNT is a reference count at the head of each op tree: needed - * since the tree is shared between threads, and between cloned closure - * copies in the same thread. OP_REFCNT_LOCK/UNLOCK is used when modifying - * this count. - * The same mutex is used to protect the refcounts of the reg_trie_data - * and reg_ac_data structures, which are shared between duplicated - * regexes. - * The same mutex is used to protect the refcounts for RCPV objects. +#define OA_FILESTATOP (12 << OCSHIFT) +#define OA_LOOPEXOP (13 << OCSHIFT) +#define OA_METHOP (14 << OCSHIFT) +#define OA_UNOP_AUX (15 << OCSHIFT) + +/* Each remaining nybble of PL_opargs (i.e. bits 12..15, + * 16..19 etc) encode the type for each arg */ +#define OASHIFT 12 + +#define OA_SCALAR 1 +#define OA_LIST 2 +#define OA_AVREF 3 +#define OA_HVREF 4 +#define OA_CVREF 5 +#define OA_FILEREF 6 +#define OA_SCALARREF 7 +#define OA_OPTIONAL 8 + +/* Op_REFCNT is a reference count at the head of each op tree: needed since + * the tree is shared between threads, and between cloned closure copies in + * the same thread. OP_REFCNT_LOCK/UNLOCK is used when modifying this count. + * The same mutex is used to protect the refcounts of the reg_trie_data and + * reg_ac_data structures, which are shared between duplicated regexes. The + * same mutex is used to protect the refcounts for RCPV objects. */ #ifdef USE_ITHREADS -# define OP_REFCNT_INIT MUTEX_INIT(&PL_op_mutex) +# define OP_REFCNT_INIT MUTEX_INIT(&PL_op_mutex) # ifdef PERL_CORE -# define OP_REFCNT_LOCK MUTEX_LOCK(&PL_op_mutex) -# define OP_REFCNT_UNLOCK MUTEX_UNLOCK(&PL_op_mutex) +# define OP_REFCNT_LOCK MUTEX_LOCK(&PL_op_mutex) +# define OP_REFCNT_UNLOCK MUTEX_UNLOCK(&PL_op_mutex) # else /* Subject non-core uses to clang thread safety analysis */ -# define OP_REFCNT_LOCK op_refcnt_lock() -# define OP_REFCNT_UNLOCK op_refcnt_unlock() +# define OP_REFCNT_LOCK op_refcnt_lock() +# define OP_REFCNT_UNLOCK op_refcnt_unlock() # endif -# define OP_REFCNT_TERM MUTEX_DESTROY(&PL_op_mutex) +# define OP_REFCNT_TERM MUTEX_DESTROY(&PL_op_mutex) #else -# define OP_REFCNT_INIT NOOP -# define OP_REFCNT_LOCK NOOP -# define OP_REFCNT_UNLOCK NOOP -# define OP_REFCNT_TERM NOOP +# define OP_REFCNT_INIT NOOP +# define OP_REFCNT_LOCK NOOP +# define OP_REFCNT_UNLOCK NOOP +# define OP_REFCNT_TERM NOOP #endif -#define OpREFCNT_set(o,n) ((o)->op_targ = (n)) +#define OpREFCNT_set(o,n) ((o)->op_targ = (n)) #ifdef PERL_DEBUG_READONLY_OPS -# define OpREFCNT_inc(o) Perl_op_refcnt_inc(aTHX_ o) -# define OpREFCNT_dec(o) Perl_op_refcnt_dec(aTHX_ o) +# define OpREFCNT_inc(o) Perl_op_refcnt_inc(aTHX_ o) +# define OpREFCNT_dec(o) Perl_op_refcnt_dec(aTHX_ o) #else -# define OpREFCNT_inc(o) ((o) ? (++(o)->op_targ, (o)) : NULL) -# define OpREFCNT_dec(o) (--(o)->op_targ) +# define OpREFCNT_inc(o) ((o) ? (++(o)->op_targ, (o)) : NULL) +# define OpREFCNT_dec(o) (--(o)->op_targ) #endif /* flags used by Perl_load_module() */ -#define PERL_LOADMOD_DENY 0x1 /* no Module */ -#define PERL_LOADMOD_NOIMPORT 0x2 /* use Module () */ -#define PERL_LOADMOD_IMPORT_OPS 0x4 /* import arguments - are passed as a sin- - gle op tree, not a - list of SVs */ +#define PERL_LOADMOD_DENY 0x1 /* no Module */ +#define PERL_LOADMOD_NOIMPORT 0x2 /* use Module () */ +#define PERL_LOADMOD_IMPORT_OPS 0x4 /* import arguments are passed + as a sin- gle op tree, not + a list of SVs */ #if defined(PERL_IN_PERLY_C) || defined(PERL_IN_OP_C) || defined(PERL_IN_TOKE_C) -#define ref(o, type) doref(o, type, TRUE) +#define ref(o, type) doref(o, type, TRUE) #endif @@ -676,111 +669,110 @@ typedef struct { =for apidoc Am|OP*|LINKLIST|OP *o Given the root of an optree, link the tree in execution order using the -C pointers and return the first op executed. If this has -already been done, it will not be redone, and C<< o->op_next >> will be -returned. If C<< o->op_next >> is not already set, C should be at -least an C. +C pointers and return the first op executed. If this has already been +done, it will not be redone, and C<< o->op_next >> will be returned. If C<< +o->op_next >> is not already set, C should be at least an C. =cut */ -#define LINKLIST(o) ((o)->op_next ? (o)->op_next : op_linklist((OP*)o)) +#define LINKLIST(o) ((o)->op_next ? (o)->op_next : op_linklist((OP*)o)) /* no longer used anywhere in core */ #ifndef PERL_CORE -#define cv_ckproto(cv, gv, p) \ - cv_ckproto_len_flags((cv), (gv), (p), (p) ? strlen(p) : 0, 0) +#define cv_ckproto(cv, gv, p) \ + cv_ckproto_len_flags((cv), (gv), (p), (p) ? strlen(p) : 0, 0) #endif #ifdef PERL_CORE -# define my(o) my_attrs((o), NULL) +# define my(o) my_attrs((o), NULL) #endif #ifdef USE_REENTRANT_API #include "reentr.h" #endif -#define NewOp(m,var,c,type) \ - (var = (type *) Perl_Slab_Alloc(aTHX_ c*sizeof(type))) -#define NewOpSz(m,var,size) \ - (var = (OP *) Perl_Slab_Alloc(aTHX_ size)) -#define FreeOp(p) Perl_Slab_Free(aTHX_ p) +#define NewOp(m,var,c,type) \ + (var = (type *) Perl_Slab_Alloc(aTHX_ c*sizeof(type))) +#define NewOpSz(m,var,size) \ + (var = (OP *) Perl_Slab_Alloc(aTHX_ size)) +#define FreeOp(p) Perl_Slab_Free(aTHX_ p) /* - * The per-CV op slabs consist of a header (the opslab struct) and a bunch - * of space for allocating op slots, each of which consists of two pointers + * The per-CV op slabs consist of a header (the opslab struct) and a bunch of + * space for allocating op slots, each of which consists of two pointers * followed by an op. The first pointer points to the next op slot. The - * second points to the slab. At the end of the slab is a null pointer, - * so that slot->opslot_next - slot can be used to determine the size - * of the op. + * second points to the slab. At the end of the slab is a null pointer, so + * that slot->opslot_next - slot can be used to determine the size of the op. * * Each CV can have multiple slabs; opslab_next points to the next slab, to - * form a chain. All bookkeeping is done on the first slab, which is where - * all the op slots point. + * form a chain. All bookkeeping is done on the first slab, which is where all + * the op slots point. * - * Freed ops are marked as freed and attached to the freed chain - * via op_next pointers. + * Freed ops are marked as freed and attached to the freed chain via op_next + * pointers. * * When there is more than one slab, the second slab in the slab chain is * assumed to be the one with free space available. It is used when allo- * cating an op if there are no freed ops available or big enough. - */ +*/ #ifdef PERL_CORE struct opslot { - U16 opslot_size; /* size of this slot (in pointers) */ - U16 opslot_offset; /* offset from start of slab (in ptr units) */ - OP opslot_op; /* the op itself */ + U16 opslot_size; /* size of this slot (in pointers) */ + U16 opslot_offset; /* offset from start of slab (in ptr units) */ + OP opslot_op; /* the op itself */ }; struct opslab { - OPSLAB * opslab_next; /* next slab */ - OPSLAB * opslab_head; /* first slab in chain */ - OP ** opslab_freed; /* array of sized chains of freed ops (head only)*/ - size_t opslab_refcnt; /* number of ops (head slab only) */ - U16 opslab_freed_size; /* allocated size of opslab_freed */ - U16 opslab_size; /* size of slab in pointers, - including header */ - U16 opslab_free_space; /* space available in this slab - for allocating new ops (in ptr - units) */ + OPSLAB *opslab_next; /* next slab */ + OPSLAB *opslab_head; /* first slab in chain */ + OP **opslab_freed; /* array of sized chains of freed + ops (head only) */ + size_t opslab_refcnt; /* number of ops (head slab only) */ + U16 opslab_freed_size; /* allocated size of opslab_freed */ + U16 opslab_size; /* size of slab in pointers, + including header */ + U16 opslab_free_space; /* space available in this slab for allocating + new ops (in ptr units) */ # ifdef PERL_DEBUG_READONLY_OPS - bool opslab_readonly; + bool opslab_readonly; # endif - OPSLOT opslab_slots; /* slots begin here */ + OPSLOT opslab_slots; /* slots begin here */ }; -# define OPSLOT_HEADER STRUCT_OFFSET(OPSLOT, opslot_op) -# define OpSLOT(o) (assert_(o->op_slabbed) \ - (OPSLOT *)(((char *)o)-OPSLOT_HEADER)) +# define OPSLOT_HEADER STRUCT_OFFSET(OPSLOT, opslot_op) +# define OpSLOT(o) \ + (assert_(o->op_slabbed) \ + (OPSLOT *)(((char *)o)-OPSLOT_HEADER)) /* the slab that owns this op */ -# define OpMySLAB(o) \ - ((OPSLAB*)((char *)((I32**)OpSLOT(o) - OpSLOT(o)->opslot_offset)-STRUCT_OFFSET(struct opslab, opslab_slots))) +# define OpMySLAB(o) \ + ((OPSLAB*)((char *)((I32**)OpSLOT(o) - OpSLOT(o)->opslot_offset)-STRUCT_OFFSET(struct opslab, opslab_slots))) /* the first (head) opslab of the chain in which this op is allocated */ -# define OpSLAB(o) \ - (OpMySLAB(o)->opslab_head) +# define OpSLAB(o) \ + (OpMySLAB(o)->opslab_head) /* calculate the slot given the owner slab and an offset */ #define OpSLOToff(slab, offset) \ ((OPSLOT*)(((I32 **)&(slab)->opslab_slots)+(offset))) -# define OpslabREFCNT_dec(slab) \ - (((slab)->opslab_refcnt == 1) \ - ? opslab_free_nopad(slab) \ - : (void)--(slab)->opslab_refcnt) +# define OpslabREFCNT_dec(slab) \ + (((slab)->opslab_refcnt == 1) \ + ? opslab_free_nopad(slab) \ + : (void)--(slab)->opslab_refcnt) /* Variant that does not null out the pads */ -# define OpslabREFCNT_dec_padok(slab) \ - (((slab)->opslab_refcnt == 1) \ - ? opslab_free(slab) \ - : (void)--(slab)->opslab_refcnt) +# define OpslabREFCNT_dec_padok(slab) \ + (((slab)->opslab_refcnt == 1) \ + ? opslab_free(slab) \ + : (void)--(slab)->opslab_refcnt) #endif struct block_hooks { - U32 bhk_flags; - void (*bhk_start) (pTHX_ int full); - void (*bhk_pre_end) (pTHX_ OP **seq); - void (*bhk_post_end) (pTHX_ OP **seq); - void (*bhk_eval) (pTHX_ OP *const saveop); + U32 bhk_flags; + void (*bhk_start) (pTHX_ int full); + void (*bhk_pre_end) (pTHX_ OP **seq); + void (*bhk_post_end)(pTHX_ OP **seq); + void (*bhk_eval) (pTHX_ OP *const saveop); }; /* @@ -791,25 +783,23 @@ Return the BHK's flags. =for apidoc mxu|void *|BhkENTRY|BHK *hk|token which Return an entry from the BHK structure. C is a preprocessor token -indicating which entry to return. If the appropriate flag is not set -this will return C. The type of the return value depends on which -entry you ask for. +indicating which entry to return. If the appropriate flag is not set this will +return C. The type of the return value depends on which entry you ask +for. =for apidoc Amxu|void|BhkENTRY_set|BHK *hk|token which|void *ptr -Set an entry in the BHK structure, and set the flags to indicate it is -valid. C is a preprocessing token indicating which entry to set. -The type of C depends on the entry. +Set an entry in the BHK structure, and set the flags to indicate it is valid. +C is a preprocessing token indicating which entry to set. The type of +C depends on the entry. =for apidoc Amxu|void|BhkDISABLE|BHK *hk|token which -Temporarily disable an entry in this BHK structure, by clearing the -appropriate flag. C is a preprocessor token indicating which -entry to disable. +Temporarily disable an entry in this BHK structure, by clearing the appropriate +flag. C is a preprocessor token indicating which entry to disable. =for apidoc Amxu|void|BhkENABLE|BHK *hk|token which -Re-enable an entry in this BHK structure, by setting the appropriate -flag. C is a preprocessor token indicating which entry to enable. -This will assert (under -DDEBUGGING) if the entry doesn't contain a valid -pointer. +Re-enable an entry in this BHK structure, by setting the appropriate flag. +C is a preprocessor token indicating which entry to enable. This will +assert (under -DDEBUGGING) if the entry doesn't contain a valid pointer. =for apidoc mxu|void|CALL_BLOCK_HOOKS|token which|arg Call all the registered block hooks for type C. C is a @@ -818,68 +808,69 @@ preprocessing token; the type of C depends on C. =cut */ -#define BhkFLAGS(hk) ((hk)->bhk_flags) +#define BhkFLAGS(hk) ((hk)->bhk_flags) -#define BHKf_bhk_start 0x01 -#define BHKf_bhk_pre_end 0x02 -#define BHKf_bhk_post_end 0x04 -#define BHKf_bhk_eval 0x08 +#define BHKf_bhk_start 0x01 +#define BHKf_bhk_pre_end 0x02 +#define BHKf_bhk_post_end 0x04 +#define BHKf_bhk_eval 0x08 #define BhkENTRY(hk, which) \ ((BhkFLAGS(hk) & BHKf_ ## which) ? ((hk)->which) : NULL) -#define BhkENABLE(hk, which) \ - STMT_START { \ +#define BhkENABLE(hk, which) \ + STMT_START { \ BhkFLAGS(hk) |= BHKf_ ## which; \ - assert(BhkENTRY(hk, which)); \ + assert(BhkENTRY(hk, which)); \ } STMT_END -#define BhkDISABLE(hk, which) \ - STMT_START { \ - BhkFLAGS(hk) &= ~(BHKf_ ## which); \ +#define BhkDISABLE(hk, which) \ + STMT_START { \ + BhkFLAGS(hk) &= ~(BHKf_ ## which); \ } STMT_END -#define BhkENTRY_set(hk, which, ptr) \ - STMT_START { \ - (hk)->which = ptr; \ - BhkENABLE(hk, which); \ +#define BhkENTRY_set(hk, which, ptr) \ + STMT_START { \ + (hk)->which = ptr; \ + BhkENABLE(hk, which); \ } STMT_END -#define CALL_BLOCK_HOOKS(which, arg) \ - STMT_START { \ - if (PL_blockhooks) { \ - SSize_t i; \ - for (i = av_top_index(PL_blockhooks); i >= 0; i--) { \ - SV *sv = AvARRAY(PL_blockhooks)[i]; \ - BHK *hk; \ - \ - assert(SvIOK(sv)); \ - if (SvUOK(sv)) \ - hk = INT2PTR(BHK *, SvUVX(sv)); \ - else \ - hk = INT2PTR(BHK *, SvIVX(sv)); \ - \ - if (BhkENTRY(hk, which)) \ - BhkENTRY(hk, which)(aTHX_ arg); \ - } \ - } \ +#define CALL_BLOCK_HOOKS(which, arg) \ + STMT_START { \ + if (PL_blockhooks) { \ + SSize_t i; \ + for (i = av_top_index(PL_blockhooks); i >= 0; i--) { \ + SV *sv = AvARRAY(PL_blockhooks)[i]; \ + BHK *hk; \ + \ + assert(SvIOK(sv)); \ + if (SvUOK(sv)) \ + hk = INT2PTR(BHK *, SvUVX(sv)); \ + else \ + hk = INT2PTR(BHK *, SvIVX(sv)); \ + \ + if (BhkENTRY(hk, which)) \ + BhkENTRY(hk, which)(aTHX_ arg); \ + } \ + } \ } STMT_END /* flags for rv2cv_op_cv */ -#define RV2CVOPCV_MARK_EARLY 0x00000001 +#define RV2CVOPCV_MARK_EARLY 0x00000001 #define RV2CVOPCV_RETURN_NAME_GV 0x00000002 -#define RV2CVOPCV_RETURN_STUB 0x00000004 -#if defined(PERL_CORE) || defined(PERL_EXT) /* behaviour of this flag is subject to change: */ -# define RV2CVOPCV_MAYBE_NAME_GV 0x00000008 +#define RV2CVOPCV_RETURN_STUB 0x00000004 +#if defined(PERL_CORE) || \ + defined(PERL_EXT) /* behaviour of this flag is subject to change: */ +# define RV2CVOPCV_MAYBE_NAME_GV 0x00000008 #endif -#define RV2CVOPCV_FLAG_MASK 0x0000000f /* all of the above */ +#define RV2CVOPCV_FLAG_MASK 0x0000000f /* all of the above */ -#define op_lvalue(op,t) Perl_op_lvalue_flags(aTHX_ op,t,0) +#define op_lvalue(op,t) Perl_op_lvalue_flags(aTHX_ op,t,0) /* flags for op_lvalue_flags */ -#define OP_LVALUE_NO_CROAK 1 +#define OP_LVALUE_NO_CROAK 1 /* =for apidoc_section $custom @@ -888,22 +879,20 @@ preprocessing token; the type of C depends on C. Return the XOP's flags. =for apidoc Amu||XopENTRY|XOP *xop|token which -Return a member of the XOP structure. C is a cpp token -indicating which entry to return. If the member is not set -this will return a default value. The return type depends -on C. This macro evaluates its arguments more than -once. If you are using C to retrieve a -C from a C, use the more efficient L instead. +Return a member of the XOP structure. C is a cpp token indicating which +entry to return. If the member is not set this will return a default value. +The return type depends on C. This macro evaluates its arguments more +than once. If you are using C to retrieve a C from +a C, use the more efficient L instead. =for apidoc Amu||XopENTRYCUSTOM|const OP *o|token which Exactly like C but more efficient. The C parameter is identical to L. =for apidoc Amu|void|XopENTRY_set|XOP *xop|token which|value -Set a member of the XOP structure. C is a cpp token -indicating which entry to set. See L -for details about the available members and how -they are used. This macro evaluates its argument +Set a member of the XOP structure. C is a cpp token indicating which +entry to set. See L for details about the +available members and how they are used. This macro evaluates its argument more than once. =for apidoc Amu|void|XopDISABLE|XOP *xop|token which @@ -916,30 +905,30 @@ Reenable a member of the XOP which has been disabled. */ struct custom_op { - U32 xop_flags; - const char *xop_name; - const char *xop_desc; - U32 xop_class; - void (*xop_peep)(pTHX_ OP *o, OP *oldop); + U32 xop_flags; + const char *xop_name; + const char *xop_desc; + U32 xop_class; + void (*xop_peep)(pTHX_ OP *o, OP *oldop); }; -/* return value of Perl_custom_op_get_field, similar to void * then casting but - the U32 doesn't need truncation on 64 bit platforms in the caller, also - for easier macro writing */ +/* return value of Perl_custom_op_get_field, similar to void * + then casting but the U32 doesn't need truncation on 64 bit + platforms in the caller, also for easier macro writing */ typedef union { - const char *xop_name; - const char *xop_desc; - U32 xop_class; - void (*xop_peep)(pTHX_ OP *o, OP *oldop); + const char *xop_name; + const char *xop_desc; + U32 xop_class; + void (*xop_peep)(pTHX_ OP *o, OP *oldop); XOP *xop_ptr; } XOPRETANY; -#define XopFLAGS(xop) ((xop)->xop_flags) +#define XopFLAGS(xop) ((xop)->xop_flags) -#define XOPf_xop_name 0x01 -#define XOPf_xop_desc 0x02 -#define XOPf_xop_class 0x04 -#define XOPf_xop_peep 0x08 +#define XOPf_xop_name 0x01 +#define XOPf_xop_desc 0x02 +#define XOPf_xop_class 0x04 +#define XOPf_xop_peep 0x08 /* used by Perl_custom_op_get_field for option checking */ typedef enum { @@ -950,71 +939,68 @@ typedef enum { XOPe_xop_peep = XOPf_xop_peep } xop_flags_enum; -#define XOPd_xop_name PL_op_name[OP_CUSTOM] -#define XOPd_xop_desc PL_op_desc[OP_CUSTOM] -#define XOPd_xop_class OA_BASEOP -#define XOPd_xop_peep ((Perl_cpeep_t)0) +#define XOPd_xop_name PL_op_name[OP_CUSTOM] +#define XOPd_xop_desc PL_op_desc[OP_CUSTOM] +#define XOPd_xop_class OA_BASEOP +#define XOPd_xop_peep ((Perl_cpeep_t)0) -#define XopENTRY_set(xop, which, to) \ - STMT_START { \ - (xop)->which = (to); \ +#define XopENTRY_set(xop, which, to) \ + STMT_START { \ + (xop)->which = (to); \ (xop)->xop_flags |= XOPf_ ## which; \ } STMT_END -#define XopENTRY(xop, which) \ +#define XopENTRY(xop, which) \ ((XopFLAGS(xop) & XOPf_ ## which) ? (xop)->which : XOPd_ ## which) -#define XopENTRYCUSTOM(o, which) \ +#define XopENTRYCUSTOM(o, which) \ (Perl_custom_op_get_field(aTHX_ o, XOPe_ ## which).which) -#define XopDISABLE(xop, which) ((xop)->xop_flags &= ~XOPf_ ## which) -#define XopENABLE(xop, which) \ - STMT_START { \ +#define XopDISABLE(xop, which) ((xop)->xop_flags &= ~XOPf_ ## which) +#define XopENABLE(xop, which) \ + STMT_START { \ (xop)->xop_flags |= XOPf_ ## which; \ - assert(XopENTRY(xop, which)); \ + assert(XopENTRY(xop, which)); \ } STMT_END -#define Perl_custom_op_xop(x) \ +#define Perl_custom_op_xop(x) \ (Perl_custom_op_get_field(x, XOPe_xop_ptr).xop_ptr) /* =for apidoc_section $optree_manipulation =for apidoc Am|const char *|OP_NAME|OP *o -Return the name of the provided OP. For core ops this looks up the name -from the op_type; for custom ops from the op_ppaddr. +Return the name of the provided OP. For core ops this looks up the name from +the op_type; for custom ops from the op_ppaddr. =for apidoc Am|const char *|OP_DESC|OP *o Return a short description of the provided OP. =for apidoc Am|U32|OP_CLASS|OP *o -Return the class of the provided OP: that is, which of the *OP -structures it uses. For core ops this currently gets the information out -of C, which does not always accurately reflect the type used; -in v5.26 onwards, see also the function C> which can do a better -job of determining the used type. +Return the class of the provided OP: that is, which of the *OP structures it +uses. For core ops this currently gets the information out of C, +which does not always accurately reflect the type used; in v5.26 onwards, see +also the function C> which can do a better job of determining the +used type. -For custom ops the type is returned from the registration, and it is up -to the registree to ensure it is accurate. The value returned will be -one of the C* constants from F. +For custom ops the type is returned from the registration, and it is up to the +registree to ensure it is accurate. The value returned will be one of the +C* constants from F. =for apidoc Am|bool|OP_TYPE_IS|OP *o|Optype type -Returns true if the given OP is not a C pointer -and if it is of the given type. +Returns true if the given OP is not a C pointer and if it is of the given +type. -The negation of this macro, C is also available -as well as C and C which elide -the NULL pointer check. +The negation of this macro, C is also available as well as +C and C which elide the NULL pointer check. =for apidoc Am|bool|OP_TYPE_IS_OR_WAS|OP *o|Optype type -Returns true if the given OP is not a NULL pointer and -if it is of the given type or used to be before being -replaced by an OP of type OP_NULL. +Returns true if the given OP is not a NULL pointer and if it is of the given +type or used to be before being replaced by an OP of type OP_NULL. -The negation of this macro, C -is also available as well as C -and C which elide -the C pointer check. +The negation of this macro, C is also available as well +as C and C which elide the +C pointer check. =for apidoc Am|bool|OpHAS_SIBLING|OP *o Returns true if C has a sibling @@ -1023,85 +1009,89 @@ Returns true if C has a sibling Returns the sibling of C, or C if there is no sibling =for apidoc Am|void|OpMORESIB_set|OP *o|OP *sib -Sets the sibling of C to the non-zero value C. See also C> -and C>. For a higher-level interface, see -C>. +Sets the sibling of C to the non-zero value C. See also +C> and C>. For a higher-level interface, +see C>. =for apidoc Am|void|OpLASTSIB_set|OP *o|OP *parent -Marks C as having no further siblings and marks -o as having the specified parent. See also C> and -C. For a higher-level interface, see -C>. +Marks C as having no further siblings and marks o as having the specified +parent. See also C> and C. For a +higher-level interface, see C>. =for apidoc Am|void|OpMAYBESIB_set|OP *o|OP *sib|OP *parent Conditionally does C or C depending on whether -C is non-null. For a higher-level interface, see C>. +C is non-null. For a higher-level interface, see +C>. =cut */ -#define OP_NAME(o) ((o)->op_type == OP_CUSTOM \ - ? XopENTRYCUSTOM(o, xop_name) \ - : PL_op_name[(o)->op_type]) -#define OP_DESC(o) ((o)->op_type == OP_CUSTOM \ - ? XopENTRYCUSTOM(o, xop_desc) \ - : PL_op_desc[(o)->op_type]) -#define OP_CLASS(o) ((o)->op_type == OP_CUSTOM \ - ? XopENTRYCUSTOM(o, xop_class) \ - : (PL_opargs[(o)->op_type] & OA_CLASS_MASK)) - -#define OP_TYPE_IS(o, type) ((o) && (o)->op_type == (type)) -#define OP_TYPE_IS_NN(o, type) ((o)->op_type == (type)) -#define OP_TYPE_ISNT(o, type) ((o) && (o)->op_type != (type)) +#define OP_NAME(o) \ + ((o)->op_type == OP_CUSTOM \ + ? XopENTRYCUSTOM(o, xop_name) \ + : PL_op_name[(o)->op_type]) +#define OP_DESC(o) \ + ((o)->op_type == OP_CUSTOM \ + ? XopENTRYCUSTOM(o, xop_desc) \ + : PL_op_desc[(o)->op_type]) +#define OP_CLASS(o) \ + ((o)->op_type == OP_CUSTOM \ + ? XopENTRYCUSTOM(o, xop_class) \ + : (PL_opargs[(o)->op_type] & OA_CLASS_MASK)) + +#define OP_TYPE_IS(o, type) ((o) && (o)->op_type == (type)) +#define OP_TYPE_IS_NN(o, type) ((o)->op_type == (type)) +#define OP_TYPE_ISNT(o, type) ((o) && (o)->op_type != (type)) #define OP_TYPE_ISNT_NN(o, type) ((o)->op_type != (type)) -#define OP_TYPE_IS_OR_WAS_NN(o, type) \ - ( ((o)->op_type == OP_NULL \ - ? (o)->op_targ \ - : (o)->op_type) \ +#define OP_TYPE_IS_OR_WAS_NN(o, type) \ + ( ((o)->op_type == OP_NULL \ + ? (o)->op_targ \ + : (o)->op_type) \ == (type) ) -#define OP_TYPE_IS_OR_WAS(o, type) \ +#define OP_TYPE_IS_OR_WAS(o, type) \ ( (o) && OP_TYPE_IS_OR_WAS_NN(o, type) ) -#define OP_TYPE_ISNT_AND_WASNT_NN(o, type) \ - ( ((o)->op_type == OP_NULL \ - ? (o)->op_targ \ - : (o)->op_type) \ +#define OP_TYPE_ISNT_AND_WASNT_NN(o, type) \ + ( ((o)->op_type == OP_NULL \ + ? (o)->op_targ \ + : (o)->op_type) \ != (type) ) #define OP_TYPE_ISNT_AND_WASNT(o, type) \ ( (o) && OP_TYPE_ISNT_AND_WASNT_NN(o, type) ) /* should match anything that uses ck_ftst in regen/opcodes */ -#define OP_IS_STAT(op) (OP_IS_FILETEST(op) || (op) == OP_LSTAT || (op) == OP_STAT) +#define OP_IS_STAT(op) \ + (OP_IS_FILETEST(op) || (op) == OP_LSTAT || (op) == OP_STAT) -#define OpHAS_SIBLING(o) (cBOOL((o)->op_moresib)) -#define OpSIBLING(o) (0 + (o)->op_moresib ? (o)->op_sibparent : NULL) -#define OpMORESIB_set(o, sib) ((o)->op_moresib = 1, (o)->op_sibparent = (sib)) -#define OpLASTSIB_set(o, parent) \ +#define OpHAS_SIBLING(o) (cBOOL((o)->op_moresib)) +#define OpSIBLING(o) (0 + (o)->op_moresib ? (o)->op_sibparent : NULL) +#define OpMORESIB_set(o, sib) ((o)->op_moresib = 1, (o)->op_sibparent = (sib)) +#define OpLASTSIB_set(o, parent) \ ((o)->op_moresib = 0, (o)->op_sibparent = (parent)) -#define OpMAYBESIB_set(o, sib, parent) \ +#define OpMAYBESIB_set(o, sib, parent) \ ((o)->op_sibparent = ((o)->op_moresib = cBOOL(sib)) ? (sib) : (parent)) #if !defined(PERL_CORE) && !defined(PERL_EXT) /* for backwards compatibility only */ -# define OP_SIBLING(o) OpSIBLING(o) +# define OP_SIBLING(o) OpSIBLING(o) #endif #define newATTRSUB(f, o, p, a, b) Perl_newATTRSUB_x(aTHX_ f, o, p, a, b, FALSE) -#define newSUB(f, o, p, b) newATTRSUB((f), (o), (p), NULL, (b)) +#define newSUB(f, o, p, b) newATTRSUB((f), (o), (p), NULL, (b)) #ifdef USE_ITHREADS -# define OP_CHECK_MUTEX_INIT MUTEX_INIT(&PL_check_mutex) -# define OP_CHECK_MUTEX_LOCK MUTEX_LOCK(&PL_check_mutex) -# define OP_CHECK_MUTEX_UNLOCK MUTEX_UNLOCK(&PL_check_mutex) -# define OP_CHECK_MUTEX_TERM MUTEX_DESTROY(&PL_check_mutex) +# define OP_CHECK_MUTEX_INIT MUTEX_INIT(&PL_check_mutex) +# define OP_CHECK_MUTEX_LOCK MUTEX_LOCK(&PL_check_mutex) +# define OP_CHECK_MUTEX_UNLOCK MUTEX_UNLOCK(&PL_check_mutex) +# define OP_CHECK_MUTEX_TERM MUTEX_DESTROY(&PL_check_mutex) #else -# define OP_CHECK_MUTEX_INIT NOOP -# define OP_CHECK_MUTEX_LOCK NOOP -# define OP_CHECK_MUTEX_UNLOCK NOOP -# define OP_CHECK_MUTEX_TERM NOOP +# define OP_CHECK_MUTEX_INIT NOOP +# define OP_CHECK_MUTEX_LOCK NOOP +# define OP_CHECK_MUTEX_UNLOCK NOOP +# define OP_CHECK_MUTEX_TERM NOOP #endif @@ -1109,70 +1099,73 @@ C is non-null. For a higher-level interface, see C>. /* actions */ -/* Load another word of actions/flag bits. Must be 0 */ -#define MDEREF_reload 0 +/* Load another word of actions/flag bits. Must be 0 */ +#define MDEREF_reload 0 -#define MDEREF_AV_pop_rv2av_aelem 1 -#define MDEREF_AV_gvsv_vivify_rv2av_aelem 2 -#define MDEREF_AV_padsv_vivify_rv2av_aelem 3 -#define MDEREF_AV_vivify_rv2av_aelem 4 -#define MDEREF_AV_padav_aelem 5 -#define MDEREF_AV_gvav_aelem 6 +#define MDEREF_AV_pop_rv2av_aelem 1 +#define MDEREF_AV_gvsv_vivify_rv2av_aelem 2 +#define MDEREF_AV_padsv_vivify_rv2av_aelem 3 +#define MDEREF_AV_vivify_rv2av_aelem 4 +#define MDEREF_AV_padav_aelem 5 +#define MDEREF_AV_gvav_aelem 6 -#define MDEREF_HV_pop_rv2hv_helem 8 -#define MDEREF_HV_gvsv_vivify_rv2hv_helem 9 -#define MDEREF_HV_padsv_vivify_rv2hv_helem 10 -#define MDEREF_HV_vivify_rv2hv_helem 11 -#define MDEREF_HV_padhv_helem 12 -#define MDEREF_HV_gvhv_helem 13 +#define MDEREF_HV_pop_rv2hv_helem 8 +#define MDEREF_HV_gvsv_vivify_rv2hv_helem 9 +#define MDEREF_HV_padsv_vivify_rv2hv_helem 10 +#define MDEREF_HV_vivify_rv2hv_helem 11 +#define MDEREF_HV_padhv_helem 12 +#define MDEREF_HV_gvhv_helem 13 -#define MDEREF_ACTION_MASK 0xf +#define MDEREF_ACTION_MASK 0xf /* key / index type */ -#define MDEREF_INDEX_none 0x00 /* run external ops to generate index */ -#define MDEREF_INDEX_const 0x10 /* index is const PV/UV */ -#define MDEREF_INDEX_padsv 0x20 /* index is lexical var */ -#define MDEREF_INDEX_gvsv 0x30 /* index is GV */ +#define MDEREF_INDEX_none 0x00 /* run external ops to + generate index */ +#define MDEREF_INDEX_const 0x10 /* index is const PV/UV */ +#define MDEREF_INDEX_padsv 0x20 /* index is lexical var */ +#define MDEREF_INDEX_gvsv 0x30 /* index is GV */ -#define MDEREF_INDEX_MASK 0x30 +#define MDEREF_INDEX_MASK 0x30 /* bit flags */ -#define MDEREF_FLAG_last 0x40 /* the last [ah]elem; PL_op flags apply */ +#define MDEREF_FLAG_last 0x40 /* the last [ah]elem; PL_op + flags apply */ -#define MDEREF_MASK 0x7F -#define MDEREF_SHIFT 7 +#define MDEREF_MASK 0x7F +#define MDEREF_SHIFT 7 #if defined(PERL_IN_DOOP_C) || defined(PERL_IN_PP_C) -# define FATAL_ABOVE_FF_MSG \ - "Use of strings with code points over 0xFF as arguments to " \ - "%s operator is not allowed" +# define FATAL_ABOVE_FF_MSG \ + "Use of strings with code points over 0xFF as arguments to " \ + "%s operator is not allowed" #endif #if defined(PERL_IN_OP_C) || defined(PERL_IN_DOOP_C) || defined(PERL_IN_PERL_C) -# define TR_UNMAPPED (UV)-1 -# define TR_DELETE (UV)-2 -# define TR_R_EMPTY (UV)-3 /* rhs (replacement) is empty */ -# define TR_OOB (UV)-4 /* Something that isn't one of the others */ -# define TR_SPECIAL_HANDLING TR_DELETE /* Can occupy same value */ -# define TR_UNLISTED TR_UNMAPPED /* A synonym whose name is clearer - at times */ +# define TR_UNMAPPED (UV)-1 +# define TR_DELETE (UV)-2 +# define TR_R_EMPTY (UV)-3 /* rhs (replacement) is empty */ +# define TR_OOB (UV)-4 /* Something that isn't one + of the others */ +# define TR_SPECIAL_HANDLING TR_DELETE /* Can occupy same value */ +# define TR_UNLISTED TR_UNMAPPED /* A synonym whose name is + clearer at times */ #endif #if defined(PERL_IN_OP_C) || defined(PERL_IN_TOKE_C) -#define RANGE_INDICATOR ILLEGAL_UTF8_BYTE +#define RANGE_INDICATOR ILLEGAL_UTF8_BYTE #endif /* stuff for OP_ARGCHECK */ struct op_argcheck_aux { - UV params; /* number of positional parameters */ - UV opt_params; /* number of optional positional parameters */ - char slurpy; /* presence of slurpy: may be '\0', '@' or '%' */ + UV params; /* number of positional parameters */ + UV opt_params; /* number of optional positional parameters */ + char slurpy; /* presence of slurpy: may be '\0', '@' or '%' */ }; -#define MI_INIT_WORKAROUND_PACK "Module::Install::DSL" +#define MI_INIT_WORKAROUND_PACK "Module::Install::DSL" /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/op_reg_common.h b/op_reg_common.h index 1273cb6f2195..8ecb8f57a0b0 100644 --- a/op_reg_common.h +++ b/op_reg_common.h @@ -2,47 +2,47 @@ * * Definitions common to by op.h and regexp.h * - * Copyright (C) 2010, 2011 by Larry Wall and others + * Copyright (C) 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, + * 2019, 2020, 2021, 2022 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * */ -/* These defines are used in both op.h and regexp.h The definitions use the +/* These defines are used in both op.h and regexp.h The definitions use the * shift form so that ext/B/Makefile.PL will pick them up. * * Data structures used in the two headers have common fields, and in fact one * is copied onto the other. This makes it easy to keep them in sync */ -/* This tells where the first of these bits is. Setting it to 0 saved cycles - * and memory. I (khw) think the code will work if changed back, but haven't - * tested it */ +/* This tells where the first of these bits is. Setting it + * to 0 saved cycles and memory. I (khw) think the code + * will work if changed back, but haven't tested it */ /* Make sure to update ext/re/re.pm when changing this! */ #ifndef RXf_PMf_STD_PMMOD_SHIFT /* Only expand #include of this file once */ -#define RXf_PMf_STD_PMMOD_SHIFT 0 +#define RXf_PMf_STD_PMMOD_SHIFT 0 -/* The bits need to be ordered so that the msixn are contiguous starting at bit - * RXf_PMf_STD_PMMOD_SHIFT, followed by the p. See STD_PAT_MODS and - * INT_PAT_MODS in regexp.h for the reason contiguity is needed */ +/* The bits need to be ordered so that the msixn are contiguous starting + * at bit RXf_PMf_STD_PMMOD_SHIFT, followed by the p. See STD_PAT_MODS + * and INT_PAT_MODS in regexp.h for the reason contiguity is needed */ /* Make sure to update lib/re.pm when changing these! */ /* Make sure you keep the pure PMf_ versions below in sync */ -#define RXf_PMf_MULTILINE (1U << (RXf_PMf_STD_PMMOD_SHIFT+0)) /* /m */ -#define RXf_PMf_SINGLELINE (1U << (RXf_PMf_STD_PMMOD_SHIFT+1)) /* /s */ -#define RXf_PMf_FOLD (1U << (RXf_PMf_STD_PMMOD_SHIFT+2)) /* /i */ -#define RXf_PMf_EXTENDED (1U << (RXf_PMf_STD_PMMOD_SHIFT+3)) /* /x */ -#define RXf_PMf_EXTENDED_MORE (1U << (RXf_PMf_STD_PMMOD_SHIFT+4)) /* /xx */ -#define RXf_PMf_NOCAPTURE (1U << (RXf_PMf_STD_PMMOD_SHIFT+5)) /* /n */ - -#define RXf_PMf_KEEPCOPY (1U << (RXf_PMf_STD_PMMOD_SHIFT+6)) /* /p */ - -/* The character set for the regex is stored in a field of more than one bit - * using an enum, for reasons of compactness and to ensure that the options are - * mutually exclusive */ -/* Make sure to update ext/re/re.pm and regcomp.sym (as these are used as - * offsets for various node types, like POSIXD vs POSIXL, etc) when changing - * this! */ +#define RXf_PMf_MULTILINE (1U << (RXf_PMf_STD_PMMOD_SHIFT+0)) /* /m */ +#define RXf_PMf_SINGLELINE (1U << (RXf_PMf_STD_PMMOD_SHIFT+1)) /* /s */ +#define RXf_PMf_FOLD (1U << (RXf_PMf_STD_PMMOD_SHIFT+2)) /* /i */ +#define RXf_PMf_EXTENDED (1U << (RXf_PMf_STD_PMMOD_SHIFT+3)) /* /x */ +#define RXf_PMf_EXTENDED_MORE (1U << (RXf_PMf_STD_PMMOD_SHIFT+4)) /* /xx */ +#define RXf_PMf_NOCAPTURE (1U << (RXf_PMf_STD_PMMOD_SHIFT+5)) /* /n */ + +#define RXf_PMf_KEEPCOPY (1U << (RXf_PMf_STD_PMMOD_SHIFT+6)) /* /p */ + +/* The character set for the regex is stored in a field of more + * than one bit using an enum, for reasons of compactness and + * to ensure that the options are mutually exclusive */ +/* Make sure to update ext/re/re.pm and regcomp.sym (as + * these are used as offsets for various node types, like + * POSIXD vs POSIXL, etc) when changing this! */ typedef enum { REGEX_DEPENDS_CHARSET = 0, REGEX_LOCALE_CHARSET, @@ -51,12 +51,12 @@ typedef enum { REGEX_ASCII_MORE_RESTRICTED_CHARSET } regex_charset; -#define _RXf_PMf_CHARSET_SHIFT ((RXf_PMf_STD_PMMOD_SHIFT)+7) -#define RXf_PMf_CHARSET (7U << (_RXf_PMf_CHARSET_SHIFT)) /* 3 bits */ +#define _RXf_PMf_CHARSET_SHIFT ((RXf_PMf_STD_PMMOD_SHIFT)+7) +#define RXf_PMf_CHARSET (7U << (_RXf_PMf_CHARSET_SHIFT)) /* 3 bits */ -/* Manually decorate these functions here with gcc-style attributes just to - * avoid making the regex_charset typedef global, which it would need to be for - * proto.h to understand it */ +/* Manually decorate these functions here with gcc-style attributes + * just to avoid making the regex_charset typedef global, which it + * would need to be for proto.h to understand it */ PERL_STATIC_INLINE void set_regex_charset(U32 * const flags, const regex_charset cs) __attribute__nonnull__(1); @@ -64,8 +64,8 @@ set_regex_charset(U32 * const flags, const regex_charset cs) PERL_STATIC_INLINE void set_regex_charset(U32 * const flags, const regex_charset cs) { - /* Sets the character set portion of 'flags' to 'cs', which is a member of - * the above enum */ + /* Sets the character set portion of 'flags' to 'cs', + * which is a member of the above enum */ *flags &= ~RXf_PMf_CHARSET; *flags |= (cs << _RXf_PMf_CHARSET_SHIFT); @@ -83,7 +83,7 @@ get_regex_charset(const U32 flags) return (regex_charset) ((flags & RXf_PMf_CHARSET) >> _RXf_PMf_CHARSET_SHIFT); } -#define RXf_PMf_STRICT (1U<<(RXf_PMf_STD_PMMOD_SHIFT+10)) +#define RXf_PMf_STRICT (1U<<(RXf_PMf_STD_PMMOD_SHIFT+10)) #define _RXf_PMf_SHIFT_COMPILETIME (RXf_PMf_STD_PMMOD_SHIFT+11) @@ -93,14 +93,14 @@ get_regex_charset(const U32 flags) be used by regex engines to check whether they should set RXf_SKIPWHITE */ -#define RXf_PMf_SPLIT (1U<<(RXf_PMf_STD_PMMOD_SHIFT+11)) +#define RXf_PMf_SPLIT (1U<<(RXf_PMf_STD_PMMOD_SHIFT+11)) -/* Next available bit after the above. Name begins with '_' so won't be - * exported by B */ -#define _RXf_PMf_SHIFT_NEXT (RXf_PMf_STD_PMMOD_SHIFT+12) +/* Next available bit after the above. Name begins + * with '_' so won't be exported by B */ +#define _RXf_PMf_SHIFT_NEXT (RXf_PMf_STD_PMMOD_SHIFT+12) -/* Mask of the above bits. These need to be transferred from op_pmflags to - * re->extflags during compilation */ +/* Mask of the above bits. These need to be transferred from + * op_pmflags to re->extflags during compilation */ #define RXf_PMf_COMPILETIME \ ( RXf_PMf_MULTILINE \ | RXf_PMf_SINGLELINE \ @@ -113,11 +113,10 @@ get_regex_charset(const U32 flags) | RXf_PMf_STRICT ) #define RXf_PMf_FLAGCOPYMASK \ - ( RXf_PMf_COMPILETIME \ - | RXf_PMf_SPLIT ) + ( RXf_PMf_COMPILETIME | RXf_PMf_SPLIT ) -/* Temporary to get Jenkins happy again - * See thread starting at http://nntp.perl.org/group/perl.perl5.porters/220710 +/* Temporary to get Jenkins happy again See thread starting at + * http://nntp.perl.org/group/perl.perl5.porters/220710 */ #if 0 /* Exclude win32 because it can't cope with I32_MAX definition */ @@ -128,29 +127,38 @@ get_regex_charset(const U32 flags) #endif #endif -/* These copies need to be numerical or ext/B/Makefile.PL won't think they are - * constants */ -#define PMf_MULTILINE (1U<<0) -#define PMf_SINGLELINE (1U<<1) -#define PMf_FOLD (1U<<2) -#define PMf_EXTENDED (1U<<3) -#define PMf_EXTENDED_MORE (1U<<4) -#define PMf_NOCAPTURE (1U<<5) -#define PMf_KEEPCOPY (1U<<6) -#define PMf_CHARSET (7U<<7) -#define PMf_STRICT (1U<<10) -#define PMf_SPLIT (1U<<11) - -#if PMf_MULTILINE != RXf_PMf_MULTILINE || PMf_SINGLELINE != RXf_PMf_SINGLELINE || PMf_FOLD != RXf_PMf_FOLD || PMf_EXTENDED != RXf_PMf_EXTENDED || PMf_EXTENDED_MORE != RXf_PMf_EXTENDED_MORE || PMf_KEEPCOPY != RXf_PMf_KEEPCOPY || PMf_SPLIT != RXf_PMf_SPLIT || PMf_CHARSET != RXf_PMf_CHARSET || PMf_NOCAPTURE != RXf_PMf_NOCAPTURE || PMf_STRICT != RXf_PMf_STRICT +/* These copies need to be numerical or ext/B/Makefile.PL + * won't think they are constants */ +#define PMf_MULTILINE (1U<<0) +#define PMf_SINGLELINE (1U<<1) +#define PMf_FOLD (1U<<2) +#define PMf_EXTENDED (1U<<3) +#define PMf_EXTENDED_MORE (1U<<4) +#define PMf_NOCAPTURE (1U<<5) +#define PMf_KEEPCOPY (1U<<6) +#define PMf_CHARSET (7U<<7) +#define PMf_STRICT (1U<<10) +#define PMf_SPLIT (1U<<11) + +#if PMf_MULTILINE != RXf_PMf_MULTILINE || \ + PMf_SINGLELINE != RXf_PMf_SINGLELINE || \ + PMf_FOLD != RXf_PMf_FOLD || \ + PMf_EXTENDED != RXf_PMf_EXTENDED || \ + PMf_EXTENDED_MORE != RXf_PMf_EXTENDED_MORE || \ + PMf_KEEPCOPY != RXf_PMf_KEEPCOPY || \ + PMf_SPLIT != RXf_PMf_SPLIT || \ + PMf_CHARSET != RXf_PMf_CHARSET || \ + PMf_NOCAPTURE != RXf_PMf_NOCAPTURE || \ + PMf_STRICT != RXf_PMf_STRICT # error RXf_PMf defines are wrong #endif -/* Error check that haven't left something out of this. This isn't done - * directly in the #define because doing so confuses regcomp.pl. - * (2**n - 1) is n 1 bits, so the below gets the contiguous bits between the - * beginning and ending shifts */ +/* Error check that haven't left something out of this. This isn't + * done directly in the #define because doing so confuses + * regcomp.pl. (2**n - 1) is n 1 bits, so the below gets the + * contiguous bits between the beginning and ending shifts */ #if RXf_PMf_COMPILETIME != ((nBIT_MASK(_RXf_PMf_SHIFT_COMPILETIME)) \ - & (~(nBIT_MASK( RXf_PMf_STD_PMMOD_SHIFT)))) + & (~(nBIT_MASK( RXf_PMf_STD_PMMOD_SHIFT)))) # error RXf_PMf_COMPILETIME is invalid #endif diff --git a/pad.h b/pad.h index 8f339ae6c430..775cf13b6f33 100644 --- a/pad.h +++ b/pad.h @@ -1,52 +1,53 @@ /* pad.h * - * Copyright (C) 2002, 2003, 2005, 2006, 2007, 2008, - * 2009, 2010, 2011 by Larry Wall and others + * Copyright (C) 2002, 2003, 2005, 2006, 2007, 2008, 2009, 2010, 2011, + * 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021, 2022 by + * Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * - * This file defines the types and macros associated with the API for - * manipulating scratchpads, which are used by perl to store lexical - * variables, op targets and constants. + * This file defines the types and macros associated with the API for + * manipulating scratchpads, which are used by perl to store lexical + * variables, op targets and constants. */ /* offsets within a pad */ typedef SSize_t PADOFFSET; /* signed so that -1 is a valid value */ -#define NOT_IN_PAD ((PADOFFSET) -1) +#define NOT_IN_PAD ((PADOFFSET) -1) -/* B.xs expects the first members of these two structs to line up - (xpadl_max with xpadnl_fill). +/* B.xs expects the first members of these two structs + to line up (xpadl_max with xpadnl_fill). */ struct padlist { - SSize_t xpadl_max; /* max index for which array has space */ + SSize_t xpadl_max; /* max index for which array has space */ union { - PAD ** xpadlarr_alloc; /* Pointer to beginning of array of AVs. - Note that a 'padnamelist *' is stored - in the 0 index of the AV. */ + PAD **xpadlarr_alloc; /* Pointer to beginning of array of AVs. + Note that a 'padnamelist *' is stored + in the 0 index of the AV. */ struct { - PADNAMELIST * padnl; - PAD * pad_1; /* this slice of PAD * array always alloced */ - PAD * pad_2; /* maybe unalloced */ - } * xpadlarr_dbg; /* for use with a C debugger only */ - } xpadl_arr; - U32 xpadl_id; /* Semi-unique ID, shared between clones */ - U32 xpadl_outid; /* ID of outer pad */ + PADNAMELIST *padnl; + PAD *pad_1; /* this slice of PAD * array always alloced */ + PAD *pad_2; /* maybe unalloced */ + } *xpadlarr_dbg; /* for use with a C debugger only */ + } xpadl_arr; + U32 xpadl_id; /* Semi-unique ID, shared between clones */ + U32 xpadl_outid; /* ID of outer pad */ }; struct padnamelist { - SSize_t xpadnl_fill; /* max index in use */ - PADNAME ** xpadnl_alloc; /* pointer to beginning of array */ - SSize_t xpadnl_max; /* max index for which array has space */ - PADOFFSET xpadnl_max_named; /* highest index with len > 0 */ - U32 xpadnl_refcnt; + SSize_t xpadnl_fill; /* max index in use */ + PADNAME **xpadnl_alloc; /* pointer to beginning of array */ + SSize_t xpadnl_max; /* max index for which array has space */ + PADOFFSET xpadnl_max_named; /* highest index with len > 0 */ + U32 xpadnl_refcnt; }; /* PERL_PADNAME_MINIMAL uses less memory, but on some platforms - PERL_PADNAME_ALIGNED may be faster, so platform-specific hints can - define one or the other. */ + PERL_PADNAME_ALIGNED may be faster, so platform-specific + hints can define one or the other. */ #if defined(PERL_PADNAME_MINIMAL) && defined (PERL_PADNAME_ALIGNED) # error PERL_PADNAME_MINIMAL and PERL_PADNAME_ALIGNED are exclusive #endif @@ -57,20 +58,20 @@ struct padnamelist { struct padname_fieldinfo; -#define _PADNAME_BASE \ - char * xpadn_pv; \ - HV * xpadn_ourstash; \ - union { \ - HV * xpadn_typestash; \ - CV * xpadn_protocv; \ - } xpadn_type_u; \ - struct padname_fieldinfo *xpadn_fieldinfo; \ - U32 xpadn_low; \ - U32 xpadn_high; \ - U32 xpadn_refcnt; \ - int xpadn_gen; \ - U8 xpadn_len; \ - U8 xpadn_flags +#define _PADNAME_BASE \ + char * xpadn_pv; \ + HV * xpadn_ourstash; \ + union { \ + HV * xpadn_typestash; \ + CV * xpadn_protocv; \ + } xpadn_type_u; \ + struct padname_fieldinfo *xpadn_fieldinfo; \ + U32 xpadn_low; \ + U32 xpadn_high; \ + U32 xpadn_refcnt; \ + int xpadn_gen; \ + U8 xpadn_len; \ + U8 xpadn_flags struct padname { _PADNAME_BASE; @@ -80,96 +81,103 @@ struct padname_with_str { #ifdef PERL_PADNAME_MINIMAL _PADNAME_BASE; #else - struct padname xpadn_padname; + struct padname xpadn_padname; #endif - char xpadn_str[1]; + char xpadn_str[1]; }; #undef _PADNAME_BASE -#define PADNAME_FROM_PV(s) \ +#define PADNAME_FROM_PV(s) \ ((PADNAME *)((s) - STRUCT_OFFSET(struct padname_with_str, xpadn_str))) -/* Most padnames are not field names. Keep all the field-related info in its - * own substructure, stored in ->xpadn_fieldinfo. +/* Most padnames are not field names. Keep all the field-related + * info in its own substructure, stored in ->xpadn_fieldinfo. */ struct padname_fieldinfo { - U32 refcount; - PADOFFSET fieldix; /* index of this field within ObjectFIELDS() array */ - HV *fieldstash; /* original class package which added this field */ - OP *defop; /* optree fragment for defaulting expression */ - SV *paramname; /* name of the :param to look for in constructor */ - int def_if_undef : 1; /* default op uses //= */ - int def_if_false : 1; /* default op uses ||= */ + U32 refcount; + PADOFFSET fieldix; /* index of this field within + ObjectFIELDS() array */ + HV *fieldstash; /* original class package which + added this field */ + OP *defop; /* optree fragment for defaulting + expression */ + SV *paramname; /* name of the :param to look + for in constructor */ + int def_if_undef : 1; /* default op uses //= */ + int def_if_false : 1; /* default op uses ||= */ }; -/* a value that PL_cop_seqmax is guaranteed never to be, - * flagging that a lexical is being introduced, or has not yet left scope +/* a value that PL_cop_seqmax is guaranteed never to be, flagging + * that a lexical is being introduced, or has not yet left scope */ -#define PERL_PADSEQ_INTRO U32_MAX -#define COP_SEQMAX_INC \ - (PL_cop_seqmax++, \ - (void)(PL_cop_seqmax == PERL_PADSEQ_INTRO && PL_cop_seqmax++)) +#define PERL_PADSEQ_INTRO U32_MAX +#define COP_SEQMAX_INC \ + (PL_cop_seqmax++, \ + (void)(PL_cop_seqmax == PERL_PADSEQ_INTRO && PL_cop_seqmax++)) /* B.xs needs these for the benefit of B::Deparse */ /* Low range end is exclusive (valid from the cop seq after this one) */ /* High range end is inclusive (valid up to this cop seq) */ -#define COP_SEQ_RANGE_LOW(pn) (pn)->xpadn_low -#define COP_SEQ_RANGE_HIGH(pn) (pn)->xpadn_high -#define PARENT_PAD_INDEX(pn) (pn)->xpadn_low -#define PARENT_FAKELEX_FLAGS(pn) (pn)->xpadn_high +#define COP_SEQ_RANGE_LOW(pn) (pn)->xpadn_low +#define COP_SEQ_RANGE_HIGH(pn) (pn)->xpadn_high +#define PARENT_PAD_INDEX(pn) (pn)->xpadn_low +#define PARENT_FAKELEX_FLAGS(pn) (pn)->xpadn_high /* Flags set in the SvIVX field of FAKE namesvs */ -#define PAD_FAKELEX_ANON 1 /* the lex is declared in an ANON, or ... */ -#define PAD_FAKELEX_MULTI 2 /* the lex can be instantiated multiple times */ +#define PAD_FAKELEX_ANON 1 /* the lex is declared in an ANON, or ... */ +#define PAD_FAKELEX_MULTI 2 /* the lex can be instantiated + multiple times */ /* flags for the pad_new() function */ -#define padnew_CLONE 1 /* this pad is for a cloned CV */ -#define padnew_SAVE 2 /* save old globals */ -#define padnew_SAVESUB 4 /* also save extra stuff for start of sub */ +#define padnew_CLONE 1 /* this pad is for a cloned CV */ +#define padnew_SAVE 2 /* save old globals */ +#define padnew_SAVESUB 4 /* also save extra stuff + for start of sub */ /* values for the pad_tidy() function */ typedef enum { - padtidy_SUB, /* tidy up a pad for a sub, */ - padtidy_SUBCLONE, /* a cloned sub, */ - padtidy_FORMAT /* or a format */ + padtidy_SUB, /* tidy up a pad for a sub, */ + padtidy_SUBCLONE, /* a cloned sub, */ + padtidy_FORMAT /* or a format */ } padtidy_type; /* flags for pad_add_name_pvn. */ -#define padadd_OUR 0x01 /* our declaration. */ -#define padadd_STATE 0x02 /* state declaration. */ -#define padadd_NO_DUP_CHECK 0x04 /* skip warning on dups. */ -#define padadd_STALEOK 0x08 /* allow stale lexical in active - * sub, but only one level up */ -#define padadd_FIELD 0x10 /* set PADNAMEt_FIELD */ -#define padfind_FIELD_OK 0x20 /* pad_findlex is permitted to see fields */ +#define padadd_OUR 0x01 /* our declaration. */ +#define padadd_STATE 0x02 /* state declaration. */ +#define padadd_NO_DUP_CHECK 0x04 /* skip warning on dups. */ +#define padadd_STALEOK 0x08 /* allow stale lexical in active sub, + * but only one level up */ +#define padadd_FIELD 0x10 /* set PADNAMEt_FIELD */ +#define padfind_FIELD_OK 0x20 /* pad_findlex is permitted + to see fields */ -/* ASSERT_CURPAD_LEGAL and ASSERT_CURPAD_ACTIVE respectively determine - * whether PL_comppad and PL_curpad are consistent and whether they have - * active values */ +/* ASSERT_CURPAD_LEGAL and ASSERT_CURPAD_ACTIVE respectively + * determine whether PL_comppad and PL_curpad are consistent + * and whether they have active values */ # define pad_peg(label) #ifdef DEBUGGING -# define ASSERT_CURPAD_LEGAL(label) \ - pad_peg(label); \ - if (PL_comppad ? (AvARRAY(PL_comppad) != PL_curpad) : (PL_curpad != 0)) \ - Perl_croak(aTHX_ "panic: illegal pad in %s: 0x%" UVxf "[0x%" UVxf "]",\ - label, PTR2UV(PL_comppad), PTR2UV(PL_curpad)); - - -# define ASSERT_CURPAD_ACTIVE(label) \ - pad_peg(label); \ - if (!PL_comppad || (AvARRAY(PL_comppad) != PL_curpad)) \ - Perl_croak(aTHX_ "panic: invalid pad in %s: 0x%" UVxf "[0x%" UVxf "]",\ - label, PTR2UV(PL_comppad), PTR2UV(PL_curpad)); +# define ASSERT_CURPAD_LEGAL(label) \ + pad_peg(label); \ + if (PL_comppad ? (AvARRAY(PL_comppad) != PL_curpad) : (PL_curpad != 0)) \ + Perl_croak(aTHX_ "panic: illegal pad in %s: 0x%" UVxf "[0x%" UVxf "]", \ + label, PTR2UV(PL_comppad), PTR2UV(PL_curpad)); + + +# define ASSERT_CURPAD_ACTIVE(label) \ + pad_peg(label); \ + if (!PL_comppad || (AvARRAY(PL_comppad) != PL_curpad)) \ + Perl_croak(aTHX_ "panic: invalid pad in %s: 0x%" UVxf "[0x%" UVxf "]", \ + label, PTR2UV(PL_comppad), PTR2UV(PL_curpad)); #else # define ASSERT_CURPAD_LEGAL(label) # define ASSERT_CURPAD_ACTIVE(label) @@ -177,20 +185,20 @@ typedef enum { -/* Note: the following three macros are actually defined in scope.h, but - * they are documented here for completeness, since they directly or - * indirectly affect pads. */ +/* Note: the following three macros are actually defined in + * scope.h, but they are documented here for completeness, + * since they directly or indirectly affect pads. */ /* -=for apidoc m|void|SAVEPADSV |PADOFFSET po +=for apidoc m|void|SAVEPADSV |PADOFFSET po Save a pad slot (used to restore after an iteration) =cut XXX DAPM it would make more sense to make the arg a PADOFFSET -=for apidoc m|void|SAVECLEARSV |SV **svp -Clear the pointed to pad value on scope exit. (i.e. the runtime action of +=for apidoc m|void|SAVECLEARSV |SV **svp +Clear the pointed to pad value on scope exit. (i.e. the runtime action of C) =for apidoc m|void|SAVECOMPPAD @@ -202,9 +210,9 @@ The C array of a padlist, containing the pads. Only subscript it with numbers >= 1, as the 0th entry is not guaranteed to remain usable. =for apidoc Amx|SSize_t|PadlistMAX|PADLIST * padlist -The index of the last allocated space in the padlist. Note that the last -pad may be in an earlier slot. Any entries following it will be C in -that case. +The index of the last allocated space in the padlist. Note that the last pad +may be in an earlier slot. Any entries following it will be C in that +case. =for apidoc Amx|PADNAMELIST *|PadlistNAMES|PADLIST * padlist The names associated with pad entries. @@ -263,8 +271,8 @@ are often referred to as 'fake'. Whether this is a "state" variable. =for apidoc m|bool|PadnameIsFIELD|PADNAME * pn -Whether this is a "field" variable. PADNAMEs where this is true will -have additional information available via C. +Whether this is a "field" variable. PADNAMEs where this is true will have +additional information available via C. =for apidoc m|HV *|PadnameTYPE|PADNAME * pn The stash associated with a typed lexical. This returns the C<%Foo::> hash @@ -280,168 +288,171 @@ Increases the reference count of the pad name. Returns the pad name itself. Lowers the reference count of the pad name. -=for apidoc m|SV *|PAD_SETSV |PADOFFSET po|SV* sv +=for apidoc m|SV *|PAD_SETSV |PADOFFSET po|SV* sv Set the slot at offset C in the current pad to C -=for apidoc m|SV *|PAD_SV |PADOFFSET po +=for apidoc m|SV *|PAD_SV |PADOFFSET po Get the value at offset C in the current pad -=for apidoc m|SV *|PAD_SVl |PADOFFSET po -Lightweight and lvalue version of C. -Get or set the value at offset C in the current pad. -Unlike C, does not print diagnostics with -DX. -For internal use only. +=for apidoc m|SV *|PAD_SVl |PADOFFSET po +Lightweight and lvalue version of C. Get or set the value at offset +C in the current pad. Unlike C, does not print diagnostics with +-DX. For internal use only. -=for apidoc m|SV *|PAD_BASE_SV |PADLIST padlist|PADOFFSET po +=for apidoc m|SV *|PAD_BASE_SV |PADLIST padlist|PADOFFSET po Get the value from slot C in the base (DEPTH=1) pad of a padlist -=for apidoc m|void|PAD_SET_CUR |PADLIST padlist|I32 n -Set the current pad to be pad C in the padlist, saving -the previous current pad. NB currently this macro expands to a string too -long for some compilers, so it's best to replace it with +=for apidoc m|void|PAD_SET_CUR |PADLIST padlist|I32 n +Set the current pad to be pad C in the padlist, saving the previous +current pad. NB currently this macro expands to a string too long for some +compilers, so it's best to replace it with SAVECOMPPAD(); PAD_SET_CUR_NOSAVE(padlist,n); -=for apidoc m|void|PAD_SET_CUR_NOSAVE |PADLIST padlist|I32 n +=for apidoc m|void|PAD_SET_CUR_NOSAVE |PADLIST padlist|I32 n like PAD_SET_CUR, but without the save =for apidoc m|void|PAD_SAVE_SETNULLPAD Save the current pad then set it to null. =for apidoc m|void|PAD_SAVE_LOCAL|PAD *opad|PAD *npad -Save the current pad to the local variable C, then make the -current pad equal to C +Save the current pad to the local variable C, then make the current pad +equal to C =for apidoc m|void|PAD_RESTORE_LOCAL|PAD *opad -Restore the old pad saved into the local variable C by C +Restore the old pad saved into the local variable C by +C =cut */ -#define PadlistARRAY(pl) (pl)->xpadl_arr.xpadlarr_alloc -#define PadlistMAX(pl) (pl)->xpadl_max -#define PadlistNAMES(pl) *((PADNAMELIST **)PadlistARRAY(pl)) -#define PadlistNAMESARRAY(pl) PadnamelistARRAY(PadlistNAMES(pl)) -#define PadlistNAMESMAX(pl) PadnamelistMAX(PadlistNAMES(pl)) -#define PadlistREFCNT(pl) 1 /* reserved for future use */ - -#define PadnamelistARRAY(pnl) (pnl)->xpadnl_alloc -#define PadnamelistMAX(pnl) (pnl)->xpadnl_fill -#define PadnamelistMAXNAMED(pnl) (pnl)->xpadnl_max_named -#define PadnamelistREFCNT(pnl) (pnl)->xpadnl_refcnt -#define PadnamelistREFCNT_inc(pnl) Perl_padnamelist_refcnt_inc(pnl) -#define PadnamelistREFCNT_dec(pnl) Perl_padnamelist_free(aTHX_ pnl) - -#define PadARRAY(pad) AvARRAY(pad) -#define PadMAX(pad) AvFILLp(pad) - -#define PadnamePV(pn) (pn)->xpadn_pv -#define PadnameLEN(pn) (pn)->xpadn_len -#define PadnameUTF8(pn) 1 -#define PadnameSV(pn) \ - newSVpvn_flags(PadnamePV(pn), PadnameLEN(pn), SVs_TEMP|SVf_UTF8) -#define PadnameFLAGS(pn) (pn)->xpadn_flags -#define PadnameIsOUR(pn) cBOOL((pn)->xpadn_ourstash) -#define PadnameOURSTASH(pn) (pn)->xpadn_ourstash -#define PadnameTYPE(pn) (pn)->xpadn_type_u.xpadn_typestash +#define PadlistARRAY(pl) (pl)->xpadl_arr.xpadlarr_alloc +#define PadlistMAX(pl) (pl)->xpadl_max +#define PadlistNAMES(pl) *((PADNAMELIST **)PadlistARRAY(pl)) +#define PadlistNAMESARRAY(pl) PadnamelistARRAY(PadlistNAMES(pl)) +#define PadlistNAMESMAX(pl) PadnamelistMAX(PadlistNAMES(pl)) +#define PadlistREFCNT(pl) 1 /* reserved for future use */ + +#define PadnamelistARRAY(pnl) (pnl)->xpadnl_alloc +#define PadnamelistMAX(pnl) (pnl)->xpadnl_fill +#define PadnamelistMAXNAMED(pnl) (pnl)->xpadnl_max_named +#define PadnamelistREFCNT(pnl) (pnl)->xpadnl_refcnt +#define PadnamelistREFCNT_inc(pnl) Perl_padnamelist_refcnt_inc(pnl) +#define PadnamelistREFCNT_dec(pnl) Perl_padnamelist_free(aTHX_ pnl) + +#define PadARRAY(pad) AvARRAY(pad) +#define PadMAX(pad) AvFILLp(pad) + +#define PadnamePV(pn) (pn)->xpadn_pv +#define PadnameLEN(pn) (pn)->xpadn_len +#define PadnameUTF8(pn) 1 +#define PadnameSV(pn) \ + newSVpvn_flags(PadnamePV(pn), PadnameLEN(pn), SVs_TEMP|SVf_UTF8) +#define PadnameFLAGS(pn) (pn)->xpadn_flags +#define PadnameIsOUR(pn) cBOOL((pn)->xpadn_ourstash) +#define PadnameOURSTASH(pn) (pn)->xpadn_ourstash +#define PadnameTYPE(pn) (pn)->xpadn_type_u.xpadn_typestash #define PadnameHasTYPE(pn) cBOOL(PadnameTYPE(pn)) -#define PadnamePROTOCV(pn) (pn)->xpadn_type_u.xpadn_protocv -#define PadnameREFCNT(pn) (pn)->xpadn_refcnt +#define PadnamePROTOCV(pn) (pn)->xpadn_type_u.xpadn_protocv +#define PadnameREFCNT(pn) (pn)->xpadn_refcnt #define PadnameREFCNT_inc(pn) Perl_padname_refcnt_inc(pn) -#define PadnameREFCNT_dec(pn) Perl_padname_free(aTHX_ pn) +#define PadnameREFCNT_dec(pn) Perl_padname_free(aTHX_ pn) #define PadnameOURSTASH_set(pn,s) (PadnameOURSTASH(pn) = (s)) -#define PadnameTYPE_set(pn,s) (PadnameTYPE(pn) = (s)) +#define PadnameTYPE_set(pn,s) (PadnameTYPE(pn) = (s)) #define PadnameFIELDINFO(pn) (pn)->xpadn_fieldinfo -#define PadnameOUTER(pn) (PadnameFLAGS(pn) & PADNAMEf_OUTER) -#define PadnameIsSTATE(pn) (PadnameFLAGS(pn) & PADNAMEf_STATE) -#define PadnameLVALUE(pn) (PadnameFLAGS(pn) & PADNAMEf_LVALUE) -#define PadnameIsFIELD(pn) (PadnameFLAGS(pn) & PADNAMEf_FIELD) - -#define PadnameLVALUE_on(pn) (PadnameFLAGS(pn) |= PADNAMEf_LVALUE) -#define PadnameIsSTATE_on(pn) (PadnameFLAGS(pn) |= PADNAMEf_STATE) - -#define PADNAMEf_OUTER 0x01 /* outer lexical var */ -#define PADNAMEf_STATE 0x02 /* state var */ -#define PADNAMEf_LVALUE 0x04 /* used as lvalue */ -#define PADNAMEf_TYPED 0x08 /* for B; unused by core */ -#define PADNAMEf_OUR 0x10 /* for B; unused by core */ +#define PadnameOUTER(pn) (PadnameFLAGS(pn) & PADNAMEf_OUTER) +#define PadnameIsSTATE(pn) (PadnameFLAGS(pn) & PADNAMEf_STATE) +#define PadnameLVALUE(pn) (PadnameFLAGS(pn) & PADNAMEf_LVALUE) +#define PadnameIsFIELD(pn) (PadnameFLAGS(pn) & PADNAMEf_FIELD) + +#define PadnameLVALUE_on(pn) (PadnameFLAGS(pn) |= PADNAMEf_LVALUE) +#define PadnameIsSTATE_on(pn) (PadnameFLAGS(pn) |= PADNAMEf_STATE) + +#define PADNAMEf_OUTER 0x01 /* outer lexical var */ +#define PADNAMEf_STATE 0x02 /* state var */ +#define PADNAMEf_LVALUE 0x04 /* used as lvalue */ +#define PADNAMEf_TYPED 0x08 /* for B; unused by core */ +#define PADNAMEf_OUR 0x10 /* for B; unused by core */ #define PADNAMEf_FIELD 0x20 /* field var */ /* backward compatibility */ #ifndef PERL_CORE -# define SvPAD_STATE PadnameIsSTATE -# define SvPAD_TYPED PadnameHasTYPE -# define SvPAD_OUR(pn) cBOOL(PadnameOURSTASH(pn)) -# define SvPAD_STATE_on PadnameIsSTATE_on -# define SvPAD_TYPED_on(pn) (PadnameFLAGS(pn) |= PADNAMEf_TYPED) -# define SvPAD_OUR_on(pn) (PadnameFLAGS(pn) |= PADNAMEf_OUR) -# define SvOURSTASH PadnameOURSTASH -# define SvOURSTASH_set PadnameOURSTASH_set -# define SVpad_STATE PADNAMEf_STATE -# define SVpad_TYPED PADNAMEf_TYPED -# define SVpad_OUR PADNAMEf_OUR -# define PADNAMEt_OUTER PADNAMEf_OUTER -# define PADNAMEt_STATE PADNAMEf_STATE -# define PADNAMEt_LVALUE PADNAMEf_LVALUE -# define PADNAMEt_TYPED PADNAMEf_TYPED -# define PADNAMEt_OUR PADNAMEf_OUR +# define SvPAD_STATE PadnameIsSTATE +# define SvPAD_TYPED PadnameHasTYPE +# define SvPAD_OUR(pn) cBOOL(PadnameOURSTASH(pn)) +# define SvPAD_STATE_on PadnameIsSTATE_on +# define SvPAD_TYPED_on(pn) (PadnameFLAGS(pn) |= PADNAMEf_TYPED) +# define SvPAD_OUR_on(pn) (PadnameFLAGS(pn) |= PADNAMEf_OUR) +# define SvOURSTASH PadnameOURSTASH +# define SvOURSTASH_set PadnameOURSTASH_set +# define SVpad_STATE PADNAMEf_STATE +# define SVpad_TYPED PADNAMEf_TYPED +# define SVpad_OUR PADNAMEf_OUR +# define PADNAMEt_OUTER PADNAMEf_OUTER +# define PADNAMEt_STATE PADNAMEf_STATE +# define PADNAMEt_LVALUE PADNAMEf_LVALUE +# define PADNAMEt_TYPED PADNAMEf_TYPED +# define PADNAMEt_OUR PADNAMEf_OUR #endif #ifdef USE_ITHREADS -# define padnamelist_dup_inc(pnl,param) PadnamelistREFCNT_inc(padnamelist_dup(pnl,param)) -# define padname_dup_inc(pn,param) PadnameREFCNT_inc(padname_dup(pn,param)) +# define padnamelist_dup_inc(pnl,param) \ + PadnamelistREFCNT_inc(padnamelist_dup(pnl,param)) +# define padname_dup_inc(pn,param) \ + PadnameREFCNT_inc(padname_dup(pn,param)) #endif #ifdef DEBUGGING -# define PAD_SV(po) pad_sv(po) -# define PAD_SETSV(po,sv) pad_setsv(po,sv) +# define PAD_SV(po) pad_sv(po) +# define PAD_SETSV(po,sv) pad_setsv(po,sv) #else -# define PAD_SV(po) (PL_curpad[po]) -# define PAD_SETSV(po,sv) PL_curpad[po] = (sv) +# define PAD_SV(po) (PL_curpad[po]) +# define PAD_SETSV(po,sv) PL_curpad[po] = (sv) #endif -#define PAD_SVl(po) (PL_curpad[po]) +#define PAD_SVl(po) (PL_curpad[po]) -#define PAD_BASE_SV(padlist, po) \ - (PadlistARRAY(padlist)[1]) \ - ? AvARRAY(MUTABLE_AV((PadlistARRAY(padlist)[1])))[po] \ - : NULL; +#define PAD_BASE_SV(padlist, po) \ + (PadlistARRAY(padlist)[1]) \ + ? AvARRAY(MUTABLE_AV((PadlistARRAY(padlist)[1])))[po] \ + : NULL; -#define PAD_SET_CUR_NOSAVE(padlist,nth) \ - PL_comppad = (PAD*) (PadlistARRAY(padlist)[nth]); \ - PL_curpad = AvARRAY(PL_comppad); \ - DEBUG_Xv(PerlIO_printf(Perl_debug_log, \ - "Pad 0x%" UVxf "[0x%" UVxf "] set_cur depth=%d\n", \ - PTR2UV(PL_comppad), PTR2UV(PL_curpad), (int)(nth))); +#define PAD_SET_CUR_NOSAVE(padlist,nth) \ + PL_comppad = (PAD*) (PadlistARRAY(padlist)[nth]); \ + PL_curpad = AvARRAY(PL_comppad); \ + DEBUG_Xv(PerlIO_printf(Perl_debug_log, \ + "Pad 0x%" UVxf "[0x%" UVxf "] set_cur depth=%d\n", \ + PTR2UV(PL_comppad), PTR2UV(PL_curpad), (int)(nth))); -#define PAD_SET_CUR(padlist,nth) \ - SAVECOMPPAD(); \ - PAD_SET_CUR_NOSAVE(padlist,nth); +#define PAD_SET_CUR(padlist,nth) \ + SAVECOMPPAD(); \ + PAD_SET_CUR_NOSAVE(padlist,nth); -#define PAD_SAVE_SETNULLPAD() SAVECOMPPAD(); \ - PL_comppad = NULL; PL_curpad = NULL; \ +#define PAD_SAVE_SETNULLPAD() \ + SAVECOMPPAD(); \ + PL_comppad = NULL; PL_curpad = NULL; \ DEBUG_Xv(PerlIO_printf(Perl_debug_log, "Pad set_null\n")); -#define PAD_SAVE_LOCAL(opad,npad) \ - opad = PL_comppad; \ - PL_comppad = (npad); \ - PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : NULL; \ - DEBUG_Xv(PerlIO_printf(Perl_debug_log, \ - "Pad 0x%" UVxf "[0x%" UVxf "] save_local\n", \ - PTR2UV(PL_comppad), PTR2UV(PL_curpad))); +#define PAD_SAVE_LOCAL(opad,npad) \ + opad = PL_comppad; \ + PL_comppad = (npad); \ + PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : NULL; \ + DEBUG_Xv(PerlIO_printf(Perl_debug_log, \ + "Pad 0x%" UVxf "[0x%" UVxf "] save_local\n", \ + PTR2UV(PL_comppad), PTR2UV(PL_curpad))); -#define PAD_RESTORE_LOCAL(opad) \ - assert(!opad || !SvIS_FREED(opad)); \ - PL_comppad = opad; \ - PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : NULL; \ - DEBUG_Xv(PerlIO_printf(Perl_debug_log, \ - "Pad 0x%" UVxf "[0x%" UVxf "] restore_local\n", \ - PTR2UV(PL_comppad), PTR2UV(PL_curpad))); +#define PAD_RESTORE_LOCAL(opad) \ + assert(!opad || !SvIS_FREED(opad)); \ + PL_comppad = opad; \ + PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : NULL; \ + DEBUG_Xv(PerlIO_printf(Perl_debug_log, \ + "Pad 0x%" UVxf "[0x%" UVxf "] restore_local\n", \ + PTR2UV(PL_comppad), PTR2UV(PL_curpad))); /* @@ -449,58 +460,57 @@ Restore the old pad saved into the local variable C by C Save the current pad in the given context block structure. =for apidoc m|SV *|CX_CURPAD_SV|struct context|PADOFFSET po -Access the SV at offset C in the saved current pad in the given -context block structure (can be used as an lvalue). +Access the SV at offset C in the saved current pad in the +given context block structure (can be used as an lvalue). =cut */ -#define CX_CURPAD_SAVE(block) (block).oldcomppad = PL_comppad -#define CX_CURPAD_SV(block,po) (AvARRAY(MUTABLE_AV(((block).oldcomppad)))[po]) +#define CX_CURPAD_SAVE(block) (block).oldcomppad = PL_comppad +#define CX_CURPAD_SV(block,po) (AvARRAY(MUTABLE_AV(((block).oldcomppad)))[po]) /* =for apidoc m|U32|PAD_COMPNAME_FLAGS|PADOFFSET po -Return the flags for the current compiling pad name -at offset C. Assumes a valid slot entry. +Return the flags for the current compiling pad name at offset +C. Assumes a valid slot entry. =for apidoc m|char *|PAD_COMPNAME_PV|PADOFFSET po -Return the name of the current compiling pad name -at offset C. Assumes a valid slot entry. +Return the name of the current compiling pad name at offset C. +Assumes a valid slot entry. =for apidoc m|HV *|PAD_COMPNAME_TYPE|PADOFFSET po Return the type (stash) of the current compiling pad name at offset C. Must be a valid name. Returns null if not typed. =for apidoc m|HV *|PAD_COMPNAME_OURSTASH|PADOFFSET po -Return the stash associated with an C variable. -Assumes the slot entry is a valid C lexical. +Return the stash associated with an C variable. Assumes the +slot entry is a valid C lexical. =for apidoc m|STRLEN|PAD_COMPNAME_GEN|PADOFFSET po The generation number of the name at offset C in the current compiling pad (lvalue). =for apidoc m|STRLEN|PAD_COMPNAME_GEN_set|PADOFFSET po|int gen -Sets the generation number of the name at offset C in the current -ling pad (lvalue) to C. +Sets the generation number of the name at offset C in the +current ling pad (lvalue) to C. =cut - */ -#define PAD_COMPNAME(po) PAD_COMPNAME_SV(po) -#define PAD_COMPNAME_SV(po) (PadnamelistARRAY(PL_comppad_name)[(po)]) -#define PAD_COMPNAME_FLAGS(po) PadnameFLAGS(PAD_COMPNAME(po)) -#define PAD_COMPNAME_FLAGS_isOUR(po) PadnameIsOUR(PAD_COMPNAME_SV(po)) -#define PAD_COMPNAME_PV(po) PadnamePV(PAD_COMPNAME(po)) +#define PAD_COMPNAME(po) PAD_COMPNAME_SV(po) +#define PAD_COMPNAME_SV(po) (PadnamelistARRAY(PL_comppad_name)[(po)]) +#define PAD_COMPNAME_FLAGS(po) PadnameFLAGS(PAD_COMPNAME(po)) +#define PAD_COMPNAME_FLAGS_isOUR(po) PadnameIsOUR(PAD_COMPNAME_SV(po)) +#define PAD_COMPNAME_PV(po) PadnamePV(PAD_COMPNAME(po)) -#define PAD_COMPNAME_TYPE(po) PadnameTYPE(PAD_COMPNAME(po)) +#define PAD_COMPNAME_TYPE(po) PadnameTYPE(PAD_COMPNAME(po)) -#define PAD_COMPNAME_OURSTASH(po) (PadnameOURSTASH(PAD_COMPNAME_SV(po))) +#define PAD_COMPNAME_OURSTASH(po) (PadnameOURSTASH(PAD_COMPNAME_SV(po))) -#define PAD_COMPNAME_GEN(po) \ +#define PAD_COMPNAME_GEN(po) \ ((STRLEN)PadnamelistARRAY(PL_comppad_name)[po]->xpadn_gen) -#define PAD_COMPNAME_GEN_set(po, gen) \ +#define PAD_COMPNAME_GEN_set(po, gen) \ (PadnamelistARRAY(PL_comppad_name)[po]->xpadn_gen = (gen)) @@ -519,25 +529,25 @@ Clone the state variables associated with running and compiling pads. * where the second thread dups the outer sub's comppad but not the * sub's CV or padlist. */ -#define PAD_CLONE_VARS(proto_perl, param) \ - PL_comppad = av_dup(proto_perl->Icomppad, param); \ - PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : NULL; \ - PL_comppad_name = \ - padnamelist_dup(proto_perl->Icomppad_name, param); \ - PL_comppad_name_fill = proto_perl->Icomppad_name_fill; \ - PL_comppad_name_floor = proto_perl->Icomppad_name_floor; \ - PL_min_intro_pending = proto_perl->Imin_intro_pending; \ - PL_max_intro_pending = proto_perl->Imax_intro_pending; \ - PL_padix = proto_perl->Ipadix; \ - PL_padix_floor = proto_perl->Ipadix_floor; \ - PL_pad_reset_pending = proto_perl->Ipad_reset_pending; \ - PL_cop_seqmax = proto_perl->Icop_seqmax; +#define PAD_CLONE_VARS(proto_perl, param) \ + PL_comppad = av_dup(proto_perl->Icomppad, param); \ + PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : NULL; \ + PL_comppad_name = \ + padnamelist_dup(proto_perl->Icomppad_name, param); \ + PL_comppad_name_fill = proto_perl->Icomppad_name_fill; \ + PL_comppad_name_floor = proto_perl->Icomppad_name_floor; \ + PL_min_intro_pending = proto_perl->Imin_intro_pending; \ + PL_max_intro_pending = proto_perl->Imax_intro_pending; \ + PL_padix = proto_perl->Ipadix; \ + PL_padix_floor = proto_perl->Ipadix_floor; \ + PL_pad_reset_pending = proto_perl->Ipad_reset_pending; \ + PL_cop_seqmax = proto_perl->Icop_seqmax; /* =for apidoc Am|PADOFFSET|pad_add_name_pvs|"name"|U32 flags|HV *typestash|HV *ourstash -Exactly like L, but takes a literal string -instead of a string/length pair. +Exactly like L, but takes a literal +string instead of a string/length pair. =cut */ @@ -548,13 +558,13 @@ instead of a string/length pair. /* =for apidoc Am|PADOFFSET|pad_findmy_pvs|"name"|U32 flags -Exactly like L, but takes a literal string -instead of a string/length pair. +Exactly like L, but takes a literal +string instead of a string/length pair. =cut */ -#define pad_findmy_pvs(name,flags) \ +#define pad_findmy_pvs(name,flags) \ Perl_pad_findmy_pvn(aTHX_ STR_WITH_LEN(name), flags) struct suspended_compcv @@ -571,4 +581,4 @@ struct suspended_compcv /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/parser.h b/parser.h index 46d6a19c7b1e..2ca0d121fa30 100644 --- a/parser.h +++ b/parser.h @@ -4,145 +4,195 @@ * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * - * This file defines the layout of the parser object used by the parser - * and lexer (perly.c, toke.c). + * + * This file defines the layout of the parser object used by the + * parser and lexer (perly.c, toke.c). */ -#define YYEMPTY (-2) +#define YYEMPTY (-2) typedef struct { YYSTYPE val; /* semantic value */ short state; - I32 savestack_ix; /* size of savestack at this state */ - CV *compcv; /* value of PL_compcv when this value was created */ + I32 savestack_ix; /* size of savestack at this state */ + CV *compcv; /* value of PL_compcv when this value was created */ #ifdef DEBUGGING const char *name; /* token/rule name for -Dpv */ #endif } yy_stack_frame; -/* Fields that need to be shared with (i.e., visible to) inner lex- - ing scopes. */ +/* Fields that need to be shared with (i.e., + visible to) inner lex- ing scopes. */ typedef struct yy_lexshared { - struct yy_lexshared *ls_prev; - SV *ls_linestr; /* mirrors PL_parser->linestr */ - char *ls_bufptr; /* mirrors PL_parser->bufptr */ - char *re_eval_start; /* start of "(?{..." text */ - SV *re_eval_str; /* "(?{...})" text */ + struct yy_lexshared *ls_prev; + SV *ls_linestr; /* mirrors PL_parser->linestr */ + char *ls_bufptr; /* mirrors PL_parser->bufptr */ + char *re_eval_start; /* start of "(?{..." text */ + SV *re_eval_str; /* "(?{...})" text */ } LEXSHARED; typedef struct yy_parser { - /* parser state */ - struct yy_parser *old_parser; /* previous value of PL_parser */ - YYSTYPE yylval; /* value of lookahead symbol, set by yylex() */ - int yychar; /* The lookahead symbol. */ + struct yy_parser *old_parser; /* previous value of + PL_parser */ + YYSTYPE yylval; /* value of lookahead symbol, + set by yylex() */ + int yychar; /* The lookahead symbol. */ - /* Number of tokens to shift before error messages enabled. */ - int yyerrstatus; + /* Number of tokens to shift before error messages enabled. */ + int yyerrstatus; - yy_stack_frame *stack; /* base of stack */ - yy_stack_frame *stack_max1;/* (top-1)th element of allocated stack */ - yy_stack_frame *ps; /* current stack frame */ - int yylen; /* length of active reduction */ + yy_stack_frame *stack; /* base of stack */ + yy_stack_frame *stack_max1; /* (top-1)th element of + allocated stack */ + yy_stack_frame *ps; /* current stack frame */ + int yylen; /* length of active + reduction */ /* lexer state */ - I32 lex_formbrack; /* bracket count at outer format level */ - I32 lex_brackets; /* square and curly bracket count */ - I32 lex_casemods; /* casemod count */ - char *lex_brackstack;/* what kind of brackets to pop */ - char *lex_casestack; /* what kind of case mods in effect */ - U8 lex_defer; /* state after determined token */ - U8 lex_dojoin; /* doing an array interpolation - 1 = @{...} 2 = ->@ */ - U8 expect; /* how to interpret ambiguous tokens */ - bool preambled; - bool sub_no_recover; /* can't recover from a sublex error */ - U8 sub_error_count; /* the number of errors before sublexing */ - OP *lex_inpat; /* in pattern $) and $| are special */ - OP *lex_op; /* extra info to pass back on op */ - SV *lex_repl; /* runtime replacement from s/// */ - U16 lex_inwhat; /* what kind of quoting are we in */ - OPCODE last_lop_op; /* last named list or unary operator */ - I32 lex_starts; /* how many interps done on level */ - SV *lex_stuff; /* runtime pattern from m// or s/// */ - I32 multi_start; /* 1st line of multi-line string */ - I32 multi_end; /* last line of multi-line string */ - UV multi_open; /* delimiter code point of said string */ - UV multi_close; /* delimiter code point of said string */ - bool lex_re_reparsing; /* we're doing G_RE_REPARSING */ - U8 lex_super_state;/* lexer state to save */ - U16 lex_sub_inwhat; /* "lex_inwhat" to use in sublex_push */ - I32 lex_allbrackets;/* (), [], {}, ?: bracket count */ - OP *lex_sub_op; /* current op in y/// or pattern */ - SV *lex_sub_repl; /* repl of s/// used in sublex_push */ - LEXSHARED *lex_shared; - SV *linestr; /* current chunk of src text */ - char *bufptr; /* carries the cursor (current parsing - position) from one invocation of yylex - to the next */ - char *oldbufptr; /* in yylex, beginning of current token */ - char *oldoldbufptr; /* in yylex, beginning of previous token */ - char *bufend; - char *linestart; /* beginning of most recently read line */ - char *last_uni; /* position of last named-unary op */ - char *last_lop; /* position of last list operator */ - /* copline is used to pass a specific line number to newSTATEOP. It - is a one-time line number, as newSTATEOP invalidates it (sets it to - NOLINE) after using it. The purpose of this is to report line num- - bers in multiline constructs using the number of the first line. */ - line_t copline; - U16 in_my; /* we're compiling a "my"/"our" declaration */ - U8 lex_state; /* next token is determined */ - U8 error_count; /* how many compile errors so far, max 10 */ - HV *in_my_stash; /* declared class of this "my" declaration */ - PerlIO *rsfp; /* current source file pointer */ - AV *rsfp_filters; /* holds chain of active source filters */ - - YYSTYPE nextval[5]; /* value of next token, if any */ - I32 nexttype[5]; /* type of next token */ - U8 nexttoke; - U8 form_lex_state; /* remember lex_state when parsing fmt */ - U8 lex_fakeeof; /* precedence at which to fake EOF */ - U8 lex_flags; - COP *saved_curcop; /* the previous PL_curcop */ - char tokenbuf[256]; - line_t herelines; /* number of lines in here-doc */ - line_t preambling; /* line # when processing $ENV{PERL5DB} */ + I32 lex_formbrack; /* bracket count at outer + format level */ + I32 lex_brackets; /* square and curly bracket + count */ + I32 lex_casemods; /* casemod count */ + char *lex_brackstack; /* what kind of brackets + to pop */ + char *lex_casestack; /* what kind of case mods + in effect */ + U8 lex_defer; /* state after determined + token */ + U8 lex_dojoin; /* doing an array interpolation + 1 = @{...} 2 = ->@ */ + U8 expect; /* how to interpret ambiguous + tokens */ + bool preambled; + bool sub_no_recover; /* can't recover from + a sublex error */ + U8 sub_error_count; /* the number of errors + before sublexing */ + OP *lex_inpat; /* in pattern $) and $| + are special */ + OP *lex_op; /* extra info to pass + back on op */ + SV *lex_repl; /* runtime replacement + from s/// */ + U16 lex_inwhat; /* what kind of quoting + are we in */ + OPCODE last_lop_op; /* last named list or + unary operator */ + I32 lex_starts; /* how many interps done + on level */ + SV *lex_stuff; /* runtime pattern from + m// or s/// */ + I32 multi_start; /* 1st line of multi-line + string */ + I32 multi_end; /* last line of multi-line + string */ + UV multi_open; /* delimiter code point + of said string */ + UV multi_close; /* delimiter code point + of said string */ + bool lex_re_reparsing; /* we're doing G_RE_REPARSING + */ + U8 lex_super_state; /* lexer state to save */ + U16 lex_sub_inwhat; /* "lex_inwhat" to use + in sublex_push */ + I32 lex_allbrackets; /* (), [], {}, ?: bracket + count */ + OP *lex_sub_op; /* current op in y/// + or pattern */ + SV *lex_sub_repl; /* repl of s/// used in + sublex_push */ + LEXSHARED *lex_shared; + SV *linestr; /* current chunk of src text */ + char *bufptr; /* carries the cursor (current + parsing position) from one + invocation of yylex to the + next */ + char *oldbufptr; /* in yylex, beginning of + current token */ + char *oldoldbufptr; /* in yylex, beginning of + previous token */ + char *bufend; + char *linestart; /* beginning of most recently + read line */ + char *last_uni; /* position of last named-unary + op */ + char *last_lop; /* position of last list + operator */ + /* copline is used to pass a specific line number to newSTATEOP. It is a + one-time line number, as newSTATEOP invalidates it (sets it to NOLINE) + after using it. The purpose of this is to report line num- bers in + multiline constructs using the number of the first line. */ + line_t copline; + U16 in_my; /* we're compiling a "my"/"our" + declaration */ + U8 lex_state; /* next token is determined */ + U8 error_count; /* how many compile errors + so far, max 10 */ + HV *in_my_stash; /* declared class of this + "my" declaration */ + PerlIO *rsfp; /* current source file + pointer */ + AV *rsfp_filters; /* holds chain of active + source filters */ + + YYSTYPE nextval[5]; /* value of next token, + if any */ + I32 nexttype[5]; /* type of next token */ + U8 nexttoke; + U8 form_lex_state; /* remember lex_state when + parsing fmt */ + U8 lex_fakeeof; /* precedence at which + to fake EOF */ + U8 lex_flags; + COP *saved_curcop; /* the previous PL_curcop */ + char tokenbuf[256]; + line_t herelines; /* number of lines + in here-doc */ + line_t preambling; /* line # when processing + $ENV{PERL5DB} */ /* these are valid while parsing a subroutine signature */ - UV sig_elems; /* number of signature elements seen so far */ - UV sig_optelems; /* number of optional signature elems seen */ - char sig_slurpy; /* the sigil of the slurpy var (or null) */ - bool sig_seen; /* the currently parsing sub has a signature */ - - bool recheck_utf8_validity; - - PERL_BITFIELD16 in_pod:1; /* lexer is within a =pod section */ - PERL_BITFIELD16 filtered:1; /* source filters in evalbytes */ - PERL_BITFIELD16 saw_infix_sigil:1; /* saw & or * or % operator */ - PERL_BITFIELD16 parsed_sub:1; /* last thing parsed was a sub */ + UV sig_elems; /* number of signature elements + seen so far */ + UV sig_optelems; /* number of optional signature + elems seen */ + char sig_slurpy; /* the sigil of the slurpy + var (or null) */ + bool sig_seen; /* the currently parsing sub + has a signature */ + + bool recheck_utf8_validity; + + PERL_BITFIELD16 in_pod:1; /* lexer is within a + =pod section */ + PERL_BITFIELD16 filtered:1; /* source filters in + evalbytes */ + PERL_BITFIELD16 saw_infix_sigil:1; /* saw & or * or % operator */ + PERL_BITFIELD16 parsed_sub:1; /* last thing parsed + was a sub */ } yy_parser; /* flags for lexer API */ -#define LEX_STUFF_UTF8 0x00000001 -#define LEX_KEEP_PREVIOUS 0x00000002 +#define LEX_STUFF_UTF8 0x00000001 +#define LEX_KEEP_PREVIOUS 0x00000002 #ifdef PERL_CORE -# define LEX_START_SAME_FILTER 0x00000001 -# define LEX_IGNORE_UTF8_HINTS 0x00000002 -# define LEX_EVALBYTES 0x00000004 -# define LEX_START_COPIED 0x00000008 -# define LEX_DONT_CLOSE_RSFP 0x00000010 -# define LEX_START_FLAGS \ - (LEX_START_SAME_FILTER|LEX_START_COPIED \ - |LEX_IGNORE_UTF8_HINTS|LEX_EVALBYTES|LEX_DONT_CLOSE_RSFP) +# define LEX_START_SAME_FILTER 0x00000001 +# define LEX_IGNORE_UTF8_HINTS 0x00000002 +# define LEX_EVALBYTES 0x00000004 +# define LEX_START_COPIED 0x00000008 +# define LEX_DONT_CLOSE_RSFP 0x00000010 +# define LEX_START_FLAGS \ + (LEX_START_SAME_FILTER|LEX_START_COPIED \ + |LEX_IGNORE_UTF8_HINTS|LEX_EVALBYTES|LEX_DONT_CLOSE_RSFP) #endif /* flags for parser API */ -#define PARSE_OPTIONAL 0x00000001 +#define PARSE_OPTIONAL 0x00000001 /* values for lex_fakeeof */ enum { @@ -162,4 +212,4 @@ enum { /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/perl.h b/perl.h index 11e13be84cf0..473bff4932d4 100644 --- a/perl.h +++ b/perl.h @@ -1,22 +1,22 @@ /* perl.h * - * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001 - * 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 by Larry Wall and others + * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001 2002, + * 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, + * 2015, 2016, 2017, 2018, 2019, 2020, 2021, 2022 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * */ #ifndef H_PERL -#define H_PERL 1 +#define H_PERL 1 #ifdef PERL_FOR_X2P /* - * This file is being used for x2p stuff. - * Above symbol is defined via -D in 'x2p/Makefile.SH' - * Decouple x2p stuff from some of perls more extreme eccentricities. - */ + * This file is being used for x2p stuff. Above symbol is + * defined via -D in 'x2p/Makefile.SH' Decouple x2p stuff + * from some of perls more extreme eccentricities. +*/ #undef MULTIPLICITY #undef USE_STDIO #define USE_STDIO @@ -39,38 +39,38 @@ all when not under DEBUGGING, reducing the number of C<#ifdef>'s in the code. The program is responsible for maintaining the correct value for C. =for apidoc CyW ||_pDEPTH -This is used in the prototype declarations for functions that take a L> -final parameter, much like L|perlguts/Background and MULTIPLICITY> -is used in functions that take a thread context initial parameter. +This is used in the prototype declarations for functions that take a +L> final parameter, much like L|perlguts/Background and +MULTIPLICITY> is used in functions that take a thread context initial +parameter. =cut - */ +*/ #ifdef DEBUGGING -# define _pDEPTH ,U32 depth -# define _aDEPTH ,depth +# define _pDEPTH ,U32 depth +# define _aDEPTH ,depth #else # define _pDEPTH # define _aDEPTH #endif /* NOTE 1: that with gcc -std=c89 the __STDC_VERSION__ is *not* defined - * because the __STDC_VERSION__ became a thing only with C90. Therefore, - * with gcc, HAS_C99 will never become true as long as we use -std=c89. - - * NOTE 2: headers lie. Do not expect that if HAS_C99 gets to be true, - * all the C99 features are there and are correct. */ -#if (defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L) || \ + * because the __STDC_VERSION__ became a thing only with C90. Therefore, with + * gcc, HAS_C99 will never become true as long as we use -std=c89. + * + * NOTE 2: headers lie. Do not expect that if HAS_C99 gets to be true, all + * the C99 features are there and are correct. */ +#if (defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L) || \ defined(_STDC_C99) || defined(__c99) -# define HAS_C99 1 +# define HAS_C99 1 #endif -/* See L for detailed notes on - * MULTIPLICITY and PERL_IMPLICIT_SYS */ +/* See L for detailed notes + * on MULTIPLICITY and PERL_IMPLICIT_SYS */ -/* XXX NOTE that from here --> to <-- the same logic is - * repeated in makedef.pl, so be certain to update - * both places when editing. */ +/* XXX NOTE that from here --> to <-- the same logic is repeated in + * makedef.pl, so be certain to update both places when editing. */ #ifdef USE_ITHREADS # if !defined(MULTIPLICITY) @@ -79,9 +79,9 @@ is used in functions that take a thread context initial parameter. #endif /* PERL_IMPLICIT_CONTEXT is a legacy synonym for MULTIPLICITY */ -#if defined(MULTIPLICITY) \ - && ! defined(PERL_CORE) \ - && ! defined(PERL_IMPLICIT_CONTEXT) +#if defined(MULTIPLICITY) \ + && ! defined(PERL_CORE) \ + && ! defined(PERL_IMPLICIT_CONTEXT) # define PERL_IMPLICIT_CONTEXT #endif #if defined(PERL_IMPLICIT_CONTEXT) && !defined(MULTIPLICITY) @@ -99,8 +99,8 @@ is used in functions that take a thread context initial parameter. #endif /* Use the reentrant APIs like localtime_r and getpwent_r */ -/* Win32 has naturally threadsafe libraries, no need to use any _r variants. - * XXX KEEP makedef.pl copy of this code in sync */ +/* Win32 has naturally threadsafe libraries, no need to use any _r + * variants. XXX KEEP makedef.pl copy of this code in sync */ #if defined(USE_ITHREADS) && !defined(USE_REENTRANT_API) && !defined(WIN32) # define USE_REENTRANT_API #endif @@ -138,24 +138,24 @@ Otherwise ends a section of code already begun by a C>. #undef END_EXTERN_C #undef EXTERN_C #ifdef __cplusplus -# define EXTERN_C extern "C" -# define START_EXTERN_C EXTERN_C { -# define END_EXTERN_C } +# define EXTERN_C extern "C" +# define START_EXTERN_C EXTERN_C { +# define END_EXTERN_C } #else # define START_EXTERN_C # define END_EXTERN_C -# define EXTERN_C extern +# define EXTERN_C extern #endif /* Fallback definitions in case we don't have definitions from config.h. This should only matter for systems that don't use Configure and haven't been modified to define PERL_STATIC_INLINE yet. -*/ + */ #if !defined(PERL_STATIC_INLINE) # ifdef HAS_STATIC_INLINE -# define PERL_STATIC_INLINE static inline +# define PERL_STATIC_INLINE static inline # else -# define PERL_STATIC_INLINE static +# define PERL_STATIC_INLINE static # endif #endif @@ -171,24 +171,24 @@ Now a synonym for C>. */ #ifdef MULTIPLICITY -# define tTHX PerlInterpreter* -# define pTHX tTHX my_perl PERL_UNUSED_DECL -# define aTHX my_perl -# define aTHXa(a) aTHX = (tTHX)a -# define dTHXa(a) pTHX = (tTHX)a -# define dTHX pTHX = PERL_GET_THX -# define pTHX_ pTHX, -# define aTHX_ aTHX, -# define pTHX_1 2 -# define pTHX_2 3 -# define pTHX_3 4 -# define pTHX_4 5 -# define pTHX_5 6 -# define pTHX_6 7 -# define pTHX_7 8 -# define pTHX_8 9 -# define pTHX_9 10 -# define pTHX_12 13 +# define tTHX PerlInterpreter* +# define pTHX tTHX my_perl PERL_UNUSED_DECL +# define aTHX my_perl +# define aTHXa(a) aTHX = (tTHX)a +# define dTHXa(a) pTHX = (tTHX)a +# define dTHX pTHX = PERL_GET_THX +# define pTHX_ pTHX, +# define aTHX_ aTHX, +# define pTHX_1 2 +# define pTHX_2 3 +# define pTHX_3 4 +# define pTHX_4 5 +# define pTHX_5 6 +# define pTHX_6 7 +# define pTHX_7 8 +# define pTHX_8 9 +# define pTHX_9 10 +# define pTHX_12 13 # if defined(DEBUGGING) && !defined(PERL_TRACK_MEMPOOL) # define PERL_TRACK_MEMPOOL # endif @@ -197,112 +197,108 @@ Now a synonym for C>. #endif #ifdef DEBUGGING -# define dTHX_DEBUGGING dTHX +# define dTHX_DEBUGGING dTHX #else -# define dTHX_DEBUGGING dNOOP +# define dTHX_DEBUGGING dNOOP #endif -#define STATIC static +#define STATIC static #ifndef PERL_CORE -/* Do not use these macros. They were part of PERL_OBJECT, which was an - * implementation of multiplicity using C++ objects. They have been left - * here solely for the sake of XS code which has incorrectly - * cargo-culted them. - * - * The only one Devel::PPPort handles is this; list it as deprecated +/* Do not use these macros. They were part of PERL_OBJECT, which was an * + implementation of multiplicity using C++ objects. They have been left * + here solely for the sake of XS code which has incorrectly * cargo-culted + them. * * The only one Devel::PPPort handles is this; list it as deprecated -=for apidoc_section $concurrency -=for apidoc AmD|void|CPERLscope|void x -Now a no-op. + =for apidoc_section $concurrency =for apidoc AmD|void|CPERLscope|void x Now + a no-op. -=cut + =cut */ -# define CPERLscope(x) x -# define CPERLarg void +# define CPERLscope(x) x +# define CPERLarg void # define CPERLarg_ # define _CPERLarg # define PERL_OBJECT_THIS # define _PERL_OBJECT_THIS # define PERL_OBJECT_THIS_ -# define CALL_FPTR(fptr) (*fptr) +# define CALL_FPTR(fptr) (*fptr) # define MEMBER_TO_FPTR(name) name #endif /* !PERL_CORE */ -#define CALLRUNOPS PL_runops +#define CALLRUNOPS PL_runops -#define CALLREGCOMP(sv, flags) Perl_pregcomp(aTHX_ (sv),(flags)) +#define CALLREGCOMP(sv, flags) Perl_pregcomp(aTHX_ (sv),(flags)) #define CALLREGCOMP_ENG(prog, sv, flags) (prog)->comp(aTHX_ sv, flags) -#define CALLREGEXEC(prog,stringarg,strend,strbeg,minend,sv,data,flags) \ - RX_ENGINE(prog)->exec(aTHX_ (prog),(stringarg),(strend), \ +#define CALLREGEXEC(prog,stringarg,strend,strbeg,minend,sv,data,flags) \ + RX_ENGINE(prog)->exec(aTHX_ (prog),(stringarg),(strend), \ (strbeg),(minend),(sv),(data),(flags)) -#define CALLREG_INTUIT_START(prog,sv,strbeg,strpos,strend,flags,data) \ - RX_ENGINE(prog)->intuit(aTHX_ (prog), (sv), (strbeg), (strpos), \ +#define CALLREG_INTUIT_START(prog,sv,strbeg,strpos,strend,flags,data) \ + RX_ENGINE(prog)->intuit(aTHX_ (prog), (sv), (strbeg), (strpos), \ (strend),(flags),(data)) #define CALLREG_INTUIT_STRING(prog) \ RX_ENGINE(prog)->checkstr(aTHX_ (prog)) -#define CALLREGFREE(prog) \ +#define CALLREGFREE(prog) \ Perl_pregfree(aTHX_ (prog)) -#define CALLREGFREE_PVT(prog) \ +#define CALLREGFREE_PVT(prog) \ if(prog && RX_ENGINE(prog)) RX_ENGINE(prog)->rxfree(aTHX_ (prog)) -#define CALLREG_NUMBUF_FETCH(rx,paren,usesv) \ +#define CALLREG_NUMBUF_FETCH(rx,paren,usesv) \ RX_ENGINE(rx)->numbered_buff_FETCH(aTHX_ (rx),(paren),(usesv)) -#define CALLREG_NUMBUF_STORE(rx,paren,value) \ +#define CALLREG_NUMBUF_STORE(rx,paren,value) \ RX_ENGINE(rx)->numbered_buff_STORE(aTHX_ (rx),(paren),(value)) -#define CALLREG_NUMBUF_LENGTH(rx,sv,paren) \ +#define CALLREG_NUMBUF_LENGTH(rx,sv,paren) \ RX_ENGINE(rx)->numbered_buff_LENGTH(aTHX_ (rx),(sv),(paren)) -#define CALLREG_NAMED_BUFF_FETCH(rx, key, flags) \ +#define CALLREG_NAMED_BUFF_FETCH(rx, key, flags) \ RX_ENGINE(rx)->named_buff(aTHX_ (rx), (key), NULL, ((flags) | RXapif_FETCH)) #define CALLREG_NAMED_BUFF_STORE(rx, key, value, flags) \ RX_ENGINE(rx)->named_buff(aTHX_ (rx), (key), (value), ((flags) | RXapif_STORE)) -#define CALLREG_NAMED_BUFF_DELETE(rx, key, flags) \ +#define CALLREG_NAMED_BUFF_DELETE(rx, key, flags) \ RX_ENGINE(rx)->named_buff(aTHX_ (rx),(key), NULL, ((flags) | RXapif_DELETE)) #define CALLREG_NAMED_BUFF_CLEAR(rx, flags) \ RX_ENGINE(rx)->named_buff(aTHX_ (rx), NULL, NULL, ((flags) | RXapif_CLEAR)) -#define CALLREG_NAMED_BUFF_EXISTS(rx, key, flags) \ +#define CALLREG_NAMED_BUFF_EXISTS(rx, key, flags) \ RX_ENGINE(rx)->named_buff(aTHX_ (rx), (key), NULL, ((flags) | RXapif_EXISTS)) -#define CALLREG_NAMED_BUFF_FIRSTKEY(rx, flags) \ +#define CALLREG_NAMED_BUFF_FIRSTKEY(rx, flags) \ RX_ENGINE(rx)->named_buff_iter(aTHX_ (rx), NULL, ((flags) | RXapif_FIRSTKEY)) -#define CALLREG_NAMED_BUFF_NEXTKEY(rx, lastkey, flags) \ +#define CALLREG_NAMED_BUFF_NEXTKEY(rx, lastkey, flags) \ RX_ENGINE(rx)->named_buff_iter(aTHX_ (rx), (lastkey), ((flags) | RXapif_NEXTKEY)) -#define CALLREG_NAMED_BUFF_SCALAR(rx, flags) \ +#define CALLREG_NAMED_BUFF_SCALAR(rx, flags) \ RX_ENGINE(rx)->named_buff(aTHX_ (rx), NULL, NULL, ((flags) | RXapif_SCALAR)) -#define CALLREG_NAMED_BUFF_COUNT(rx) \ +#define CALLREG_NAMED_BUFF_COUNT(rx) \ RX_ENGINE(rx)->named_buff(aTHX_ (rx), NULL, NULL, RXapif_REGNAMES_COUNT) -#define CALLREG_NAMED_BUFF_ALL(rx, flags) \ +#define CALLREG_NAMED_BUFF_ALL(rx, flags) \ RX_ENGINE(rx)->named_buff(aTHX_ (rx), NULL, NULL, flags) #define CALLREG_PACKAGE(rx) \ RX_ENGINE(rx)->qr_package(aTHX_ (rx)) #if defined(USE_ITHREADS) -# define CALLREGDUPE(prog,param) \ - Perl_re_dup(aTHX_ (prog),(param)) +# define CALLREGDUPE(prog,param) \ + Perl_re_dup(aTHX_ (prog),(param)) -# define CALLREGDUPE_PVT(prog,param) \ - (prog ? RX_ENGINE(prog)->dupe(aTHX_ (prog),(param)) \ - : (REGEXP *)NULL) +# define CALLREGDUPE_PVT(prog,param) \ + (prog ? RX_ENGINE(prog)->dupe(aTHX_ (prog),(param)) : (REGEXP *)NULL) #endif /* some compilers impersonate gcc */ #if defined(__GNUC__) && !defined(__clang__) && !defined(__INTEL_COMPILER) -# define PERL_IS_GCC 1 +# define PERL_IS_GCC 1 #endif #define PERL_GCC_VERSION_GE(major,minor,patch) \ @@ -318,18 +314,16 @@ Now a no-op. (((100000 * __GNUC__) + (1000 * __GNUC_MINOR__) + __GNUC_PATCHLEVEL__) \ < ((100000 * (major)) + (1000 * (minor)) + (patch))) -/* In case Configure was not used (we are using a "canned config" - * such as Win32, or a cross-compilation setup, for example) try going - * by the gcc major and minor versions. One useful URL is - * http://www.ohse.de/uwe/articles/gcc-attributes.html, - * but contrary to this information warn_unused_result seems - * not to be in gcc 3.3.5, at least. --jhi - * Also, when building extensions with an installed perl, this allows - * the user to upgrade gcc and get the right attributes, rather than - * relying on the list generated at Configure time. --AD - * Set these up now otherwise we get confused when some of the <*thread.h> - * includes below indirectly pull in (which needs to know if we - * have HASATTRIBUTE_FORMAT). +/* In case Configure was not used (we are using a "canned config" such as + * Win32, or a cross-compilation setup, for example) try going by the gcc major + * and minor versions. One useful URL is + * http://www.ohse.de/uwe/articles/gcc-attributes.html, but contrary to this + * information warn_unused_result seems not to be in gcc 3.3.5, at least. + * --jhi Also, when building extensions with an installed perl, this allows the + * user to upgrade gcc and get the right attributes, rather than relying on the + * list generated at Configure time. --AD Set these up now otherwise we get + * confused when some of the <*thread.h> includes below indirectly pull in + * (which needs to know if we have HASATTRIBUTE_FORMAT). */ #ifndef PERL_MICRO @@ -359,7 +353,7 @@ Now a no-op. # define HASATTRIBUTE_UNUSED # endif # if __GNUC__ == 3 && __GNUC_MINOR__ == 3 && !defined(__cplusplus) -# define HASATTRIBUTE_UNUSED /* gcc-3.3, but not g++-3.3. */ +# define HASATTRIBUTE_UNUSED /* gcc-3.3, but not g++-3.3. */ # endif # if PERL_GCC_VERSION_GE(3,4,0) # define HASATTRIBUTE_WARN_UNUSED_RESULT @@ -375,25 +369,25 @@ Now a no-op. #endif /* #ifndef PERL_MICRO */ #ifdef HASATTRIBUTE_DEPRECATED -# define __attribute__deprecated__ __attribute__((deprecated)) +# define __attribute__deprecated__ __attribute__((deprecated)) #endif #ifdef HASATTRIBUTE_FORMAT -# define __attribute__format__(x,y,z) __attribute__((format(x,y,z))) +# define __attribute__format__(x,y,z) __attribute__((format(x,y,z))) #endif #ifdef HASATTRIBUTE_MALLOC -# define __attribute__malloc__ __attribute__((__malloc__)) +# define __attribute__malloc__ __attribute__((__malloc__)) #endif #ifdef HASATTRIBUTE_NONNULL -# define __attribute__nonnull__(a) __attribute__((nonnull(a))) +# define __attribute__nonnull__(a) __attribute__((nonnull(a))) #endif #ifdef HASATTRIBUTE_NORETURN -# define __attribute__noreturn__ __attribute__((noreturn)) +# define __attribute__noreturn__ __attribute__((noreturn)) #endif #ifdef HASATTRIBUTE_PURE -# define __attribute__pure__ __attribute__((pure)) +# define __attribute__pure__ __attribute__((pure)) #endif #ifdef HASATTRIBUTE_UNUSED -# define __attribute__unused__ __attribute__((unused)) +# define __attribute__unused__ __attribute__((unused)) #endif #ifdef HASATTRIBUTE_WARN_UNUSED_RESULT # define __attribute__warn_unused_result__ __attribute__((warn_unused_result)) @@ -401,16 +395,16 @@ Now a no-op. #ifdef HASATTRIBUTE_ALWAYS_INLINE /* always_inline is buggy in gcc <= 4.6 and causes compilation errors */ # if !defined(PERL_IS_GCC) || PERL_GCC_VERSION_GE(4,7,0) -# define __attribute__always_inline__ __attribute__((always_inline)) +# define __attribute__always_inline__ __attribute__((always_inline)) # endif #endif #if defined(HASATTRIBUTE_VISIBILITY) && !defined(_WIN32) && !defined(__CYGWIN__) -/* On Windows instead of this, we use __declspec(dllexport) and a .def file - * Cygwin works by exporting every global symbol, see the definition of ldflags - * near the end of hints/cygwin.sh and the visibility attribute doesn't appear - * to control that. +/* On Windows instead of this, we use __declspec(dllexport) and a + * .def file Cygwin works by exporting every global symbol, see + * the definition of ldflags near the end of hints/cygwin.sh and + * the visibility attribute doesn't appear to control that. */ -# define __attribute__visibility__(x) __attribute__((visibility(x))) +# define __attribute__visibility__(x) __attribute__((visibility(x))) #endif /* If we haven't defined the attributes yet, define them to blank. */ @@ -447,7 +441,7 @@ Now a no-op. /* Some OS warn on NULL format to printf */ #ifdef PRINTF_FORMAT_NULL_OK -# define __attribute__format__null_ok__(x,y,z) __attribute__format__(x,y,z) +# define __attribute__format__null_ok__(x,y,z) __attribute__format__(x,y,z) #else # define __attribute__format__null_ok__(x,y,z) #endif @@ -456,20 +450,20 @@ Now a no-op. * Because of backward compatibility reasons the PERL_UNUSED_DECL * cannot be changed from postfix to PERL_UNUSED_DECL(x). Sigh. * - * Note that there are C compilers such as MetroWerks CodeWarrior - * which do not have an "inlined" way (like the gcc __attribute__) of - * marking unused variables (they need e.g. a #pragma) and therefore - * cpp macros like PERL_UNUSED_DECL cannot work for this purpose, even - * if it were PERL_UNUSED_DECL(x), which it cannot be (see above). + * Note that there are C compilers such as MetroWerks CodeWarrior which + * do not have an "inlined" way (like the gcc __attribute__) of marking + * unused variables (they need e.g. a #pragma) and therefore cpp + * macros like PERL_UNUSED_DECL cannot work for this purpose, even if + * it were PERL_UNUSED_DECL(x), which it cannot be (see above). */ /* =for apidoc_section $directives =for apidoc AmnU||PERL_UNUSED_DECL -Tells the compiler that the parameter in the function prototype just before it -is not necessarily expected to be used in the function. Not that many -compilers understand this, so this should only be used in cases where -C> can't conveniently be used. +Tells the compiler that the parameter in the function prototype just +before it is not necessarily expected to be used in the function. +Not that many compilers understand this, so this should only be used +in cases where C> can't conveniently be used. Example usage: @@ -485,12 +479,11 @@ Example usage: */ #ifndef PERL_UNUSED_DECL -# define PERL_UNUSED_DECL __attribute__unused__ +# define PERL_UNUSED_DECL __attribute__unused__ #endif -/* gcc -Wall: - * for silencing unused variables that are actually used most of the time, - * but we cannot quite get rid of, such as "ax" in PPCODE+noargs xsubs, +/* gcc -Wall: for silencing unused variables that are actually used most of the + * time, but we cannot quite get rid of, such as "ax" in PPCODE+noargs xsubs, * or variables/arguments that are used only in certain configurations. */ /* @@ -501,37 +494,36 @@ under some configuration conditions, but not others, so that C preprocessor conditional compilation causes it be used just sometimes. =for apidoc Amn;||PERL_UNUSED_CONTEXT -This is used to suppress compiler warnings that the thread context parameter to -a function is not used. This situation can arise, for example, when a -C preprocessor conditional compilation causes it be used just some times. +This is used to suppress compiler warnings that the thread context parameter +to a function is not used. This situation can arise, for example, when a C +preprocessor conditional compilation causes it be used just some times. =for apidoc Am;||PERL_UNUSED_VAR|void x -This is used to suppress compiler warnings that the variable I is not used. -This situation can arise, for example, when a C preprocessor conditional -compilation causes it be used just some times. +This is used to suppress compiler warnings that the variable I is not +used. This situation can arise, for example, when a C preprocessor +conditional compilation causes it be used just some times. =cut */ #ifndef PERL_UNUSED_ARG -# define PERL_UNUSED_ARG(x) ((void)sizeof(x)) +# define PERL_UNUSED_ARG(x) ((void)sizeof(x)) #endif #ifndef PERL_UNUSED_VAR -# define PERL_UNUSED_VAR(x) ((void)sizeof(x)) +# define PERL_UNUSED_VAR(x) ((void)sizeof(x)) #endif #if defined(USE_ITHREADS) -# define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl) +# define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl) #else # define PERL_UNUSED_CONTEXT #endif -/* gcc (-ansi) -pedantic doesn't allow gcc statement expressions, - * g++ allows them but seems to have problems with them - * (insane errors ensue). +/* gcc (-ansi) -pedantic doesn't allow gcc statement expressions, g++ + * allows them but seems to have problems with them (insane errors ensue). * g++ does not give insane errors now (RMB 2008-01-30, gcc 4.2.2). */ -#if defined(PERL_GCC_PEDANTIC) || \ - (defined(__GNUC__) && defined(__cplusplus) && \ +#if defined(PERL_GCC_PEDANTIC) || \ + (defined(__GNUC__) && defined(__cplusplus) && \ (PERL_GCC_VERSION_LT(4,2,0))) # ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN # define PERL_GCC_BRACE_GROUPS_FORBIDDEN @@ -548,40 +540,39 @@ it, I, PERL_UNUSED_RESULT(foo(a, b)) The main reason for this is that the combination of C -(part of C<-Wall>) and the C<__attribute__((warn_unused_result))> cannot -be silenced with casting to C. This causes trouble when the system +(part of C<-Wall>) and the C<__attribute__((warn_unused_result))> cannot be +silenced with casting to C. This causes trouble when the system header files use the attribute. -Use C sparingly, though, since usually the warning -is there for a good reason: you might lose success/failure information, -or leak resources, or changes in resources. +Use C sparingly, though, since usually the warning is +there for a good reason: you might lose success/failure information, or leak +resources, or changes in resources. But sometimes you just want to ignore the return value, I, on -codepaths soon ending up in abort, or in "best effort" attempts, -or in situations where there is no good way to handle failures. +codepaths soon ending up in abort, or in "best effort" attempts, or in +situations where there is no good way to handle failures. -Sometimes C might not be the most natural way: -another possibility is that you can capture the return value -and use C> on that. +Sometimes C might not be the most natural way: another +possibility is that you can capture the return value and use +C> on that. =cut -The __typeof__() is used instead of typeof() since typeof() is not -available under strict ISO C, and because of compilers masquerading -as gcc (clang and icc), we want exactly the gcc extension -__typeof__ and nothing else. - +The __typeof__() is used instead of typeof() since typeof() is not available +under strict ISO C, and because of compilers masquerading as gcc (clang and +icc), we want exactly the gcc extension __typeof__ and nothing else. */ #ifndef PERL_UNUSED_RESULT # if defined(__GNUC__) && defined(HASATTRIBUTE_WARN_UNUSED_RESULT) -# define PERL_UNUSED_RESULT(v) STMT_START { __typeof__(v) z = (v); (void)sizeof(z); } STMT_END +# define PERL_UNUSED_RESULT(v) \ + STMT_START { __typeof__(v) z = (v); (void)sizeof(z); } STMT_END # else -# define PERL_UNUSED_RESULT(v) ((void)(v)) +# define PERL_UNUSED_RESULT(v) ((void)(v)) # endif #endif -/* on gcc (and clang), specify that a warning should be temporarily - * ignored; e.g. +/* on gcc (and clang), specify that a warning should be temporarily ignored; + * e.g. * * GCC_DIAG_IGNORE_DECL(-Wmultichar); * char b = 'ab'; @@ -592,95 +583,97 @@ __typeof__ and nothing else. * Note that "pragma GCC diagnostic push/pop" was added in GCC 4.6, Mar 2011; * clang only pretends to be GCC 4.2, but still supports push/pop. * - * Note on usage: all macros must be used at a place where a declaration - * or statement can occur, i.e., not in the middle of an expression. - * *_DIAG_IGNORE() and *_DIAG_RESTORE can be used in any such place, but - * must be used without a following semicolon. *_DIAG_IGNORE_DECL() and + * Note on usage: all macros must be used at a place where a declaration or + * statement can occur, i.e., not in the middle of an expression. + * *_DIAG_IGNORE() and *_DIAG_RESTORE can be used in any such place, but must + * be used without a following semicolon. *_DIAG_IGNORE_DECL() and * *_DIAG_RESTORE_DECL must be used with a following semicolon, and behave - * syntactically as declarations (like dNOOP). *_DIAG_IGNORE_STMT() - * and *_DIAG_RESTORE_STMT must be used with a following semicolon, - * and behave syntactically as statements (like NOOP). - * + * syntactically as declarations (like dNOOP). *_DIAG_IGNORE_STMT() and + * *_DIAG_RESTORE_STMT must be used with a following semicolon, and behave + * syntactically as statements (like NOOP). */ #if defined(__clang__) || defined(__clang) || PERL_GCC_VERSION_GE(4,6,0) -# define GCC_DIAG_PRAGMA(x) _Pragma (#x) +# define GCC_DIAG_PRAGMA(x) _Pragma (#x) /* clang has "clang diagnostic" pragmas, but also understands gcc. */ -# define GCC_DIAG_IGNORE(x) _Pragma("GCC diagnostic push") \ - GCC_DIAG_PRAGMA(GCC diagnostic ignored #x) -# define GCC_DIAG_RESTORE _Pragma("GCC diagnostic pop") +# define GCC_DIAG_IGNORE(x) \ + _Pragma("GCC diagnostic push") \ + GCC_DIAG_PRAGMA(GCC diagnostic ignored #x) +# define GCC_DIAG_RESTORE _Pragma("GCC diagnostic pop") #else # define GCC_DIAG_IGNORE(w) # define GCC_DIAG_RESTORE #endif -#define GCC_DIAG_IGNORE_DECL(x) GCC_DIAG_IGNORE(x) dNOOP -#define GCC_DIAG_RESTORE_DECL GCC_DIAG_RESTORE dNOOP -#define GCC_DIAG_IGNORE_STMT(x) GCC_DIAG_IGNORE(x) NOOP -#define GCC_DIAG_RESTORE_STMT GCC_DIAG_RESTORE NOOP +#define GCC_DIAG_IGNORE_DECL(x) GCC_DIAG_IGNORE(x) dNOOP +#define GCC_DIAG_RESTORE_DECL GCC_DIAG_RESTORE dNOOP +#define GCC_DIAG_IGNORE_STMT(x) GCC_DIAG_IGNORE(x) NOOP +#define GCC_DIAG_RESTORE_STMT GCC_DIAG_RESTORE NOOP /* for clang specific pragmas */ #if defined(__clang__) || defined(__clang) -# define CLANG_DIAG_PRAGMA(x) _Pragma (#x) -# define CLANG_DIAG_IGNORE(x) _Pragma("clang diagnostic push") \ - CLANG_DIAG_PRAGMA(clang diagnostic ignored #x) -# define CLANG_DIAG_RESTORE _Pragma("clang diagnostic pop") +# define CLANG_DIAG_PRAGMA(x) _Pragma (#x) +# define CLANG_DIAG_IGNORE(x) \ + _Pragma("clang diagnostic push") \ + CLANG_DIAG_PRAGMA(clang diagnostic ignored #x) +# define CLANG_DIAG_RESTORE _Pragma("clang diagnostic pop") #else # define CLANG_DIAG_IGNORE(w) # define CLANG_DIAG_RESTORE #endif -#define CLANG_DIAG_IGNORE_DECL(x) CLANG_DIAG_IGNORE(x) dNOOP -#define CLANG_DIAG_RESTORE_DECL CLANG_DIAG_RESTORE dNOOP -#define CLANG_DIAG_IGNORE_STMT(x) CLANG_DIAG_IGNORE(x) NOOP -#define CLANG_DIAG_RESTORE_STMT CLANG_DIAG_RESTORE NOOP +#define CLANG_DIAG_IGNORE_DECL(x) CLANG_DIAG_IGNORE(x) dNOOP +#define CLANG_DIAG_RESTORE_DECL CLANG_DIAG_RESTORE dNOOP +#define CLANG_DIAG_IGNORE_STMT(x) CLANG_DIAG_IGNORE(x) NOOP +#define CLANG_DIAG_RESTORE_STMT CLANG_DIAG_RESTORE NOOP #if defined(_MSC_VER) -# define MSVC_DIAG_IGNORE(x) __pragma(warning(push)) \ - __pragma(warning(disable : x)) -# define MSVC_DIAG_RESTORE __pragma(warning(pop)) +# define MSVC_DIAG_IGNORE(x) \ + __pragma(warning(push)) \ + __pragma(warning(disable : x)) +# define MSVC_DIAG_RESTORE __pragma(warning(pop)) #else # define MSVC_DIAG_IGNORE(x) # define MSVC_DIAG_RESTORE #endif -#define MSVC_DIAG_IGNORE_DECL(x) MSVC_DIAG_IGNORE(x) dNOOP -#define MSVC_DIAG_RESTORE_DECL MSVC_DIAG_RESTORE dNOOP -#define MSVC_DIAG_IGNORE_STMT(x) MSVC_DIAG_IGNORE(x) NOOP -#define MSVC_DIAG_RESTORE_STMT MSVC_DIAG_RESTORE NOOP +#define MSVC_DIAG_IGNORE_DECL(x) MSVC_DIAG_IGNORE(x) dNOOP +#define MSVC_DIAG_RESTORE_DECL MSVC_DIAG_RESTORE dNOOP +#define MSVC_DIAG_IGNORE_STMT(x) MSVC_DIAG_IGNORE(x) NOOP +#define MSVC_DIAG_RESTORE_STMT MSVC_DIAG_RESTORE NOOP /* =for apidoc Amn;||NOOP -Do nothing; typically used as a placeholder to replace something that used to -do something. +Do nothing; typically used as a placeholder to replace +something that used to do something. =for apidoc Amn;||dNOOP -Declare nothing; typically used as a placeholder to replace something that used -to declare something. Works on compilers that require declarations before any -code. +Declare nothing; typically used as a placeholder to replace +something that used to declare something. Works on +compilers that require declarations before any code. =cut */ -#define NOOP /*EMPTY*/(void)0 -#define dNOOP struct Perl___notused_struct +#define NOOP /*EMPTY */(void)0 +#define dNOOP struct Perl___notused_struct #ifndef pTHX -/* Don't bother defining tTHX ; using it outside +/* Don't bother defining tTHX; using it outside * code guarded by MULTIPLICITY is an error. */ -# define pTHX void +# define pTHX void # define pTHX_ # define aTHX # define aTHX_ -# define aTHXa(a) NOOP -# define dTHXa(a) dNOOP -# define dTHX dNOOP -# define pTHX_1 1 -# define pTHX_2 2 -# define pTHX_3 3 -# define pTHX_4 4 -# define pTHX_5 5 -# define pTHX_6 6 -# define pTHX_7 7 -# define pTHX_8 8 -# define pTHX_9 9 -# define pTHX_12 12 +# define aTHXa(a) NOOP +# define dTHXa(a) dNOOP +# define dTHX dNOOP +# define pTHX_1 1 +# define pTHX_2 2 +# define pTHX_3 3 +# define pTHX_4 4 +# define pTHX_5 5 +# define pTHX_6 6 +# define pTHX_7 7 +# define pTHX_8 8 +# define pTHX_9 9 +# define pTHX_12 12 #endif /* @@ -696,38 +689,38 @@ Now a placeholder that declares nothing */ #ifndef PERL_CORE - /* Backwards compatibility macro for XS code. It used to be part of the + /* Backwards compatibility macro for XS code. It used to be part of the * PERL_GLOBAL_STRUCT(_PRIVATE) feature, which no longer exists */ -# define dVAR dNOOP +# define dVAR dNOOP - /* these are only defined for compatibility; should not be used internally. - * */ -# define dMY_CXT_SV dNOOP + /* these are only defined for compatibility; + * should not be used internally. */ +# define dMY_CXT_SV dNOOP # ifndef pTHXo -# define pTHXo pTHX -# define pTHXo_ pTHX_ -# define aTHXo aTHX -# define aTHXo_ aTHX_ -# define dTHXo dTHX -# define dTHXoa(x) dTHXa(x) +# define pTHXo pTHX +# define pTHXo_ pTHX_ +# define aTHXo aTHX +# define aTHXo_ aTHX_ +# define dTHXo dTHX +# define dTHXoa(x) dTHXa(x) # endif #endif #ifndef pTHXx -# define pTHXx PerlInterpreter *my_perl -# define pTHXx_ pTHXx, -# define aTHXx my_perl -# define aTHXx_ aTHXx, -# define dTHXx dTHX +# define pTHXx PerlInterpreter *my_perl +# define pTHXx_ pTHXx, +# define aTHXx my_perl +# define aTHXx_ aTHXx, +# define dTHXx dTHX #endif /* Under PERL_IMPLICIT_SYS (used in Windows for fork emulation) * PerlIO_foo() expands to PL_StdIO->pFOO(PL_StdIO, ...). * dTHXs is therefore needed for all functions using PerlIO_foo(). */ #ifdef PERL_IMPLICIT_SYS -# define dTHXs dTHX +# define dTHXs dTHX #else -# define dTHXs dNOOP +# define dTHXs dNOOP #endif #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus) @@ -747,7 +740,7 @@ as in if (x) STMT_START { ... } STMT_END else ... Note that you can't return a value out of this construct and cannot use it as -an operand to the comma operator. These limit its utility. +an operand to the comma operator. These limit its utility. But, a value could be returned by constructing the API so that a pointer is passed and the macro dereferences this to set the return. If the value can be @@ -755,7 +748,7 @@ any of various types, depending on context, you can handle that situation in some situations by adding the type of the return as an extra accompanying parameter: - #define foo(param, type) STMT_START { + #define foo(param, type) STMT_START { type * param; *param = do_calc; ... } STMT_END @@ -810,20 +803,20 @@ Example usage: Trying to select a version that gives no warnings... */ #if !(defined(STMT_START) && defined(STMT_END)) -# define STMT_START do -# define STMT_END while (0) +# define STMT_START do +# define STMT_END while (0) #endif #ifndef BYTEORDER /* Should never happen -- byteorder is in config.h */ -# define BYTEORDER 0x1234 +# define BYTEORDER 0x1234 #endif /* =for apidoc_section $genconfig =for apidoc Amn#||ASCIIish -A preprocessor symbol that is defined iff the system is an ASCII platform; this -symbol would not be defined on C> platforms. +A preprocessor symbol that is defined iff the system is an ASCII platform; +this symbol would not be defined on C> platforms. =cut */ @@ -843,62 +836,61 @@ symbol would not be defined on C> platforms. /* define this once if either system, instead of cluttering up the src */ #if defined(WIN32) -#define DOSISH 1 +#define DOSISH 1 #endif /* These exist only for back-compat with XS modules. */ #ifndef PERL_CORE -#define VOL volatile +#define VOL volatile #define CAN_PROTOTYPE -#define _(args) args +#define _(args) args #define I_LIMITS #define I_STDARG #define STANDARD_C #endif /* By compiling a perl with -DNO_TAINT_SUPPORT or -DSILENT_NO_TAINT_SUPPORT, - * you get a perl without taint support, but doubtlessly with a lesser - * degree of support. Do not do so unless you know exactly what it means - * technically, have a good reason to do so, and know exactly how the - * perl will be used. perls with -DSILENT_NO_TAINT_SUPPORT are considered - * a potential security risk due to flat out ignoring the security-relevant - * taint flags. This being said, a perl without taint support compiled in - * has marginal run-time performance benefits. - * SILENT_NO_TAINT_SUPPORT implies NO_TAINT_SUPPORT. - * SILENT_NO_TAINT_SUPPORT is the same as NO_TAINT_SUPPORT except it - * silently ignores -t/-T instead of throwing an exception. + * you get a perl without taint support, but doubtlessly with a lesser degree + * of support. Do not do so unless you know exactly what it means + * technically, have a good reason to do so, and know exactly how the perl + * will be used. perls with -DSILENT_NO_TAINT_SUPPORT are considered a + * potential security risk due to flat out ignoring the security-relevant + * taint flags. This being said, a perl without taint support compiled in has + * marginal run-time performance benefits. SILENT_NO_TAINT_SUPPORT implies + * NO_TAINT_SUPPORT. SILENT_NO_TAINT_SUPPORT is the same as NO_TAINT_SUPPORT + * except it silently ignores -t/-T instead of throwing an exception. * - * DANGER! Using NO_TAINT_SUPPORT or SILENT_NO_TAINT_SUPPORT - * voids your nonexistent warranty! + * DANGER! Using NO_TAINT_SUPPORT or SILENT_NO_TAINT_SUPPORT voids your + * nonexistent warranty! */ #if defined(SILENT_NO_TAINT_SUPPORT) && !defined(NO_TAINT_SUPPORT) -# define NO_TAINT_SUPPORT 1 +# define NO_TAINT_SUPPORT 1 #endif /* NO_TAINT_SUPPORT can be set to transform virtually all taint-related - * operations into no-ops for a very modest speed-up. Enable only if you - * know what you're doing: tests and CPAN modules' tests are bound to fail. + * operations into no-ops for a very modest speed-up. Enable only if you know + * what you're doing: tests and CPAN modules' tests are bound to fail. */ #ifdef NO_TAINT_SUPPORT -# define TAINT NOOP -# define TAINT_NOT NOOP -# define TAINT_IF(c) NOOP -# define TAINT_ENV() NOOP -# define TAINT_PROPER(s) NOOP -# define TAINT_set(s) NOOP -# define TAINT_get 0 -# define TAINTING_get 0 -# define TAINTING_set(s) NOOP -# define TAINT_WARN_get 0 -# define TAINT_WARN_set(s) NOOP +# define TAINT NOOP +# define TAINT_NOT NOOP +# define TAINT_IF(c) NOOP +# define TAINT_ENV() NOOP +# define TAINT_PROPER(s) NOOP +# define TAINT_set(s) NOOP +# define TAINT_get 0 +# define TAINTING_get 0 +# define TAINTING_set(s) NOOP +# define TAINT_WARN_get 0 +# define TAINT_WARN_set(s) NOOP #else /* =for apidoc_section $tainting =for apidoc Cm|void|TAINT -If we aren't in taint checking mode, do nothing; -otherwise indicate to L> and L> that some +If we aren't in taint checking mode, do nothing; otherwise +indicate to L> and L> that some unspecified element is tainted. =for apidoc Cm|void|TAINT_NOT @@ -907,25 +899,25 @@ Remove any taintedness previously set by, I, C. =for apidoc Cm|void|TAINT_IF|bool c -If C evaluates to true, call L> to indicate that something is -tainted; otherwise do nothing. +If C evaluates to true, call L> to indicate that +something is tainted; otherwise do nothing. =for apidoc Cmn|void|TAINT_ENV -Looks at several components of L|perlvar/%ENV> for taintedness, and -calls L> if any are tainted. The components it searches are -things like C<$PATH>. +Looks at several components of L|perlvar/%ENV> for +taintedness, and calls L> if any are tainted. +The components it searches are things like C<$PATH>. =for apidoc Cm|void|TAINT_PROPER|const char * s -If no element is tainted, do nothing; -otherwise output a message (containing C) that indicates there is a -tainting violation. If such violations are fatal, it croaks. +If no element is tainted, do nothing; otherwise output a message +(containing C) that indicates there is a tainting violation. +If such violations are fatal, it croaks. =for apidoc Cm|void|TAINT_set|bool s -If C is true, L> returns true; -If C is false, L> returns false; +If C is true, L> returns true; If C is false, +L> returns false; =for apidoc Cm|bool|TAINT_get @@ -941,98 +933,101 @@ Turn taint checking mode off/on =for apidoc Cm|bool|TAINT_WARN_get -Returns false if tainting violations are fatal; -Returns true if they're just warnings +Returns false if tainting violations are fatal; Returns true if +they're just warnings =for apidoc Cm|void|TAINT_WARN_set|bool s -C being true indicates L> should return that tainting -violations are just warnings +C being true indicates L> should return that +tainting violations are just warnings -C being false indicates L> should return that tainting -violations are fatal. +C being false indicates L> should return +that tainting violations are fatal. =cut */ /* Set to tainted if we are running under tainting mode */ -# define TAINT (PL_tainted = PL_tainting) +# define TAINT (PL_tainted = PL_tainting) -# define TAINT_NOT (PL_tainted = FALSE) /* Untaint */ -# define TAINT_IF(c) if (UNLIKELY(c)) { TAINT; } /* Conditionally taint */ -# define TAINT_ENV() if (UNLIKELY(PL_tainting)) { taint_env(); } +# define TAINT_NOT (PL_tainted = FALSE) /* Untaint */ +# define TAINT_IF(c) if (UNLIKELY(c)) { TAINT; } /* Conditionally + taint */ +# define TAINT_ENV() if (UNLIKELY(PL_tainting)) { taint_env(); } /* croak or warn if tainting */ -# define TAINT_PROPER(s) if (UNLIKELY(PL_tainting)) { \ - taint_proper(NULL, s); \ - } -# define TAINT_set(s) (PL_tainted = cBOOL(s)) -# define TAINT_get (cBOOL(UNLIKELY(PL_tainted))) /* Is something tainted? */ -# define TAINTING_get (cBOOL(UNLIKELY(PL_tainting))) -# define TAINTING_set(s) (PL_tainting = cBOOL(s)) -# define TAINT_WARN_get (PL_taint_warn) -# define TAINT_WARN_set(s) (PL_taint_warn = cBOOL(s)) +# define TAINT_PROPER(s) \ + if (UNLIKELY(PL_tainting)) { \ + taint_proper(NULL, s); \ + } +# define TAINT_set(s) (PL_tainted = cBOOL(s)) +# define TAINT_get (cBOOL(UNLIKELY(PL_tainted))) /* Is something + tainted? */ +# define TAINTING_get (cBOOL(UNLIKELY(PL_tainting))) +# define TAINTING_set(s) (PL_tainting = cBOOL(s)) +# define TAINT_WARN_get (PL_taint_warn) +# define TAINT_WARN_set(s) (PL_taint_warn = cBOOL(s)) #endif /* flags used internally only within pp_subst and pp_substcont */ #ifdef PERL_CORE -# define SUBST_TAINT_STR 1 /* string tainted */ -# define SUBST_TAINT_PAT 2 /* pattern tainted */ -# define SUBST_TAINT_REPL 4 /* replacement tainted */ -# define SUBST_TAINT_RETAINT 8 /* use re'taint' in scope */ -# define SUBST_TAINT_BOOLRET 16 /* return is boolean (don't taint) */ +# define SUBST_TAINT_STR 1 /* string tainted */ +# define SUBST_TAINT_PAT 2 /* pattern tainted */ +# define SUBST_TAINT_REPL 4 /* replacement tainted */ +# define SUBST_TAINT_RETAINT 8 /* use re'taint' in scope */ +# define SUBST_TAINT_BOOLRET 16 /* return is boolean (don't taint) */ #endif -/* XXX All process group stuff is handled in pp_sys.c. Should these - defines move there? If so, I could simplify this a lot. --AD 9/96. -*/ +/* XXX All process group stuff is handled in pp_sys.c. Should these defines + move there? If so, I could simplify this a lot. --AD 9/96. + */ /* Process group stuff changed from traditional BSD to POSIX. - perlfunc.pod documents the traditional BSD-style syntax, so we'll - try to preserve that, if possible. -*/ + perlfunc.pod documents the traditional BSD-style syntax, + so we'll try to preserve that, if possible. + */ #ifdef HAS_SETPGID -# define BSD_SETPGRP(pid, pgrp) setpgid((pid), (pgrp)) +# define BSD_SETPGRP(pid, pgrp) setpgid((pid), (pgrp)) #elif defined(HAS_SETPGRP) && defined(USE_BSD_SETPGRP) -# define BSD_SETPGRP(pid, pgrp) setpgrp((pid), (pgrp)) +# define BSD_SETPGRP(pid, pgrp) setpgrp((pid), (pgrp)) #elif defined(HAS_SETPGRP2) -# define BSD_SETPGRP(pid, pgrp) setpgrp2((pid), (pgrp)) +# define BSD_SETPGRP(pid, pgrp) setpgrp2((pid), (pgrp)) #endif #if defined(BSD_SETPGRP) && !defined(HAS_SETPGRP) -# define HAS_SETPGRP /* Well, effectively it does . . . */ +# define HAS_SETPGRP /* Well, effectively it does . . . */ #endif -/* getpgid isn't POSIX, but at least Solaris and Linux have it, and it makes - our life easier :-) so we'll try it. -*/ +/* getpgid isn't POSIX, but at least Solaris and Linux have + it, and it makes our life easier :-) so we'll try it. + */ #ifdef HAS_GETPGID -# define BSD_GETPGRP(pid) getpgid((pid)) +# define BSD_GETPGRP(pid) getpgid((pid)) #elif defined(HAS_GETPGRP) && defined(USE_BSD_GETPGRP) -# define BSD_GETPGRP(pid) getpgrp((pid)) +# define BSD_GETPGRP(pid) getpgrp((pid)) #elif defined(HAS_GETPGRP2) -# define BSD_GETPGRP(pid) getpgrp2((pid)) +# define BSD_GETPGRP(pid) getpgrp2((pid)) #endif #if defined(BSD_GETPGRP) && !defined(HAS_GETPGRP) -# define HAS_GETPGRP /* Well, effectively it does . . . */ +# define HAS_GETPGRP /* Well, effectively it does . . . */ #endif /* These are not exact synonyms, since setpgrp() and getpgrp() may have different behaviors, but perl.h used to define USE_BSDPGRP (prior to 5.003_05) so some extension might depend on it. -*/ + */ #if defined(USE_BSD_SETPGRP) || defined(USE_BSD_GETPGRP) # ifndef USE_BSDPGRP # define USE_BSDPGRP # endif #endif -/* This define exists only for compatibility. It used to mean "my_setenv and - * friends should use setenv/putenv, instead of manipulating environ directly", - * which is now always the case. It's still defined to prevent XS modules from - * using the no longer existing PL_use_safe_putenv variable. +/* This define exists only for compatibility. It used to mean "my_setenv and + * friends should use setenv/putenv, instead of manipulating environ + * directly", which is now always the case. It's still defined to prevent XS + * modules from using the no longer existing PL_use_safe_putenv variable. */ #define PERL_USE_SAFE_PUTENV /* HP-UX 10.X CMA (Common Multithreaded Architecture) insists that pthread.h must be included before all other header files. -*/ + */ #if defined(USE_ITHREADS) && defined(PTHREAD_H_FIRST) && defined(I_PTHREAD) # include #endif @@ -1053,7 +1048,7 @@ violations are fatal. #include #include -#ifdef METHOD /* Defined by OSF/1 v3.0 by ctype.h */ +#ifdef METHOD /* Defined by OSF/1 v3.0 by ctype.h */ #undef METHOD #endif @@ -1075,22 +1070,22 @@ violations are fatal. * The defines from here to the following ===== line are unfortunately * duplicated in makedef.pl, and changes here MUST also be made there */ -/* If not forbidden, we enable locale handling if either 1) the POSIX 2008 - * functions are available, or 2) just the setlocale() function. This logic is - * repeated in t/loc_tools.pl and makedef.pl; The three should be kept in - * sync. */ +/* If not forbidden, we enable locale handling if either 1) the + * POSIX 2008 functions are available, or 2) just the setlocale() + * function. This logic is repeated in t/loc_tools.pl and + * makedef.pl; The three should be kept in sync. */ #if ! defined(NO_LOCALE) -# if ! defined(NO_POSIX_2008_LOCALE) \ - && defined(HAS_NEWLOCALE) \ - && defined(HAS_USELOCALE) \ - && defined(HAS_DUPLOCALE) \ - && defined(HAS_FREELOCALE) \ - && defined(LC_ALL_MASK) +# if ! defined(NO_POSIX_2008_LOCALE) \ + && defined(HAS_NEWLOCALE) \ + && defined(HAS_USELOCALE) \ + && defined(HAS_DUPLOCALE) \ + && defined(HAS_FREELOCALE) \ + && defined(LC_ALL_MASK) - /* For simplicity, the code is written to assume that any platform advanced - * enough to have the Posix 2008 locale functions has LC_ALL. The final - * test above makes sure that assumption is valid */ + /* For simplicity, the code is written to assume that any platform + * advanced enough to have the Posix 2008 locale functions has LC_ALL. + * The final test above makes sure that assumption is valid */ # define HAS_POSIX_2008_LOCALE # define USE_LOCALE @@ -1100,139 +1095,140 @@ violations are fatal. #endif #ifdef USE_LOCALE -# define HAS_SKIP_LOCALE_INIT /* Solely for XS code to test for this - #define */ -# if !defined(NO_LOCALE_COLLATE) && defined(LC_COLLATE) \ - && defined(HAS_STRXFRM) -# define USE_LOCALE_COLLATE +# define HAS_SKIP_LOCALE_INIT /* Solely for XS code to test + for this #define */ +# if !defined(NO_LOCALE_COLLATE) && defined(LC_COLLATE) \ + && defined(HAS_STRXFRM) +# define USE_LOCALE_COLLATE # endif # if !defined(NO_LOCALE_CTYPE) && defined(LC_CTYPE) -# define USE_LOCALE_CTYPE +# define USE_LOCALE_CTYPE # endif # if !defined(NO_LOCALE_NUMERIC) && defined(LC_NUMERIC) -# define USE_LOCALE_NUMERIC +# define USE_LOCALE_NUMERIC # endif # if !defined(NO_LOCALE_MESSAGES) && defined(LC_MESSAGES) -# define USE_LOCALE_MESSAGES +# define USE_LOCALE_MESSAGES # endif # if !defined(NO_LOCALE_MONETARY) && defined(LC_MONETARY) -# define USE_LOCALE_MONETARY +# define USE_LOCALE_MONETARY # endif # if !defined(NO_LOCALE_TIME) && defined(LC_TIME) -# define USE_LOCALE_TIME +# define USE_LOCALE_TIME # endif # if !defined(NO_LOCALE_ADDRESS) && defined(LC_ADDRESS) -# define USE_LOCALE_ADDRESS +# define USE_LOCALE_ADDRESS # endif # if !defined(NO_LOCALE_IDENTIFICATION) && defined(LC_IDENTIFICATION) -# define USE_LOCALE_IDENTIFICATION +# define USE_LOCALE_IDENTIFICATION # endif # if !defined(NO_LOCALE_MEASUREMENT) && defined(LC_MEASUREMENT) -# define USE_LOCALE_MEASUREMENT +# define USE_LOCALE_MEASUREMENT # endif # if !defined(NO_LOCALE_PAPER) && defined(LC_PAPER) -# define USE_LOCALE_PAPER +# define USE_LOCALE_PAPER # endif # if !defined(NO_LOCALE_TELEPHONE) && defined(LC_TELEPHONE) -# define USE_LOCALE_TELEPHONE +# define USE_LOCALE_TELEPHONE # endif # if !defined(NO_LOCALE_NAME) && defined(LC_NAME) -# define USE_LOCALE_NAME +# define USE_LOCALE_NAME # endif # if !defined(NO_LOCALE_SYNTAX) && defined(LC_SYNTAX) -# define USE_LOCALE_SYNTAX +# define USE_LOCALE_SYNTAX # endif # if !defined(NO_LOCALE_TOD) && defined(LC_TOD) -# define USE_LOCALE_TOD +# define USE_LOCALE_TOD # endif -/* Now create LC_foo_INDEX_ #defines for just those categories on this system */ +/* Now create LC_foo_INDEX_ #defines for just + those categories on this system */ # ifdef USE_LOCALE_CTYPE -# define LC_CTYPE_INDEX_ 0 -# define PERL_DUMMY_CTYPE_ LC_CTYPE_INDEX_ +# define LC_CTYPE_INDEX_ 0 +# define PERL_DUMMY_CTYPE_ LC_CTYPE_INDEX_ # else -# define PERL_DUMMY_CTYPE_ -1 +# define PERL_DUMMY_CTYPE_ -1 # endif # ifdef USE_LOCALE_NUMERIC -# define LC_NUMERIC_INDEX_ PERL_DUMMY_CTYPE_ + 1 -# define PERL_DUMMY_NUMERIC_ LC_NUMERIC_INDEX_ +# define LC_NUMERIC_INDEX_ PERL_DUMMY_CTYPE_ + 1 +# define PERL_DUMMY_NUMERIC_ LC_NUMERIC_INDEX_ # else -# define PERL_DUMMY_NUMERIC_ PERL_DUMMY_CTYPE_ +# define PERL_DUMMY_NUMERIC_ PERL_DUMMY_CTYPE_ # endif # ifdef USE_LOCALE_COLLATE -# define LC_COLLATE_INDEX_ PERL_DUMMY_NUMERIC_ + 1 -# define PERL_DUMMY_COLLATE_ LC_COLLATE_INDEX_ +# define LC_COLLATE_INDEX_ PERL_DUMMY_NUMERIC_ + 1 +# define PERL_DUMMY_COLLATE_ LC_COLLATE_INDEX_ # else -# define PERL_DUMMY_COLLATE_ PERL_DUMMY_NUMERIC_ +# define PERL_DUMMY_COLLATE_ PERL_DUMMY_NUMERIC_ # endif # ifdef USE_LOCALE_TIME -# define LC_TIME_INDEX_ PERL_DUMMY_COLLATE_ + 1 -# define PERL_DUMMY_TIME_ LC_TIME_INDEX_ +# define LC_TIME_INDEX_ PERL_DUMMY_COLLATE_ + 1 +# define PERL_DUMMY_TIME_ LC_TIME_INDEX_ # else -# define PERL_DUMMY_TIME_ PERL_DUMMY_COLLATE_ +# define PERL_DUMMY_TIME_ PERL_DUMMY_COLLATE_ # endif # ifdef USE_LOCALE_MESSAGES -# define LC_MESSAGES_INDEX_ PERL_DUMMY_TIME_ + 1 -# define PERL_DUMMY_MESSAGES_ LC_MESSAGES_INDEX_ +# define LC_MESSAGES_INDEX_ PERL_DUMMY_TIME_ + 1 +# define PERL_DUMMY_MESSAGES_ LC_MESSAGES_INDEX_ # else -# define PERL_DUMMY_MESSAGES_ PERL_DUMMY_TIME_ +# define PERL_DUMMY_MESSAGES_ PERL_DUMMY_TIME_ # endif # ifdef USE_LOCALE_MONETARY -# define LC_MONETARY_INDEX_ PERL_DUMMY_MESSAGES_ + 1 -# define PERL_DUMMY_MONETARY_ LC_MONETARY_INDEX_ +# define LC_MONETARY_INDEX_ PERL_DUMMY_MESSAGES_ + 1 +# define PERL_DUMMY_MONETARY_ LC_MONETARY_INDEX_ # else -# define PERL_DUMMY_MONETARY_ PERL_DUMMY_MESSAGES_ +# define PERL_DUMMY_MONETARY_ PERL_DUMMY_MESSAGES_ # endif # ifdef USE_LOCALE_ADDRESS -# define LC_ADDRESS_INDEX_ PERL_DUMMY_MONETARY_ + 1 -# define PERL_DUMMY_ADDRESS_ LC_ADDRESS_INDEX_ +# define LC_ADDRESS_INDEX_ PERL_DUMMY_MONETARY_ + 1 +# define PERL_DUMMY_ADDRESS_ LC_ADDRESS_INDEX_ # else -# define PERL_DUMMY_ADDRESS_ PERL_DUMMY_MONETARY_ +# define PERL_DUMMY_ADDRESS_ PERL_DUMMY_MONETARY_ # endif # ifdef USE_LOCALE_IDENTIFICATION -# define LC_IDENTIFICATION_INDEX_ PERL_DUMMY_ADDRESS_ + 1 -# define PERL_DUMMY_IDENTIFICATION_ LC_IDENTIFICATION_INDEX_ +# define LC_IDENTIFICATION_INDEX_ PERL_DUMMY_ADDRESS_ + 1 +# define PERL_DUMMY_IDENTIFICATION_ LC_IDENTIFICATION_INDEX_ # else -# define PERL_DUMMY_IDENTIFICATION_ PERL_DUMMY_ADDRESS_ +# define PERL_DUMMY_IDENTIFICATION_ PERL_DUMMY_ADDRESS_ # endif # ifdef USE_LOCALE_MEASUREMENT -# define LC_MEASUREMENT_INDEX_ PERL_DUMMY_IDENTIFICATION_ + 1 -# define PERL_DUMMY_MEASUREMENT_ LC_MEASUREMENT_INDEX_ +# define LC_MEASUREMENT_INDEX_ PERL_DUMMY_IDENTIFICATION_ + 1 +# define PERL_DUMMY_MEASUREMENT_ LC_MEASUREMENT_INDEX_ # else -# define PERL_DUMMY_MEASUREMENT_ PERL_DUMMY_IDENTIFICATION_ +# define PERL_DUMMY_MEASUREMENT_ PERL_DUMMY_IDENTIFICATION_ # endif # ifdef USE_LOCALE_PAPER -# define LC_PAPER_INDEX_ PERL_DUMMY_MEASUREMENT_ + 1 -# define PERL_DUMMY_PAPER_ LC_PAPER_INDEX_ +# define LC_PAPER_INDEX_ PERL_DUMMY_MEASUREMENT_ + 1 +# define PERL_DUMMY_PAPER_ LC_PAPER_INDEX_ # else -# define PERL_DUMMY_PAPER_ PERL_DUMMY_MEASUREMENT_ +# define PERL_DUMMY_PAPER_ PERL_DUMMY_MEASUREMENT_ # endif # ifdef USE_LOCALE_TELEPHONE -# define LC_TELEPHONE_INDEX_ PERL_DUMMY_PAPER_ + 1 -# define PERL_DUMMY_TELEPHONE_ LC_TELEPHONE_INDEX_ +# define LC_TELEPHONE_INDEX_ PERL_DUMMY_PAPER_ + 1 +# define PERL_DUMMY_TELEPHONE_ LC_TELEPHONE_INDEX_ # else -# define PERL_DUMMY_TELEPHONE_ PERL_DUMMY_PAPER_ +# define PERL_DUMMY_TELEPHONE_ PERL_DUMMY_PAPER_ # endif # ifdef USE_LOCALE_NAME -# define LC_NAME_INDEX_ PERL_DUMMY_TELEPHONE_ + 1 -# define PERL_DUMMY_NAME_ LC_NAME_INDEX_ +# define LC_NAME_INDEX_ PERL_DUMMY_TELEPHONE_ + 1 +# define PERL_DUMMY_NAME_ LC_NAME_INDEX_ # else -# define PERL_DUMMY_NAME_ PERL_DUMMY_TELEPHONE_ +# define PERL_DUMMY_NAME_ PERL_DUMMY_TELEPHONE_ # endif # ifdef USE_LOCALE_SYNTAX -# define LC_SYNTAX_INDEX_ PERL_DUMMY_NAME + 1 -# define PERL_DUMMY_SYNTAX_ LC_SYNTAX_INDEX_ +# define LC_SYNTAX_INDEX_ PERL_DUMMY_NAME + 1 +# define PERL_DUMMY_SYNTAX_ LC_SYNTAX_INDEX_ # else -# define PERL_DUMMY_SYNTAX_ PERL_DUMMY_NAME_ +# define PERL_DUMMY_SYNTAX_ PERL_DUMMY_NAME_ # endif # ifdef USE_LOCALE_TOD -# define LC_TOD_INDEX_ PERL_DUMMY_SYNTAX_ + 1 -# define PERL_DUMMY_TOD_ LC_TOD_INDEX_ +# define LC_TOD_INDEX_ PERL_DUMMY_SYNTAX_ + 1 +# define PERL_DUMMY_TOD_ LC_TOD_INDEX_ # else -# define PERL_DUMMY_TOD_ PERL_DUMMY_SYNTAX_ +# define PERL_DUMMY_TOD_ PERL_DUMMY_SYNTAX_ # endif # ifdef LC_ALL -# define LC_ALL_INDEX_ PERL_DUMMY_TOD_ + 1 +# define LC_ALL_INDEX_ PERL_DUMMY_TOD_ + 1 # endif @@ -1240,18 +1236,18 @@ violations are fatal. # define USE_LOCALE_THREADS # endif - /* Use POSIX 2008 locales if available, and no alternative exists - * ('setlocale()' is the alternative); or is threaded and not forbidden to - * use them */ -# if defined(HAS_POSIX_2008_LOCALE) && ( ! defined(HAS_SETLOCALE) \ - || ( defined(USE_LOCALE_THREADS) \ - && ! defined(NO_POSIX_2008_LOCALE))) + /* Use POSIX 2008 locales if available, and no alternative + * exists ('setlocale()' is the alternative); or is + * threaded and not forbidden to use them */ +# if defined(HAS_POSIX_2008_LOCALE) && ( ! defined(HAS_SETLOCALE) \ + || ( defined(USE_LOCALE_THREADS) \ + && ! defined(NO_POSIX_2008_LOCALE))) # define USE_POSIX_2008_LOCALE # endif - /* On threaded builds, use thread-safe locales if they are available and not - * forbidden. Availability is when we are using POSIX 2008 locales, or - * Windows for quite a few releases now. */ + /* On threaded builds, use thread-safe locales if they are available + * and not forbidden. Availability is when we are using POSIX 2008 + * locales, or Windows for quite a few releases now. */ # if defined(USE_LOCALE_THREADS) && ! defined(NO_THREAD_SAFE_LOCALE) # if defined(USE_POSIX_2008_LOCALE) || (defined(WIN32) && defined(_MSC_VER)) # define USE_THREAD_SAFE_LOCALE @@ -1260,27 +1256,27 @@ violations are fatal. # include "perl_langinfo.h" /* Needed for _NL_LOCALE_NAME */ -/* Allow use of glibc's undocumented querylocale() equivalent if asked for, and - * appropriate */ +/* Allow use of glibc's undocumented querylocale() + * equivalent if asked for, and appropriate */ # ifdef USE_POSIX_2008_LOCALE -# if defined(HAS_QUERYLOCALE) \ - /* Has this internal undocumented item for nl_langinfo() */ \ - || ( defined(_NL_LOCALE_NAME) \ - /* And asked for */ \ - && defined(USE_NL_LOCALE_NAME) \ - /* We need the below because we will be calling it within a \ - * macro, can't have it get messed up by another thread. */ \ - && defined(HAS_THREAD_SAFE_NL_LANGINFO_L) \ - /* On systems that accept any locale name, the real \ - * underlying locale is often returned by this internal \ - * item, so we can't use it */ \ - && ! defined(SETLOCALE_ACCEPTS_ANY_LOCALE_NAME)) +# if defined(HAS_QUERYLOCALE) \ + /* Has this internal undocumented item for nl_langinfo() */ \ + || ( defined(_NL_LOCALE_NAME) \ + /* And asked for */ \ + && defined(USE_NL_LOCALE_NAME) \ + /* We need the below because we will be calling it within a macro, \ + * can't have it get messed up by another thread. */ \ + && defined(HAS_THREAD_SAFE_NL_LANGINFO_L) \ + /* On systems that accept any locale name, the \ + * real underlying locale is often returned by \ + * this internal item, so we can't use it */ \ + && ! defined(SETLOCALE_ACCEPTS_ANY_LOCALE_NAME)) # define USE_QUERYLOCALE # endif # endif - /* POSIX 2008 has no means of finding out the current locale without a - * querylocale; so must keep track of it ourselves */ + /* POSIX 2008 has no means of finding out the current locale without + * a querylocale; so must keep track of it ourselves */ # if (defined(USE_POSIX_2008_LOCALE) && ! defined(USE_QUERYLOCALE)) # define USE_PL_CURLOCALES # define USE_PL_CUR_LC_ALL @@ -1288,27 +1284,27 @@ violations are fatal. # if defined(WIN32) && defined(USE_THREAD_SAFE_LOCALE) - /* We need to be able to map the current value of what the tTHX context - * thinks LC_ALL is so as to inform the Windows libc when switching - * contexts. */ + /* We need to be able to map the current value of what + * the tTHX context thinks LC_ALL is so as to inform + * the Windows libc when switching contexts. */ # define USE_PL_CUR_LC_ALL - /* Microsoft documentation reads in the change log for VS 2015: "The - * localeconv function declared in locale.h now works correctly when - * per-thread locale is enabled. In previous versions of the library, this - * function would return the lconv data for the global locale, not the - * thread's locale." */ + /* Microsoft documentation reads in the change log for VS 2015: + * "The localeconv function declared in locale.h now works + * correctly when per-thread locale is enabled. In previous + * versions of the library, this function would return the lconv + * data for the global locale, not the thread's locale." */ # if _MSC_VER < 1900 # define TS_W32_BROKEN_LOCALECONV # endif # endif - /* POSIX 2008 and Windows with thread-safe locales keep locale information - * in libc data. Therefore we must inform their libc's when the context - * switches */ -# if defined(MULTIPLICITY) && ( defined(USE_POSIX_2008_LOCALE) \ - || ( defined(WIN32) \ - && defined(USE_THREAD_SAFE_LOCALE))) + /* POSIX 2008 and Windows with thread-safe locales keep + * locale information in libc data. Therefore we must + * inform their libc's when the context switches */ +# if defined(MULTIPLICITY) && ( defined(USE_POSIX_2008_LOCALE) \ + || ( defined(WIN32) \ + && defined(USE_THREAD_SAFE_LOCALE))) # define USE_PERL_SWITCH_LOCALE_CONTEXT # endif #endif @@ -1318,15 +1314,15 @@ violations are fatal. #ifdef PERL_CORE -/* Both typedefs are used in locale.c only, but defined here so that embed.fnc - * can generate the proper prototypes. */ +/* Both typedefs are used in locale.c only, but defined here so + * that embed.fnc can generate the proper prototypes. */ typedef enum { DONT_RECALC_LC_ALL, YES_RECALC_LC_ALL, - /* Used in tight loops through all sub-categories, where LC_ALL won't be - * fully known until all subcategories are handled. */ + /* Used in tight loops through all sub-categories, where LC_ALL won't + * be fully known until all subcategories are handled. */ RECALCULATE_LC_ALL_ON_FINAL_INTERATION } recalc_lc_all_t; @@ -1349,15 +1345,15 @@ typedef struct { #ifdef I_SYS_PARAM # ifdef PARAM_NEEDS_TYPES -# include +# include # endif # include #endif -/* On BSD-derived systems, defines BSD to a year-month - value something like 199306. This may be useful if no more-specific - feature test is available. -*/ +/* On BSD-derived systems, defines BSD to a + year-month value something like 199306. This may be + useful if no more-specific feature test is available. + */ #if defined(BSD) # ifndef BSDish # define BSDish @@ -1367,7 +1363,7 @@ typedef struct { /* Use all the "standard" definitions */ #include -/* If this causes problems, set i_unistd=undef in the hint file. */ +/* If this causes problems, set i_unistd=undef in the hint file. */ #ifdef I_UNISTD # if defined(__amigaos4__) # ifdef I_NETINET_IN @@ -1376,13 +1372,12 @@ typedef struct { # endif # include # if defined(__amigaos4__) -/* Under AmigaOS 4 newlib.library provides an environ. However using - * it doesn't give us enough control over inheritance of variables by - * subshells etc. so replace with custom version based on abc-shell - * code. */ +/* Under AmigaOS 4 newlib.library provides an environ. However using it + * doesn't give us enough control over inheritance of variables by subshells + * etc. so replace with custom version based on abc-shell code. */ extern char **myenviron; # undef environ -# define environ myenviron +# define environ myenviron # endif #endif @@ -1399,9 +1394,9 @@ EXTERN_C int syscall(int, ...); EXTERN_C int usleep(unsigned int); #endif -/* Macros for correct constant construction. These are in C99 - * (so they will not be available in strict C89 mode), but they are nice, so - * let's define them if necessary. */ +/* Macros for correct constant construction. These are in C99 + * (so they will not be available in strict C89 mode), + * but they are nice, so let's define them if necessary. */ /* =for apidoc_section $integer @@ -1409,38 +1404,38 @@ EXTERN_C int usleep(unsigned int); =for apidoc_item |I32|INT32_C|number =for apidoc_item |I64|INT64_C|number -Returns a token the C compiler recognizes for the constant C of the -corresponding integer type on the machine. +Returns a token the C compiler recognizes for the constant C of +the corresponding integer type on the machine. -If the machine does not have a 64-bit type, C is undefined. -Use C> to get the largest type available on the platform. +If the machine does not have a 64-bit type, C is undefined. Use +C> to get the largest type available on the platform. =for apidoc Am|U16|UINT16_C|number =for apidoc_item |U32|UINT32_C|number =for apidoc_item |U64|UINT64_C|number -Returns a token the C compiler recognizes for the constant C of the -corresponding unsigned integer type on the machine. +Returns a token the C compiler recognizes for the constant C of +the corresponding unsigned integer type on the machine. -If the machine does not have a 64-bit type, C is undefined. -Use C> to get the largest type available on the platform. +If the machine does not have a 64-bit type, C is undefined. Use +C> to get the largest type available on the platform. =cut */ #ifndef UINT16_C # if INTSIZE >= 2 -# define UINT16_C(x) ((U16_TYPE)x##U) +# define UINT16_C(x) ((U16_TYPE)x##U) # else -# define UINT16_C(x) ((U16_TYPE)x##UL) +# define UINT16_C(x) ((U16_TYPE)x##UL) # endif #endif #ifndef UINT32_C # if INTSIZE >= 4 -# define UINT32_C(x) ((U32_TYPE)x##U) +# define UINT32_C(x) ((U32_TYPE)x##U) # else -# define UINT32_C(x) ((U32_TYPE)x##UL) +# define UINT32_C(x) ((U32_TYPE)x##UL) # endif #endif @@ -1449,48 +1444,48 @@ Use C> to get the largest type available on the platform. typedef uintmax_t PERL_UINTMAX_T; #endif -/* N.B. We use QUADKIND here instead of HAS_QUAD here, because that doesn't - * actually mean what it has always been documented to mean (see RT #119753) - * and is explicitly turned off outside of core with dire warnings about - * removing the undef. */ +/* N.B. We use QUADKIND here instead of HAS_QUAD here, because + * that doesn't actually mean what it has always been documented + * to mean (see RT #119753) and is explicitly turned off outside + * of core with dire warnings about removing the undef. */ #if defined(QUADKIND) # undef PeRl_INT64_C # undef PeRl_UINT64_C -/* Prefer the native integer types (int and long) over long long - * (which is not C89) and Win32-specific __int64. */ +/* Prefer the native integer types (int and long) over long + * long (which is not C89) and Win32-specific __int64. */ # if QUADKIND == QUAD_IS_INT && INTSIZE == 8 -# define PeRl_INT64_C(c) (c) -# define PeRl_UINT64_C(c) CAT2(c,U) +# define PeRl_INT64_C(c) (c) +# define PeRl_UINT64_C(c) CAT2(c,U) # endif # if QUADKIND == QUAD_IS_LONG && LONGSIZE == 8 -# define PeRl_INT64_C(c) CAT2(c,L) -# define PeRl_UINT64_C(c) CAT2(c,UL) +# define PeRl_INT64_C(c) CAT2(c,L) +# define PeRl_UINT64_C(c) CAT2(c,UL) # endif # if QUADKIND == QUAD_IS_LONG_LONG && defined(HAS_LONG_LONG) -# define PeRl_INT64_C(c) CAT2(c,LL) -# define PeRl_UINT64_C(c) CAT2(c,ULL) +# define PeRl_INT64_C(c) CAT2(c,LL) +# define PeRl_UINT64_C(c) CAT2(c,ULL) # endif # if QUADKIND == QUAD_IS___INT64 -# define PeRl_INT64_C(c) CAT2(c,I64) -# define PeRl_UINT64_C(c) CAT2(c,UI64) +# define PeRl_INT64_C(c) CAT2(c,I64) +# define PeRl_UINT64_C(c) CAT2(c,UI64) # endif # ifndef PeRl_INT64_C -# define PeRl_INT64_C(c) ((I64)(c)) /* last resort */ -# define PeRl_UINT64_C(c) ((U64TYPE)(c)) +# define PeRl_INT64_C(c) ((I64)(c)) /* last resort */ +# define PeRl_UINT64_C(c) ((U64TYPE)(c)) # endif -/* In OS X the INT64_C/UINT64_C are defined with LL/ULL, which will - * not fly with C89-pedantic gcc, so let's undefine them first so that - * we can redefine them with our native integer preferring versions. */ +/* In OS X the INT64_C/UINT64_C are defined with LL/ULL, which will not + * fly with C89-pedantic gcc, so let's undefine them first so that we + * can redefine them with our native integer preferring versions. */ # if defined(PERL_DARWIN) && defined(PERL_GCC_PEDANTIC) # undef INT64_C # undef UINT64_C # endif # ifndef INT64_C -# define INT64_C(c) PeRl_INT64_C(c) +# define INT64_C(c) PeRl_INT64_C(c) # endif # ifndef UINT64_C -# define UINT64_C(c) PeRl_UINT64_C(c) +# define UINT64_C(c) PeRl_UINT64_C(c) # endif /* @@ -1525,10 +1520,10 @@ Use L to declare variables of the maximum usable size on this platform. typedef U64TYPE PERL_UINTMAX_T; # endif # ifndef INTMAX_C -# define INTMAX_C(c) INT64_C(c) +# define INTMAX_C(c) INT64_C(c) # endif # ifndef UINTMAX_C -# define UINTMAX_C(c) UINT64_C(c) +# define UINTMAX_C(c) UINT64_C(c) # endif #else /* below QUADKIND is undefined */ @@ -1539,10 +1534,10 @@ Use L to declare variables of the maximum usable size on this platform. typedef U32TYPE PERL_UINTMAX_T; # endif # ifndef INTMAX_C -# define INTMAX_C(c) INT32_C(c) +# define INTMAX_C(c) INT32_C(c) # endif # ifndef UINTMAX_C -# define UINTMAX_C(c) UINT32_C(c) +# define UINTMAX_C(c) UINT32_C(c) # endif #endif /* no QUADKIND */ @@ -1550,57 +1545,63 @@ Use L to declare variables of the maximum usable size on this platform. #ifdef PERL_CORE /* byte-swapping functions for big-/little-endian conversion */ -# define _swab_16_(x) ((U16)( \ - (((U16)(x) & UINT16_C(0x00ff)) << 8) | \ - (((U16)(x) & UINT16_C(0xff00)) >> 8) )) - -# define _swab_32_(x) ((U32)( \ - (((U32)(x) & UINT32_C(0x000000ff)) << 24) | \ - (((U32)(x) & UINT32_C(0x0000ff00)) << 8) | \ - (((U32)(x) & UINT32_C(0x00ff0000)) >> 8) | \ - (((U32)(x) & UINT32_C(0xff000000)) >> 24) )) +# define _swab_16_(x) \ + ((U16)( \ + (((U16)(x) & UINT16_C(0x00ff)) << 8) | \ + (((U16)(x) & UINT16_C(0xff00)) >> 8) )) + +# define _swab_32_(x) \ + ((U32)( \ + (((U32)(x) & UINT32_C(0x000000ff)) << 24) | \ + (((U32)(x) & UINT32_C(0x0000ff00)) << 8) | \ + (((U32)(x) & UINT32_C(0x00ff0000)) >> 8) | \ + (((U32)(x) & UINT32_C(0xff000000)) >> 24) )) # ifdef HAS_QUAD -# define _swab_64_(x) ((U64)( \ - (((U64)(x) & UINT64_C(0x00000000000000ff)) << 56) | \ - (((U64)(x) & UINT64_C(0x000000000000ff00)) << 40) | \ - (((U64)(x) & UINT64_C(0x0000000000ff0000)) << 24) | \ - (((U64)(x) & UINT64_C(0x00000000ff000000)) << 8) | \ - (((U64)(x) & UINT64_C(0x000000ff00000000)) >> 8) | \ - (((U64)(x) & UINT64_C(0x0000ff0000000000)) >> 24) | \ - (((U64)(x) & UINT64_C(0x00ff000000000000)) >> 40) | \ - (((U64)(x) & UINT64_C(0xff00000000000000)) >> 56) )) +# define _swab_64_(x) \ + ((U64)( \ + (((U64)(x) & UINT64_C(0x00000000000000ff)) << 56) | \ + (((U64)(x) & UINT64_C(0x000000000000ff00)) << 40) | \ + (((U64)(x) & UINT64_C(0x0000000000ff0000)) << 24) | \ + (((U64)(x) & UINT64_C(0x00000000ff000000)) << 8) | \ + (((U64)(x) & UINT64_C(0x000000ff00000000)) >> 8) | \ + (((U64)(x) & UINT64_C(0x0000ff0000000000)) >> 24) | \ + (((U64)(x) & UINT64_C(0x00ff000000000000)) >> 40) | \ + (((U64)(x) & UINT64_C(0xff00000000000000)) >> 56) )) # endif /* Maximum level of recursion */ #ifndef PERL_SUB_DEPTH_WARN -#define PERL_SUB_DEPTH_WARN 100 +#define PERL_SUB_DEPTH_WARN 100 #endif #endif /* PERL_CORE */ -/* Maximum number of args that may be passed to an OP_MULTICONCAT op. - * It determines the size of local arrays in S_maybe_multiconcat() and - * pp_multiconcat(). +/* Maximum number of args that may be passed to an + * OP_MULTICONCAT op. It determines the size of local arrays + * in S_maybe_multiconcat() and pp_multiconcat(). */ -#define PERL_MULTICONCAT_MAXARG 64 +#define PERL_MULTICONCAT_MAXARG 64 -/* The indexes of fields of a multiconcat aux struct. - * The fixed fields are followed by nargs+1 const segment lengths, - * and if utf8 and non-utf8 differ, a second nargs+1 set for utf8. +/* The indexes of fields of a multiconcat aux struct. The fixed + * fields are followed by nargs+1 const segment lengths, and if + * utf8 and non-utf8 differ, a second nargs+1 set for utf8. */ -#define PERL_MULTICONCAT_IX_NARGS 0 /* number of arguments */ -#define PERL_MULTICONCAT_IX_PLAIN_PV 1 /* non-utf8 constant string */ -#define PERL_MULTICONCAT_IX_PLAIN_LEN 2 /* non-utf8 constant string length */ -#define PERL_MULTICONCAT_IX_UTF8_PV 3 /* utf8 constant string */ -#define PERL_MULTICONCAT_IX_UTF8_LEN 4 /* utf8 constant string length */ -#define PERL_MULTICONCAT_IX_LENGTHS 5 /* first of nargs+1 const segment lens */ -#define PERL_MULTICONCAT_HEADER_SIZE 5 /* The number of fields of a - multiconcat header */ - -/* We no longer default to creating a new SV for GvSV. - Do this before embed. */ +#define PERL_MULTICONCAT_IX_NARGS 0 /* number of arguments */ +#define PERL_MULTICONCAT_IX_PLAIN_PV 1 /* non-utf8 constant string */ +#define PERL_MULTICONCAT_IX_PLAIN_LEN 2 /* non-utf8 constant + string length */ +#define PERL_MULTICONCAT_IX_UTF8_PV 3 /* utf8 constant string */ +#define PERL_MULTICONCAT_IX_UTF8_LEN 4 /* utf8 constant string + length */ +#define PERL_MULTICONCAT_IX_LENGTHS 5 /* first of nargs+1 const + segment lens */ +#define PERL_MULTICONCAT_HEADER_SIZE 5 /* The number of fields of a + multiconcat header */ + +/* We no longer default to creating a new SV + for GvSV. Do this before embed. */ #ifndef PERL_CREATE_GVSV # ifndef PERL_DONT_CREATE_GVSV # define PERL_DONT_CREATE_GVSV @@ -1615,71 +1616,67 @@ Use L to declare variables of the maximum usable size on this platform. #define PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION #endif -#define MEM_SIZE Size_t +#define MEM_SIZE Size_t -/* av_extend and analogues enforce a minimum number of array elements. - * This has been 4 elements (so a minimum key size of 3) for a long - * time, but the rationale behind this seems to have been lost to the - * mists of time. */ +/* av_extend and analogues enforce a minimum number of array elements. This + * has been 4 elements (so a minimum key size of 3) for a long time, but the + * rationale behind this seems to have been lost to the mists of time. */ #ifndef PERL_ARRAY_NEW_MIN_KEY -#define PERL_ARRAY_NEW_MIN_KEY 3 -#endif - -/* Functions like Perl_sv_grow mandate a minimum string size. - * This was 10 bytes for a long time, the rationale for which seems lost - * to the mists of time. However, this does not correlate to what modern - * malloc implementations will actually return, in particular the fact - * that chunks are almost certainly some multiple of pointer size. The - * default has therefore been revised to a more useful approximation. - * Notes: The following is specifically conservative for 64 bit, since - * most dlmalloc derivatives seem to serve a 3xPTRSIZE minimum chunk, - * so the below perhaps should be: - * ((PTRSIZE == 4) ? 12 : 24) - * Configure probes for malloc_good_size, malloc_actual_size etc. - * could be revised to record the actual minimum chunk size, to which - * PERL_STRLEN_NEW_MIN could then be set. +#define PERL_ARRAY_NEW_MIN_KEY 3 +#endif + +/* Functions like Perl_sv_grow mandate a minimum string size. This was 10 + * bytes for a long time, the rationale for which seems lost to the mists of + * time. However, this does not correlate to what modern malloc + * implementations will actually return, in particular the fact that chunks are + * almost certainly some multiple of pointer size. The default has therefore + * been revised to a more useful approximation. Notes: The following is + * specifically conservative for 64 bit, since most dlmalloc derivatives seem + * to serve a 3xPTRSIZE minimum chunk, so the below perhaps should be: + * ((PTRSIZE == 4) ? 12 : 24) Configure probes for malloc_good_size, + * malloc_actual_size etc. could be revised to record the actual minimum chunk + * size, to which PERL_STRLEN_NEW_MIN could then be set. */ #ifndef PERL_STRLEN_NEW_MIN -#define PERL_STRLEN_NEW_MIN ((PTRSIZE == 4) ? 12 : 16) +#define PERL_STRLEN_NEW_MIN ((PTRSIZE == 4) ? 12 : 16) #endif -/* Round all values passed to malloc up, by default to a multiple of - sizeof(size_t) -*/ +/* Round all values passed to malloc up, by + default to a multiple of sizeof(size_t) + */ #ifndef PERL_STRLEN_ROUNDUP_QUANTUM #define PERL_STRLEN_ROUNDUP_QUANTUM Size_t_size #endif -/* sv_grow() will expand strings by at least a certain percentage of - the previously *used* length to avoid excessive calls to realloc(). - The default is 25% of the current length. -*/ +/* sv_grow() will expand strings by at least a certain percentage + of the previously *used* length to avoid excessive calls to + realloc(). The default is 25% of the current length. + */ #ifndef PERL_STRLEN_EXPAND_SHIFT -# define PERL_STRLEN_EXPAND_SHIFT 2 +# define PERL_STRLEN_EXPAND_SHIFT 2 #endif -/* This use of offsetof() requires /Zc:offsetof- for VS2017 (and presumably - * onwards) when building Socket.xs, but we can just use a different definition - * for STRUCT_OFFSET instead. */ +/* This use of offsetof() requires /Zc:offsetof- for VS2017 (and + * presumably onwards) when building Socket.xs, but we can just + * use a different definition for STRUCT_OFFSET instead. */ #if defined(WIN32) && defined(_MSC_VER) && _MSC_VER >= 1910 -# define STRUCT_OFFSET(s,m) (Size_t)(&(((s *)0)->m)) +# define STRUCT_OFFSET(s,m) (Size_t)(&(((s *)0)->m)) #else # include -# define STRUCT_OFFSET(s,m) offsetof(s,m) +# define STRUCT_OFFSET(s,m) offsetof(s,m) #endif -/* ptrdiff_t is C11, so undef it under pedantic builds. (Actually it is - * in C89, but apparently there are platforms where it doesn't exist. See - * thread beginning at http://nntp.perl.org/group/perl.perl5.porters/251541.) - * */ +/* ptrdiff_t is C11, so undef it under pedantic builds. (Actually it is in + * C89, but apparently there are platforms where it doesn't exist. See thread + * beginning at http://nntp.perl.org/group/perl.perl5.porters/251541.) */ #ifdef PERL_GCC_PEDANTIC # undef HAS_PTRDIFF_T #endif #ifdef HAS_PTRDIFF_T -# define Ptrdiff_t ptrdiff_t +# define Ptrdiff_t ptrdiff_t #else -# define Ptrdiff_t SSize_t +# define Ptrdiff_t SSize_t #endif # include @@ -1690,52 +1687,53 @@ Use L to declare variables of the maximum usable size on this platform. #ifdef MYMALLOC # ifdef PERL_POLLUTE_MALLOC # ifndef PERL_EXTMALLOC_DEF -# define Perl_malloc malloc -# define Perl_calloc calloc -# define Perl_realloc realloc -# define Perl_mfree free +# define Perl_malloc malloc +# define Perl_calloc calloc +# define Perl_realloc realloc +# define Perl_mfree free # endif # else -# define EMBEDMYMALLOC /* for compatibility */ -# endif - -# define safemalloc Perl_malloc -# define safecalloc Perl_calloc -# define saferealloc Perl_realloc -# define safefree Perl_mfree -# define CHECK_MALLOC_TOO_LATE_FOR_(code) STMT_START { \ - if (!TAINTING_get && MallocCfg_ptr[MallocCfg_cfg_env_read]) \ - code; \ - } STMT_END -# define CHECK_MALLOC_TOO_LATE_FOR(ch) \ - CHECK_MALLOC_TOO_LATE_FOR_(MALLOC_TOO_LATE_FOR(ch)) -# define panic_write2(s) write(2, s, strlen(s)) -# define CHECK_MALLOC_TAINT(newval) \ - CHECK_MALLOC_TOO_LATE_FOR_( \ - if (newval) { \ - PERL_UNUSED_RESULT(panic_write2("panic: tainting with $ENV{PERL_MALLOC_OPT}\n"));\ - exit(1); }) -# define MALLOC_CHECK_TAINT(argc,argv,env) \ - STMT_START { \ - if (doing_taint(argc,argv,env)) { \ - MallocCfg_ptr[MallocCfg_skip_cfg_env] = 1; \ - } \ - } STMT_END; +# define EMBEDMYMALLOC /* for compatibility */ +# endif + +# define safemalloc Perl_malloc +# define safecalloc Perl_calloc +# define saferealloc Perl_realloc +# define safefree Perl_mfree +# define CHECK_MALLOC_TOO_LATE_FOR_(code) \ + STMT_START { \ + if (!TAINTING_get && MallocCfg_ptr[MallocCfg_cfg_env_read]) \ + code; \ + } STMT_END +# define CHECK_MALLOC_TOO_LATE_FOR(ch) \ + CHECK_MALLOC_TOO_LATE_FOR_(MALLOC_TOO_LATE_FOR(ch)) +# define panic_write2(s) write(2, s, strlen(s)) +# define CHECK_MALLOC_TAINT(newval) \ + CHECK_MALLOC_TOO_LATE_FOR_( \ + if (newval) { \ + PERL_UNUSED_RESULT(panic_write2("panic: tainting with $ENV{PERL_MALLOC_OPT}\n")); \ + exit(1); }) +# define MALLOC_CHECK_TAINT(argc,argv,env) \ + STMT_START { \ + if (doing_taint(argc,argv,env)) { \ + MallocCfg_ptr[MallocCfg_skip_cfg_env] = 1; \ + } \ + } STMT_END; #else /* MYMALLOC */ -# define safemalloc safesysmalloc -# define safecalloc safesyscalloc -# define saferealloc safesysrealloc -# define safefree safesysfree -# define CHECK_MALLOC_TOO_LATE_FOR(ch) ((void)0) -# define CHECK_MALLOC_TAINT(newval) ((void)0) +# define safemalloc safesysmalloc +# define safecalloc safesyscalloc +# define saferealloc safesysrealloc +# define safefree safesysfree +# define CHECK_MALLOC_TOO_LATE_FOR(ch) ((void)0) +# define CHECK_MALLOC_TAINT(newval) ((void)0) # define MALLOC_CHECK_TAINT(argc,argv,env) #endif /* MYMALLOC */ /* diag_listed_as: "-T" is on the #! line, it must also be used on the command line */ -#define TOO_LATE_FOR_(ch,what) Perl_croak(aTHX_ "\"-%c\" is on the #! line, it must also be used on the command line%s", (char)(ch), what) -#define TOO_LATE_FOR(ch) TOO_LATE_FOR_(ch, "") -#define MALLOC_TOO_LATE_FOR(ch) TOO_LATE_FOR_(ch, " with $ENV{PERL_MALLOC_OPT}") -#define MALLOC_CHECK_TAINT2(argc,argv) MALLOC_CHECK_TAINT(argc,argv,NULL) +#define TOO_LATE_FOR_(ch,what) Perl_croak(aTHX_ "\"-%c\" is on the #! line, it must also be used on the command line%s", (char)(ch), what) +#define TOO_LATE_FOR(ch) TOO_LATE_FOR_(ch, "") +#define MALLOC_TOO_LATE_FOR(ch) TOO_LATE_FOR_(ch, " with $ENV{PERL_MALLOC_OPT}") +#define MALLOC_CHECK_TAINT2(argc,argv) MALLOC_CHECK_TAINT(argc,argv,NULL) /* =for apidoc Am|void|memzero|void * d|Size_t l @@ -1744,7 +1742,7 @@ Set the C bytes starting at C<*d> to all zeroes. =cut */ #ifndef memzero -# define memzero(d,l) memset(d,0,l) +# define memzero(d,l) memset(d,0,l) #endif #ifdef I_NETINET_IN @@ -1759,21 +1757,21 @@ Set the C bytes starting at C<*d> to all zeroes. # include #endif -/* Microsoft VC's sys/stat.h defines all S_Ixxx macros except S_IFIFO. - This definition should ideally go into win32/win32.h, but S_IFIFO is - used later here in perl.h before win32/win32.h is being included. */ +/* Microsoft VC's sys/stat.h defines all S_Ixxx macros except S_IFIFO. This + definition should ideally go into win32/win32.h, but S_IFIFO is used + later here in perl.h before win32/win32.h is being included. */ #if !defined(S_IFIFO) && defined(_S_IFIFO) -# define S_IFIFO _S_IFIFO +# define S_IFIFO _S_IFIFO #endif -/* The stat macros for Unisoft System V/88 (and derivatives - like UTekV) are broken, sometimes giving false positives. Undefine +/* The stat macros for Unisoft System V/88 (and derivatives like + UTekV) are broken, sometimes giving false positives. Undefine them here and let the code below set them to proper values. - The ghs macro stands for GreenHills Software C-1.8.5 which - is the C compiler for sysV88 and the various derivatives. - This header file bug is corrected in gcc-2.5.8 and later versions. - --Kaveh Ghazi (ghazi@noc.rutgers.edu) 10/3/94. */ + The ghs macro stands for GreenHills Software C-1.8.5 which is + the C compiler for sysV88 and the various derivatives. This + header file bug is corrected in gcc-2.5.8 and later versions. + --Kaveh Ghazi (ghazi@noc.rutgers.edu) 10/3/94. */ #if defined(m88k) && defined(ghs) # undef S_ISDIR @@ -1788,11 +1786,11 @@ Set the C bytes starting at C<*d> to all zeroes. #ifdef I_SYS_TIME # ifdef I_SYS_TIME_KERNEL -# define KERNEL +# define KERNEL # endif # include # ifdef I_SYS_TIME_KERNEL -# undef KERNEL +# undef KERNEL # endif #endif @@ -1803,14 +1801,15 @@ Set the C bytes starting at C<*d> to all zeroes. #include #if defined(WIN32) && defined(PERL_IMPLICIT_SYS) -# define WIN32SCK_IS_STDSCK /* don't pull in custom wsock layer */ +# define WIN32SCK_IS_STDSCK /* don't pull in custom wsock layer */ #endif -#if defined(HAS_SOCKET) && !defined(WIN32) /* WIN32 handles sockets via win32.h */ +#if defined(HAS_SOCKET) && !defined(WIN32) /* WIN32 handles sockets + via win32.h */ # include # if defined(USE_SOCKS) && defined(I_SOCKS) # if !defined(INCLUDE_PROTOTYPES) -# define INCLUDE_PROTOTYPES /* for */ +# define INCLUDE_PROTOTYPES /* for */ # define PERL_SOCKS_NEED_PROTOTYPES # endif # include @@ -1829,9 +1828,9 @@ Set the C bytes starting at C<*d> to all zeroes. # endif #endif -/* sockatmark() is so new (2001) that many places might have it hidden - * behind some -D_BLAH_BLAH_SOURCE guard. The __THROW magic is required - * e.g. in Gentoo, see http://bugs.gentoo.org/show_bug.cgi?id=12605 */ +/* sockatmark() is so new (2001) that many places might have it hidden behind + * some -D_BLAH_BLAH_SOURCE guard. The __THROW magic is required e.g. in + * Gentoo, see http://bugs.gentoo.org/show_bug.cgi?id=12605 */ #if defined(HAS_SOCKATMARK) && !defined(HAS_SOCKATMARK_PROTO) # if defined(__THROW) && defined(__GLIBC__) int sockatmark(int) __THROW; @@ -1840,7 +1839,9 @@ int sockatmark(int); # endif #endif -#if defined(__osf__) && defined(__cplusplus) && !defined(_XOPEN_SOURCE_EXTENDED) /* Tru64 "cxx" (C++), see hints/dec_osf.sh for why the _XOPEN_SOURCE_EXTENDED cannot be defined. */ +#if defined(__osf__) && defined(__cplusplus) && !defined(_XOPEN_SOURCE_EXTENDED) \ + /* Tru64 "cxx" (C++), see hints/dec_osf.sh for why the + _XOPEN_SOURCE_EXTENDED cannot be defined. */ EXTERN_C int fchdir(int); EXTERN_C int flock(int, int); EXTERN_C int fseeko(FILE *, off_t, int); @@ -1864,25 +1865,25 @@ Set C, and on VMS set C. =for apidoc mn|void|dSAVEDERRNO -Declare variables needed to save C and any operating system -specific error number. +Declare variables needed to save C and any operating +system specific error number. =for apidoc mn|void|dSAVE_ERRNO -Declare variables needed to save C and any operating system -specific error number, and save them for optional later restoration -by C. +Declare variables needed to save C and any operating +system specific error number, and save them for optional later +restoration by C. =for apidoc mn|void|SAVE_ERRNO -Save C and any operating system specific error number for -optional later restoration by C. Requires +Save C and any operating system specific error number +for optional later restoration by C. Requires C or C in scope. =for apidoc mn|void|RESTORE_ERRNO -Restore C and any operating system specific error number that -was saved by C or C. +Restore C and any operating system specific error number +that was saved by C or C. =cut */ @@ -1893,58 +1894,63 @@ was saved by C or C. #ifdef VMS # define SETERRNO(errcode,vmserrcode) \ - STMT_START { \ - set_errno(errcode); \ - set_vaxc_errno(vmserrcode); \ + STMT_START { \ + set_errno(errcode); \ + set_vaxc_errno(vmserrcode); \ } STMT_END -# define dSAVEDERRNO int saved_errno; unsigned saved_vms_errno -# define dSAVE_ERRNO int saved_errno = errno; unsigned saved_vms_errno = vaxc$errno -# define SAVE_ERRNO ( saved_errno = errno, saved_vms_errno = vaxc$errno ) -# define RESTORE_ERRNO SETERRNO(saved_errno, saved_vms_errno) - -# define LIB_INVARG LIB$_INVARG -# define RMS_DIR RMS$_DIR -# define RMS_FAC RMS$_FAC -# define RMS_FEX RMS$_FEX -# define RMS_FNF RMS$_FNF -# define RMS_IFI RMS$_IFI -# define RMS_ISI RMS$_ISI -# define RMS_PRV RMS$_PRV -# define SS_ACCVIO SS$_ACCVIO -# define SS_DEVOFFLINE SS$_DEVOFFLINE -# define SS_IVCHAN SS$_IVCHAN -# define SS_NORMAL SS$_NORMAL -# define SS_NOPRIV SS$_NOPRIV -# define SS_BUFFEROVF SS$_BUFFEROVF +# define dSAVEDERRNO int saved_errno; unsigned saved_vms_errno +# define dSAVE_ERRNO \ + int saved_errno = errno; unsigned saved_vms_errno = vaxc$errno +# define SAVE_ERRNO ( saved_errno = errno, saved_vms_errno = vaxc$errno ) +# define RESTORE_ERRNO SETERRNO(saved_errno, saved_vms_errno) + +# define LIB_INVARG LIB$_INVARG +# define RMS_DIR RMS$_DIR +# define RMS_FAC RMS$_FAC +# define RMS_FEX RMS$_FEX +# define RMS_FNF RMS$_FNF +# define RMS_IFI RMS$_IFI +# define RMS_ISI RMS$_ISI +# define RMS_PRV RMS$_PRV +# define SS_ACCVIO SS$_ACCVIO +# define SS_DEVOFFLINE SS$_DEVOFFLINE +# define SS_IVCHAN SS$_IVCHAN +# define SS_NORMAL SS$_NORMAL +# define SS_NOPRIV SS$_NOPRIV +# define SS_BUFFEROVF SS$_BUFFEROVF #else -# define LIB_INVARG 0 -# define RMS_DIR 0 -# define RMS_FAC 0 -# define RMS_FEX 0 -# define RMS_FNF 0 -# define RMS_IFI 0 -# define RMS_ISI 0 -# define RMS_PRV 0 -# define SS_ACCVIO 0 -# define SS_DEVOFFLINE 0 -# define SS_IVCHAN 0 -# define SS_NORMAL 0 -# define SS_NOPRIV 0 -# define SS_BUFFEROVF 0 +# define LIB_INVARG 0 +# define RMS_DIR 0 +# define RMS_FAC 0 +# define RMS_FEX 0 +# define RMS_FNF 0 +# define RMS_IFI 0 +# define RMS_ISI 0 +# define RMS_PRV 0 +# define SS_ACCVIO 0 +# define SS_DEVOFFLINE 0 +# define SS_IVCHAN 0 +# define SS_NORMAL 0 +# define SS_NOPRIV 0 +# define SS_BUFFEROVF 0 #endif #ifdef WIN32 -# define dSAVEDERRNO int saved_errno; DWORD saved_win32_errno -# define dSAVE_ERRNO int saved_errno = errno; DWORD saved_win32_errno = GetLastError() -# define SAVE_ERRNO ( saved_errno = errno, saved_win32_errno = GetLastError() ) -# define RESTORE_ERRNO ( errno = saved_errno, SetLastError(saved_win32_errno) ) +# define dSAVEDERRNO int saved_errno; DWORD saved_win32_errno +# define dSAVE_ERRNO \ + int saved_errno = errno; DWORD saved_win32_errno = GetLastError() +# define SAVE_ERRNO \ + ( saved_errno = errno, saved_win32_errno = GetLastError() ) +# define RESTORE_ERRNO \ + ( errno = saved_errno, SetLastError(saved_win32_errno) ) #endif #ifdef OS2 -# define dSAVEDERRNO int saved_errno; unsigned long saved_os2_errno -# define dSAVE_ERRNO int saved_errno = errno; unsigned long saved_os2_errno = Perl_rc -# define SAVE_ERRNO ( saved_errno = errno, saved_os2_errno = Perl_rc ) -# define RESTORE_ERRNO ( errno = saved_errno, Perl_rc = saved_os2_errno ) +# define dSAVEDERRNO int saved_errno; unsigned long saved_os2_errno +# define dSAVE_ERRNO \ + int saved_errno = errno; unsigned long saved_os2_errno = Perl_rc +# define SAVE_ERRNO ( saved_errno = errno, saved_os2_errno = Perl_rc ) +# define RESTORE_ERRNO ( errno = saved_errno, Perl_rc = saved_os2_errno ) #endif #ifndef SETERRNO @@ -1952,10 +1958,10 @@ was saved by C or C. #endif #ifndef dSAVEDERRNO -# define dSAVEDERRNO int saved_errno -# define dSAVE_ERRNO int saved_errno = errno -# define SAVE_ERRNO (saved_errno = errno) -# define RESTORE_ERRNO (errno = saved_errno) +# define dSAVEDERRNO int saved_errno +# define dSAVE_ERRNO int saved_errno = errno +# define SAVE_ERRNO (saved_errno = errno) +# define RESTORE_ERRNO (errno = saved_errno) #endif /* @@ -1981,59 +1987,61 @@ any magic. =cut */ -#define ERRSV GvSVn(PL_errgv) +#define ERRSV GvSVn(PL_errgv) /* contains inlined gv_add_by_type */ -#define CLEAR_ERRSV() STMT_START { \ - SV ** const svp = &GvSV(PL_errgv); \ - if (!*svp) { \ - *svp = newSVpvs(""); \ - } else if (SvREADONLY(*svp)) { \ - SvREFCNT_dec_NN(*svp); \ - *svp = newSVpvs(""); \ - } else { \ - SV *const errsv = *svp; \ - SvPVCLEAR(errsv); \ - SvPOK_only(errsv); \ - if (SvMAGICAL(errsv)) { \ - mg_free(errsv); \ - } \ - } \ +#define CLEAR_ERRSV() \ + STMT_START { \ + SV ** const svp = &GvSV(PL_errgv); \ + if (!*svp) { \ + *svp = newSVpvs(""); \ + } else if (SvREADONLY(*svp)) { \ + SvREFCNT_dec_NN(*svp); \ + *svp = newSVpvs(""); \ + } else { \ + SV *const errsv = *svp; \ + SvPVCLEAR(errsv); \ + SvPOK_only(errsv); \ + if (SvMAGICAL(errsv)) { \ + mg_free(errsv); \ + } \ + } \ } STMT_END /* contains inlined gv_add_by_type */ -#define SANE_ERRSV() STMT_START { \ - SV ** const svp = &GvSV(PL_errgv); \ - if (!*svp) { \ - *svp = newSVpvs(""); \ - } else if (SvREADONLY(*svp)) { \ - SV *dupsv = newSVsv(*svp); \ - SvREFCNT_dec_NN(*svp); \ - *svp = dupsv; \ - } else { \ - SV *const errsv = *svp; \ - if (SvMAGICAL(errsv)) { \ - mg_free(errsv); \ - } \ - } \ +#define SANE_ERRSV() \ + STMT_START { \ + SV ** const svp = &GvSV(PL_errgv); \ + if (!*svp) { \ + *svp = newSVpvs(""); \ + } else if (SvREADONLY(*svp)) { \ + SV *dupsv = newSVsv(*svp); \ + SvREFCNT_dec_NN(*svp); \ + *svp = dupsv; \ + } else { \ + SV *const errsv = *svp; \ + if (SvMAGICAL(errsv)) { \ + mg_free(errsv); \ + } \ + } \ } STMT_END #ifdef PERL_CORE -# define DEFSV (0 + GvSVn(PL_defgv)) -# define DEFSV_set(sv) \ - (SvREFCNT_dec(GvSV(PL_defgv)), GvSV(PL_defgv) = SvREFCNT_inc(sv)) -# define SAVE_DEFSV \ - ( \ - save_gp(PL_defgv, 0), \ - GvINTRO_off(PL_defgv), \ - SAVEGENERICSV(GvSV(PL_defgv)), \ - GvSV(PL_defgv) = NULL \ - ) +# define DEFSV (0 + GvSVn(PL_defgv)) +# define DEFSV_set(sv) \ + (SvREFCNT_dec(GvSV(PL_defgv)), GvSV(PL_defgv) = SvREFCNT_inc(sv)) +# define SAVE_DEFSV \ + ( \ + save_gp(PL_defgv, 0), \ + GvINTRO_off(PL_defgv), \ + SAVEGENERICSV(GvSV(PL_defgv)), \ + GvSV(PL_defgv) = NULL \ + ) #else -# define DEFSV GvSVn(PL_defgv) -# define DEFSV_set(sv) (GvSV(PL_defgv) = (sv)) -# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) +# define DEFSV GvSVn(PL_defgv) +# define DEFSV_set(sv) (GvSV(PL_defgv) = (sv)) +# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) #endif /* @@ -2051,48 +2059,47 @@ Localize C<$_>. See L. */ #ifndef errno - extern int errno; /* ANSI allows errno to be an lvalue expr. - * For example in multithreaded environments - * something like this might happen: - * extern int *_errno(void); - * #define errno (*_errno()) */ + extern int errno; /* ANSI allows errno to be an lvalue expr. For + * example in multithreaded environments + * something like this might happen: extern int + * *_errno(void); #define errno (*_errno()) */ #endif -#define UNKNOWN_ERRNO_MSG "(unknown)" +#define UNKNOWN_ERRNO_MSG "(unknown)" #ifdef VMS -#define Strerror(e) strerror((e), vaxc$errno) +#define Strerror(e) strerror((e), vaxc$errno) #else -#define Strerror(e) strerror(e) +#define Strerror(e) strerror(e) #endif #ifdef I_SYS_IOCTL # ifndef _IOCTL_ -# include +# include # endif #endif #if defined(mc300) || defined(mc500) || defined(mc700) || defined(mc6000) # ifdef HAS_SOCKETPAIR -# undef HAS_SOCKETPAIR +# undef HAS_SOCKETPAIR # endif # ifdef I_NDBM -# undef I_NDBM +# undef I_NDBM # endif #endif #ifndef HAS_SOCKETPAIR # ifdef HAS_SOCKET -# define socketpair Perl_my_socketpair +# define socketpair Perl_my_socketpair # endif #endif #if INTSIZE == 2 -# define htoni htons -# define ntohi ntohs +# define htoni htons +# define ntohi ntohs #else -# define htoni htonl -# define ntohi ntohl +# define htoni htonl +# define ntohi ntohl #endif /* Configure already sets Direntry_t */ @@ -2105,10 +2112,10 @@ Localize C<$_>. See L. #endif /* - * The following gobbledygook brought to you on behalf of __STDC__. - * (I could just use #ifndef __STDC__, but this is more bulletproof - * in the face of half-implementations.) - */ + * The following gobbledygook brought to you on behalf of + * __STDC__. (I could just use #ifndef __STDC__, but this is more + * bulletproof in the face of half-implementations.) +*/ #if defined(I_SYSMODE) #include @@ -2116,118 +2123,118 @@ Localize C<$_>. See L. #ifndef S_IFMT # ifdef _S_IFMT -# define S_IFMT _S_IFMT +# define S_IFMT _S_IFMT # else -# define S_IFMT 0170000 +# define S_IFMT 0170000 # endif #endif #ifndef S_ISDIR -# define S_ISDIR(m) ((m & S_IFMT) == S_IFDIR) +# define S_ISDIR(m) ((m & S_IFMT) == S_IFDIR) #endif #ifndef S_ISCHR -# define S_ISCHR(m) ((m & S_IFMT) == S_IFCHR) +# define S_ISCHR(m) ((m & S_IFMT) == S_IFCHR) #endif #ifndef S_ISBLK # ifdef S_IFBLK -# define S_ISBLK(m) ((m & S_IFMT) == S_IFBLK) +# define S_ISBLK(m) ((m & S_IFMT) == S_IFBLK) # else -# define S_ISBLK(m) (0) +# define S_ISBLK(m) (0) # endif #endif #ifndef S_ISREG -# define S_ISREG(m) ((m & S_IFMT) == S_IFREG) +# define S_ISREG(m) ((m & S_IFMT) == S_IFREG) #endif #ifndef S_ISFIFO # ifdef S_IFIFO -# define S_ISFIFO(m) ((m & S_IFMT) == S_IFIFO) +# define S_ISFIFO(m) ((m & S_IFMT) == S_IFIFO) # else -# define S_ISFIFO(m) (0) +# define S_ISFIFO(m) (0) # endif #endif #ifndef S_ISLNK # ifdef _S_ISLNK -# define S_ISLNK(m) _S_ISLNK(m) +# define S_ISLNK(m) _S_ISLNK(m) # elif defined(_S_IFLNK) -# define S_ISLNK(m) ((m & S_IFMT) == _S_IFLNK) +# define S_ISLNK(m) ((m & S_IFMT) == _S_IFLNK) # elif defined(S_IFLNK) -# define S_ISLNK(m) ((m & S_IFMT) == S_IFLNK) +# define S_ISLNK(m) ((m & S_IFMT) == S_IFLNK) # else -# define S_ISLNK(m) (0) +# define S_ISLNK(m) (0) # endif #endif #ifndef S_ISSOCK # ifdef _S_ISSOCK -# define S_ISSOCK(m) _S_ISSOCK(m) +# define S_ISSOCK(m) _S_ISSOCK(m) # elif defined(_S_IFSOCK) -# define S_ISSOCK(m) ((m & S_IFMT) == _S_IFSOCK) +# define S_ISSOCK(m) ((m & S_IFMT) == _S_IFSOCK) # elif defined(S_IFSOCK) -# define S_ISSOCK(m) ((m & S_IFMT) == S_IFSOCK) +# define S_ISSOCK(m) ((m & S_IFMT) == S_IFSOCK) # else -# define S_ISSOCK(m) (0) +# define S_ISSOCK(m) (0) # endif #endif #ifndef S_IRUSR # ifdef S_IREAD -# define S_IRUSR S_IREAD -# define S_IWUSR S_IWRITE -# define S_IXUSR S_IEXEC +# define S_IRUSR S_IREAD +# define S_IWUSR S_IWRITE +# define S_IXUSR S_IEXEC # else -# define S_IRUSR 0400 -# define S_IWUSR 0200 -# define S_IXUSR 0100 +# define S_IRUSR 0400 +# define S_IWUSR 0200 +# define S_IXUSR 0100 # endif #endif #ifndef S_IRGRP # ifdef S_IRUSR -# define S_IRGRP (S_IRUSR>>3) -# define S_IWGRP (S_IWUSR>>3) -# define S_IXGRP (S_IXUSR>>3) +# define S_IRGRP (S_IRUSR>>3) +# define S_IWGRP (S_IWUSR>>3) +# define S_IXGRP (S_IXUSR>>3) # else -# define S_IRGRP 0040 -# define S_IWGRP 0020 -# define S_IXGRP 0010 +# define S_IRGRP 0040 +# define S_IWGRP 0020 +# define S_IXGRP 0010 # endif #endif #ifndef S_IROTH # ifdef S_IRUSR -# define S_IROTH (S_IRUSR>>6) -# define S_IWOTH (S_IWUSR>>6) -# define S_IXOTH (S_IXUSR>>6) +# define S_IROTH (S_IRUSR>>6) +# define S_IWOTH (S_IWUSR>>6) +# define S_IXOTH (S_IXUSR>>6) # else -# define S_IROTH 0040 -# define S_IWOTH 0020 -# define S_IXOTH 0010 +# define S_IROTH 0040 +# define S_IWOTH 0020 +# define S_IXOTH 0010 # endif #endif #ifndef S_ISUID -# define S_ISUID 04000 +# define S_ISUID 04000 #endif #ifndef S_ISGID -# define S_ISGID 02000 +# define S_ISGID 02000 #endif #ifndef S_IRWXU -# define S_IRWXU (S_IRUSR|S_IWUSR|S_IXUSR) +# define S_IRWXU (S_IRUSR|S_IWUSR|S_IXUSR) #endif #ifndef S_IRWXG -# define S_IRWXG (S_IRGRP|S_IWGRP|S_IXGRP) +# define S_IRWXG (S_IRGRP|S_IWGRP|S_IXGRP) #endif #ifndef S_IRWXO -# define S_IRWXO (S_IROTH|S_IWOTH|S_IXOTH) +# define S_IRWXO (S_IROTH|S_IWOTH|S_IXOTH) #endif /* Haiku R1 seems to define S_IREAD and S_IWRITE in @@ -2235,15 +2242,15 @@ Localize C<$_>. See L. * lines in the future. --jhi */ #if !defined(S_IREAD) && !defined(__HAIKU__) -# define S_IREAD S_IRUSR +# define S_IREAD S_IRUSR #endif #if !defined(S_IWRITE) && !defined(__HAIKU__) -# define S_IWRITE S_IWUSR +# define S_IWRITE S_IWUSR #endif #ifndef S_IEXEC -# define S_IEXEC S_IXUSR +# define S_IEXEC S_IXUSR #endif #if defined(cray) || defined(gould) || defined(i860) || defined(pyr) @@ -2267,59 +2274,59 @@ my_snprintf() =cut */ -#define my_sprintf sprintf +#define my_sprintf sprintf /* - * If we have v?snprintf() and the C99 variadic macros, we can just - * use just the v?snprintf(). It is nice to try to trap the buffer - * overflow, however, so if we are DEBUGGING, and we cannot use the - * gcc statement expressions, then use the function wrappers which try - * to trap the overflow. If we can use the gcc statement expressions, - * we can try that even with the version that uses the C99 variadic - * macros. - */ + * If we have v?snprintf() and the C99 variadic macros, we can just use + * just the v?snprintf(). It is nice to try to trap the buffer overflow, + * however, so if we are DEBUGGING, and we cannot use the gcc statement + * expressions, then use the function wrappers which try to trap the + * overflow. If we can use the gcc statement expressions, we can try + * that even with the version that uses the C99 variadic macros. +*/ -/* Note that we do not check against snprintf()/vsnprintf() returning - * negative values because that is non-standard behaviour and we use - * snprintf/vsnprintf only iff HAS_VSNPRINTF has been defined, and - * that should be true only if the snprintf()/vsnprintf() are true - * to the standard. */ +/* Note that we do not check against snprintf()/vsnprintf() returning negative + * values because that is non-standard behaviour and we use snprintf/vsnprintf + * only iff HAS_VSNPRINTF has been defined, and that should be true only if + * the snprintf()/vsnprintf() are true to the standard. */ -#define PERL_SNPRINTF_CHECK(len, max, api) STMT_START { if ((max) > 0 && (Size_t)len > (max)) Perl_croak_nocontext("panic: %s buffer overflow", STRINGIFY(api)); } STMT_END +#define PERL_SNPRINTF_CHECK(len, max, api) \ + STMT_START { if ((max) > 0 && (Size_t)len > (max)) Perl_croak_nocontext("panic: %s buffer overflow", STRINGIFY(api)); } STMT_END #if defined(USE_LOCALE_NUMERIC) || defined(USE_QUADMATH) -# define my_snprintf Perl_my_snprintf +# define my_snprintf Perl_my_snprintf # define PERL_MY_SNPRINTF_GUARDED #elif defined(HAS_SNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) && !defined(PERL_GCC_PEDANTIC) # ifdef PERL_USE_GCC_BRACE_GROUPS -# define my_snprintf(buffer, max, ...) ({ int len = snprintf(buffer, max, __VA_ARGS__); PERL_SNPRINTF_CHECK(len, max, snprintf); len; }) +# define my_snprintf(buffer, max, ...) \ + ({ int len = snprintf(buffer, max, __VA_ARGS__); PERL_SNPRINTF_CHECK(len, max, snprintf); len; }) # define PERL_MY_SNPRINTF_GUARDED # else -# define my_snprintf(buffer, max, ...) snprintf(buffer, max, __VA_ARGS__) +# define my_snprintf(buffer, max, ...) snprintf(buffer, max, __VA_ARGS__) # endif #else -# define my_snprintf Perl_my_snprintf +# define my_snprintf Perl_my_snprintf # define PERL_MY_SNPRINTF_GUARDED #endif /* There is no quadmath_vsnprintf, and therefore my_vsnprintf() * dies if called under USE_QUADMATH. */ -#if ! defined(USE_LOCALE_NUMERIC) \ - && defined(HAS_VSNPRINTF) \ - && defined(HAS_C99_VARIADIC_MACROS) \ - && ! (defined(DEBUGGING) && ! defined(PERL_USE_GCC_BRACE_GROUPS)) \ - && ! defined(PERL_GCC_PEDANTIC) +#if ! defined(USE_LOCALE_NUMERIC) \ + && defined(HAS_VSNPRINTF) \ + && defined(HAS_C99_VARIADIC_MACROS) \ + && ! (defined(DEBUGGING) && ! defined(PERL_USE_GCC_BRACE_GROUPS)) \ + && ! defined(PERL_GCC_PEDANTIC) # ifdef PERL_USE_GCC_BRACE_GROUPS -# define my_vsnprintf(buffer, max, ...) \ - ({ int len = vsnprintf(buffer, max, __VA_ARGS__); \ - PERL_SNPRINTF_CHECK(len, max, vsnprintf); \ - len; }) +# define my_vsnprintf(buffer, max, ...) \ + ({ int len = vsnprintf(buffer, max, __VA_ARGS__); \ + PERL_SNPRINTF_CHECK(len, max, vsnprintf); \ + len; }) # define PERL_MY_VSNPRINTF_GUARDED # else -# define my_vsnprintf(buffer, max, ...) vsnprintf(buffer, max, __VA_ARGS__) +# define my_vsnprintf(buffer, max, ...) vsnprintf(buffer, max, __VA_ARGS__) # endif #else -# define my_vsnprintf Perl_my_vsnprintf +# define my_vsnprintf Perl_my_vsnprintf # define PERL_MY_VSNPRINTF_GUARDED #endif @@ -2343,41 +2350,43 @@ my_snprintf() * insert the POST_GUARD() also in that case. */ #ifndef PERL_MY_SNPRINTF_GUARDED -# define PERL_MY_SNPRINTF_POST_GUARD(len, max) PERL_SNPRINTF_CHECK(len, max, snprintf) +# define PERL_MY_SNPRINTF_POST_GUARD(len, max) \ + PERL_SNPRINTF_CHECK(len, max, snprintf) #else -# define PERL_MY_SNPRINTF_POST_GUARD(len, max) PERL_UNUSED_VAR(len) +# define PERL_MY_SNPRINTF_POST_GUARD(len, max) PERL_UNUSED_VAR(len) #endif #ifndef PERL_MY_VSNPRINTF_GUARDED -# define PERL_MY_VSNPRINTF_POST_GUARD(len, max) PERL_SNPRINTF_CHECK(len, max, vsnprintf) +# define PERL_MY_VSNPRINTF_POST_GUARD(len, max) \ + PERL_SNPRINTF_CHECK(len, max, vsnprintf) #else -# define PERL_MY_VSNPRINTF_POST_GUARD(len, max) PERL_UNUSED_VAR(len) +# define PERL_MY_VSNPRINTF_POST_GUARD(len, max) PERL_UNUSED_VAR(len) #endif #ifdef HAS_STRLCAT -# define my_strlcat strlcat +# define my_strlcat strlcat #endif #if defined(PERL_CORE) || defined(PERL_EXT) # ifdef HAS_MEMRCHR -# define my_memrchr memrchr +# define my_memrchr memrchr # else -# define my_memrchr S_my_memrchr +# define my_memrchr S_my_memrchr # endif #endif #ifdef HAS_STRLCPY -# define my_strlcpy strlcpy +# define my_strlcpy strlcpy #endif #ifdef HAS_STRNLEN -# define my_strnlen strnlen +# define my_strnlen strnlen #endif /* The IV type is supposed to be long enough to hold any integral value or a pointer. - --Andy Dougherty August 1996 + --Andy Dougherty August 1996 */ typedef IVTYPE IV; @@ -2385,39 +2394,39 @@ typedef UVTYPE UV; #if defined(USE_64_BIT_INT) && defined(HAS_QUAD) # if QUADKIND == QUAD_IS_INT64_T && defined(INT64_MAX) -# define IV_MAX ((IV)INT64_MAX) -# define IV_MIN ((IV)INT64_MIN) -# define UV_MAX ((UV)UINT64_MAX) +# define IV_MAX ((IV)INT64_MAX) +# define IV_MIN ((IV)INT64_MIN) +# define UV_MAX ((UV)UINT64_MAX) # ifndef UINT64_MIN -# define UINT64_MIN 0 +# define UINT64_MIN 0 # endif -# define UV_MIN ((UV)UINT64_MIN) +# define UV_MIN ((UV)UINT64_MIN) # else -# define IV_MAX PERL_QUAD_MAX -# define IV_MIN PERL_QUAD_MIN -# define UV_MAX PERL_UQUAD_MAX -# define UV_MIN PERL_UQUAD_MIN +# define IV_MAX PERL_QUAD_MAX +# define IV_MIN PERL_QUAD_MIN +# define UV_MAX PERL_UQUAD_MAX +# define UV_MIN PERL_UQUAD_MIN # endif # define IV_IS_QUAD # define UV_IS_QUAD #else # if defined(INT32_MAX) && IVSIZE == 4 -# define IV_MAX ((IV)INT32_MAX) -# define IV_MIN ((IV)INT32_MIN) -# ifndef UINT32_MAX_BROKEN /* e.g. HP-UX with gcc messes this up */ -# define UV_MAX ((UV)UINT32_MAX) +# define IV_MAX ((IV)INT32_MAX) +# define IV_MIN ((IV)INT32_MIN) +# ifndef UINT32_MAX_BROKEN /* e.g. HP-UX with gcc messes this up */ +# define UV_MAX ((UV)UINT32_MAX) # else -# define UV_MAX ((UV)4294967295U) +# define UV_MAX ((UV)4294967295U) # endif # ifndef UINT32_MIN -# define UINT32_MIN 0 +# define UINT32_MIN 0 # endif -# define UV_MIN ((UV)UINT32_MIN) +# define UV_MIN ((UV)UINT32_MIN) # else -# define IV_MAX PERL_LONG_MAX -# define IV_MIN PERL_LONG_MIN -# define UV_MAX PERL_ULONG_MAX -# define UV_MIN PERL_ULONG_MIN +# define IV_MAX PERL_LONG_MAX +# define IV_MIN PERL_LONG_MIN +# define UV_MAX PERL_ULONG_MAX +# define UV_MIN PERL_ULONG_MIN # endif # if IVSIZE == 8 # define IV_IS_QUAD @@ -2430,21 +2439,21 @@ typedef UVTYPE UV; # undef UV_IS_QUAD #if !defined(PERL_CORE) /* We think that removing this decade-old undef this will cause too much - breakage on CPAN for too little gain. (See RT #119753) - However, we do need HAS_QUAD in the core for use by the drand48 code. */ + breakage on CPAN for too little gain. (See RT #119753) However, we + do need HAS_QUAD in the core for use by the drand48 code. */ # undef HAS_QUAD #endif # endif #endif -#define Size_t_MAX (~(Size_t)0) -#define SSize_t_MAX (SSize_t)(~(Size_t)0 >> 1) +#define Size_t_MAX (~(Size_t)0) +#define SSize_t_MAX (SSize_t)(~(Size_t)0 >> 1) -#define IV_DIG (BIT_DIGITS(IVSIZE * 8)) -#define UV_DIG (BIT_DIGITS(UVSIZE * 8)) +#define IV_DIG (BIT_DIGITS(IVSIZE * 8)) +#define UV_DIG (BIT_DIGITS(UVSIZE * 8)) #ifndef NO_PERL_PRESERVE_IVUV -#define PERL_PRESERVE_IVUV /* We like our integers to stay integers. */ +#define PERL_PRESERVE_IVUV /* We like our integers to stay integers. */ #endif /* @@ -2458,23 +2467,23 @@ typedef UVTYPE UV; * cast (PTRV) to avoid compiler warnings. * * These are mentioned in perlguts - */ +*/ #if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE) -# define PTRV UV -# define INT2PTR(any,d) (any)(d) +# define PTRV UV +# define INT2PTR(any,d) (any)(d) #elif PTRSIZE == LONGSIZE -# define PTRV unsigned long -# define PTR2ul(p) (unsigned long)(p) +# define PTRV unsigned long +# define PTR2ul(p) (unsigned long)(p) #else -# define PTRV unsigned +# define PTRV unsigned #endif #ifndef INT2PTR -# define INT2PTR(any,d) (any)(PTRV)(d) +# define INT2PTR(any,d) (any)(PTRV)(d) #endif #ifndef PTR2ul -# define PTR2ul(p) INT2PTR(unsigned long,p) +# define PTR2ul(p) INT2PTR(unsigned long,p) #endif /* @@ -2485,24 +2494,26 @@ You probably want to be using L> instead. =cut */ -#define NUM2PTR(any,d) (any)(PTRV)(d) -#define PTR2IV(p) INT2PTR(IV,p) -#define PTR2UV(p) INT2PTR(UV,p) -#define PTR2NV(p) NUM2PTR(NV,p) -#define PTR2nat(p) (PTRV)(p) /* pointer to integer of PTRSIZE */ - -/* According to strict ANSI C89 one cannot freely cast between - * data pointers and function (code) pointers. There are at least - * two ways around this. One (used below) is to do two casts, - * first the other pointer to an (unsigned) integer, and then - * the integer to the other pointer. The other way would be - * to use unions to "overlay" the pointers. For an example of - * the latter technique, see union dirpu in struct xpvio in sv.h. - * The only feasible use is probably temporarily storing - * function pointers in a data pointer (such as a void pointer). */ - -#define DPTR2FPTR(t,p) ((t)PTR2nat(p)) /* data pointer to function pointer */ -#define FPTR2DPTR(t,p) ((t)PTR2nat(p)) /* function pointer to data pointer */ +#define NUM2PTR(any,d) (any)(PTRV)(d) +#define PTR2IV(p) INT2PTR(IV,p) +#define PTR2UV(p) INT2PTR(UV,p) +#define PTR2NV(p) NUM2PTR(NV,p) +#define PTR2nat(p) (PTRV)(p) /* pointer to integer + of PTRSIZE */ + +/* According to strict ANSI C89 one cannot freely cast between data pointers + * and function (code) pointers. There are at least two ways around this. + * One (used below) is to do two casts, first the other pointer to an + * (unsigned) integer, and then the integer to the other pointer. The other + * way would be to use unions to "overlay" the pointers. For an example of + * the latter technique, see union dirpu in struct xpvio in sv.h. The only + * feasible use is probably temporarily storing function pointers in a data + * pointer (such as a void pointer). */ + +#define DPTR2FPTR(t,p) ((t)PTR2nat(p)) /* data pointer to function + pointer */ +#define FPTR2DPTR(t,p) ((t)PTR2nat(p)) /* function pointer to + data pointer */ #ifdef USE_LONG_DOUBLE # if LONG_DOUBLESIZE == DOUBLESIZE @@ -2511,32 +2522,28 @@ You probably want to be using L> instead. # endif #endif -/* The following is all to get LDBL_DIG, in order to pick a nice - default value for printing floating point numbers in Gconvert. - (see config.h) -*/ +/* The following is all to get LDBL_DIG, in order to pick a nice default value + for printing floating point numbers in Gconvert. (see config.h) + */ #ifndef HAS_LDBL_DIG # if LONG_DOUBLESIZE == 10 -# define LDBL_DIG 18 /* assume IEEE */ +# define LDBL_DIG 18 /* assume IEEE */ # elif LONG_DOUBLESIZE == 12 -# define LDBL_DIG 18 /* gcc? */ +# define LDBL_DIG 18 /* gcc? */ # elif LONG_DOUBLESIZE == 16 -# define LDBL_DIG 33 /* assume IEEE */ +# define LDBL_DIG 33 /* assume IEEE */ # elif LONG_DOUBLESIZE == DOUBLESIZE -# define LDBL_DIG DBL_DIG /* bummer */ +# define LDBL_DIG DBL_DIG /* bummer */ # endif #endif -/* On MS Windows,with 64-bit mingw-w64 compilers, we - need to attend to a __float128 alignment issue if - USE_QUADMATH is defined. Otherwise we simply: - typedef NVTYPE NV - 32-bit mingw.org compilers might also require - aligned(32) - at least that's what I found with my - Math::Foat128 module. But this is as yet untested - here, so no allowance is being made for mingw.org - compilers at this stage. -- sisyphus January 2021 -*/ +/* On MS Windows,with 64-bit mingw-w64 compilers, we need to attend to a + __float128 alignment issue if USE_QUADMATH is defined. Otherwise we + simply: typedef NVTYPE NV 32-bit mingw.org compilers might also require + aligned(32) - at least that's what I found with my Math::Foat128 + module. But this is as yet untested here, so no allowance is being made + for mingw.org compilers at this stage. -- sisyphus January 2021 + */ #if (defined(USE_LONG_DOUBLE) || defined(USE_QUADMATH)) && defined(__MINGW64__) /* 64-bit build, mingw-w64 compiler only */ typedef NVTYPE NV __attribute__ ((aligned(8))); @@ -2561,257 +2568,261 @@ You probably want to be using L> instead. # include # endif # if defined(LDBL_DIG) -# define NV_DIG LDBL_DIG +# define NV_DIG LDBL_DIG # ifdef LDBL_MANT_DIG -# define NV_MANT_DIG LDBL_MANT_DIG +# define NV_MANT_DIG LDBL_MANT_DIG # endif # ifdef LDBL_MIN -# define NV_MIN LDBL_MIN +# define NV_MIN LDBL_MIN # endif # ifdef LDBL_MAX -# define NV_MAX LDBL_MAX +# define NV_MAX LDBL_MAX # endif # ifdef LDBL_MIN_EXP -# define NV_MIN_EXP LDBL_MIN_EXP +# define NV_MIN_EXP LDBL_MIN_EXP # endif # ifdef LDBL_MAX_EXP -# define NV_MAX_EXP LDBL_MAX_EXP +# define NV_MAX_EXP LDBL_MAX_EXP # endif # ifdef LDBL_MIN_10_EXP -# define NV_MIN_10_EXP LDBL_MIN_10_EXP +# define NV_MIN_10_EXP LDBL_MIN_10_EXP # endif # ifdef LDBL_MAX_10_EXP -# define NV_MAX_10_EXP LDBL_MAX_10_EXP +# define NV_MAX_10_EXP LDBL_MAX_10_EXP # endif # ifdef LDBL_EPSILON -# define NV_EPSILON LDBL_EPSILON +# define NV_EPSILON LDBL_EPSILON # endif # ifdef LDBL_MAX -# define NV_MAX LDBL_MAX +# define NV_MAX LDBL_MAX /* Having LDBL_MAX doesn't necessarily mean that we have LDBL_MIN... -Allen */ # elif defined(HUGE_VALL) -# define NV_MAX HUGE_VALL +# define NV_MAX HUGE_VALL # endif # endif # if defined(HAS_SQRTL) -# define Perl_acos acosl -# define Perl_asin asinl -# define Perl_atan atanl -# define Perl_atan2 atan2l -# define Perl_ceil ceill -# define Perl_cos cosl -# define Perl_cosh coshl -# define Perl_exp expl -# define Perl_fabs fabsl -# define Perl_floor floorl -# define Perl_fmod fmodl -# define Perl_log logl -# define Perl_log10 log10l -# define Perl_pow powl -# define Perl_sin sinl -# define Perl_sinh sinhl -# define Perl_sqrt sqrtl -# define Perl_tan tanl -# define Perl_tanh tanhl +# define Perl_acos acosl +# define Perl_asin asinl +# define Perl_atan atanl +# define Perl_atan2 atan2l +# define Perl_ceil ceill +# define Perl_cos cosl +# define Perl_cosh coshl +# define Perl_exp expl +# define Perl_fabs fabsl +# define Perl_floor floorl +# define Perl_fmod fmodl +# define Perl_log logl +# define Perl_log10 log10l +# define Perl_pow powl +# define Perl_sin sinl +# define Perl_sinh sinhl +# define Perl_sqrt sqrtl +# define Perl_tan tanl +# define Perl_tanh tanhl # endif -/* e.g. libsunmath doesn't have modfl and frexpl as of mid-March 2000 */ +/* e.g. libsunmath doesn't have modfl and frexpl as of mid-March 2000 */ # ifndef Perl_modf # ifdef HAS_MODFL -# define Perl_modf(x,y) modfl(x,y) -/* eg glibc 2.2 series seems to provide modfl on ppc and arm, but has no - prototype in */ +# define Perl_modf(x,y) modfl(x,y) +/* eg glibc 2.2 series seems to provide modfl on ppc + and arm, but has no prototype in */ # ifndef HAS_MODFL_PROTO EXTERN_C long double modfl(long double, long double *); -# endif +# endif # elif (defined(HAS_TRUNCL) || defined(HAS_AINTL)) && defined(HAS_COPYSIGNL) extern long double Perl_my_modfl(long double x, long double *ip); -# define Perl_modf(x,y) Perl_my_modfl(x,y) +# define Perl_modf(x,y) Perl_my_modfl(x,y) # endif # endif # ifndef Perl_frexp # ifdef HAS_FREXPL -# define Perl_frexp(x,y) frexpl(x,y) +# define Perl_frexp(x,y) frexpl(x,y) # elif defined(HAS_ILOGBL) && defined(HAS_SCALBNL) extern long double Perl_my_frexpl(long double x, int *e); -# define Perl_frexp(x,y) Perl_my_frexpl(x,y) +# define Perl_frexp(x,y) Perl_my_frexpl(x,y) # endif # endif # ifndef Perl_ldexp # ifdef HAS_LDEXPL -# define Perl_ldexp(x, y) ldexpl(x,y) +# define Perl_ldexp(x, y) ldexpl(x,y) # elif defined(HAS_SCALBNL) && FLT_RADIX == 2 -# define Perl_ldexp(x,y) scalbnl(x,y) +# define Perl_ldexp(x,y) scalbnl(x,y) # endif # endif # ifndef Perl_isnan # if defined(HAS_ISNANL) && !(defined(isnan) && defined(HAS_C99)) -# define Perl_isnan(x) isnanl(x) +# define Perl_isnan(x) isnanl(x) # elif defined(__sgi) && defined(__c99) /* XXX Configure test needed */ -# define Perl_isnan(x) isnan(x) +# define Perl_isnan(x) isnan(x) # endif # endif # ifndef Perl_isinf # if defined(HAS_ISINFL) && !(defined(isinf) && defined(HAS_C99)) -# define Perl_isinf(x) isinfl(x) +# define Perl_isinf(x) isinfl(x) # elif defined(__sgi) && defined(__c99) /* XXX Configure test needed */ -# define Perl_isinf(x) isinf(x) +# define Perl_isinf(x) isinf(x) # elif defined(LDBL_MAX) && !defined(NAN_COMPARE_BROKEN) -# define Perl_isinf(x) ((x) > LDBL_MAX || (x) < -LDBL_MAX) +# define Perl_isinf(x) ((x) > LDBL_MAX || (x) < -LDBL_MAX) # endif # endif # ifndef Perl_isfinite -# define Perl_isfinite(x) Perl_isfinitel(x) +# define Perl_isfinite(x) Perl_isfinitel(x) # endif #elif defined(USE_QUADMATH) && defined(I_QUADMATH) # include -# define NV_DIG FLT128_DIG -# define NV_MANT_DIG FLT128_MANT_DIG -# define NV_MIN FLT128_MIN -# define NV_MAX FLT128_MAX -# define NV_MIN_EXP FLT128_MIN_EXP -# define NV_MAX_EXP FLT128_MAX_EXP -# define NV_EPSILON FLT128_EPSILON -# define NV_MIN_10_EXP FLT128_MIN_10_EXP -# define NV_MAX_10_EXP FLT128_MAX_10_EXP -# define Perl_acos acosq -# define Perl_asin asinq -# define Perl_atan atanq -# define Perl_atan2 atan2q -# define Perl_ceil ceilq -# define Perl_cos cosq -# define Perl_cosh coshq -# define Perl_exp expq -# define Perl_fabs fabsq -# define Perl_floor floorq -# define Perl_fmod fmodq -# define Perl_log logq -# define Perl_log10 log10q -# define Perl_signbit signbitq -# define Perl_pow powq -# define Perl_sin sinq -# define Perl_sinh sinhq -# define Perl_sqrt sqrtq -# define Perl_tan tanq -# define Perl_tanh tanhq -# define Perl_modf(x,y) modfq(x,y) -# define Perl_frexp(x,y) frexpq(x,y) -# define Perl_ldexp(x, y) ldexpq(x,y) -# define Perl_isinf(x) isinfq(x) -# define Perl_isnan(x) isnanq(x) -# define Perl_isfinite(x) !(isnanq(x) || isinfq(x)) -# define Perl_fp_class(x) ((x) == 0.0Q ? 0 : isinfq(x) ? 3 : isnanq(x) ? 4 : PERL_ABS(x) < FLT128_MIN ? 2 : 1) -# define Perl_fp_class_inf(x) (Perl_fp_class(x) == 3) -# define Perl_fp_class_nan(x) (Perl_fp_class(x) == 4) -# define Perl_fp_class_norm(x) (Perl_fp_class(x) == 1) +# define NV_DIG FLT128_DIG +# define NV_MANT_DIG FLT128_MANT_DIG +# define NV_MIN FLT128_MIN +# define NV_MAX FLT128_MAX +# define NV_MIN_EXP FLT128_MIN_EXP +# define NV_MAX_EXP FLT128_MAX_EXP +# define NV_EPSILON FLT128_EPSILON +# define NV_MIN_10_EXP FLT128_MIN_10_EXP +# define NV_MAX_10_EXP FLT128_MAX_10_EXP +# define Perl_acos acosq +# define Perl_asin asinq +# define Perl_atan atanq +# define Perl_atan2 atan2q +# define Perl_ceil ceilq +# define Perl_cos cosq +# define Perl_cosh coshq +# define Perl_exp expq +# define Perl_fabs fabsq +# define Perl_floor floorq +# define Perl_fmod fmodq +# define Perl_log logq +# define Perl_log10 log10q +# define Perl_signbit signbitq +# define Perl_pow powq +# define Perl_sin sinq +# define Perl_sinh sinhq +# define Perl_sqrt sqrtq +# define Perl_tan tanq +# define Perl_tanh tanhq +# define Perl_modf(x,y) modfq(x,y) +# define Perl_frexp(x,y) frexpq(x,y) +# define Perl_ldexp(x, y) ldexpq(x,y) +# define Perl_isinf(x) isinfq(x) +# define Perl_isnan(x) isnanq(x) +# define Perl_isfinite(x) !(isnanq(x) || isinfq(x)) +# define Perl_fp_class(x) \ + ((x) == 0.0Q ? 0 : isinfq(x) ? 3 : isnanq(x) ? 4 : PERL_ABS(x) < FLT128_MIN ? 2 : 1) +# define Perl_fp_class_inf(x) (Perl_fp_class(x) == 3) +# define Perl_fp_class_nan(x) (Perl_fp_class(x) == 4) +# define Perl_fp_class_norm(x) (Perl_fp_class(x) == 1) # define Perl_fp_class_denorm(x) (Perl_fp_class(x) == 2) -# define Perl_fp_class_zero(x) (Perl_fp_class(x) == 0) +# define Perl_fp_class_zero(x) (Perl_fp_class(x) == 0) #else -# define NV_DIG DBL_DIG -# define NV_MANT_DIG DBL_MANT_DIG -# define NV_MIN DBL_MIN -# define NV_MAX DBL_MAX -# define NV_MIN_EXP DBL_MIN_EXP -# define NV_MAX_EXP DBL_MAX_EXP -# define NV_MIN_10_EXP DBL_MIN_10_EXP -# define NV_MAX_10_EXP DBL_MAX_10_EXP -# define NV_EPSILON DBL_EPSILON -# define NV_MAX DBL_MAX -# define NV_MIN DBL_MIN +# define NV_DIG DBL_DIG +# define NV_MANT_DIG DBL_MANT_DIG +# define NV_MIN DBL_MIN +# define NV_MAX DBL_MAX +# define NV_MIN_EXP DBL_MIN_EXP +# define NV_MAX_EXP DBL_MAX_EXP +# define NV_MIN_10_EXP DBL_MIN_10_EXP +# define NV_MAX_10_EXP DBL_MAX_10_EXP +# define NV_EPSILON DBL_EPSILON +# define NV_MAX DBL_MAX +# define NV_MIN DBL_MIN /* These math interfaces are C89. */ -# define Perl_acos acos -# define Perl_asin asin -# define Perl_atan atan -# define Perl_atan2 atan2 -# define Perl_ceil ceil -# define Perl_cos cos -# define Perl_cosh cosh -# define Perl_exp exp -# define Perl_fabs fabs -# define Perl_floor floor -# define Perl_fmod fmod -# define Perl_log log -# define Perl_log10 log10 -# define Perl_pow pow -# define Perl_sin sin -# define Perl_sinh sinh -# define Perl_sqrt sqrt -# define Perl_tan tan -# define Perl_tanh tanh - -# define Perl_modf(x,y) modf(x,y) -# define Perl_frexp(x,y) frexp(x,y) -# define Perl_ldexp(x,y) ldexp(x,y) +# define Perl_acos acos +# define Perl_asin asin +# define Perl_atan atan +# define Perl_atan2 atan2 +# define Perl_ceil ceil +# define Perl_cos cos +# define Perl_cosh cosh +# define Perl_exp exp +# define Perl_fabs fabs +# define Perl_floor floor +# define Perl_fmod fmod +# define Perl_log log +# define Perl_log10 log10 +# define Perl_pow pow +# define Perl_sin sin +# define Perl_sinh sinh +# define Perl_sqrt sqrt +# define Perl_tan tan +# define Perl_tanh tanh + +# define Perl_modf(x,y) modf(x,y) +# define Perl_frexp(x,y) frexp(x,y) +# define Perl_ldexp(x,y) ldexp(x,y) # ifndef Perl_isnan # ifdef HAS_ISNAN -# define Perl_isnan(x) isnan(x) +# define Perl_isnan(x) isnan(x) # endif # endif # ifndef Perl_isinf # if defined(HAS_ISINF) -# define Perl_isinf(x) isinf(x) +# define Perl_isinf(x) isinf(x) # elif defined(DBL_MAX) && !defined(NAN_COMPARE_BROKEN) -# define Perl_isinf(x) ((x) > DBL_MAX || (x) < -DBL_MAX) +# define Perl_isinf(x) ((x) > DBL_MAX || (x) < -DBL_MAX) # endif # endif # ifndef Perl_isfinite # ifdef HAS_ISFINITE -# define Perl_isfinite(x) isfinite(x) +# define Perl_isfinite(x) isfinite(x) # elif defined(HAS_FINITE) -# define Perl_isfinite(x) finite(x) +# define Perl_isfinite(x) finite(x) # endif # endif #endif -/* fpclassify(): C99. It is supposed to be a macro that switches on -* the sizeof() of its argument, so there's no need for e.g. fpclassifyl().*/ +/* fpclassify(): C99. It is supposed to be a macro that switches on the + * sizeof() of its argument, so there's no need for e.g. fpclassifyl(). */ #if !defined(Perl_fp_class) && defined(HAS_FPCLASSIFY) # include # if defined(FP_INFINITE) && defined(FP_NAN) -# define Perl_fp_class(x) fpclassify(x) -# define Perl_fp_class_inf(x) (Perl_fp_class(x)==FP_INFINITE) -# define Perl_fp_class_nan(x) (Perl_fp_class(x)==FP_NAN) -# define Perl_fp_class_norm(x) (Perl_fp_class(x)==FP_NORMAL) -# define Perl_fp_class_denorm(x) (Perl_fp_class(x)==FP_SUBNORMAL) -# define Perl_fp_class_zero(x) (Perl_fp_class(x)==FP_ZERO) +# define Perl_fp_class(x) fpclassify(x) +# define Perl_fp_class_inf(x) (Perl_fp_class(x)==FP_INFINITE) +# define Perl_fp_class_nan(x) (Perl_fp_class(x)==FP_NAN) +# define Perl_fp_class_norm(x) (Perl_fp_class(x)==FP_NORMAL) +# define Perl_fp_class_denorm(x) (Perl_fp_class(x)==FP_SUBNORMAL) +# define Perl_fp_class_zero(x) (Perl_fp_class(x)==FP_ZERO) # elif defined(FP_PLUS_INF) && defined(FP_QNAN) /* Some versions of HP-UX (10.20) have (only) fpclassify() but which is * actually not the C99 fpclassify, with its own set of return defines. */ -# define Perl_fp_class(x) fpclassify(x) -# define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_PLUS_INF) -# define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_MINUS_INF) -# define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_SNAN) -# define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_QNAN) -# define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_PLUS_NORM) -# define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_MINUS_NORM) -# define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_PLUS_DENORM) -# define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_MINUS_DENORM) -# define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_PLUS_ZERO) -# define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_MINUS_ZERO) +# define Perl_fp_class(x) fpclassify(x) +# define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_PLUS_INF) +# define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_MINUS_INF) +# define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_SNAN) +# define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_QNAN) +# define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_PLUS_NORM) +# define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_MINUS_NORM) +# define Perl_fp_class_pdenorm(x) \ + (Perl_fp_class(x)==FP_PLUS_DENORM) +# define Perl_fp_class_ndenorm(x) \ + (Perl_fp_class(x)==FP_MINUS_DENORM) +# define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_PLUS_ZERO) +# define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_MINUS_ZERO) # else # undef Perl_fp_class /* Unknown set of defines */ # endif #endif -/* fp_classify(): Legacy: VMS, maybe Unicos? The values, however, - * are identical to the C99 fpclassify(). */ +/* fp_classify(): Legacy: VMS, maybe Unicos? The values, + * however, are identical to the C99 fpclassify(). */ #if !defined(Perl_fp_class) && defined(HAS_FP_CLASSIFY) # include # ifdef __VMS - /* FP_INFINITE and others are here rather than in math.h as C99 stipulates */ + /* FP_INFINITE and others are here rather + than in math.h as C99 stipulates */ # include /* oh, and the isnormal macro has a typo in it! */ # undef isnormal -# define isnormal(x) Perl_fp_class_norm(x) +# define isnormal(x) Perl_fp_class_norm(x) # endif # if defined(FP_INFINITE) && defined(FP_NAN) -# define Perl_fp_class(x) fp_classify(x) -# define Perl_fp_class_inf(x) (Perl_fp_class(x)==FP_INFINITE) -# define Perl_fp_class_nan(x) (Perl_fp_class(x)==FP_NAN) -# define Perl_fp_class_norm(x) (Perl_fp_class(x)==FP_NORMAL) -# define Perl_fp_class_denorm(x) (Perl_fp_class(x)==FP_SUBNORMAL) -# define Perl_fp_class_zero(x) (Perl_fp_class(x)==FP_ZERO) +# define Perl_fp_class(x) fp_classify(x) +# define Perl_fp_class_inf(x) (Perl_fp_class(x)==FP_INFINITE) +# define Perl_fp_class_nan(x) (Perl_fp_class(x)==FP_NAN) +# define Perl_fp_class_norm(x) (Perl_fp_class(x)==FP_NORMAL) +# define Perl_fp_class_denorm(x) (Perl_fp_class(x)==FP_SUBNORMAL) +# define Perl_fp_class_zero(x) (Perl_fp_class(x)==FP_ZERO) # else # undef Perl_fp_class /* Unknown set of defines */ # endif @@ -2824,12 +2835,12 @@ extern long double Perl_my_frexpl(long double x, int *e); /* fpclass(): SysV, at least Solaris and some versions of IRIX. */ #if !defined(Perl_fp_class) && (defined(HAS_FPCLASS)||defined(HAS_FPCLASSL)) -/* Solaris and IRIX have fpclass/fpclassl, but they are using - * an enum typedef, not cpp symbols, and Configure doesn't detect that. - * Define some symbols also as cpp symbols so we can detect them. */ +/* Solaris and IRIX have fpclass/fpclassl, but they are using an enum + * typedef, not cpp symbols, and Configure doesn't detect that. Define + * some symbols also as cpp symbols so we can detect them. */ # if defined(__sun) || defined(__sgi) /* XXX Configure test instead */ -# define FP_PINF FP_PINF -# define FP_QNAN FP_QNAN +# define FP_PINF FP_PINF +# define FP_QNAN FP_QNAN # endif # include # ifdef I_IEEEFP @@ -2839,32 +2850,34 @@ extern long double Perl_my_frexpl(long double x, int *e); # include # endif # if defined(USE_LONG_DOUBLE) && defined(HAS_FPCLASSL) -# define Perl_fp_class(x) fpclassl(x) +# define Perl_fp_class(x) fpclassl(x) # else -# define Perl_fp_class(x) fpclass(x) +# define Perl_fp_class(x) fpclass(x) # endif # if defined(FP_CLASS_PINF) && defined(FP_CLASS_SNAN) -# define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_CLASS_SNAN) -# define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_CLASS_QNAN) -# define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_CLASS_NINF) -# define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_CLASS_PINF) -# define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_CLASS_NNORM) -# define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_CLASS_PNORM) -# define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_CLASS_NDENORM) -# define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_CLASS_PDENORM) -# define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_CLASS_NZERO) -# define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_CLASS_PZERO) +# define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_CLASS_SNAN) +# define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_CLASS_QNAN) +# define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_CLASS_NINF) +# define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_CLASS_PINF) +# define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_CLASS_NNORM) +# define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_CLASS_PNORM) +# define Perl_fp_class_ndenorm(x) \ + (Perl_fp_class(x)==FP_CLASS_NDENORM) +# define Perl_fp_class_pdenorm(x) \ + (Perl_fp_class(x)==FP_CLASS_PDENORM) +# define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_CLASS_NZERO) +# define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_CLASS_PZERO) # elif defined(FP_PINF) && defined(FP_QNAN) -# define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_SNAN) -# define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_QNAN) -# define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_NINF) -# define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_PINF) -# define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_NNORM) -# define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_PNORM) -# define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_NDENORM) -# define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_PDENORM) -# define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_NZERO) -# define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_PZERO) +# define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_SNAN) +# define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_QNAN) +# define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_NINF) +# define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_PINF) +# define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_NNORM) +# define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_PNORM) +# define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_NDENORM) +# define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_PDENORM) +# define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_NZERO) +# define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_PZERO) # else # undef Perl_fp_class /* Unknown set of defines */ # endif @@ -2879,28 +2892,30 @@ extern long double Perl_my_frexpl(long double x, int *e); # if defined(FP_POS_INF) && defined(FP_QNAN) # ifdef __sgi /* XXX Configure test instead */ # ifdef USE_LONG_DOUBLE -# define Perl_fp_class(x) fp_class_l(x) +# define Perl_fp_class(x) fp_class_l(x) # else -# define Perl_fp_class(x) fp_class_d(x) +# define Perl_fp_class(x) fp_class_d(x) # endif # else # if defined(USE_LONG_DOUBLE) && defined(HAS_FP_CLASSL) -# define Perl_fp_class(x) fp_classl(x) +# define Perl_fp_class(x) fp_classl(x) # else -# define Perl_fp_class(x) fp_class(x) +# define Perl_fp_class(x) fp_class(x) # endif # endif # if defined(FP_POS_INF) && defined(FP_QNAN) -# define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_SNAN) -# define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_QNAN) -# define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_NEG_INF) -# define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_POS_INF) -# define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_NEG_NORM) -# define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_POS_NORM) -# define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_NEG_DENORM) -# define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_POS_DENORM) -# define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_NEG_ZERO) -# define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_POS_ZERO) +# define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_SNAN) +# define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_QNAN) +# define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_NEG_INF) +# define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_POS_INF) +# define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_NEG_NORM) +# define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_POS_NORM) +# define Perl_fp_class_ndenorm(x) \ + (Perl_fp_class(x)==FP_NEG_DENORM) +# define Perl_fp_class_pdenorm(x) \ + (Perl_fp_class(x)==FP_POS_DENORM) +# define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_NEG_ZERO) +# define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_POS_ZERO) # else # undef Perl_fp_class /* Unknown set of defines */ # endif @@ -2912,21 +2927,25 @@ extern long double Perl_my_frexpl(long double x, int *e); # include # if defined(FP_PLUS_NORM) && defined(FP_PLUS_INF) # ifndef _cplusplus -# define Perl_fp_class(x) class(x) +# define Perl_fp_class(x) class(x) # else -# define Perl_fp_class(x) _class(x) +# define Perl_fp_class(x) _class(x) # endif # if defined(FP_PLUS_INF) && defined(FP_NANQ) -# define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_NANS) -# define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_NANQ) -# define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_MINUS_INF) -# define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_PLUS_INF) -# define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_MINUS_NORM) -# define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_PLUS_NORM) -# define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_MINUS_DENORM) -# define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_PLUS_DENORM) -# define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_MINUS_ZERO) -# define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_PLUS_ZERO) +# define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_NANS) +# define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_NANQ) +# define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_MINUS_INF) +# define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_PLUS_INF) +# define Perl_fp_class_nnorm(x) \ + (Perl_fp_class(x)==FP_MINUS_NORM) +# define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_PLUS_NORM) +# define Perl_fp_class_ndenorm(x) \ + (Perl_fp_class(x)==FP_MINUS_DENORM) +# define Perl_fp_class_pdenorm(x) \ + (Perl_fp_class(x)==FP_PLUS_DENORM) +# define Perl_fp_class_nzero(x) \ + (Perl_fp_class(x)==FP_MINUS_ZERO) +# define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_PLUS_ZERO) # else # undef Perl_fp_class /* Unknown set of defines */ # endif @@ -2936,129 +2955,130 @@ extern long double Perl_my_frexpl(long double x, int *e); /* Win32: _fpclass(), _isnan(), _finite(). */ #ifdef _MSC_VER # ifndef Perl_isnan -# define Perl_isnan(x) _isnan(x) +# define Perl_isnan(x) _isnan(x) # endif # ifndef Perl_isfinite -# define Perl_isfinite(x) _finite(x) +# define Perl_isfinite(x) _finite(x) # endif # ifndef Perl_fp_class_snan -/* No simple way to #define Perl_fp_class because _fpclass() - * returns a set of bits. */ -# define Perl_fp_class_snan(x) (_fpclass(x) & _FPCLASS_SNAN) -# define Perl_fp_class_qnan(x) (_fpclass(x) & _FPCLASS_QNAN) -# define Perl_fp_class_nan(x) (_fpclass(x) & (_FPCLASS_SNAN|_FPCLASS_QNAN)) -# define Perl_fp_class_ninf(x) (_fpclass(x) & _FPCLASS_NINF) -# define Perl_fp_class_pinf(x) (_fpclass(x) & _FPCLASS_PINF) -# define Perl_fp_class_inf(x) (_fpclass(x) & (_FPCLASS_NINF|_FPCLASS_PINF)) -# define Perl_fp_class_nnorm(x) (_fpclass(x) & _FPCLASS_NN) -# define Perl_fp_class_pnorm(x) (_fpclass(x) & _FPCLASS_PN) -# define Perl_fp_class_norm(x) (_fpclass(x) & (_FPCLASS_NN|_FPCLASS_PN)) +/* No simple way to #define Perl_fp_class because + * _fpclass() returns a set of bits. */ +# define Perl_fp_class_snan(x) (_fpclass(x) & _FPCLASS_SNAN) +# define Perl_fp_class_qnan(x) (_fpclass(x) & _FPCLASS_QNAN) +# define Perl_fp_class_nan(x) (_fpclass(x) & (_FPCLASS_SNAN|_FPCLASS_QNAN)) +# define Perl_fp_class_ninf(x) (_fpclass(x) & _FPCLASS_NINF) +# define Perl_fp_class_pinf(x) (_fpclass(x) & _FPCLASS_PINF) +# define Perl_fp_class_inf(x) (_fpclass(x) & (_FPCLASS_NINF|_FPCLASS_PINF)) +# define Perl_fp_class_nnorm(x) (_fpclass(x) & _FPCLASS_NN) +# define Perl_fp_class_pnorm(x) (_fpclass(x) & _FPCLASS_PN) +# define Perl_fp_class_norm(x) (_fpclass(x) & (_FPCLASS_NN|_FPCLASS_PN)) # define Perl_fp_class_ndenorm(x) (_fpclass(x) & _FPCLASS_ND) # define Perl_fp_class_pdenorm(x) (_fpclass(x) & _FPCLASS_PD) # define Perl_fp_class_denorm(x) (_fpclass(x) & (_FPCLASS_ND|_FPCLASS_PD)) -# define Perl_fp_class_nzero(x) (_fpclass(x) & _FPCLASS_NZ) -# define Perl_fp_class_pzero(x) (_fpclass(x) & _FPCLASS_PZ) -# define Perl_fp_class_zero(x) (_fpclass(x) & (_FPCLASS_NZ|_FPCLASS_PZ)) +# define Perl_fp_class_nzero(x) (_fpclass(x) & _FPCLASS_NZ) +# define Perl_fp_class_pzero(x) (_fpclass(x) & _FPCLASS_PZ) +# define Perl_fp_class_zero(x) (_fpclass(x) & (_FPCLASS_NZ|_FPCLASS_PZ)) # endif #endif -#if !defined(Perl_fp_class_inf) && \ - defined(Perl_fp_class_pinf) && defined(Perl_fp_class_ninf) -# define Perl_fp_class_inf(x) \ - (Perl_fp_class_pinf(x) || Perl_fp_class_ninf(x)) +#if !defined(Perl_fp_class_inf) && \ + defined(Perl_fp_class_pinf) && defined(Perl_fp_class_ninf) +# define Perl_fp_class_inf(x) \ + (Perl_fp_class_pinf(x) || Perl_fp_class_ninf(x)) #endif -#if !defined(Perl_fp_class_nan) && \ - defined(Perl_fp_class_snan) && defined(Perl_fp_class_qnan) -# define Perl_fp_class_nan(x) \ - (Perl_fp_class_snan(x) || Perl_fp_class_qnan(x)) +#if !defined(Perl_fp_class_nan) && \ + defined(Perl_fp_class_snan) && defined(Perl_fp_class_qnan) +# define Perl_fp_class_nan(x) \ + (Perl_fp_class_snan(x) || Perl_fp_class_qnan(x)) #endif #if !defined(Perl_fp_class_zero) && \ - defined(Perl_fp_class_pzero) && defined(Perl_fp_class_nzero) + defined(Perl_fp_class_pzero) && defined(Perl_fp_class_nzero) # define Perl_fp_class_zero(x) \ - (Perl_fp_class_pzero(x) || Perl_fp_class_nzero(x)) + (Perl_fp_class_pzero(x) || Perl_fp_class_nzero(x)) #endif #if !defined(Perl_fp_class_norm) && \ - defined(Perl_fp_class_pnorm) && defined(Perl_fp_class_nnorm) + defined(Perl_fp_class_pnorm) && defined(Perl_fp_class_nnorm) # define Perl_fp_class_norm(x) \ - (Perl_fp_class_pnorm(x) || Perl_fp_class_nnorm(x)) + (Perl_fp_class_pnorm(x) || Perl_fp_class_nnorm(x)) #endif -#if !defined(Perl_fp_class_denorm) && \ - defined(Perl_fp_class_pdenorm) && defined(Perl_fp_class_ndenorm) -# define Perl_fp_class_denorm(x) \ - (Perl_fp_class_pdenorm(x) || Perl_fp_class_ndenorm(x)) +#if !defined(Perl_fp_class_denorm) && \ + defined(Perl_fp_class_pdenorm) && defined(Perl_fp_class_ndenorm) +# define Perl_fp_class_denorm(x) \ + (Perl_fp_class_pdenorm(x) || Perl_fp_class_ndenorm(x)) #endif #ifndef Perl_isnan # ifdef Perl_fp_class_nan -# define Perl_isnan(x) Perl_fp_class_nan(x) +# define Perl_isnan(x) Perl_fp_class_nan(x) # elif defined(HAS_UNORDERED) -# define Perl_isnan(x) unordered((x), 0.0) +# define Perl_isnan(x) unordered((x), 0.0) # else -# define Perl_isnan(x) ((x)!=(x)) +# define Perl_isnan(x) ((x)!=(x)) # endif #endif #ifndef Perl_isinf # ifdef Perl_fp_class_inf -# define Perl_isinf(x) Perl_fp_class_inf(x) +# define Perl_isinf(x) Perl_fp_class_inf(x) # endif #endif #ifndef Perl_isfinite # if defined(HAS_ISFINITE) && !defined(isfinite) -# define Perl_isfinite(x) isfinite((double)(x)) +# define Perl_isfinite(x) isfinite((double)(x)) # elif defined(HAS_FINITE) -# define Perl_isfinite(x) finite((double)(x)) +# define Perl_isfinite(x) finite((double)(x)) # elif defined(Perl_fp_class_finite) -# define Perl_isfinite(x) Perl_fp_class_finite(x) +# define Perl_isfinite(x) Perl_fp_class_finite(x) # else -/* For the infinities the multiplication returns nan, - * for the nan the multiplication also returns nan, - * for everything else (that is, finite) zero should be returned. */ -# define Perl_isfinite(x) (((x) * 0) == 0) +/* For the infinities the multiplication returns nan, for the + * nan the multiplication also returns nan, for everything + * else (that is, finite) zero should be returned. */ +# define Perl_isfinite(x) (((x) * 0) == 0) # endif #endif #ifndef Perl_isinf # if defined(Perl_isfinite) && defined(Perl_isnan) -# define Perl_isinf(x) !(Perl_isfinite(x)||Perl_isnan(x)) +# define Perl_isinf(x) !(Perl_isfinite(x)||Perl_isnan(x)) # endif #endif -/* We need Perl_isfinitel (ends with ell) (if available) even when - * not USE_LONG_DOUBLE because the printf code (sv_catpvfn_flags) - * needs that. */ +/* We need Perl_isfinitel (ends with ell) (if available) even when not + * USE_LONG_DOUBLE because the printf code (sv_catpvfn_flags) needs that. */ #if defined(HAS_LONG_DOUBLE) && !defined(Perl_isfinitel) /* If isfinite() is a macro and looks like we have C99, * we assume it's the type-aware C99 isfinite(). */ # if defined(HAS_ISFINITE) && defined(isfinite) && defined(HAS_C99) -# define Perl_isfinitel(x) isfinite(x) +# define Perl_isfinitel(x) isfinite(x) # elif defined(HAS_ISFINITEL) -# define Perl_isfinitel(x) isfinitel(x) +# define Perl_isfinitel(x) isfinitel(x) # elif defined(HAS_FINITEL) -# define Perl_isfinitel(x) finitel(x) +# define Perl_isfinitel(x) finitel(x) # elif defined(HAS_ISINFL) && defined(HAS_ISNANL) -# define Perl_isfinitel(x) !(isinfl(x)||isnanl(x)) +# define Perl_isfinitel(x) !(isinfl(x)||isnanl(x)) # else -# define Perl_isfinitel(x) ((x) * 0 == 0) /* See Perl_isfinite. */ +# define Perl_isfinitel(x) ((x) * 0 == 0) /* See + Perl_isfinite. + */ # endif #endif -/* The default is to use Perl's own atof() implementation (in numeric.c). - * This knows about if 'use locale' is in effect or not, and handles the radix - * character accordingly. On some platforms (e.g. UNICOS) it is however best - * to use the native implementation of atof, as long as you accept that the - * current underlying locale will affect the radix character. Perl's version - * uses a dot for a radix, execpt within the lexical scope of a Perl C statement. +/* The default is to use Perl's own atof() implementation (in + * numeric.c). This knows about if 'use locale' is in effect or not, and + * handles the radix character accordingly. On some platforms (e.g. + * UNICOS) it is however best to use the native implementation of atof, as + * long as you accept that the current underlying locale will affect the + * radix character. Perl's version uses a dot for a radix, execpt within + * the lexical scope of a Perl C statement. * * You can experiment with using your native one by -DUSE_PERL_ATOF=0. * Some good tests to try out with either setting are t/base/num.t, - * t/op/numconvert.t, and t/op/pack.t. Note that if using long doubles + * t/op/numconvert.t, and t/op/pack.t. Note that if using long doubles * you may need to be using a different function than atof! */ #ifndef USE_PERL_ATOF @@ -3072,13 +3092,13 @@ extern long double Perl_my_frexpl(long double x, int *e); #endif #ifdef USE_PERL_ATOF -# define Perl_atof(s) Perl_my_atof(aTHX_ s) -# define Perl_atof2(s, n) Perl_my_atof3(aTHX_ (s), &(n), 0) +# define Perl_atof(s) Perl_my_atof(aTHX_ s) +# define Perl_atof2(s, n) Perl_my_atof3(aTHX_ (s), &(n), 0) #else -# define Perl_atof(s) (NV)atof(s) -# define Perl_atof2(s, n) ((n) = atof(s)) +# define Perl_atof(s) (NV)atof(s) +# define Perl_atof2(s, n) ((n) = atof(s)) #endif -#define my_atof2(a,b) my_atof3(a,b,0) +#define my_atof2(a,b) my_atof3(a,b,0) /* =for apidoc AmTR|NV|Atof|NN const char * const s @@ -3086,10 +3106,9 @@ extern long double Perl_my_frexpl(long double x, int *e); This is a synonym for L>. =cut - */ -#define Atof my_atof +#define Atof my_atof /* =for apidoc_section $numeric @@ -3118,50 +3137,48 @@ This is a synonym for L>. =for apidoc_item |NV|Perl_tan|NV x =for apidoc_item |NV|Perl_tanh|NV x -These perform the corresponding mathematical operation on the operand(s), using -the libc function designed for the task that has just enough precision for an -NV on this platform. If no such function with sufficient precision exists, -the highest precision one available is used. +These perform the corresponding mathematical operation on the operand(s), +using the libc function designed for the task that has just enough +precision for an NV on this platform. If no such function with sufficient +precision exists, the highest precision one available is used. =cut - */ /* - * CHAR_MIN and CHAR_MAX are not included here, as the (char) type may be - * ambiguous. It may be equivalent to (signed char) or (unsigned char) - * depending on local options. Until Configure detects this (or at least - * detects whether the "signed" keyword is available) the CHAR ranges - * will not be included. UCHAR functions normally. - * - kja - */ + * CHAR_MIN and CHAR_MAX are not included here, as the (char) type may + * be ambiguous. It may be equivalent to (signed char) or (unsigned + * char) depending on local options. Until Configure detects this (or + * at least detects whether the "signed" keyword is available) the CHAR + * ranges will not be included. UCHAR functions normally. - kja +*/ -#define PERL_UCHAR_MIN ((unsigned char)0) -#define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX) +#define PERL_UCHAR_MIN ((unsigned char)0) +#define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX) #define PERL_USHORT_MIN ((unsigned short)0) #define PERL_USHORT_MAX ((unsigned short)USHRT_MAX) -#define PERL_SHORT_MAX ((short)SHRT_MAX) -#define PERL_SHORT_MIN ((short)SHRT_MIN) +#define PERL_SHORT_MAX ((short)SHRT_MAX) +#define PERL_SHORT_MIN ((short)SHRT_MIN) -#define PERL_UINT_MAX ((unsigned int)UINT_MAX) -#define PERL_UINT_MIN ((unsigned int)0) +#define PERL_UINT_MAX ((unsigned int)UINT_MAX) +#define PERL_UINT_MIN ((unsigned int)0) -#define PERL_INT_MAX ((int)INT_MAX) -#define PERL_INT_MIN ((int)INT_MIN) +#define PERL_INT_MAX ((int)INT_MAX) +#define PERL_INT_MIN ((int)INT_MIN) -#define PERL_ULONG_MAX ((unsigned long)ULONG_MAX) -#define PERL_ULONG_MIN ((unsigned long)0L) +#define PERL_ULONG_MAX ((unsigned long)ULONG_MAX) +#define PERL_ULONG_MIN ((unsigned long)0L) -#define PERL_LONG_MAX ((long)LONG_MAX) -#define PERL_LONG_MIN ((long)LONG_MIN) +#define PERL_LONG_MAX ((long)LONG_MAX) +#define PERL_LONG_MIN ((long)LONG_MIN) #ifdef UV_IS_QUAD -# define PERL_UQUAD_MAX (~(UV)0) -# define PERL_UQUAD_MIN ((UV)0) -# define PERL_QUAD_MAX ((IV) (PERL_UQUAD_MAX >> 1)) -# define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3)) +# define PERL_UQUAD_MAX (~(UV)0) +# define PERL_UQUAD_MIN ((UV)0) +# define PERL_QUAD_MAX ((IV) (PERL_UQUAD_MAX >> 1)) +# define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3)) #endif /* @@ -3186,19 +3203,18 @@ the highest precision one available is used. =for apidoc_item |unsigned short|PERL_USHORT_MAX =for apidoc_item |unsigned short|PERL_USHORT_MIN -These give the largest and smallest number representable in the current -platform in variables of the corresponding types. +These give the largest and smallest number representable in the +current platform in variables of the corresponding types. -For signed types, the smallest representable number is the most negative -number, the one furthest away from zero. +For signed types, the smallest representable number is the most +negative number, the one furthest away from zero. -For C99 and later compilers, these correspond to things like C, which -are available to the C code. But these constants, furnished by Perl, -allow code compiled on earlier compilers to portably have access to the same -constants. +For C99 and later compilers, these correspond to things like +C, which are available to the C code. But these +constants, furnished by Perl, allow code compiled on earlier +compilers to portably have access to the same constants. =cut - */ typedef MEM_SIZE STRLEN; @@ -3229,9 +3245,9 @@ typedef struct interpreter PerlInterpreter; /* SGI's has struct sv */ #if defined(__sgi) -# define STRUCT_SV perl_sv +# define STRUCT_SV perl_sv #else -# define STRUCT_SV sv +# define STRUCT_SV sv #endif typedef struct STRUCT_SV SV; typedef struct av AV; @@ -3267,14 +3283,13 @@ typedef struct ptr_tbl_ent PTR_TBL_ENT_t; typedef struct ptr_tbl PTR_TBL_t; typedef struct clone_params CLONE_PARAMS; -/* a pad is currently just an AV; but that might change, - * so hide the type. */ +/* a pad is currently just an AV; but that might change, so hide the type. */ typedef struct padlist PADLIST; typedef AV PAD; typedef struct padnamelist PADNAMELIST; typedef struct padname PADNAME; -/* always enable PERL_OP_PARENT */ +/* always enable PERL_OP_PARENT */ #if !defined(PERL_OP_PARENT) # define PERL_OP_PARENT #endif @@ -3299,7 +3314,7 @@ typedef struct padname PADNAME; #if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_RAWIO) # if LSEEKSIZE == 8 && !defined(USE_64_BIT_RAWIO) -# define USE_64_BIT_RAWIO /* implicit */ +# define USE_64_BIT_RAWIO /* implicit */ # endif #endif @@ -3308,92 +3323,94 @@ typedef struct padname PADNAME; * however, because operating systems like to do that themself. */ #ifndef FSEEKSIZE # ifdef HAS_FSEEKO -# define FSEEKSIZE LSEEKSIZE +# define FSEEKSIZE LSEEKSIZE # else -# define FSEEKSIZE LONGSIZE +# define FSEEKSIZE LONGSIZE # endif #endif #if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_STDIO) # if FSEEKSIZE == 8 && !defined(USE_64_BIT_STDIO) -# define USE_64_BIT_STDIO /* implicit */ +# define USE_64_BIT_STDIO /* implicit */ # endif #endif #ifdef USE_64_BIT_RAWIO # ifdef HAS_OFF64_T # undef Off_t -# define Off_t off64_t +# define Off_t off64_t # undef LSEEKSIZE -# define LSEEKSIZE 8 +# define LSEEKSIZE 8 # endif -/* Most 64-bit environments have defines like _LARGEFILE_SOURCE that - * will trigger defines like the ones below. Some 64-bit environments, +/* Most 64-bit environments have defines like _LARGEFILE_SOURCE that will + * trigger defines like the ones below. Some 64-bit environments, * however, do not. Therefore we have to explicitly mix and match. */ # if defined(USE_OPEN64) -# define open open64 +# define open open64 # endif # if defined(USE_LSEEK64) -# define lseek lseek64 +# define lseek lseek64 # else # if defined(USE_LLSEEK) -# define lseek llseek +# define lseek llseek # endif # endif # if defined(USE_STAT64) -# define stat stat64 +# define stat stat64 # endif # if defined(USE_FSTAT64) -# define fstat fstat64 +# define fstat fstat64 # endif # if defined(USE_LSTAT64) -# define lstat lstat64 +# define lstat lstat64 # endif # if defined(USE_FLOCK64) -# define flock flock64 +# define flock flock64 # endif # if defined(USE_LOCKF64) -# define lockf lockf64 +# define lockf lockf64 # endif # if defined(USE_FCNTL64) -# define fcntl fcntl64 +# define fcntl fcntl64 # endif # if defined(USE_TRUNCATE64) -# define truncate truncate64 +# define truncate truncate64 # endif # if defined(USE_FTRUNCATE64) -# define ftruncate ftruncate64 +# define ftruncate ftruncate64 # endif #endif #ifdef USE_64_BIT_STDIO # ifdef HAS_FPOS64_T # undef Fpos_t -# define Fpos_t fpos64_t +# define Fpos_t fpos64_t # endif -/* Most 64-bit environments have defines like _LARGEFILE_SOURCE that - * will trigger defines like the ones below. Some 64-bit environments, - * however, do not. */ +/* Most 64-bit environments have defines like _LARGEFILE_SOURCE + * that will trigger defines like the ones below. Some 64-bit + * environments, however, do not. */ # if defined(USE_FOPEN64) -# define fopen fopen64 +# define fopen fopen64 # endif # if defined(USE_FSEEK64) -# define fseek fseek64 /* don't do fseeko here, see perlio.c */ +# define fseek fseek64 /* don't do fseeko here, + see perlio.c */ # endif # if defined(USE_FTELL64) -# define ftell ftell64 /* don't do ftello here, see perlio.c */ +# define ftell ftell64 /* don't do ftello here, + see perlio.c */ # endif # if defined(USE_FSETPOS64) -# define fsetpos fsetpos64 +# define fsetpos fsetpos64 # endif # if defined(USE_FGETPOS64) -# define fgetpos fgetpos64 +# define fgetpos fgetpos64 # endif # if defined(USE_TMPFILE64) -# define tmpfile tmpfile64 +# define tmpfile tmpfile64 # endif # if defined(USE_FREOPEN64) -# define freopen freopen64 +# define freopen freopen64 # endif #endif @@ -3431,25 +3448,25 @@ typedef struct padname PADNAME; /* NSIG logic from Configure --> */ #ifndef NSIG # ifdef _NSIG -# define NSIG (_NSIG) +# define NSIG (_NSIG) # elif defined(SIGMAX) -# define NSIG (SIGMAX+1) +# define NSIG (SIGMAX+1) # elif defined(SIG_MAX) -# define NSIG (SIG_MAX+1) +# define NSIG (SIG_MAX+1) # elif defined(_SIG_MAX) -# define NSIG (_SIG_MAX+1) +# define NSIG (_SIG_MAX+1) # elif defined(MAXSIG) -# define NSIG (MAXSIG+1) +# define NSIG (MAXSIG+1) # elif defined(MAX_SIG) -# define NSIG (MAX_SIG+1) +# define NSIG (MAX_SIG+1) # elif defined(SIGARRAYSIZE) -# define NSIG SIGARRAYSIZE /* Assume ary[SIGARRAYSIZE] */ +# define NSIG SIGARRAYSIZE /* Assume ary[SIGARRAYSIZE] */ # elif defined(_sys_nsig) -# define NSIG (_sys_nsig) /* Solaris 2.5 */ +# define NSIG (_sys_nsig) /* Solaris 2.5 */ # else - /* Default to some arbitrary number that's big enough to get most - * of the common signals. */ -# define NSIG 50 + /* Default to some arbitrary number that's big enough + * to get most of the common signals. */ +# define NSIG 50 # endif #endif /* <-- NSIG logic from Configure */ @@ -3459,21 +3476,20 @@ typedef struct padname PADNAME; #endif #if defined(HAS_SIGACTION) && defined(SA_SIGINFO) - /* having sigaction(2) means that the OS supports both 1-arg and 3-arg - * signal handlers. But the perl core itself only fully supports 1-arg - * handlers, so don't enable for now. + /* having sigaction(2) means that the OS supports both 1-arg + * and 3-arg signal handlers. But the perl core itself only + * fully supports 1-arg handlers, so don't enable for now. * NB: POSIX::sigaction() supports both. * * # define PERL_USE_3ARG_SIGHANDLER */ #endif -/* Siginfo_t: - * This is an alias for the OS's siginfo_t, except that where the OS - * doesn't support it, declare a dummy version instead. This allows us to - * have signal handler functions which always have a Siginfo_t parameter - * regardless of platform, (and which will just be passed a NULL value - * where the OS doesn't support HAS_SIGACTION). +/* Siginfo_t: This is an alias for the OS's siginfo_t, except that where + * the OS doesn't support it, declare a dummy version instead. This + * allows us to have signal handler functions which always have a + * Siginfo_t parameter regardless of platform, (and which will just be + * passed a NULL value where the OS doesn't support HAS_SIGACTION). */ #if defined(HAS_SIGACTION) && defined(SA_SIGINFO) @@ -3490,69 +3506,71 @@ typedef struct padname PADNAME; /* * initialise to avoid floating-point exceptions from overflow, etc - */ +*/ #ifndef PERL_FPU_INIT # ifdef HAS_FPSETMASK # if HAS_FLOATINGPOINT_H # include # endif -/* Some operating systems have this as a macro, which in turn expands to a comma - expression, and the last sub-expression is something that gets calculated, - and then they have the gall to warn that a value computed is not used. Hence - cast to void. */ -# define PERL_FPU_INIT (void)fpsetmask(0) +/* Some operating systems have this as a macro, which in turn expands + to a comma expression, and the last sub-expression is something + that gets calculated, and then they have the gall to warn that a + value computed is not used. Hence cast to void. */ +# define PERL_FPU_INIT (void)fpsetmask(0) # elif defined(SIGFPE) && defined(SIG_IGN) && !defined(PERL_MICRO) -# define PERL_FPU_INIT PL_sigfpe_saved = (Sighandler_t) signal(SIGFPE, SIG_IGN) -# define PERL_FPU_PRE_EXEC { Sigsave_t xfpe; rsignal_save(SIGFPE, PL_sigfpe_saved, &xfpe); -# define PERL_FPU_POST_EXEC rsignal_restore(SIGFPE, &xfpe); } +# define PERL_FPU_INIT \ + PL_sigfpe_saved = (Sighandler_t) signal(SIGFPE, SIG_IGN) +# define PERL_FPU_PRE_EXEC \ + { Sigsave_t xfpe; rsignal_save(SIGFPE, PL_sigfpe_saved, &xfpe); +# define PERL_FPU_POST_EXEC rsignal_restore(SIGFPE, &xfpe); } # else # define PERL_FPU_INIT # endif #endif #ifndef PERL_FPU_PRE_EXEC -# define PERL_FPU_PRE_EXEC { -# define PERL_FPU_POST_EXEC } +# define PERL_FPU_PRE_EXEC { +# define PERL_FPU_POST_EXEC } #endif -/* In Tru64 the cc -ieee enables the IEEE math but disables traps. - * We need to reenable the "invalid" trap because otherwise generation - * of NaN values leaves the IEEE fp flags in bad state, leaving any further - * fp ops behaving strangely (Inf + 1 resulting in zero, for example). */ +/* In Tru64 the cc -ieee enables the IEEE math but disables traps. We need + * to reenable the "invalid" trap because otherwise generation of NaN + * values leaves the IEEE fp flags in bad state, leaving any further fp ops + * behaving strangely (Inf + 1 resulting in zero, for example). */ #ifdef __osf__ # include -# define PERL_SYS_FPU_INIT \ - STMT_START { \ - ieee_set_fp_control(IEEE_TRAP_ENABLE_INV); \ - signal(SIGFPE, SIG_IGN); \ - } STMT_END -#endif -/* In IRIX the default for Flush to Zero bit is true, - * which means that results going below the minimum of normal - * floating points go to zero, instead of going denormal/subnormal. - * This is unlike almost any other system running Perl, so let's clear it. - * [perl #123767] IRIX64 blead (ddce084a) opbasic/arith.t failure, originally - * [perl #120426] small numbers shouldn't round to zero if they have extra floating digits +# define PERL_SYS_FPU_INIT \ + STMT_START { \ + ieee_set_fp_control(IEEE_TRAP_ENABLE_INV); \ + signal(SIGFPE, SIG_IGN); \ + } STMT_END +#endif +/* In IRIX the default for Flush to Zero bit is true, which means that + * results going below the minimum of normal floating points go to zero, + * instead of going denormal/subnormal. This is unlike almost any other + * system running Perl, so let's clear it. [perl #123767] IRIX64 blead + * (ddce084a) opbasic/arith.t failure, originally [perl #120426] small + * numbers shouldn't round to zero if they have extra floating digits * - * XXX The flush-to-zero behaviour should be a Configure scan. - * To change the behaviour usually requires some system-specific + * XXX The flush-to-zero behaviour should be a Configure scan. To + * change the behaviour usually requires some system-specific * incantation, though, like the below. */ #ifdef __sgi # include -# define PERL_SYS_FPU_INIT \ - STMT_START { \ - union fpc_csr csr; \ - csr.fc_word = get_fpc_csr(); \ - csr.fc_struct.flush = 0; \ - set_fpc_csr(csr.fc_word); \ - } STMT_END +# define PERL_SYS_FPU_INIT \ + STMT_START { \ + union fpc_csr csr; \ + csr.fc_word = get_fpc_csr(); \ + csr.fc_struct.flush = 0; \ + set_fpc_csr(csr.fc_word); \ + } STMT_END #endif #ifndef PERL_SYS_FPU_INIT -# define PERL_SYS_FPU_INIT NOOP +# define PERL_SYS_FPU_INIT NOOP #endif #ifndef PERL_SYS_INIT3_BODY -# define PERL_SYS_INIT3_BODY(argvp,argcp,envp) PERL_SYS_INIT_BODY(argvp,argcp) +# define PERL_SYS_INIT3_BODY(argvp,argcp,envp) PERL_SYS_INIT_BODY(argvp,argcp) #endif /* @@ -3561,23 +3579,23 @@ typedef struct padname PADNAME; =for apidoc Am|void|PERL_SYS_INIT |int *argc|char*** argv =for apidoc_item| |PERL_SYS_INIT3|int *argc|char*** argv|char*** env -These provide system-specific tune up of the C runtime environment necessary to -run Perl interpreters. Only one should be used, and it should be called only -once, before creating any Perl interpreters. +These provide system-specific tune up of the C runtime environment +necessary to run Perl interpreters. Only one should be used, and it should +be called only once, before creating any Perl interpreters. They differ in that C also initializes C. =for apidoc Am|void|PERL_SYS_TERM| Provides system-specific clean up of the C runtime environment after -running Perl interpreters. This should be called only once, after -freeing any remaining Perl interpreters. +running Perl interpreters. This should be called only once, after freeing +any remaining Perl interpreters. =cut - */ +*/ -#define PERL_SYS_INIT(argc, argv) Perl_sys_init(argc, argv) -#define PERL_SYS_INIT3(argc, argv, env) Perl_sys_init3(argc, argv, env) -#define PERL_SYS_TERM() Perl_sys_term() +#define PERL_SYS_INIT(argc, argv) Perl_sys_init(argc, argv) +#define PERL_SYS_INIT3(argc, argv, env) Perl_sys_init3(argc, argv, env) +#define PERL_SYS_TERM() Perl_sys_term() #ifndef PERL_WRITE_MSG_TO_CONSOLE # define PERL_WRITE_MSG_TO_CONSOLE(io, msg, len) PerlIO_write(io, msg, len) @@ -3587,20 +3605,19 @@ freeing any remaining Perl interpreters. # ifdef PATH_MAX # ifdef _POSIX_PATH_MAX # if PATH_MAX > _POSIX_PATH_MAX -/* POSIX 1990 (and pre) was ambiguous about whether PATH_MAX - * included the null byte or not. Later amendments of POSIX, - * XPG4, the Austin Group, and the Single UNIX Specification - * all explicitly include the null byte in the PATH_MAX. - * Ditto for _POSIX_PATH_MAX. */ -# define MAXPATHLEN PATH_MAX +/* POSIX 1990 (and pre) was ambiguous about whether PATH_MAX included + * the null byte or not. Later amendments of POSIX, XPG4, the Austin + * Group, and the Single UNIX Specification all explicitly include + * the null byte in the PATH_MAX. Ditto for _POSIX_PATH_MAX. */ +# define MAXPATHLEN PATH_MAX # else -# define MAXPATHLEN _POSIX_PATH_MAX +# define MAXPATHLEN _POSIX_PATH_MAX # endif # else -# define MAXPATHLEN (PATH_MAX+1) +# define MAXPATHLEN (PATH_MAX+1) # endif # else -# define MAXPATHLEN 1024 /* Err on the large side. */ +# define MAXPATHLEN 1024 /* Err on the large side. */ # endif #endif @@ -3608,30 +3625,30 @@ freeing any remaining Perl interpreters. * http://clang.llvm.org/docs/ThreadSafetyAnalysis.html * * Available since clang 3.6-ish (appeared in 3.4, but shaky still in 3.5). - * Apple XCode hijacks __clang_major__ and __clang_minor__ - * (6.1 means really clang 3.6), so needs extra hijinks - * (could probably also test the contents of __apple_build_version__). + * Apple XCode hijacks __clang_major__ and __clang_minor__ (6.1 means really + * clang 3.6), so needs extra hijinks (could probably also test the contents + * of __apple_build_version__). */ -#if defined(USE_ITHREADS) && defined(I_PTHREAD) && \ - defined(__clang__) && \ - !defined(SWIG) && \ - ((!defined(__apple_build_version__) && \ - ((__clang_major__ == 3 && __clang_minor__ >= 6) || \ - (__clang_major__ >= 4))) || \ - (defined(__apple_build_version__) && \ - ((__clang_major__ == 6 && __clang_minor__ >= 1) || \ - (__clang_major__ >= 7)))) -# define PERL_TSA__(x) __attribute__((x)) +#if defined(USE_ITHREADS) && defined(I_PTHREAD) && \ + defined(__clang__) && \ + !defined(SWIG) && \ + ((!defined(__apple_build_version__) && \ + ((__clang_major__ == 3 && __clang_minor__ >= 6) || \ + (__clang_major__ >= 4))) || \ + (defined(__apple_build_version__) && \ + ((__clang_major__ == 6 && __clang_minor__ >= 1) || \ + (__clang_major__ >= 7)))) +# define PERL_TSA__(x) __attribute__((x)) # define PERL_TSA_ACTIVE #else -# define PERL_TSA__(x) /* No TSA, make TSA attributes no-ops. */ +# define PERL_TSA__(x) /* No TSA, make TSA attributes no-ops. */ # undef PERL_TSA_ACTIVE #endif -/* PERL_TSA_CAPABILITY() is used to annotate typedefs. - * typedef old_type PERL_TSA_CAPABILITY("mutex") new_type; +/* PERL_TSA_CAPABILITY() is used to annotate typedefs. typedef + * old_type PERL_TSA_CAPABILITY("mutex") new_type; */ -#define PERL_TSA_CAPABILITY(x) \ +#define PERL_TSA_CAPABILITY(x) \ PERL_TSA__(capability(x)) /* In the below examples the mutex must be lexically visible, usually @@ -3641,7 +3658,7 @@ freeing any remaining Perl interpreters. * * Foo foo PERL_TSA_GUARDED_BY(mutex); */ -#define PERL_TSA_GUARDED_BY(x) \ +#define PERL_TSA_GUARDED_BY(x) \ PERL_TSA__(guarded_by(x)) /* PERL_TSA_PT_GUARDED_BY() is used to annotate global pointers. @@ -3649,57 +3666,57 @@ freeing any remaining Perl interpreters. * * Foo* ptr PERL_TSA_PT_GUARDED_BY(mutex); */ -#define PERL_TSA_PT_GUARDED_BY(x) \ +#define PERL_TSA_PT_GUARDED_BY(x) \ PERL_TSA__(pt_guarded_by(x)) -/* PERL_TSA_REQUIRES() is used to annotate functions. - * The caller MUST hold the resource when calling the function. +/* PERL_TSA_REQUIRES() is used to annotate functions. The caller + * MUST hold the resource when calling the function. * * void Foo() PERL_TSA_REQUIRES(mutex); */ -#define PERL_TSA_REQUIRES(x) \ +#define PERL_TSA_REQUIRES(x) \ PERL_TSA__(requires_capability(x)) -/* PERL_TSA_EXCLUDES() is used to annotate functions. - * The caller MUST NOT hold resource when calling the function. +/* PERL_TSA_EXCLUDES() is used to annotate functions. The caller + * MUST NOT hold resource when calling the function. * - * EXCLUDES should be used when the function first acquires - * the resource and then releases it. Use to avoid deadlock. + * EXCLUDES should be used when the function first acquires the + * resource and then releases it. Use to avoid deadlock. * * void Foo() PERL_TSA_EXCLUDES(mutex); */ -#define PERL_TSA_EXCLUDES(x) \ +#define PERL_TSA_EXCLUDES(x) \ PERL_TSA__(locks_excluded(x)) -/* PERL_TSA_ACQUIRE() is used to annotate functions. - * The caller MUST NOT hold the resource when calling the function, - * and the function will acquire the resource. +/* PERL_TSA_ACQUIRE() is used to annotate functions. The + * caller MUST NOT hold the resource when calling the + * function, and the function will acquire the resource. * * void Foo() PERL_TSA_ACQUIRE(mutex); */ #define PERL_TSA_ACQUIRE(x) \ PERL_TSA__(acquire_capability(x)) -/* PERL_TSA_RELEASE() is used to annotate functions. - * The caller MUST hold the resource when calling the function, - * and the function will release the resource. +/* PERL_TSA_RELEASE() is used to annotate functions. The + * caller MUST hold the resource when calling the + * function, and the function will release the resource. * * void Foo() PERL_TSA_RELEASE(mutex); */ #define PERL_TSA_RELEASE(x) \ PERL_TSA__(release_capability(x)) -/* PERL_TSA_NO_TSA is used to annotate functions. - * Used when being intentionally unsafe, or when the code is too - * complicated for the analysis. Use sparingly. +/* PERL_TSA_NO_TSA is used to annotate functions. Used + * when being intentionally unsafe, or when the code is + * too complicated for the analysis. Use sparingly. * * void Foo() PERL_TSA_NO_TSA; */ #define PERL_TSA_NO_TSA \ PERL_TSA__(no_thread_safety_analysis) -/* There are more annotations/attributes available, see the clang - * documentation for details. */ +/* There are more annotations/attributes available, + * see the clang documentation for details. */ #if defined(USE_ITHREADS) # if defined(WIN32) @@ -3708,16 +3725,16 @@ freeing any remaining Perl interpreters. # include "os2thread.h" # elif defined(I_MACH_CTHREADS) # include -typedef cthread_t perl_os_thread; -typedef mutex_t perl_mutex; -typedef condition_t perl_cond; -typedef void * perl_key; +typedef cthread_t perl_os_thread; +typedef mutex_t perl_mutex; +typedef condition_t perl_cond; +typedef void * perl_key; # elif defined(I_PTHREAD) /* Posix threads */ # include -typedef pthread_t perl_os_thread; +typedef pthread_t perl_os_thread; typedef pthread_mutex_t PERL_TSA_CAPABILITY("mutex") perl_mutex; -typedef pthread_cond_t perl_cond; -typedef pthread_key_t perl_key; +typedef pthread_cond_t perl_cond; +typedef pthread_key_t perl_key; # endif /* Many readers; single writer */ @@ -3732,15 +3749,15 @@ typedef struct { #ifdef PERL_TSA_ACTIVE /* Since most pthread mutex interfaces have not been annotated, we - * need to have these wrappers. The NO_TSA annotation is quite ugly - * but it cannot be avoided in plain C, unlike in C++, where one could - * e.g. use ACQUIRE() with no arg on a mutex lock method. + * need to have these wrappers. The NO_TSA annotation is quite ugly + * but it cannot be avoided in plain C, unlike in C++, where one + * could e.g. use ACQUIRE() with no arg on a mutex lock method. * * The bodies of these wrappers are in util.c * * TODO: however, some platforms are starting to get these clang - * thread safety annotations for pthreads, for example FreeBSD. - * Do we need a way to a bypass these wrappers? */ + * thread safety annotations for pthreads, for example FreeBSD. Do + * we need a way to a bypass these wrappers? */ EXTERN_C int perl_tsa_mutex_lock(perl_mutex* mutex) PERL_TSA_ACQUIRE(*mutex) PERL_TSA_NO_TSA; @@ -3753,289 +3770,288 @@ EXTERN_C int perl_tsa_mutex_unlock(perl_mutex* mutex) # include "win32.h" #endif -#define STATUS_UNIX PL_statusvalue +#define STATUS_UNIX PL_statusvalue #ifdef VMS -# define STATUS_NATIVE PL_statusvalue_vms +# define STATUS_NATIVE PL_statusvalue_vms /* - * vaxc$errno is only guaranteed to be valid if errno == EVMSERR, otherwise - * its contents can not be trusted. Unfortunately, Perl seems to check - * it on exit, so it when PL_statusvalue_vms is updated, vaxc$errno should - * be updated also. - */ + * vaxc$errno is only guaranteed to be valid if errno == EVMSERR, + * otherwise its contents can not be trusted. Unfortunately, + * Perl seems to check it on exit, so it when PL_statusvalue_vms + * is updated, vaxc$errno should be updated also. +*/ # include # include -/* Presume this because if VMS changes it, it will require a new - * set of APIs for waiting on children for binary compatibility. +/* Presume this because if VMS changes it, it will require a new set + * of APIs for waiting on children for binary compatibility. */ -# define child_offset_bits (8) +# define child_offset_bits (8) # ifndef C_FAC_POSIX -# define C_FAC_POSIX 0x35A000 +# define C_FAC_POSIX 0x35A000 # endif -/* STATUS_EXIT - validates and returns a NATIVE exit status code for the - * platform from the existing UNIX or Native status values. +/* STATUS_EXIT - validates and returns a NATIVE exit status code for + * the platform from the existing UNIX or Native status values. */ -# define STATUS_EXIT \ +# define STATUS_EXIT \ (((I32)PL_statusvalue_vms == -1 ? SS$_ABORT : PL_statusvalue_vms) | \ (VMSISH_HUSHED ? STS$M_INHIB_MSG : 0)) -/* STATUS_NATIVE_CHILD_SET - Calculate UNIX status that matches the child - * exit code and shifts the UNIX value over the correct number of bits to - * be a child status. Usually the number of bits is 8, but that could be - * platform dependent. The NATIVE status code is presumed to have either - * from a child process. +/* STATUS_NATIVE_CHILD_SET - Calculate UNIX status that matches the + * child exit code and shifts the UNIX value over the correct + * number of bits to be a child status. Usually the number of bits + * is 8, but that could be platform dependent. The NATIVE status + * code is presumed to have either from a child process. */ /* This is complicated. The child processes return a true native VMS status which must be saved. But there is an assumption in Perl that - the UNIX child status has some relationship to errno values, so - Perl tries to translate it to text in some of the tests. - In order to get the string translation correct, for the error, errno - must be EVMSERR, but that generates a different text message - than what the test programs are expecting. So an errno value must - be derived from the native status value when an error occurs. - That will hide the true native status message. With this version of - perl, the true native child status can always be retrieved so that - is not a problem. But in this case, Pl_statusvalue and errno may - have different values in them. + the UNIX child status has some relationship to errno values, so Perl + tries to translate it to text in some of the tests. In order to get + the string translation correct, for the error, errno must be EVMSERR, + but that generates a different text message than what the test programs + are expecting. So an errno value must be derived from the native + status value when an error occurs. That will hide the true native + status message. With this version of perl, the true native child + status can always be retrieved so that is not a problem. But in this + case, Pl_statusvalue and errno may have different values in them. */ -# define STATUS_NATIVE_CHILD_SET(n) \ - STMT_START { \ - I32 evalue = (I32)n; \ - if (evalue == EVMSERR) { \ - PL_statusvalue_vms = vaxc$errno; \ - PL_statusvalue = evalue; \ - } else { \ - PL_statusvalue_vms = evalue; \ - if (evalue == -1) { \ - PL_statusvalue = -1; \ +# define STATUS_NATIVE_CHILD_SET(n) \ + STMT_START { \ + I32 evalue = (I32)n; \ + if (evalue == EVMSERR) { \ + PL_statusvalue_vms = vaxc$errno; \ + PL_statusvalue = evalue; \ + } else { \ + PL_statusvalue_vms = evalue; \ + if (evalue == -1) { \ + PL_statusvalue = -1; \ PL_statusvalue_vms = SS$_ABORT; /* Should not happen */ \ - } else \ - PL_statusvalue = Perl_vms_status_to_unix(evalue, 1); \ - set_vaxc_errno(evalue); \ - if ((PL_statusvalue_vms & C_FAC_POSIX) == C_FAC_POSIX) \ - set_errno(EVMSERR); \ - else set_errno(Perl_vms_status_to_unix(evalue, 0)); \ - PL_statusvalue = PL_statusvalue << child_offset_bits; \ - } \ + } else \ + PL_statusvalue = Perl_vms_status_to_unix(evalue, 1); \ + set_vaxc_errno(evalue); \ + if ((PL_statusvalue_vms & C_FAC_POSIX) == C_FAC_POSIX) \ + set_errno(EVMSERR); \ + else set_errno(Perl_vms_status_to_unix(evalue, 0)); \ + PL_statusvalue = PL_statusvalue << child_offset_bits; \ + } \ } STMT_END # ifdef VMSISH_STATUS -# define STATUS_CURRENT (VMSISH_STATUS ? STATUS_NATIVE : STATUS_UNIX) +# define STATUS_CURRENT (VMSISH_STATUS ? STATUS_NATIVE : STATUS_UNIX) # else -# define STATUS_CURRENT STATUS_UNIX +# define STATUS_CURRENT STATUS_UNIX # endif - /* STATUS_UNIX_SET - takes a UNIX/POSIX errno value and attempts to update - * the NATIVE status to an equivalent value. Can not be used to translate - * exit code values as exit code values are not guaranteed to have any - * relationship at all to errno values. - * This is used when Perl is forcing errno to have a specific value. + /* STATUS_UNIX_SET - takes a UNIX/POSIX errno value and attempts to + * update the NATIVE status to an equivalent value. Can not be used + * to translate exit code values as exit code values are not + * guaranteed to have any relationship at all to errno values. This + * is used when Perl is forcing errno to have a specific value. */ -# define STATUS_UNIX_SET(n) \ - STMT_START { \ - I32 evalue = (I32)n; \ - PL_statusvalue = evalue; \ - if (PL_statusvalue != -1) { \ - if (PL_statusvalue != EVMSERR) { \ - PL_statusvalue &= 0xFFFF; \ - if (MY_POSIX_EXIT) \ - PL_statusvalue_vms=PL_statusvalue ? SS$_ABORT : SS$_NORMAL;\ - else PL_statusvalue_vms = Perl_unix_status_to_vms(evalue); \ - } \ - else { \ - PL_statusvalue_vms = vaxc$errno; \ - } \ - } \ - else PL_statusvalue_vms = SS$_ABORT; \ - set_vaxc_errno(PL_statusvalue_vms); \ +# define STATUS_UNIX_SET(n) \ + STMT_START { \ + I32 evalue = (I32)n; \ + PL_statusvalue = evalue; \ + if (PL_statusvalue != -1) { \ + if (PL_statusvalue != EVMSERR) { \ + PL_statusvalue &= 0xFFFF; \ + if (MY_POSIX_EXIT) \ + PL_statusvalue_vms=PL_statusvalue ? SS$_ABORT : SS$_NORMAL; \ + else PL_statusvalue_vms = Perl_unix_status_to_vms(evalue); \ + } \ + else { \ + PL_statusvalue_vms = vaxc$errno; \ + } \ + } \ + else PL_statusvalue_vms = SS$_ABORT; \ + set_vaxc_errno(PL_statusvalue_vms); \ } STMT_END - /* STATUS_UNIX_EXIT_SET - Takes a UNIX/POSIX exit code and sets - * the NATIVE error status based on it. + /* STATUS_UNIX_EXIT_SET - Takes a UNIX/POSIX exit code and sets the NATIVE + * error status based on it. * - * When in the default mode to comply with the Perl VMS documentation, - * 0 is a success and any other code sets the NATIVE status to a failure - * code of SS$_ABORT. + * When in the default mode to comply with the Perl VMS documentation, 0 is + * a success and any other code sets the NATIVE status to a failure code of + * SS$_ABORT. * - * In the new POSIX EXIT mode, native status will be set so that the - * actual exit code will can be retrieved by the calling program or - * shell. + * In the new POSIX EXIT mode, native status will be set so that the actual + * exit code will can be retrieved by the calling program or shell. * - * If the exit code is not clearly a UNIX parent or child exit status, - * it will be passed through as a VMS status. + * If the exit code is not clearly a UNIX parent or child exit status, it + * will be passed through as a VMS status. */ -# define STATUS_UNIX_EXIT_SET(n) \ - STMT_START { \ - I32 evalue = (I32)n; \ - PL_statusvalue = evalue; \ - if (MY_POSIX_EXIT) { \ - if (evalue <= 0xFF00) { \ - if (evalue > 0xFF) \ - evalue = ((U8) (evalue >> child_offset_bits)); \ - PL_statusvalue_vms = \ - (C_FAC_POSIX | (evalue << 3 ) | \ - ((evalue == 1) ? (STS$K_ERROR | STS$M_INHIB_MSG) : 1)); \ - } else /* forgive them Perl, for they have sinned */ \ - PL_statusvalue_vms = evalue; \ - } else { \ - if (evalue == 0) \ - PL_statusvalue_vms = SS$_NORMAL; \ - else if (evalue <= 0xFF00) \ - PL_statusvalue_vms = SS$_ABORT; \ - else { /* forgive them Perl, for they have sinned */ \ - if (evalue != EVMSERR) PL_statusvalue_vms = evalue; \ - else PL_statusvalue_vms = vaxc$errno; \ - /* And obviously used a VMS status value instead of UNIX */ \ - PL_statusvalue = EVMSERR; \ - } \ - set_vaxc_errno(PL_statusvalue_vms); \ - } \ +# define STATUS_UNIX_EXIT_SET(n) \ + STMT_START { \ + I32 evalue = (I32)n; \ + PL_statusvalue = evalue; \ + if (MY_POSIX_EXIT) { \ + if (evalue <= 0xFF00) { \ + if (evalue > 0xFF) \ + evalue = ((U8) (evalue >> child_offset_bits)); \ + PL_statusvalue_vms = \ + (C_FAC_POSIX | (evalue << 3 ) | \ + ((evalue == 1) ? (STS$K_ERROR | STS$M_INHIB_MSG) : 1)); \ + } else /* forgive them Perl, for they have sinned */ \ + PL_statusvalue_vms = evalue; \ + } else { \ + if (evalue == 0) \ + PL_statusvalue_vms = SS$_NORMAL; \ + else if (evalue <= 0xFF00) \ + PL_statusvalue_vms = SS$_ABORT; \ + else { /* forgive them Perl, for they have sinned */ \ + if (evalue != EVMSERR) PL_statusvalue_vms = evalue; \ + else PL_statusvalue_vms = vaxc$errno; \ + /* And obviously used a VMS status value instead of UNIX */ \ + PL_statusvalue = EVMSERR; \ + } \ + set_vaxc_errno(PL_statusvalue_vms); \ + } \ } STMT_END - /* STATUS_EXIT_SET - Takes a NATIVE/UNIX/POSIX exit code - * and sets the NATIVE error status based on it. This special case - * is needed to maintain compatibility with past VMS behavior. + /* STATUS_EXIT_SET - Takes a NATIVE/UNIX/POSIX exit code and sets the NATIVE + * error status based on it. This special case is needed to maintain + * compatibility with past VMS behavior. * - * In the default mode on VMS, this number is passed through as - * both the NATIVE and UNIX status. Which makes it different - * that the STATUS_UNIX_EXIT_SET. + * In the default mode on VMS, this number is passed through as both the + * NATIVE and UNIX status. Which makes it different that the + * STATUS_UNIX_EXIT_SET. * - * In the new POSIX EXIT mode, native status will be set so that the - * actual exit code will can be retrieved by the calling program or - * shell. + * In the new POSIX EXIT mode, native status will be set so that the actual + * exit code will can be retrieved by the calling program or shell. * - * A POSIX exit code is from 0 to 255. If the exit code is higher - * than this, it needs to be assumed that it is a VMS exit code and - * passed through. + * A POSIX exit code is from 0 to 255. If the exit code is higher than this, + * it needs to be assumed that it is a VMS exit code and passed through. */ -# define STATUS_EXIT_SET(n) \ - STMT_START { \ - I32 evalue = (I32)n; \ - PL_statusvalue = evalue; \ - if (MY_POSIX_EXIT) \ - if (evalue > 255) PL_statusvalue_vms = evalue; else { \ - PL_statusvalue_vms = \ - (C_FAC_POSIX | (evalue << 3 ) | \ - ((evalue == 1) ? (STS$K_ERROR | STS$M_INHIB_MSG) : 1));} \ - else \ - PL_statusvalue_vms = evalue ? evalue : SS$_NORMAL; \ - set_vaxc_errno(PL_statusvalue_vms); \ +# define STATUS_EXIT_SET(n) \ + STMT_START { \ + I32 evalue = (I32)n; \ + PL_statusvalue = evalue; \ + if (MY_POSIX_EXIT) \ + if (evalue > 255) PL_statusvalue_vms = evalue; else { \ + PL_statusvalue_vms = \ + (C_FAC_POSIX | (evalue << 3 ) | \ + ((evalue == 1) ? (STS$K_ERROR | STS$M_INHIB_MSG) : 1));} \ + else \ + PL_statusvalue_vms = evalue ? evalue : SS$_NORMAL; \ + set_vaxc_errno(PL_statusvalue_vms); \ } STMT_END /* This macro forces a success status */ -# define STATUS_ALL_SUCCESS \ +# define STATUS_ALL_SUCCESS \ (PL_statusvalue = 0, PL_statusvalue_vms = SS$_NORMAL) /* This macro forces a failure status */ -# define STATUS_ALL_FAILURE (PL_statusvalue = 1, \ - vaxc$errno = PL_statusvalue_vms = MY_POSIX_EXIT ? \ - (C_FAC_POSIX | (1 << 3) | STS$K_ERROR | STS$M_INHIB_MSG) : SS$_ABORT) +# define STATUS_ALL_FAILURE \ + (PL_statusvalue = 1, \ + vaxc$errno = PL_statusvalue_vms = MY_POSIX_EXIT ? \ + (C_FAC_POSIX | (1 << 3) | STS$K_ERROR | STS$M_INHIB_MSG) : SS$_ABORT) #elif defined(__amigaos4__) /* A somewhat experimental attempt to simulate posix return code values */ -# define STATUS_NATIVE PL_statusvalue_posix -# define STATUS_NATIVE_CHILD_SET(n) \ - STMT_START { \ - PL_statusvalue_posix = (n); \ - if (PL_statusvalue_posix < 0) { \ - PL_statusvalue = -1; \ - } \ - else { \ - PL_statusvalue = n << 8; \ - } \ +# define STATUS_NATIVE PL_statusvalue_posix +# define STATUS_NATIVE_CHILD_SET(n) \ + STMT_START { \ + PL_statusvalue_posix = (n); \ + if (PL_statusvalue_posix < 0) { \ + PL_statusvalue = -1; \ + } \ + else { \ + PL_statusvalue = n << 8; \ + } \ } STMT_END -# define STATUS_UNIX_SET(n) \ - STMT_START { \ - PL_statusvalue = (n); \ - if (PL_statusvalue != -1) \ - PL_statusvalue &= 0xFFFF; \ +# define STATUS_UNIX_SET(n) \ + STMT_START { \ + PL_statusvalue = (n); \ + if (PL_statusvalue != -1) \ + PL_statusvalue &= 0xFFFF; \ } STMT_END # define STATUS_UNIX_EXIT_SET(n) STATUS_UNIX_SET(n) -# define STATUS_EXIT_SET(n) STATUS_UNIX_SET(n) -# define STATUS_CURRENT STATUS_UNIX -# define STATUS_EXIT STATUS_UNIX -# define STATUS_ALL_SUCCESS (PL_statusvalue = 0, PL_statusvalue_posix = 0) -# define STATUS_ALL_FAILURE (PL_statusvalue = 1, PL_statusvalue_posix = 1) +# define STATUS_EXIT_SET(n) STATUS_UNIX_SET(n) +# define STATUS_CURRENT STATUS_UNIX +# define STATUS_EXIT STATUS_UNIX +# define STATUS_ALL_SUCCESS (PL_statusvalue = 0, PL_statusvalue_posix = 0) +# define STATUS_ALL_FAILURE (PL_statusvalue = 1, PL_statusvalue_posix = 1) #else -# define STATUS_NATIVE PL_statusvalue_posix +# define STATUS_NATIVE PL_statusvalue_posix # if defined(WCOREDUMP) -# define STATUS_NATIVE_CHILD_SET(n) \ - STMT_START { \ - PL_statusvalue_posix = (n); \ - if (PL_statusvalue_posix == -1) \ - PL_statusvalue = -1; \ - else { \ - PL_statusvalue = \ +# define STATUS_NATIVE_CHILD_SET(n) \ + STMT_START { \ + PL_statusvalue_posix = (n); \ + if (PL_statusvalue_posix == -1) \ + PL_statusvalue = -1; \ + else { \ + PL_statusvalue = \ (WIFEXITED(PL_statusvalue_posix) ? (WEXITSTATUS(PL_statusvalue_posix) << 8) : 0) | \ (WIFSIGNALED(PL_statusvalue_posix) ? (WTERMSIG(PL_statusvalue_posix) & 0x7F) : 0) | \ (WIFSIGNALED(PL_statusvalue_posix) && WCOREDUMP(PL_statusvalue_posix) ? 0x80 : 0); \ - } \ + } \ } STMT_END # elif defined(WIFEXITED) -# define STATUS_NATIVE_CHILD_SET(n) \ - STMT_START { \ - PL_statusvalue_posix = (n); \ - if (PL_statusvalue_posix == -1) \ - PL_statusvalue = -1; \ - else { \ - PL_statusvalue = \ +# define STATUS_NATIVE_CHILD_SET(n) \ + STMT_START { \ + PL_statusvalue_posix = (n); \ + if (PL_statusvalue_posix == -1) \ + PL_statusvalue = -1; \ + else { \ + PL_statusvalue = \ (WIFEXITED(PL_statusvalue_posix) ? (WEXITSTATUS(PL_statusvalue_posix) << 8) : 0) | \ (WIFSIGNALED(PL_statusvalue_posix) ? (WTERMSIG(PL_statusvalue_posix) & 0x7F) : 0); \ - } \ + } \ } STMT_END # else -# define STATUS_NATIVE_CHILD_SET(n) \ - STMT_START { \ - PL_statusvalue_posix = (n); \ - if (PL_statusvalue_posix == -1) \ - PL_statusvalue = -1; \ - else { \ - PL_statusvalue = \ - PL_statusvalue_posix & 0xFFFF; \ - } \ +# define STATUS_NATIVE_CHILD_SET(n) \ + STMT_START { \ + PL_statusvalue_posix = (n); \ + if (PL_statusvalue_posix == -1) \ + PL_statusvalue = -1; \ + else { \ + PL_statusvalue = \ + PL_statusvalue_posix & 0xFFFF; \ + } \ } STMT_END # endif -# define STATUS_UNIX_SET(n) \ - STMT_START { \ - PL_statusvalue = (n); \ - if (PL_statusvalue != -1) \ - PL_statusvalue &= 0xFFFF; \ +# define STATUS_UNIX_SET(n) \ + STMT_START { \ + PL_statusvalue = (n); \ + if (PL_statusvalue != -1) \ + PL_statusvalue &= 0xFFFF; \ } STMT_END # define STATUS_UNIX_EXIT_SET(n) STATUS_UNIX_SET(n) -# define STATUS_EXIT_SET(n) STATUS_UNIX_SET(n) -# define STATUS_CURRENT STATUS_UNIX -# define STATUS_EXIT STATUS_UNIX -# define STATUS_ALL_SUCCESS (PL_statusvalue = 0, PL_statusvalue_posix = 0) -# define STATUS_ALL_FAILURE (PL_statusvalue = 1, PL_statusvalue_posix = 1) +# define STATUS_EXIT_SET(n) STATUS_UNIX_SET(n) +# define STATUS_CURRENT STATUS_UNIX +# define STATUS_EXIT STATUS_UNIX +# define STATUS_ALL_SUCCESS (PL_statusvalue = 0, PL_statusvalue_posix = 0) +# define STATUS_ALL_FAILURE (PL_statusvalue = 1, PL_statusvalue_posix = 1) #endif /* flags in PL_exit_flags for nature of exit() */ -#define PERL_EXIT_EXPECTED 0x01 -#define PERL_EXIT_DESTRUCT_END 0x02 /* Run END in perl_destruct */ -#define PERL_EXIT_WARN 0x04 /* Warn if Perl_my_exit() or Perl_my_failure_exit() called */ -#define PERL_EXIT_ABORT 0x08 /* Call abort() if Perl_my_exit() or Perl_my_failure_exit() called */ +#define PERL_EXIT_EXPECTED 0x01 +#define PERL_EXIT_DESTRUCT_END 0x02 /* Run END in perl_destruct */ +#define PERL_EXIT_WARN 0x04 /* Warn if Perl_my_exit() or + Perl_my_failure_exit() called */ +#define PERL_EXIT_ABORT 0x08 /* Call abort() if Perl_my_exit() or + Perl_my_failure_exit() called */ #ifndef PERL_CORE /* format to use for version numbers in file/directory names */ /* XXX move to Configure? */ -/* This was only ever used for the current version, and that can be done at - compile time, as PERL_FS_VERSION, so should we just delete it? */ +/* This was only ever used for the current version, and that can be done + at compile time, as PERL_FS_VERSION, so should we just delete it? */ # ifndef PERL_FS_VER_FMT -# define PERL_FS_VER_FMT "%d.%d.%d" +# define PERL_FS_VER_FMT "%d.%d.%d" # endif #endif #ifndef PERL_FS_VERSION -# define PERL_FS_VERSION PERL_VERSION_STRING +# define PERL_FS_VERSION PERL_VERSION_STRING #endif /* @@ -4043,43 +4059,43 @@ EXTERN_C int perl_tsa_mutex_unlock(perl_mutex* mutex) =for apidoc_section $io =for apidoc Amn|void|PERL_FLUSHALL_FOR_CHILD -This defines a way to flush all output buffers. This may be a -performance issue, so we allow people to disable it. Also, if -we are using stdio, there are broken implementations of fflush(NULL) -out there, Solaris being the most prominent. +This defines a way to flush all output buffers. This may be +a performance issue, so we allow people to disable it. Also, +if we are using stdio, there are broken implementations of +fflush(NULL) out there, Solaris being the most prominent. =cut - */ +*/ #ifndef PERL_FLUSHALL_FOR_CHILD # if defined(USE_PERLIO) || defined(FFLUSH_NULL) -# define PERL_FLUSHALL_FOR_CHILD PerlIO_flush((PerlIO*)NULL) +# define PERL_FLUSHALL_FOR_CHILD PerlIO_flush((PerlIO*)NULL) # elif defined(FFLUSH_ALL) -# define PERL_FLUSHALL_FOR_CHILD my_fflush_all() +# define PERL_FLUSHALL_FOR_CHILD my_fflush_all() # else -# define PERL_FLUSHALL_FOR_CHILD NOOP +# define PERL_FLUSHALL_FOR_CHILD NOOP # endif #endif #ifndef PERL_WAIT_FOR_CHILDREN -# define PERL_WAIT_FOR_CHILDREN NOOP +# define PERL_WAIT_FOR_CHILDREN NOOP #endif /* the traditional thread-unsafe notion of "current interpreter". */ #ifndef PERL_SET_INTERP -# define PERL_SET_INTERP(i) \ - STMT_START { PL_curinterp = (PerlInterpreter*)(i); \ - PERL_SET_NON_tTHX_CONTEXT(i); \ - } STMT_END +# define PERL_SET_INTERP(i) \ + STMT_START { PL_curinterp = (PerlInterpreter*)(i); \ + PERL_SET_NON_tTHX_CONTEXT(i); \ + } STMT_END #endif #ifndef PERL_GET_INTERP -# define PERL_GET_INTERP (PL_curinterp) +# define PERL_GET_INTERP (PL_curinterp) #endif #if defined(MULTIPLICITY) && !defined(PERL_GET_THX) -# define PERL_GET_THX ((PerlInterpreter *)PERL_GET_CONTEXT) -# define PERL_SET_THX(t) PERL_SET_CONTEXT(t) +# define PERL_GET_THX ((PerlInterpreter *)PERL_GET_CONTEXT) +# define PERL_SET_THX(t) PERL_SET_CONTEXT(t) #endif /* @@ -4095,58 +4111,58 @@ out there, Solaris being the most prominent. */ #ifndef SVf_ -# define SVf_(n) "-" STRINGIFY(n) "p" +# define SVf_(n) "-" STRINGIFY(n) "p" #endif #ifndef SVf -# define SVf "-p" +# define SVf "-p" #endif #ifndef SVf32 -# define SVf32 SVf_(32) +# define SVf32 SVf_(32) #endif #ifndef SVf256 -# define SVf256 SVf_(256) +# define SVf256 SVf_(256) #endif -#define SVfARG(p) ((void*)(p)) +#define SVfARG(p) ((void*)(p)) -/* Render an SV as a quoted and escaped string suitable for an error message. - * Only shows the first PERL_QUOTEDPREFIX_LEN characters, and adds ellipses if the - * string is too long. +/* Render an SV as a quoted and escaped string suitable for an + * error message. Only shows the first PERL_QUOTEDPREFIX_LEN + * characters, and adds ellipses if the string is too long. */ #ifndef PERL_QUOTEDPREFIX_LEN -# define PERL_QUOTEDPREFIX_LEN 256 +# define PERL_QUOTEDPREFIX_LEN 256 #endif #ifndef SVf_QUOTEDPREFIX -# define SVf_QUOTEDPREFIX "5p" +# define SVf_QUOTEDPREFIX "5p" #endif /* like %s but runs through the quoted prefix logic */ #ifndef PVf_QUOTEDPREFIX -# define PVf_QUOTEDPREFIX "1p" +# define PVf_QUOTEDPREFIX "1p" #endif #ifndef HEKf -# define HEKf "2p" +# define HEKf "2p" #endif #ifndef HEKf_QUOTEDPREFIX -# define HEKf_QUOTEDPREFIX "7p" +# define HEKf_QUOTEDPREFIX "7p" #endif -/* Not ideal, but we cannot easily include a number in an already-numeric - * format sequence. */ +/* Not ideal, but we cannot easily include a number + * in an already-numeric format sequence. */ #ifndef HEKf256 -# define HEKf256 "3p" +# define HEKf256 "3p" #endif #ifndef HEKf256_QUOTEDPREFIX # define HEKf256_QUOTEDPREFIX "8p" #endif -#define HEKfARG(p) ((void*)(p)) +#define HEKfARG(p) ((void*)(p)) /* Documented in perlguts * @@ -4154,37 +4170,36 @@ out there, Solaris being the most prominent. * They only occur when prefixed by specific other formats. */ #ifndef UTF8f -# define UTF8f "d%" UVuf "%4p" +# define UTF8f "d%" UVuf "%4p" #endif #ifndef UTF8f_QUOTEDPREFIX # define UTF8f_QUOTEDPREFIX "d%" UVuf "%9p" #endif #define UTF8fARG(u,l,p) (int)cBOOL(u), (UV)(l), (void*)(p) -#define PNf UTF8f -#define PNfARG(pn) (int)1, (UV)PadnameLEN(pn), (void *)PadnamePV(pn) +#define PNf UTF8f +#define PNfARG(pn) (int)1, (UV)PadnameLEN(pn), (void *)PadnamePV(pn) -#define HvNAMEf "6p" +#define HvNAMEf "6p" #define HvNAMEf_QUOTEDPREFIX "10p" -#define HvNAMEfARG(hv) ((void*)(hv)) +#define HvNAMEfARG(hv) ((void*)(hv)) #ifdef PERL_CORE /* not used; but needed for backward compatibility with XS code? - RMB -=for apidoc_section $io_formats -=for apidoc AmnD|const char *|UVf + =for apidoc_section $io_formats =for apidoc AmnD|const char *|UVf -Obsolete form of C, which you should convert to instead use + Obsolete form of C, which you should convert to instead use -=cut -*/ + =cut + */ # undef UVf #elif !defined(UVf) -# define UVf UVuf +# define UVf UVuf #endif #if !defined(DEBUGGING) && !defined(NDEBUG) -# define NDEBUG 1 +# define NDEBUG 1 #endif #include @@ -4192,15 +4207,15 @@ Obsolete form of C, which you should convert to instead use appropriate to call return. In either case, include the lint directive. */ #ifdef HASATTRIBUTE_NORETURN -# define NORETURN_FUNCTION_END NOT_REACHED; +# define NORETURN_FUNCTION_END NOT_REACHED; #else -# define NORETURN_FUNCTION_END NOT_REACHED; return 0 +# define NORETURN_FUNCTION_END NOT_REACHED; return 0 #endif #ifdef HAS_BUILTIN_EXPECT -# define EXPECT(expr,val) __builtin_expect(expr,val) +# define EXPECT(expr,val) __builtin_expect(expr,val) #else -# define EXPECT(expr,val) (expr) +# define EXPECT(expr,val) (expr) #endif /* @@ -4218,8 +4233,8 @@ hint to the compiler that this condition is likely to be false. =cut */ -#define LIKELY(cond) EXPECT(cBOOL(cond),TRUE) -#define UNLIKELY(cond) EXPECT(cBOOL(cond),FALSE) +#define LIKELY(cond) EXPECT(cBOOL(cond),TRUE) +#define UNLIKELY(cond) EXPECT(cBOOL(cond),FALSE) #ifdef HAS_BUILTIN_CHOOSE_EXPR /* placeholder */ @@ -4237,45 +4252,47 @@ hint to the compiler that this condition is likely to be false. STATIC_ASSERT_STMT expands to a statement and is suitable for use inside a function. */ -#if (! defined(__IBMC__) || __IBMC__ >= 1210) \ - && (( defined(static_assert) && ( defined(_ISOC11_SOURCE) \ - || (__STDC_VERSION__ - 0) >= 201101L)) \ - || (defined(__cplusplus) && __cplusplus >= 201103L)) -/* XXX static_assert is a macro defined in in C11 or a compiler - builtin in C++11. But IBM XL C V11 does not support _Static_assert, no - matter what says. -*/ -# define STATIC_ASSERT_DECL(COND) static_assert(COND, #COND) +#if (! defined(__IBMC__) || \ + __IBMC__ >= 1210) \ + && (( defined(static_assert) && ( defined(_ISOC11_SOURCE) \ + || (__STDC_VERSION__ - 0) >= 201101L)) \ + || (defined(__cplusplus) && __cplusplus >= 201103L)) +/* XXX static_assert is a macro defined in in C11 + or a compiler builtin in C++11. But IBM XL C V11 does not + support _Static_assert, no matter what says. + */ +# define STATIC_ASSERT_DECL(COND) static_assert(COND, #COND) #else -/* We use a bit-field instead of an array because gcc accepts - 'typedef char x[n]' where n is not a compile-time constant. - We want to enforce constantness. -*/ -# define STATIC_ASSERT_2(COND, SUFFIX) \ - typedef struct { \ - unsigned int _static_assertion_failed_##SUFFIX : (COND) ? 1 : -1; \ - } _static_assertion_failed_##SUFFIX PERL_UNUSED_DECL +/* We use a bit-field instead of an array because gcc + accepts 'typedef char x[n]' where n is not a compile-time + constant. We want to enforce constantness. + */ +# define STATIC_ASSERT_2(COND, SUFFIX) \ + typedef struct { \ + unsigned int _static_assertion_failed_##SUFFIX : (COND) ? 1 : -1; \ + } _static_assertion_failed_##SUFFIX PERL_UNUSED_DECL # define STATIC_ASSERT_1(COND, SUFFIX) STATIC_ASSERT_2(COND, SUFFIX) # define STATIC_ASSERT_DECL(COND) STATIC_ASSERT_1(COND, __LINE__) #endif /* We need this wrapper even in C11 because 'case X: static_assert(...);' is an error (static_assert is a declaration, and only statements can have labels). */ -#define STATIC_ASSERT_STMT(COND) STMT_START { STATIC_ASSERT_DECL(COND); } STMT_END +#define STATIC_ASSERT_STMT(COND) \ + STMT_START { STATIC_ASSERT_DECL(COND); } STMT_END #ifndef __has_builtin -# define __has_builtin(x) 0 /* not a clang style compiler */ +# define __has_builtin(x) 0 /* not a clang style compiler */ #endif /* =for apidoc Am||ASSUME|bool expr -C is like C, but it has a benefit in a release build. It is a -hint to a compiler about a statement of fact in a function call free -expression, which allows the compiler to generate better machine code. In a -debug build, C is a synonym for C. C means the -control path is unreachable. In a for loop, C can be used to hint that -a loop will run at least X times. C is based off MSVC's C<__assume> -intrinsic function, see its documents for more details. +C is like C, but it has a benefit in a release build. It +is a hint to a compiler about a statement of fact in a function call free +expression, which allows the compiler to generate better machine code. In +a debug build, C is a synonym for C. C +means the control path is unreachable. In a for loop, C can be +used to hint that a loop will run at least X times. C is based off +MSVC's C<__assume> intrinsic function, see its documents for more details. =cut */ @@ -4287,76 +4304,76 @@ intrinsic function, see its documents for more details. #endif #ifdef DEBUGGING -# define ASSUME(x) assert(x) +# define ASSUME(x) assert(x) #elif __has_builtin(__builtin_assume) # if defined(__clang__) || defined(__clang) -# define ASSUME(x) CLANG_DIAG_IGNORE(-Wassume) \ - __builtin_assume (x) \ - CLANG_DIAG_RESTORE +# define ASSUME(x) \ + CLANG_DIAG_IGNORE(-Wassume) \ + __builtin_assume (x) \ + CLANG_DIAG_RESTORE # else -# define ASSUME(x) __builtin_assume(x) +# define ASSUME(x) __builtin_assume(x) # endif #elif defined(_MSC_VER) -# define ASSUME(x) __assume(x) +# define ASSUME(x) __assume(x) #elif defined(__ARMCC_VERSION) /* untested */ -# define ASSUME(x) __promise(x) +# define ASSUME(x) __promise(x) #elif defined(HAS_BUILTIN_UNREACHABLE) /* Compilers can take the hint from something being unreachable */ -# define ASSUME(x) ((x) ? (void) 0 : __builtin_unreachable()) +# define ASSUME(x) ((x) ? (void) 0 : __builtin_unreachable()) #else - /* Not DEBUGGING, so assert() is a no-op, but a random compiler might - * define assert() to its own special optimization token so pass it through - * to C lib as a last resort */ -# define ASSUME(x) assert(x) + /* Not DEBUGGING, so assert() is a no-op, but a random compiler + * might define assert() to its own special optimization token + * so pass it through to C lib as a last resort */ +# define ASSUME(x) assert(x) #endif #ifdef HAS_BUILTIN_UNREACHABLE -# define NOT_REACHED \ - STMT_START { \ - ASSUME(!"UNREACHABLE"); __builtin_unreachable(); \ - } STMT_END +# define NOT_REACHED \ + STMT_START { \ + ASSUME(!"UNREACHABLE"); __builtin_unreachable(); \ + } STMT_END # undef HAS_BUILTIN_UNREACHABLE /* Don't leak out this internal symbol */ #elif ! defined(__GNUC__) && (defined(__sun) || defined(__hpux)) /* These just complain that NOT_REACHED isn't reached */ # define NOT_REACHED #else -# define NOT_REACHED ASSUME(!"UNREACHABLE") +# define NOT_REACHED ASSUME(!"UNREACHABLE") #endif /* Some unistd.h's give a prototype for pause() even though HAS_PAUSE ends up undefined. This causes the #define below to be rejected by the compiler. Sigh. -*/ + */ #ifdef HAS_PAUSE -#define Pause pause +#define Pause pause #else -#define Pause() sleep((32767<<16)+32767) +#define Pause() sleep((32767<<16)+32767) #endif #ifndef IOCPARM_LEN # ifdef IOCPARM_MASK /* on BSDish systems we're safe */ -# define IOCPARM_LEN(x) (((x) >> 16) & IOCPARM_MASK) +# define IOCPARM_LEN(x) (((x) >> 16) & IOCPARM_MASK) # elif defined(_IOC_SIZE) && defined(__GLIBC__) /* on Linux systems we're safe; except when we're not [perl #38223] */ -# define IOCPARM_LEN(x) (_IOC_SIZE(x) < 256 ? 256 : _IOC_SIZE(x)) +# define IOCPARM_LEN(x) (_IOC_SIZE(x) < 256 ? 256 : _IOC_SIZE(x)) # else /* otherwise guess at what's safe */ -# define IOCPARM_LEN(x) 256 +# define IOCPARM_LEN(x) 256 # endif #endif #if defined(__CYGWIN__) -/* USEMYBINMODE - * This symbol, if defined, indicates that the program should - * use the routine my_binmode(FILE *fp, char iotype, int mode) to insure - * that a file is in "binary" mode -- that is, that no translation - * of bytes occurs on read or write operations. +/* USEMYBINMODE This symbol, if defined, indicates that the program + * should use the routine my_binmode(FILE *fp, char iotype, int + * mode) to insure that a file is in "binary" mode -- that is, that + * no translation of bytes occurs on read or write operations. */ -# define USEMYBINMODE /**/ +# define USEMYBINMODE /**/ # include /* for setmode() prototype */ -# define my_binmode(fp, iotype, mode) \ - cBOOL(PerlLIO_setmode(fileno(fp), mode) != -1) +# define my_binmode(fp, iotype, mode) \ + cBOOL(PerlLIO_setmode(fileno(fp), mode) != -1) #endif #ifdef __CYGWIN__ @@ -4367,60 +4384,59 @@ void init_os_extras(void); UNION_ANY_DEFINITION; #else union any { - void* any_ptr; - SV* any_sv; - SV** any_svp; - GV* any_gv; - AV* any_av; - HV* any_hv; - OP* any_op; - char* any_pv; - char** any_pvp; - I32 any_i32; - U32 any_u32; - IV any_iv; - UV any_uv; - long any_long; - bool any_bool; - Size_t any_size; - SSize_t any_ssize; - STRLEN any_strlen; - void (*any_dptr) (void*); - void (*any_dxptr) (pTHX_ void*); + void *any_ptr; + SV *any_sv; + SV **any_svp; + GV *any_gv; + AV *any_av; + HV *any_hv; + OP *any_op; + char *any_pv; + char **any_pvp; + I32 any_i32; + U32 any_u32; + IV any_iv; + UV any_uv; + long any_long; + bool any_bool; + Size_t any_size; + SSize_t any_ssize; + STRLEN any_strlen; + void (*any_dptr) (void*); + void (*any_dxptr)(pTHX_ void*); }; #endif typedef I32 (*filter_t) (pTHX_ int, SV *, int); -#define FILTER_READ(idx, sv, len) filter_read(idx, sv, len) -#define FILTER_DATA(idx) \ - (PL_parser ? AvARRAY(PL_parser->rsfp_filters)[idx] : NULL) -#define FILTER_ISREADER(idx) \ - (PL_parser && PL_parser->rsfp_filters \ - && idx >= AvFILLp(PL_parser->rsfp_filters)) -#define PERL_FILTER_EXISTS(i) \ - (PL_parser && PL_parser->rsfp_filters \ - && (Size_t) (i) < av_count(PL_parser->rsfp_filters)) +#define FILTER_READ(idx, sv, len) filter_read(idx, sv, len) +#define FILTER_DATA(idx) \ + (PL_parser ? AvARRAY(PL_parser->rsfp_filters)[idx] : NULL) +#define FILTER_ISREADER(idx) \ + (PL_parser && PL_parser->rsfp_filters \ + && idx >= AvFILLp(PL_parser->rsfp_filters)) +#define PERL_FILTER_EXISTS(i) \ + (PL_parser && PL_parser->rsfp_filters \ + && (Size_t) (i) < av_count(PL_parser->rsfp_filters)) #if defined(_AIX) && !defined(_AIX43) #if defined(USE_REENTRANT) || defined(_REENTRANT) || defined(_THREAD_SAFE) /* We cannot include to get the struct crypt_data * because of setkey prototype problems when threading */ -typedef struct crypt_data { /* straight from /usr/include/crypt.h */ - /* From OSF, Not needed in AIX - char C[28], D[28]; - */ - char E[48]; - char KS[16][48]; - char block[66]; - char iobuf[16]; +typedef struct crypt_data { /* straight from /usr/include/crypt.h */ + /* From OSF, Not needed in AIX char C[28], D[28]; + */ + char E[48]; + char KS[16][48]; + char block[66]; + char iobuf[16]; } CRYPTD; #endif /* threading */ #endif /* AIX */ #ifndef PERL_CALLCONV # ifdef __cplusplus -# define PERL_CALLCONV EXTERN_C +# define PERL_CALLCONV EXTERN_C # else # define PERL_CALLCONV # endif @@ -4429,22 +4445,22 @@ typedef struct crypt_data { /* straight from /usr/include/crypt.h */ # define PERL_CALLCONV_NO_RET PERL_CALLCONV #endif -/* PERL_STATIC_NO_RET is supposed to be equivalent to STATIC on builds that - dont have a noreturn as a declaration specifier -*/ +/* PERL_STATIC_NO_RET is supposed to be equivalent to STATIC on + builds that dont have a noreturn as a declaration specifier + */ #ifndef PERL_STATIC_NO_RET -# define PERL_STATIC_NO_RET STATIC +# define PERL_STATIC_NO_RET STATIC #endif /* PERL_STATIC_INLINE_NO_RET is supposed to be equivalent to PERL_STATIC_INLINE * on builds that dont have a noreturn as a declaration specifier -*/ + */ #ifndef PERL_STATIC_INLINE_NO_RET -# define PERL_STATIC_INLINE_NO_RET PERL_STATIC_INLINE +# define PERL_STATIC_INLINE_NO_RET PERL_STATIC_INLINE #endif #ifndef PERL_STATIC_FORCE_INLINE -# define PERL_STATIC_FORCE_INLINE PERL_STATIC_INLINE +# define PERL_STATIC_FORCE_INLINE PERL_STATIC_INLINE #endif #ifndef PERL_STATIC_FORCE_INLINE_NO_RET @@ -4477,23 +4493,23 @@ typedef struct crypt_data { /* straight from /usr/include/crypt.h */ /* macros to define bit-fields in structs. */ #ifndef PERL_BITFIELD8 # ifdef HAS_NON_INT_BITFIELDS -# define PERL_BITFIELD8 U8 +# define PERL_BITFIELD8 U8 # else -# define PERL_BITFIELD8 unsigned +# define PERL_BITFIELD8 unsigned # endif #endif #ifndef PERL_BITFIELD16 # ifdef HAS_NON_INT_BITFIELDS -# define PERL_BITFIELD16 U16 +# define PERL_BITFIELD16 U16 # else -# define PERL_BITFIELD16 unsigned +# define PERL_BITFIELD16 unsigned # endif #endif #ifndef PERL_BITFIELD32 # ifdef HAS_NON_INT_BITFIELDS -# define PERL_BITFIELD32 U32 +# define PERL_BITFIELD32 U32 # else -# define PERL_BITFIELD32 unsigned +# define PERL_BITFIELD32 unsigned # endif #endif @@ -4515,8 +4531,8 @@ typedef struct crypt_data { /* straight from /usr/include/crypt.h */ #include "utf8.h" /* these would be in doio.h if there was such a file */ -#define my_stat() my_stat_flags(SV_GMAGIC) -#define my_lstat() my_lstat_flags(SV_GMAGIC) +#define my_stat() my_stat_flags(SV_GMAGIC) +#define my_lstat() my_lstat_flags(SV_GMAGIC) /* defined in sv.c, but also used in [ach]v.c */ #undef _XPV_HEAD @@ -4525,18 +4541,18 @@ typedef struct crypt_data { /* straight from /usr/include/crypt.h */ #include "parser.h" -typedef struct magic_state MGS; /* struct magic_state defined in mg.c */ +typedef struct magic_state MGS; /* struct magic_state defined in mg.c */ #if defined(PERL_IN_REGEX_ENGINE) || defined(PERL_EXT_RE_BUILD) -/* These have to be predeclared, as they are used in proto.h which is #included - * before their definitions in regcomp.h. */ +/* These have to be predeclared, as they are used in proto.h which + * is #included before their definitions in regcomp.h. */ struct scan_data_t; typedef struct regnode_charclass regnode_charclass; -/* A hopefully less confusing name. The sub-classes are all Posix classes only - * used under /l matching */ +/* A hopefully less confusing name. The sub-classes are + * all Posix classes only used under /l matching */ typedef struct regnode_charclass_posixl regnode_charclass_class; typedef struct regnode_charclass_posixl regnode_charclass_posixl; @@ -4548,18 +4564,18 @@ typedef struct scan_data_t scan_data_t; #endif struct ptr_tbl_ent { - struct ptr_tbl_ent* next; - const void* oldval; - void* newval; + struct ptr_tbl_ent *next; + const void *oldval; + void *newval; }; struct ptr_tbl { - struct ptr_tbl_ent** tbl_ary; - UV tbl_max; - UV tbl_items; - struct ptr_tbl_arena *tbl_arena; - struct ptr_tbl_ent *tbl_arena_next; - struct ptr_tbl_ent *tbl_arena_end; + struct ptr_tbl_ent **tbl_ary; + UV tbl_max; + UV tbl_items; + struct ptr_tbl_arena *tbl_arena; + struct ptr_tbl_ent *tbl_arena_next; + struct ptr_tbl_ent *tbl_arena_end; }; #if defined(htonl) && !defined(HAS_HTONL) @@ -4581,19 +4597,19 @@ struct ptr_tbl { #define HAS_NTOHL # if (BYTEORDER & 0xffff) == 0x4321 /* Big endian system, so ntohl, ntohs, htonl and htons do not need to - re-order their values. However, to behave identically to the alternative - implementations, they should truncate to the correct size. */ -# define ntohl(x) ((x)&0xFFFFFFFF) -# define htonl(x) ntohl(x) -# define ntohs(x) ((x)&0xFFFF) -# define htons(x) ntohs(x) + re-order their values. However, to behave identically to the alternative + implementations, they should truncate to the correct size. */ +# define ntohl(x) ((x)&0xFFFFFFFF) +# define htonl(x) ntohl(x) +# define ntohs(x) ((x)&0xFFFF) +# define htons(x) ntohs(x) # elif BYTEORDER == 0x1234 || BYTEORDER == 0x12345678 -/* Note that we can't straight out declare our own htonl and htons because - the Win32 build process forcibly undefines HAS_HTONL etc for its miniperl, - to avoid the overhead of initialising the socket subsystem, but the headers - that *declare* the various functions are still seen. If we declare our own - htonl etc they will clash with the declarations in the Win32 headers. */ +/* Note that we can't straight out declare our own htonl and htons because the + Win32 build process forcibly undefines HAS_HTONL etc for its miniperl, to + avoid the overhead of initialising the socket subsystem, but the headers + that *declare* the various functions are still seen. If we declare our own + htonl etc they will clash with the declarations in the Win32 headers. */ PERL_STATIC_INLINE U32 my_swap32(const U32 x) { @@ -4606,15 +4622,15 @@ my_swap16(const U16 x) { return ((x & 0xFF) << 8) | ((x >> 8) & 0xFF); } -# define htonl(x) my_swap32(x) -# define ntohl(x) my_swap32(x) -# define ntohs(x) my_swap16(x) -# define htons(x) my_swap16(x) +# define htonl(x) my_swap32(x) +# define ntohl(x) my_swap32(x) +# define ntohs(x) my_swap16(x) +# define htons(x) my_swap16(x) # else # error "Unsupported byteorder" /* The C pre-processor doesn't let us return the value of BYTEORDER as part of - the error message. Please check the value of the macro BYTEORDER, as defined - in config.h. The values of BYTEORDER we expect are + the error message. Please check the value of the macro BYTEORDER, as + defined in config.h. The values of BYTEORDER we expect are big endian little endian 32 bit 0x4321 0x1234 @@ -4622,98 +4638,100 @@ my_swap16(const U16 x) { If you have a system with a different byte order, please see pod/perlhack.pod for how to submit a patch to add supporting code. -*/ + */ # endif #endif /* - * Little-endian byte order functions - 'v' for 'VAX', or 'reVerse'. - * -DWS - */ + * Little-endian byte order functions - 'v' for 'VAX', or 'reVerse'. -DWS +*/ #if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678 /* Little endian system, so vtohl, vtohs, htovl and htovs do not need to - re-order their values. However, to behave identically to the alternative - implementations, they should truncate to the correct size. */ -# define vtohl(x) ((x)&0xFFFFFFFF) -# define vtohs(x) ((x)&0xFFFF) -# define htovl(x) vtohl(x) -# define htovs(x) vtohs(x) + re-order their values. However, to behave identically to the alternative + implementations, they should truncate to the correct size. */ +# define vtohl(x) ((x)&0xFFFFFFFF) +# define vtohs(x) ((x)&0xFFFF) +# define htovl(x) vtohl(x) +# define htovs(x) vtohs(x) #elif BYTEORDER == 0x4321 || BYTEORDER == 0x87654321 -# define vtohl(x) ((((x)&0xFF)<<24) \ - +(((x)>>24)&0xFF) \ - +(((x)&0x0000FF00)<<8) \ - +(((x)&0x00FF0000)>>8) ) -# define vtohs(x) ((((x)&0xFF)<<8) + (((x)>>8)&0xFF)) -# define htovl(x) vtohl(x) -# define htovs(x) vtohs(x) +# define vtohl(x) \ + ((((x)&0xFF)<<24) \ + +(((x)>>24)&0xFF) \ + +(((x)&0x0000FF00)<<8) \ + +(((x)&0x00FF0000)>>8) ) +# define vtohs(x) ((((x)&0xFF)<<8) + (((x)>>8)&0xFF)) +# define htovl(x) vtohl(x) +# define htovs(x) vtohs(x) #else # error "Unsupported byteorder" /* If you have need for current perl on PDP-11 or similar, and can help test that blead keeps working on a mixed-endian system, then see - pod/perlhack.pod for how to submit patches to things working again. */ + pod/perlhack.pod for how to submit patches to things working again. */ #endif -/* *MAX Plus 1. A floating point value. - Hopefully expressed in a way that dodgy floating point can't mess up. - >> 2 rather than 1, so that value is safely less than I32_MAX after 1 - is added to it - May find that some broken compiler will want the value cast to I32. - [after the shift, as signed >> may not be as secure as unsigned >>] -*/ -#define I32_MAX_P1 (2.0 * (1 + (((U32)I32_MAX) >> 1))) -#define U32_MAX_P1 (4.0 * (1 + ((U32_MAX) >> 2))) +/* *MAX Plus 1. A floating point value. Hopefully expressed in a way + that dodgy floating point can't mess up. >> 2 rather than 1, so that + value is safely less than I32_MAX after 1 is added to it May find + that some broken compiler will want the value cast to I32. [after + the shift, as signed >> may not be as secure as unsigned >>] + */ +#define I32_MAX_P1 (2.0 * (1 + (((U32)I32_MAX) >> 1))) +#define U32_MAX_P1 (4.0 * (1 + ((U32_MAX) >> 2))) /* For compilers that can't correctly cast NVs over 0x7FFFFFFF (or - 0x7FFFFFFFFFFFFFFF) to an unsigned integer. In the future, sizeof(UV) - may be greater than sizeof(IV), so don't assume that half max UV is max IV. -*/ -#define U32_MAX_P1_HALF (2.0 * (1 + ((U32_MAX) >> 2))) + 0x7FFFFFFFFFFFFFFF) to an unsigned integer. In the future, sizeof(UV) may + be greater than sizeof(IV), so don't assume that half max UV is max IV. + */ +#define U32_MAX_P1_HALF (2.0 * (1 + ((U32_MAX) >> 2))) -#define UV_MAX_P1 (4.0 * (1 + ((UV_MAX) >> 2))) -#define IV_MAX_P1 (2.0 * (1 + (((UV)IV_MAX) >> 1))) -#define UV_MAX_P1_HALF (2.0 * (1 + ((UV_MAX) >> 2))) +#define UV_MAX_P1 (4.0 * (1 + ((UV_MAX) >> 2))) +#define IV_MAX_P1 (2.0 * (1 + (((UV)IV_MAX) >> 1))) +#define UV_MAX_P1_HALF (2.0 * (1 + ((UV_MAX) >> 2))) -/* This may look like unnecessary jumping through hoops, but converting - out of range floating point values to integers *is* undefined behaviour, - and it is starting to bite. +/* This may look like unnecessary jumping through hoops, but + converting out of range floating point values to integers + *is* undefined behaviour, and it is starting to bite. -=for apidoc_section $casting -=for apidoc Am|I32|I_32|NV what -Cast an NV to I32 while avoiding undefined C behavior + =for apidoc_section $casting =for apidoc Am|I32|I_32|NV what + Cast an NV to I32 while avoiding undefined C behavior -=for apidoc Am|U32|U_32|NV what -Cast an NV to U32 while avoiding undefined C behavior + =for apidoc Am|U32|U_32|NV what Cast an NV to U32 while + avoiding undefined C behavior -=for apidoc Am|IV|I_V|NV what -Cast an NV to IV while avoiding undefined C behavior + =for apidoc Am|IV|I_V|NV what Cast an NV to IV while + avoiding undefined C behavior -=for apidoc Am|UV|U_V|NV what -Cast an NV to UV while avoiding undefined C behavior + =for apidoc Am|UV|U_V|NV what Cast an NV to UV while + avoiding undefined C behavior -=cut -*/ + =cut + */ #ifndef CAST_INLINE -#define I_32(what) (cast_i32((NV)(what))) -#define U_32(what) (cast_ulong((NV)(what))) -#define I_V(what) (cast_iv((NV)(what))) -#define U_V(what) (cast_uv((NV)(what))) +#define I_32(what) (cast_i32((NV)(what))) +#define U_32(what) (cast_ulong((NV)(what))) +#define I_V(what) (cast_iv((NV)(what))) +#define U_V(what) (cast_uv((NV)(what))) #else -#define I_32(n) ((n) < I32_MAX_P1 ? ((n) < I32_MIN ? I32_MIN : (I32) (n)) \ - : ((n) < U32_MAX_P1 ? (I32)(U32) (n) \ - : ((n) > 0 ? (I32) U32_MAX : 0 /* NaN */))) -#define U_32(n) ((n) < 0.0 ? ((n) < I32_MIN ? (UV) I32_MIN : (U32)(I32) (n)) \ - : ((n) < U32_MAX_P1 ? (U32) (n) \ - : ((n) > 0 ? U32_MAX : 0 /* NaN */))) -#define I_V(n) (LIKELY((n) < IV_MAX_P1) ? (UNLIKELY((n) < IV_MIN) ? IV_MIN : (IV) (n)) \ - : (LIKELY((n) < UV_MAX_P1) ? (IV)(UV) (n) \ - : ((n) > 0 ? (IV)UV_MAX : 0 /* NaN */))) -#define U_V(n) ((n) < 0.0 ? (UNLIKELY((n) < IV_MIN) ? (UV) IV_MIN : (UV)(IV) (n)) \ - : (LIKELY((n) < UV_MAX_P1) ? (UV) (n) \ - : ((n) > 0 ? UV_MAX : 0 /* NaN */))) -#endif - -#define U_S(what) ((U16)U_32(what)) -#define U_I(what) ((unsigned int)U_32(what)) -#define U_L(what) U_32(what) +#define I_32(n) \ + ((n) < I32_MAX_P1 ? ((n) < I32_MIN ? I32_MIN : (I32) (n)) \ + : ((n) < U32_MAX_P1 ? (I32)(U32) (n) \ + : ((n) > 0 ? (I32) U32_MAX : 0 /* NaN */))) +#define U_32(n) \ + ((n) < 0.0 ? ((n) < I32_MIN ? (UV) I32_MIN : (U32)(I32) (n)) \ + : ((n) < U32_MAX_P1 ? (U32) (n) \ + : ((n) > 0 ? U32_MAX : 0 /* NaN */))) +#define I_V(n) \ + (LIKELY((n) < IV_MAX_P1) ? (UNLIKELY((n) < IV_MIN) ? IV_MIN : (IV) (n)) \ + : (LIKELY((n) < UV_MAX_P1) ? (IV)(UV) (n) \ + : ((n) > 0 ? (IV)UV_MAX : 0 /* NaN */))) +#define U_V(n) \ + ((n) < 0.0 ? (UNLIKELY((n) < IV_MIN) ? (UV) IV_MIN : (UV)(IV) (n)) \ + : (LIKELY((n) < UV_MAX_P1) ? (UV) (n) \ + : ((n) > 0 ? UV_MAX : 0 /* NaN */))) +#endif + +#define U_S(what) ((U16)U_32(what)) +#define U_I(what) ((unsigned int)U_32(what)) +#define U_L(what) U_32(what) /* =for apidoc_section $integer @@ -4721,36 +4739,36 @@ Cast an NV to UV while avoiding undefined C behavior The largest signed integer that fits in an IV on this platform. =for apidoc Amn|IV|IV_MIN -The negative signed integer furthest away from 0 that fits in an IV on this -platform. +The negative signed integer furthest away from 0 that fits in an +IV on this platform. =for apidoc Amn|UV|UV_MAX The largest unsigned integer that fits in a UV on this platform. =for apidoc Amn|UV|UV_MIN -The smallest unsigned integer that fits in a UV on this platform. It should -equal zero. +The smallest unsigned integer that fits in a UV on this +platform. It should equal zero. =cut */ #ifdef HAS_SIGNBIT # ifndef Perl_signbit -# define Perl_signbit signbit +# define Perl_signbit signbit # endif #endif /* These do not care about the fractional part, only about the range. */ -#define NV_WITHIN_IV(nv) (I_V(nv) >= IV_MIN && I_V(nv) <= IV_MAX) -#define NV_WITHIN_UV(nv) ((nv)>=0.0 && U_V(nv) >= UV_MIN && U_V(nv) <= UV_MAX) +#define NV_WITHIN_IV(nv) (I_V(nv) >= IV_MIN && I_V(nv) <= IV_MAX) +#define NV_WITHIN_UV(nv) ((nv)>=0.0 && U_V(nv) >= UV_MIN && U_V(nv) <= UV_MAX) /* Used with UV/IV arguments: */ /* XXXX: need to speed it up */ -#define CLUMP_2UV(iv) ((iv) < 0 ? 0 : (UV)(iv)) -#define CLUMP_2IV(uv) ((uv) > (UV)IV_MAX ? IV_MAX : (IV)(uv)) +#define CLUMP_2UV(iv) ((iv) < 0 ? 0 : (UV)(iv)) +#define CLUMP_2IV(uv) ((uv) > (UV)IV_MAX ? IV_MAX : (IV)(uv)) #ifndef MAXSYSFD -# define MAXSYSFD 2 +# define MAXSYSFD 2 #endif #ifndef __cplusplus @@ -4763,186 +4781,184 @@ Gid_t getegid (void); #endif #ifndef Perl_debug_log -# define Perl_debug_log PerlIO_stderr() +# define Perl_debug_log PerlIO_stderr() #endif #ifndef Perl_error_log -# define Perl_error_log (PL_stderrgv \ - && isGV(PL_stderrgv) \ - && GvIOp(PL_stderrgv) \ - && IoOFP(GvIOp(PL_stderrgv)) \ - ? IoOFP(GvIOp(PL_stderrgv)) \ - : PerlIO_stderr()) -#endif - - -#define DEBUG_p_FLAG 0x00000001 /* 1 */ -#define DEBUG_s_FLAG 0x00000002 /* 2 */ -#define DEBUG_l_FLAG 0x00000004 /* 4 */ -#define DEBUG_t_FLAG 0x00000008 /* 8 */ -#define DEBUG_o_FLAG 0x00000010 /* 16 */ -#define DEBUG_c_FLAG 0x00000020 /* 32 */ -#define DEBUG_P_FLAG 0x00000040 /* 64 */ -#define DEBUG_m_FLAG 0x00000080 /* 128 */ -#define DEBUG_f_FLAG 0x00000100 /* 256 */ -#define DEBUG_r_FLAG 0x00000200 /* 512 */ -#define DEBUG_x_FLAG 0x00000400 /* 1024 */ -#define DEBUG_u_FLAG 0x00000800 /* 2048 */ +# define Perl_error_log \ + (PL_stderrgv \ + && isGV(PL_stderrgv) \ + && GvIOp(PL_stderrgv) \ + && IoOFP(GvIOp(PL_stderrgv)) \ + ? IoOFP(GvIOp(PL_stderrgv)) \ + : PerlIO_stderr()) +#endif + + +#define DEBUG_p_FLAG 0x00000001 /* 1 */ +#define DEBUG_s_FLAG 0x00000002 /* 2 */ +#define DEBUG_l_FLAG 0x00000004 /* 4 */ +#define DEBUG_t_FLAG 0x00000008 /* 8 */ +#define DEBUG_o_FLAG 0x00000010 /* 16 */ +#define DEBUG_c_FLAG 0x00000020 /* 32 */ +#define DEBUG_P_FLAG 0x00000040 /* 64 */ +#define DEBUG_m_FLAG 0x00000080 /* 128 */ +#define DEBUG_f_FLAG 0x00000100 /* 256 */ +#define DEBUG_r_FLAG 0x00000200 /* 512 */ +#define DEBUG_x_FLAG 0x00000400 /* 1024 */ +#define DEBUG_u_FLAG 0x00000800 /* 2048 */ /* U is reserved for Unofficial, exploratory hacking */ -#define DEBUG_U_FLAG 0x00001000 /* 4096 */ -#define DEBUG_h_FLAG 0x00002000 /* 8192 */ -#define DEBUG_X_FLAG 0x00004000 /* 16384 */ -#define DEBUG_D_FLAG 0x00008000 /* 32768 */ -#define DEBUG_S_FLAG 0x00010000 /* 65536 */ -#define DEBUG_T_FLAG 0x00020000 /* 131072 */ -#define DEBUG_R_FLAG 0x00040000 /* 262144 */ -#define DEBUG_J_FLAG 0x00080000 /* 524288 */ -#define DEBUG_v_FLAG 0x00100000 /*1048576 */ -#define DEBUG_C_FLAG 0x00200000 /*2097152 */ -#define DEBUG_A_FLAG 0x00400000 /*4194304 */ -#define DEBUG_q_FLAG 0x00800000 /*8388608 */ -#define DEBUG_M_FLAG 0x01000000 /*16777216*/ -#define DEBUG_B_FLAG 0x02000000 /*33554432*/ -#define DEBUG_L_FLAG 0x04000000 /*67108864*/ -#define DEBUG_i_FLAG 0x08000000 /*134217728*/ -#define DEBUG_y_FLAG 0x10000000 /*268435456*/ -#define DEBUG_MASK 0x1FFFEFFF /* mask of all the standard flags */ - -#define DEBUG_DB_RECURSE_FLAG 0x40000000 -#define DEBUG_TOP_FLAG 0x80000000 /* -D was given --> PL_debug |= FLAG */ +#define DEBUG_U_FLAG 0x00001000 /* 4096 */ +#define DEBUG_h_FLAG 0x00002000 /* 8192 */ +#define DEBUG_X_FLAG 0x00004000 /* 16384 */ +#define DEBUG_D_FLAG 0x00008000 /* 32768 */ +#define DEBUG_S_FLAG 0x00010000 /* 65536 */ +#define DEBUG_T_FLAG 0x00020000 /* 131072 */ +#define DEBUG_R_FLAG 0x00040000 /* 262144 */ +#define DEBUG_J_FLAG 0x00080000 /* 524288 */ +#define DEBUG_v_FLAG 0x00100000 /*1048576 */ +#define DEBUG_C_FLAG 0x00200000 /*2097152 */ +#define DEBUG_A_FLAG 0x00400000 /*4194304 */ +#define DEBUG_q_FLAG 0x00800000 /*8388608 */ +#define DEBUG_M_FLAG 0x01000000 /*16777216*/ +#define DEBUG_B_FLAG 0x02000000 /*33554432*/ +#define DEBUG_L_FLAG 0x04000000 /*67108864*/ +#define DEBUG_i_FLAG 0x08000000 /*134217728*/ +#define DEBUG_y_FLAG 0x10000000 /*268435456*/ +#define DEBUG_MASK 0x1FFFEFFF /* mask of all the standard flags */ + +#define DEBUG_DB_RECURSE_FLAG 0x40000000 +#define DEBUG_TOP_FLAG 0x80000000 /* -D was given --> PL_debug |= FLAG */ /* Both flags have to be set */ -# define DEBUG_BOTH_FLAGS_TEST_(flag1, flag2) \ - UNLIKELY((PL_debug & ((flag1)|(flag2))) \ - == ((flag1)|(flag2))) - -# define DEBUG_p_TEST_ UNLIKELY(PL_debug & DEBUG_p_FLAG) -# define DEBUG_s_TEST_ UNLIKELY(PL_debug & DEBUG_s_FLAG) -# define DEBUG_l_TEST_ UNLIKELY(PL_debug & DEBUG_l_FLAG) -# define DEBUG_t_TEST_ UNLIKELY(PL_debug & DEBUG_t_FLAG) -# define DEBUG_o_TEST_ UNLIKELY(PL_debug & DEBUG_o_FLAG) -# define DEBUG_c_TEST_ UNLIKELY(PL_debug & DEBUG_c_FLAG) -# define DEBUG_P_TEST_ UNLIKELY(PL_debug & DEBUG_P_FLAG) -# define DEBUG_m_TEST_ UNLIKELY(PL_debug & DEBUG_m_FLAG) -# define DEBUG_f_TEST_ UNLIKELY(PL_debug & DEBUG_f_FLAG) -# define DEBUG_r_TEST_ UNLIKELY(PL_debug & DEBUG_r_FLAG) -# define DEBUG_x_TEST_ UNLIKELY(PL_debug & DEBUG_x_FLAG) -# define DEBUG_u_TEST_ UNLIKELY(PL_debug & DEBUG_u_FLAG) -# define DEBUG_U_TEST_ UNLIKELY(PL_debug & DEBUG_U_FLAG) -# define DEBUG_h_TEST_ UNLIKELY(PL_debug & DEBUG_h_FLAG) -# define DEBUG_X_TEST_ UNLIKELY(PL_debug & DEBUG_X_FLAG) -# define DEBUG_D_TEST_ UNLIKELY(PL_debug & DEBUG_D_FLAG) -# define DEBUG_S_TEST_ UNLIKELY(PL_debug & DEBUG_S_FLAG) -# define DEBUG_T_TEST_ UNLIKELY(PL_debug & DEBUG_T_FLAG) -# define DEBUG_R_TEST_ UNLIKELY(PL_debug & DEBUG_R_FLAG) -# define DEBUG_J_TEST_ UNLIKELY(PL_debug & DEBUG_J_FLAG) -# define DEBUG_v_TEST_ UNLIKELY(PL_debug & DEBUG_v_FLAG) -# define DEBUG_C_TEST_ UNLIKELY(PL_debug & DEBUG_C_FLAG) -# define DEBUG_A_TEST_ UNLIKELY(PL_debug & DEBUG_A_FLAG) -# define DEBUG_q_TEST_ UNLIKELY(PL_debug & DEBUG_q_FLAG) -# define DEBUG_M_TEST_ UNLIKELY(PL_debug & DEBUG_M_FLAG) -# define DEBUG_B_TEST_ UNLIKELY(PL_debug & DEBUG_B_FLAG) +# define DEBUG_BOTH_FLAGS_TEST_(flag1, flag2) \ + UNLIKELY((PL_debug & ((flag1)|(flag2))) \ + == ((flag1)|(flag2))) + +# define DEBUG_p_TEST_ UNLIKELY(PL_debug & DEBUG_p_FLAG) +# define DEBUG_s_TEST_ UNLIKELY(PL_debug & DEBUG_s_FLAG) +# define DEBUG_l_TEST_ UNLIKELY(PL_debug & DEBUG_l_FLAG) +# define DEBUG_t_TEST_ UNLIKELY(PL_debug & DEBUG_t_FLAG) +# define DEBUG_o_TEST_ UNLIKELY(PL_debug & DEBUG_o_FLAG) +# define DEBUG_c_TEST_ UNLIKELY(PL_debug & DEBUG_c_FLAG) +# define DEBUG_P_TEST_ UNLIKELY(PL_debug & DEBUG_P_FLAG) +# define DEBUG_m_TEST_ UNLIKELY(PL_debug & DEBUG_m_FLAG) +# define DEBUG_f_TEST_ UNLIKELY(PL_debug & DEBUG_f_FLAG) +# define DEBUG_r_TEST_ UNLIKELY(PL_debug & DEBUG_r_FLAG) +# define DEBUG_x_TEST_ UNLIKELY(PL_debug & DEBUG_x_FLAG) +# define DEBUG_u_TEST_ UNLIKELY(PL_debug & DEBUG_u_FLAG) +# define DEBUG_U_TEST_ UNLIKELY(PL_debug & DEBUG_U_FLAG) +# define DEBUG_h_TEST_ UNLIKELY(PL_debug & DEBUG_h_FLAG) +# define DEBUG_X_TEST_ UNLIKELY(PL_debug & DEBUG_X_FLAG) +# define DEBUG_D_TEST_ UNLIKELY(PL_debug & DEBUG_D_FLAG) +# define DEBUG_S_TEST_ UNLIKELY(PL_debug & DEBUG_S_FLAG) +# define DEBUG_T_TEST_ UNLIKELY(PL_debug & DEBUG_T_FLAG) +# define DEBUG_R_TEST_ UNLIKELY(PL_debug & DEBUG_R_FLAG) +# define DEBUG_J_TEST_ UNLIKELY(PL_debug & DEBUG_J_FLAG) +# define DEBUG_v_TEST_ UNLIKELY(PL_debug & DEBUG_v_FLAG) +# define DEBUG_C_TEST_ UNLIKELY(PL_debug & DEBUG_C_FLAG) +# define DEBUG_A_TEST_ UNLIKELY(PL_debug & DEBUG_A_FLAG) +# define DEBUG_q_TEST_ UNLIKELY(PL_debug & DEBUG_q_FLAG) +# define DEBUG_M_TEST_ UNLIKELY(PL_debug & DEBUG_M_FLAG) +# define DEBUG_B_TEST_ UNLIKELY(PL_debug & DEBUG_B_FLAG) /* Locale initialization comes earlier than PL_debug gets set, * DEBUG_LOCALE_INITIALIZATION_, if defined, will be set early enough */ # ifndef DEBUG_LOCALE_INITIALIZATION_ -# define DEBUG_LOCALE_INITIALIZATION_ 0 -# endif -# define DEBUG_L_TEST_ \ - ( UNLIKELY(DEBUG_LOCALE_INITIALIZATION_) \ - || UNLIKELY(PL_debug & DEBUG_L_FLAG)) -# define DEBUG_Lv_TEST_ \ - ( UNLIKELY(DEBUG_LOCALE_INITIALIZATION_) \ - || UNLIKELY(DEBUG_BOTH_FLAGS_TEST_(DEBUG_L_FLAG, DEBUG_v_FLAG))) -# define DEBUG_i_TEST_ UNLIKELY(PL_debug & DEBUG_i_FLAG) -# define DEBUG_y_TEST_ UNLIKELY(PL_debug & DEBUG_y_FLAG) -# define DEBUG_Xv_TEST_ DEBUG_BOTH_FLAGS_TEST_(DEBUG_X_FLAG, DEBUG_v_FLAG) -# define DEBUG_Uv_TEST_ DEBUG_BOTH_FLAGS_TEST_(DEBUG_U_FLAG, DEBUG_v_FLAG) -# define DEBUG_Pv_TEST_ DEBUG_BOTH_FLAGS_TEST_(DEBUG_P_FLAG, DEBUG_v_FLAG) -# define DEBUG_yv_TEST_ DEBUG_BOTH_FLAGS_TEST_(DEBUG_y_FLAG, DEBUG_v_FLAG) +# define DEBUG_LOCALE_INITIALIZATION_ 0 +# endif +# define DEBUG_L_TEST_ \ + ( UNLIKELY(DEBUG_LOCALE_INITIALIZATION_) \ + || UNLIKELY(PL_debug & DEBUG_L_FLAG)) +# define DEBUG_Lv_TEST_ \ + ( UNLIKELY(DEBUG_LOCALE_INITIALIZATION_) \ + || UNLIKELY(DEBUG_BOTH_FLAGS_TEST_(DEBUG_L_FLAG, DEBUG_v_FLAG))) +# define DEBUG_i_TEST_ UNLIKELY(PL_debug & DEBUG_i_FLAG) +# define DEBUG_y_TEST_ UNLIKELY(PL_debug & DEBUG_y_FLAG) +# define DEBUG_Xv_TEST_ DEBUG_BOTH_FLAGS_TEST_(DEBUG_X_FLAG, DEBUG_v_FLAG) +# define DEBUG_Uv_TEST_ DEBUG_BOTH_FLAGS_TEST_(DEBUG_U_FLAG, DEBUG_v_FLAG) +# define DEBUG_Pv_TEST_ DEBUG_BOTH_FLAGS_TEST_(DEBUG_P_FLAG, DEBUG_v_FLAG) +# define DEBUG_yv_TEST_ DEBUG_BOTH_FLAGS_TEST_(DEBUG_y_FLAG, DEBUG_v_FLAG) #ifdef DEBUGGING -# define DEBUG_p_TEST DEBUG_p_TEST_ -# define DEBUG_s_TEST DEBUG_s_TEST_ -# define DEBUG_l_TEST DEBUG_l_TEST_ -# define DEBUG_t_TEST DEBUG_t_TEST_ -# define DEBUG_o_TEST DEBUG_o_TEST_ -# define DEBUG_c_TEST DEBUG_c_TEST_ -# define DEBUG_P_TEST DEBUG_P_TEST_ -# define DEBUG_m_TEST DEBUG_m_TEST_ -# define DEBUG_f_TEST DEBUG_f_TEST_ -# define DEBUG_r_TEST DEBUG_r_TEST_ -# define DEBUG_x_TEST DEBUG_x_TEST_ -# define DEBUG_u_TEST DEBUG_u_TEST_ -# define DEBUG_U_TEST DEBUG_U_TEST_ -# define DEBUG_h_TEST DEBUG_h_TEST_ -# define DEBUG_X_TEST DEBUG_X_TEST_ -# define DEBUG_D_TEST DEBUG_D_TEST_ -# define DEBUG_S_TEST DEBUG_S_TEST_ -# define DEBUG_T_TEST DEBUG_T_TEST_ -# define DEBUG_R_TEST DEBUG_R_TEST_ -# define DEBUG_J_TEST DEBUG_J_TEST_ -# define DEBUG_v_TEST DEBUG_v_TEST_ -# define DEBUG_C_TEST DEBUG_C_TEST_ -# define DEBUG_A_TEST DEBUG_A_TEST_ -# define DEBUG_q_TEST DEBUG_q_TEST_ -# define DEBUG_M_TEST DEBUG_M_TEST_ -# define DEBUG_B_TEST DEBUG_B_TEST_ -# define DEBUG_L_TEST DEBUG_L_TEST_ -# define DEBUG_i_TEST DEBUG_i_TEST_ -# define DEBUG_y_TEST DEBUG_y_TEST_ -# define DEBUG_Xv_TEST DEBUG_Xv_TEST_ -# define DEBUG_Uv_TEST DEBUG_Uv_TEST_ -# define DEBUG_Pv_TEST DEBUG_Pv_TEST_ -# define DEBUG_Lv_TEST DEBUG_Lv_TEST_ -# define DEBUG_yv_TEST DEBUG_yv_TEST_ - -# define PERL_DEB(a) a -# define PERL_DEB2(a,b) a -# define PERL_DEBUG(a) if (PL_debug) a -# define DEBUG_p(a) if (DEBUG_p_TEST) a -# define DEBUG_s(a) if (DEBUG_s_TEST) a -# define DEBUG_l(a) if (DEBUG_l_TEST) a -# define DEBUG_t(a) if (DEBUG_t_TEST) a -# define DEBUG_o(a) if (DEBUG_o_TEST) a -# define DEBUG_c(a) if (DEBUG_c_TEST) a -# define DEBUG_P(a) if (DEBUG_P_TEST) a - - /* Temporarily turn off memory debugging in case the a - * does memory allocation, either directly or indirectly. */ -# define DEBUG_m(a) \ - STMT_START { \ - if (PERL_GET_INTERP) { \ - dTHX; \ - if (DEBUG_m_TEST) { \ - PL_debug &= ~DEBUG_m_FLAG; \ - a; \ - PL_debug |= DEBUG_m_FLAG; \ - } \ - } \ - } STMT_END - -/* These allow you to customize your debugging output for specialized, - * generally temporary ad-hoc purposes. For example, if you need 'errno' - * preserved, you can add definitions to these macros (either in this file for - * the whole program, or before the #include "perl.h" in a particular .c file - * you're trying to debug) and recompile: - * - * #define DEBUG_PRE_STMTS dSAVE_ERRNO; - * #define DEBUG_POST_STMTS RESTORE_ERRNO; - * - * Other potential things include displaying timestamps, location information, - * which thread, etc. Heres an example with both errno and location info: - * - * #define DEBUG_PRE_STMTS dSAVE_ERRNO; \ - * PerlIO_printf(Perl_debug_log, "%s:%d: ", __FILE__, __LINE__); - * #define DEBUG_POST RESTORE_ERRNO; - * - * All DEBUG statements in the compiled scope will be have these extra - * statements compiled in; they will be executed only for the DEBUG statements - * whose flags are turned on. - */ +# define DEBUG_p_TEST DEBUG_p_TEST_ +# define DEBUG_s_TEST DEBUG_s_TEST_ +# define DEBUG_l_TEST DEBUG_l_TEST_ +# define DEBUG_t_TEST DEBUG_t_TEST_ +# define DEBUG_o_TEST DEBUG_o_TEST_ +# define DEBUG_c_TEST DEBUG_c_TEST_ +# define DEBUG_P_TEST DEBUG_P_TEST_ +# define DEBUG_m_TEST DEBUG_m_TEST_ +# define DEBUG_f_TEST DEBUG_f_TEST_ +# define DEBUG_r_TEST DEBUG_r_TEST_ +# define DEBUG_x_TEST DEBUG_x_TEST_ +# define DEBUG_u_TEST DEBUG_u_TEST_ +# define DEBUG_U_TEST DEBUG_U_TEST_ +# define DEBUG_h_TEST DEBUG_h_TEST_ +# define DEBUG_X_TEST DEBUG_X_TEST_ +# define DEBUG_D_TEST DEBUG_D_TEST_ +# define DEBUG_S_TEST DEBUG_S_TEST_ +# define DEBUG_T_TEST DEBUG_T_TEST_ +# define DEBUG_R_TEST DEBUG_R_TEST_ +# define DEBUG_J_TEST DEBUG_J_TEST_ +# define DEBUG_v_TEST DEBUG_v_TEST_ +# define DEBUG_C_TEST DEBUG_C_TEST_ +# define DEBUG_A_TEST DEBUG_A_TEST_ +# define DEBUG_q_TEST DEBUG_q_TEST_ +# define DEBUG_M_TEST DEBUG_M_TEST_ +# define DEBUG_B_TEST DEBUG_B_TEST_ +# define DEBUG_L_TEST DEBUG_L_TEST_ +# define DEBUG_i_TEST DEBUG_i_TEST_ +# define DEBUG_y_TEST DEBUG_y_TEST_ +# define DEBUG_Xv_TEST DEBUG_Xv_TEST_ +# define DEBUG_Uv_TEST DEBUG_Uv_TEST_ +# define DEBUG_Pv_TEST DEBUG_Pv_TEST_ +# define DEBUG_Lv_TEST DEBUG_Lv_TEST_ +# define DEBUG_yv_TEST DEBUG_yv_TEST_ + +# define PERL_DEB(a) a +# define PERL_DEB2(a,b) a +# define PERL_DEBUG(a) if (PL_debug) a +# define DEBUG_p(a) if (DEBUG_p_TEST) a +# define DEBUG_s(a) if (DEBUG_s_TEST) a +# define DEBUG_l(a) if (DEBUG_l_TEST) a +# define DEBUG_t(a) if (DEBUG_t_TEST) a +# define DEBUG_o(a) if (DEBUG_o_TEST) a +# define DEBUG_c(a) if (DEBUG_c_TEST) a +# define DEBUG_P(a) if (DEBUG_P_TEST) a + + /* Temporarily turn off memory debugging in case the a does + * memory allocation, either directly or indirectly. */ +# define DEBUG_m(a) \ + STMT_START { \ + if (PERL_GET_INTERP) { \ + dTHX; \ + if (DEBUG_m_TEST) { \ + PL_debug &= ~DEBUG_m_FLAG; \ + a; \ + PL_debug |= DEBUG_m_FLAG; \ + } \ + } \ + } STMT_END + +/* These allow you to customize your debugging output for specialized, \ + * generally temporary ad-hoc purposes. For example, if you need 'errno' \ + * preserved, you can add definitions to these macros (either in this file for \ + * the whole program, or before the #include "perl.h" in a particular .c file \ + * you're trying to debug) and recompile: \ + * \ + * #define DEBUG_PRE_STMTS dSAVE_ERRNO; #define DEBUG_POST_STMTS RESTORE_ERRNO; \ + * \ + * Other potential things include displaying timestamps, location information, \ + * which thread, etc. Heres an example with both errno and location info: \ + * \ + * #define DEBUG_PRE_STMTS dSAVE_ERRNO; PerlIO_printf(Perl_debug_log, "%s:%d: \ + * ", __FILE__, __LINE__); #define DEBUG_POST RESTORE_ERRNO; \ + * \ + * All DEBUG statements in the compiled scope will be have these extra \ + * statements compiled in; they will be executed only for the DEBUG statements \ + * whose flags are turned on. */ #ifndef DEBUG_PRE_STMTS # define DEBUG_PRE_STMTS #endif @@ -4950,87 +4966,88 @@ Gid_t getegid (void); # define DEBUG_POST_STMTS #endif -# define DEBUG__(t, a) \ - STMT_START { \ - if (t) { \ - DEBUG_PRE_STMTS a; DEBUG_POST_STMTS \ - } \ - } STMT_END +# define DEBUG__(t, a) \ + STMT_START { \ + if (t) { \ + DEBUG_PRE_STMTS a; DEBUG_POST_STMTS \ + } \ + } STMT_END -# define DEBUG_f(a) DEBUG__(DEBUG_f_TEST, a) +# define DEBUG_f(a) DEBUG__(DEBUG_f_TEST, a) /* For re_comp.c, re_exec.c, assume -Dr has been specified */ # ifdef PERL_EXT_RE_BUILD -# define DEBUG_r(a) STMT_START { \ - DEBUG_PRE_STMTS a; DEBUG_POST_STMTS \ - } STMT_END; +# define DEBUG_r(a) \ + STMT_START { \ + DEBUG_PRE_STMTS a; DEBUG_POST_STMTS \ + } STMT_END; # else -# define DEBUG_r(a) DEBUG__(DEBUG_r_TEST, a) +# define DEBUG_r(a) DEBUG__(DEBUG_r_TEST, a) # endif /* PERL_EXT_RE_BUILD */ -# define DEBUG_x(a) DEBUG__(DEBUG_x_TEST, a) -# define DEBUG_u(a) DEBUG__(DEBUG_u_TEST, a) -# define DEBUG_U(a) DEBUG__(DEBUG_U_TEST, a) -# define DEBUG_X(a) DEBUG__(DEBUG_X_TEST, a) -# define DEBUG_D(a) DEBUG__(DEBUG_D_TEST, a) -# define DEBUG_Xv(a) DEBUG__(DEBUG_Xv_TEST, a) -# define DEBUG_Uv(a) DEBUG__(DEBUG_Uv_TEST, a) -# define DEBUG_Pv(a) DEBUG__(DEBUG_Pv_TEST, a) -# define DEBUG_Lv(a) DEBUG__(DEBUG_Lv_TEST, a) -# define DEBUG_yv(a) DEBUG__(DEBUG_yv_TEST, a) - -# define DEBUG_S(a) DEBUG__(DEBUG_S_TEST, a) -# define DEBUG_T(a) DEBUG__(DEBUG_T_TEST, a) -# define DEBUG_R(a) DEBUG__(DEBUG_R_TEST, a) -# define DEBUG_v(a) DEBUG__(DEBUG_v_TEST, a) -# define DEBUG_C(a) DEBUG__(DEBUG_C_TEST, a) -# define DEBUG_A(a) DEBUG__(DEBUG_A_TEST, a) -# define DEBUG_q(a) DEBUG__(DEBUG_q_TEST, a) -# define DEBUG_M(a) DEBUG__(DEBUG_M_TEST, a) -# define DEBUG_B(a) DEBUG__(DEBUG_B_TEST, a) -# define DEBUG_L(a) DEBUG__(DEBUG_L_TEST, a) -# define DEBUG_i(a) DEBUG__(DEBUG_i_TEST, a) -# define DEBUG_y(a) DEBUG__(DEBUG_y_TEST, a) +# define DEBUG_x(a) DEBUG__(DEBUG_x_TEST, a) +# define DEBUG_u(a) DEBUG__(DEBUG_u_TEST, a) +# define DEBUG_U(a) DEBUG__(DEBUG_U_TEST, a) +# define DEBUG_X(a) DEBUG__(DEBUG_X_TEST, a) +# define DEBUG_D(a) DEBUG__(DEBUG_D_TEST, a) +# define DEBUG_Xv(a) DEBUG__(DEBUG_Xv_TEST, a) +# define DEBUG_Uv(a) DEBUG__(DEBUG_Uv_TEST, a) +# define DEBUG_Pv(a) DEBUG__(DEBUG_Pv_TEST, a) +# define DEBUG_Lv(a) DEBUG__(DEBUG_Lv_TEST, a) +# define DEBUG_yv(a) DEBUG__(DEBUG_yv_TEST, a) + +# define DEBUG_S(a) DEBUG__(DEBUG_S_TEST, a) +# define DEBUG_T(a) DEBUG__(DEBUG_T_TEST, a) +# define DEBUG_R(a) DEBUG__(DEBUG_R_TEST, a) +# define DEBUG_v(a) DEBUG__(DEBUG_v_TEST, a) +# define DEBUG_C(a) DEBUG__(DEBUG_C_TEST, a) +# define DEBUG_A(a) DEBUG__(DEBUG_A_TEST, a) +# define DEBUG_q(a) DEBUG__(DEBUG_q_TEST, a) +# define DEBUG_M(a) DEBUG__(DEBUG_M_TEST, a) +# define DEBUG_B(a) DEBUG__(DEBUG_B_TEST, a) +# define DEBUG_L(a) DEBUG__(DEBUG_L_TEST, a) +# define DEBUG_i(a) DEBUG__(DEBUG_i_TEST, a) +# define DEBUG_y(a) DEBUG__(DEBUG_y_TEST, a) #else /* ! DEBUGGING below */ -# define DEBUG_p_TEST (0) -# define DEBUG_s_TEST (0) -# define DEBUG_l_TEST (0) -# define DEBUG_t_TEST (0) -# define DEBUG_o_TEST (0) -# define DEBUG_c_TEST (0) -# define DEBUG_P_TEST (0) -# define DEBUG_m_TEST (0) -# define DEBUG_f_TEST (0) -# define DEBUG_r_TEST (0) -# define DEBUG_x_TEST (0) -# define DEBUG_u_TEST (0) -# define DEBUG_U_TEST (0) -# define DEBUG_h_TEST (0) -# define DEBUG_X_TEST (0) -# define DEBUG_D_TEST (0) -# define DEBUG_S_TEST (0) -# define DEBUG_T_TEST (0) -# define DEBUG_R_TEST (0) -# define DEBUG_J_TEST (0) -# define DEBUG_v_TEST (0) -# define DEBUG_C_TEST (0) -# define DEBUG_A_TEST (0) -# define DEBUG_q_TEST (0) -# define DEBUG_M_TEST (0) -# define DEBUG_B_TEST (0) -# define DEBUG_L_TEST (0) -# define DEBUG_i_TEST (0) -# define DEBUG_y_TEST (0) -# define DEBUG_Xv_TEST (0) -# define DEBUG_Uv_TEST (0) -# define DEBUG_Pv_TEST (0) -# define DEBUG_Lv_TEST (0) -# define DEBUG_yv_TEST (0) +# define DEBUG_p_TEST (0) +# define DEBUG_s_TEST (0) +# define DEBUG_l_TEST (0) +# define DEBUG_t_TEST (0) +# define DEBUG_o_TEST (0) +# define DEBUG_c_TEST (0) +# define DEBUG_P_TEST (0) +# define DEBUG_m_TEST (0) +# define DEBUG_f_TEST (0) +# define DEBUG_r_TEST (0) +# define DEBUG_x_TEST (0) +# define DEBUG_u_TEST (0) +# define DEBUG_U_TEST (0) +# define DEBUG_h_TEST (0) +# define DEBUG_X_TEST (0) +# define DEBUG_D_TEST (0) +# define DEBUG_S_TEST (0) +# define DEBUG_T_TEST (0) +# define DEBUG_R_TEST (0) +# define DEBUG_J_TEST (0) +# define DEBUG_v_TEST (0) +# define DEBUG_C_TEST (0) +# define DEBUG_A_TEST (0) +# define DEBUG_q_TEST (0) +# define DEBUG_M_TEST (0) +# define DEBUG_B_TEST (0) +# define DEBUG_L_TEST (0) +# define DEBUG_i_TEST (0) +# define DEBUG_y_TEST (0) +# define DEBUG_Xv_TEST (0) +# define DEBUG_Uv_TEST (0) +# define DEBUG_Pv_TEST (0) +# define DEBUG_Lv_TEST (0) +# define DEBUG_yv_TEST (0) # define PERL_DEB(a) -# define PERL_DEB2(a,b) b +# define PERL_DEB2(a,b) b # define PERL_DEBUG(a) # define DEBUG_p(a) # define DEBUG_s(a) @@ -5067,28 +5084,29 @@ Gid_t getegid (void); #endif /* DEBUGGING */ -#define DEBUG_SCOPE(where) \ - DEBUG_l( \ - Perl_deb(aTHX_ "%s scope %ld (savestack=%ld) at %s:%d\n", \ - where, (long)PL_scopestack_ix, (long)PL_savestack_ix, \ +#define DEBUG_SCOPE(where) \ + DEBUG_l( \ + Perl_deb(aTHX_ "%s scope %ld (savestack=%ld) at %s:%d\n", \ + where, (long)PL_scopestack_ix, (long)PL_savestack_ix, \ __FILE__, __LINE__)); -/* Keep the old croak based assert for those who want it, and as a fallback if - the platform is so heretically non-ANSI that it can't assert. */ +/* Keep the old croak based assert for those who want it, and as a fallback + if the platform is so heretically non-ANSI that it can't assert. */ -#define Perl_assert(what) PERL_DEB2( \ - ((what) ? ((void) 0) : \ - (Perl_croak_nocontext("Assertion %s failed: file \"" __FILE__ \ - "\", line %d", STRINGIFY(what), __LINE__), \ +#define Perl_assert(what) \ + PERL_DEB2( \ + ((what) ? ((void) 0) : \ + (Perl_croak_nocontext("Assertion %s failed: file \"" __FILE__ \ + "\", line %d", STRINGIFY(what), __LINE__), \ (void) 0)), ((void)0)) -/* assert() gets defined if DEBUGGING. - * If no DEBUGGING, the has not been included. */ +/* assert() gets defined if DEBUGGING. If no DEBUGGING, + * the has not been included. */ #ifndef assert -# define assert(what) Perl_assert(what) +# define assert(what) Perl_assert(what) #endif #ifdef DEBUGGING -# define assert_(what) assert(what), +# define assert_(what) assert(what), #else # define assert_(what) #endif @@ -5096,7 +5114,7 @@ Gid_t getegid (void); struct ufuncs { I32 (*uf_val)(pTHX_ IV, SV*); I32 (*uf_set)(pTHX_ IV, SV*); - IV uf_index; + IV uf_index; }; /* In pre-5.7-Perls the PERL_MAGIC_uvar magic didn't get the thread context. @@ -5104,7 +5122,7 @@ struct ufuncs { * like the following: #ifndef PERL_MG_UFUNC -#define PERL_MG_UFUNC(name,ix,sv) I32 name(IV ix, SV *sv) +#define PERL_MG_UFUNC(name,ix,sv) I32 name(IV ix, SV *sv) #endif static PERL_MG_UFUNC(foo_get, index, val) @@ -5118,12 +5136,13 @@ static PERL_MG_UFUNC(foo_get, index, val) */ #ifndef PERL_MG_UFUNC -#define PERL_MG_UFUNC(name,ix,sv) I32 name(pTHX_ IV ix, SV *sv) +#define PERL_MG_UFUNC(name,ix,sv) I32 name(pTHX_ IV ix, SV *sv) #endif #include #ifdef __VMS - /* isfinite and others are here rather than in math.h as C99 stipulates */ + /* isfinite and others are here rather than + in math.h as C99 stipulates */ # include #endif @@ -5143,10 +5162,10 @@ char *getlogin (void); /* Fixme on VMS. This needs to be a run-time, not build time options */ /* Also rename() is affected by this */ #ifdef UNLINK_ALL_VERSIONS /* Currently only makes sense for VMS */ -#define UNLINK unlnk +#define UNLINK unlnk I32 unlnk (pTHX_ const char*); #else -#define UNLINK PerlLIO_unlink +#define UNLINK PerlLIO_unlink #endif /* some versions of glibc are missing the setresuid() proto */ @@ -5160,13 +5179,13 @@ int setresgid(gid_t rgid, gid_t egid, gid_t sgid); #ifndef HAS_SETREUID # ifdef HAS_SETRESUID -# define setreuid(r,e) setresuid(r,e,(Uid_t)-1) +# define setreuid(r,e) setresuid(r,e,(Uid_t)-1) # define HAS_SETREUID # endif #endif #ifndef HAS_SETREGID # ifdef HAS_SETRESGID -# define setregid(r,e) setresgid(r,e,(Gid_t)-1) +# define setregid(r,e) setresgid(r,e,(Gid_t)-1) # define HAS_SETREGID # endif #endif @@ -5179,31 +5198,31 @@ typedef struct sigaction Sigsave_t; typedef Sighandler_t Sigsave_t; #endif -#define SCAN_DEF 0 -#define SCAN_TR 1 -#define SCAN_REPL 2 +#define SCAN_DEF 0 +#define SCAN_TR 1 +#define SCAN_REPL 2 #ifdef DEBUGGING # ifndef register # define register # endif -# define RUNOPS_DEFAULT Perl_runops_debug +# define RUNOPS_DEFAULT Perl_runops_debug #else -# define RUNOPS_DEFAULT Perl_runops_standard +# define RUNOPS_DEFAULT Perl_runops_standard #endif #if defined(USE_PERLIO) EXTERN_C void PerlIO_teardown(void); # ifdef USE_ITHREADS -# define PERLIO_INIT MUTEX_INIT(&PL_perlio_mutex) -# define PERLIO_TERM \ - STMT_START { \ - PerlIO_teardown(); \ - MUTEX_DESTROY(&PL_perlio_mutex);\ - } STMT_END +# define PERLIO_INIT MUTEX_INIT(&PL_perlio_mutex) +# define PERLIO_TERM \ + STMT_START { \ + PerlIO_teardown(); \ + MUTEX_DESTROY(&PL_perlio_mutex); \ + } STMT_END # else # define PERLIO_INIT -# define PERLIO_TERM PerlIO_teardown() +# define PERLIO_TERM PerlIO_teardown() # endif #else # define PERLIO_INIT @@ -5212,20 +5231,20 @@ EXTERN_C void PerlIO_teardown(void); #ifdef MYMALLOC # ifdef MUTEX_INIT_CALLS_MALLOC -# define MALLOC_INIT \ - STMT_START { \ - PL_malloc_mutex = NULL; \ - MUTEX_INIT(&PL_malloc_mutex); \ - } STMT_END -# define MALLOC_TERM \ - STMT_START { \ - perl_mutex tmp = PL_malloc_mutex; \ - PL_malloc_mutex = NULL; \ - MUTEX_DESTROY(&tmp); \ - } STMT_END +# define MALLOC_INIT \ + STMT_START { \ + PL_malloc_mutex = NULL; \ + MUTEX_INIT(&PL_malloc_mutex); \ + } STMT_END +# define MALLOC_TERM \ + STMT_START { \ + perl_mutex tmp = PL_malloc_mutex; \ + PL_malloc_mutex = NULL; \ + MUTEX_DESTROY(&tmp); \ + } STMT_END # else -# define MALLOC_INIT MUTEX_INIT(&PL_malloc_mutex) -# define MALLOC_TERM MUTEX_DESTROY(&PL_malloc_mutex) +# define MALLOC_INIT MUTEX_INIT(&PL_malloc_mutex) +# define MALLOC_TERM MUTEX_DESTROY(&PL_malloc_mutex) # endif #else # define MALLOC_INIT @@ -5236,14 +5255,14 @@ EXTERN_C void PerlIO_teardown(void); struct perl_memory_debug_header; struct perl_memory_debug_header { - tTHX interpreter; + tTHX interpreter; # if defined(PERL_POISON) || defined(PERL_DEBUG_READONLY_COW) - MEM_SIZE size; + MEM_SIZE size; # endif - struct perl_memory_debug_header *prev; - struct perl_memory_debug_header *next; + struct perl_memory_debug_header *prev; + struct perl_memory_debug_header *next; # ifdef PERL_DEBUG_READONLY_COW - bool readonly; + bool readonly; # endif }; @@ -5251,36 +5270,36 @@ struct perl_memory_debug_header { struct perl_memory_debug_header; struct perl_memory_debug_header { - MEM_SIZE size; + MEM_SIZE size; }; #endif #if defined (PERL_TRACK_MEMPOOL) || defined (PERL_DEBUG_READONLY_COW) -# define PERL_MEMORY_DEBUG_HEADER_SIZE \ - (sizeof(struct perl_memory_debug_header) + \ - (MEM_ALIGNBYTES - sizeof(struct perl_memory_debug_header) \ - %MEM_ALIGNBYTES) % MEM_ALIGNBYTES) +# define PERL_MEMORY_DEBUG_HEADER_SIZE \ + (sizeof(struct perl_memory_debug_header) + \ + (MEM_ALIGNBYTES - sizeof(struct perl_memory_debug_header) \ + %MEM_ALIGNBYTES) % MEM_ALIGNBYTES) #else -# define PERL_MEMORY_DEBUG_HEADER_SIZE 0 +# define PERL_MEMORY_DEBUG_HEADER_SIZE 0 #endif #ifdef PERL_TRACK_MEMPOOL # ifdef PERL_DEBUG_READONLY_COW -# define INIT_TRACK_MEMPOOL(header, interp) \ - STMT_START { \ - (header).interpreter = (interp); \ - (header).prev = (header).next = &(header); \ - (header).readonly = 0; \ - } STMT_END +# define INIT_TRACK_MEMPOOL(header, interp) \ + STMT_START { \ + (header).interpreter = (interp); \ + (header).prev = (header).next = &(header); \ + (header).readonly = 0; \ + } STMT_END # else -# define INIT_TRACK_MEMPOOL(header, interp) \ - STMT_START { \ - (header).interpreter = (interp); \ - (header).prev = (header).next = &(header); \ - } STMT_END +# define INIT_TRACK_MEMPOOL(header, interp) \ + STMT_START { \ + (header).interpreter = (interp); \ + (header).prev = (header).next = &(header); \ + } STMT_END # endif # else # define INIT_TRACK_MEMPOOL(header, interp) @@ -5292,26 +5311,26 @@ struct perl_memory_debug_header { #endif #ifdef MYMALLOC -# define Perl_safesysmalloc_size(where) Perl_malloced_size(where) +# define Perl_safesysmalloc_size(where) Perl_malloced_size(where) #else # if defined(HAS_MALLOC_SIZE) && !defined(PERL_DEBUG_READONLY_COW) # ifdef PERL_TRACK_MEMPOOL -# define Perl_safesysmalloc_size(where) \ +# define Perl_safesysmalloc_size(where) \ (malloc_size(((char *)(where)) - PERL_MEMORY_DEBUG_HEADER_SIZE) - PERL_MEMORY_DEBUG_HEADER_SIZE) # else -# define Perl_safesysmalloc_size(where) malloc_size(where) +# define Perl_safesysmalloc_size(where) malloc_size(where) # endif # endif # ifdef HAS_MALLOC_GOOD_SIZE # ifdef PERL_TRACK_MEMPOOL -# define Perl_malloc_good_size(how_much) \ +# define Perl_malloc_good_size(how_much) \ (malloc_good_size((how_much) + PERL_MEMORY_DEBUG_HEADER_SIZE) - PERL_MEMORY_DEBUG_HEADER_SIZE) # else -# define Perl_malloc_good_size(how_much) malloc_good_size(how_much) +# define Perl_malloc_good_size(how_much) malloc_good_size(how_much) # endif # else -/* Having this as the identity operation makes some code simpler. */ -# define Perl_malloc_good_size(how_much) (how_much) +/* Having this as the identity operation makes some code simpler. */ +# define Perl_malloc_good_size(how_much) (how_much) # endif #endif @@ -5323,8 +5342,8 @@ typedef bool (*destroyable_proc_t) (pTHX_ SV *sv); typedef void (*despatch_signals_proc_t) (pTHX); #if defined(__DYNAMIC__) && defined(PERL_DARWIN) && defined(PERL_CORE) -# include /* for the env array */ -# define environ (*_NSGetEnviron()) +# include /* for the env array */ +# define environ (*_NSGetEnviron()) #elif defined(USE_ENVIRON_ARRAY) && !defined(environ) /* VMS and some other platforms don't use the environ array */ EXTERN_C char **environ; /* environment variables supplied via exec */ @@ -5334,13 +5353,15 @@ EXTERN_C char **environ; /* environment variables supplied via exec */ #include "patchlevel.h" #undef PERL_PATCHLEVEL_H_IMPLICIT -#define PERL_VERSION_STRING STRINGIFY(PERL_REVISION) "." \ - STRINGIFY(PERL_VERSION) "." \ - STRINGIFY(PERL_SUBVERSION) +#define PERL_VERSION_STRING \ + STRINGIFY(PERL_REVISION) "." \ + STRINGIFY(PERL_VERSION) "." \ + STRINGIFY(PERL_SUBVERSION) -#define PERL_API_VERSION_STRING STRINGIFY(PERL_API_REVISION) "." \ - STRINGIFY(PERL_API_VERSION) "." \ - STRINGIFY(PERL_API_SUBVERSION) +#define PERL_API_VERSION_STRING \ + STRINGIFY(PERL_API_REVISION) "." \ + STRINGIFY(PERL_API_VERSION) "." \ + STRINGIFY(PERL_API_SUBVERSION) START_EXTERN_C @@ -5357,8 +5378,8 @@ EXTCONST char PL_warn_nl[] INIT("Unsuccessful %s on filename containing newline"); EXTCONST char PL_no_wrongref[] INIT("Can't use %s ref as %s ref"); -/* The core no longer needs this here. If you require the string constant, - please inline a copy into your own code. */ +/* The core no longer needs this here. If you require the string + constant, please inline a copy into your own code. */ EXTCONST char PL_no_symref[] __attribute__deprecated__ INIT("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use"); EXTCONST char PL_no_symref_sv[] @@ -5408,8 +5429,8 @@ whose first character is '8'. What is actually returned is a pointer into a string. All you are interested in is the first character of that string. To get uppercase letters (for the values 10..15), add 16 to the index. Hence, C is C<'b'>, and C is C<'B'>. Adding 16 -to an index whose representation is '0'..'9' yields the same as not adding 16. -Indices outside the range 0..31 result in (bad) undedefined behavior. +to an index whose representation is '0'..'9' yields the same as not adding +16. Indices outside the range 0..31 result in (bad) undedefined behavior. =cut */ @@ -5430,12 +5451,12 @@ EXTCONST char PL_sh_path[] #ifdef CSH EXTCONST char PL_cshname[] INIT(CSH); -# define PL_cshlen (sizeof(CSH "") - 1) +# define PL_cshlen (sizeof(CSH "") - 1) #endif -/* These are baked at compile time into any shared perl library. - In future releases this will allow us in main() to sanity test the - library we're linking against. */ +/* These are baked at compile time into any shared perl + library. In future releases this will allow us in main() to + sanity test the library we're linking against. */ EXTCONST U8 PL_revision INIT(PERL_REVISION); @@ -5447,9 +5468,9 @@ EXTCONST U8 PL_subversion EXTCONST char PL_uuemap[65] INIT("`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_"); -/* a special string address whose value is "isa", but which perl knows - * to treat as if it were really "DOES" when printing the method name in - * the "Can't call method '%s'" error message */ +/* a special string address whose value is "isa", but which perl + * knows to treat as if it were really "DOES" when printing the + * method name in the "Can't call method '%s'" error message */ EXTCONST char PL_isa_DOES[] INIT("isa"); @@ -5478,176 +5499,177 @@ EXTCONST int PL_sig_num[]; #endif /* fast conversion and case folding tables. The folding tables complement the - * fold, so that 'a' maps to 'A' and 'A' maps to 'a', ignoring more complicated - * folds such as outside the range or to multiple characters. */ + * fold, so that 'a' maps to 'A' and 'A' maps to 'a', ignoring more + * complicated folds such as outside the range or to multiple characters. */ #ifdef DOINIT # ifndef EBCDIC -/* The EBCDIC fold table depends on the code page, and hence is found in - * ebcdic_tables.h */ +/* The EBCDIC fold table depends on the code page, + * and hence is found in ebcdic_tables.h */ EXTCONST unsigned char PL_fold[] = { - 0, 1, 2, 3, 4, 5, 6, 7, - 8, 9, 10, 11, 12, 13, 14, 15, - 16, 17, 18, 19, 20, 21, 22, 23, - 24, 25, 26, 27, 28, 29, 30, 31, - 32, 33, 34, 35, 36, 37, 38, 39, - 40, 41, 42, 43, 44, 45, 46, 47, - 48, 49, 50, 51, 52, 53, 54, 55, - 56, 57, 58, 59, 60, 61, 62, 63, - 64, 'a', 'b', 'c', 'd', 'e', 'f', 'g', - 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', - 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', - 'x', 'y', 'z', 91, 92, 93, 94, 95, - 96, 'A', 'B', 'C', 'D', 'E', 'F', 'G', - 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', - 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', - 'X', 'Y', 'Z', 123, 124, 125, 126, 127, - 128, 129, 130, 131, 132, 133, 134, 135, - 136, 137, 138, 139, 140, 141, 142, 143, - 144, 145, 146, 147, 148, 149, 150, 151, - 152, 153, 154, 155, 156, 157, 158, 159, - 160, 161, 162, 163, 164, 165, 166, 167, - 168, 169, 170, 171, 172, 173, 174, 175, - 176, 177, 178, 179, 180, 181, 182, 183, - 184, 185, 186, 187, 188, 189, 190, 191, - 192, 193, 194, 195, 196, 197, 198, 199, - 200, 201, 202, 203, 204, 205, 206, 207, - 208, 209, 210, 211, 212, 213, 214, 215, - 216, 217, 218, 219, 220, 221, 222, 223, - 224, 225, 226, 227, 228, 229, 230, 231, - 232, 233, 234, 235, 236, 237, 238, 239, - 240, 241, 242, 243, 244, 245, 246, 247, - 248, 249, 250, 251, 252, 253, 254, 255 + 0, 1, 2, 3, 4, 5, 6, 7, + 8, 9, 10, 11, 12, 13, 14, 15, + 16, 17, 18, 19, 20, 21, 22, 23, + 24, 25, 26, 27, 28, 29, 30, 31, + 32, 33, 34, 35, 36, 37, 38, 39, + 40, 41, 42, 43, 44, 45, 46, 47, + 48, 49, 50, 51, 52, 53, 54, 55, + 56, 57, 58, 59, 60, 61, 62, 63, + 64, 'a', 'b', 'c', 'd', 'e', 'f', 'g', + 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', + 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', + 'x', 'y', 'z', 91, 92, 93, 94, 95, + 96, 'A', 'B', 'C', 'D', 'E', 'F', 'G', + 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', + 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', + 'X', 'Y', 'Z', 123, 124, 125, 126, 127, + 128, 129, 130, 131, 132, 133, 134, 135, + 136, 137, 138, 139, 140, 141, 142, 143, + 144, 145, 146, 147, 148, 149, 150, 151, + 152, 153, 154, 155, 156, 157, 158, 159, + 160, 161, 162, 163, 164, 165, 166, 167, + 168, 169, 170, 171, 172, 173, 174, 175, + 176, 177, 178, 179, 180, 181, 182, 183, + 184, 185, 186, 187, 188, 189, 190, 191, + 192, 193, 194, 195, 196, 197, 198, 199, + 200, 201, 202, 203, 204, 205, 206, 207, + 208, 209, 210, 211, 212, 213, 214, 215, + 216, 217, 218, 219, 220, 221, 222, 223, + 224, 225, 226, 227, 228, 229, 230, 231, + 232, 233, 234, 235, 236, 237, 238, 239, + 240, 241, 242, 243, 244, 245, 246, 247, + 248, 249, 250, 251, 252, 253, 254, 255 }; EXTCONST unsigned char PL_fold_latin1[] = { - /* Full latin1 complement folding, except for three problematic code points: - * Micro sign (181 = 0xB5) and y with diearesis (255 = 0xFF) have their - * fold complements outside the Latin1 range, so can't match something - * that isn't in utf8. - * German lower case sharp s (223 = 0xDF) folds to two characters, 'ss', - * not one, so can't be represented in this table. + /* Full latin1 complement folding, except for three problematic + * code points: Micro sign (181 = 0xB5) and y with diearesis + * (255 = 0xFF) have their fold complements outside the Latin1 + * range, so can't match something that isn't in utf8. German + * lower case sharp s (223 = 0xDF) folds to two characters, + * 'ss', not one, so can't be represented in this table. * * All have to be specially handled */ - 0, 1, 2, 3, 4, 5, 6, 7, - 8, 9, 10, 11, 12, 13, 14, 15, - 16, 17, 18, 19, 20, 21, 22, 23, - 24, 25, 26, 27, 28, 29, 30, 31, - 32, 33, 34, 35, 36, 37, 38, 39, - 40, 41, 42, 43, 44, 45, 46, 47, - 48, 49, 50, 51, 52, 53, 54, 55, - 56, 57, 58, 59, 60, 61, 62, 63, - 64, 'a', 'b', 'c', 'd', 'e', 'f', 'g', - 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', - 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', - 'x', 'y', 'z', 91, 92, 93, 94, 95, - 96, 'A', 'B', 'C', 'D', 'E', 'F', 'G', - 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', - 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', - 'X', 'Y', 'Z', 123, 124, 125, 126, 127, - 128, 129, 130, 131, 132, 133, 134, 135, - 136, 137, 138, 139, 140, 141, 142, 143, - 144, 145, 146, 147, 148, 149, 150, 151, - 152, 153, 154, 155, 156, 157, 158, 159, - 160, 161, 162, 163, 164, 165, 166, 167, - 168, 169, 170, 171, 172, 173, 174, 175, - 176, 177, 178, 179, 180, 181 /*micro */, 182, 183, - 184, 185, 186, 187, 188, 189, 190, 191, - 192+32, 193+32, 194+32, 195+32, 196+32, 197+32, 198+32, 199+32, - 200+32, 201+32, 202+32, 203+32, 204+32, 205+32, 206+32, 207+32, - 208+32, 209+32, 210+32, 211+32, 212+32, 213+32, 214+32, 215, - 216+32, 217+32, 218+32, 219+32, 220+32, 221+32, 222+32, 223 /* ss */, - 224-32, 225-32, 226-32, 227-32, 228-32, 229-32, 230-32, 231-32, - 232-32, 233-32, 234-32, 235-32, 236-32, 237-32, 238-32, 239-32, - 240-32, 241-32, 242-32, 243-32, 244-32, 245-32, 246-32, 247, - 248-32, 249-32, 250-32, 251-32, 252-32, 253-32, 254-32, + 0, 1, 2, 3, 4, 5, 6, 7, + 8, 9, 10, 11, 12, 13, 14, 15, + 16, 17, 18, 19, 20, 21, 22, 23, + 24, 25, 26, 27, 28, 29, 30, 31, + 32, 33, 34, 35, 36, 37, 38, 39, + 40, 41, 42, 43, 44, 45, 46, 47, + 48, 49, 50, 51, 52, 53, 54, 55, + 56, 57, 58, 59, 60, 61, 62, 63, + 64, 'a', 'b', 'c', 'd', 'e', 'f', 'g', + 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', + 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', + 'x', 'y', 'z', 91, 92, 93, 94, 95, + 96, 'A', 'B', 'C', 'D', 'E', 'F', 'G', + 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', + 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', + 'X', 'Y', 'Z', 123, 124, 125, 126, 127, + 128, 129, 130, 131, 132, 133, 134, 135, + 136, 137, 138, 139, 140, 141, 142, 143, + 144, 145, 146, 147, 148, 149, 150, 151, + 152, 153, 154, 155, 156, 157, 158, 159, + 160, 161, 162, 163, 164, 165, 166, 167, + 168, 169, 170, 171, 172, 173, 174, 175, + 176, 177, 178, 179, 180, 181 /*micro */, 182, 183, + 184, 185, 186, 187, 188, 189, 190, 191, + 192+32, 193+32, 194+32, 195+32, 196+32, 197+32, 198+32, 199+32, + 200+32, 201+32, 202+32, 203+32, 204+32, 205+32, 206+32, 207+32, + 208+32, 209+32, 210+32, 211+32, 212+32, 213+32, 214+32, 215, + 216+32, 217+32, 218+32, 219+32, 220+32, 221+32, 222+32, 223 /* ss */, + 224-32, 225-32, 226-32, 227-32, 228-32, 229-32, 230-32, 231-32, + 232-32, 233-32, 234-32, 235-32, 236-32, 237-32, 238-32, 239-32, + 240-32, 241-32, 242-32, 243-32, 244-32, 245-32, 246-32, 247, + 248-32, 249-32, 250-32, 251-32, 252-32, 253-32, 254-32, 255 /* y with diaeresis */ }; -/* If these tables are accessed through ebcdic, the access will be converted to - * latin1 first */ +/* If these tables are accessed through ebcdic, the + * access will be converted to latin1 first */ EXTCONST unsigned char PL_latin1_lc[] = { /* lowercasing */ - 0, 1, 2, 3, 4, 5, 6, 7, - 8, 9, 10, 11, 12, 13, 14, 15, - 16, 17, 18, 19, 20, 21, 22, 23, - 24, 25, 26, 27, 28, 29, 30, 31, - 32, 33, 34, 35, 36, 37, 38, 39, - 40, 41, 42, 43, 44, 45, 46, 47, - 48, 49, 50, 51, 52, 53, 54, 55, - 56, 57, 58, 59, 60, 61, 62, 63, - 64, 'a', 'b', 'c', 'd', 'e', 'f', 'g', - 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', - 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', - 'x', 'y', 'z', 91, 92, 93, 94, 95, - 96, 97, 98, 99, 100, 101, 102, 103, - 104, 105, 106, 107, 108, 109, 110, 111, - 112, 113, 114, 115, 116, 117, 118, 119, - 120, 121, 122, 123, 124, 125, 126, 127, - 128, 129, 130, 131, 132, 133, 134, 135, - 136, 137, 138, 139, 140, 141, 142, 143, - 144, 145, 146, 147, 148, 149, 150, 151, - 152, 153, 154, 155, 156, 157, 158, 159, - 160, 161, 162, 163, 164, 165, 166, 167, - 168, 169, 170, 171, 172, 173, 174, 175, - 176, 177, 178, 179, 180, 181, 182, 183, - 184, 185, 186, 187, 188, 189, 190, 191, - 192+32, 193+32, 194+32, 195+32, 196+32, 197+32, 198+32, 199+32, - 200+32, 201+32, 202+32, 203+32, 204+32, 205+32, 206+32, 207+32, - 208+32, 209+32, 210+32, 211+32, 212+32, 213+32, 214+32, 215, - 216+32, 217+32, 218+32, 219+32, 220+32, 221+32, 222+32, 223, - 224, 225, 226, 227, 228, 229, 230, 231, - 232, 233, 234, 235, 236, 237, 238, 239, - 240, 241, 242, 243, 244, 245, 246, 247, - 248, 249, 250, 251, 252, 253, 254, 255 + 0, 1, 2, 3, 4, 5, 6, 7, + 8, 9, 10, 11, 12, 13, 14, 15, + 16, 17, 18, 19, 20, 21, 22, 23, + 24, 25, 26, 27, 28, 29, 30, 31, + 32, 33, 34, 35, 36, 37, 38, 39, + 40, 41, 42, 43, 44, 45, 46, 47, + 48, 49, 50, 51, 52, 53, 54, 55, + 56, 57, 58, 59, 60, 61, 62, 63, + 64, 'a', 'b', 'c', 'd', 'e', 'f', 'g', + 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', + 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', + 'x', 'y', 'z', 91, 92, 93, 94, 95, + 96, 97, 98, 99, 100, 101, 102, 103, + 104, 105, 106, 107, 108, 109, 110, 111, + 112, 113, 114, 115, 116, 117, 118, 119, + 120, 121, 122, 123, 124, 125, 126, 127, + 128, 129, 130, 131, 132, 133, 134, 135, + 136, 137, 138, 139, 140, 141, 142, 143, + 144, 145, 146, 147, 148, 149, 150, 151, + 152, 153, 154, 155, 156, 157, 158, 159, + 160, 161, 162, 163, 164, 165, 166, 167, + 168, 169, 170, 171, 172, 173, 174, 175, + 176, 177, 178, 179, 180, 181, 182, 183, + 184, 185, 186, 187, 188, 189, 190, 191, + 192+32, 193+32, 194+32, 195+32, 196+32, 197+32, 198+32, 199+32, + 200+32, 201+32, 202+32, 203+32, 204+32, 205+32, 206+32, 207+32, + 208+32, 209+32, 210+32, 211+32, 212+32, 213+32, 214+32, 215, + 216+32, 217+32, 218+32, 219+32, 220+32, 221+32, 222+32, 223, + 224, 225, 226, 227, 228, 229, 230, 231, + 232, 233, 234, 235, 236, 237, 238, 239, + 240, 241, 242, 243, 244, 245, 246, 247, + 248, 249, 250, 251, 252, 253, 254, 255 }; -/* upper and title case of latin1 characters, modified so that the three tricky - * ones are mapped to 255 (which is one of the three) */ +/* upper and title case of latin1 characters, modified so that the three + * tricky ones are mapped to 255 (which is one of the three) */ EXTCONST unsigned char PL_mod_latin1_uc[] = { - 0, 1, 2, 3, 4, 5, 6, 7, - 8, 9, 10, 11, 12, 13, 14, 15, - 16, 17, 18, 19, 20, 21, 22, 23, - 24, 25, 26, 27, 28, 29, 30, 31, - 32, 33, 34, 35, 36, 37, 38, 39, - 40, 41, 42, 43, 44, 45, 46, 47, - 48, 49, 50, 51, 52, 53, 54, 55, - 56, 57, 58, 59, 60, 61, 62, 63, - 64, 65, 66, 67, 68, 69, 70, 71, - 72, 73, 74, 75, 76, 77, 78, 79, - 80, 81, 82, 83, 84, 85, 86, 87, - 88, 89, 90, 91, 92, 93, 94, 95, - 96, 'A', 'B', 'C', 'D', 'E', 'F', 'G', - 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', - 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', - 'X', 'Y', 'Z', 123, 124, 125, 126, 127, - 128, 129, 130, 131, 132, 133, 134, 135, - 136, 137, 138, 139, 140, 141, 142, 143, - 144, 145, 146, 147, 148, 149, 150, 151, - 152, 153, 154, 155, 156, 157, 158, 159, - 160, 161, 162, 163, 164, 165, 166, 167, - 168, 169, 170, 171, 172, 173, 174, 175, - 176, 177, 178, 179, 180, 255 /*micro*/, 182, 183, - 184, 185, 186, 187, 188, 189, 190, 191, - 192, 193, 194, 195, 196, 197, 198, 199, - 200, 201, 202, 203, 204, 205, 206, 207, - 208, 209, 210, 211, 212, 213, 214, 215, - 216, 217, 218, 219, 220, 221, 222, -# if UNICODE_MAJOR_VERSION > 2 \ - || (UNICODE_MAJOR_VERSION == 2 && UNICODE_DOT_VERSION >= 1 \ - && UNICODE_DOT_DOT_VERSION >= 8) - 255 /*sharp s*/, + 0, 1, 2, 3, 4, 5, 6, 7, + 8, 9, 10, 11, 12, 13, 14, 15, + 16, 17, 18, 19, 20, 21, 22, 23, + 24, 25, 26, 27, 28, 29, 30, 31, + 32, 33, 34, 35, 36, 37, 38, 39, + 40, 41, 42, 43, 44, 45, 46, 47, + 48, 49, 50, 51, 52, 53, 54, 55, + 56, 57, 58, 59, 60, 61, 62, 63, + 64, 65, 66, 67, 68, 69, 70, 71, + 72, 73, 74, 75, 76, 77, 78, 79, + 80, 81, 82, 83, 84, 85, 86, 87, + 88, 89, 90, 91, 92, 93, 94, 95, + 96, 'A', 'B', 'C', 'D', 'E', 'F', 'G', + 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', + 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', + 'X', 'Y', 'Z', 123, 124, 125, 126, 127, + 128, 129, 130, 131, 132, 133, 134, 135, + 136, 137, 138, 139, 140, 141, 142, 143, + 144, 145, 146, 147, 148, 149, 150, 151, + 152, 153, 154, 155, 156, 157, 158, 159, + 160, 161, 162, 163, 164, 165, 166, 167, + 168, 169, 170, 171, 172, 173, 174, 175, + 176, 177, 178, 179, 180, 255 /*micro */, 182, 183, + 184, 185, 186, 187, 188, 189, 190, 191, + 192, 193, 194, 195, 196, 197, 198, 199, + 200, 201, 202, 203, 204, 205, 206, 207, + 208, 209, 210, 211, 212, 213, 214, 215, + 216, 217, 218, 219, 220, 221, 222, +# if UNICODE_MAJOR_VERSION > 2 \ + || (UNICODE_MAJOR_VERSION == 2 && UNICODE_DOT_VERSION >= 1 \ + && UNICODE_DOT_DOT_VERSION >= 8) + 255 /*sharp + s */, # else /* uc(sharp s) is 'sharp s' itself in early unicode */ 223, # endif - 224-32, 225-32, 226-32, 227-32, 228-32, 229-32, 230-32, 231-32, - 232-32, 233-32, 234-32, 235-32, 236-32, 237-32, 238-32, 239-32, - 240-32, 241-32, 242-32, 243-32, 244-32, 245-32, 246-32, 247, - 248-32, 249-32, 250-32, 251-32, 252-32, 253-32, 254-32, 255 + 224-32, 225-32, 226-32, 227-32, 228-32, 229-32, 230-32, 231-32, + 232-32, 233-32, 234-32, 235-32, 236-32, 237-32, 238-32, 239-32, + 240-32, 241-32, 242-32, 243-32, 244-32, 245-32, 246-32, 247, + 248-32, 249-32, 250-32, 251-32, 252-32, 253-32, 254-32, 255 }; # endif /* !EBCDIC, but still in DOINIT */ -#else /* ! DOINIT */ +#else /* ! DOINIT */ # ifndef EBCDIC EXTCONST unsigned char PL_fold[]; EXTCONST unsigned char PL_fold_latin1[]; @@ -5656,9 +5678,9 @@ EXTCONST unsigned char PL_latin1_lc[]; # endif #endif -/* Although only used for debugging, these constants must be available in - * non-debugging builds too, since they're used in ext/re/re_exec.c, - * which has DEBUGGING enabled always */ +/* Although only used for debugging, these constants must be + * available in non-debugging builds too, since they're used in + * ext/re/re_exec.c, which has DEBUGGING enabled always */ #ifdef DOINIT EXTCONST char* const PL_block_type[] = { "NULL", @@ -5681,10 +5703,10 @@ EXTCONST char* PL_block_type[]; #endif /* These are all the compile time options that affect binary compatibility. - Other compile time options that are binary compatible are in perl.c - (in S_Internals_V()). Both are combined for the output of perl -V - However, this string will be embedded in any shared perl library, which will - allow us add a comparison check in perlmain.c in the near future. */ + Other compile time options that are binary compatible are in perl.c (in + S_Internals_V()). Both are combined for the output of perl -V However, + this string will be embedded in any shared perl library, which will allow + us add a comparison check in perlmain.c in the near future. */ #ifdef DOINIT EXTCONST char PL_bincompat_options[] = # ifdef DEBUG_LEAKING_SCALARS @@ -5799,21 +5821,21 @@ EXTCONST char PL_bincompat_options[]; #endif #ifndef PERL_SET_PHASE -# define PERL_SET_PHASE(new_phase) \ - PERL_DTRACE_PROBE_PHASE(new_phase); \ - PL_phase = new_phase; +# define PERL_SET_PHASE(new_phase) \ + PERL_DTRACE_PROBE_PHASE(new_phase); \ + PL_phase = new_phase; #endif -/* The interpreter phases. If these ever change, PL_phase_names right below will - * need to be updated accordingly. */ +/* The interpreter phases. If these ever change, PL_phase_names + * right below will need to be updated accordingly. */ enum perl_phase { - PERL_PHASE_CONSTRUCT = 0, - PERL_PHASE_START = 1, - PERL_PHASE_CHECK = 2, - PERL_PHASE_INIT = 3, - PERL_PHASE_RUN = 4, - PERL_PHASE_END = 5, - PERL_PHASE_DESTRUCT = 6 + PERL_PHASE_CONSTRUCT = 0, + PERL_PHASE_START = 1, + PERL_PHASE_CHECK = 2, + PERL_PHASE_INIT = 3, + PERL_PHASE_RUN = 4, + PERL_PHASE_END = 5, + PERL_PHASE_DESTRUCT = 6 }; #ifdef DOINIT @@ -5837,8 +5859,8 @@ EXTCONST char *const PL_phase_names[]; Returns the given phase's name as a NUL-terminated string. -For example, to print a stack trace that includes the current -interpreter phase you might do: +For example, to print a stack trace that includes the +current interpreter phase you might do: const char* phase_name = phase_name(PL_phase); mess("This is weird. (Perl phase: %s)", phase_name); @@ -5846,26 +5868,28 @@ interpreter phase you might do: =cut */ -#define phase_name(phase) (PL_phase_names[phase]) +#define phase_name(phase) (PL_phase_names[phase]) #ifndef PERL_CORE -/* Do not use this macro. It only exists for extensions that rely on PL_dirty - * instead of using the newer PL_phase, which provides everything PL_dirty - * provided, and more. */ -# define PL_dirty cBOOL(PL_phase == PERL_PHASE_DESTRUCT) +/* Do not use this macro. It only exists for extensions that + * rely on PL_dirty instead of using the newer PL_phase, which + * provides everything PL_dirty provided, and more. */ +# define PL_dirty cBOOL(PL_phase == PERL_PHASE_DESTRUCT) -# define PL_amagic_generation PL_na -# define PL_encoding ((SV *)NULL) +# define PL_amagic_generation PL_na +# define PL_encoding ((SV *)NULL) #endif /* !PERL_CORE */ -#define PL_hints PL_compiling.cop_hints -#define PL_maxo MAXO +#define PL_hints PL_compiling.cop_hints +#define PL_maxo MAXO END_EXTERN_C -/*****************************************************************************/ +/**************************************************************************** + */ /* This lexer/parser stuff is currently global since yacc is hard to reenter */ -/*****************************************************************************/ +/**************************************************************************** + */ /* XXX This needs to be revisited, since BEGIN makes yacc re-enter... */ #ifdef __Lynx__ @@ -5878,7 +5902,7 @@ END_EXTERN_C #endif #endif -#define LEX_NOTPARSING 11 /* borrowed from toke.c */ +#define LEX_NOTPARSING 11 /* borrowed from toke.c */ typedef enum { XOPERATOR, @@ -5895,110 +5919,113 @@ typedef enum { /* update exp_name[] in toke.c if adding to this enum */ } expectation; -#define KEY_sigvar 0xFFFF /* fake keyword representing a signature var */ +#define KEY_sigvar 0xFFFF /* fake keyword representing + a signature var */ -/* Hints are now stored in a dedicated U32, so the bottom 8 bits are no longer - special and there is no need for HINT_PRIVATE_MASK for COPs. +/* Hints are now stored in a dedicated U32, so the bottom 8 bits are no + longer special and there is no need for HINT_PRIVATE_MASK for COPs. NOTE: The typical module using these has the bit value hard-coded, so don't blindly change the values of these. - If we run out of bits, the 2 locale ones could be combined. The PARTIAL one - is for "use locale 'FOO'" which excludes some categories. It requires going - to %^H to find out which are in and which are out. This could be extended - for the normal case of a plain HINT_LOCALE, so that %^H would be used for - any locale form. */ -#define HINT_INTEGER 0x00000001 /* integer pragma */ -#define HINT_STRICT_REFS 0x00000002 /* strict pragma */ -#define HINT_LOCALE 0x00000004 /* locale pragma */ -#define HINT_BYTES 0x00000008 /* bytes pragma */ -#define HINT_LOCALE_PARTIAL 0x00000010 /* locale, but a subset of categories */ - -#define HINT_EXPLICIT_STRICT_REFS 0x00000020 /* strict.pm */ -#define HINT_EXPLICIT_STRICT_SUBS 0x00000040 /* strict.pm */ -#define HINT_EXPLICIT_STRICT_VARS 0x00000080 /* strict.pm */ - -#define HINT_BLOCK_SCOPE 0x00000100 -#define HINT_STRICT_SUBS 0x00000200 /* strict pragma */ -#define HINT_STRICT_VARS 0x00000400 /* strict pragma */ -#define HINT_UNI_8_BIT 0x00000800 /* unicode_strings feature */ + If we run out of bits, the 2 locale ones could be combined. The + PARTIAL one is for "use locale 'FOO'" which excludes some + categories. It requires going to %^H to find out which are in and + which are out. This could be extended for the normal case of a plain + HINT_LOCALE, so that %^H would be used for any locale form. */ +#define HINT_INTEGER 0x00000001 /* integer pragma */ +#define HINT_STRICT_REFS 0x00000002 /* strict pragma */ +#define HINT_LOCALE 0x00000004 /* locale pragma */ +#define HINT_BYTES 0x00000008 /* bytes pragma */ +#define HINT_LOCALE_PARTIAL 0x00000010 /* locale, but a subset + of categories */ + +#define HINT_EXPLICIT_STRICT_REFS 0x00000020 /* strict.pm */ +#define HINT_EXPLICIT_STRICT_SUBS 0x00000040 /* strict.pm */ +#define HINT_EXPLICIT_STRICT_VARS 0x00000080 /* strict.pm */ + +#define HINT_BLOCK_SCOPE 0x00000100 +#define HINT_STRICT_SUBS 0x00000200 /* strict pragma */ +#define HINT_STRICT_VARS 0x00000400 /* strict pragma */ +#define HINT_UNI_8_BIT 0x00000800 /* unicode_strings feature */ /* The HINT_NEW_* constants are used by the overload pragma */ -#define HINT_NEW_INTEGER 0x00001000 -#define HINT_NEW_FLOAT 0x00002000 -#define HINT_NEW_BINARY 0x00004000 -#define HINT_NEW_STRING 0x00008000 -#define HINT_NEW_RE 0x00010000 -#define HINT_LOCALIZE_HH 0x00020000 /* %^H needs to be copied */ -#define HINT_LEXICAL_IO_IN 0x00040000 /* ${^OPEN} is set for input */ -#define HINT_LEXICAL_IO_OUT 0x00080000 /* ${^OPEN} is set for output */ +#define HINT_NEW_INTEGER 0x00001000 +#define HINT_NEW_FLOAT 0x00002000 +#define HINT_NEW_BINARY 0x00004000 +#define HINT_NEW_STRING 0x00008000 +#define HINT_NEW_RE 0x00010000 +#define HINT_LOCALIZE_HH 0x00020000 /* %^H needs to be copied */ +#define HINT_LEXICAL_IO_IN 0x00040000 /* ${^OPEN} is set for input */ +#define HINT_LEXICAL_IO_OUT 0x00080000 /* ${^OPEN} is set for output */ -#define HINT_RE_TAINT 0x00100000 /* re pragma */ -#define HINT_RE_EVAL 0x00200000 /* re pragma */ +#define HINT_RE_TAINT 0x00100000 /* re pragma */ +#define HINT_RE_EVAL 0x00200000 /* re pragma */ -#define HINT_FILETEST_ACCESS 0x00400000 /* filetest pragma */ -#define HINT_UTF8 0x00800000 /* utf8 pragma */ +#define HINT_FILETEST_ACCESS 0x00400000 /* filetest pragma */ +#define HINT_UTF8 0x00800000 /* utf8 pragma */ -#define HINT_NO_AMAGIC 0x01000000 /* overloading pragma */ +#define HINT_NO_AMAGIC 0x01000000 /* overloading pragma */ -#define HINT_RE_FLAGS 0x02000000 /* re '/xism' pragma */ +#define HINT_RE_FLAGS 0x02000000 /* re '/xism' pragma */ -#define HINT_FEATURE_MASK 0x3c000000 /* 4 bits for feature bundles */ +#define HINT_FEATURE_MASK 0x3c000000 /* 4 bits for feature bundles */ /* Note: Used for HINT_M_VMSISH_*, currently defined by vms/vmsish.h: - 0x40000000 - 0x80000000 + 0x40000000 0x80000000 */ -#define HINT_ALL_STRICT HINT_STRICT_REFS \ - | HINT_STRICT_SUBS \ +#define HINT_ALL_STRICT \ + HINT_STRICT_REFS \ + | HINT_STRICT_SUBS \ | HINT_STRICT_VARS #ifdef USE_STRICT_BY_DEFAULT -#define HINTS_DEFAULT HINT_ALL_STRICT +#define HINTS_DEFAULT HINT_ALL_STRICT #else -#define HINTS_DEFAULT 0 +#define HINTS_DEFAULT 0 #endif /* flags for PL_sawampersand */ -#define SAWAMPERSAND_LEFT 1 /* saw $` */ -#define SAWAMPERSAND_MIDDLE 2 /* saw $& */ -#define SAWAMPERSAND_RIGHT 4 /* saw $' */ +#define SAWAMPERSAND_LEFT 1 /* saw $` */ +#define SAWAMPERSAND_MIDDLE 2 /* saw $& */ +#define SAWAMPERSAND_RIGHT 4 /* saw $' */ #ifndef PERL_SAWAMPERSAND -# define PL_sawampersand \ - (SAWAMPERSAND_LEFT|SAWAMPERSAND_MIDDLE|SAWAMPERSAND_RIGHT) +# define PL_sawampersand \ + (SAWAMPERSAND_LEFT|SAWAMPERSAND_MIDDLE|SAWAMPERSAND_RIGHT) #endif /* Used for debugvar magic */ -#define DBVARMG_SINGLE 0 -#define DBVARMG_TRACE 1 -#define DBVARMG_SIGNAL 2 -#define DBVARMG_COUNT 3 +#define DBVARMG_SINGLE 0 +#define DBVARMG_TRACE 1 +#define DBVARMG_SIGNAL 2 +#define DBVARMG_COUNT 3 #define PL_DBsingle_iv (PL_DBcontrol[DBVARMG_SINGLE]) #define PL_DBtrace_iv (PL_DBcontrol[DBVARMG_TRACE]) #define PL_DBsignal_iv (PL_DBcontrol[DBVARMG_SIGNAL]) /* Various states of the input record separator SV (rs) */ -#define RsSNARF(sv) (! SvOK(sv)) -#define RsSIMPLE(sv) (SvOK(sv) && (! SvPOK(sv) || SvCUR(sv))) -#define RsPARA(sv) (SvPOK(sv) && ! SvCUR(sv)) -#define RsRECORD(sv) (SvROK(sv) && (SvIV(SvRV(sv)) > 0)) - -/* A struct for keeping various DEBUGGING related stuff, - * neatly packed. Currently only scratch variables for - * constructing debug output are included. Needed always, - * not just when DEBUGGING, though, because of the re extension. c*/ +#define RsSNARF(sv) (! SvOK(sv)) +#define RsSIMPLE(sv) (SvOK(sv) && (! SvPOK(sv) || SvCUR(sv))) +#define RsPARA(sv) (SvPOK(sv) && ! SvCUR(sv)) +#define RsRECORD(sv) (SvROK(sv) && (SvIV(SvRV(sv)) > 0)) + +/* A struct for keeping various DEBUGGING related stuff, neatly + * packed. Currently only scratch variables for constructing + * debug output are included. Needed always, not just when + * DEBUGGING, though, because of the re extension. c */ struct perl_debug_pad { - SV pad[3]; + SV pad[3]; }; -#define PERL_DEBUG_PAD(i) &(PL_debug_pad.pad[i]) -#define PERL_DEBUG_PAD_ZERO(i) (SvPVX(PERL_DEBUG_PAD(i))[0] = 0, \ - (((XPV*) SvANY(PERL_DEBUG_PAD(i)))->xpv_cur = 0), \ +#define PERL_DEBUG_PAD(i) &(PL_debug_pad.pad[i]) +#define PERL_DEBUG_PAD_ZERO(i) \ + (SvPVX(PERL_DEBUG_PAD(i))[0] = 0, \ + (((XPV*) SvANY(PERL_DEBUG_PAD(i)))->xpv_cur = 0), \ PERL_DEBUG_PAD(i)) /* Enable variables which are pointers to functions */ @@ -6011,8 +6038,8 @@ typedef char* (*re_intuit_start_t) (pTHX_ regexp *prog, SV *sv, char *strpos, char *strend, U32 flags, re_scream_pos_data *d); -typedef SV* (*re_intuit_string_t) (pTHX_ regexp *prog); -typedef void (*regfree_t) (pTHX_ struct regexp* r); +typedef SV* (*re_intuit_string_t) (pTHX_ regexp *prog); +typedef void (*regfree_t) (pTHX_ struct regexp* r); typedef regexp* (*regdupe_t) (pTHX_ const regexp* r, CLONE_PARAMS *param); typedef I32 (*re_fold_t)(pTHX_ const char *, char const *, I32); @@ -6026,10 +6053,10 @@ typedef void (*XSUBADDR_t) (pTHX_ CV *); enum Perl_custom_infix_precedence { /* These numbers are spaced out to give room to insert new values as - * required. They form part of the ABI contract with XS::Parse::Infix so - * they should not be changed within a stable release cycle, but they can - * be freely altered during a development cycle because no ABI guarantees - * are made at that time */ + * required. They form part of the ABI contract with + * XS::Parse::Infix so they should not be changed within a stable + * release cycle, but they can be freely altered during a development + * cycle because no ABI guarantees are made at that time */ INFIX_PREC_LOW = 10, /* non-associative */ INFIX_PREC_LOGICAL_OR_LOW = 30, /* left-associative, as `or` */ INFIX_PREC_LOGICAL_AND_LOW = 40, /* left-associative, as `and` */ @@ -6041,14 +6068,16 @@ enum Perl_custom_infix_precedence { INFIX_PREC_MUL = 130, /* left-associative, as `*` */ INFIX_PREC_POW = 150, /* right-associative, as `**` */ INFIX_PREC_HIGH = 170, /* non-associative */ - /* Try to keep within the range of a U8 in case we need to split the field - * and add flags */ + /* Try to keep within the range of a U8 in case + * we need to split the field and add flags */ }; struct Perl_custom_infix; struct Perl_custom_infix { enum Perl_custom_infix_precedence prec; - void (*parse)(pTHX_ SV **opdata, struct Perl_custom_infix *); /* optional */ - OP *(*build_op)(pTHX_ SV **opdata, OP *lhs, OP *rhs, struct Perl_custom_infix *); + void (*parse) (pTHX_ SV **opdata, struct Perl_custom_infix *); \ + /* optional + */ + OP *(*build_op)(pTHX_ SV **opdata, OP *lhs, OP *rhs, struct Perl_custom_infix *); }; typedef OP* (*Perl_ppaddr_t)(pTHX); @@ -6060,51 +6089,52 @@ typedef void(*Perl_cpeep_t)(pTHX_ OP *, OP *); typedef void(*globhook_t)(pTHX); -#define KEYWORD_PLUGIN_DECLINE 0 -#define KEYWORD_PLUGIN_STMT 1 -#define KEYWORD_PLUGIN_EXPR 2 +#define KEYWORD_PLUGIN_DECLINE 0 +#define KEYWORD_PLUGIN_STMT 1 +#define KEYWORD_PLUGIN_EXPR 2 /* Interpreter exitlist entry */ typedef struct exitlistentry { - void (*fn) (pTHX_ void*); - void *ptr; + void (*fn)(pTHX_ void*); + void *ptr; } PerlExitListEntry; -/* if you only have signal() and it resets on each signal, FAKE_PERSISTENT_SIGNAL_HANDLERS fixes */ +/* if you only have signal() and it resets on each signal, + FAKE_PERSISTENT_SIGNAL_HANDLERS fixes */ /* These have to be before perlvars.h */ #if !defined(HAS_SIGACTION) && defined(VMS) -# define FAKE_PERSISTENT_SIGNAL_HANDLERS +# define FAKE_PERSISTENT_SIGNAL_HANDLERS #endif -/* if we're doing kill() with sys$sigprc on VMS, FAKE_DEFAULT_SIGNAL_HANDLERS */ +/* if we're doing kill() with sys$sigprc on + VMS, FAKE_DEFAULT_SIGNAL_HANDLERS */ #if defined(KILL_BY_SIGPRC) -# define FAKE_DEFAULT_SIGNAL_HANDLERS +# define FAKE_DEFAULT_SIGNAL_HANDLERS #endif #if !defined(MULTIPLICITY) struct interpreter { - char broiled; + char broiled; }; #else -/* If we have multiple interpreters define a struct - holding variables which must be per-interpreter - If we don't have threads anything that would have - be per-thread is per-interpreter. -*/ +/* If we have multiple interpreters define a struct holding variables + which must be per-interpreter If we don't have threads anything + that would have be per-thread is per-interpreter. + */ /* Set up PERLVAR macros for populating structs */ -# define PERLVAR(prefix,var,type) type prefix##var; +# define PERLVAR(prefix,var,type) type prefix##var; /* 'var' is an array of length 'n' */ -# define PERLVARA(prefix,var,n,type) type prefix##var[n]; +# define PERLVARA(prefix,var,n,type) type prefix##var[n]; /* initialize 'var' to init' */ -# define PERLVARI(prefix,var,type,init) type prefix##var; +# define PERLVARI(prefix,var,type,init) type prefix##var; /* like PERLVARI, but make 'var' a const */ -# define PERLVARIC(prefix,var,type,init) type prefix##var; +# define PERLVARIC(prefix,var,type,init) type prefix##var; struct interpreter { # include "intrpvar.h" @@ -6113,13 +6143,13 @@ struct interpreter { EXTCONST U16 PL_interp_size INIT(sizeof(struct interpreter)); -# define PERL_INTERPRETER_SIZE_UPTO_MEMBER(member) \ - STRUCT_OFFSET(struct interpreter, member) + \ - sizeof(((struct interpreter*)0)->member) +# define PERL_INTERPRETER_SIZE_UPTO_MEMBER(member) \ + STRUCT_OFFSET(struct interpreter, member) + \ + sizeof(((struct interpreter*)0)->member) -/* This will be useful for subsequent releases, because this has to be the - same in your libperl as in main(), else you have a mismatch and must abort. -*/ +/* This will be useful for subsequent releases, because this has to be the same + in your libperl as in main(), else you have a mismatch and must abort. + */ EXTCONST U16 PL_interp_size_5_18_0 INIT(PERL_INTERPRETER_SIZE_UPTO_MEMBER(PERL_LAST_5_18_0_INTERP_MEMBER)); @@ -6139,17 +6169,17 @@ struct tempsym; /* defined in pp_pack.c */ #undef PERL_CKDEF #undef PERL_PPDEF -#define PERL_CKDEF(s) PERL_CALLCONV OP *s (pTHX_ OP *o); -#define PERL_PPDEF(s) PERL_CALLCONV OP *s (pTHX); +#define PERL_CKDEF(s) PERL_CALLCONV OP *s (pTHX_ OP *o); +#define PERL_PPDEF(s) PERL_CALLCONV OP *s (pTHX); #ifdef MYMALLOC # include "malloc_ctl.h" #endif /* - * This provides a layer of functions and macros to ensure extensions will - * get to use the same RTL functions as the core. - */ + * This provides a layer of functions and macros to ensure extensions + * will get to use the same RTL functions as the core. +*/ #if defined(WIN32) # include "win32iop.h" #endif @@ -6166,34 +6196,33 @@ struct tempsym; /* defined in pp_pack.c */ # include "embedvar.h" #endif -/* Now include all the 'global' variables - * If we don't have threads or multiple interpreters - * these include variables that would have been their struct-s +/* Now include all the 'global' variables If we don't have threads or multiple + * interpreters these include variables that would have been their struct-s */ -#define PERLVAR(prefix,var,type) EXT type PL_##var; -#define PERLVARA(prefix,var,n,type) EXT type PL_##var[n]; -#define PERLVARI(prefix,var,type,init) EXT type PL_##var INIT(init); +#define PERLVAR(prefix,var,type) EXT type PL_##var; +#define PERLVARA(prefix,var,n,type) EXT type PL_##var[n]; +#define PERLVARI(prefix,var,type,init) EXT type PL_##var INIT(init); #define PERLVARIC(prefix,var,type,init) EXTCONST type PL_##var INIT(init); #if !defined(MULTIPLICITY) START_EXTERN_C # include "intrpvar.h" END_EXTERN_C -# define PL_sv_yes (PL_sv_immortals[0]) -# define PL_sv_undef (PL_sv_immortals[1]) -# define PL_sv_no (PL_sv_immortals[2]) -# define PL_sv_zero (PL_sv_immortals[3]) +# define PL_sv_yes (PL_sv_immortals[0]) +# define PL_sv_undef (PL_sv_immortals[1]) +# define PL_sv_no (PL_sv_immortals[2]) +# define PL_sv_zero (PL_sv_immortals[3]) #endif #ifdef PERL_CORE -/* All core uses now exterminated. Ensure no zombies can return: */ +/* All core uses now exterminated. Ensure no zombies can return: */ # undef PL_na #endif /* Now all the config stuff is setup we can include embed.h - In particular, need the relevant *ish file included already, as it may - define HAVE_INTERP_INTERN */ + In particular, need the relevant *ish file included + already, as it may define HAVE_INTERP_INTERN */ #include "embed.h" START_EXTERN_C @@ -6209,15 +6238,16 @@ END_EXTERN_C #if !defined(MULTIPLICITY) /* Set up PERLVAR macros for populating structs */ -# define PERLVAR(prefix,var,type) type prefix##var; +# define PERLVAR(prefix,var,type) type prefix##var; /* 'var' is an array of length 'n' */ -# define PERLVARA(prefix,var,n,type) type prefix##var[n]; +# define PERLVARA(prefix,var,n,type) type prefix##var[n]; /* initialize 'var' to init' */ -# define PERLVARI(prefix,var,type,init) type prefix##var; +# define PERLVARI(prefix,var,type,init) type prefix##var; /* like PERLVARI, but make 'var' a const */ -# define PERLVARIC(prefix,var,type,init) type prefix##var; +# define PERLVARIC(prefix,var,type,init) type prefix##var; -/* this is never instantiated, is it just used for sizeof(struct PerlHandShakeInterpreter) */ +/* this is never instantiated, is it just used for + sizeof(struct PerlHandShakeInterpreter) */ struct PerlHandShakeInterpreter { # include "intrpvar.h" }; @@ -6237,20 +6267,20 @@ EXTCONST runops_proc_t PL_runops_std EXTCONST runops_proc_t PL_runops_dbg INIT(Perl_runops_debug); -#define EXT_MGVTBL EXTCONST MGVTBL +#define EXT_MGVTBL EXTCONST MGVTBL -#define PERL_MAGIC_READONLY_ACCEPTABLE 0x40 -#define PERL_MAGIC_VALUE_MAGIC 0x80 -#define PERL_MAGIC_VTABLE_MASK 0x3F +#define PERL_MAGIC_READONLY_ACCEPTABLE 0x40 +#define PERL_MAGIC_VALUE_MAGIC 0x80 +#define PERL_MAGIC_VTABLE_MASK 0x3F /* can this type of magic be attached to a readonly SV? */ -#define PERL_MAGIC_TYPE_READONLY_ACCEPTABLE(t) \ +#define PERL_MAGIC_TYPE_READONLY_ACCEPTABLE(t) \ (PL_magic_data[(U8)(t)] & PERL_MAGIC_READONLY_ACCEPTABLE) -/* Is this type of magic container magic (%ENV, $1 etc), - * or value magic (pos, taint etc)? +/* Is this type of magic container magic (%ENV, + * $1 etc), or value magic (pos, taint etc)? */ -#define PERL_MAGIC_TYPE_IS_VALUE_MAGIC(t) \ +#define PERL_MAGIC_TYPE_IS_VALUE_MAGIC(t) \ (PL_magic_data[(U8)(t)] & PERL_MAGIC_VALUE_MAGIC) #include "mg_vtable.h" @@ -6268,7 +6298,8 @@ EXTCONST U8 PL_magic_data[256]; #endif #ifdef DOINIT - /* NL IV NV PV INV PI PN MG RX GV LV AV HV CV FM IO OBJ */ + /* NL IV NV PV INV PI PN MG RX GV + LV AV HV CV FM IO OBJ */ EXTCONST bool PL_valid_types_IVX[] = { 0, 1, 0, 0, 0, 1, 1, 1, 0, 1, 1, 0, 0, 0, 0, 0, 0 }; EXTCONST bool @@ -6284,14 +6315,16 @@ PL_valid_types_NV_set[] = { 0, 0, 1, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0 }; EXTCONST U8 PL_deBruijn_bitpos_tab32[] = { - /* https://graphics.stanford.edu/~seander/bithacks.html#IntegerLogDeBruijn */ + /* https://graphics.stanford.edu/~seander/bithacks.html#IntegerLogDeBruijn + */ 0, 1, 28, 2, 29, 14, 24, 3, 30, 22, 20, 15, 25, 17, 4, 8, 31, 27, 13, 23, 21, 19, 16, 7, 26, 12, 18, 6, 11, 5, 10, 9 }; EXTCONST U8 PL_deBruijn_bitpos_tab64[] = { - /* https://stackoverflow.com/questions/11376288/fast-computing-of-log2-for-64-bit-integers */ + /* https://stackoverflow.com/questions/11376288/fast-computing-of-log2-for-64-bit-integers + */ 63, 0, 58, 1, 59, 47, 53, 2, 60, 39, 48, 27, 54, 33, 42, 3, 61, 51, 37, 40, 49, 18, 28, 20, 55, 30, 34, 11, 43, 14, 22, 4, 62, 57, 46, 52, 38, 26, 32, 41, 50, 36, 17, 19, 29, 10, 13, 21, @@ -6312,101 +6345,100 @@ EXTCONST U8 PL_deBruijn_bitpos_tab64[]; #endif /* The constants for using PL_deBruijn_bitpos_tab */ -#define PERL_deBruijnMagic32_ 0x077CB531 -#define PERL_deBruijnShift32_ 27 -#define PERL_deBruijnMagic64_ 0x07EDD5E59A4E28C2 -#define PERL_deBruijnShift64_ 58 - -/* In C99 we could use designated (named field) union initializers. - * In C89 we need to initialize the member declared first. - * In C++ we need extern C initializers. +#define PERL_deBruijnMagic32_ 0x077CB531 +#define PERL_deBruijnShift32_ 27 +#define PERL_deBruijnMagic64_ 0x07EDD5E59A4E28C2 +#define PERL_deBruijnShift64_ 58 + +/* In C99 we could use designated (named field) union + * initializers. In C89 we need to initialize the member declared + * first. In C++ we need extern C initializers. * * With the U8_NV version you will want to have inner braces, * while with the NV_U8 use just the NV. */ -#define INFNAN_U8_NV_DECL EXTCONST union { U8 u8[NVSIZE]; NV nv; } -#define INFNAN_NV_U8_DECL EXTCONST union { NV nv; U8 u8[NVSIZE]; } +#define INFNAN_U8_NV_DECL EXTCONST union { U8 u8[NVSIZE]; NV nv; } +#define INFNAN_NV_U8_DECL EXTCONST union { NV nv; U8 u8[NVSIZE]; } /* if these never got defined, they need defaults */ #ifndef PERL_SET_CONTEXT -# define PERL_SET_CONTEXT(i) PERL_SET_INTERP(i) +# define PERL_SET_CONTEXT(i) PERL_SET_INTERP(i) #endif #ifdef USE_PERL_SWITCH_LOCALE_CONTEXT -# define PERL_SET_LOCALE_CONTEXT(i) \ - STMT_START { \ - if (UNLIKELY(PL_veto_switch_non_tTHX_context)) \ - Perl_switch_locale_context(); \ - } STMT_END +# define PERL_SET_LOCALE_CONTEXT(i) \ + STMT_START { \ + if (UNLIKELY(PL_veto_switch_non_tTHX_context)) \ + Perl_switch_locale_context(); \ + } STMT_END #else -# define PERL_SET_LOCALE_CONTEXT(i) NOOP +# define PERL_SET_LOCALE_CONTEXT(i) NOOP #endif -/* In some Configurations there may be per-thread information that is carried - * in a library instead of perl's tTHX structure. This macro is to be used to - * handle those when tTHX is changed. Only locale handling is currently known - * to be affected. */ -#define PERL_SET_NON_tTHX_CONTEXT(i) \ - STMT_START { PERL_SET_LOCALE_CONTEXT(i); } STMT_END +/* In some Configurations there may be per-thread information that + * is carried in a library instead of perl's tTHX structure. This + * macro is to be used to handle those when tTHX is changed. Only + * locale handling is currently known to be affected. */ +#define PERL_SET_NON_tTHX_CONTEXT(i) \ + STMT_START { PERL_SET_LOCALE_CONTEXT(i); } STMT_END #ifndef PERL_GET_CONTEXT -# define PERL_GET_CONTEXT PERL_GET_INTERP +# define PERL_GET_CONTEXT PERL_GET_INTERP #endif #ifndef PERL_GET_THX -# define PERL_GET_THX ((void*)NULL) +# define PERL_GET_THX ((void*)NULL) #endif #ifndef PERL_SET_THX -# define PERL_SET_THX(t) NOOP +# define PERL_SET_THX(t) NOOP #endif #ifndef EBCDIC -/* The tables below are adapted from - * https://bjoern.hoehrmann.de/utf-8/decoder/dfa/, which requires this copyright - * notice: - -Copyright (c) 2008-2009 Bjoern Hoehrmann - -Permission is hereby granted, free of charge, to any person obtaining a copy of -this software and associated documentation files (the "Software"), to deal in -the Software without restriction, including without limitation the rights to -use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies -of the Software, and to permit persons to whom the Software is furnished to do -so, subject to the following conditions: - -The above copyright notice and this permission notice shall be included in all -copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE -SOFTWARE. - -*/ +/* The tables below are adapted from * + https://bjoern.hoehrmann.de/utf-8/decoder/dfa/, which requires this + copyright * notice: + + Copyright (c) 2008-2009 Bjoern Hoehrmann + + Permission is hereby granted, free of charge, to any person obtaining a + copy of this software and associated documentation files (the "Software"), + to deal in the Software without restriction, including without limitation + the rights to use, copy, modify, merge, publish, distribute, sublicense, + and/or sell copies of the Software, and to permit persons to whom the + Software is furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING + FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER + DEALINGS IN THE SOFTWARE. + */ # ifdef DOINIT # if 0 /* This is the original table given in https://bjoern.hoehrmann.de/utf-8/decoder/dfa/ */ static U8 utf8d_C9[] = { - /* The first part of the table maps bytes to character classes that - * to reduce the size of the transition table and create bitmasks. */ - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /*-1F*/ - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /*-3F*/ - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /*-5F*/ - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /*-7F*/ - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9, /*-9F*/ - 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, /*-BF*/ - 8,8,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, /*-DF*/ - 10,3,3,3,3,3,3,3,3,3,3,3,3,4,3,3, 11,6,6,6,5,8,8,8,8,8,8,8,8,8,8,8, /*-FF*/ - - /* The second part is a transition table that maps a combination - * of a state of the automaton and a character class to a state. */ + /* The first part of the table maps bytes to character classes that to + * reduce the size of the transition table and create bitmasks. */ + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /*-1F */ + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /*-3F */ + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /*-5F */ + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /*-7F */ + 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9, /*-9F */ + 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, /*-BF */ + 8,8,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, /*-DF */ + 10,3,3,3,3,3,3,3,3,3,3,3,3,4,3,3, 11,6,6,6,5,8,8,8,8,8,8,8,8,8,8,8, /*-FF */ + + /* The second part is a transition table that maps a combination of + * a state of the automaton and a character class to a state. */ 0,12,24,36,60,96,84,12,12,12,48,72, 12,12,12,12,12,12,12,12,12,12,12,12, 12, 0,12,12,12,12,12, 0,12, 0,12,12, 12,24,12,12,12,12,12,24,12,24,12,12, 12,12,12,12,12,12,12,24,12,12,12,12, 12,24,12,12,12,12,12,12,12,24,12,12, @@ -6442,93 +6474,78 @@ static U8 utf8d_C9[] = { * new nodes. The array would have to be made U16 instead of U8, not worth it * for this rarely encountered case * - * The classes are - * 00-7F 0 Always legal, single byte sequence - * 80-81 7 Not legal immediately after start bytes E0 F0 F8 FC - * FE - * 82-83 8 Not legal immediately after start bytes E0 F0 F8 FC - * 84-87 9 Not legal immediately after start bytes E0 F0 F8 - * 88-8F 10 Not legal immediately after start bytes E0 F0 - * 90-9F 11 Not legal immediately after start byte E0 - * A0-BF 12 Always legal continuation byte - * C0,C1 1 Not legal: overlong - * C2-DF 2 Legal start byte for two byte sequences - * E0 13 Some sequences are overlong; others legal - * E1-EF 3 Legal start byte for three byte sequences - * F0 14 Some sequences are overlong; others legal - * F1-F7 4 Legal start byte for four byte sequences - * F8 15 Some sequences are overlong; others legal - * F9-FB 5 Legal start byte for five byte sequences - * FC 16 Some sequences are overlong; others legal - * FD 6 Legal start byte for six byte sequences - * FE 17 Some sequences are overlong; others legal - * (is 1 on 32-bit machines, since it overflows) - * FF 1 Need to handle specially + * The classes are 00-7F 0 Always legal, single byte sequence 80-81 7 Not legal + * immediately after start bytes E0 F0 F8 FC FE 82-83 8 Not legal immediately + * after start bytes E0 F0 F8 FC 84-87 9 Not legal immediately after start + * bytes E0 F0 F8 88-8F 10 Not legal immediately after start bytes E0 F0 90-9F + * 11 Not legal immediately after start byte E0 A0-BF 12 Always legal + * continuation byte C0,C1 1 Not legal: overlong C2-DF 2 Legal start byte for + * two byte sequences E0 13 Some sequences are overlong; others legal E1-EF 3 + * Legal start byte for three byte sequences F0 14 Some sequences are overlong; + * others legal F1-F7 4 Legal start byte for four byte sequences F8 15 Some + * sequences are overlong; others legal F9-FB 5 Legal start byte for five byte + * sequences FC 16 Some sequences are overlong; others legal FD 6 Legal start + * byte for six byte sequences FE 17 Some sequences are overlong; others legal + * (is 1 on 32-bit machines, since it overflows) FF 1 Need to handle specially */ EXTCONST U8 PL_extended_utf8_dfa_tab[] = { /* The first part of the table maps bytes to character classes to reduce * the size of the transition table and create bitmasks. */ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*00-0F*/ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*10-1F*/ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*20-2F*/ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*30-3F*/ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*40-4F*/ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*50-5F*/ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*60-6F*/ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*70-7F*/ - 7, 7, 8, 8, 9, 9, 9, 9,10,10,10,10,10,10,10,10, /*80-8F*/ - 11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11, /*90-9F*/ - 12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12, /*A0-AF*/ - 12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12, /*B0-BF*/ - 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, /*C0-CF*/ - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, /*D0-DF*/ - 13, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, /*E0-EF*/ - 14, 4, 4, 4, 4, 4, 4, 4,15, 5, 5, 5,16, 6, /*F0-FD*/ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*00-0F */ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*10-1F */ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*20-2F */ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*30-3F */ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*40-4F */ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*50-5F */ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*60-6F */ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*70-7F */ + 7, 7, 8, 8, 9, 9, 9, 9,10,10,10,10,10,10,10,10, /*80-8F */ + 11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11, /*90-9F */ + 12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12, /*A0-AF */ + 12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12, /*B0-BF */ + 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, /*C0-CF */ + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, /*D0-DF */ + 13, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, /*E0-EF */ + 14, 4, 4, 4, 4, 4, 4, 4,15, 5, 5, 5,16, 6, /*F0-FD */ # ifdef UV_IS_QUAD - 17, /*FE*/ + 17, /*FE */ # else - 1, /*FE*/ + 1, /*FE */ # endif - 1, /*FF*/ - -/* The second part is a transition table that maps a combination - * of a state of the automaton and a character class to a new state, called a - * node. The nodes are: - * N0 The initial state, and final accepting one. - * N1 Any one continuation byte (80-BF) left. This is transitioned to - * immediately when the start byte indicates a two-byte sequence - * N2 Any two continuation bytes left. - * N3 Any three continuation bytes left. - * N4 Any four continuation bytes left. - * N5 Any five continuation bytes left. - * N6 Start byte is E0. Continuation bytes 80-9F are illegal (overlong); - * the other continuations transition to N1 - * N7 Start byte is F0. Continuation bytes 80-8F are illegal (overlong); - * the other continuations transition to N2 - * N8 Start byte is F8. Continuation bytes 80-87 are illegal (overlong); - * the other continuations transition to N3 - * N9 Start byte is FC. Continuation bytes 80-83 are illegal (overlong); - * the other continuations transition to N4 - * N10 Start byte is FE. Continuation bytes 80-81 are illegal (overlong); - * the other continuations transition to N5 - * 1 Reject. All transitions not mentioned above (except the single - * byte ones (as they are always legal)) are to this state. + 1, /*FF */ + +/* The second part is a transition table that maps a combination of a state of + * the automaton and a character class to a new state, called a node. The + * nodes are: N0 The initial state, and final accepting one. N1 Any one + * continuation byte (80-BF) left. This is transitioned to immediately when + * the start byte indicates a two-byte sequence N2 Any two continuation bytes + * left. N3 Any three continuation bytes left. N4 Any four continuation + * bytes left. N5 Any five continuation bytes left. N6 Start byte is E0. + * Continuation bytes 80-9F are illegal (overlong); the other continuations + * transition to N1 N7 Start byte is F0. Continuation bytes 80-8F are illegal + * (overlong); the other continuations transition to N2 N8 Start byte is F8. + * Continuation bytes 80-87 are illegal (overlong); the other continuations + * transition to N3 N9 Start byte is FC. Continuation bytes 80-83 are illegal + * (overlong); the other continuations transition to N4 N10 Start byte is FE. + * Continuation bytes 80-81 are illegal (overlong); the other continuations + * transition to N5 1 Reject. All transitions not mentioned above (except the + * single byte ones (as they are always legal)) are to this state. */ # if defined(PERL_CORE) -# define NUM_CLASSES 18 -# define N0 0 -# define N1 ((N0) + NUM_CLASSES) -# define N2 ((N1) + NUM_CLASSES) -# define N3 ((N2) + NUM_CLASSES) -# define N4 ((N3) + NUM_CLASSES) -# define N5 ((N4) + NUM_CLASSES) -# define N6 ((N5) + NUM_CLASSES) -# define N7 ((N6) + NUM_CLASSES) -# define N8 ((N7) + NUM_CLASSES) -# define N9 ((N8) + NUM_CLASSES) -# define N10 ((N9) + NUM_CLASSES) +# define NUM_CLASSES 18 +# define N0 0 +# define N1 ((N0) + NUM_CLASSES) +# define N2 ((N1) + NUM_CLASSES) +# define N3 ((N2) + NUM_CLASSES) +# define N4 ((N3) + NUM_CLASSES) +# define N5 ((N4) + NUM_CLASSES) +# define N6 ((N5) + NUM_CLASSES) +# define N7 ((N6) + NUM_CLASSES) +# define N8 ((N7) + NUM_CLASSES) +# define N9 ((N8) + NUM_CLASSES) +# define N10 ((N9) + NUM_CLASSES) /*Class: 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 */ /*N0*/ 0, 1,N1,N2,N3,N4,N5, 1, 1, 1, 1, 1, 1,N6,N7,N8,N9,N10, @@ -6551,17 +6568,15 @@ EXTCONST U8 PL_extended_utf8_dfa_tab[] = { * that can be returned immediately. * * The "Implementation details" portion of - * https://bjoern.hoehrmann.de/utf-8/decoder/dfa/ shows how - * the first portion of the table maps each possible byte into a character - * class. And that the classes for those bytes which are start bytes have been - * carefully chosen so they serve as well to be used as a shift value to mask - * off the leading 1 bits of the start byte. Unfortunately the addition of - * being able to distinguish non-characters makes this not fully work. This is - * because, now, the start bytes E1-EF have to be broken into 3 classes instead - * of 2: - * 1) ED because it could be a surrogate - * 2) EF because it could be a non-character - * 3) the rest, which can never evaluate to a problematic code point. + * https://bjoern.hoehrmann.de/utf-8/decoder/dfa/ shows how the first portion + * of the table maps each possible byte into a character class. And that the + * classes for those bytes which are start bytes have been carefully chosen so + * they serve as well to be used as a shift value to mask off the leading 1 + * bits of the start byte. Unfortunately the addition of being able to + * distinguish non-characters makes this not fully work. This is because, now, + * the start bytes E1-EF have to be broken into 3 classes instead of 2: 1) ED + * because it could be a surrogate 2) EF because it could be a non-character 3) + * the rest, which can never evaluate to a problematic code point. * * Each of E1-EF has three leading 1 bits, then a 0. That means we could use a * shift (and hence class number) of either 3 or 4 to get a mask that works. @@ -6570,90 +6585,63 @@ EXTCONST U8 PL_extended_utf8_dfa_tab[] = { * drops out immediately for that. In the dfa, classes 3 and 4 are used to * distinguish EF vs the rest. Then special code is used to deal with ED, * that's executed only when the dfa drops out. The code points started by ED - * are half surrogates, and half hangul syllables. This means that 2048 of - * the hangul syllables (about 18%) take longer than all other non-problematic - * code points to handle. + * are half surrogates, and half hangul syllables. This means that 2048 of the + * hangul syllables (about 18%) take longer than all other non-problematic code + * points to handle. * * The changes to handle non-characters requires the addition of states and * classes to the dfa. (See the section on "Mapping bytes to character * classes" in the linked-to document for further explanation of the original * dfa.) * - * The classes are - * 00-7F 0 - * 80-8E 9 - * 8F 10 - * 90-9E 11 - * 9F 12 - * A0-AE 13 - * AF 14 - * B0-B6 15 - * B7 16 - * B8-BD 15 - * BE 17 - * BF 18 - * C0,C1 1 - * C2-DF 2 - * E0 7 - * E1-EC 3 - * ED 1 - * EE 3 - * EF 4 - * F0 8 - * F1-F3 6 (6 bits can be stripped) - * F4 5 (only 5 can be stripped) - * F5-FF 1 + * The classes are 00-7F 0 80-8E 9 8F 10 90-9E 11 9F 12 A0-AE 13 AF 14 B0-B6 15 + * B7 16 B8-BD 15 BE 17 BF 18 C0,C1 1 C2-DF 2 E0 7 E1-EC 3 ED 1 EE 3 EF 4 F0 8 + * F1-F3 6 (6 bits can be stripped) F4 5 (only 5 can be stripped) F5-FF 1 */ EXTCONST U8 PL_strict_utf8_dfa_tab[] = { /* The first part of the table maps bytes to character classes to reduce * the size of the transition table and create bitmasks. */ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*00-0F*/ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*10-1F*/ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*20-2F*/ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*30-3F*/ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*40-4F*/ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*50-5F*/ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*60-6F*/ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*70-7F*/ - 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,10, /*80-8F*/ - 11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,12, /*90-9F*/ - 13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,14, /*A0-AF*/ - 15,15,15,15,15,15,15,16,15,15,15,15,15,15,17,18, /*B0-BF*/ - 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, /*C0-CF*/ - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, /*D0-DF*/ - 7, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 1, 3, 4, /*E0-EF*/ - 8, 6, 6, 6, 5, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, /*F0-FF*/ - -/* The second part is a transition table that maps a combination - * of a state of the automaton and a character class to a new state, called a - * node. The nodes are: - * N0 The initial state, and final accepting one. - * N1 Any one continuation byte (80-BF) left. This is transitioned to - * immediately when the start byte indicates a two-byte sequence - * N2 Any two continuation bytes left. - * N3 Start byte is E0. Continuation bytes 80-9F are illegal (overlong); - * the other continuations transition to state N1 - * N4 Start byte is EF. Continuation byte B7 transitions to N8; BF to N9; - * the other continuations transitions to N1 - * N5 Start byte is F0. Continuation bytes 80-8F are illegal (overlong); - * [9AB]F transition to N10; the other continuations to N2. - * N6 Start byte is F[123]. Continuation bytes [89AB]F transition - * to N10; the other continuations to N2. - * N7 Start byte is F4. Continuation bytes 90-BF are illegal - * (non-unicode); 8F transitions to N10; the other continuations to N2 - * N8 Initial sequence is EF B7. Continuation bytes 90-AF are illegal - * (non-characters); the other continuations transition to N0. - * N9 Initial sequence is EF BF. Continuation bytes BE and BF are illegal - * (non-characters); the other continuations transition to N0. - * N10 Initial sequence is one of: F0 [9-B]F; F[123] [8-B]F; or F4 8F. - * Continuation byte BF transitions to N11; the other continuations to - * N1 - * N11 Initial sequence is the two bytes given in N10 followed by BF. - * Continuation bytes BE and BF are illegal (non-characters); the other - * continuations transition to N0. - * 1 Reject. All transitions not mentioned above (except the single - * byte ones (as they are always legal) are to this state. + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*00-0F */ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*10-1F */ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*20-2F */ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*30-3F */ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*40-4F */ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*50-5F */ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*60-6F */ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*70-7F */ + 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,10, /*80-8F */ + 11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,12, /*90-9F */ + 13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,14, /*A0-AF */ + 15,15,15,15,15,15,15,16,15,15,15,15,15,15,17,18, /*B0-BF */ + 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, /*C0-CF */ + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, /*D0-DF */ + 7, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 1, 3, 4, /*E0-EF */ + 8, 6, 6, 6, 5, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, /*F0-FF */ + +/* The second part is a transition table that maps a combination of a state of + * the automaton and a character class to a new state, called a node. The + * nodes are: N0 The initial state, and final accepting one. N1 Any one + * continuation byte (80-BF) left. This is transitioned to immediately when + * the start byte indicates a two-byte sequence N2 Any two continuation bytes + * left. N3 Start byte is E0. Continuation bytes 80-9F are illegal + * (overlong); the other continuations transition to state N1 N4 Start byte is + * EF. Continuation byte B7 transitions to N8; BF to N9; the other + * continuations transitions to N1 N5 Start byte is F0. Continuation bytes + * 80-8F are illegal (overlong); [9AB]F transition to N10; the other + * continuations to N2. N6 Start byte is F[123]. Continuation bytes [89AB]F + * transition to N10; the other continuations to N2. N7 Start byte is F4. + * Continuation bytes 90-BF are illegal (non-unicode); 8F transitions to N10; + * the other continuations to N2 N8 Initial sequence is EF B7. Continuation + * bytes 90-AF are illegal (non-characters); the other continuations transition + * to N0. N9 Initial sequence is EF BF. Continuation bytes BE and BF are + * illegal (non-characters); the other continuations transition to N0. N10 + * Initial sequence is one of: F0 [9-B]F; F[123] [8-B]F; or F4 8F. + * Continuation byte BF transitions to N11; the other continuations to N1 N11 + * Initial sequence is the two bytes given in N10 followed by BF. Continuation + * bytes BE and BF are illegal (non-characters); the other continuations + * transition to N0. 1 Reject. All transitions not mentioned above (except + * the single byte ones (as they are always legal) are to this state. */ # undef N0 @@ -6667,19 +6655,19 @@ EXTCONST U8 PL_strict_utf8_dfa_tab[] = { # undef N8 # undef N9 # undef NUM_CLASSES -# define NUM_CLASSES 19 -# define N0 0 -# define N1 ((N0) + NUM_CLASSES) -# define N2 ((N1) + NUM_CLASSES) -# define N3 ((N2) + NUM_CLASSES) -# define N4 ((N3) + NUM_CLASSES) -# define N5 ((N4) + NUM_CLASSES) -# define N6 ((N5) + NUM_CLASSES) -# define N7 ((N6) + NUM_CLASSES) -# define N8 ((N7) + NUM_CLASSES) -# define N9 ((N8) + NUM_CLASSES) -# define N10 ((N9) + NUM_CLASSES) -# define N11 ((N10) + NUM_CLASSES) +# define NUM_CLASSES 19 +# define N0 0 +# define N1 ((N0) + NUM_CLASSES) +# define N2 ((N1) + NUM_CLASSES) +# define N3 ((N2) + NUM_CLASSES) +# define N4 ((N3) + NUM_CLASSES) +# define N5 ((N4) + NUM_CLASSES) +# define N6 ((N5) + NUM_CLASSES) +# define N7 ((N6) + NUM_CLASSES) +# define N8 ((N7) + NUM_CLASSES) +# define N9 ((N8) + NUM_CLASSES) +# define N10 ((N9) + NUM_CLASSES) +# define N11 ((N10) + NUM_CLASSES) /*Class: 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 */ /*N0*/ 0, 1, N1, N2, N4, N7, N6, N3, N5, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, @@ -6697,66 +6685,50 @@ EXTCONST U8 PL_strict_utf8_dfa_tab[] = { /*N11*/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, }; -/* And below is yet another version of the above tables that accepts only UTF-8 - * as defined by Corregidum #9. Hence no surrogates nor non-Unicode, but - * it allows non-characters. This is isomorphic to the original table - * in https://bjoern.hoehrmann.de/utf-8/decoder/dfa/ +/* And below is yet another version of the above tables that accepts + * only UTF-8 as defined by Corregidum #9. Hence no surrogates nor + * non-Unicode, but it allows non-characters. This is isomorphic to the + * original table in https://bjoern.hoehrmann.de/utf-8/decoder/dfa/ * - * The classes are - * 00-7F 0 - * 80-8F 9 - * 90-9F 10 - * A0-BF 11 - * C0,C1 1 - * C2-DF 2 - * E0 7 - * E1-EC 3 - * ED 4 - * EE-EF 3 - * F0 8 - * F1-F3 6 (6 bits can be stripped) - * F4 5 (only 5 can be stripped) - * F5-FF 1 + * The classes are 00-7F 0 80-8F 9 90-9F 10 A0-BF 11 C0,C1 1 C2-DF 2 E0 + * 7 E1-EC 3 ED 4 EE-EF 3 F0 8 F1-F3 6 (6 bits can be stripped) F4 5 + * (only 5 can be stripped) F5-FF 1 */ EXTCONST U8 PL_c9_utf8_dfa_tab[] = { /* The first part of the table maps bytes to character classes to reduce * the size of the transition table and create bitmasks. */ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*00-0F*/ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*10-1F*/ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*20-2F*/ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*30-3F*/ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*40-4F*/ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*50-5F*/ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*60-6F*/ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*70-7F*/ - 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, /*80-8F*/ - 10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10, /*90-9F*/ - 11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11, /*A0-AF*/ - 11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11, /*B0-BF*/ - 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, /*C0-CF*/ - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, /*D0-DF*/ - 7, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 3, 3, /*E0-EF*/ - 8, 6, 6, 6, 5, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, /*F0-FF*/ - -/* The second part is a transition table that maps a combination - * of a state of the automaton and a character class to a new state, called a - * node. The nodes are: - * N0 The initial state, and final accepting one. - * N1 Any one continuation byte (80-BF) left. This is transitioned to - * immediately when the start byte indicates a two-byte sequence - * N2 Any two continuation bytes left. - * N3 Any three continuation bytes left. - * N4 Start byte is E0. Continuation bytes 80-9F are illegal (overlong); - * the other continuations transition to state N1 - * N5 Start byte is ED. Continuation bytes A0-BF all lead to surrogates, - * so are illegal. The other continuations transition to state N1. - * N6 Start byte is F0. Continuation bytes 80-8F are illegal (overlong); - * the other continuations transition to N2 - * N7 Start byte is F4. Continuation bytes 90-BF are illegal - * (non-unicode); the other continuations transition to N2 - * 1 Reject. All transitions not mentioned above (except the single - * byte ones (as they are always legal) are to this state. + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*00-0F */ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*10-1F */ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*20-2F */ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*30-3F */ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*40-4F */ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*50-5F */ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*60-6F */ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*70-7F */ + 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, /*80-8F */ + 10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10, /*90-9F */ + 11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11, /*A0-AF */ + 11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11, /*B0-BF */ + 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, /*C0-CF */ + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, /*D0-DF */ + 7, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 3, 3, /*E0-EF */ + 8, 6, 6, 6, 5, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, /*F0-FF */ + +/* The second part is a transition table that maps a combination of a state of + * the automaton and a character class to a new state, called a node. The + * nodes are: N0 The initial state, and final accepting one. N1 Any one + * continuation byte (80-BF) left. This is transitioned to immediately when + * the start byte indicates a two-byte sequence N2 Any two continuation bytes + * left. N3 Any three continuation bytes left. N4 Start byte is E0. + * Continuation bytes 80-9F are illegal (overlong); the other continuations + * transition to state N1 N5 Start byte is ED. Continuation bytes A0-BF all + * lead to surrogates, so are illegal. The other continuations transition to + * state N1. N6 Start byte is F0. Continuation bytes 80-8F are illegal + * (overlong); the other continuations transition to N2 N7 Start byte is F4. + * Continuation bytes 90-BF are illegal (non-unicode); the other continuations + * transition to N2 1 Reject. All transitions not mentioned above (except the + * single byte ones (as they are always legal) are to this state. */ # undef N0 @@ -6768,8 +6740,8 @@ EXTCONST U8 PL_c9_utf8_dfa_tab[] = { # undef N6 # undef N7 # undef NUM_CLASSES -# define NUM_CLASSES 12 -# define N0 0 +# define NUM_CLASSES 12 +# define N0 0 # define N1 ((N0) + NUM_CLASSES) # define N2 ((N1) + NUM_CLASSES) # define N3 ((N2) + NUM_CLASSES) @@ -6805,134 +6777,137 @@ EXTCONST U8 PL_c9_utf8_dfa_tab[]; END_EXTERN_C struct am_table { - U8 flags; - U8 fallback; - U16 spare; - U32 was_ok_sub; - CV* table[NofAMmeth]; + U8 flags; + U8 fallback; + U16 spare; + U32 was_ok_sub; + CV *table[NofAMmeth]; }; struct am_table_short { - U8 flags; - U8 fallback; - U16 spare; - U32 was_ok_sub; + U8 flags; + U8 fallback; + U16 spare; + U32 was_ok_sub; }; typedef struct am_table AMT; typedef struct am_table_short AMTS; -#define AMGfallNEVER 1 -#define AMGfallNO 2 -#define AMGfallYES 3 +#define AMGfallNEVER 1 +#define AMGfallNO 2 +#define AMGfallYES 3 -#define AMTf_AMAGIC 1 -#define AMT_AMAGIC(amt) ((amt)->flags & AMTf_AMAGIC) -#define AMT_AMAGIC_on(amt) ((amt)->flags |= AMTf_AMAGIC) -#define AMT_AMAGIC_off(amt) ((amt)->flags &= ~AMTf_AMAGIC) +#define AMTf_AMAGIC 1 +#define AMT_AMAGIC(amt) ((amt)->flags & AMTf_AMAGIC) +#define AMT_AMAGIC_on(amt) ((amt)->flags |= AMTf_AMAGIC) +#define AMT_AMAGIC_off(amt) ((amt)->flags &= ~AMTf_AMAGIC) -#define StashHANDLER(stash,meth) gv_handler((stash),CAT2(meth,_amg)) +#define StashHANDLER(stash,meth) gv_handler((stash),CAT2(meth,_amg)) /* - * some compilers like to redefine cos et alia as faster - * (and less accurate?) versions called F_cos et cetera (Quidquid - * latine dictum sit, altum viditur.) This trick collides with - * the Perl overloading (amg). The following #defines fool both. - */ + * some compilers like to redefine cos et alia as faster (and less + * accurate?) versions called F_cos et cetera (Quidquid latine + * dictum sit, altum viditur.) This trick collides with the Perl + * overloading (amg). The following #defines fool both. +*/ #ifdef _FASTMATH # ifdef atan2 -# define F_atan2_amg atan2_amg +# define F_atan2_amg atan2_amg # endif # ifdef cos -# define F_cos_amg cos_amg +# define F_cos_amg cos_amg # endif # ifdef exp -# define F_exp_amg exp_amg +# define F_exp_amg exp_amg # endif # ifdef log -# define F_log_amg log_amg +# define F_log_amg log_amg # endif # ifdef pow -# define F_pow_amg pow_amg +# define F_pow_amg pow_amg # endif # ifdef sin -# define F_sin_amg sin_amg +# define F_sin_amg sin_amg # endif # ifdef sqrt -# define F_sqrt_amg sqrt_amg +# define F_sqrt_amg sqrt_amg # endif #endif /* _FASTMATH */ -#define PERLDB_ALL (PERLDBf_SUB | PERLDBf_LINE | \ - PERLDBf_NOOPT | PERLDBf_INTER | \ - PERLDBf_SUBLINE| PERLDBf_SINGLE| \ - PERLDBf_NAMEEVAL| PERLDBf_NAMEANON | \ - PERLDBf_SAVESRC) +#define PERLDB_ALL \ + (PERLDBf_SUB | PERLDBf_LINE | \ + PERLDBf_NOOPT | PERLDBf_INTER | \ + PERLDBf_SUBLINE| PERLDBf_SINGLE| \ + PERLDBf_NAMEEVAL| PERLDBf_NAMEANON | \ + PERLDBf_SAVESRC) /* No _NONAME, _GOTO */ -#define PERLDBf_SUB 0x01 /* Debug sub enter/exit */ -#define PERLDBf_LINE 0x02 /* Keep line # */ -#define PERLDBf_NOOPT 0x04 /* Switch off optimizations */ -#define PERLDBf_INTER 0x08 /* Preserve more data for - later inspections */ -#define PERLDBf_SUBLINE 0x10 /* Keep subr source lines */ -#define PERLDBf_SINGLE 0x20 /* Start with single-step on */ -#define PERLDBf_NONAME 0x40 /* For _SUB: no name of the subr */ -#define PERLDBf_GOTO 0x80 /* Report goto: call DB::goto */ -#define PERLDBf_NAMEEVAL 0x100 /* Informative names for evals */ -#define PERLDBf_NAMEANON 0x200 /* Informative names for anon subs */ -#define PERLDBf_SAVESRC 0x400 /* Save source lines into @{"_<$filename"} */ -#define PERLDBf_SAVESRC_NOSUBS 0x800 /* Including evals that generate no subroutines */ -#define PERLDBf_SAVESRC_INVALID 0x1000 /* Save source that did not compile */ - -#define PERLDB_SUB (PL_perldb & PERLDBf_SUB) -#define PERLDB_LINE (PL_perldb & PERLDBf_LINE) -#define PERLDB_NOOPT (PL_perldb & PERLDBf_NOOPT) -#define PERLDB_INTER (PL_perldb & PERLDBf_INTER) -#define PERLDB_SUBLINE (PL_perldb & PERLDBf_SUBLINE) -#define PERLDB_SINGLE (PL_perldb & PERLDBf_SINGLE) -#define PERLDB_SUB_NN (PL_perldb & PERLDBf_NONAME) -#define PERLDB_GOTO (PL_perldb & PERLDBf_GOTO) -#define PERLDB_NAMEEVAL (PL_perldb & PERLDBf_NAMEEVAL) -#define PERLDB_NAMEANON (PL_perldb & PERLDBf_NAMEANON) -#define PERLDB_SAVESRC (PL_perldb & PERLDBf_SAVESRC) -#define PERLDB_SAVESRC_NOSUBS (PL_perldb & PERLDBf_SAVESRC_NOSUBS) -#define PERLDB_SAVESRC_INVALID (PL_perldb & PERLDBf_SAVESRC_INVALID) - -#define PERLDB_LINE_OR_SAVESRC (PL_perldb & (PERLDBf_LINE | PERLDBf_SAVESRC)) +#define PERLDBf_SUB 0x01 /* Debug sub enter/exit */ +#define PERLDBf_LINE 0x02 /* Keep line # */ +#define PERLDBf_NOOPT 0x04 /* Switch off optimizations */ +#define PERLDBf_INTER 0x08 /* Preserve more data for + later inspections */ +#define PERLDBf_SUBLINE 0x10 /* Keep subr source lines */ +#define PERLDBf_SINGLE 0x20 /* Start with single-step on */ +#define PERLDBf_NONAME 0x40 /* For _SUB: no name of the subr */ +#define PERLDBf_GOTO 0x80 /* Report goto: call DB::goto */ +#define PERLDBf_NAMEEVAL 0x100 /* Informative names for evals */ +#define PERLDBf_NAMEANON 0x200 /* Informative names for anon subs */ +#define PERLDBf_SAVESRC 0x400 /* Save source lines into + @{"_<$filename"} */ +#define PERLDBf_SAVESRC_NOSUBS 0x800 /* Including evals that generate + no subroutines */ +#define PERLDBf_SAVESRC_INVALID 0x1000 /* Save source that did not compile */ + +#define PERLDB_SUB (PL_perldb & PERLDBf_SUB) +#define PERLDB_LINE (PL_perldb & PERLDBf_LINE) +#define PERLDB_NOOPT (PL_perldb & PERLDBf_NOOPT) +#define PERLDB_INTER (PL_perldb & PERLDBf_INTER) +#define PERLDB_SUBLINE (PL_perldb & PERLDBf_SUBLINE) +#define PERLDB_SINGLE (PL_perldb & PERLDBf_SINGLE) +#define PERLDB_SUB_NN (PL_perldb & PERLDBf_NONAME) +#define PERLDB_GOTO (PL_perldb & PERLDBf_GOTO) +#define PERLDB_NAMEEVAL (PL_perldb & PERLDBf_NAMEEVAL) +#define PERLDB_NAMEANON (PL_perldb & PERLDBf_NAMEANON) +#define PERLDB_SAVESRC (PL_perldb & PERLDBf_SAVESRC) +#define PERLDB_SAVESRC_NOSUBS (PL_perldb & PERLDBf_SAVESRC_NOSUBS) +#define PERLDB_SAVESRC_INVALID (PL_perldb & PERLDBf_SAVESRC_INVALID) + +#define PERLDB_LINE_OR_SAVESRC (PL_perldb & (PERLDBf_LINE | PERLDBf_SAVESRC)) #ifdef USE_ITHREADS -# define KEYWORD_PLUGIN_MUTEX_INIT MUTEX_INIT(&PL_keyword_plugin_mutex) -# define KEYWORD_PLUGIN_MUTEX_LOCK MUTEX_LOCK(&PL_keyword_plugin_mutex) -# define KEYWORD_PLUGIN_MUTEX_UNLOCK MUTEX_UNLOCK(&PL_keyword_plugin_mutex) -# define KEYWORD_PLUGIN_MUTEX_TERM MUTEX_DESTROY(&PL_keyword_plugin_mutex) -# define USER_PROP_MUTEX_INIT MUTEX_INIT(&PL_user_prop_mutex) -# define USER_PROP_MUTEX_LOCK MUTEX_LOCK(&PL_user_prop_mutex) -# define USER_PROP_MUTEX_UNLOCK MUTEX_UNLOCK(&PL_user_prop_mutex) -# define USER_PROP_MUTEX_TERM MUTEX_DESTROY(&PL_user_prop_mutex) +# define KEYWORD_PLUGIN_MUTEX_INIT MUTEX_INIT(&PL_keyword_plugin_mutex) +# define KEYWORD_PLUGIN_MUTEX_LOCK MUTEX_LOCK(&PL_keyword_plugin_mutex) +# define KEYWORD_PLUGIN_MUTEX_UNLOCK MUTEX_UNLOCK(&PL_keyword_plugin_mutex) +# define KEYWORD_PLUGIN_MUTEX_TERM MUTEX_DESTROY(&PL_keyword_plugin_mutex) +# define USER_PROP_MUTEX_INIT MUTEX_INIT(&PL_user_prop_mutex) +# define USER_PROP_MUTEX_LOCK MUTEX_LOCK(&PL_user_prop_mutex) +# define USER_PROP_MUTEX_UNLOCK MUTEX_UNLOCK(&PL_user_prop_mutex) +# define USER_PROP_MUTEX_TERM MUTEX_DESTROY(&PL_user_prop_mutex) #else -# define KEYWORD_PLUGIN_MUTEX_INIT NOOP -# define KEYWORD_PLUGIN_MUTEX_LOCK NOOP -# define KEYWORD_PLUGIN_MUTEX_UNLOCK NOOP -# define KEYWORD_PLUGIN_MUTEX_TERM NOOP -# define USER_PROP_MUTEX_INIT NOOP -# define USER_PROP_MUTEX_LOCK NOOP -# define USER_PROP_MUTEX_UNLOCK NOOP -# define USER_PROP_MUTEX_TERM NOOP +# define KEYWORD_PLUGIN_MUTEX_INIT NOOP +# define KEYWORD_PLUGIN_MUTEX_LOCK NOOP +# define KEYWORD_PLUGIN_MUTEX_UNLOCK NOOP +# define KEYWORD_PLUGIN_MUTEX_TERM NOOP +# define USER_PROP_MUTEX_INIT NOOP +# define USER_PROP_MUTEX_LOCK NOOP +# define USER_PROP_MUTEX_UNLOCK NOOP +# define USER_PROP_MUTEX_TERM NOOP #endif #ifdef USE_LOCALE /* These locale things are all subject to change */ - /* Returns TRUE if the plain locale pragma without a parameter is in effect. - * */ -# define IN_LOCALE_RUNTIME (PL_curcop \ - && CopHINTS_get(PL_curcop) & HINT_LOCALE) + /* Returns TRUE if the plain locale pragma + * without a parameter is in effect. */ +# define IN_LOCALE_RUNTIME \ + (PL_curcop && CopHINTS_get(PL_curcop) & HINT_LOCALE) /* Returns TRUE if either form of the locale pragma is in effect */ -# define IN_SOME_LOCALE_FORM_RUNTIME \ - cBOOL(CopHINTS_get(PL_curcop) & (HINT_LOCALE|HINT_LOCALE_PARTIAL)) +# define IN_SOME_LOCALE_FORM_RUNTIME \ + cBOOL(CopHINTS_get(PL_curcop) & (HINT_LOCALE|HINT_LOCALE_PARTIAL)) -# define IN_LOCALE_COMPILETIME cBOOL(PL_hints & HINT_LOCALE) -# define IN_SOME_LOCALE_FORM_COMPILETIME \ - cBOOL(PL_hints & (HINT_LOCALE|HINT_LOCALE_PARTIAL)) +# define IN_LOCALE_COMPILETIME cBOOL(PL_hints & HINT_LOCALE) +# define IN_SOME_LOCALE_FORM_COMPILETIME \ + cBOOL(PL_hints & (HINT_LOCALE|HINT_LOCALE_PARTIAL)) /* =for apidoc_section $locale @@ -6955,44 +6930,44 @@ the plain locale pragma without a parameter (S>) is in effect. =cut */ -# define IN_LOCALE \ - (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME) -# define IN_SOME_LOCALE_FORM \ - (IN_PERL_COMPILETIME ? IN_SOME_LOCALE_FORM_COMPILETIME \ - : IN_SOME_LOCALE_FORM_RUNTIME) +# define IN_LOCALE \ + (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME) +# define IN_SOME_LOCALE_FORM \ + (IN_PERL_COMPILETIME ? IN_SOME_LOCALE_FORM_COMPILETIME \ + : IN_SOME_LOCALE_FORM_RUNTIME) -# define IN_LC_ALL_COMPILETIME IN_LOCALE_COMPILETIME -# define IN_LC_ALL_RUNTIME IN_LOCALE_RUNTIME +# define IN_LC_ALL_COMPILETIME IN_LOCALE_COMPILETIME +# define IN_LC_ALL_RUNTIME IN_LOCALE_RUNTIME # define IN_LC_PARTIAL_COMPILETIME cBOOL(PL_hints & HINT_LOCALE_PARTIAL) -# define IN_LC_PARTIAL_RUNTIME \ - (PL_curcop && CopHINTS_get(PL_curcop) & HINT_LOCALE_PARTIAL) +# define IN_LC_PARTIAL_RUNTIME \ + (PL_curcop && CopHINTS_get(PL_curcop) & HINT_LOCALE_PARTIAL) -# define IN_LC_COMPILETIME(category) \ - ( IN_LC_ALL_COMPILETIME \ - || ( IN_LC_PARTIAL_COMPILETIME \ +# define IN_LC_COMPILETIME(category) \ + ( IN_LC_ALL_COMPILETIME \ + || ( IN_LC_PARTIAL_COMPILETIME \ && Perl__is_in_locale_category(aTHX_ TRUE, (category)))) -# define IN_LC_RUNTIME(category) \ - (IN_LC_ALL_RUNTIME || (IN_LC_PARTIAL_RUNTIME \ - && Perl__is_in_locale_category(aTHX_ FALSE, (category)))) -# define IN_LC(category) \ - (IN_LC_COMPILETIME(category) || IN_LC_RUNTIME(category)) +# define IN_LC_RUNTIME(category) \ + (IN_LC_ALL_RUNTIME || (IN_LC_PARTIAL_RUNTIME \ + && Perl__is_in_locale_category(aTHX_ FALSE, (category)))) +# define IN_LC(category) \ + (IN_LC_COMPILETIME(category) || IN_LC_RUNTIME(category)) # if defined (PERL_CORE) || defined (PERL_IN_XSUB_RE) - /* This internal macro should be called from places that operate under - * locale rules. If there is a problem with the current locale that - * hasn't been raised yet, it will output a warning this time. Because - * this will so rarely be true, there is no point to optimize for time; - * instead it makes sense to minimize space used and do all the work in - * the rarely called function */ + /* This internal macro should be called from places that operate + * under locale rules. If there is a problem with the current + * locale that hasn't been raised yet, it will output a warning this + * time. Because this will so rarely be true, there is no point to + * optimize for time; instead it makes sense to minimize space used + * and do all the work in the rarely called function */ # ifdef USE_LOCALE_CTYPE -# define CHECK_AND_WARN_PROBLEMATIC_LOCALE_ \ - STMT_START { \ - if (UNLIKELY(PL_warn_locale)) { \ - Perl__warn_problematic_locale(); \ - } \ - } STMT_END +# define CHECK_AND_WARN_PROBLEMATIC_LOCALE_ \ + STMT_START { \ + if (UNLIKELY(PL_warn_locale)) { \ + Perl__warn_problematic_locale(); \ + } \ + } STMT_END # else # define CHECK_AND_WARN_PROBLEMATIC_LOCALE_ # endif @@ -7002,54 +6977,54 @@ the plain locale pragma without a parameter (S>) is in effect. * and will do so if enabled. The first takes a single code point * argument; the 2nd, is a pointer to the first byte of the UTF-8 encoded * string, and an end position which it won't try to read past */ -# define _CHECK_AND_OUTPUT_WIDE_LOCALE_CP_MSG(cp) \ - STMT_START { \ - if (! IN_UTF8_CTYPE_LOCALE && ckWARN(WARN_LOCALE)) { \ - Perl_warner(aTHX_ packWARN(WARN_LOCALE), \ - "Wide character (U+%" UVXf ") in %s",\ - (UV) cp, OP_DESC(PL_op)); \ - } \ - } STMT_END - -# define _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(s, send) \ - STMT_START { /* Check if to warn before doing the conversion work */\ - if (! IN_UTF8_CTYPE_LOCALE && ckWARN(WARN_LOCALE)) { \ - UV cp = utf8_to_uvchr_buf((U8 *) (s), (U8 *) (send), NULL); \ - Perl_warner(aTHX_ packWARN(WARN_LOCALE), \ - "Wide character (U+%" UVXf ") in %s", \ - (cp == 0) \ - ? UNICODE_REPLACEMENT \ - : (UV) cp, \ - OP_DESC(PL_op)); \ - } \ - } STMT_END +# define _CHECK_AND_OUTPUT_WIDE_LOCALE_CP_MSG(cp) \ + STMT_START { \ + if (! IN_UTF8_CTYPE_LOCALE && ckWARN(WARN_LOCALE)) { \ + Perl_warner(aTHX_ packWARN(WARN_LOCALE), \ + "Wide character (U+%" UVXf ") in %s", \ + (UV) cp, OP_DESC(PL_op)); \ + } \ + } STMT_END + +# define _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(s, send) \ + STMT_START { /* Check if to warn before doing the conversion work */ \ + if (! IN_UTF8_CTYPE_LOCALE && ckWARN(WARN_LOCALE)) { \ + UV cp = utf8_to_uvchr_buf((U8 *) (s), (U8 *) (send), NULL); \ + Perl_warner(aTHX_ packWARN(WARN_LOCALE), \ + "Wide character (U+%" UVXf ") in %s", \ + (cp == 0) \ + ? UNICODE_REPLACEMENT \ + : (UV) cp, \ + OP_DESC(PL_op)); \ + } \ + } STMT_END # endif /* PERL_CORE or PERL_IN_XSUB_RE */ #else /* No locale usage */ -# define IN_LOCALE_RUNTIME 0 -# define IN_SOME_LOCALE_FORM_RUNTIME 0 -# define IN_LOCALE_COMPILETIME 0 -# define IN_SOME_LOCALE_FORM_COMPILETIME 0 -# define IN_LOCALE 0 -# define IN_SOME_LOCALE_FORM 0 -# define IN_LC_ALL_COMPILETIME 0 -# define IN_LC_ALL_RUNTIME 0 -# define IN_LC_PARTIAL_COMPILETIME 0 -# define IN_LC_PARTIAL_RUNTIME 0 -# define IN_LC_COMPILETIME(category) 0 -# define IN_LC_RUNTIME(category) 0 -# define IN_LC(category) 0 +# define IN_LOCALE_RUNTIME 0 +# define IN_SOME_LOCALE_FORM_RUNTIME 0 +# define IN_LOCALE_COMPILETIME 0 +# define IN_SOME_LOCALE_FORM_COMPILETIME 0 +# define IN_LOCALE 0 +# define IN_SOME_LOCALE_FORM 0 +# define IN_LC_ALL_COMPILETIME 0 +# define IN_LC_ALL_RUNTIME 0 +# define IN_LC_PARTIAL_COMPILETIME 0 +# define IN_LC_PARTIAL_RUNTIME 0 +# define IN_LC_COMPILETIME(category) 0 +# define IN_LC_RUNTIME(category) 0 +# define IN_LC(category) 0 # define CHECK_AND_WARN_PROBLEMATIC_LOCALE_ # define _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(s, send) # define _CHECK_AND_OUTPUT_WIDE_LOCALE_CP_MSG(c) #endif -#define locale_panic_(m) Perl_locale_panic((m), __FILE__, __LINE__, errno) +#define locale_panic_(m) Perl_locale_panic((m), __FILE__, __LINE__, errno) /* Locale/thread synchronization macros. */ #if ! defined(USE_LOCALE) || ! defined(USE_LOCALE_THREADS) -# define LOCALE_LOCK_(cond) NOOP -# define LOCALE_UNLOCK_ NOOP +# define LOCALE_LOCK_(cond) NOOP +# define LOCALE_UNLOCK_ NOOP # define LOCALE_INIT # define LOCALE_TERM @@ -7071,130 +7046,131 @@ the plain locale pragma without a parameter (S>) is in effect. * https://clang.llvm.org/docs/ThreadSafetyAnalysis.html#conditional-locks */ # define LOCALE_LOCK_(cond_to_panic_if_already_locked) \ - STMT_START { \ - CLANG_DIAG_IGNORE(-Wthread-safety) \ - if (LIKELY(PL_locale_mutex_depth <= 0)) { \ - DEBUG_Lv(PerlIO_printf(Perl_debug_log, \ - "%s: %d: locking locale; depth=1\n", \ - __FILE__, __LINE__)); \ - MUTEX_LOCK(&PL_locale_mutex); \ - PL_locale_mutex_depth = 1; \ - } \ - else { \ - PL_locale_mutex_depth++; \ - DEBUG_Lv(PerlIO_printf(Perl_debug_log, \ - "%s: %d: avoided locking locale; new depth=%d\n", \ - __FILE__, __LINE__, PL_locale_mutex_depth)); \ - if (cond_to_panic_if_already_locked) { \ - locale_panic_("Trying to lock locale incompatibly: " \ - STRINGIFY(cond_to_panic_if_already_locked)); \ - } \ - } \ - CLANG_DIAG_RESTORE \ - } STMT_END + STMT_START { \ + CLANG_DIAG_IGNORE(-Wthread-safety) \ + if (LIKELY(PL_locale_mutex_depth <= 0)) { \ + DEBUG_Lv(PerlIO_printf(Perl_debug_log, \ + "%s: %d: locking locale; depth=1\n", \ + __FILE__, __LINE__)); \ + MUTEX_LOCK(&PL_locale_mutex); \ + PL_locale_mutex_depth = 1; \ + } \ + else { \ + PL_locale_mutex_depth++; \ + DEBUG_Lv(PerlIO_printf(Perl_debug_log, \ + "%s: %d: avoided locking locale; new depth=%d\n", \ + __FILE__, __LINE__, PL_locale_mutex_depth)); \ + if (cond_to_panic_if_already_locked) { \ + locale_panic_("Trying to lock locale incompatibly: " \ + STRINGIFY(cond_to_panic_if_already_locked)); \ + } \ + } \ + CLANG_DIAG_RESTORE \ + } STMT_END # define LOCALE_UNLOCK_ \ - STMT_START { \ - if (LIKELY(PL_locale_mutex_depth == 1)) { \ - DEBUG_Lv(PerlIO_printf(Perl_debug_log, \ - "%s: %d: unlocking locale; new depth=0\n", \ - __FILE__, __LINE__)); \ - PL_locale_mutex_depth = 0; \ - MUTEX_UNLOCK(&PL_locale_mutex); \ - } \ - else if (PL_locale_mutex_depth <= 0) { \ - DEBUG_L(PerlIO_printf(Perl_debug_log, \ - "%s: %d: ignored attempt to unlock already" \ - " unlocked locale; depth unchanged at %d\n", \ + STMT_START { \ + if (LIKELY(PL_locale_mutex_depth == 1)) { \ + DEBUG_Lv(PerlIO_printf(Perl_debug_log, \ + "%s: %d: unlocking locale; new depth=0\n", \ + __FILE__, __LINE__)); \ + PL_locale_mutex_depth = 0; \ + MUTEX_UNLOCK(&PL_locale_mutex); \ + } \ + else if (PL_locale_mutex_depth <= 0) { \ + DEBUG_L(PerlIO_printf(Perl_debug_log, \ + "%s: %d: ignored attempt to unlock already" \ + " unlocked locale; depth unchanged at %d\n", \ + __FILE__, __LINE__, PL_locale_mutex_depth)); \ + } \ + else { \ + PL_locale_mutex_depth--; \ + DEBUG_Lv(PerlIO_printf(Perl_debug_log, \ + "%s: %d: avoided unlocking locale; new depth=%d\n", \ __FILE__, __LINE__, PL_locale_mutex_depth)); \ - } \ - else { \ - PL_locale_mutex_depth--; \ - DEBUG_Lv(PerlIO_printf(Perl_debug_log, \ - "%s: %d: avoided unlocking locale; new depth=%d\n", \ - __FILE__, __LINE__, PL_locale_mutex_depth)); \ - } \ - } STMT_END + } \ + } STMT_END # if defined(USE_THREADS) && ! defined(USE_THREAD_SAFE_LOCALE) - /* By definition, a thread-unsafe locale means we need a critical - * section. */ -# define SETLOCALE_LOCK LOCALE_LOCK_(0) -# define SETLOCALE_UNLOCK LOCALE_UNLOCK_ + /* By definition, a thread-unsafe locale means + * we need a critical section. */ +# define SETLOCALE_LOCK LOCALE_LOCK_(0) +# define SETLOCALE_UNLOCK LOCALE_UNLOCK_ # ifdef USE_LOCALE_NUMERIC -# define LC_NUMERIC_LOCK(cond_to_panic_if_already_locked) \ - LOCALE_LOCK_(cond_to_panic_if_already_locked) -# define LC_NUMERIC_UNLOCK LOCALE_UNLOCK_ +# define LC_NUMERIC_LOCK(cond_to_panic_if_already_locked) \ + LOCALE_LOCK_(cond_to_panic_if_already_locked) +# define LC_NUMERIC_UNLOCK LOCALE_UNLOCK_ # endif # endif # ifndef USE_POSIX_2008_LOCALE -# define LOCALE_TERM_POSIX_2008_ NOOP +# define LOCALE_TERM_POSIX_2008_ NOOP # else /* We have a locale object holding the 'C' locale for Posix 2008 */ -# define LOCALE_TERM_POSIX_2008_ \ - STMT_START { \ - if (PL_C_locale_obj) { \ - /* Make sure we aren't using the locale \ - * space we are about to free */ \ - uselocale(LC_GLOBAL_LOCALE); \ - freelocale(PL_C_locale_obj); \ - PL_C_locale_obj = (locale_t) NULL; \ - } \ - } STMT_END -# endif - -# define LOCALE_INIT MUTEX_INIT(&PL_locale_mutex) -# define LOCALE_TERM STMT_START { \ - LOCALE_TERM_POSIX_2008_; \ - MUTEX_DESTROY(&PL_locale_mutex); \ - } STMT_END -#endif - -/* There are some locale-related functions which may need locking only because - * they share some common memory across threads, and hence there is the - * potential for a race in accessing that space. Most are because their return - * points to a global static buffer, but some just use some common space - * internally. All functions accessing a given space need to have a critical - * section to prevent any other thread from accessing it at the same time. - * Ideally, there would be a separate mutex for each such space, so that - * another thread isn't unnecessarily blocked. But, most of them need to be - * locked against the locale changing while accessing that space, and it is not - * expected that any will be called frequently, and the locked interval should - * be short, and modern platforms will have reentrant versions (which don't - * lock) for almost all of them, so khw thinks a single mutex should suffice. - * Having a single mutex facilitates that, avoiding potential deadlock - * situations. +# define LOCALE_TERM_POSIX_2008_ \ + STMT_START { \ + if (PL_C_locale_obj) { \ + /* Make sure we aren't using the locale \ + * space we are about to free */ \ + uselocale(LC_GLOBAL_LOCALE); \ + freelocale(PL_C_locale_obj); \ + PL_C_locale_obj = (locale_t) NULL; \ + } \ + } STMT_END +# endif + +# define LOCALE_INIT MUTEX_INIT(&PL_locale_mutex) +# define LOCALE_TERM \ + STMT_START { \ + LOCALE_TERM_POSIX_2008_; \ + MUTEX_DESTROY(&PL_locale_mutex); \ + } STMT_END +#endif + +/* There are some locale-related functions which may need locking only + * because they share some common memory across threads, and hence there is + * the potential for a race in accessing that space. Most are because + * their return points to a global static buffer, but some just use some + * common space internally. All functions accessing a given space need to + * have a critical section to prevent any other thread from accessing it at + * the same time. Ideally, there would be a separate mutex for each such + * space, so that another thread isn't unnecessarily blocked. But, most of + * them need to be locked against the locale changing while accessing that + * space, and it is not expected that any will be called frequently, and + * the locked interval should be short, and modern platforms will have + * reentrant versions (which don't lock) for almost all of them, so khw + * thinks a single mutex should suffice. Having a single mutex facilitates + * that, avoiding potential deadlock situations. * - * This will be a no-op iff the perl is unthreaded. 'gw' stands for 'global - * write', to indicate the caller wants to be able to access memory that isn't - * thread specific, either to write to itself, or to prevent anyone else from - * writing. */ -#define gwLOCALE_LOCK LOCALE_LOCK_(0) -#define gwLOCALE_UNLOCK LOCALE_UNLOCK_ - -/* setlocale() generally returns in a global static buffer, but not on Windows - * when operating in thread-safe mode */ + * This will be a no-op iff the perl is unthreaded. 'gw' stands for + * 'global write', to indicate the caller wants to be able to access memory + * that isn't thread specific, either to write to itself, or to prevent + * anyone else from writing. */ +#define gwLOCALE_LOCK LOCALE_LOCK_(0) +#define gwLOCALE_UNLOCK LOCALE_UNLOCK_ + +/* setlocale() generally returns in a global static buffer, but + * not on Windows when operating in thread-safe mode */ #if defined(WIN32) && defined(USE_THREAD_SAFE_LOCALE) -# define POSIX_SETLOCALE_LOCK \ - STMT_START { \ - if (_configthreadlocale(0) == _DISABLE_PER_THREAD_LOCALE) \ - gwLOCALE_LOCK; \ - } STMT_END -# define POSIX_SETLOCALE_UNLOCK \ - STMT_START { \ - if (_configthreadlocale(0) == _DISABLE_PER_THREAD_LOCALE) \ - gwLOCALE_UNLOCK; \ - } STMT_END +# define POSIX_SETLOCALE_LOCK \ + STMT_START { \ + if (_configthreadlocale(0) == _DISABLE_PER_THREAD_LOCALE) \ + gwLOCALE_LOCK; \ + } STMT_END +# define POSIX_SETLOCALE_UNLOCK \ + STMT_START { \ + if (_configthreadlocale(0) == _DISABLE_PER_THREAD_LOCALE) \ + gwLOCALE_UNLOCK; \ + } STMT_END #else -# define POSIX_SETLOCALE_LOCK gwLOCALE_LOCK -# define POSIX_SETLOCALE_UNLOCK gwLOCALE_UNLOCK +# define POSIX_SETLOCALE_LOCK gwLOCALE_LOCK +# define POSIX_SETLOCALE_UNLOCK gwLOCALE_UNLOCK #endif /* It handles _wsetlocale() as well */ -#define WSETLOCALE_LOCK POSIX_SETLOCALE_LOCK -#define WSETLOCALE_UNLOCK POSIX_SETLOCALE_UNLOCK +#define WSETLOCALE_LOCK POSIX_SETLOCALE_LOCK +#define WSETLOCALE_UNLOCK POSIX_SETLOCALE_UNLOCK /* Similar to gwLOCALE_LOCK, there are functions that require both the locale * and environment to be constant during their execution, and don't change @@ -7203,70 +7179,70 @@ the plain locale pragma without a parameter (S>) is in effect. * read lock on both the locale and environment. However, on systems which * have per-thread locales, the locale is constant during the execution of * these functions, and so no locale lock is necssary. For such systems, an - * exclusive ENV lock is necessary and sufficient. On systems where the locale - * could change out from under us, we use an exclusive LOCALE lock to prevent - * that, and a read ENV lock to prevent other threads that have nothing to do - * with locales here from changing the environment. */ + * exclusive ENV lock is necessary and sufficient. On systems where the + * locale could change out from under us, we use an exclusive LOCALE lock to + * prevent that, and a read ENV lock to prevent other threads that have + * nothing to do with locales here from changing the environment. */ #ifdef SETLOCALE_LOCK -# define gwENVr_LOCALEr_LOCK \ - STMT_START { SETLOCALE_LOCK; ENV_READ_LOCK; } STMT_END -# define gwENVr_LOCALEr_UNLOCK \ - STMT_START { ENV_READ_UNLOCK; SETLOCALE_UNLOCK; } STMT_END +# define gwENVr_LOCALEr_LOCK \ + STMT_START { SETLOCALE_LOCK; ENV_READ_LOCK; } STMT_END +# define gwENVr_LOCALEr_UNLOCK \ + STMT_START { ENV_READ_UNLOCK; SETLOCALE_UNLOCK; } STMT_END #else -# define gwENVr_LOCALEr_LOCK ENV_LOCK -# define gwENVr_LOCALEr_UNLOCK ENV_UNLOCK +# define gwENVr_LOCALEr_LOCK ENV_LOCK +# define gwENVr_LOCALEr_UNLOCK ENV_UNLOCK #endif -/* Now that we have defined gwENVr_LOCALEr_LOCK, we can finish defining - * SETLOCALE_LOCK, which we kept undefined until here on a thread-safe system - * so that we could use that fact to calculate what gwENVr_LOCALEr_LOCK should - * be */ +/* Now that we have defined gwENVr_LOCALEr_LOCK, we can finish + * defining SETLOCALE_LOCK, which we kept undefined until here + * on a thread-safe system so that we could use that fact to + * calculate what gwENVr_LOCALEr_LOCK should be */ #ifndef SETLOCALE_LOCK -# define SETLOCALE_LOCK NOOP -# define SETLOCALE_UNLOCK NOOP +# define SETLOCALE_LOCK NOOP +# define SETLOCALE_UNLOCK NOOP #endif /* On systems that don't have per-thread locales, even though we don't - * think we are changing the locale ourselves, behind the scenes it does - * get changed to whatever the thread's should be, so it has to be an - * exclusive lock. By defining it here with this name, we can, for the - * most part, hide this detail from the rest of the code */ + * think we are changing the locale ourselves, behind the scenes it + * does get changed to whatever the thread's should be, so it has to + * be an exclusive lock. By defining it here with this name, we can, + * for the most part, hide this detail from the rest of the code */ /* Currently, the read lock is an exclusive lock */ -#define LOCALE_READ_LOCK SETLOCALE_LOCK -#define LOCALE_READ_UNLOCK SETLOCALE_UNLOCK +#define LOCALE_READ_LOCK SETLOCALE_LOCK +#define LOCALE_READ_UNLOCK SETLOCALE_UNLOCK #ifndef LC_NUMERIC_LOCK -# define LC_NUMERIC_LOCK(cond) NOOP -# define LC_NUMERIC_UNLOCK NOOP +# define LC_NUMERIC_LOCK(cond) NOOP +# define LC_NUMERIC_UNLOCK NOOP #endif /* These non-reentrant versions use global space */ -# define MBLEN_LOCK_ gwLOCALE_LOCK -# define MBLEN_UNLOCK_ gwLOCALE_UNLOCK +# define MBLEN_LOCK_ gwLOCALE_LOCK +# define MBLEN_UNLOCK_ gwLOCALE_UNLOCK -# define MBTOWC_LOCK_ gwLOCALE_LOCK -# define MBTOWC_UNLOCK_ gwLOCALE_UNLOCK +# define MBTOWC_LOCK_ gwLOCALE_LOCK +# define MBTOWC_UNLOCK_ gwLOCALE_UNLOCK -# define WCTOMB_LOCK_ gwLOCALE_LOCK -# define WCTOMB_UNLOCK_ gwLOCALE_UNLOCK +# define WCTOMB_LOCK_ gwLOCALE_LOCK +# define WCTOMB_UNLOCK_ gwLOCALE_UNLOCK - /* Whereas the reentrant versions don't (assuming they are called with a - * per-thread buffer; some have the capability of being called with a NULL - * parameter, which defeats the reentrancy) */ -# define MBRLEN_LOCK_ NOOP -# define MBRLEN_UNLOCK_ NOOP -# define MBRTOWC_LOCK_ NOOP -# define MBRTOWC_UNLOCK_ NOOP -# define WCRTOMB_LOCK_ NOOP -# define WCRTOMB_UNLOCK_ NOOP + /* Whereas the reentrant versions don't (assuming they are called + * with a per-thread buffer; some have the capability of being called + * with a NULL parameter, which defeats the reentrancy) */ +# define MBRLEN_LOCK_ NOOP +# define MBRLEN_UNLOCK_ NOOP +# define MBRTOWC_LOCK_ NOOP +# define MBRTOWC_UNLOCK_ NOOP +# define WCRTOMB_LOCK_ NOOP +# define WCRTOMB_UNLOCK_ NOOP -# define LC_COLLATE_LOCK SETLOCALE_LOCK -# define LC_COLLATE_UNLOCK SETLOCALE_UNLOCK +# define LC_COLLATE_LOCK SETLOCALE_LOCK +# define LC_COLLATE_UNLOCK SETLOCALE_UNLOCK -# define STRFTIME_LOCK ENV_LOCK -# define STRFTIME_UNLOCK ENV_UNLOCK +# define STRFTIME_LOCK ENV_LOCK +# define STRFTIME_UNLOCK ENV_UNLOCK #ifdef USE_LOCALE_NUMERIC @@ -7413,152 +7389,152 @@ cannot have changed since the precalculation. */ /* If the underlying numeric locale has a non-dot decimal point or has a - * non-empty floating point thousands separator, the current locale is instead - * generally kept in the C locale instead of that underlying locale. The - * current status is known by looking at two words. One is non-zero if the - * current numeric locale is the standard C/POSIX one or is indistinguishable - * from C. The other is non-zero if the current locale is the underlying - * locale. Both can be non-zero if, as often happens, the underlying locale is - * C or indistinguishable from it. + * non-empty floating point thousands separator, the current locale is + * instead generally kept in the C locale instead of that underlying + * locale. The current status is known by looking at two words. One is + * non-zero if the current numeric locale is the standard C/POSIX one or + * is indistinguishable from C. The other is non-zero if the current + * locale is the underlying locale. Both can be non-zero if, as often + * happens, the underlying locale is C or indistinguishable from it. * - * khw believes the reason for the variables instead of the bits in a single - * word is to avoid having to have masking instructions. */ + * khw believes the reason for the variables instead of the bits in a + * single word is to avoid having to have masking instructions. */ -# define NOT_IN_NUMERIC_STANDARD_ (! PL_numeric_standard) +# define NOT_IN_NUMERIC_STANDARD_ (! PL_numeric_standard) -/* We can lock the category to stay in the C locale, making requests to the - * contrary be noops, in the dynamic scope by setting PL_numeric_standard to 2. - * */ -# define NOT_IN_NUMERIC_UNDERLYING_ \ - (! PL_numeric_underlying && PL_numeric_standard < 2) +/* We can lock the category to stay in the C locale, making + * requests to the contrary be noops, in the dynamic scope + * by setting PL_numeric_standard to 2. */ +# define NOT_IN_NUMERIC_UNDERLYING_ \ + (! PL_numeric_underlying && PL_numeric_standard < 2) -# define DECLARATION_FOR_LC_NUMERIC_MANIPULATION \ - void (*_restore_LC_NUMERIC_function)(pTHX) = NULL +# define DECLARATION_FOR_LC_NUMERIC_MANIPULATION \ + void (*_restore_LC_NUMERIC_function)(pTHX) = NULL # define STORE_LC_NUMERIC_SET_TO_NEEDED_IN(in) \ - STMT_START { \ - bool _in_lc_numeric = (in); \ - LC_NUMERIC_LOCK( \ - ( ( _in_lc_numeric && NOT_IN_NUMERIC_UNDERLYING_) \ - || (! _in_lc_numeric && NOT_IN_NUMERIC_STANDARD_))); \ - if (_in_lc_numeric) { \ - if (NOT_IN_NUMERIC_UNDERLYING_) { \ - Perl_set_numeric_underlying(aTHX); \ - _restore_LC_NUMERIC_function \ - = &Perl_set_numeric_standard; \ - } \ - } \ - else { \ - if (NOT_IN_NUMERIC_STANDARD_) { \ - Perl_set_numeric_standard(aTHX); \ - _restore_LC_NUMERIC_function \ - = &Perl_set_numeric_underlying; \ - } \ - } \ - } STMT_END - -# define STORE_LC_NUMERIC_SET_TO_NEEDED() \ - STORE_LC_NUMERIC_SET_TO_NEEDED_IN(IN_LC(LC_NUMERIC)) - -# define RESTORE_LC_NUMERIC() \ - STMT_START { \ - if (_restore_LC_NUMERIC_function) { \ - _restore_LC_NUMERIC_function(aTHX); \ - } \ - LC_NUMERIC_UNLOCK; \ - } STMT_END - -/* The next two macros should be rarely used, and only after being sure that - * this is what is needed */ + STMT_START { \ + bool _in_lc_numeric = (in); \ + LC_NUMERIC_LOCK( \ + ( ( _in_lc_numeric && NOT_IN_NUMERIC_UNDERLYING_) \ + || (! _in_lc_numeric && NOT_IN_NUMERIC_STANDARD_))); \ + if (_in_lc_numeric) { \ + if (NOT_IN_NUMERIC_UNDERLYING_) { \ + Perl_set_numeric_underlying(aTHX); \ + _restore_LC_NUMERIC_function \ + = &Perl_set_numeric_standard; \ + } \ + } \ + else { \ + if (NOT_IN_NUMERIC_STANDARD_) { \ + Perl_set_numeric_standard(aTHX); \ + _restore_LC_NUMERIC_function \ + = &Perl_set_numeric_underlying; \ + } \ + } \ + } STMT_END + +# define STORE_LC_NUMERIC_SET_TO_NEEDED() \ + STORE_LC_NUMERIC_SET_TO_NEEDED_IN(IN_LC(LC_NUMERIC)) + +# define RESTORE_LC_NUMERIC() \ + STMT_START { \ + if (_restore_LC_NUMERIC_function) { \ + _restore_LC_NUMERIC_function(aTHX); \ + } \ + LC_NUMERIC_UNLOCK; \ + } STMT_END + +/* The next two macros should be rarely used, and only + * after being sure that this is what is needed */ # define SET_NUMERIC_STANDARD() \ - STMT_START { \ - DEBUG_Lv(PerlIO_printf(Perl_debug_log, \ - "%s: %d: lc_numeric standard=%d\n", \ + STMT_START { \ + DEBUG_Lv(PerlIO_printf(Perl_debug_log, \ + "%s: %d: lc_numeric standard=%d\n", \ + __FILE__, __LINE__, PL_numeric_standard)); \ + if (UNLIKELY(NOT_IN_NUMERIC_STANDARD_)) { \ + Perl_set_numeric_standard(aTHX); \ + } \ + DEBUG_Lv(PerlIO_printf(Perl_debug_log, \ + "%s: %d: lc_numeric standard=%d\n", \ __FILE__, __LINE__, PL_numeric_standard)); \ - if (UNLIKELY(NOT_IN_NUMERIC_STANDARD_)) { \ - Perl_set_numeric_standard(aTHX); \ - } \ - DEBUG_Lv(PerlIO_printf(Perl_debug_log, \ - "%s: %d: lc_numeric standard=%d\n", \ - __FILE__, __LINE__, PL_numeric_standard)); \ - } STMT_END + } STMT_END -# define SET_NUMERIC_UNDERLYING() \ - STMT_START { \ - /*assert(PL_locale_mutex_depth > 0);*/ \ - if (NOT_IN_NUMERIC_UNDERLYING_) { \ - Perl_set_numeric_underlying(aTHX); \ - } \ - } STMT_END +# define SET_NUMERIC_UNDERLYING() \ + STMT_START { \ + /*assert(PL_locale_mutex_depth > 0); */ \ + if (NOT_IN_NUMERIC_UNDERLYING_) { \ + Perl_set_numeric_underlying(aTHX); \ + } \ + } STMT_END /* The rest of these LC_NUMERIC macros toggle to one or the other state, with * the RESTORE_foo ones called to switch back, but only if need be */ # define STORE_LC_NUMERIC_SET_STANDARD() \ - STMT_START { \ - LC_NUMERIC_LOCK(NOT_IN_NUMERIC_STANDARD_); \ - if (NOT_IN_NUMERIC_STANDARD_) { \ - _restore_LC_NUMERIC_function = &Perl_set_numeric_underlying;\ - Perl_set_numeric_standard(aTHX); \ - } \ - } STMT_END - -/* Rarely, we want to change to the underlying locale even outside of 'use - * locale'. This is principally in the POSIX:: functions */ + STMT_START { \ + LC_NUMERIC_LOCK(NOT_IN_NUMERIC_STANDARD_); \ + if (NOT_IN_NUMERIC_STANDARD_) { \ + _restore_LC_NUMERIC_function = &Perl_set_numeric_underlying; \ + Perl_set_numeric_standard(aTHX); \ + } \ + } STMT_END + +/* Rarely, we want to change to the underlying locale even outside of + * 'use locale'. This is principally in the POSIX:: functions */ # define STORE_LC_NUMERIC_FORCE_TO_UNDERLYING() \ - STMT_START { \ - LC_NUMERIC_LOCK(NOT_IN_NUMERIC_UNDERLYING_); \ - if (NOT_IN_NUMERIC_UNDERLYING_) { \ - Perl_set_numeric_underlying(aTHX); \ - _restore_LC_NUMERIC_function = &Perl_set_numeric_standard; \ - } \ - } STMT_END - -/* Lock/unlock to the C locale until unlock is called. This needs to be - * recursively callable. [perl #128207] */ + STMT_START { \ + LC_NUMERIC_LOCK(NOT_IN_NUMERIC_UNDERLYING_); \ + if (NOT_IN_NUMERIC_UNDERLYING_) { \ + Perl_set_numeric_underlying(aTHX); \ + _restore_LC_NUMERIC_function = &Perl_set_numeric_standard; \ + } \ + } STMT_END + +/* Lock/unlock to the C locale until unlock is called. This + * needs to be recursively callable. [perl #128207] */ # define LOCK_LC_NUMERIC_STANDARD() \ - STMT_START { \ - DEBUG_Lv(PerlIO_printf(Perl_debug_log, \ - "%s: %d: lc_numeric_standard now locked to depth %d\n", \ - __FILE__, __LINE__, PL_numeric_standard)); \ - __ASSERT_(PL_numeric_standard) \ - PL_numeric_standard++; \ - } STMT_END + STMT_START { \ + DEBUG_Lv(PerlIO_printf(Perl_debug_log, \ + "%s: %d: lc_numeric_standard now locked to depth %d\n", \ + __FILE__, __LINE__, PL_numeric_standard)); \ + __ASSERT_(PL_numeric_standard) \ + PL_numeric_standard++; \ + } STMT_END # define UNLOCK_LC_NUMERIC_STANDARD() \ - STMT_START { \ - if (PL_numeric_standard > 1) { \ - PL_numeric_standard--; \ - } \ - else { \ - assert(0); \ - } \ - DEBUG_Lv(PerlIO_printf(Perl_debug_log, \ - "%s: %d: ", __FILE__, __LINE__); \ - if (PL_numeric_standard <= 1) \ - PerlIO_printf(Perl_debug_log, \ - "lc_numeric_standard now unlocked\n");\ - else PerlIO_printf(Perl_debug_log, \ - "lc_numeric_standard lock decremented to depth %d\n", \ - PL_numeric_standard););\ - } STMT_END - -# define WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric, block) \ - STMT_START { \ - DECLARATION_FOR_LC_NUMERIC_MANIPULATION; \ - STORE_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric); \ - block; \ - RESTORE_LC_NUMERIC(); \ - } STMT_END; - -# define WITH_LC_NUMERIC_SET_TO_NEEDED(block) \ - WITH_LC_NUMERIC_SET_TO_NEEDED_IN(IN_LC(LC_NUMERIC), block) + STMT_START { \ + if (PL_numeric_standard > 1) { \ + PL_numeric_standard--; \ + } \ + else { \ + assert(0); \ + } \ + DEBUG_Lv(PerlIO_printf(Perl_debug_log, \ + "%s: %d: ", __FILE__, __LINE__); \ + if (PL_numeric_standard <= 1) \ + PerlIO_printf(Perl_debug_log, \ + "lc_numeric_standard now unlocked\n"); \ + else PerlIO_printf(Perl_debug_log, \ + "lc_numeric_standard lock decremented to depth %d\n", \ + PL_numeric_standard);); \ + } STMT_END + +# define WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric, block) \ + STMT_START { \ + DECLARATION_FOR_LC_NUMERIC_MANIPULATION; \ + STORE_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric); \ + block; \ + RESTORE_LC_NUMERIC(); \ + } STMT_END; + +# define WITH_LC_NUMERIC_SET_TO_NEEDED(block) \ + WITH_LC_NUMERIC_SET_TO_NEEDED_IN(IN_LC(LC_NUMERIC), block) #else /* !USE_LOCALE_NUMERIC */ # define SET_NUMERIC_STANDARD() # define SET_NUMERIC_UNDERLYING() -# define IS_NUMERIC_RADIX(a, b) (0) -# define DECLARATION_FOR_LC_NUMERIC_MANIPULATION dNOOP +# define IS_NUMERIC_RADIX(a, b) (0) +# define DECLARATION_FOR_LC_NUMERIC_MANIPULATION dNOOP # define STORE_LC_NUMERIC_SET_STANDARD() # define STORE_LC_NUMERIC_FORCE_TO_UNDERLYING() # define STORE_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric) @@ -7566,44 +7542,44 @@ cannot have changed since the precalculation. # define RESTORE_LC_NUMERIC() # define LOCK_LC_NUMERIC_STANDARD() # define UNLOCK_LC_NUMERIC_STANDARD() -# define WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric, block) \ - STMT_START { block; } STMT_END -# define WITH_LC_NUMERIC_SET_TO_NEEDED(block) \ - STMT_START { block; } STMT_END +# define WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric, block) \ + STMT_START { block; } STMT_END +# define WITH_LC_NUMERIC_SET_TO_NEEDED(block) \ + STMT_START { block; } STMT_END #endif /* !USE_LOCALE_NUMERIC */ #ifdef USE_LOCALE_THREADS -# define ENV_LOCK PERL_WRITE_LOCK(&PL_env_mutex) -# define ENV_UNLOCK PERL_WRITE_UNLOCK(&PL_env_mutex) -# define ENV_READ_LOCK PERL_READ_LOCK(&PL_env_mutex) -# define ENV_READ_UNLOCK PERL_READ_UNLOCK(&PL_env_mutex) -# define ENV_INIT PERL_RW_MUTEX_INIT(&PL_env_mutex) -# define ENV_TERM PERL_RW_MUTEX_DESTROY(&PL_env_mutex) +# define ENV_LOCK PERL_WRITE_LOCK(&PL_env_mutex) +# define ENV_UNLOCK PERL_WRITE_UNLOCK(&PL_env_mutex) +# define ENV_READ_LOCK PERL_READ_LOCK(&PL_env_mutex) +# define ENV_READ_UNLOCK PERL_READ_UNLOCK(&PL_env_mutex) +# define ENV_INIT PERL_RW_MUTEX_INIT(&PL_env_mutex) +# define ENV_TERM PERL_RW_MUTEX_DESTROY(&PL_env_mutex) /* On platforms where the static buffer contained in getenv() is per-thread - * rather than process-wide, another thread executing a getenv() at the same - * time won't destroy ours before we have copied the result safely away and - * unlocked the mutex. On such platforms (which is most), we can have many - * readers of the environment at the same time. */ + * rather than process-wide, another thread executing a getenv() at the + * same time won't destroy ours before we have copied the result safely + * away and unlocked the mutex. On such platforms (which is most), we can + * have many readers of the environment at the same time. */ # ifdef GETENV_PRESERVES_OTHER_THREAD -# define GETENV_LOCK ENV_READ_LOCK -# define GETENV_UNLOCK ENV_READ_UNLOCK +# define GETENV_LOCK ENV_READ_LOCK +# define GETENV_UNLOCK ENV_READ_UNLOCK # else - /* If, on the other hand, another thread could zap our getenv() return, we - * need to keep them from executing until we are done */ -# define GETENV_LOCK ENV_LOCK -# define GETENV_UNLOCK ENV_UNLOCK + /* If, on the other hand, another thread could zap our getenv() return, + * we need to keep them from executing until we are done */ +# define GETENV_LOCK ENV_LOCK +# define GETENV_UNLOCK ENV_UNLOCK # endif #else -# define ENV_LOCK NOOP -# define ENV_UNLOCK NOOP -# define ENV_READ_LOCK NOOP -# define ENV_READ_UNLOCK NOOP -# define ENV_INIT NOOP -# define ENV_TERM NOOP -# define GETENV_LOCK NOOP -# define GETENV_UNLOCK NOOP +# define ENV_LOCK NOOP +# define ENV_UNLOCK NOOP +# define ENV_READ_LOCK NOOP +# define ENV_READ_UNLOCK NOOP +# define ENV_INIT NOOP +# define ENV_TERM NOOP +# define GETENV_LOCK NOOP +# define GETENV_UNLOCK NOOP #endif /* Some critical sections need to lock both the locale and the environment from @@ -7611,150 +7587,150 @@ cannot have changed since the precalculation. * is always done in the same order. These should always be invoked, like all * locks really, at such a low level that its just a libc call that is wrapped, * so as to prevent recursive calls which could deadlock. */ -#define ENVr_LOCALEr_LOCK \ - STMT_START { LOCALE_READ_LOCK; ENV_READ_LOCK; } STMT_END -#define ENVr_LOCALEr_UNLOCK \ - STMT_START { ENV_READ_UNLOCK; LOCALE_READ_UNLOCK; } STMT_END +#define ENVr_LOCALEr_LOCK \ + STMT_START { LOCALE_READ_LOCK; ENV_READ_LOCK; } STMT_END +#define ENVr_LOCALEr_UNLOCK \ + STMT_START { ENV_READ_UNLOCK; LOCALE_READ_UNLOCK; } STMT_END /* These time-related functions all requre that the environment and locale - * don't change while they are executing (at least in glibc; this appears to be - * contrary to the POSIX standard). tzset() writes global variables, so - * always needs to have write locking. ctime, localtime, mktime, and strftime - * effectively call it, so they too need exclusive access. The rest need to - * have exclusive locking as well so that they can copy the contents of the - * returned static buffer before releasing the lock. That leaves asctime and - * gmtime. There may be reentrant versions of these available on the platform - * which don't require write locking. + * don't change while they are executing (at least in glibc; this appears + * to be contrary to the POSIX standard). tzset() writes global variables, + * so always needs to have write locking. ctime, localtime, mktime, and + * strftime effectively call it, so they too need exclusive access. The + * rest need to have exclusive locking as well so that they can copy the + * contents of the returned static buffer before releasing the lock. That + * leaves asctime and gmtime. There may be reentrant versions of these + * available on the platform which don't require write locking. */ #ifdef PERL_REENTR_USING_ASCTIME_R -# define ASCTIME_LOCK ENVr_LOCALEr_LOCK -# define ASCTIME_UNLOCK ENVr_LOCALEr_UNLOCK +# define ASCTIME_LOCK ENVr_LOCALEr_LOCK +# define ASCTIME_UNLOCK ENVr_LOCALEr_UNLOCK #else -# define ASCTIME_LOCK gwENVr_LOCALEr_LOCK -# define ASCTIME_UNLOCK gwENVr_LOCALEr_UNLOCK +# define ASCTIME_LOCK gwENVr_LOCALEr_LOCK +# define ASCTIME_UNLOCK gwENVr_LOCALEr_UNLOCK #endif -#define CTIME_LOCK gwENVr_LOCALEr_LOCK -#define CTIME_UNLOCK gwENVr_LOCALEr_UNLOCK +#define CTIME_LOCK gwENVr_LOCALEr_LOCK +#define CTIME_UNLOCK gwENVr_LOCALEr_UNLOCK #ifdef PERL_REENTR_USING_GMTIME_R -# define GMTIME_LOCK ENVr_LOCALEr_LOCK -# define GMTIME_UNLOCK ENVr_LOCALEr_UNLOCK +# define GMTIME_LOCK ENVr_LOCALEr_LOCK +# define GMTIME_UNLOCK ENVr_LOCALEr_UNLOCK #else -# define GMTIME_LOCK gwENVr_LOCALEr_LOCK -# define GMTIME_UNLOCK gwENVr_LOCALEr_UNLOCK -#endif - -#define LOCALTIME_LOCK gwENVr_LOCALEr_LOCK -#define LOCALTIME_UNLOCK gwENVr_LOCALEr_UNLOCK -#define MKTIME_LOCK gwENVr_LOCALEr_LOCK -#define MKTIME_UNLOCK gwENVr_LOCALEr_UNLOCK -#define TZSET_LOCK gwENVr_LOCALEr_LOCK -#define TZSET_UNLOCK gwENVr_LOCALEr_UNLOCK - -/* Similiarly, these functions need a constant environment and/or locale. And - * some have a buffer that is shared with another thread executing the same or - * a related call. A mutex could be created for each class, but for now, share - * the ENV mutex with everything, as none probably gets called so much that - * performance would suffer by a thread being locked out by another thread that - * could have used a different mutex. +# define GMTIME_LOCK gwENVr_LOCALEr_LOCK +# define GMTIME_UNLOCK gwENVr_LOCALEr_UNLOCK +#endif + +#define LOCALTIME_LOCK gwENVr_LOCALEr_LOCK +#define LOCALTIME_UNLOCK gwENVr_LOCALEr_UNLOCK +#define MKTIME_LOCK gwENVr_LOCALEr_LOCK +#define MKTIME_UNLOCK gwENVr_LOCALEr_UNLOCK +#define TZSET_LOCK gwENVr_LOCALEr_LOCK +#define TZSET_UNLOCK gwENVr_LOCALEr_UNLOCK + +/* Similiarly, these functions need a constant environment and/or locale. + * And some have a buffer that is shared with another thread executing the + * same or a related call. A mutex could be created for each class, but + * for now, share the ENV mutex with everything, as none probably gets + * called so much that performance would suffer by a thread being locked + * out by another thread that could have used a different mutex. * * But, create a different macro name just to indicate the ones that don't - * actually depend on the environment, but are using its mutex for want of a - * better one */ -#define gwLOCALEr_LOCK gwENVr_LOCALEr_LOCK -#define gwLOCALEr_UNLOCK gwENVr_LOCALEr_UNLOCK + * actually depend on the environment, but are using its mutex for want of + * a better one */ +#define gwLOCALEr_LOCK gwENVr_LOCALEr_LOCK +#define gwLOCALEr_UNLOCK gwENVr_LOCALEr_UNLOCK #ifdef PERL_REENTR_USING_GETHOSTBYADDR_R -# define GETHOSTBYADDR_LOCK ENVr_LOCALEr_LOCK -# define GETHOSTBYADDR_UNLOCK ENVr_LOCALEr_UNLOCK +# define GETHOSTBYADDR_LOCK ENVr_LOCALEr_LOCK +# define GETHOSTBYADDR_UNLOCK ENVr_LOCALEr_UNLOCK #else -# define GETHOSTBYADDR_LOCK gwENVr_LOCALEr_LOCK -# define GETHOSTBYADDR_UNLOCK gwENVr_LOCALEr_UNLOCK +# define GETHOSTBYADDR_LOCK gwENVr_LOCALEr_LOCK +# define GETHOSTBYADDR_UNLOCK gwENVr_LOCALEr_UNLOCK #endif #ifdef PERL_REENTR_USING_GETHOSTBYNAME_R -# define GETHOSTBYNAME_LOCK ENVr_LOCALEr_LOCK -# define GETHOSTBYNAME_UNLOCK ENVr_LOCALEr_UNLOCK +# define GETHOSTBYNAME_LOCK ENVr_LOCALEr_LOCK +# define GETHOSTBYNAME_UNLOCK ENVr_LOCALEr_UNLOCK #else -# define GETHOSTBYNAME_LOCK gwENVr_LOCALEr_LOCK -# define GETHOSTBYNAME_UNLOCK gwENVr_LOCALEr_UNLOCK +# define GETHOSTBYNAME_LOCK gwENVr_LOCALEr_LOCK +# define GETHOSTBYNAME_UNLOCK gwENVr_LOCALEr_UNLOCK #endif #ifdef PERL_REENTR_USING_GETNETBYADDR_R -# define GETNETBYADDR_LOCK LOCALE_READ_LOCK -# define GETNETBYADDR_UNLOCK LOCALE_READ_UNLOCK +# define GETNETBYADDR_LOCK LOCALE_READ_LOCK +# define GETNETBYADDR_UNLOCK LOCALE_READ_UNLOCK #else -# define GETNETBYADDR_LOCK gwLOCALEr_LOCK -# define GETNETBYADDR_UNLOCK gwLOCALEr_UNLOCK +# define GETNETBYADDR_LOCK gwLOCALEr_LOCK +# define GETNETBYADDR_UNLOCK gwLOCALEr_UNLOCK #endif #ifdef PERL_REENTR_USING_GETNETBYNAME_R -# define GETNETBYNAME_LOCK LOCALE_READ_LOCK -# define GETNETBYNAME_UNLOCK LOCALE_READ_UNLOCK +# define GETNETBYNAME_LOCK LOCALE_READ_LOCK +# define GETNETBYNAME_UNLOCK LOCALE_READ_UNLOCK #else -# define GETNETBYNAME_LOCK gwLOCALEr_LOCK -# define GETNETBYNAME_UNLOCK gwLOCALEr_UNLOCK +# define GETNETBYNAME_LOCK gwLOCALEr_LOCK +# define GETNETBYNAME_UNLOCK gwLOCALEr_UNLOCK #endif #ifdef PERL_REENTR_USING_GETPROTOBYNAME_R -# define GETPROTOBYNAME_LOCK LOCALE_READ_LOCK -# define GETPROTOBYNAME_UNLOCK LOCALE_READ_UNLOCK +# define GETPROTOBYNAME_LOCK LOCALE_READ_LOCK +# define GETPROTOBYNAME_UNLOCK LOCALE_READ_UNLOCK #else -# define GETPROTOBYNAME_LOCK gwLOCALEr_LOCK -# define GETPROTOBYNAME_UNLOCK gwLOCALEr_UNLOCK +# define GETPROTOBYNAME_LOCK gwLOCALEr_LOCK +# define GETPROTOBYNAME_UNLOCK gwLOCALEr_UNLOCK #endif #ifdef PERL_REENTR_USING_GETPROTOBYNUMBER_R -# define GETPROTOBYNUMBER_LOCK LOCALE_READ_LOCK -# define GETPROTOBYNUMBER_UNLOCK LOCALE_READ_UNLOCK +# define GETPROTOBYNUMBER_LOCK LOCALE_READ_LOCK +# define GETPROTOBYNUMBER_UNLOCK LOCALE_READ_UNLOCK #else -# define GETPROTOBYNUMBER_LOCK gwLOCALEr_LOCK -# define GETPROTOBYNUMBER_UNLOCK gwLOCALEr_UNLOCK +# define GETPROTOBYNUMBER_LOCK gwLOCALEr_LOCK +# define GETPROTOBYNUMBER_UNLOCK gwLOCALEr_UNLOCK #endif #ifdef PERL_REENTR_USING_GETPROTOENT_R -# define GETPROTOENT_LOCK LOCALE_READ_LOCK -# define GETPROTOENT_UNLOCK LOCALE_READ_UNLOCK +# define GETPROTOENT_LOCK LOCALE_READ_LOCK +# define GETPROTOENT_UNLOCK LOCALE_READ_UNLOCK #else -# define GETPROTOENT_LOCK gwLOCALEr_LOCK -# define GETPROTOENT_UNLOCK gwLOCALEr_UNLOCK +# define GETPROTOENT_LOCK gwLOCALEr_LOCK +# define GETPROTOENT_UNLOCK gwLOCALEr_UNLOCK #endif #ifdef PERL_REENTR_USING_GETPWNAM_R -# define GETPWNAM_LOCK LOCALE_READ_LOCK -# define GETPWNAM_UNLOCK LOCALE_READ_UNLOCK +# define GETPWNAM_LOCK LOCALE_READ_LOCK +# define GETPWNAM_UNLOCK LOCALE_READ_UNLOCK #else -# define GETPWNAM_LOCK gwLOCALEr_LOCK -# define GETPWNAM_UNLOCK gwLOCALEr_UNLOCK +# define GETPWNAM_LOCK gwLOCALEr_LOCK +# define GETPWNAM_UNLOCK gwLOCALEr_UNLOCK #endif #ifdef PERL_REENTR_USING_GETPWUID_R -# define GETPWUID_LOCK LOCALE_READ_LOCK -# define GETPWUID_UNLOCK LOCALE_READ_UNLOCK +# define GETPWUID_LOCK LOCALE_READ_LOCK +# define GETPWUID_UNLOCK LOCALE_READ_UNLOCK #else -# define GETPWUID_LOCK gwLOCALEr_LOCK -# define GETPWUID_UNLOCK gwLOCALEr_UNLOCK +# define GETPWUID_LOCK gwLOCALEr_LOCK +# define GETPWUID_UNLOCK gwLOCALEr_UNLOCK #endif #ifdef PERL_REENTR_USING_GETSERVBYNAME_R -# define GETSERVBYNAME_LOCK LOCALE_READ_LOCK -# define GETSERVBYNAME_UNLOCK LOCALE_READ_UNLOCK +# define GETSERVBYNAME_LOCK LOCALE_READ_LOCK +# define GETSERVBYNAME_UNLOCK LOCALE_READ_UNLOCK #else -# define GETSERVBYNAME_LOCK gwLOCALEr_LOCK -# define GETSERVBYNAME_UNLOCK gwLOCALEr_UNLOCK +# define GETSERVBYNAME_LOCK gwLOCALEr_LOCK +# define GETSERVBYNAME_UNLOCK gwLOCALEr_UNLOCK #endif #ifdef PERL_REENTR_USING_GETSERVBYPORT_R -# define GETSERVBYPORT_LOCK LOCALE_READ_LOCK -# define GETSERVBYPORT_UNLOCK LOCALE_READ_UNLOCK +# define GETSERVBYPORT_LOCK LOCALE_READ_LOCK +# define GETSERVBYPORT_UNLOCK LOCALE_READ_UNLOCK #else -# define GETSERVBYPORT_LOCK gwLOCALEr_LOCK -# define GETSERVBYPORT_UNLOCK gwLOCALEr_UNLOCK +# define GETSERVBYPORT_LOCK gwLOCALEr_LOCK +# define GETSERVBYPORT_UNLOCK gwLOCALEr_UNLOCK #endif #ifdef PERL_REENTR_USING_GETSERVENT_R -# define GETSERVENT_LOCK LOCALE_READ_LOCK -# define GETSERVENT_UNLOCK LOCALE_READ_UNLOCK +# define GETSERVENT_LOCK LOCALE_READ_LOCK +# define GETSERVENT_UNLOCK LOCALE_READ_UNLOCK #else -# define GETSERVENT_LOCK gwLOCALEr_LOCK -# define GETSERVENT_UNLOCK gwLOCALEr_UNLOCK +# define GETSERVENT_LOCK gwLOCALEr_LOCK +# define GETSERVENT_UNLOCK gwLOCALEr_UNLOCK #endif #ifdef PERL_REENTR_USING_GETSPNAM_R -# define GETSPNAM_LOCK LOCALE_READ_LOCK -# define GETSPNAM_UNLOCK LOCALE_READ_UNLOCK +# define GETSPNAM_LOCK LOCALE_READ_LOCK +# define GETSPNAM_UNLOCK LOCALE_READ_UNLOCK #else -# define GETSPNAM_LOCK gwLOCALEr_LOCK -# define GETSPNAM_UNLOCK gwLOCALEr_UNLOCK +# define GETSPNAM_LOCK gwLOCALEr_LOCK +# define GETSPNAM_UNLOCK gwLOCALEr_UNLOCK #endif #define STRFMON_LOCK LC_MONETARY_LOCK @@ -7763,17 +7739,16 @@ cannot have changed since the precalculation. /* End of locale/env synchronization */ #ifndef PERL_NO_INLINE_FUNCTIONS -/* Static inline funcs that depend on includes and declarations above. - Some of these reference functions in the perl object files, and some - compilers aren't smart enough to eliminate unused static inline - functions, so including this file in source code can cause link errors - even if the source code uses none of the functions. Hence including these - can be suppressed by setting PERL_NO_INLINE_FUNCTIONS. Doing this will - (obviously) result in unworkable XS code, but allows simple probing code - to continue to work, because it permits tests to include the perl headers - for definitions without creating a link dependency on the perl library - (which may not exist yet). -*/ +/* Static inline funcs that depend on includes and declarations above. Some of + these reference functions in the perl object files, and some compilers + aren't smart enough to eliminate unused static inline functions, so + including this file in source code can cause link errors even if the source + code uses none of the functions. Hence including these can be suppressed by + setting PERL_NO_INLINE_FUNCTIONS. Doing this will (obviously) result in + unworkable XS code, but allows simple probing code to continue to work, + because it permits tests to include the perl headers for definitions without + creating a link dependency on the perl library (which may not exist yet). + */ START_EXTERN_C @@ -7795,117 +7770,117 @@ This is a synonym for L. =for apidoc AmTR|NV|Strtol|NN const char * const s|NULLOK char ** e|int base -Platform and configuration independent C. This expands to the -appropriate C-like function based on the platform and F -options>. For example it could expand to C or C instead of -C. +Platform and configuration independent C. This expands +to the appropriate C-like function based on the +platform and F options>. For example it could expand +to C or C instead of C. =for apidoc AmTR|NV|Strtoul|NN const char * const s|NULLOK char ** e|int base -Platform and configuration independent C. This expands to the -appropriate C-like function based on the platform and F -options>. For example it could expand to C or C instead of -C. +Platform and configuration independent C. This expands +to the appropriate C-like function based on the +platform and F options>. For example it could expand +to C or C instead of C. =cut - */ -#define Strtod my_strtod +#define Strtod my_strtod -#if defined(HAS_STRTOD) \ - || defined(USE_QUADMATH) \ - || (defined(HAS_STRTOLD) && defined(HAS_LONG_DOUBLE) \ - && defined(USE_LONG_DOUBLE)) -# define Perl_strtod Strtod +#if defined(HAS_STRTOD) \ + || defined(USE_QUADMATH) \ + || (defined(HAS_STRTOLD) && defined(HAS_LONG_DOUBLE) \ + && defined(USE_LONG_DOUBLE)) +# define Perl_strtod Strtod #endif -#if !defined(Strtol) && defined(USE_64_BIT_INT) && defined(IV_IS_QUAD) && \ - (QUADKIND == QUAD_IS_LONG_LONG || QUADKIND == QUAD_IS___INT64) +#if !defined(Strtol) && defined(USE_64_BIT_INT) && defined(IV_IS_QUAD) && \ + (QUADKIND == QUAD_IS_LONG_LONG || QUADKIND == QUAD_IS___INT64) # ifdef __hpux -# define strtoll __strtoll /* secret handshake */ +# define strtoll __strtoll /* secret handshake */ # endif # if defined(WIN64) && defined(_MSC_VER) -# define strtoll _strtoi64 /* secret handshake */ +# define strtoll _strtoi64 /* secret handshake */ # endif # if !defined(Strtol) && defined(HAS_STRTOLL) -# define Strtol strtoll +# define Strtol strtoll # endif # if !defined(Strtol) && defined(HAS_STRTOQ) -# define Strtol strtoq +# define Strtol strtoq # endif /* is there atoq() anywhere? */ #endif #if !defined(Strtol) && defined(HAS_STRTOL) -# define Strtol strtol +# define Strtol strtol #endif #ifndef Atol -/* It would be more fashionable to use Strtol() to define atol() - * (as is done for Atoul(), see below) but for backward compatibility - * we just assume atol(). */ -# if defined(USE_64_BIT_INT) && defined(IV_IS_QUAD) && defined(HAS_ATOLL) && \ - (QUADKIND == QUAD_IS_LONG_LONG || QUADKIND == QUAD_IS___INT64) +/* It would be more fashionable to use Strtol() to define + * atol() (as is done for Atoul(), see below) but for + * backward compatibility we just assume atol(). */ +# if defined(USE_64_BIT_INT) && defined(IV_IS_QUAD) && defined(HAS_ATOLL) && \ + (QUADKIND == QUAD_IS_LONG_LONG || QUADKIND == QUAD_IS___INT64) # ifdef WIN64 -# define atoll _atoi64 /* secret handshake */ +# define atoll _atoi64 /* secret handshake */ # endif -# define Atol atoll +# define Atol atoll # else -# define Atol atol +# define Atol atol # endif #endif -#if !defined(Strtoul) && defined(USE_64_BIT_INT) && defined(UV_IS_QUAD) && \ - (QUADKIND == QUAD_IS_LONG_LONG || QUADKIND == QUAD_IS___INT64) +#if !defined(Strtoul) && defined(USE_64_BIT_INT) && defined(UV_IS_QUAD) && \ + (QUADKIND == QUAD_IS_LONG_LONG || QUADKIND == QUAD_IS___INT64) # ifdef __hpux -# define strtoull __strtoull /* secret handshake */ +# define strtoull __strtoull /* secret handshake */ # endif # if defined(WIN64) && defined(_MSC_VER) -# define strtoull _strtoui64 /* secret handshake */ +# define strtoull _strtoui64 /* secret handshake */ # endif # if !defined(Strtoul) && defined(HAS_STRTOULL) -# define Strtoul strtoull +# define Strtoul strtoull # endif # if !defined(Strtoul) && defined(HAS_STRTOUQ) -# define Strtoul strtouq +# define Strtoul strtouq # endif /* is there atouq() anywhere? */ #endif #if !defined(Strtoul) && defined(HAS_STRTOUL) -# define Strtoul strtoul +# define Strtoul strtoul #endif #if !defined(Strtoul) && defined(HAS_STRTOL) /* Last resort. */ -# define Strtoul(s, e, b) strchr((s), '-') ? ULONG_MAX : (unsigned long)strtol((s), (e), (b)) +# define Strtoul(s, e, b) \ + strchr((s), '-') ? ULONG_MAX : (unsigned long)strtol((s), (e), (b)) #endif #ifndef Atoul -# define Atoul(s) Strtoul(s, NULL, 10) +# define Atoul(s) Strtoul(s, NULL, 10) #endif -#define grok_bin(s,lp,fp,rp) \ - grok_bin_oct_hex(s, lp, fp, rp, 1, CC_BINDIGIT_, 'b') -#define grok_oct(s,lp,fp,rp) \ - (*(fp) |= PERL_SCAN_DISALLOW_PREFIX, \ - grok_bin_oct_hex(s, lp, fp, rp, 3, CC_OCTDIGIT_, '\0')) -#define grok_hex(s,lp,fp,rp) \ - grok_bin_oct_hex(s, lp, fp, rp, 4, CC_XDIGIT_, 'x') +#define grok_bin(s,lp,fp,rp) \ + grok_bin_oct_hex(s, lp, fp, rp, 1, CC_BINDIGIT_, 'b') +#define grok_oct(s,lp,fp,rp) \ + (*(fp) |= PERL_SCAN_DISALLOW_PREFIX, \ + grok_bin_oct_hex(s, lp, fp, rp, 3, CC_OCTDIGIT_, '\0')) +#define grok_hex(s,lp,fp,rp) \ + grok_bin_oct_hex(s, lp, fp, rp, 4, CC_XDIGIT_, 'x') #ifndef PERL_SCRIPT_MODE -#define PERL_SCRIPT_MODE "r" +#define PERL_SCRIPT_MODE "r" #endif -/* not used. Kept as a NOOP for backcompat */ -#define PERL_STACK_OVERFLOW_CHECK() NOOP +/* not used. Kept as a NOOP for backcompat */ +#define PERL_STACK_OVERFLOW_CHECK() NOOP /* - * Some nonpreemptive operating systems find it convenient to - * check for asynchronous conditions after each op execution. - * Keep this check simple, or it may slow down execution - * massively. - */ + * Some nonpreemptive operating systems find it convenient to check + * for asynchronous conditions after each op execution. Keep this + * check simple, or it may slow down execution massively. +*/ #ifndef PERL_MICRO -# ifndef PERL_ASYNC_CHECK -# define PERL_ASYNC_CHECK() if (UNLIKELY(PL_sig_pending)) PL_signalhook(aTHX) -# endif +# ifndef PERL_ASYNC_CHECK +# define PERL_ASYNC_CHECK() \ + if (UNLIKELY(PL_sig_pending)) PL_signalhook(aTHX) +# endif #endif #ifndef PERL_ASYNC_CHECK @@ -7913,128 +7888,123 @@ C. #endif /* - * On some operating systems, a memory allocation may succeed, - * but put the process too close to the system's comfort limit. - * In this case, PERL_ALLOC_CHECK frees the pointer and sets - * it to NULL. - */ + * On some operating systems, a memory allocation may succeed, but + * put the process too close to the system's comfort limit. In this + * case, PERL_ALLOC_CHECK frees the pointer and sets it to NULL. +*/ #ifndef PERL_ALLOC_CHECK -#define PERL_ALLOC_CHECK(p) NOOP +#define PERL_ALLOC_CHECK(p) NOOP #endif #ifdef HAS_SEM # include # include -# ifndef HAS_UNION_SEMUN /* Provide the union semun. */ +# ifndef HAS_UNION_SEMUN /* Provide the union semun. */ union semun { - int val; - struct semid_ds *buf; - unsigned short *array; + int val; + struct semid_ds *buf; + unsigned short *array; }; # endif # ifdef USE_SEMCTL_SEMUN -# ifdef IRIX32_SEMUN_BROKEN_BY_GCC +# ifdef IRIX32_SEMUN_BROKEN_BY_GCC union gccbug_semun { int val; struct semid_ds *buf; unsigned short *array; char __dummy[5]; }; -# define semun gccbug_semun -# endif -# define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun) +# define semun gccbug_semun +# endif +# define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun) # elif defined(USE_SEMCTL_SEMID_DS) # ifdef EXTRA_F_IN_SEMUN_BUF -# define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun.buff) +# define Semctl(id, num, cmd, semun) \ + semctl(id, num, cmd, semun.buff) # else -# define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun.buf) +# define Semctl(id, num, cmd, semun) \ + semctl(id, num, cmd, semun.buf) # endif # endif #endif /* - * Boilerplate macros for initializing and accessing interpreter-local - * data from C. All statics in extensions should be reworked to use - * this, if you want to make the extension thread-safe. See - * ext/XS/APItest/APItest.xs for an example of the use of these macros, - * and perlxs.pod for more. + * Boilerplate macros for initializing and accessing interpreter-local data + * from C. All statics in extensions should be reworked to use this, if you + * want to make the extension thread-safe. See ext/XS/APItest/APItest.xs + * for an example of the use of these macros, and perlxs.pod for more. * - * Code that uses these macros is responsible for the following: - * 1. #define MY_CXT_KEY to a unique string, e.g. - * "DynaLoader::_guts" XS_VERSION - * XXX in the current implementation, this string is ignored. - * 2. Declare a typedef named my_cxt_t that is a structure that contains - * all the data that needs to be interpreter-local that perl controls. This - * doesn't include things that libc controls, such as the uselocale object - * in Configurations that use it. - * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t. - * 4. Use the MY_CXT_INIT macro such that it is called exactly once - * (typically put in the BOOT: section). - * 5. Use the members of the my_cxt_t structure everywhere as - * MY_CXT.member. - * 6. Use the dMY_CXT macro (a declaration) in all the functions that - * access MY_CXT. - */ + * Code that uses these macros is responsible for the following: 1. #define + * MY_CXT_KEY to a unique string, e.g. "DynaLoader::_guts" XS_VERSION XXX + * in the current implementation, this string is ignored. 2. Declare a + * typedef named my_cxt_t that is a structure that contains all the data that + * needs to be interpreter-local that perl controls. This doesn't include + * things that libc controls, such as the uselocale object in Configurations + * that use it. 3. Use the START_MY_CXT macro after the declaration of + * my_cxt_t. 4. Use the MY_CXT_INIT macro such that it is called exactly + * once (typically put in the BOOT: section). 5. Use the members of the + * my_cxt_t structure everywhere as MY_CXT.member. 6. Use the dMY_CXT + * macro (a declaration) in all the functions that access MY_CXT. +*/ #if defined(MULTIPLICITY) /* START_MY_CXT must appear in all extensions that define a my_cxt_t structure, - * right after the definition (i.e. at file scope). The non-threads - * case below uses it to declare the data as static. */ -# define START_MY_CXT static int my_cxt_index = -1; -# define MY_CXT_INDEX my_cxt_index + * right after the definition (i.e. at file scope). The non-threads case + * below uses it to declare the data as static. */ +# define START_MY_CXT static int my_cxt_index = -1; +# define MY_CXT_INDEX my_cxt_index # define MY_CXT_INIT_ARG &my_cxt_index -/* Creates and zeroes the per-interpreter data. - * (We allocate my_cxtp in a Perl SV so that it will be released when - * the interpreter goes away.) */ -# define MY_CXT_INIT \ - my_cxt_t *my_cxtp = \ - (my_cxt_t*)Perl_my_cxt_init(aTHX_ MY_CXT_INIT_ARG, sizeof(my_cxt_t)); \ - PERL_UNUSED_VAR(my_cxtp) -# define MY_CXT_INIT_INTERP(my_perl) \ - my_cxt_t *my_cxtp = \ - (my_cxt_t*)Perl_my_cxt_init(my_perl, MY_CXT_INIT_ARG, sizeof(my_cxt_t)); \ - PERL_UNUSED_VAR(my_cxtp) - -/* This declaration should be used within all functions that use the - * interpreter-local data. */ -# define dMY_CXT \ - my_cxt_t *my_cxtp = (my_cxt_t *)PL_my_cxt_list[MY_CXT_INDEX] -# define dMY_CXT_INTERP(my_perl) \ - my_cxt_t *my_cxtp = (my_cxt_t *)(my_perl)->Imy_cxt_list[MY_CXT_INDEX] +/* Creates and zeroes the per-interpreter data. (We allocate my_cxtp in a Perl + * SV so that it will be released when the interpreter goes away.) */ +# define MY_CXT_INIT \ + my_cxt_t *my_cxtp = \ + (my_cxt_t*)Perl_my_cxt_init(aTHX_ MY_CXT_INIT_ARG, sizeof(my_cxt_t)); \ + PERL_UNUSED_VAR(my_cxtp) +# define MY_CXT_INIT_INTERP(my_perl) \ + my_cxt_t *my_cxtp = \ + (my_cxt_t*)Perl_my_cxt_init(my_perl, MY_CXT_INIT_ARG, sizeof(my_cxt_t)); \ + PERL_UNUSED_VAR(my_cxtp) + +/* This declaration should be used within all functions + * that use the interpreter-local data. */ +# define dMY_CXT \ + my_cxt_t *my_cxtp = (my_cxt_t *)PL_my_cxt_list[MY_CXT_INDEX] +# define dMY_CXT_INTERP(my_perl) \ + my_cxt_t *my_cxtp = (my_cxt_t *)(my_perl)->Imy_cxt_list[MY_CXT_INDEX] /* Clones the per-interpreter data. */ -# define MY_CXT_CLONE \ - my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ - void * old_my_cxtp = PL_my_cxt_list[MY_CXT_INDEX]; \ - PL_my_cxt_list[MY_CXT_INDEX] = my_cxtp; \ - Copy(old_my_cxtp, my_cxtp, 1, my_cxt_t); +# define MY_CXT_CLONE \ + my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1)); \ + void * old_my_cxtp = PL_my_cxt_list[MY_CXT_INDEX]; \ + PL_my_cxt_list[MY_CXT_INDEX] = my_cxtp; \ + Copy(old_my_cxtp, my_cxtp, 1, my_cxt_t); -/* This macro must be used to access members of the my_cxt_t structure. - * e.g. MY_CXT.some_data */ -# define MY_CXT (*my_cxtp) +/* This macro must be used to access members of the + * my_cxt_t structure. e.g. MY_CXT.some_data */ +# define MY_CXT (*my_cxtp) -/* Judicious use of these macros can reduce the number of times dMY_CXT - * is used. Use is similar to pTHX, aTHX etc. */ -# define pMY_CXT my_cxt_t *my_cxtp -# define pMY_CXT_ pMY_CXT, -# define _pMY_CXT ,pMY_CXT -# define aMY_CXT my_cxtp -# define aMY_CXT_ aMY_CXT, -# define _aMY_CXT ,aMY_CXT +/* Judicious use of these macros can reduce the number of times + * dMY_CXT is used. Use is similar to pTHX, aTHX etc. */ +# define pMY_CXT my_cxt_t *my_cxtp +# define pMY_CXT_ pMY_CXT, +# define _pMY_CXT ,pMY_CXT +# define aMY_CXT my_cxtp +# define aMY_CXT_ aMY_CXT, +# define _aMY_CXT ,aMY_CXT #else /* MULTIPLICITY */ -# define START_MY_CXT static my_cxt_t my_cxt; -# define dMY_CXT dNOOP +# define START_MY_CXT static my_cxt_t my_cxt; +# define dMY_CXT dNOOP # define dMY_CXT_INTERP(my_perl) dNOOP -# define MY_CXT_INIT NOOP -# define MY_CXT_CLONE NOOP -# define MY_CXT my_cxt +# define MY_CXT_INIT NOOP +# define MY_CXT_CLONE NOOP +# define MY_CXT my_cxt -# define pMY_CXT void +# define pMY_CXT void # define pMY_CXT_ # define _pMY_CXT # define aMY_CXT @@ -8065,54 +8035,53 @@ EXTERN_C int flock(int fd, int op); #ifndef O_RDONLY /* Assume UNIX defaults */ -# define O_RDONLY 0000 -# define O_WRONLY 0001 -# define O_RDWR 0002 -# define O_CREAT 0100 +# define O_RDONLY 0000 +# define O_WRONLY 0001 +# define O_RDWR 0002 +# define O_CREAT 0100 #endif #ifndef O_BINARY -# define O_BINARY 0 +# define O_BINARY 0 #endif #ifndef O_TEXT -# define O_TEXT 0 +# define O_TEXT 0 #endif #if O_TEXT != O_BINARY - /* If you have different O_TEXT and O_BINARY and you are a CRLF shop, - * that is, you are somehow DOSish. */ + /* If you have different O_TEXT and O_BINARY and you are + * a CRLF shop, that is, you are somehow DOSish. */ # if defined(__HAIKU__) || defined(__VOS__) || defined(__CYGWIN__) /* Haiku has O_TEXT != O_BINARY but O_TEXT and O_BINARY have no effect; * Haiku is always UNIXoid (LF), not DOSish (CRLF). */ /* VOS has O_TEXT != O_BINARY, and they have effect, * but VOS always uses LF, never CRLF. */ - /* If you have O_TEXT different from your O_BINARY but you still are - * not a CRLF shop. */ + /* If you have O_TEXT different from your O_BINARY + * but you still are not a CRLF shop. */ # undef PERLIO_USING_CRLF # else /* If you really are DOSish. */ -# define PERLIO_USING_CRLF 1 +# define PERLIO_USING_CRLF 1 # endif #endif #ifdef I_LIBUTIL -# include /* setproctitle() in some FreeBSDs */ +# include /* setproctitle() in some FreeBSDs */ #endif #ifndef EXEC_ARGV_CAST -#define EXEC_ARGV_CAST(x) (char **)x +#define EXEC_ARGV_CAST(x) (char **)x #endif -#define IS_NUMBER_IN_UV 0x01 /* number within UV range (maybe not - int). value returned in pointed- - to UV */ +#define IS_NUMBER_IN_UV 0x01 /* number within UV range (maybe not int). + value returned in pointed- to UV */ #define IS_NUMBER_GREATER_THAN_UV_MAX 0x02 /* pointed to UV undefined */ -#define IS_NUMBER_NOT_INT 0x04 /* saw . or E notation or infnan */ -#define IS_NUMBER_NEG 0x08 /* leading minus sign */ -#define IS_NUMBER_INFINITY 0x10 /* this is big */ -#define IS_NUMBER_NAN 0x20 /* this is not */ -#define IS_NUMBER_TRAILING 0x40 /* number has trailing trash */ +#define IS_NUMBER_NOT_INT 0x04 /* saw . or E notation or infnan */ +#define IS_NUMBER_NEG 0x08 /* leading minus sign */ +#define IS_NUMBER_INFINITY 0x10 /* this is big */ +#define IS_NUMBER_NAN 0x20 /* this is not */ +#define IS_NUMBER_TRAILING 0x40 /* number has trailing trash */ /* =for apidoc_section $numeric @@ -8123,36 +8092,39 @@ A synonym for L =cut */ -#define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send) +#define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send) -/* Number scan flags. All are used for input, the ones used for output are so - * marked */ -#define PERL_SCAN_ALLOW_UNDERSCORES 0x01 /* grok_??? accept _ in numbers */ -#define PERL_SCAN_DISALLOW_PREFIX 0x02 /* grok_??? reject 0x in hex etc */ +/* Number scan flags. All are used for input, + * the ones used for output are so marked */ +#define PERL_SCAN_ALLOW_UNDERSCORES 0x01 /* grok_??? accept _ + in numbers */ +#define PERL_SCAN_DISALLOW_PREFIX 0x02 /* grok_??? reject 0x + in hex etc */ /* grok_??? input: ignored; output: found overflow */ -#define PERL_SCAN_GREATER_THAN_UV_MAX 0x04 +#define PERL_SCAN_GREATER_THAN_UV_MAX 0x04 -/* grok_??? don't warn about illegal digits. To preserve total backcompat, - * this isn't set on output if one is found. Instead, see - * PERL_SCAN_NOTIFY_ILLDIGIT. */ -#define PERL_SCAN_SILENT_ILLDIGIT 0x08 +/* grok_??? don't warn about illegal digits. To preserve + * total backcompat, this isn't set on output if one is + * found. Instead, see PERL_SCAN_NOTIFY_ILLDIGIT. */ +#define PERL_SCAN_SILENT_ILLDIGIT 0x08 -#define PERL_SCAN_TRAILING 0x10 /* grok_number_flags() allow trailing - and set IS_NUMBER_TRAILING */ +#define PERL_SCAN_TRAILING 0x10 /* grok_number_flags() allow + trailing and set + IS_NUMBER_TRAILING */ /* These are considered experimental, so not exposed publicly */ #if defined(PERL_CORE) || defined(PERL_EXT) -/* grok_??? don't warn about very large numbers which are <= UV_MAX; - * output: found such a number */ +/* grok_??? don't warn about very large numbers which + * are <= UV_MAX; output: found such a number */ # define PERL_SCAN_SILENT_NON_PORTABLE 0x20 -/* If this is set on input, and no illegal digit is found, it will be cleared - * on output; otherwise unchanged */ -# define PERL_SCAN_NOTIFY_ILLDIGIT 0x40 +/* If this is set on input, and no illegal digit is found, + * it will be cleared on output; otherwise unchanged */ +# define PERL_SCAN_NOTIFY_ILLDIGIT 0x40 /* Don't warn on overflow; output flag still set */ -# define PERL_SCAN_SILENT_OVERFLOW 0x80 +# define PERL_SCAN_SILENT_OVERFLOW 0x80 /* Forbid a leading underscore, which the other one doesn't */ # define PERL_SCAN_ALLOW_MEDIAL_UNDERSCORES (0x100|PERL_SCAN_ALLOW_UNDERSCORES) @@ -8162,111 +8134,110 @@ A synonym for L /* to let user control profiling */ #ifdef PERL_GPROF_CONTROL extern void moncontrol(int); -#define PERL_GPROF_MONCONTROL(x) moncontrol(x) +#define PERL_GPROF_MONCONTROL(x) moncontrol(x) #else #define PERL_GPROF_MONCONTROL(x) #endif /* ISO 6429 NEL - C1 control NExt Line */ /* See https://www.unicode.org/unicode/reports/tr13/ */ -#define NEXT_LINE_CHAR NEXT_LINE_NATIVE +#define NEXT_LINE_CHAR NEXT_LINE_NATIVE #ifndef PIPESOCK_MODE # define PIPESOCK_MODE #endif #ifndef SOCKET_OPEN_MODE -# define SOCKET_OPEN_MODE PIPESOCK_MODE +# define SOCKET_OPEN_MODE PIPESOCK_MODE #endif #ifndef PIPE_OPEN_MODE -# define PIPE_OPEN_MODE PIPESOCK_MODE +# define PIPE_OPEN_MODE PIPESOCK_MODE #endif -#define PERL_MAGIC_UTF8_CACHESIZE 2 +#define PERL_MAGIC_UTF8_CACHESIZE 2 #ifdef PERL_CORE -#define PERL_UNICODE_STDIN_FLAG 0x0001 -#define PERL_UNICODE_STDOUT_FLAG 0x0002 -#define PERL_UNICODE_STDERR_FLAG 0x0004 -#define PERL_UNICODE_IN_FLAG 0x0008 -#define PERL_UNICODE_OUT_FLAG 0x0010 -#define PERL_UNICODE_ARGV_FLAG 0x0020 -#define PERL_UNICODE_LOCALE_FLAG 0x0040 -#define PERL_UNICODE_WIDESYSCALLS_FLAG 0x0080 /* for Sarathy */ -#define PERL_UNICODE_UTF8CACHEASSERT_FLAG 0x0100 - -#define PERL_UNICODE_STD_FLAG \ - (PERL_UNICODE_STDIN_FLAG | \ - PERL_UNICODE_STDOUT_FLAG | \ - PERL_UNICODE_STDERR_FLAG) - -#define PERL_UNICODE_INOUT_FLAG \ - (PERL_UNICODE_IN_FLAG | \ - PERL_UNICODE_OUT_FLAG) - -#define PERL_UNICODE_DEFAULT_FLAGS \ - (PERL_UNICODE_STD_FLAG | \ - PERL_UNICODE_INOUT_FLAG | \ - PERL_UNICODE_LOCALE_FLAG) - -#define PERL_UNICODE_ALL_FLAGS 0x01ff - -#define PERL_UNICODE_STDIN 'I' -#define PERL_UNICODE_STDOUT 'O' -#define PERL_UNICODE_STDERR 'E' -#define PERL_UNICODE_STD 'S' -#define PERL_UNICODE_IN 'i' -#define PERL_UNICODE_OUT 'o' -#define PERL_UNICODE_INOUT 'D' -#define PERL_UNICODE_ARGV 'A' -#define PERL_UNICODE_LOCALE 'L' -#define PERL_UNICODE_WIDESYSCALLS 'W' -#define PERL_UNICODE_UTF8CACHEASSERT 'a' +#define PERL_UNICODE_STDIN_FLAG 0x0001 +#define PERL_UNICODE_STDOUT_FLAG 0x0002 +#define PERL_UNICODE_STDERR_FLAG 0x0004 +#define PERL_UNICODE_IN_FLAG 0x0008 +#define PERL_UNICODE_OUT_FLAG 0x0010 +#define PERL_UNICODE_ARGV_FLAG 0x0020 +#define PERL_UNICODE_LOCALE_FLAG 0x0040 +#define PERL_UNICODE_WIDESYSCALLS_FLAG 0x0080 /* for Sarathy */ +#define PERL_UNICODE_UTF8CACHEASSERT_FLAG 0x0100 + +#define PERL_UNICODE_STD_FLAG \ + (PERL_UNICODE_STDIN_FLAG | \ + PERL_UNICODE_STDOUT_FLAG | \ + PERL_UNICODE_STDERR_FLAG) + +#define PERL_UNICODE_INOUT_FLAG \ + (PERL_UNICODE_IN_FLAG | PERL_UNICODE_OUT_FLAG) + +#define PERL_UNICODE_DEFAULT_FLAGS \ + (PERL_UNICODE_STD_FLAG | \ + PERL_UNICODE_INOUT_FLAG | \ + PERL_UNICODE_LOCALE_FLAG) + +#define PERL_UNICODE_ALL_FLAGS 0x01ff + +#define PERL_UNICODE_STDIN 'I' +#define PERL_UNICODE_STDOUT 'O' +#define PERL_UNICODE_STDERR 'E' +#define PERL_UNICODE_STD 'S' +#define PERL_UNICODE_IN 'i' +#define PERL_UNICODE_OUT 'o' +#define PERL_UNICODE_INOUT 'D' +#define PERL_UNICODE_ARGV 'A' +#define PERL_UNICODE_LOCALE 'L' +#define PERL_UNICODE_WIDESYSCALLS 'W' +#define PERL_UNICODE_UTF8CACHEASSERT 'a' #endif /* =for apidoc_section $signals =for apidoc Amn|U32|PERL_SIGNALS_UNSAFE_FLAG -If this bit in C is set, the system is uing the pre-Perl 5.8 -unsafe signals. See L and L. +If this bit in C is set, the system is uing the +pre-Perl 5.8 unsafe signals. See L +and L. =cut */ -#define PERL_SIGNALS_UNSAFE_FLAG 0x0001 +#define PERL_SIGNALS_UNSAFE_FLAG 0x0001 /* =for apidoc_section $numeric =for apidoc Am|int|PERL_ABS|int x -Typeless C or C, I. (The usage below indicates it is for -integers, but it works for any type.) Use instead of these, since the C -library ones force their argument to be what it is expecting, potentially -leading to disaster. But also beware that this evaluates its argument twice, -so no C. +Typeless C or C, I. (The usage below indicates +it is for integers, but it works for any type.) Use instead of +these, since the C library ones force their argument to be what +it is expecting, potentially leading to disaster. But also +beware that this evaluates its argument twice, so no C. =cut */ -#define PERL_ABS(x) ((x) < 0 ? -(x) : (x)) +#define PERL_ABS(x) ((x) < 0 ? -(x) : (x)) #if defined(__DECC) && defined(__osf__) #pragma message disable (mainparm) /* Perl uses the envp in main(). */ #endif #define do_open(g, n, l, a, rm, rp, sf) \ - do_openn(g, n, l, a, rm, rp, sf, (SV **) NULL, 0) + do_openn(g, n, l, a, rm, rp, sf, (SV **) NULL, 0) #ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION -# define do_exec(cmd) do_exec3(cmd,0,0) +# define do_exec(cmd) do_exec3(cmd,0,0) #endif #ifdef OS2 -# define do_aexec Perl_do_aexec +# define do_aexec Perl_do_aexec #else -# define do_aexec(really, mark,sp) do_aexec5(really, mark, sp, 0, 0) +# define do_aexec(really, mark,sp) do_aexec5(really, mark, sp, 0, 0) #endif @@ -8281,23 +8252,24 @@ Same as L. Allows one ending \0 */ -#define IS_SAFE_SYSCALL(p, len, what, op_name) (Perl_is_safe_syscall(aTHX_ (p), (len), (what), (op_name))) +#define IS_SAFE_SYSCALL(p, len, what, op_name) \ + (Perl_is_safe_syscall(aTHX_ (p), (len), (what), (op_name))) -#define IS_SAFE_PATHNAME(p, len, op_name) IS_SAFE_SYSCALL((p), (len), "pathname", (op_name)) +#define IS_SAFE_PATHNAME(p, len, op_name) \ + IS_SAFE_SYSCALL((p), (len), "pathname", (op_name)) #if defined(OEMVS) || defined(__amigaos4__) #define NO_ENV_ARRAY_IN_MAIN #endif -/* These are used by Perl_pv_escape() and Perl_pv_pretty() - * are here so that they are available throughout the core - * NOTE that even though some are for _escape and some for _pretty - * there must not be any clashes as the flags from _pretty are - * passed straight through to _escape. +/* These are used by Perl_pv_escape() and Perl_pv_pretty() are here so + * that they are available throughout the core NOTE that even though some + * are for _escape and some for _pretty there must not be any clashes as + * the flags from _pretty are passed straight through to _escape. */ -#define PERL_PV_ESCAPE_QUOTE 0x000001 -#define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE +#define PERL_PV_ESCAPE_QUOTE 0x000001 +#define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE #define PERL_PV_PRETTY_ELLIPSES 0x000002 #define PERL_PV_PRETTY_LTGT 0x000004 @@ -8311,20 +8283,21 @@ Allows one ending \0 #define PERL_PV_ESCAPE_ALL 0x001000 #define PERL_PV_ESCAPE_NOBACKSLASH 0x002000 #define PERL_PV_ESCAPE_NOCLEAR 0x004000 -#define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR -#define PERL_PV_ESCAPE_RE 0x008000 +#define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR +#define PERL_PV_ESCAPE_RE 0x008000 /* Escape PV with hex, except leave NULs as octal: */ -#define PERL_PV_ESCAPE_DWIM 0x010000 +#define PERL_PV_ESCAPE_DWIM 0x010000 /* Escape PV with all hex, including NUL. */ -#define PERL_PV_ESCAPE_DWIM_ALL_HEX 0x020000 +#define PERL_PV_ESCAPE_DWIM_ALL_HEX 0x020000 /* Do not escape word characters, alters meaning of other flags */ -#define PERL_PV_ESCAPE_NON_WC 0x040000 -#define PERL_PV_ESCAPE_TRUNC_MIDDLE 0x080000 +#define PERL_PV_ESCAPE_NON_WC 0x040000 +#define PERL_PV_ESCAPE_TRUNC_MIDDLE 0x080000 -#define PERL_PV_PRETTY_QUOTEDPREFIX ( \ +#define PERL_PV_PRETTY_QUOTEDPREFIX \ + ( \ PERL_PV_PRETTY_ELLIPSES | \ PERL_PV_PRETTY_QUOTE | \ PERL_PV_ESCAPE_NONASCII | \ @@ -8333,91 +8306,83 @@ Allows one ending \0 0) -/* used by pv_display in dump.c*/ -#define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE -#define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE|PERL_PV_ESCAPE_NONASCII +/* used by pv_display in dump.c */ +#define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE +#define PERL_PV_PRETTY_REGPROP \ + PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE|PERL_PV_ESCAPE_NONASCII -#if DOUBLEKIND == DOUBLE_IS_VAX_F_FLOAT || \ - DOUBLEKIND == DOUBLE_IS_VAX_D_FLOAT || \ +#if DOUBLEKIND == DOUBLE_IS_VAX_F_FLOAT || \ + DOUBLEKIND == DOUBLE_IS_VAX_D_FLOAT || \ DOUBLEKIND == DOUBLE_IS_VAX_G_FLOAT # define DOUBLE_IS_VAX_FLOAT #else # define DOUBLE_IS_IEEE_FORMAT #endif -#if DOUBLEKIND == DOUBLE_IS_IEEE_754_32_BIT_LITTLE_ENDIAN || \ - DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_LITTLE_ENDIAN || \ +#if DOUBLEKIND == DOUBLE_IS_IEEE_754_32_BIT_LITTLE_ENDIAN || \ + DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_LITTLE_ENDIAN || \ DOUBLEKIND == DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN # define DOUBLE_LITTLE_ENDIAN #endif -#if DOUBLEKIND == DOUBLE_IS_IEEE_754_32_BIT_BIG_ENDIAN || \ - DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_BIG_ENDIAN || \ +#if DOUBLEKIND == DOUBLE_IS_IEEE_754_32_BIT_BIG_ENDIAN || \ + DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_BIG_ENDIAN || \ DOUBLEKIND == DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN # define DOUBLE_BIG_ENDIAN #endif -#if DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_LE_BE || \ +#if DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_LE_BE || \ DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_BE_LE # define DOUBLE_MIX_ENDIAN #endif -/* The VAX fp formats are neither consistently little-endian nor - * big-endian, and neither are they really IEEE-mixed endian like - * the mixed-endian ARM IEEE formats (with swapped bytes). - * Ultimately, the VAX format came from the PDP-11. +/* The VAX fp formats are neither consistently little-endian nor big-endian, + * and neither are they really IEEE-mixed endian like the mixed-endian ARM IEEE + * formats (with swapped bytes). Ultimately, the VAX format came from the + * PDP-11. * - * The ordering of the parts in VAX floats is quite vexing. - * In the below the fraction_n are the mantissa bits. + * The ordering of the parts in VAX floats is quite vexing. In the below the + * fraction_n are the mantissa bits. * - * The fraction_1 is the most significant (numbering as by DEC/Digital), - * while the rightmost bit in each fraction is the least significant: - * in other words, big-endian bit order within the fractions. + * The fraction_1 is the most significant (numbering as by DEC/Digital), while + * the rightmost bit in each fraction is the least significant: in other words, + * big-endian bit order within the fractions. * - * The fraction segments themselves would be big-endianly, except that - * within 32 bit segments the less significant half comes first, the more - * significant after, except that in the format H (used for long doubles) - * the first fraction segment is alone, because the exponent is wider. - * This means for example that both the most and the least significant - * bits can be in the middle of the floats, not at either end. + * The fraction segments themselves would be big-endianly, except that within + * 32 bit segments the less significant half comes first, the more significant + * after, except that in the format H (used for long doubles) the first + * fraction segment is alone, because the exponent is wider. This means for + * example that both the most and the least significant bits can be in the + * middle of the floats, not at either end. * * References: * http://nssdc.gsfc.nasa.gov/nssdc/formats/VAXFloatingPoint.htm * http://www.quadibloc.com/comp/cp0201.htm - * http://h71000.www7.hp.com/doc/82final/6443/6443pro_028.html - * (somebody at HP should be fired for the URLs) + * http://h71000.www7.hp.com/doc/82final/6443/6443pro_028.html (somebody at + * HP should be fired for the URLs) * - * F fraction_2:16 sign:1 exp:8 fraction_1:7 - * (exponent bias 128, hidden first one-bit) + * F fraction_2:16 sign:1 exp:8 fraction_1:7 (exponent bias 128, hidden first + * one-bit) * - * D fraction_2:16 sign:1 exp:8 fraction_1:7 - * fraction_4:16 fraction_3:16 - * (exponent bias 128, hidden first one-bit) + * D fraction_2:16 sign:1 exp:8 fraction_1:7 fraction_4:16 fraction_3:16 + * (exponent bias 128, hidden first one-bit) * - * G fraction_2:16 sign:1 exp:11 fraction_1:4 - * fraction_4:16 fraction_3:16 - * (exponent bias 1024, hidden first one-bit) + * G fraction_2:16 sign:1 exp:11 fraction_1:4 fraction_4:16 fraction_3:16 + * (exponent bias 1024, hidden first one-bit) * - * H fraction_1:16 sign:1 exp:15 - * fraction_3:16 fraction_2:16 - * fraction_5:16 fraction_4:16 - * fraction_7:16 fraction_6:16 - * (exponent bias 16384, hidden first one-bit) - * (available only on VAX, and only on Fortran?) + * H fraction_1:16 sign:1 exp:15 fraction_3:16 fraction_2:16 fraction_5:16 + * fraction_4:16 fraction_7:16 fraction_6:16 (exponent bias 16384, hidden first + * one-bit) (available only on VAX, and only on Fortran?) * - * The formats S, T and X are available on the Alpha (and Itanium, - * also known as I64/IA64) and are equivalent with the IEEE-754 formats - * binary32, binary64, and binary128 (commonly: float, double, long double). + * The formats S, T and X are available on the Alpha (and Itanium, also known + * as I64/IA64) and are equivalent with the IEEE-754 formats binary32, + * binary64, and binary128 (commonly: float, double, long double). * - * S sign:1 exp:8 mantissa:23 - * (exponent bias 127, hidden first one-bit) + * S sign:1 exp:8 mantissa:23 (exponent bias 127, hidden first one-bit) * - * T sign:1 exp:11 mantissa:52 - * (exponent bias 1022, hidden first one-bit) - * - * X sign:1 exp:15 mantissa:112 - * (exponent bias 16382, hidden first one-bit) + * T sign:1 exp:11 mantissa:52 (exponent bias 1022, hidden first one-bit) * + * X sign:1 exp:15 mantissa:112 (exponent bias 16382, hidden first one-bit) */ #ifdef DOUBLE_IS_VAX_FLOAT @@ -8425,34 +8390,34 @@ Allows one ending \0 #endif #ifdef DOUBLE_IS_IEEE_FORMAT -/* All the basic IEEE formats have the implicit bit, - * except for the x86 80-bit extended formats, which will undef this. - * Also note that the IEEE 754 subnormals (formerly known as denormals) - * do not have the implicit bit of one. */ +/* All the basic IEEE formats have the implicit bit, except for + * the x86 80-bit extended formats, which will undef this. + * Also note that the IEEE 754 subnormals (formerly known as + * denormals) do not have the implicit bit of one. */ # define NV_IMPLICIT_BIT #endif #if defined(LONG_DOUBLEKIND) && LONG_DOUBLEKIND != LONG_DOUBLE_IS_DOUBLE -# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN || \ - LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN || \ - LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_LE +# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN || \ + LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN || \ + LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_LE # define LONGDOUBLE_LITTLE_ENDIAN # endif -# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN || \ - LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN || \ - LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE +# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN || \ + LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN || \ + LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE # define LONGDOUBLE_BIG_ENDIAN # endif -# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_BE || \ - LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_LE +# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_BE || \ + LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_LE # define LONGDOUBLE_MIX_ENDIAN # endif # if LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN || \ - LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN + LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN # define LONGDOUBLE_X86_80_BIT # ifdef USE_LONG_DOUBLE # undef NV_IMPLICIT_BIT @@ -8460,10 +8425,10 @@ Allows one ending \0 # endif # endif -# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_LE || \ - LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE || \ - LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_BE || \ - LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_LE +# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_LE || \ + LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE || \ + LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_BE || \ + LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_LE # define LONGDOUBLE_DOUBLEDOUBLE # endif @@ -8473,7 +8438,8 @@ Allows one ending \0 #endif /* LONG_DOUBLEKIND */ -#ifdef USE_QUADMATH /* assume quadmath endianness == native double endianness */ +#ifdef USE_QUADMATH /* assume quadmath endianness == + native double endianness */ # if defined(DOUBLE_LITTLE_ENDIAN) # define NV_LITTLE_ENDIAN # elif defined(DOUBLE_BIG_ENDIAN) @@ -8509,22 +8475,22 @@ Allows one ending \0 # endif #endif -/* We have somehow managed not to define the denormal/subnormal - * detection. +/* We have somehow managed not to define the denormal/subnormal detection. * - * This may happen if the compiler doesn't expose the C99 math like - * the fpclassify() without some special switches. Perl tries to - * stay C89, so for example -std=c99 is not an option. + * This may happen if the compiler doesn't expose the C99 math like the + * fpclassify() without some special switches. Perl tries to stay C89, so + * for example -std=c99 is not an option. * - * The Perl_isinf() and Perl_isnan() should have been defined even if - * the C99 isinf() and isnan() are unavailable, and the NV_MIN becomes - * from the C89 DBL_MIN or moral equivalent. */ + * The Perl_isinf() and Perl_isnan() should have been defined even if the + * C99 isinf() and isnan() are unavailable, and the NV_MIN becomes from the + * C89 DBL_MIN or moral equivalent. */ #if !defined(Perl_fp_class_denorm) && defined(Perl_isinf) && defined(Perl_isnan) && defined(NV_MIN) -# define Perl_fp_class_denorm(x) ((x) != 0.0 && !Perl_isinf(x) && !Perl_isnan(x) && PERL_ABS(x) < NV_MIN) +# define Perl_fp_class_denorm(x) \ + ((x) != 0.0 && !Perl_isinf(x) && !Perl_isnan(x) && PERL_ABS(x) < NV_MIN) #endif -/* This is not a great fallback: subnormals tests will fail, - * but at least Perl will link and 99.999% of tests will work. */ +/* This is not a great fallback: subnormals tests will fail, but + * at least Perl will link and 99.999% of tests will work. */ #if !defined(Perl_fp_class_denorm) # define Perl_fp_class_denorm(x) FALSE #endif @@ -8542,24 +8508,24 @@ START_EXTERN_C /* PL_inf and PL_nan initialization. * - * For inf and nan initialization the ultimate fallback is dividing - * one or zero by zero: however, some compilers will warn or even fail - * on divide-by-zero, but hopefully something earlier will work. + * For inf and nan initialization the ultimate fallback is dividing one or + * zero by zero: however, some compilers will warn or even fail on + * divide-by-zero, but hopefully something earlier will work. * - * If you are thinking of using HUGE_VAL for infinity, or using - * functions to generate NV_INF (e.g. exp(1e9), log(-1.0)), - * stop. Neither will work portably: HUGE_VAL can be just DBL_MAX, - * and the math functions might be just generating DBL_MAX, or even zero. + * If you are thinking of using HUGE_VAL for infinity, or using + * functions to generate NV_INF (e.g. exp(1e9), log(-1.0)), stop. Neither + * will work portably: HUGE_VAL can be just DBL_MAX, and the math functions + * might be just generating DBL_MAX, or even zero. * * Also, do NOT try doing NV_NAN based on NV_INF and trying (NV_INF-NV_INF). - * Though logically correct, some compilers (like Visual C 2003) - * falsely misoptimize that to zero (x-x is always zero, right?) + * Though logically correct, some compilers (like Visual C 2003) falsely + * misoptimize that to zero (x-x is always zero, right?) * * Finally, note that not all floating point formats define Inf (or NaN). * For the infinity a large number may be used instead. Operations that - * under the IEEE floating point would return Inf or NaN may return - * either large numbers (positive or negative), or they may cause - * a floating point exception or some other fault. + * under the IEEE floating point would return Inf or NaN may return either + * large numbers (positive or negative), or they may cause a floating point + * exception or some other fault. */ /* The quadmath literals are anon structs which -Wc++-compat doesn't like. */ @@ -8568,8 +8534,7 @@ GCC_DIAG_IGNORE_DECL(-Wc++-compat); # endif # ifdef USE_QUADMATH -/* Cannot use HUGE_VALQ for PL_inf because not a compile-time - * constant. */ +/* Cannot use HUGE_VALQ for PL_inf because not a compile-time constant. */ INFNAN_NV_U8_DECL PL_inf = { 1.0Q/0.0Q }; # elif NVSIZE == LONG_DOUBLESIZE && defined(LONGDBLINFBYTES) INFNAN_U8_NV_DECL PL_inf = { { LONGDBLINFBYTES } }; @@ -8604,8 +8569,7 @@ INFNAN_NV_U8_DECL PL_inf = { 1.0/0.0 }; /* keep last */ # endif # ifdef USE_QUADMATH -/* Cannot use nanq("0") for PL_nan because not a compile-time - * constant. */ +/* Cannot use nanq("0") for PL_nan because not a compile-time constant. */ INFNAN_NV_U8_DECL PL_nan = { 0.0Q/0.0Q }; # elif NVSIZE == LONG_DOUBLESIZE && defined(LONGDBLNANBYTES) INFNAN_U8_NV_DECL PL_nan = { { LONGDBLNANBYTES } }; @@ -8641,21 +8605,21 @@ GCC_DIAG_RESTORE_DECL; #else -/* The declarations here need to match the initializations done above, - since a mismatch across compilation units causes undefined +/* The declarations here need to match the initializations done + above, since a mismatch across compilation units causes undefined behavior. It also prevents warnings from LTO builds. -*/ -# if !defined(USE_QUADMATH) && \ - (NVSIZE == LONG_DOUBLESIZE && defined(LONGDBLINFBYTES) || \ - NVSIZE == DOUBLESIZE && defined(DOUBLEINFBYTES)) + */ +# if !defined(USE_QUADMATH) && \ + (NVSIZE == LONG_DOUBLESIZE && defined(LONGDBLINFBYTES) || \ + NVSIZE == DOUBLESIZE && defined(DOUBLEINFBYTES)) INFNAN_U8_NV_DECL PL_inf; # else INFNAN_NV_U8_DECL PL_inf; # endif -# if !defined(USE_QUADMATH) && \ - (NVSIZE == LONG_DOUBLESIZE && defined(LONGDBLNANBYTES) || \ - NVSIZE == DOUBLESIZE && defined(DOUBLENANBYTES)) +# if !defined(USE_QUADMATH) && \ + (NVSIZE == LONG_DOUBLESIZE && defined(LONGDBLNANBYTES) || \ + NVSIZE == DOUBLESIZE && defined(DOUBLENANBYTES)) INFNAN_U8_NV_DECL PL_nan; # else INFNAN_NV_U8_DECL PL_nan; @@ -8665,16 +8629,16 @@ INFNAN_NV_U8_DECL PL_nan; END_EXTERN_C -/* If you have not defined NV_INF/NV_NAN (like for example win32/win32.h), - * we will define NV_INF/NV_NAN as the nv part of the global const - * PL_inf/PL_nan. Note, however, that the preexisting NV_INF/NV_NAN - * might not be a compile-time constant, in which case it cannot be - * used to initialize PL_inf/PL_nan above. */ +/* If you have not defined NV_INF/NV_NAN (like for example + * win32/win32.h), we will define NV_INF/NV_NAN as the nv part of the + * global const PL_inf/PL_nan. Note, however, that the preexisting + * NV_INF/NV_NAN might not be a compile-time constant, in which case it + * cannot be used to initialize PL_inf/PL_nan above. */ #ifndef NV_INF -# define NV_INF PL_inf.nv +# define NV_INF PL_inf.nv #endif #ifndef NV_NAN -# define NV_NAN PL_nan.nv +# define NV_NAN PL_nan.nv #endif /* NaNs (not-a-numbers) can carry payload bits, in addition to @@ -8779,254 +8743,254 @@ END_EXTERN_C * NVMANTBITS works for normal floats. */ /* We do not want to include the quiet/signaling bit. */ -#define NV_NAN_BITS (NVMANTBITS - 1) +#define NV_NAN_BITS (NVMANTBITS - 1) #if defined(USE_LONG_DOUBLE) && NVSIZE > DOUBLESIZE # if LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN -# define NV_NAN_QS_BYTE_OFFSET 13 +# define NV_NAN_QS_BYTE_OFFSET 13 # elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN -# define NV_NAN_QS_BYTE_OFFSET 2 +# define NV_NAN_QS_BYTE_OFFSET 2 # elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN -# define NV_NAN_QS_BYTE_OFFSET 7 +# define NV_NAN_QS_BYTE_OFFSET 7 # elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN -# define NV_NAN_QS_BYTE_OFFSET 2 +# define NV_NAN_QS_BYTE_OFFSET 2 # elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_LE -# define NV_NAN_QS_BYTE_OFFSET 13 +# define NV_NAN_QS_BYTE_OFFSET 13 # elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE -# define NV_NAN_QS_BYTE_OFFSET 1 +# define NV_NAN_QS_BYTE_OFFSET 1 # elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_BE -# define NV_NAN_QS_BYTE_OFFSET 9 +# define NV_NAN_QS_BYTE_OFFSET 9 # elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_LE -# define NV_NAN_QS_BYTE_OFFSET 6 +# define NV_NAN_QS_BYTE_OFFSET 6 # else # error "Unexpected long double format" # endif #else # ifdef USE_QUADMATH # ifdef NV_LITTLE_ENDIAN -# define NV_NAN_QS_BYTE_OFFSET 13 +# define NV_NAN_QS_BYTE_OFFSET 13 # elif defined(NV_BIG_ENDIAN) -# define NV_NAN_QS_BYTE_OFFSET 2 +# define NV_NAN_QS_BYTE_OFFSET 2 # else # error "Unexpected quadmath format" # endif # elif DOUBLEKIND == DOUBLE_IS_IEEE_754_32_BIT_LITTLE_ENDIAN -# define NV_NAN_QS_BYTE_OFFSET 2 +# define NV_NAN_QS_BYTE_OFFSET 2 # elif DOUBLEKIND == DOUBLE_IS_IEEE_754_32_BIT_BIG_ENDIAN -# define NV_NAN_QS_BYTE_OFFSET 1 +# define NV_NAN_QS_BYTE_OFFSET 1 # elif DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_LITTLE_ENDIAN -# define NV_NAN_QS_BYTE_OFFSET 6 +# define NV_NAN_QS_BYTE_OFFSET 6 # elif DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_BIG_ENDIAN -# define NV_NAN_QS_BYTE_OFFSET 1 +# define NV_NAN_QS_BYTE_OFFSET 1 # elif DOUBLEKIND == DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN -# define NV_NAN_QS_BYTE_OFFSET 13 +# define NV_NAN_QS_BYTE_OFFSET 13 # elif DOUBLEKIND == DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN -# define NV_NAN_QS_BYTE_OFFSET 2 +# define NV_NAN_QS_BYTE_OFFSET 2 # elif DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_LE_BE -# define NV_NAN_QS_BYTE_OFFSET 2 /* bytes 4 5 6 7 0 1 2 3 (MSB 7) */ +# define NV_NAN_QS_BYTE_OFFSET 2 /* bytes 4 5 6 7 0 1 2 3 (MSB 7) */ # elif DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_BE_LE -# define NV_NAN_QS_BYTE_OFFSET 5 /* bytes 3 2 1 0 7 6 5 4 (MSB 7) */ +# define NV_NAN_QS_BYTE_OFFSET 5 /* bytes 3 2 1 0 7 6 5 4 (MSB 7) */ # else -/* For example the VAX formats should never - * get here because they do not have NaN. */ +/* For example the VAX formats should never get + * here because they do not have NaN. */ # error "Unexpected double format" # endif #endif /* NV_NAN_QS_BYTE is the byte to test for the quiet/signaling */ -#define NV_NAN_QS_BYTE(nvp) (((U8*)(nvp))[NV_NAN_QS_BYTE_OFFSET]) +#define NV_NAN_QS_BYTE(nvp) (((U8*)(nvp))[NV_NAN_QS_BYTE_OFFSET]) /* NV_NAN_QS_BIT is the bit to test in the NV_NAN_QS_BYTE_OFFSET * for the quiet/signaling */ -#if defined(USE_LONG_DOUBLE) && \ - (LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN || \ - LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN) -# define NV_NAN_QS_BIT_SHIFT 6 /* 0x40 */ -#elif defined(USE_LONG_DOUBLE) && \ - (LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_LE || \ - LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE || \ - LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_BE || \ - LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_LE) -# define NV_NAN_QS_BIT_SHIFT 3 /* 0x08, but not via NV_NAN_BITS */ +#if defined(USE_LONG_DOUBLE) && \ + (LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN || \ + LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN) +# define NV_NAN_QS_BIT_SHIFT 6 /* 0x40 */ +#elif defined(USE_LONG_DOUBLE) && \ + (LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_LE || \ + LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE || \ + LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_BE || \ + LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_LE) +# define NV_NAN_QS_BIT_SHIFT 3 /* 0x08, but not via NV_NAN_BITS */ #else -# define NV_NAN_QS_BIT_SHIFT ((NV_NAN_BITS) % 8) /* usually 3, or 0x08 */ +# define NV_NAN_QS_BIT_SHIFT ((NV_NAN_BITS) % 8) /* usually 3, or + 0x08 */ #endif -#define NV_NAN_QS_BIT (1 << (NV_NAN_QS_BIT_SHIFT)) -/* NV_NAN_QS_BIT_OFFSET is the bit offset from the beginning of a NV - * (bytes ordered big-endianly) for the quiet/signaling bit - * for the quiet/signaling */ -#define NV_NAN_QS_BIT_OFFSET \ +#define NV_NAN_QS_BIT (1 << (NV_NAN_QS_BIT_SHIFT)) +/* NV_NAN_QS_BIT_OFFSET is the bit offset from the beginning of a NV (bytes + * ordered big-endianly) for the quiet/signaling bit for the quiet/signaling */ +#define NV_NAN_QS_BIT_OFFSET \ (8 * (NV_NAN_QS_BYTE_OFFSET) + (NV_NAN_QS_BIT_SHIFT)) /* NV_NAN_QS_QUIET (always defined) is true if the NV_NAN_QS_QS_BIT being - * on indicates quiet NaN. NV_NAN_QS_SIGNALING (also always defined) - * is true if the NV_NAN_QS_BIT being on indicates signaling NaN. */ + * on indicates quiet NaN. NV_NAN_QS_SIGNALING (also always defined) is + * true if the NV_NAN_QS_BIT being on indicates signaling NaN. */ #define NV_NAN_QS_QUIET \ ((NV_NAN_QS_BYTE(PL_nan.u8) & NV_NAN_QS_BIT) == NV_NAN_QS_BIT) -#define NV_NAN_QS_SIGNALING (!(NV_NAN_QS_QUIET)) -#define NV_NAN_QS_TEST(nvp) (NV_NAN_QS_BYTE(nvp) & NV_NAN_QS_BIT) -/* NV_NAN_IS_QUIET() returns true if the NV behind nvp is a NaN, - * whether it is a quiet NaN, NV_NAN_IS_SIGNALING() if a signaling NaN. - * Note however that these do not check whether the nvp is a NaN. */ -#define NV_NAN_IS_QUIET(nvp) \ +#define NV_NAN_QS_SIGNALING (!(NV_NAN_QS_QUIET)) +#define NV_NAN_QS_TEST(nvp) (NV_NAN_QS_BYTE(nvp) & NV_NAN_QS_BIT) +/* NV_NAN_IS_QUIET() returns true if the NV behind nvp is a NaN, whether + * it is a quiet NaN, NV_NAN_IS_SIGNALING() if a signaling NaN. Note + * however that these do not check whether the nvp is a NaN. */ +#define NV_NAN_IS_QUIET(nvp) \ (NV_NAN_QS_TEST(nvp) == (NV_NAN_QS_QUIET ? NV_NAN_QS_BIT : 0)) -#define NV_NAN_IS_SIGNALING(nvp) \ +#define NV_NAN_IS_SIGNALING(nvp) \ (NV_NAN_QS_TEST(nvp) == (NV_NAN_QS_QUIET ? 0 : NV_NAN_QS_BIT)) -#define NV_NAN_SET_QUIET(nvp) \ - (NV_NAN_QS_QUIET ? \ - (NV_NAN_QS_BYTE(nvp) |= NV_NAN_QS_BIT) : \ +#define NV_NAN_SET_QUIET(nvp) \ + (NV_NAN_QS_QUIET ? \ + (NV_NAN_QS_BYTE(nvp) |= NV_NAN_QS_BIT) : \ (NV_NAN_QS_BYTE(nvp) &= ~NV_NAN_QS_BIT)) -#define NV_NAN_SET_SIGNALING(nvp) \ - (NV_NAN_QS_QUIET ? \ - (NV_NAN_QS_BYTE(nvp) &= ~NV_NAN_QS_BIT) : \ +#define NV_NAN_SET_SIGNALING(nvp) \ + (NV_NAN_QS_QUIET ? \ + (NV_NAN_QS_BYTE(nvp) &= ~NV_NAN_QS_BIT) : \ (NV_NAN_QS_BYTE(nvp) |= NV_NAN_QS_BIT)) -#define NV_NAN_QS_XOR(nvp) (NV_NAN_QS_BYTE(nvp) ^= NV_NAN_QS_BIT) +#define NV_NAN_QS_XOR(nvp) (NV_NAN_QS_BYTE(nvp) ^= NV_NAN_QS_BIT) /* NV_NAN_PAYLOAD_MASK: masking the nan payload bits. * - * NV_NAN_PAYLOAD_PERM: permuting the nan payload bytes. - * 0xFF means "don't go here".*/ + * NV_NAN_PAYLOAD_PERM: permuting the nan payload + * bytes. 0xFF means "don't go here". */ /* Shorthands to avoid typoses. */ -#define NV_NAN_PAYLOAD_MASK_SKIP_EIGHT \ - 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0 -#define NV_NAN_PAYLOAD_PERM_SKIP_EIGHT \ - 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff -#define NV_NAN_PAYLOAD_PERM_0_TO_7 \ - 0x0, 0x1, 0x2, 0x3, 0x4, 0x5, 0x6, 0x7 -#define NV_NAN_PAYLOAD_PERM_7_TO_0 \ - 0x7, 0x6, 0x5, 0x4, 0x3, 0x2, 0x1, 0x0 -#define NV_NAN_PAYLOAD_MASK_IEEE_754_128_LE \ - 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, \ - 0xff, 0xff, 0xff, 0xff, 0xff, 0x7f, 0x00, 0x00 +#define NV_NAN_PAYLOAD_MASK_SKIP_EIGHT \ + 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0 +#define NV_NAN_PAYLOAD_PERM_SKIP_EIGHT \ + 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff +#define NV_NAN_PAYLOAD_PERM_0_TO_7 \ + 0x0, 0x1, 0x2, 0x3, 0x4, 0x5, 0x6, 0x7 +#define NV_NAN_PAYLOAD_PERM_7_TO_0 \ + 0x7, 0x6, 0x5, 0x4, 0x3, 0x2, 0x1, 0x0 +#define NV_NAN_PAYLOAD_MASK_IEEE_754_128_LE \ + 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, \ + 0xff, 0xff, 0xff, 0xff, 0xff, 0x7f, 0x00, 0x00 #define NV_NAN_PAYLOAD_PERM_IEEE_754_128_LE \ - NV_NAN_PAYLOAD_PERM_0_TO_7, \ - 0x8, 0x9, 0xa, 0xb, 0xc, 0xd, 0xFF, 0xFF -#define NV_NAN_PAYLOAD_MASK_IEEE_754_128_BE \ - 0x00, 0x00, 0x7f, 0xff, 0xff, 0xff, 0xff, 0xff, \ - 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff -#define NV_NAN_PAYLOAD_PERM_IEEE_754_128_BE \ - 0xFF, 0xFF, 0xd, 0xc, 0xb, 0xa, 0x9, 0x8, \ - NV_NAN_PAYLOAD_PERM_7_TO_0 -#define NV_NAN_PAYLOAD_MASK_IEEE_754_64_LE \ - 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x07, 0x00 -#define NV_NAN_PAYLOAD_PERM_IEEE_754_64_LE \ - 0x0, 0x1, 0x2, 0x3, 0x4, 0x5, 0x6, 0xFF -#define NV_NAN_PAYLOAD_MASK_IEEE_754_64_BE \ - 0x00, 0x07, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff -#define NV_NAN_PAYLOAD_PERM_IEEE_754_64_BE \ - 0xFF, 0x6, 0x5, 0x4, 0x3, 0x2, 0x1, 0x0 + NV_NAN_PAYLOAD_PERM_0_TO_7, \ + 0x8, 0x9, 0xa, 0xb, 0xc, 0xd, 0xFF, 0xFF +#define NV_NAN_PAYLOAD_MASK_IEEE_754_128_BE \ + 0x00, 0x00, 0x7f, 0xff, 0xff, 0xff, 0xff, 0xff, \ + 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff +#define NV_NAN_PAYLOAD_PERM_IEEE_754_128_BE \ + 0xFF, 0xFF, 0xd, 0xc, 0xb, 0xa, 0x9, 0x8, \ + NV_NAN_PAYLOAD_PERM_7_TO_0 +#define NV_NAN_PAYLOAD_MASK_IEEE_754_64_LE \ + 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x07, 0x00 +#define NV_NAN_PAYLOAD_PERM_IEEE_754_64_LE \ + 0x0, 0x1, 0x2, 0x3, 0x4, 0x5, 0x6, 0xFF +#define NV_NAN_PAYLOAD_MASK_IEEE_754_64_BE \ + 0x00, 0x07, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff +#define NV_NAN_PAYLOAD_PERM_IEEE_754_64_BE \ + 0xFF, 0x6, 0x5, 0x4, 0x3, 0x2, 0x1, 0x0 #if defined(USE_LONG_DOUBLE) && NVSIZE > DOUBLESIZE # if LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN -# define NV_NAN_PAYLOAD_MASK NV_NAN_PAYLOAD_MASK_IEEE_754_128_LE -# define NV_NAN_PAYLOAD_PERM NV_NAN_PAYLOAD_PERM_IEEE_754_128_LE +# define NV_NAN_PAYLOAD_MASK NV_NAN_PAYLOAD_MASK_IEEE_754_128_LE +# define NV_NAN_PAYLOAD_PERM NV_NAN_PAYLOAD_PERM_IEEE_754_128_LE # elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN -# define NV_NAN_PAYLOAD_MASK NV_NAN_PAYLOAD_MASK_IEEE_754_128_BE -# define NV_NAN_PAYLOAD_PERM NV_NAN_PAYLOAD_PERM_IEEE_754_128_BE +# define NV_NAN_PAYLOAD_MASK NV_NAN_PAYLOAD_MASK_IEEE_754_128_BE +# define NV_NAN_PAYLOAD_PERM NV_NAN_PAYLOAD_PERM_IEEE_754_128_BE # elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN # if LONG_DOUBLESIZE == 10 -# define NV_NAN_PAYLOAD_MASK \ - 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x1f, \ - 0x00, 0x00 -# define NV_NAN_PAYLOAD_PERM \ - NV_NAN_PAYLOAD_PERM_0_TO_7, 0xFF, 0xFF +# define NV_NAN_PAYLOAD_MASK \ + 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x1f, \ + 0x00, 0x00 +# define NV_NAN_PAYLOAD_PERM \ + NV_NAN_PAYLOAD_PERM_0_TO_7, 0xFF, 0xFF # elif LONG_DOUBLESIZE == 12 -# define NV_NAN_PAYLOAD_MASK \ - 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x1f, \ - 0x00, 0x00, 0x00, 0x00 -# define NV_NAN_PAYLOAD_PERM \ - NV_NAN_PAYLOAD_PERM_0_TO_7, 0xFF, 0xFF, 0xFF, 0xFF +# define NV_NAN_PAYLOAD_MASK \ + 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x1f, \ + 0x00, 0x00, 0x00, 0x00 +# define NV_NAN_PAYLOAD_PERM \ + NV_NAN_PAYLOAD_PERM_0_TO_7, 0xFF, 0xFF, 0xFF, 0xFF # elif LONG_DOUBLESIZE == 16 -# define NV_NAN_PAYLOAD_MASK \ - 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x1f, \ - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 -# define NV_NAN_PAYLOAD_PERM \ - NV_NAN_PAYLOAD_PERM_0_TO_7, \ - 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF +# define NV_NAN_PAYLOAD_MASK \ + 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x1f, \ + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 +# define NV_NAN_PAYLOAD_PERM \ + NV_NAN_PAYLOAD_PERM_0_TO_7, \ + 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF # else # error "Unexpected x86 80-bit little-endian long double format" # endif # elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN # if LONG_DOUBLESIZE == 10 -# define NV_NAN_PAYLOAD_MASK \ - 0x00, 0x00, 0x1f, 0xff, 0xff, 0xff, 0xff, 0xff, \ - 0xff, 0xff -# define NV_NAN_PAYLOAD_PERM \ - NV_NAN_PAYLOAD_PERM_7_TO_0, 0xFF, 0xFF +# define NV_NAN_PAYLOAD_MASK \ + 0x00, 0x00, 0x1f, 0xff, 0xff, 0xff, 0xff, 0xff, \ + 0xff, 0xff +# define NV_NAN_PAYLOAD_PERM \ + NV_NAN_PAYLOAD_PERM_7_TO_0, 0xFF, 0xFF # elif LONG_DOUBLESIZE == 12 -# define NV_NAN_PAYLOAD_MASK \ - 0x00, 0x00, 0x1f, 0xff, 0xff, 0xff, 0xff, 0xff, \ - 0xff, 0xff, 0x00, 0x00 -# define NV_NAN_PAYLOAD_PERM \ - NV_NAN_PAYLOAD_PERM_7_TO_0, 0xFF, 0xFF, 0xFF, 0xFF +# define NV_NAN_PAYLOAD_MASK \ + 0x00, 0x00, 0x1f, 0xff, 0xff, 0xff, 0xff, 0xff, \ + 0xff, 0xff, 0x00, 0x00 +# define NV_NAN_PAYLOAD_PERM \ + NV_NAN_PAYLOAD_PERM_7_TO_0, 0xFF, 0xFF, 0xFF, 0xFF # elif LONG_DOUBLESIZE == 16 -# define NV_NAN_PAYLOAD_MASK \ - 0x00, 0x00, 0x1f, 0xff, 0xff, 0xff, 0xff, 0xff, \ - 0xff, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 -# define NV_NAN_PAYLOAD_PERM \ - NV_NAN_PAYLOAD_PERM_7_TO_0, \ - 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF +# define NV_NAN_PAYLOAD_MASK \ + 0x00, 0x00, 0x1f, 0xff, 0xff, 0xff, 0xff, 0xff, \ + 0xff, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 +# define NV_NAN_PAYLOAD_PERM \ + NV_NAN_PAYLOAD_PERM_7_TO_0, \ + 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF # else # error "Unexpected x86 80-bit big-endian long double format" # endif # elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_LE -/* For double-double we assume only the first double (in LE or BE terms) - * is used for NaN. */ +/* For double-double we assume only the first double + * (in LE or BE terms) is used for NaN. */ # define NV_NAN_PAYLOAD_MASK \ - NV_NAN_PAYLOAD_MASK_SKIP_EIGHT, NV_NAN_PAYLOAD_MASK_IEEE_754_64_LE + NV_NAN_PAYLOAD_MASK_SKIP_EIGHT, NV_NAN_PAYLOAD_MASK_IEEE_754_64_LE # define NV_NAN_PAYLOAD_PERM \ - NV_NAN_PAYLOAD_PERM_SKIP_EIGHT, NV_NAN_PAYLOAD_PERM_IEEE_754_64_LE + NV_NAN_PAYLOAD_PERM_SKIP_EIGHT, NV_NAN_PAYLOAD_PERM_IEEE_754_64_LE # elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE # define NV_NAN_PAYLOAD_MASK \ - NV_NAN_PAYLOAD_MASK_IEEE_754_64_BE + NV_NAN_PAYLOAD_MASK_IEEE_754_64_BE # define NV_NAN_PAYLOAD_PERM \ - NV_NAN_PAYLOAD_PERM_IEEE_754_64_BE + NV_NAN_PAYLOAD_PERM_IEEE_754_64_BE # elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_BE # define NV_NAN_PAYLOAD_MASK \ - NV_NAN_PAYLOAD_MASK_IEEE_754_64_LE + NV_NAN_PAYLOAD_MASK_IEEE_754_64_LE # define NV_NAN_PAYLOAD_PERM \ - NV_NAN_PAYLOAD_PERM_IEEE_754_64_LE + NV_NAN_PAYLOAD_PERM_IEEE_754_64_LE # elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_LE # define NV_NAN_PAYLOAD_MASK \ - NV_NAN_PAYLOAD_MASK_SKIP_EIGHT, NV_NAN_PAYLOAD_MASK_IEEE_754_64_BE + NV_NAN_PAYLOAD_MASK_SKIP_EIGHT, NV_NAN_PAYLOAD_MASK_IEEE_754_64_BE # define NV_NAN_PAYLOAD_PERM \ - NV_NAN_PAYLOAD_PERM_SKIP_EIGHT, NV_NAN_PAYLOAD_PERM_IEEE_754_64_BE + NV_NAN_PAYLOAD_PERM_SKIP_EIGHT, NV_NAN_PAYLOAD_PERM_IEEE_754_64_BE # else # error "Unexpected long double format" # endif #else # ifdef USE_QUADMATH /* quadmath is not long double */ # ifdef NV_LITTLE_ENDIAN -# define NV_NAN_PAYLOAD_MASK NV_NAN_PAYLOAD_MASK_IEEE_754_128_LE -# define NV_NAN_PAYLOAD_PERM NV_NAN_PAYLOAD_PERM_IEEE_754_128_LE +# define NV_NAN_PAYLOAD_MASK NV_NAN_PAYLOAD_MASK_IEEE_754_128_LE +# define NV_NAN_PAYLOAD_PERM NV_NAN_PAYLOAD_PERM_IEEE_754_128_LE # elif defined(NV_BIG_ENDIAN) -# define NV_NAN_PAYLOAD_MASK NV_NAN_PAYLOAD_MASK_IEEE_754_128_BE -# define NV_NAN_PAYLOAD_PERM NV_NAN_PAYLOAD_PERM_IEEE_754_128_BE +# define NV_NAN_PAYLOAD_MASK NV_NAN_PAYLOAD_MASK_IEEE_754_128_BE +# define NV_NAN_PAYLOAD_PERM NV_NAN_PAYLOAD_PERM_IEEE_754_128_BE # else # error "Unexpected quadmath format" # endif # elif DOUBLEKIND == DOUBLE_IS_IEEE_754_32_BIT_LITTLE_ENDIAN -# define NV_NAN_PAYLOAD_MASK 0xff, 0xff, 0x07, 0x00 -# define NV_NAN_PAYLOAD_PERM 0x0, 0x1, 0x2, 0xFF +# define NV_NAN_PAYLOAD_MASK 0xff, 0xff, 0x07, 0x00 +# define NV_NAN_PAYLOAD_PERM 0x0, 0x1, 0x2, 0xFF # elif DOUBLEKIND == DOUBLE_IS_IEEE_754_32_BIT_BIG_ENDIAN -# define NV_NAN_PAYLOAD_MASK 0x00, 0x07, 0xff, 0xff -# define NV_NAN_PAYLOAD_PERM 0xFF, 0x2, 0x1, 0x0 +# define NV_NAN_PAYLOAD_MASK 0x00, 0x07, 0xff, 0xff +# define NV_NAN_PAYLOAD_PERM 0xFF, 0x2, 0x1, 0x0 # elif DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_LITTLE_ENDIAN -# define NV_NAN_PAYLOAD_MASK NV_NAN_PAYLOAD_MASK_IEEE_754_64_LE -# define NV_NAN_PAYLOAD_PERM NV_NAN_PAYLOAD_PERM_IEEE_754_64_LE +# define NV_NAN_PAYLOAD_MASK NV_NAN_PAYLOAD_MASK_IEEE_754_64_LE +# define NV_NAN_PAYLOAD_PERM NV_NAN_PAYLOAD_PERM_IEEE_754_64_LE # elif DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_BIG_ENDIAN -# define NV_NAN_PAYLOAD_MASK NV_NAN_PAYLOAD_MASK_IEEE_754_64_BE -# define NV_NAN_PAYLOAD_PERM NV_NAN_PAYLOAD_PERM_IEEE_754_64_BE +# define NV_NAN_PAYLOAD_MASK NV_NAN_PAYLOAD_MASK_IEEE_754_64_BE +# define NV_NAN_PAYLOAD_PERM NV_NAN_PAYLOAD_PERM_IEEE_754_64_BE # elif DOUBLEKIND == DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN -# define NV_NAN_PAYLOAD_MASK NV_NAN_PAYLOAD_MASK_IEEE_754_128_LE -# define NV_NAN_PAYLOAD_PERM NV_NAN_PAYLOAD_PERM_IEEE_754_128_LE +# define NV_NAN_PAYLOAD_MASK NV_NAN_PAYLOAD_MASK_IEEE_754_128_LE +# define NV_NAN_PAYLOAD_PERM NV_NAN_PAYLOAD_PERM_IEEE_754_128_LE # elif DOUBLEKIND == DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN -# define NV_NAN_PAYLOAD_MASK NV_NAN_PAYLOAD_MASK_IEEE_754_128_BE -# define NV_NAN_PAYLOAD_PERM NV_NAN_PAYLOAD_PERM_IEEE_754_128_BE +# define NV_NAN_PAYLOAD_MASK NV_NAN_PAYLOAD_MASK_IEEE_754_128_BE +# define NV_NAN_PAYLOAD_PERM NV_NAN_PAYLOAD_PERM_IEEE_754_128_BE # elif DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_LE_BE -# define NV_NAN_PAYLOAD_MASK 0xff, 0xff, 0x07, 0x00, 0xff, 0xff, 0xff, 0xff -# define NV_NAN_PAYLOAD_PERM 0x4, 0x5, 0x6, 0xFF, 0x0, 0x1, 0x2, 0x3 +# define NV_NAN_PAYLOAD_MASK 0xff, 0xff, 0x07, 0x00, 0xff, 0xff, 0xff, 0xff +# define NV_NAN_PAYLOAD_PERM 0x4, 0x5, 0x6, 0xFF, 0x0, 0x1, 0x2, 0x3 # elif DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_BE_LE -# define NV_NAN_PAYLOAD_MASK 0xff, 0xff, 0xff, 0xff, 0x00, 0x07, 0xff, 0xff -# define NV_NAN_PAYLOAD_PERM 0x3, 0x2, 0x1, 0x0, 0xFF, 0x6, 0x5, 0x4 +# define NV_NAN_PAYLOAD_MASK 0xff, 0xff, 0xff, 0xff, 0x00, 0x07, 0xff, 0xff +# define NV_NAN_PAYLOAD_PERM 0x3, 0x2, 0x1, 0x0, 0xFF, 0x6, 0x5, 0x4 # else # error "Unexpected double format" # endif @@ -9034,28 +8998,31 @@ END_EXTERN_C #endif /* DOUBLE_HAS_NAN */ -/* these are used to faciliate the env var PERL_RAND_SEED, - * which allows consistent behavior from code that calls - * srand() with no arguments, either explicitly or implicitly. +/* these are used to faciliate the env var PERL_RAND_SEED, which + * allows consistent behavior from code that calls srand() with + * no arguments, either explicitly or implicitly. */ -#define PERL_SRAND_OVERRIDE_NEXT() PERL_XORSHIFT32_A(PL_srand_override_next); +#define PERL_SRAND_OVERRIDE_NEXT() PERL_XORSHIFT32_A(PL_srand_override_next); -#define PERL_SRAND_OVERRIDE_NEXT_INIT() STMT_START { \ - PL_srand_override = PL_srand_override_next; \ - PERL_SRAND_OVERRIDE_NEXT(); \ -} STMT_END +#define PERL_SRAND_OVERRIDE_NEXT_INIT() \ + STMT_START { \ + PL_srand_override = PL_srand_override_next; \ + PERL_SRAND_OVERRIDE_NEXT(); \ + } STMT_END -#define PERL_SRAND_OVERRIDE_GET(into) STMT_START { \ - into= PL_srand_override; \ - PERL_SRAND_OVERRIDE_NEXT_INIT(); \ -} STMT_END +#define PERL_SRAND_OVERRIDE_GET(into) \ + STMT_START { \ + into= PL_srand_override; \ + PERL_SRAND_OVERRIDE_NEXT_INIT(); \ + } STMT_END -#define PERL_SRAND_OVERRIDE_NEXT_CHILD() STMT_START { \ - PERL_XORSHIFT32_B(PL_srand_override_next); \ - PERL_SRAND_OVERRIDE_NEXT_INIT(); \ -} STMT_END +#define PERL_SRAND_OVERRIDE_NEXT_CHILD() \ + STMT_START { \ + PERL_XORSHIFT32_B(PL_srand_override_next); \ + PERL_SRAND_OVERRIDE_NEXT_INIT(); \ + } STMT_END -#define PERL_SRAND_OVERRIDE_NEXT_PARENT() \ +#define PERL_SRAND_OVERRIDE_NEXT_PARENT() \ PERL_SRAND_OVERRIDE_NEXT() /* in something like @@ -9065,25 +9032,25 @@ END_EXTERN_C * Each iteration chews up 8 stacks frames, and we will eventually SEGV * due to C stack overflow. * - * This define provides a maximum limit to prevent the SEGV. Such code is - * unusual, so it unlikely we need a very large number here. + * This define provides a maximum limit to prevent the SEGV. Such code + * is unusual, so it unlikely we need a very large number here. */ #ifndef PERL_MAX_NESTED_EVAL_BEGIN_BLOCKS_DEFAULT -#define PERL_MAX_NESTED_EVAL_BEGIN_BLOCKS_DEFAULT 1000 +#define PERL_MAX_NESTED_EVAL_BEGIN_BLOCKS_DEFAULT 1000 #endif /* ${^MAX_NESTED_EVAL_BEGIN_BLOCKS} */ -#define PERL_VAR_MAX_NESTED_EVAL_BEGIN_BLOCKS "\015AX_NESTED_EVAL_BEGIN_BLOCKS" +#define PERL_VAR_MAX_NESTED_EVAL_BEGIN_BLOCKS "\015AX_NESTED_EVAL_BEGIN_BLOCKS" -/* Defines like this make it easier to do porting/diag.t. They are no- - * ops that return their argument which can be used to hint to diag.t - * that a string is actually an error message. By putting the category - * information into the macro name it considerably simplifies extended - * diag.t to support these cases. Feel free to add more. +/* Defines like this make it easier to do porting/diag.t. They are + * no- ops that return their argument which can be used to hint to + * diag.t that a string is actually an error message. By putting the + * category information into the macro name it considerably simplifies + * extended diag.t to support these cases. Feel free to add more. * * While it seems tempting to try to convert all of our diagnostics to * this format, it would miss part of the point of diag.t in that it * detects NEW diagnostics, which would not necessarily use these - * macros. The macros instead exist where we know we have an error + * macros. The macros instead exist where we know we have an error * message that isnt being picked up by diag.t because it is declared * as a string independently of the function it is fed to, something * diag.t can never handle right without help. @@ -9093,10 +9060,10 @@ END_EXTERN_C #define PERL_DIAG_DIE_SYNTAX(x) PERL_DIAG_STR_(x) #ifndef PERL_STOP_PARSING_AFTER_N_ERRORS -#define PERL_STOP_PARSING_AFTER_N_ERRORS 10 +#define PERL_STOP_PARSING_AFTER_N_ERRORS 10 #endif -#define PERL_PARSE_ERROR_COUNT(f) (f) +#define PERL_PARSE_ERROR_COUNT(f) (f) /* @@ -9145,11 +9112,10 @@ END_EXTERN_C so that Configure picks them up. (KEEP THIS LAST IN perl.h!) - */ #endif /* Include guard */ /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/perl_inc_macro.h b/perl_inc_macro.h index 627a63a81772..3117faa8f881 100644 --- a/perl_inc_macro.h +++ b/perl_inc_macro.h @@ -1,140 +1,157 @@ -/* just define a list of macros to push elements in INC -* so we can easily use them and change order on demand -* -* list of available INCPUSH macros -* - INCPUSH_APPLLIB_EXP -* - INCPUSH_SITEARCH_EXP -* - INCPUSH_SITELIB_EXP -* - INCPUSH_PERL_VENDORARCH_EXP -* - INCPUSH_PERL_VENDORLIB_EXP -* - INCPUSH_ARCHLIB_EXP -* - INCPUSH_PRIVLIB_EXP -* - INCPUSH_PERL_OTHERLIBDIRS -* - INCPUSH_PERL5LIB -* - INCPUSH_APPLLIB_OLD_EXP -* - INCPUSH_SITELIB_STEM -* - INCPUSH_PERL_VENDORLIB_STEM -* - INCPUSH_PERL_OTHERLIBDIRS_ARCHONLY -*/ +/* just define a list of macros to push elements in INC so + * we can easily use them and change order on demand + * + * list of available INCPUSH macros + * - INCPUSH_APPLLIB_EXP + * - INCPUSH_SITEARCH_EXP + * - INCPUSH_SITELIB_EXP + * - INCPUSH_PERL_VENDORARCH_EXP + * - INCPUSH_PERL_VENDORLIB_EXP + * - INCPUSH_ARCHLIB_EXP + * - INCPUSH_PRIVLIB_EXP + * - INCPUSH_PERL_OTHERLIBDIRS + * - INCPUSH_PERL5LIB + * - INCPUSH_APPLLIB_OLD_EXP + * - INCPUSH_SITELIB_STEM + * - INCPUSH_PERL_VENDORLIB_STEM + * - INCPUSH_PERL_OTHERLIBDIRS_ARCHONLY + */ #ifndef DEFINE_INC_MACROS /* protect against multiple inclusions */ -#define DEFINE_INC_MACROS 1 +#define DEFINE_INC_MACROS 1 #ifdef APPLLIB_EXP -# define INCPUSH_APPLLIB_EXP S_incpush_use_sep(aTHX_ STR_WITH_LEN(APPLLIB_EXP), \ - INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE); +# define INCPUSH_APPLLIB_EXP \ + S_incpush_use_sep(aTHX_ STR_WITH_LEN(APPLLIB_EXP), \ + INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE); #endif #ifdef SITEARCH_EXP /* sitearch is always relative to sitelib on Windows for * DLL-based path intuition to work correctly */ # if !defined(WIN32) -# define INCPUSH_SITEARCH_EXP S_incpush_use_sep(aTHX_ STR_WITH_LEN(SITEARCH_EXP), \ - INCPUSH_CAN_RELOCATE); +# define INCPUSH_SITEARCH_EXP \ + S_incpush_use_sep(aTHX_ STR_WITH_LEN(SITEARCH_EXP), \ + INCPUSH_CAN_RELOCATE); # endif #endif #ifdef SITELIB_EXP # if defined(WIN32) /* this picks up sitearch as well */ -# define INCPUSH_SITELIB_EXP s = PerlEnv_sitelib_path(PERL_FS_VERSION, &len); \ - if (s) incpush_use_sep(s, len, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE); +# define INCPUSH_SITELIB_EXP \ + s = PerlEnv_sitelib_path(PERL_FS_VERSION, &len); \ + if (s) incpush_use_sep(s, len, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE); # else -# define INCPUSH_SITELIB_EXP S_incpush_use_sep(aTHX_ STR_WITH_LEN(SITELIB_EXP), \ - INCPUSH_CAN_RELOCATE); +# define INCPUSH_SITELIB_EXP \ + S_incpush_use_sep(aTHX_ STR_WITH_LEN(SITELIB_EXP), \ + INCPUSH_CAN_RELOCATE); # endif #endif #ifdef PERL_VENDORARCH_EXP - /* vendorarch is always relative to vendorlib on Windows for - * DLL-based path intuition to work correctly */ + /* vendorarch is always relative to vendorlib on Windows + * for DLL-based path intuition to work correctly */ # if !defined(WIN32) -# define INCPUSH_PERL_VENDORARCH_EXP S_incpush_use_sep(aTHX_ STR_WITH_LEN(PERL_VENDORARCH_EXP), INCPUSH_CAN_RELOCATE); +# define INCPUSH_PERL_VENDORARCH_EXP \ + S_incpush_use_sep(aTHX_ STR_WITH_LEN(PERL_VENDORARCH_EXP), INCPUSH_CAN_RELOCATE); # endif #endif #ifdef PERL_VENDORLIB_EXP # if defined(WIN32) /* this picks up vendorarch as well */ -# define INCPUSH_PERL_VENDORLIB_EXP s = PerlEnv_vendorlib_path(PERL_FS_VERSION, &len); \ - if (s) incpush_use_sep(s, len, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE); +# define INCPUSH_PERL_VENDORLIB_EXP \ + s = PerlEnv_vendorlib_path(PERL_FS_VERSION, &len); \ + if (s) incpush_use_sep(s, len, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE); # else -# define INCPUSH_PERL_VENDORLIB_EXP S_incpush_use_sep(aTHX_ STR_WITH_LEN(PERL_VENDORLIB_EXP), INCPUSH_CAN_RELOCATE); +# define INCPUSH_PERL_VENDORLIB_EXP \ + S_incpush_use_sep(aTHX_ STR_WITH_LEN(PERL_VENDORLIB_EXP), INCPUSH_CAN_RELOCATE); # endif #endif #ifdef ARCHLIB_EXP -# define INCPUSH_ARCHLIB_EXP S_incpush_use_sep(aTHX_ STR_WITH_LEN(ARCHLIB_EXP), INCPUSH_CAN_RELOCATE); +# define INCPUSH_ARCHLIB_EXP \ + S_incpush_use_sep(aTHX_ STR_WITH_LEN(ARCHLIB_EXP), INCPUSH_CAN_RELOCATE); #endif /* used by INCPUSH_PRIVLIB_EXP */ #ifndef PRIVLIB_EXP -# define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl" +# define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl" #endif #if defined(WIN32) -# define INCPUSH_PRIVLIB_EXP s = PerlEnv_lib_path(PERL_FS_VERSION, &len); \ - if (s) incpush_use_sep(s, len, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE); +# define INCPUSH_PRIVLIB_EXP \ + s = PerlEnv_lib_path(PERL_FS_VERSION, &len); \ + if (s) incpush_use_sep(s, len, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE); #else -# define INCPUSH_PRIVLIB_EXP S_incpush_use_sep(aTHX_ STR_WITH_LEN(PRIVLIB_EXP), INCPUSH_CAN_RELOCATE); +# define INCPUSH_PRIVLIB_EXP \ + S_incpush_use_sep(aTHX_ STR_WITH_LEN(PRIVLIB_EXP), INCPUSH_CAN_RELOCATE); #endif #ifdef PERL_OTHERLIBDIRS -# define INCPUSH_PERL_OTHERLIBDIRS S_incpush_use_sep(aTHX_ STR_WITH_LEN(PERL_OTHERLIBDIRS), \ - INCPUSH_ADD_VERSIONED_SUB_DIRS|INCPUSH_NOT_BASEDIR|INCPUSH_CAN_RELOCATE); +# define INCPUSH_PERL_OTHERLIBDIRS \ + S_incpush_use_sep(aTHX_ STR_WITH_LEN(PERL_OTHERLIBDIRS), \ + INCPUSH_ADD_VERSIONED_SUB_DIRS|INCPUSH_NOT_BASEDIR|INCPUSH_CAN_RELOCATE); #endif /* submacros for INCPUSH_PERL5LIB */ -#define _INCPUSH_PERL5LIB_IF if (perl5lib && *perl5lib != '\0') +#define _INCPUSH_PERL5LIB_IF if (perl5lib && *perl5lib != '\0') #ifndef VMS -# define _INCPUSH_PERL5LIB_ADD _INCPUSH_PERL5LIB_IF incpush_use_sep(perl5lib, 0, INCPUSH_ADD_OLD_VERS|INCPUSH_NOT_BASEDIR); +# define _INCPUSH_PERL5LIB_ADD \ + _INCPUSH_PERL5LIB_IF incpush_use_sep(perl5lib, 0, INCPUSH_ADD_OLD_VERS|INCPUSH_NOT_BASEDIR); #else /* VMS */ /* Treat PERL5?LIB as a possible search list logical name -- the - * "natural" VMS idiom for a Unix path string. We allow each - * element to be a set of |-separated directories for compatibility. + * "natural" VMS idiom for a Unix path string. We allow each element + * to be a set of |-separated directories for compatibility. */ -# define _INCPUSH_PERL5LIB_ADD char buf[256]; \ - int idx = 0; \ - if (vmstrnenv("PERL5LIB",buf,0,NULL,0)) \ - do { \ - incpush_use_sep(buf, 0, \ - INCPUSH_ADD_OLD_VERS|INCPUSH_NOT_BASEDIR); \ - } while (vmstrnenv("PERL5LIB",buf,++idx,NULL,0)); +# define _INCPUSH_PERL5LIB_ADD \ + char buf[256]; \ + int idx = 0; \ + if (vmstrnenv("PERL5LIB",buf,0,NULL,0)) \ + do { \ + incpush_use_sep(buf, 0, \ + INCPUSH_ADD_OLD_VERS|INCPUSH_NOT_BASEDIR); \ + } while (vmstrnenv("PERL5LIB",buf,++idx,NULL,0)); #endif /* this macro is special and use submacros from above */ -#define INCPUSH_PERL5LIB if (!TAINTING_get) { _INCPUSH_PERL5LIB_ADD } +#define INCPUSH_PERL5LIB if (!TAINTING_get) { _INCPUSH_PERL5LIB_ADD } /* Use the ~-expanded versions of APPLLIB (undocumented), - SITELIB and VENDORLIB for older versions -*/ + SITELIB and VENDORLIB for older versions + */ #ifdef APPLLIB_EXP -# define INCPUSH_APPLLIB_OLD_EXP S_incpush_use_sep(aTHX_ STR_WITH_LEN(APPLLIB_EXP), \ - INCPUSH_ADD_OLD_VERS|INCPUSH_NOT_BASEDIR|INCPUSH_CAN_RELOCATE); +# define INCPUSH_APPLLIB_OLD_EXP \ + S_incpush_use_sep(aTHX_ STR_WITH_LEN(APPLLIB_EXP), \ + INCPUSH_ADD_OLD_VERS|INCPUSH_NOT_BASEDIR|INCPUSH_CAN_RELOCATE); #endif #if defined(SITELIB_STEM) && defined(PERL_INC_VERSION_LIST) /* Search for version-specific dirs below here */ -# define INCPUSH_SITELIB_STEM S_incpush_use_sep(aTHX_ STR_WITH_LEN(SITELIB_STEM), \ - INCPUSH_ADD_OLD_VERS|INCPUSH_CAN_RELOCATE); +# define INCPUSH_SITELIB_STEM \ + S_incpush_use_sep(aTHX_ STR_WITH_LEN(SITELIB_STEM), \ + INCPUSH_ADD_OLD_VERS|INCPUSH_CAN_RELOCATE); #endif #if defined(PERL_VENDORLIB_STEM) && defined(PERL_INC_VERSION_LIST) /* Search for version-specific dirs below here */ -# define INCPUSH_PERL_VENDORLIB_STEM S_incpush_use_sep(aTHX_ STR_WITH_LEN(PERL_VENDORLIB_STEM), \ - INCPUSH_ADD_OLD_VERS|INCPUSH_CAN_RELOCATE); +# define INCPUSH_PERL_VENDORLIB_STEM \ + S_incpush_use_sep(aTHX_ STR_WITH_LEN(PERL_VENDORLIB_STEM), \ + INCPUSH_ADD_OLD_VERS|INCPUSH_CAN_RELOCATE); #endif #ifdef PERL_OTHERLIBDIRS -# define INCPUSH_PERL_OTHERLIBDIRS_ARCHONLY S_incpush_use_sep(aTHX_ STR_WITH_LEN(PERL_OTHERLIBDIRS), \ - INCPUSH_ADD_OLD_VERS|INCPUSH_ADD_ARCHONLY_SUB_DIRS|INCPUSH_CAN_RELOCATE); +# define INCPUSH_PERL_OTHERLIBDIRS_ARCHONLY \ + S_incpush_use_sep(aTHX_ STR_WITH_LEN(PERL_OTHERLIBDIRS), \ + INCPUSH_ADD_OLD_VERS|INCPUSH_ADD_ARCHONLY_SUB_DIRS|INCPUSH_CAN_RELOCATE); #endif diff --git a/perl_langinfo.h b/perl_langinfo.h index 60c189b83779..a74c46e86460 100644 --- a/perl_langinfo.h +++ b/perl_langinfo.h @@ -1,8 +1,8 @@ -/* Replaces , and allows our code to work on systems that don't - * have that. */ +/* Replaces , and allows our code to + * work on systems that don't have that. */ #ifndef PERL_LANGINFO_H -#define PERL_LANGINFO_H 1 +#define PERL_LANGINFO_H 1 #include "config.h" @@ -10,181 +10,181 @@ # include #endif -/* NOTE that this file is parsed by ext/XS-APItest/t/locale.t, so be careful - * with changes */ +/* NOTE that this file is parsed by ext/XS-APItest/t/locale.t, + * so be careful with changes */ /* If foo doesn't exist define it to a negative number. */ #ifndef CODESET -# define CODESET -1 +# define CODESET -1 #endif #ifndef D_T_FMT -# define D_T_FMT -2 +# define D_T_FMT -2 #endif #ifndef D_FMT -# define D_FMT -3 +# define D_FMT -3 #endif #ifndef T_FMT -# define T_FMT -4 +# define T_FMT -4 #endif #ifndef T_FMT_AMPM -# define T_FMT_AMPM -5 +# define T_FMT_AMPM -5 #endif #ifndef AM_STR -# define AM_STR -6 +# define AM_STR -6 #endif #ifndef PM_STR -# define PM_STR -7 +# define PM_STR -7 #endif #ifndef DAY_1 -# define DAY_1 -8 +# define DAY_1 -8 #endif #ifndef DAY_2 -# define DAY_2 -9 +# define DAY_2 -9 #endif #ifndef DAY_3 -# define DAY_3 -10 +# define DAY_3 -10 #endif #ifndef DAY_4 -# define DAY_4 -11 +# define DAY_4 -11 #endif #ifndef DAY_5 -# define DAY_5 -12 +# define DAY_5 -12 #endif #ifndef DAY_6 -# define DAY_6 -13 +# define DAY_6 -13 #endif #ifndef DAY_7 -# define DAY_7 -14 +# define DAY_7 -14 #endif #ifndef ABDAY_1 -# define ABDAY_1 -15 +# define ABDAY_1 -15 #endif #ifndef ABDAY_2 -# define ABDAY_2 -16 +# define ABDAY_2 -16 #endif #ifndef ABDAY_3 -# define ABDAY_3 -17 +# define ABDAY_3 -17 #endif #ifndef ABDAY_4 -# define ABDAY_4 -18 +# define ABDAY_4 -18 #endif #ifndef ABDAY_5 -# define ABDAY_5 -19 +# define ABDAY_5 -19 #endif #ifndef ABDAY_6 -# define ABDAY_6 -20 +# define ABDAY_6 -20 #endif #ifndef ABDAY_7 -# define ABDAY_7 -21 +# define ABDAY_7 -21 #endif #ifndef MON_1 -# define MON_1 -22 +# define MON_1 -22 #endif #ifndef MON_2 -# define MON_2 -23 +# define MON_2 -23 #endif #ifndef MON_3 -# define MON_3 -24 +# define MON_3 -24 #endif #ifndef MON_4 -# define MON_4 -25 +# define MON_4 -25 #endif #ifndef MON_5 -# define MON_5 -26 +# define MON_5 -26 #endif #ifndef MON_6 -# define MON_6 -27 +# define MON_6 -27 #endif #ifndef MON_7 -# define MON_7 -28 +# define MON_7 -28 #endif #ifndef MON_8 -# define MON_8 -29 +# define MON_8 -29 #endif #ifndef MON_9 -# define MON_9 -30 +# define MON_9 -30 #endif #ifndef MON_10 -# define MON_10 -31 +# define MON_10 -31 #endif #ifndef MON_11 -# define MON_11 -32 +# define MON_11 -32 #endif #ifndef MON_12 -# define MON_12 -33 +# define MON_12 -33 #endif #ifndef ABMON_1 -# define ABMON_1 -34 +# define ABMON_1 -34 #endif #ifndef ABMON_2 -# define ABMON_2 -35 +# define ABMON_2 -35 #endif #ifndef ABMON_3 -# define ABMON_3 -36 +# define ABMON_3 -36 #endif #ifndef ABMON_4 -# define ABMON_4 -37 +# define ABMON_4 -37 #endif #ifndef ABMON_5 -# define ABMON_5 -38 +# define ABMON_5 -38 #endif #ifndef ABMON_6 -# define ABMON_6 -39 +# define ABMON_6 -39 #endif #ifndef ABMON_7 -# define ABMON_7 -40 +# define ABMON_7 -40 #endif #ifndef ABMON_8 -# define ABMON_8 -41 +# define ABMON_8 -41 #endif #ifndef ABMON_9 -# define ABMON_9 -42 +# define ABMON_9 -42 #endif #ifndef ABMON_10 -# define ABMON_10 -43 +# define ABMON_10 -43 #endif #ifndef ABMON_11 -# define ABMON_11 -44 +# define ABMON_11 -44 #endif #ifndef ABMON_12 -# define ABMON_12 -45 +# define ABMON_12 -45 #endif #ifndef ERA -# define ERA -46 +# define ERA -46 #endif #ifndef ERA_D_FMT -# define ERA_D_FMT -47 +# define ERA_D_FMT -47 #endif #ifndef ERA_D_T_FMT -# define ERA_D_T_FMT -48 +# define ERA_D_T_FMT -48 #endif #ifndef ERA_T_FMT -# define ERA_T_FMT -49 +# define ERA_T_FMT -49 #endif #ifndef ALT_DIGITS -# define ALT_DIGITS -50 +# define ALT_DIGITS -50 #endif #ifndef RADIXCHAR -# define RADIXCHAR -51 +# define RADIXCHAR -51 #endif #ifndef THOUSEP -# define THOUSEP -52 +# define THOUSEP -52 #endif #ifndef YESEXPR -# define YESEXPR -53 +# define YESEXPR -53 #endif #ifndef YESSTR -# define YESSTR -54 +# define YESSTR -54 #endif #ifndef NOEXPR -# define NOEXPR -55 +# define NOEXPR -55 #endif #ifndef NOSTR -# define NOSTR -56 +# define NOSTR -56 #endif #ifndef CRNCYSTR -# define CRNCYSTR -57 +# define CRNCYSTR -57 #endif #endif diff --git a/perl_siphash.h b/perl_siphash.h index d3d71e77101d..ef7259a6faf7 100644 --- a/perl_siphash.h +++ b/perl_siphash.h @@ -1,37 +1,36 @@ -/* This is SipHash by Jean-Philippe Aumasson and Daniel J. Bernstein. - * The authors claim it is relatively secure compared to the alternatives - * and that performance wise it is a suitable hash for languages like Perl. - * See: +/* This is SipHash by Jean-Philippe Aumasson and Daniel J. Bernstein. The + * authors claim it is relatively secure compared to the alternatives and that + * performance wise it is a suitable hash for languages like Perl. See: * * https://www.131002.net/siphash/ * * This implementation seems to perform slightly slower than one-at-a-time for - * short keys, but degrades slower for longer keys. Murmur Hash outperforms it - * regardless of keys size. + * short keys, but degrades slower for longer keys. Murmur Hash outperforms + * it regardless of keys size. * * It is 64 bit only. */ #ifdef CAN64BITHASH -#define SIPROUND \ - STMT_START { \ - v0 += v1; v1=ROTL64(v1,13); v1 ^= v0; v0=ROTL64(v0,32); \ - v2 += v3; v3=ROTL64(v3,16); v3 ^= v2; \ - v0 += v3; v3=ROTL64(v3,21); v3 ^= v0; \ - v2 += v1; v1=ROTL64(v1,17); v1 ^= v2; v2=ROTL64(v2,32); \ - } STMT_END +#define SIPROUND \ + STMT_START { \ + v0 += v1; v1=ROTL64(v1,13); v1 ^= v0; v0=ROTL64(v0,32); \ + v2 += v3; v3=ROTL64(v3,16); v3 ^= v2; \ + v0 += v3; v3=ROTL64(v3,21); v3 ^= v0; \ + v2 += v1; v1=ROTL64(v1,17); v1 ^= v2; v2=ROTL64(v2,32); \ + } STMT_END -#define SIPHASH_SEED_STATE(key,v0,v1,v2,v3) \ -do { \ - v0 = v2 = U8TO64_LE(key + 0); \ - v1 = v3 = U8TO64_LE(key + 8); \ - /* "somepseudorandomlygeneratedbytes" */ \ - v0 ^= UINT64_C(0x736f6d6570736575); \ - v1 ^= UINT64_C(0x646f72616e646f6d); \ - v2 ^= UINT64_C(0x6c7967656e657261); \ - v3 ^= UINT64_C(0x7465646279746573); \ -} while (0) +#define SIPHASH_SEED_STATE(key,v0,v1,v2,v3) \ + do { \ + v0 = v2 = U8TO64_LE(key + 0); \ + v1 = v3 = U8TO64_LE(key + 8); \ + /* "somepseudorandomlygeneratedbytes" */ \ + v0 ^= UINT64_C(0x736f6d6570736575); \ + v1 ^= UINT64_C(0x646f72616e646f6d); \ + v2 ^= UINT64_C(0x6c7967656e657261); \ + v3 ^= UINT64_C(0x7465646279746573); \ + } while (0) PERL_STATIC_INLINE void S_perl_siphash_seed_state(const unsigned char * const seed_buf, unsigned char * state_buf) { @@ -39,77 +38,77 @@ void S_perl_siphash_seed_state(const unsigned char * const seed_buf, unsigned ch SIPHASH_SEED_STATE(seed_buf, v[0],v[1],v[2],v[3]); } -#define PERL_SIPHASH_FNC(FNC,SIP_ROUNDS,SIP_FINAL_ROUNDS) \ -PERL_STATIC_INLINE U64 \ -FNC ## _with_state_64 \ - (const unsigned char * const state, const unsigned char *in, const STRLEN inlen) \ -{ \ - const int left = inlen & 7; \ - const U8 *end = in + inlen - left; \ - \ - U64 b = ( ( U64 )(inlen) ) << 56; \ - U64 m; \ - U64 v0 = U8TO64_LE(state); \ - U64 v1 = U8TO64_LE(state+8); \ - U64 v2 = U8TO64_LE(state+16); \ - U64 v3 = U8TO64_LE(state+24); \ - \ - for ( ; in != end; in += 8 ) \ - { \ - m = U8TO64_LE( in ); \ - v3 ^= m; \ - \ - SIP_ROUNDS; \ - \ - v0 ^= m; \ - } \ - \ - switch( left ) \ - { \ - case 7: b |= ( ( U64 )in[ 6] ) << 48; /*FALLTHROUGH*/ \ - case 6: b |= ( ( U64 )in[ 5] ) << 40; /*FALLTHROUGH*/ \ - case 5: b |= ( ( U64 )in[ 4] ) << 32; /*FALLTHROUGH*/ \ - case 4: b |= ( ( U64 )in[ 3] ) << 24; /*FALLTHROUGH*/ \ - case 3: b |= ( ( U64 )in[ 2] ) << 16; /*FALLTHROUGH*/ \ - case 2: b |= ( ( U64 )in[ 1] ) << 8; /*FALLTHROUGH*/ \ - case 1: b |= ( ( U64 )in[ 0] ); break; \ - case 0: break; \ - } \ - \ - v3 ^= b; \ - \ - SIP_ROUNDS; \ - \ - v0 ^= b; \ - \ - v2 ^= 0xff; \ - \ - SIP_FINAL_ROUNDS \ - \ - b = v0 ^ v1 ^ v2 ^ v3; \ - return b; \ -} \ - \ -PERL_STATIC_INLINE U32 \ -FNC ## _with_state \ - (const unsigned char * const state, const unsigned char *in, const STRLEN inlen) \ -{ \ - union { \ - U64 h64; \ - U32 h32[2]; \ - } h; \ - h.h64= FNC ## _with_state_64(state,in,inlen); \ - return h.h32[0] ^ h.h32[1]; \ -} \ - \ - \ -PERL_STATIC_INLINE U32 \ -FNC (const unsigned char * const seed, const unsigned char *in, const STRLEN inlen) \ -{ \ - U64 state[4]; \ - SIPHASH_SEED_STATE(seed,state[0],state[1],state[2],state[3]); \ - return FNC ## _with_state((U8*)state,in,inlen); \ -} +#define PERL_SIPHASH_FNC(FNC,SIP_ROUNDS,SIP_FINAL_ROUNDS) \ + PERL_STATIC_INLINE U64 \ + FNC ## _with_state_64 \ + (const unsigned char * const state, const unsigned char *in, const STRLEN inlen) \ + { \ + const int left = inlen & 7; \ + const U8 *end = in + inlen - left; \ + \ + U64 b = ( ( U64 )(inlen) ) << 56; \ + U64 m; \ + U64 v0 = U8TO64_LE(state); \ + U64 v1 = U8TO64_LE(state+8); \ + U64 v2 = U8TO64_LE(state+16); \ + U64 v3 = U8TO64_LE(state+24); \ + \ + for (; in != end; in += 8 ) \ + { \ + m = U8TO64_LE( in ); \ + v3 ^= m; \ + \ + SIP_ROUNDS; \ + \ + v0 ^= m; \ + } \ + \ + switch( left ) \ + { \ + case 7: b |= ( ( U64 )in[ 6] ) << 48; /*FALLTHROUGH */ \ + case 6: b |= ( ( U64 )in[ 5] ) << 40; /*FALLTHROUGH */ \ + case 5: b |= ( ( U64 )in[ 4] ) << 32; /*FALLTHROUGH */ \ + case 4: b |= ( ( U64 )in[ 3] ) << 24; /*FALLTHROUGH */ \ + case 3: b |= ( ( U64 )in[ 2] ) << 16; /*FALLTHROUGH */ \ + case 2: b |= ( ( U64 )in[ 1] ) << 8; /*FALLTHROUGH */ \ + case 1: b |= ( ( U64 )in[ 0] ); break; \ + case 0: break; \ + } \ + \ + v3 ^= b; \ + \ + SIP_ROUNDS; \ + \ + v0 ^= b; \ + \ + v2 ^= 0xff; \ + \ + SIP_FINAL_ROUNDS \ + \ + b = v0 ^ v1 ^ v2 ^ v3; \ + return b; \ + } \ + \ + PERL_STATIC_INLINE U32 \ + FNC ## _with_state \ + (const unsigned char * const state, const unsigned char *in, const STRLEN inlen) \ + { \ + union { \ + U64 h64; \ + U32 h32[2]; \ + } h; \ + h.h64= FNC ## _with_state_64(state,in,inlen); \ + return h.h32[0] ^ h.h32[1]; \ + } \ + \ + \ + PERL_STATIC_INLINE U32 \ + FNC (const unsigned char * const seed, const unsigned char *in, const STRLEN inlen) \ + { \ + U64 state[4]; \ + SIPHASH_SEED_STATE(seed,state[0],state[1],state[2],state[3]); \ + return FNC ## _with_state((U8*)state,in,inlen); \ + } PERL_SIPHASH_FNC( diff --git a/perlapi.h b/perlapi.h index d93ee199b7ed..918efa11b63b 100644 --- a/perlapi.h +++ b/perlapi.h @@ -3,19 +3,17 @@ * perlapi.h * * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, - * 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 by Larry Wall and others + * 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021, 2022 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * - */ +*/ /* - * This file used to declare accessor functions for Perl variables - * when PERL_GLOBAL_STRUCT was enabled, but that no longer exists. - * This file is kept for backwards compatibility with XS code that - * might include it. - */ + * This file used to declare accessor functions for Perl variables when + * PERL_GLOBAL_STRUCT was enabled, but that no longer exists. This file is + * kept for backwards compatibility with XS code that might include it. +*/ #ifndef __perlapi_h__ #define __perlapi_h__ diff --git a/perlio.h b/perlio.h index 96fc6f51ccbf..afa3228f5302 100644 --- a/perlio.h +++ b/perlio.h @@ -1,11 +1,11 @@ /* perlio.h * - * Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003, - * 2004, 2005, 2006, 2007, by Larry Wall and others + * Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003, 2004, 2005, + * 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, + * 2017, 2018, 2019, 2020, 2021, 2022 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * */ #ifndef PERLIO_H_ @@ -21,7 +21,6 @@ PerlIO_xxx() are real functions defined in perlio.c which implement extra functionality required for utf8 support. - */ #ifndef USE_PERLIO @@ -32,20 +31,20 @@ # error "stdio is no longer supported as the default base layer -- use perlio." #endif -/*-------------------- End of Configure controls ---------------------------*/ +/*-------------------- End of Configure controls --------------------------- */ /* - * Although we may not want stdio to be used including here - * avoids issues where stdio.h has strange side effects - */ + * Although we may not want stdio to be used including + * here avoids issues where stdio.h has strange side effects +*/ #include #if defined(USE_64_BIT_STDIO) && defined(HAS_FTELLO) && !defined(USE_FTELL64) -#define ftell ftello +#define ftell ftello #endif #if defined(USE_64_BIT_STDIO) && defined(HAS_FSEEKO) && !defined(USE_FSEEK64) -#define fseek fseeko +#define fseek fseeko #endif /* BS2000 includes are sometimes a bit non standard :-( */ @@ -60,22 +59,22 @@ typedef struct _PerlIO PerlIOl; typedef struct _PerlIO_funcs PerlIO_funcs; typedef PerlIOl *PerlIO; -#define PerlIO PerlIO -#define PERLIO_LAYERS 1 +#define PerlIO PerlIO +#define PERLIO_LAYERS 1 /* =for apidoc_section $io =for apidoc Amu||PERLIO_FUNCS_DECL|PerlIO * ftab -Declare C to be a PerlIO function table, that is, of type -C. +Declare C to be a PerlIO function table, that is, of +type C. =for apidoc Ay|PerlIO_funcs *|PERLIO_FUNCS_CAST|PerlIO * func Cast the pointer C to be of type S>. =cut */ -#define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs -#define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs) +#define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs +#define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs) PERL_CALLCONV void PerlIO_define_layer(pTHX_ PerlIO_funcs *tab); PERL_CALLCONV PerlIO_funcs *PerlIO_find_layer(pTHX_ const char *name, @@ -88,92 +87,91 @@ PERL_CALLCONV AV* PerlIO_get_layers(pTHX_ PerlIO *f); PERL_CALLCONV void PerlIO_clone(pTHX_ PerlInterpreter *proto, CLONE_PARAMS *param); -#endif /* PerlIO */ +#endif /* PerlIO */ /* ----------- End of implementation choices ---------- */ -/* We now need to determine what happens if source trys to use stdio. - * There are three cases based on PERLIO_NOT_STDIO which XS code - * can set how it wants. +/* We now need to determine what happens if source trys to + * use stdio. There are three cases based on + * PERLIO_NOT_STDIO which XS code can set how it wants. */ #ifdef PERL_CORE -/* Make a choice for perl core code - - currently this is set to try and catch lingering raw stdio calls. - This is a known issue with some non UNIX ports which still use - "native" stdio features. -*/ +/* Make a choice for perl core code - currently this is set to try + and catch lingering raw stdio calls. This is a known issue with + some non UNIX ports which still use "native" stdio features. + */ # ifndef PERLIO_NOT_STDIO -# define PERLIO_NOT_STDIO 1 +# define PERLIO_NOT_STDIO 1 # endif #else # ifndef PERLIO_NOT_STDIO -# define PERLIO_NOT_STDIO 0 +# define PERLIO_NOT_STDIO 0 # endif #endif #ifdef PERLIO_NOT_STDIO #if PERLIO_NOT_STDIO /* - * PERLIO_NOT_STDIO #define'd as 1 - * Case 1: Strong denial of stdio - make all stdio calls (we can think of) errors - */ + * PERLIO_NOT_STDIO #define'd as 1 Case 1: Strong denial of + * stdio - make all stdio calls (we can think of) errors +*/ #include "nostdio.h" -#else /* if PERLIO_NOT_STDIO */ +#else /* if PERLIO_NOT_STDIO */ /* - * PERLIO_NOT_STDIO #define'd as 0 - * Case 2: Declares that both PerlIO and stdio can be used - */ -#endif /* if PERLIO_NOT_STDIO */ -#else /* ifdef PERLIO_NOT_STDIO */ + * PERLIO_NOT_STDIO #define'd as 0 Case 2: Declares + * that both PerlIO and stdio can be used +*/ +#endif /* if PERLIO_NOT_STDIO */ +#else /* ifdef PERLIO_NOT_STDIO */ /* - * PERLIO_NOT_STDIO not defined - * Case 3: Try and fake stdio calls as PerlIO calls - */ + * PERLIO_NOT_STDIO not defined Case 3: Try + * and fake stdio calls as PerlIO calls +*/ #include "fakesdio.h" -#endif /* ifndef PERLIO_NOT_STDIO */ +#endif /* ifndef PERLIO_NOT_STDIO */ /* ----------- fill in things that have not got #define'd ---------- */ #ifndef Fpos_t -#define Fpos_t Off_t +#define Fpos_t Off_t #endif #ifndef EOF -#define EOF (-1) +#define EOF (-1) #endif /* This is to catch case with no stdio */ #ifndef BUFSIZ -#define BUFSIZ 1024 +#define BUFSIZ 1024 #endif /* The default buffer size for the perlio buffering layer */ #ifndef PERLIOBUF_DEFAULT_BUFSIZ -#define PERLIOBUF_DEFAULT_BUFSIZ (BUFSIZ > 8192 ? BUFSIZ : 8192) +#define PERLIOBUF_DEFAULT_BUFSIZ (BUFSIZ > 8192 ? BUFSIZ : 8192) #endif #ifndef SEEK_SET -#define SEEK_SET 0 +#define SEEK_SET 0 #endif #ifndef SEEK_CUR -#define SEEK_CUR 1 +#define SEEK_CUR 1 #endif #ifndef SEEK_END -#define SEEK_END 2 +#define SEEK_END 2 #endif -#define PERLIO_DUP_CLONE 1 -#define PERLIO_DUP_FD 2 +#define PERLIO_DUP_CLONE 1 +#define PERLIO_DUP_FD 2 /* --------------------- Now prototypes for functions --------------- */ START_EXTERN_C #ifndef __attribute__format__ # ifdef HASATTRIBUTE_FORMAT -# define __attribute__format__(x,y,z) __attribute__((format(x,y,z))) +# define __attribute__format__(x,y,z) __attribute__((format(x,y,z))) # else # define __attribute__format__(x,y,z) # endif @@ -343,8 +341,8 @@ typedef struct PerlIO_list_s PerlIO_list_t; #endif END_EXTERN_C -#endif /* PERLIO_H_ */ +#endif /* PERLIO_H_ */ /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/perliol.h b/perliol.h index e247ad60dde1..14ce9eaa4d0f 100644 --- a/perliol.h +++ b/perliol.h @@ -7,105 +7,105 @@ typedef struct { } PerlIO_pair_t; struct PerlIO_list_s { - IV refcnt; - IV cur; - IV len; - PerlIO_pair_t *array; + IV refcnt; + IV cur; + IV len; + PerlIO_pair_t *array; }; struct _PerlIO_funcs { - Size_t fsize; - const char *name; - Size_t size; - U32 kind; - IV (*Pushed) (pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab); - IV (*Popped) (pTHX_ PerlIO *f); - PerlIO *(*Open) (pTHX_ PerlIO_funcs *tab, - PerlIO_list_t *layers, IV n, - const char *mode, - int fd, int imode, int perm, - PerlIO *old, int narg, SV **args); - IV (*Binmode)(pTHX_ PerlIO *f); - SV *(*Getarg) (pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags); - IV (*Fileno) (pTHX_ PerlIO *f); - PerlIO *(*Dup) (pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags); + Size_t fsize; + const char *name; + Size_t size; + U32 kind; + IV (*Pushed) (pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab); + IV (*Popped) (pTHX_ PerlIO *f); + PerlIO *(*Open) (pTHX_ PerlIO_funcs *tab, + PerlIO_list_t *layers, IV n, + const char *mode, + int fd, int imode, int perm, + PerlIO *old, int narg, SV **args); + IV (*Binmode) (pTHX_ PerlIO *f); + SV *(*Getarg) (pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags); + IV (*Fileno) (pTHX_ PerlIO *f); + PerlIO *(*Dup) (pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags); /* Unix-like functions - cf sfio line disciplines */ - SSize_t(*Read) (pTHX_ PerlIO *f, void *vbuf, Size_t count); - SSize_t(*Unread) (pTHX_ PerlIO *f, const void *vbuf, Size_t count); - SSize_t(*Write) (pTHX_ PerlIO *f, const void *vbuf, Size_t count); - IV (*Seek) (pTHX_ PerlIO *f, Off_t offset, int whence); - Off_t(*Tell) (pTHX_ PerlIO *f); - IV (*Close) (pTHX_ PerlIO *f); + SSize_t (*Read) (pTHX_ PerlIO *f, void *vbuf, Size_t count); + SSize_t (*Unread) (pTHX_ PerlIO *f, const void *vbuf, Size_t count); + SSize_t (*Write) (pTHX_ PerlIO *f, const void *vbuf, Size_t count); + IV (*Seek) (pTHX_ PerlIO *f, Off_t offset, int whence); + Off_t (*Tell) (pTHX_ PerlIO *f); + IV (*Close) (pTHX_ PerlIO *f); /* Stdio-like buffered IO functions */ - IV (*Flush) (pTHX_ PerlIO *f); - IV (*Fill) (pTHX_ PerlIO *f); - IV (*Eof) (pTHX_ PerlIO *f); - IV (*Error) (pTHX_ PerlIO *f); - void (*Clearerr) (pTHX_ PerlIO *f); - void (*Setlinebuf) (pTHX_ PerlIO *f); + IV (*Flush) (pTHX_ PerlIO *f); + IV (*Fill) (pTHX_ PerlIO *f); + IV (*Eof) (pTHX_ PerlIO *f); + IV (*Error) (pTHX_ PerlIO *f); + void (*Clearerr) (pTHX_ PerlIO *f); + void (*Setlinebuf)(pTHX_ PerlIO *f); /* Perl's snooping functions */ - STDCHAR *(*Get_base) (pTHX_ PerlIO *f); - Size_t(*Get_bufsiz) (pTHX_ PerlIO *f); - STDCHAR *(*Get_ptr) (pTHX_ PerlIO *f); - SSize_t(*Get_cnt) (pTHX_ PerlIO *f); - void (*Set_ptrcnt) (pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt); + STDCHAR *(*Get_base) (pTHX_ PerlIO *f); + Size_t (*Get_bufsiz)(pTHX_ PerlIO *f); + STDCHAR *(*Get_ptr) (pTHX_ PerlIO *f); + SSize_t (*Get_cnt) (pTHX_ PerlIO *f); + void (*Set_ptrcnt)(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt); }; -/*--------------------------------------------------------------------------------------*/ +/*---------------------------------------------------------------------------*/ /* Kind values */ -#define PERLIO_K_RAW 0x00000001 -#define PERLIO_K_BUFFERED 0x00000002 -#define PERLIO_K_CANCRLF 0x00000004 -#define PERLIO_K_FASTGETS 0x00000008 -#define PERLIO_K_DUMMY 0x00000010 -#define PERLIO_K_UTF8 0x00008000 -#define PERLIO_K_DESTRUCT 0x00010000 -#define PERLIO_K_MULTIARG 0x00020000 +#define PERLIO_K_RAW 0x00000001 +#define PERLIO_K_BUFFERED 0x00000002 +#define PERLIO_K_CANCRLF 0x00000004 +#define PERLIO_K_FASTGETS 0x00000008 +#define PERLIO_K_DUMMY 0x00000010 +#define PERLIO_K_UTF8 0x00008000 +#define PERLIO_K_DESTRUCT 0x00010000 +#define PERLIO_K_MULTIARG 0x00020000 -/*--------------------------------------------------------------------------------------*/ +/*---------------------------------------------------------------------------*/ struct _PerlIO { - PerlIOl *next; /* Lower layer */ - PerlIO_funcs *tab; /* Functions for this layer */ - U32 flags; /* Various flags for state */ - int err; /* Saved errno value */ + PerlIOl *next; /* Lower layer */ + PerlIO_funcs *tab; /* Functions for this layer */ + U32 flags; /* Various flags for state */ + int err; /* Saved errno value */ #ifdef VMS - unsigned os_err; /* Saved vaxc$errno value */ + unsigned os_err; /* Saved vaxc$errno value */ #elif defined (OS2) - unsigned long os_err; + unsigned long os_err; #elif defined (WIN32) - DWORD os_err; /* Saved GetLastError() value */ + DWORD os_err; /* Saved GetLastError() value */ #endif - PerlIOl *head; /* our ultimate parent pointer */ + PerlIOl *head; /* our ultimate parent pointer */ }; -/*--------------------------------------------------------------------------------------*/ +/*---------------------------------------------------------------------------*/ /* Flag values */ -#define PERLIO_F_EOF 0x00000100 -#define PERLIO_F_CANWRITE 0x00000200 -#define PERLIO_F_CANREAD 0x00000400 -#define PERLIO_F_ERROR 0x00000800 -#define PERLIO_F_TRUNCATE 0x00001000 -#define PERLIO_F_APPEND 0x00002000 -#define PERLIO_F_CRLF 0x00004000 -#define PERLIO_F_UTF8 0x00008000 -#define PERLIO_F_UNBUF 0x00010000 -#define PERLIO_F_WRBUF 0x00020000 -#define PERLIO_F_RDBUF 0x00040000 -#define PERLIO_F_LINEBUF 0x00080000 -#define PERLIO_F_TEMP 0x00100000 -#define PERLIO_F_OPEN 0x00200000 -#define PERLIO_F_FASTGETS 0x00400000 -#define PERLIO_F_TTY 0x00800000 -#define PERLIO_F_NOTREG 0x01000000 -#define PERLIO_F_CLEARED 0x02000000 /* layer cleared but not freed */ +#define PERLIO_F_EOF 0x00000100 +#define PERLIO_F_CANWRITE 0x00000200 +#define PERLIO_F_CANREAD 0x00000400 +#define PERLIO_F_ERROR 0x00000800 +#define PERLIO_F_TRUNCATE 0x00001000 +#define PERLIO_F_APPEND 0x00002000 +#define PERLIO_F_CRLF 0x00004000 +#define PERLIO_F_UTF8 0x00008000 +#define PERLIO_F_UNBUF 0x00010000 +#define PERLIO_F_WRBUF 0x00020000 +#define PERLIO_F_RDBUF 0x00040000 +#define PERLIO_F_LINEBUF 0x00080000 +#define PERLIO_F_TEMP 0x00100000 +#define PERLIO_F_OPEN 0x00200000 +#define PERLIO_F_FASTGETS 0x00400000 +#define PERLIO_F_TTY 0x00800000 +#define PERLIO_F_NOTREG 0x01000000 +#define PERLIO_F_CLEARED 0x02000000 /* layer cleared but not freed */ -#define PerlIOBase(f) (*(f)) +#define PerlIOBase(f) (*(f)) #define PerlIOSelf(f,type) ((type *)PerlIOBase(f)) -#define PerlIONext(f) (&(PerlIOBase(f)->next)) -#define PerlIOValid(f) ((f) && *(f)) +#define PerlIONext(f) (&(PerlIOBase(f)->next)) +#define PerlIOValid(f) ((f) && *(f)) -/*--------------------------------------------------------------------------------------*/ +/*---------------------------------------------------------------------------*/ EXTCONST PerlIO_funcs PerlIO_unix; EXTCONST PerlIO_funcs PerlIO_perlio; EXTCONST PerlIO_funcs PerlIO_stdio; @@ -116,28 +116,27 @@ EXTCONST PerlIO_funcs PerlIO_raw; EXTCONST PerlIO_funcs PerlIO_pending; PERL_CALLCONV PerlIO *PerlIO_allocate(pTHX); PERL_CALLCONV SV *PerlIO_arg_fetch(PerlIO_list_t *av, IV n); -#define PerlIOArg PerlIO_arg_fetch(layers,n) +#define PerlIOArg PerlIO_arg_fetch(layers,n) #ifdef PERLIO_USING_CRLF -#define PERLIO_STDTEXT "t" +#define PERLIO_STDTEXT "t" #else -#define PERLIO_STDTEXT "" +#define PERLIO_STDTEXT "" #endif -/*--------------------------------------------------------------------------------------*/ -/* perlio buffer layer - As this is reasonably generic its struct and "methods" are declared here - so they can be used to "inherit" from it. -*/ +/*---------------------------------------------------------------------------*/ +/* perlio buffer layer As this is reasonably generic its struct and "methods" + are declared here so they can be used to "inherit" from it. + */ typedef struct { - struct _PerlIO base; /* Base "class" info */ - STDCHAR *buf; /* Start of buffer */ - STDCHAR *end; /* End of valid part of buffer */ - STDCHAR *ptr; /* Current position in buffer */ - Off_t posn; /* Offset of buf into the file */ - Size_t bufsiz; /* Real size of buffer */ - IV oneword; /* Emergency buffer */ + struct _PerlIO base; /* Base "class" info */ + STDCHAR *buf; /* Start of buffer */ + STDCHAR *end; /* End of valid part of buffer */ + STDCHAR *ptr; /* Current position in buffer */ + Off_t posn; /* Offset of buf into the file */ + Size_t bufsiz; /* Real size of buffer */ + IV oneword; /* Emergency buffer */ } PerlIOBuf; PERL_CALLCONV int PerlIO_apply_layera(pTHX_ PerlIO *f, const char *mode, @@ -167,7 +166,7 @@ PERL_CALLCONV void PerlIO_list_free(pTHX_ PerlIO_list_t *list); * for compiling as C++. Must also match with what perl.h says. */ EXTERN_C void PerlIO_teardown(void); -/*--------------------------------------------------------------------------------------*/ +/*---------------------------------------------------------------------------*/ /* Generic, or stub layer functions */ PERL_CALLCONV IV PerlIOBase_binmode(pTHX_ PerlIO *f); @@ -276,8 +275,8 @@ PERL_CALLCONV SSize_t PerlIOUnix_write(pTHX_ PerlIO *f, const void *vbuf, Size /* Utf8 */ PERL_CALLCONV IV PerlIOUtf8_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab); -#endif /* PERLIOL_H_ */ +#endif /* PERLIOL_H_ */ /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/perlsdio.h b/perlsdio.h index 2d6b22ebbfe2..f726ebb93161 100644 --- a/perlsdio.h +++ b/perlsdio.h @@ -1,11 +1,11 @@ /* perlsdio.h * - * Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, - * 2002, 2003, 2006, 2007, 2008 by Larry Wall and others + * Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2006, + * 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, + * 2018, 2019, 2020, 2021, 2022 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * */ /* Shouldn't be possible to get here, but if we did ... */ @@ -18,4 +18,4 @@ /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/perlstatic.h b/perlstatic.h index a698de68bf5d..89465d28184b 100644 --- a/perlstatic.h +++ b/perlstatic.h @@ -1,18 +1,17 @@ /* perlstatic.h * - * 'I don't know half of you half as well as I should like; and I like less - * than half of you half as well as you deserve.' + * 'I don't know half of you half as well as I should like; and I like + * less than half of you half as well as you deserve.' * - * Copyright (C) 2020 by Larry Wall and others + * Copyright (C) 2020, 2021, 2022 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * - * This file is a home for static functions that we don't consider suitable for - * inlining, but for which giving the compiler full knowledge of may be - * advantageous. Functions that have potential tail call optimizations are a - * likely component. - + * This file is a home for static functions that we don't consider + * suitable for inlining, but for which giving the compiler full + * knowledge of may be advantageous. Functions that have potential + * tail call optimizations are a likely component. */ /* saves machine code for a common noreturn idiom typically used in Newx*() */ @@ -29,5 +28,4 @@ GCC_DIAG_RESTORE_DECL; /* * ex: set ts=8 sts=4 sw=4 et: - */ - +*/ diff --git a/perlvars.h b/perlvars.h index 02085fea4628..2ab90e002ad0 100644 --- a/perlvars.h +++ b/perlvars.h @@ -5,50 +5,49 @@ * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * */ /* =head1 Global Variables These variables are global to an entire process. They are shared between -all interpreters and all threads in a process. Any variables not documented -here may be changed or removed without notice, so don't use them! -If you feel you really do need to use an unlisted variable, first send email to -L. It may be that -someone there will point out a way to accomplish what you need without using an -internal variable. But if not, you should get a go-ahead to document and then -use the variable. +all interpreters and all threads in a process. Any variables not +documented here may be changed or removed without notice, so don't use +them! If you feel you really do need to use an unlisted variable, first +send email to L. +It may be that someone there will point out a way to accomplish what you +need without using an internal variable. But if not, you should get a +go-ahead to document and then use the variable. =cut */ /* Don't forget to re-run regen/embed.pl to propagate changes! */ -/* This file describes the "global" variables used by perl - * This used to be in perl.h directly but we want to abstract out into - * distinct files which are per-thread, per-interpreter or really global, - * and how they're initialized. +/* This file describes the "global" variables used by perl This used to be in + * perl.h directly but we want to abstract out into distinct files which are + * per-thread, per-interpreter or really global, and how they're initialized. * * The 'G' prefix is only needed for vars that need appropriate #defines - * generated in embed*.h. Such symbols are also used to generate - * the appropriate export list for win32. */ + * generated in embed*.h. Such symbols are also used to generate the + * appropriate export list for win32. */ /* global state */ #if defined(USE_ITHREADS) -PERLVAR(G, op_mutex, perl_mutex) /* Mutex for op refcounting */ +PERLVAR(G, op_mutex, perl_mutex) /* Mutex for op refcounting */ #endif -PERLVARI(G, curinterp, PerlInterpreter *, NULL) +PERLVARI(G, curinterp, PerlInterpreter *, NULL) /* currently running interpreter - * (initial parent interpreter under - * useithreads) */ + * (initial parent interpreter + * under useithreads) */ #if defined(USE_ITHREADS) -PERLVAR(G, thr_key, perl_key) /* key to retrieve per-thread struct */ +PERLVAR(G, thr_key, perl_key) /* key to retrieve per-thread struct */ #endif /* XXX does anyone even use this? */ -PERLVARI(G, do_undump, bool, FALSE) /* -u or dump seen? */ +PERLVARI(G, do_undump, bool, FALSE) /* -u or dump seen? */ -#if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS)||defined(FAKE_DEFAULT_SIGNAL_HANDLERS) +#if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS)|| \ + defined(FAKE_DEFAULT_SIGNAL_HANDLERS) PERLVARI(G, sig_handlers_initted, int, 0) #endif #ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS @@ -59,19 +58,19 @@ PERLVARA(G, sig_ignoring, SIG_SIZE, int) PERLVARA(G, sig_defaulting, SIG_SIZE, int) #endif -/* XXX signals are process-wide anyway, so we - * ignore the implications of this for threading */ +/* XXX signals are process-wide anyway, so we ignore + * the implications of this for threading */ #ifndef HAS_SIGACTION -PERLVARI(G, sig_trapped, int, 0) +PERLVARI(G, sig_trapped, int, 0) #endif #ifndef PERL_MICRO -/* If Perl has to ignore SIGPFE, this is its saved state. - * See perl.h macros PERL_FPU_INIT and PERL_FPU_{PRE,POST}_EXEC. */ +/* If Perl has to ignore SIGPFE, this is its saved state. See perl.h + * macros PERL_FPU_INIT and PERL_FPU_{PRE,POST}_EXEC. */ PERLVAR(G, sigfpe_saved, Sighandler_t) -/* these ptrs to functions are to avoid linkage problems; see - * perl-5.8.0-2193-g5c1546dc48 +/* these ptrs to functions are to avoid linkage + * problems; see perl-5.8.0-2193-g5c1546dc48 */ PERLVARI(G, csighandlerp, Sighandler_t, Perl_csighandler) PERLVARI(G, csighandler1p, Sighandler1_t, Perl_csighandler1) @@ -80,7 +79,7 @@ PERLVARI(G, csighandler3p, Sighandler3_t, Perl_csighandler3) /* This is constant on most architectures, a global on OS/2 */ #ifdef OS2 -PERLVARI(G, sh_path, char *, SH_PATH) /* full path of shell */ +PERLVARI(G, sh_path, char *, SH_PATH) /* full path of shell */ #endif #ifdef USE_PERLIO @@ -89,9 +88,11 @@ PERLVARI(G, sh_path, char *, SH_PATH) /* full path of shell */ PERLVAR(G, perlio_mutex, perl_mutex) /* Mutex for perlio fd refcounts */ # endif -PERLVARI(G, perlio_fd_refcnt, int *, 0) /* Pointer to array of fd refcounts. */ +PERLVARI(G, perlio_fd_refcnt, int *, 0) /* Pointer to array of + fd refcounts. */ PERLVARI(G, perlio_fd_refcnt_size, int, 0) /* Size of the array */ -PERLVARI(G, perlio_debug_fd, int, 0) /* the fd to write perlio debug into, 0 means not set yet */ +PERLVARI(G, perlio_debug_fd, int, 0) /* the fd to write perlio debug into, + 0 means not set yet */ #endif #ifdef HAS_MMAP @@ -99,7 +100,8 @@ PERLVARI(G, mmap_page_size, IV, 0) #endif #if defined(USE_ITHREADS) -PERLVAR(G, hints_mutex, perl_mutex) /* Mutex for refcounted he refcounting */ +PERLVAR(G, hints_mutex, perl_mutex) /* Mutex for refcounted + he refcounting */ PERLVAR(G, env_mutex, perl_RnW1_mutex_t) /* Mutex for accessing ENV */ PERLVAR(G, locale_mutex, perl_mutex) /* Mutex related to locale handling */ #endif @@ -108,46 +110,45 @@ PERLVAR(G, locale_mutex, perl_mutex) /* Mutex related to locale handling */ PERLVARI(G, C_locale_obj, locale_t, NULL) #endif -PERLVARI(G, watch_pvx, char *, NULL) +PERLVARI(G, watch_pvx, char *, NULL) /* =for apidoc AmnU|Perl_check_t *|PL_check Array, indexed by opcode, of functions that will be called for the "check" -phase of optree building during compilation of Perl code. For most (but -not all) types of op, once the op has been initially built and populated -with child ops it will be filtered through the check function referenced -by the appropriate element of this array. The new op is passed in as the -sole argument to the check function, and the check function returns the -completed op. The check function may (as the name suggests) check the op -for validity and signal errors. It may also initialise or modify parts of -the ops, or perform more radical surgery such as adding or removing child -ops, or even throw the op away and return a different op in its place. +phase of optree building during compilation of Perl code. For most (but not +all) types of op, once the op has been initially built and populated with child +ops it will be filtered through the check function referenced by the +appropriate element of this array. The new op is passed in as the sole +argument to the check function, and the check function returns the completed +op. The check function may (as the name suggests) check the op for validity +and signal errors. It may also initialise or modify parts of the ops, or +perform more radical surgery such as adding or removing child ops, or even +throw the op away and return a different op in its place. This array of function pointers is a convenient place to hook into the -compilation process. An XS module can put its own custom check function -in place of any of the standard ones, to influence the compilation of a -particular type of op. However, a custom check function must never fully -replace a standard check function (or even a custom check function from -another module). A module modifying checking must instead B the -preexisting check function. A custom check function must be selective -about when to apply its custom behaviour. In the usual case where -it decides not to do anything special with an op, it must chain the -preexisting op function. Check functions are thus linked in a chain, -with the core's base checker at the end. - -For thread safety, modules should not write directly to this array. -Instead, use the function L. +compilation process. An XS module can put its own custom check function in +place of any of the standard ones, to influence the compilation of a particular +type of op. However, a custom check function must never fully replace a +standard check function (or even a custom check function from another module). +A module modifying checking must instead B the preexisting check +function. A custom check function must be selective about when to apply its +custom behaviour. In the usual case where it decides not to do anything +special with an op, it must chain the preexisting op function. Check functions +are thus linked in a chain, with the core's base checker at the end. + +For thread safety, modules should not write directly to this array. Instead, +use the function L. =for apidoc Amn|enum perl_phase|PL_phase -A value that indicates the current Perl interpreter's phase. Possible values +A value that indicates the current Perl interpreter's phase. Possible values include C, C, C, C, C, C, and C. -For example, the following determines whether the interpreter is in -global destruction: +For example, the following determines whether the interpreter is in global +destruction: if (PL_phase == PERL_PHASE_DESTRUCT) { // we are in global destruction @@ -155,13 +156,13 @@ global destruction: C was introduced in Perl 5.14; in prior perls you can use C (boolean) to determine whether the interpreter is in global -destruction. (Use of C is discouraged since 5.14.) +destruction. (Use of C is discouraged since 5.14.) =cut */ #if defined(USE_ITHREADS) -PERLVAR(G, check_mutex, perl_mutex) /* Mutex for PL_check */ +PERLVAR(G, check_mutex, perl_mutex) /* Mutex for PL_check */ #endif /* allocate a unique index to every module that calls MY_CXT_INIT */ @@ -171,71 +172,70 @@ PERLVAR(G, check_mutex, perl_mutex) /* Mutex for PL_check */ PERLVAR(G, my_ctx_mutex, perl_mutex) PERLVARI(G, veto_switch_non_tTHX_context, int, FALSE) # endif -PERLVARI(G, my_cxt_index, int, 0) +PERLVARI(G, my_cxt_index, int, 0) #endif -/* this is currently set without MUTEX protection, so keep it a type which - * can be set atomically (ie not a bit field) */ -PERLVARI(G, veto_cleanup, int, FALSE) /* exit without cleanup */ +/* this is currently set without MUTEX protection, so keep it a + * type which can be set atomically (ie not a bit field) */ +PERLVARI(G, veto_cleanup, int, FALSE) /* exit without cleanup */ /* =for apidoc AmnUx|Perl_keyword_plugin_t|PL_keyword_plugin -Function pointer, pointing at a function used to handle extended keywords. -The function should be declared as +Function pointer, pointing at a function used to handle extended keywords. The +function should be declared as int keyword_plugin_function(pTHX_ char *keyword_ptr, STRLEN keyword_len, OP **op_ptr) -The function is called from the tokeniser, whenever a possible keyword -is seen. C points at the word in the parser's input -buffer, and C gives its length; it is not null-terminated. -The function is expected to examine the word, and possibly other state -such as L<%^H|perlvar/%^H>, to decide whether it wants to handle it -as an extended keyword. If it does not, the function should return -C, and the normal parser process will continue. - -If the function wants to handle the keyword, it first must -parse anything following the keyword that is part of the syntax -introduced by the keyword. See L for details. - -When a keyword is being handled, the plugin function must build -a tree of C structures, representing the code that was parsed. -The root of the tree must be stored in C<*op_ptr>. The function then -returns a constant indicating the syntactic role of the construct that -it has parsed: C if it is a complete statement, or -C if it is an expression. Note that a statement -construct cannot be used inside an expression (except via C -and similar), and an expression is not a complete statement (it requires -at least a terminating semicolon). - -When a keyword is handled, the plugin function may also have -(compile-time) side effects. It may modify C<%^H>, define functions, and -so on. Typically, if side effects are the main purpose of a handler, -it does not wish to generate any ops to be included in the normal -compilation. In this case it is still required to supply an op tree, -but it suffices to generate a single null op. +The function is called from the tokeniser, whenever a possible keyword is +seen. C points at the word in the parser's input buffer, and +C gives its length; it is not null-terminated. The function is +expected to examine the word, and possibly other state such as +L<%^H|perlvar/%^H>, to decide whether it wants to handle it as an extended +keyword. If it does not, the function should return C, +and the normal parser process will continue. + +If the function wants to handle the keyword, it first must parse anything +following the keyword that is part of the syntax introduced by the keyword. +See L for details. + +When a keyword is being handled, the plugin function must build a tree of C +structures, representing the code that was parsed. The root of the tree must +be stored in C<*op_ptr>. The function then returns a constant indicating the +syntactic role of the construct that it has parsed: C if +it is a complete statement, or C if it is an expression. +Note that a statement construct cannot be used inside an expression (except via +C and similar), and an expression is not a complete statement (it +requires at least a terminating semicolon). + +When a keyword is handled, the plugin function may also have (compile-time) +side effects. It may modify C<%^H>, define functions, and so on. Typically, +if side effects are the main purpose of a handler, it does not wish to generate +any ops to be included in the normal compilation. In this case it is still +required to supply an op tree, but it suffices to generate a single null op. That's how the C<*PL_keyword_plugin> function needs to behave overall. -Conventionally, however, one does not completely replace the existing -handler function. Instead, take a copy of C before -assigning your own function pointer to it. Your handler function should -look for keywords that it is interested in and handle those. Where it -is not interested, it should call the saved plugin function, passing on -the arguments it received. Thus C actually points -at a chain of handler functions, all of which have an opportunity to -handle keywords, and only the last function in the chain (built into -the Perl core) will normally return C. - -For thread safety, modules should not set this variable directly. -Instead, use the function L. +Conventionally, however, one does not completely replace the existing handler +function. Instead, take a copy of C before assigning your +own function pointer to it. Your handler function should look for keywords +that it is interested in and handle those. Where it is not interested, it +should call the saved plugin function, passing on the arguments it received. +Thus C actually points at a chain of handler functions, all +of which have an opportunity to handle keywords, and only the last function in +the chain (built into the Perl core) will normally return +C. + +For thread safety, modules should not set this variable directly. Instead, use +the function L. =cut */ #if defined(USE_ITHREADS) -PERLVAR(G, keyword_plugin_mutex, perl_mutex) /* Mutex for PL_keyword_plugin and PL_infix_plugin */ +PERLVAR(G, keyword_plugin_mutex, perl_mutex) /* Mutex for PL_keyword_plugin + and PL_infix_plugin */ #endif PERLVARI(G, keyword_plugin, Perl_keyword_plugin_t, Perl_keyword_plugin_standard) @@ -243,92 +243,92 @@ PERLVARI(G, keyword_plugin, Perl_keyword_plugin_t, Perl_keyword_plugin_standard) =for apidoc AmnUx|Perl_infix_plugin_t|PL_infix_plugin B This API exists entirely for the purpose of making the CPAN module -C work. It is not expected that additional modules will make -use of it; rather, that they should use C to provide parsing -of new infix operators. +C work. It is not expected that additional modules will +make use of it; rather, that they should use C to provide +parsing of new infix operators. Function pointer, pointing at a function used to handle extended infix -operators. The function should be declared as +operators. The function should be declared as int infix_plugin_function(pTHX_ char *opname, STRLEN oplen, struct Perl_custom_infix **infix_ptr) The function is called from the tokenizer whenever a possible infix operator -is seen. C points to the operator name in the parser's input buffer, +is seen. C points to the operator name in the parser's input buffer, and C gives the I number of bytes of it that should be -consumed; it is not null-terminated. The function is expected to examine the +consumed; it is not null-terminated. The function is expected to examine the operator name and possibly other state such as L<%^H|perlvar/%^H>, to determine whether it wants to handle the operator name. -As compared to the single stage of C, parsing of additional -infix operators occurs in three separate stages. This is because of the more -complex interactions it has with the parser, to ensure that operator -precedence rules work correctly. These stages are co-ordinated by the use of -an additional information structure. +As compared to the single stage of C, parsing of +additional infix operators occurs in three separate stages. This is because +of the more complex interactions it has with the parser, to ensure that +operator precedence rules work correctly. These stages are co-ordinated by +the use of an additional information structure. If the function wants to handle the infix operator, it must set the variable pointed to by C to the address of a structure that provides this -additional information about the subsequent parsing stages. If it does not, +additional information about the subsequent parsing stages. If it does not, it should make a call to the next function in the chain. This structure has the following definition: - struct Perl_custom_infix { - enum Perl_custom_infix_precedence prec; - void (*parse)(pTHX_ SV **opdata, - struct Perl_custom_infix *); - OP *(*build_op)(pTHX_ SV **opdata, OP *lhs, OP *rhs, - struct Perl_custom_infix *); - }; + struct Perl_custom_infix { + enum Perl_custom_infix_precedence prec; + void (*parse)(pTHX_ SV **opdata, + struct Perl_custom_infix *); + OP *(*build_op)(pTHX_ SV **opdata, OP *lhs, OP *rhs, + struct Perl_custom_infix *); + }; The function must then return an integer giving the number of bytes consumed -by the name of this operator. In the case of an operator whose name is -composed of identifier characters, this must be equal to C. In the case -of an operator named by non-identifier characters, this is permitted to be -shorter than C, and any additional characters after it will not be +by the name of this operator. In the case of an operator whose name is +composed of identifier characters, this must be equal to C. In the +case of an operator named by non-identifier characters, this is permitted to +be shorter than C, and any additional characters after it will not be claimed by the infix operator but instead will be consumed by the tokenizer and parser as normal. -If the optional C function is provided, it is called immediately by the -parser to let the operator's definition consume any additional syntax from the -source code. This should I be used for normal operand parsing, but it may -be useful when implementing things like parametric operators or meta-operators -that consume more syntax themselves. This function may use the variable -pointed to by C to provide an SV containing additional data to be -passed into the C function later on. +If the optional C function is provided, it is called immediately by +the parser to let the operator's definition consume any additional syntax +from the source code. This should I be used for normal operand parsing, +but it may be useful when implementing things like parametric operators or +meta-operators that consume more syntax themselves. This function may use +the variable pointed to by C to provide an SV containing additional +data to be passed into the C function later on. The information structure gives the operator precedence level in the C -field. This is used to tell the parser how much of the surrounding syntax +field. This is used to tell the parser how much of the surrounding syntax before and after should be considered as operands to the operator. The tokenizer and parser will then continue to operate as normal until enough additional input has been parsed to form both the left- and right-hand side -operands to the operator, according to the precedence level. At this point the -C function is called, being passed the left- and right-hand operands -as optree fragments. It is expected to combine them into the resulting optree -fragment, which it should return. +operands to the operator, according to the precedence level. At this point +the C function is called, being passed the left- and right-hand +operands as optree fragments. It is expected to combine them into the +resulting optree fragment, which it should return. After the C function has returned, if the variable pointed to by -C was set to a non-C value, it will then be destroyed by calling -C. +C was set to a non-C value, it will then be destroyed by +calling C. -For thread safety, modules should not set this variable directly. -Instead, use the function L. +For thread safety, modules should not set this variable directly. Instead, +use the function L. -However, that all said, the introductory note above still applies. This +However, that all said, the introductory note above still applies. This variable is provided in core perl only for the benefit of the -C module. That module acts as a central registry for infix +C module. That module acts as a central registry for infix operators, automatically handling things like deparse support and discovery/reflection, and these abilities only work because it knows all the -registered operators. Other modules should not use this interpreter variable -directly to implement them because then those central features would no longer -work properly. +registered operators. Other modules should not use this interpreter variable +directly to implement them because then those central features would no +longer work properly. Furthermore, it is likely that this (experimental) API will be replaced in a future Perl version by a more complete API that fully implements the central registry and other semantics currently provided by C, once -the module has had sufficient experimental testing time. This current +the module has had sufficient experimental testing time. This current mechanism exists only as an interim measure to get to that stage. =cut @@ -336,44 +336,46 @@ mechanism exists only as an interim measure to get to that stage. PERLVARI(G, infix_plugin, Perl_infix_plugin_t, Perl_infix_plugin_standard) -PERLVARI(G, op_sequence, HV *, NULL) /* dump.c */ -PERLVARI(G, op_seq, UV, 0) /* dump.c */ +PERLVARI(G, op_sequence, HV *, NULL) /* dump.c */ +PERLVARI(G, op_seq, UV, 0) /* dump.c */ #ifdef USE_ITHREADS PERLVAR(G, dollarzero_mutex, perl_mutex) /* Modifying $0 */ #endif -/* Restricted hashes placeholder value. - In theory, the contents are never used, only the address. - In practice, &PL_sv_placeholder is returned by some APIs, and the calling - code is checking SvOK(). */ +/* Restricted hashes placeholder value. In theory, the contents are never + used, only the address. In practice, &PL_sv_placeholder is returned by + some APIs, and the calling code is checking SvOK(). */ PERLVAR(G, sv_placeholder, SV) #if defined(MYMALLOC) && defined(USE_ITHREADS) -PERLVAR(G, malloc_mutex, perl_mutex) /* Mutex for malloc */ +PERLVAR(G, malloc_mutex, perl_mutex) /* Mutex for malloc */ #endif -PERLVARI(G, hash_seed_set, bool, FALSE) /* perl.c */ -PERLVARA(G, hash_seed_w, PERL_HASH_SEED_WORDS, PVT__PERL_HASH_WORD_TYPE) /* perl.c and hv.h */ +PERLVARI(G, hash_seed_set, bool, FALSE) /* perl.c */ +PERLVARA(G, hash_seed_w, PERL_HASH_SEED_WORDS, PVT__PERL_HASH_WORD_TYPE) \ + /* perl.c and hv.h */ #if defined(PERL_HASH_STATE_BYTES) -PERLVARA(G, hash_state_w, PERL_HASH_STATE_WORDS, PVT__PERL_HASH_WORD_TYPE) /* perl.c and hv.h */ +PERLVARA(G, hash_state_w, PERL_HASH_STATE_WORDS, PVT__PERL_HASH_WORD_TYPE) \ + /* perl.c and hv.h */ #endif #if defined(PERL_USE_SINGLE_CHAR_HASH_CACHE) -#define PERL_SINGLE_CHAR_HASH_CACHE_ELEMS ((1+256) * sizeof(U32)) -PERLVARA(G, hash_chars, PERL_SINGLE_CHAR_HASH_CACHE_ELEMS, unsigned char) /* perl.c and hv.h */ +#define PERL_SINGLE_CHAR_HASH_CACHE_ELEMS ((1+256) * sizeof(U32)) +PERLVARA(G, hash_chars, PERL_SINGLE_CHAR_HASH_CACHE_ELEMS, unsigned char) \ + /* perl.c and hv.h */ #endif -/* The path separator can vary depending on whether we're running under DCL or - * a Unix shell. +/* The path separator can vary depending on whether + * we're running under DCL or a Unix shell. */ #ifdef __VMS PERLVAR(G, perllib_sep, char) #endif -/* Definitions of user-defined \p{} properties, as the subs that define them - * are only called once */ -PERLVARI(G, user_def_props, HV *, NULL) +/* Definitions of user-defined \p{} properties, as the + * subs that define them are only called once */ +PERLVARI(G, user_def_props, HV *, NULL) #if defined(USE_ITHREADS) PERLVAR(G, user_def_props_aTHX, PerlInterpreter *) /* aTHX that user_def_props @@ -383,20 +385,20 @@ PERLVAR(G, user_prop_mutex, perl_mutex) /* Mutex for manipulating #endif /* these record the best way to perform certain IO operations while - * atomically setting FD_CLOEXEC. On the first call, a probe is done - * and the result recorded for use by subsequent calls. - * In theory these variables aren't thread-safe, but the worst that can - * happen is that two treads will both do an initial probe + * atomically setting FD_CLOEXEC. On the first call, a probe is + * done and the result recorded for use by subsequent calls. In + * theory these variables aren't thread-safe, but the worst that + * can happen is that two treads will both do an initial probe */ -PERLVARI(G, strategy_dup, int, 0) /* doio.c */ -PERLVARI(G, strategy_dup2, int, 0) /* doio.c */ -PERLVARI(G, strategy_open, int, 0) /* doio.c */ -PERLVARI(G, strategy_open3, int, 0) /* doio.c */ -PERLVARI(G, strategy_mkstemp, int, 0) /* doio.c */ -PERLVARI(G, strategy_socket, int, 0) /* doio.c */ -PERLVARI(G, strategy_accept, int, 0) /* doio.c */ -PERLVARI(G, strategy_pipe, int, 0) /* doio.c */ -PERLVARI(G, strategy_socketpair, int, 0) /* doio.c */ +PERLVARI(G, strategy_dup, int, 0) /* doio.c */ +PERLVARI(G, strategy_dup2, int, 0) /* doio.c */ +PERLVARI(G, strategy_open, int, 0) /* doio.c */ +PERLVARI(G, strategy_open3, int, 0) /* doio.c */ +PERLVARI(G, strategy_mkstemp, int, 0) /* doio.c */ +PERLVARI(G, strategy_socket, int, 0) /* doio.c */ +PERLVARI(G, strategy_accept, int, 0) /* doio.c */ +PERLVARI(G, strategy_pipe, int, 0) /* doio.c */ +PERLVARI(G, strategy_socketpair, int, 0) /* doio.c */ PERLVARI(G, my_environ, char **, NULL) PERLVARI(G, origenviron, char **, NULL) diff --git a/pp.h b/pp.h index 65d07ce4d9fc..dfd7027ecb03 100644 --- a/pp.h +++ b/pp.h @@ -1,21 +1,22 @@ /* pp.h * - * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, - * 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others + * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, + * 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, + * 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021, 2022 by + * Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * */ -#define PP(s) OP * Perl_##s(pTHX) +#define PP(s) OP * Perl_##s(pTHX) /* =for apidoc_section $stack =for apidoc AmnU||SP -Stack pointer. This is usually handled by C. See C> and -C. +Stack pointer. This is usually handled by C. See C> +and C. =for apidoc AmnU||MARK Stack marker variable for the XSUB. See C>. @@ -25,19 +26,19 @@ Opening bracket for arguments on a callback. See C> and L. =for apidoc Amn;||dSP -Declares a local copy of perl's stack pointer for the XSUB, available via -the C macro. See C>. +Declares a local copy of perl's stack pointer for the XSUB, available +via the C macro. See C>. =for apidoc m;||djSP -Declare Just C. This is actually identical to C, and declares -a local copy of perl's stack pointer, available via the C macro. -See C>. (Available for backward source code compatibility with -the old (Perl 5.005) thread model.) +Declare Just C. This is actually identical to C, and +declares a local copy of perl's stack pointer, available via the +C macro. See C>. (Available for backward source +code compatibility with the old (Perl 5.005) thread model.) =for apidoc Amn;||dMARK -Declare a stack marker variable, C, for the XSUB. See C> and -C>. +Declare a stack marker variable, C, for the XSUB. See +C> and C>. =for apidoc Amn;||dORIGMARK Saves the original stack mark for the XSUB. See C>. @@ -51,56 +52,58 @@ Refetch the stack pointer. Used after a callback. See L. =cut */ #undef SP /* Solaris 2.7 i386 has this in /usr/include/sys/reg.h */ -#define SP sp -#define MARK mark +#define SP sp +#define MARK mark /* =for apidoc Amn;||TARG -C is short for "target". It is an entry in the pad that an OPs -C refers to. It is scratchpad space, often used as a return -value for the OP, but some use it for other purposes. +C is short for "target". It is an entry in the pad that an +OPs C refers to. It is scratchpad space, often used as +a return value for the OP, but some use it for other purposes. =cut */ -#define TARG targ - -#define PUSHMARK(p) \ - STMT_START { \ - I32 * mark_stack_entry; \ - if (UNLIKELY((mark_stack_entry = ++PL_markstack_ptr) \ - == PL_markstack_max)) \ - mark_stack_entry = markstack_grow(); \ - *mark_stack_entry = (I32)((p) - PL_stack_base); \ - DEBUG_s(DEBUG_v(PerlIO_printf(Perl_debug_log, \ - "MARK push %p %" IVdf "\n", \ - PL_markstack_ptr, (IV)*mark_stack_entry))); \ +#define TARG targ + +#define PUSHMARK(p) \ + STMT_START { \ + I32 * mark_stack_entry; \ + if (UNLIKELY((mark_stack_entry = ++PL_markstack_ptr) \ + == PL_markstack_max)) \ + mark_stack_entry = markstack_grow(); \ + *mark_stack_entry = (I32)((p) - PL_stack_base); \ + DEBUG_s(DEBUG_v(PerlIO_printf(Perl_debug_log, \ + "MARK push %p %" IVdf "\n", \ + PL_markstack_ptr, (IV)*mark_stack_entry))); \ } STMT_END -#define TOPMARK Perl_TOPMARK(aTHX) -#define POPMARK Perl_POPMARK(aTHX) +#define TOPMARK Perl_TOPMARK(aTHX) +#define POPMARK Perl_POPMARK(aTHX) -#define INCMARK \ - STMT_START { \ - DEBUG_s(DEBUG_v(PerlIO_printf(Perl_debug_log, \ - "MARK inc %p %" IVdf "\n", \ - (PL_markstack_ptr+1), (IV)*(PL_markstack_ptr+1)))); \ - PL_markstack_ptr++; \ +#define INCMARK \ + STMT_START { \ + DEBUG_s(DEBUG_v(PerlIO_printf(Perl_debug_log, \ + "MARK inc %p %" IVdf "\n", \ + (PL_markstack_ptr+1), (IV)*(PL_markstack_ptr+1)))); \ + PL_markstack_ptr++; \ } STMT_END -#define dSP SV **sp = PL_stack_sp -#define djSP dSP -#define dMARK SV **mark = PL_stack_base + POPMARK -#define dORIGMARK const I32 origmark = (I32)(mark - PL_stack_base) -#define ORIGMARK (PL_stack_base + origmark) +#define dSP SV **sp = PL_stack_sp +#define djSP dSP +#define dMARK SV **mark = PL_stack_base + POPMARK +#define dORIGMARK const I32 origmark = (I32)(mark - PL_stack_base) +#define ORIGMARK (PL_stack_base + origmark) -#define SPAGAIN sp = PL_stack_sp -#define MSPAGAIN STMT_START { sp = PL_stack_sp; mark = ORIGMARK; } STMT_END +#define SPAGAIN sp = PL_stack_sp +#define MSPAGAIN \ + STMT_START { sp = PL_stack_sp; mark = ORIGMARK; } STMT_END -#define GETTARGETSTACKED targ = (PL_op->op_flags & OPf_STACKED ? POPs : PAD_SV(PL_op->op_targ)) -#define dTARGETSTACKED SV * GETTARGETSTACKED +#define GETTARGETSTACKED \ + targ = (PL_op->op_flags & OPf_STACKED ? POPs : PAD_SV(PL_op->op_targ)) +#define dTARGETSTACKED SV * GETTARGETSTACKED -#define GETTARGET targ = PAD_SV(PL_op->op_targ) +#define GETTARGET targ = PAD_SV(PL_op->op_targ) /* =for apidoc Amn;||dTARGET @@ -108,15 +111,16 @@ Declare that this function uses C, and initializes it =cut */ -#define dTARGET SV * GETTARGET +#define dTARGET SV * GETTARGET -#define GETATARGET targ = (PL_op->op_flags & OPf_STACKED ? sp[-1] : PAD_SV(PL_op->op_targ)) -#define dATARGET SV * GETATARGET +#define GETATARGET \ + targ = (PL_op->op_flags & OPf_STACKED ? sp[-1] : PAD_SV(PL_op->op_targ)) +#define dATARGET SV * GETATARGET -#define dTARG SV *targ +#define dTARG SV *targ -#define NORMAL PL_op->op_next -#define DIE return Perl_die +#define NORMAL PL_op->op_next +#define DIE return Perl_die /* =for apidoc Amn;||PUTBACK @@ -134,7 +138,8 @@ Pops a string off the stack. Identical to POPp. There are two names for historical reasons. =for apidoc Amn|char*|POPpbytex -Pops a string off the stack which must consist of bytes i.e. characters < 256. +Pops a string off the stack which must consist of bytes i.e. characters < +256. =for apidoc Amn|NV|POPn Pops a double off the stack. @@ -154,51 +159,51 @@ Pops an unsigned long off the stack. =cut */ -#define PUTBACK PL_stack_sp = sp -#define RETURN return (PUTBACK, NORMAL) -#define RETURNOP(o) return (PUTBACK, o) -#define RETURNX(x) return (x, PUTBACK, NORMAL) - -#define POPs (*sp--) -#define POPp POPpx -#define POPpx (SvPVx_nolen(POPs)) -#define POPpconstx (SvPVx_nolen_const(POPs)) -#define POPpbytex (SvPVbytex_nolen(POPs)) -#define POPn (SvNVx(POPs)) -#define POPi ((IV)SvIVx(POPs)) -#define POPu ((UV)SvUVx(POPs)) -#define POPl ((long)SvIVx(POPs)) -#define POPul ((unsigned long)SvIVx(POPs)) - -#define TOPs (*sp) -#define TOPm1s (*(sp-1)) -#define TOPp1s (*(sp+1)) -#define TOPp TOPpx -#define TOPpx (SvPV_nolen(TOPs)) -#define TOPn (SvNV(TOPs)) -#define TOPi ((IV)SvIV(TOPs)) -#define TOPu ((UV)SvUV(TOPs)) -#define TOPl ((long)SvIV(TOPs)) -#define TOPul ((unsigned long)SvUV(TOPs)) +#define PUTBACK PL_stack_sp = sp +#define RETURN return (PUTBACK, NORMAL) +#define RETURNOP(o) return (PUTBACK, o) +#define RETURNX(x) return (x, PUTBACK, NORMAL) + +#define POPs (*sp--) +#define POPp POPpx +#define POPpx (SvPVx_nolen(POPs)) +#define POPpconstx (SvPVx_nolen_const(POPs)) +#define POPpbytex (SvPVbytex_nolen(POPs)) +#define POPn (SvNVx(POPs)) +#define POPi ((IV)SvIVx(POPs)) +#define POPu ((UV)SvUVx(POPs)) +#define POPl ((long)SvIVx(POPs)) +#define POPul ((unsigned long)SvIVx(POPs)) + +#define TOPs (*sp) +#define TOPm1s (*(sp-1)) +#define TOPp1s (*(sp+1)) +#define TOPp TOPpx +#define TOPpx (SvPV_nolen(TOPs)) +#define TOPn (SvNV(TOPs)) +#define TOPi ((IV)SvIV(TOPs)) +#define TOPu ((UV)SvUV(TOPs)) +#define TOPl ((long)SvIV(TOPs)) +#define TOPul ((unsigned long)SvUV(TOPs)) /* Go to some pains in the rare event that we must extend the stack. */ /* =for apidoc Am|void|EXTEND|SP|SSize_t nitems -Used to extend the argument stack for an XSUB's return values. Once -used, guarantees that there is room for at least C to be pushed -onto the stack. +Used to extend the argument stack for an XSUB's return values. Once used, +guarantees that there is room for at least C to be pushed onto the +stack. =for apidoc Am|void|PUSHs|SV* sv -Push an SV onto the stack. The stack must have room for this element. -Does not handle 'set' magic. Does not use C. See also -C>, C>, and C>. +Push an SV onto the stack. The stack must have room for this element. Does +not handle 'set' magic. Does not use C. See also C>, +C>, and C>. =for apidoc Am|void|PUSHp|char* str|STRLEN len -Push a string onto the stack. The stack must have room for this element. -The C indicates the length of the string. Handles 'set' magic. Uses -C, so C or C should be called to declare it. Do not -call multiple C-oriented macros to return lists from XSUB's - see +Push a string onto the stack. The stack must have room for this element. The +C indicates the length of the string. Handles 'set' magic. Uses C, +so C or C should be called to declare it. Do not call +multiple C-oriented macros to return lists from XSUB's - see C> instead. See also C> and C>. =for apidoc Am|void|PUSHpvs|"literal string" @@ -208,64 +213,62 @@ directly. =for apidoc Am|void|PUSHn|NV nv Push a double onto the stack. The stack must have room for this element. Handles 'set' magic. Uses C, so C or C should be -called to declare it. Do not call multiple C-oriented macros to -return lists from XSUB's - see C> instead. See also C> -and C>. +called to declare it. Do not call multiple C-oriented macros to return +lists from XSUB's - see C> instead. See also C> and +C>. =for apidoc Am|void|PUSHi|IV iv Push an integer onto the stack. The stack must have room for this element. Handles 'set' magic. Uses C, so C or C should be -called to declare it. Do not call multiple C-oriented macros to -return lists from XSUB's - see C> instead. See also C> -and C>. +called to declare it. Do not call multiple C-oriented macros to return +lists from XSUB's - see C> instead. See also C> and +C>. =for apidoc Am|void|PUSHu|UV uv Push an unsigned integer onto the stack. The stack must have room for this element. Handles 'set' magic. Uses C, so C or C -should be called to declare it. Do not call multiple C-oriented -macros to return lists from XSUB's - see C> instead. See also +should be called to declare it. Do not call multiple C-oriented macros +to return lists from XSUB's - see C> instead. See also C> and C>. =for apidoc Am|void|XPUSHs|SV* sv -Push an SV onto the stack, extending the stack if necessary. Does not -handle 'set' magic. Does not use C. See also C>, -C and C. +Push an SV onto the stack, extending the stack if necessary. Does not handle +'set' magic. Does not use C. See also C>, C and +C. =for apidoc Am|void|XPUSHp|char* str|STRLEN len Push a string onto the stack, extending the stack if necessary. The C indicates the length of the string. Handles 'set' magic. Uses C, so -C or C should be called to declare it. Do not call -multiple C-oriented macros to return lists from XSUB's - see -C> instead. See also C> and C>. +C or C should be called to declare it. Do not call multiple +C-oriented macros to return lists from XSUB's - see C> +instead. See also C> and C>. =for apidoc Am|void|XPUSHpvs|"literal string" A variation on C that takes a literal string and calculates its size directly. =for apidoc Am|void|XPUSHn|NV nv -Push a double onto the stack, extending the stack if necessary. Handles -'set' magic. Uses C, so C or C should be called to -declare it. Do not call multiple C-oriented macros to return lists -from XSUB's - see C> instead. See also C> and -C>. +Push a double onto the stack, extending the stack if necessary. Handles 'set' +magic. Uses C, so C or C should be called to declare +it. Do not call multiple C-oriented macros to return lists from XSUB's - +see C> instead. See also C> and C>. =for apidoc Am|void|XPUSHi|IV iv Push an integer onto the stack, extending the stack if necessary. Handles 'set' magic. Uses C, so C or C should be called to -declare it. Do not call multiple C-oriented macros to return lists -from XSUB's - see C> instead. See also C> and -C>. +declare it. Do not call multiple C-oriented macros to return lists from +XSUB's - see C> instead. See also C> and C>. =for apidoc Am|void|XPUSHu|UV uv Push an unsigned integer onto the stack, extending the stack if necessary. Handles 'set' magic. Uses C, so C or C should be -called to declare it. Do not call multiple C-oriented macros to -return lists from XSUB's - see C> instead. See also C> and +called to declare it. Do not call multiple C-oriented macros to return +lists from XSUB's - see C> instead. See also C> and C>. =for apidoc Am|void|mPUSHs|SV* sv -Push an SV onto the stack and mortalizes the SV. The stack must have room -for this element. Does not use C. See also C> and +Push an SV onto the stack and mortalizes the SV. The stack must have room for +this element. Does not use C. See also C> and C>. =for apidoc Amn|void|PUSHmortal @@ -274,21 +277,22 @@ element. Does not use C. See also C>, C> and C>. =for apidoc Am|void|mPUSHp|char* str|STRLEN len -Push a string onto the stack. The stack must have room for this element. -The C indicates the length of the string. Does not use C. -See also C>, C> and C>. +Push a string onto the stack. The stack must have room for this element. The +C indicates the length of the string. Does not use C. See also +C>, C> and C>. =for apidoc Am|void|mPUSHpvs|"literal string" A variation on C that takes a literal string and calculates its size directly. =for apidoc Am|void|mPUSHn|NV nv -Push a double onto the stack. The stack must have room for this element. -Does not use C. See also C>, C> and C>. +Push a double onto the stack. The stack must have room for this element. Does +not use C. See also C>, C> and C>. =for apidoc Am|void|mPUSHi|IV iv Push an integer onto the stack. The stack must have room for this element. -Does not use C. See also C>, C> and C>. +Does not use C. See also C>, C> and +C>. =for apidoc Am|void|mPUSHu|UV uv Push an unsigned integer onto the stack. The stack must have room for this @@ -296,13 +300,12 @@ element. Does not use C. See also C>, C> and C>. =for apidoc Am|void|mXPUSHs|SV* sv -Push an SV onto the stack, extending the stack if necessary and mortalizes -the SV. Does not use C. See also C> and C>. +Push an SV onto the stack, extending the stack if necessary and mortalizes the +SV. Does not use C. See also C> and C>. =for apidoc Amn|void|XPUSHmortal -Push a new mortal SV onto the stack, extending the stack if necessary. -Does not use C. See also C>, C> and -C>. +Push a new mortal SV onto the stack, extending the stack if necessary. Does +not use C. See also C>, C> and C>. =for apidoc Am|void|mXPUSHp|char* str|STRLEN len Push a string onto the stack, extending the stack if necessary. The C @@ -314,12 +317,12 @@ A variation on C that takes a literal string and calculates its size directly. =for apidoc Am|void|mXPUSHn|NV nv -Push a double onto the stack, extending the stack if necessary. -Does not use C. See also C>, C> and C>. +Push a double onto the stack, extending the stack if necessary. Does not use +C. See also C>, C> and C>. =for apidoc Am|void|mXPUSHi|IV iv -Push an integer onto the stack, extending the stack if necessary. -Does not use C. See also C>, C> and C>. +Push an integer onto the stack, extending the stack if necessary. Does not use +C. See also C>, C> and C>. =for apidoc Am|void|mXPUSHu|UV uv Push an unsigned integer onto the stack, extending the stack if necessary. @@ -332,56 +335,55 @@ Does not use C. See also C>, C> and C>. * requested to be extended (which is likely to be less than PL_stack_max) */ #if defined DEBUGGING && !defined DEBUGGING_RE_ONLY -# define EXTEND_HWM_SET(p, n) \ - STMT_START { \ - SSize_t extend_hwm_set_ix = (p) - PL_stack_base + (n); \ - if (extend_hwm_set_ix > PL_curstackinfo->si_stack_hwm) \ - PL_curstackinfo->si_stack_hwm = extend_hwm_set_ix; \ - } STMT_END +# define EXTEND_HWM_SET(p, n) \ + STMT_START { \ + SSize_t extend_hwm_set_ix = (p) - PL_stack_base + (n); \ + if (extend_hwm_set_ix > PL_curstackinfo->si_stack_hwm) \ + PL_curstackinfo->si_stack_hwm = extend_hwm_set_ix; \ + } STMT_END #else -# define EXTEND_HWM_SET(p, n) NOOP +# define EXTEND_HWM_SET(p, n) NOOP #endif -/* _EXTEND_SAFE_N(n): private helper macro for EXTEND(). - * Tests whether the value of n would be truncated when implicitly cast to - * SSize_t as an arg to stack_grow(). If so, sets it to -1 instead to - * trigger a panic. It will be constant folded on platforms where this - * can't happen. +/* _EXTEND_SAFE_N(n): private helper macro for EXTEND(). Tests whether + * the value of n would be truncated when implicitly cast to SSize_t as an + * arg to stack_grow(). If so, sets it to -1 instead to trigger a panic. + * It will be constant folded on platforms where this can't happen. */ -#define _EXTEND_SAFE_N(n) \ - (sizeof(n) > sizeof(SSize_t) && ((SSize_t)(n) != (n)) ? -1 : (n)) +#define _EXTEND_SAFE_N(n) \ + (sizeof(n) > sizeof(SSize_t) && ((SSize_t)(n) != (n)) ? -1 : (n)) #ifdef STRESS_REALLOC -# define EXTEND_SKIP(p, n) EXTEND_HWM_SET(p, n) +# define EXTEND_SKIP(p, n) EXTEND_HWM_SET(p, n) -# define EXTEND(p,n) STMT_START { \ - sp = stack_grow(sp,p,_EXTEND_SAFE_N(n)); \ - PERL_UNUSED_VAR(sp); \ - } STMT_END +# define EXTEND(p,n) \ + STMT_START { \ + sp = stack_grow(sp,p,_EXTEND_SAFE_N(n)); \ + PERL_UNUSED_VAR(sp); \ + } STMT_END /* Same thing, but update mark register too. */ -# define MEXTEND(p,n) STMT_START { \ - const SSize_t markoff = mark - PL_stack_base; \ - sp = stack_grow(sp,p,_EXTEND_SAFE_N(n)); \ - mark = PL_stack_base + markoff; \ - PERL_UNUSED_VAR(sp); \ - } STMT_END +# define MEXTEND(p,n) \ + STMT_START { \ + const SSize_t markoff = mark - PL_stack_base; \ + sp = stack_grow(sp,p,_EXTEND_SAFE_N(n)); \ + mark = PL_stack_base + markoff; \ + PERL_UNUSED_VAR(sp); \ + } STMT_END #else -/* _EXTEND_NEEDS_GROW(p,n): private helper macro for EXTEND(). - * Tests to see whether n is too big and we need to grow the stack. Be - * very careful if modifying this. There are many ways to get things wrong - * (wrapping, truncating etc) that could cause a false negative and cause - * the call to stack_grow() to be skipped. On the other hand, false - * positives are safe. - * Bear in mind that sizeof(p) may be less than, equal to, or greater +/* _EXTEND_NEEDS_GROW(p,n): private helper macro for EXTEND(). Tests to see + * whether n is too big and we need to grow the stack. Be very careful if + * modifying this. There are many ways to get things wrong (wrapping, + * truncating etc) that could cause a false negative and cause the call to + * stack_grow() to be skipped. On the other hand, false positives are + * safe. Bear in mind that sizeof(p) may be less than, equal to, or greater * than sizeof(n), and while n is documented to be signed, someone might - * pass an unsigned value or expression. In general don't use casts to - * avoid warnings; instead expect the caller to fix their code. - * It is legal for p to be greater than PL_stack_max. - * If the allocated stack is already very large but current usage is - * small, then PL_stack_max - p might wrap round to a negative value, but - * this just gives a safe false positive + * pass an unsigned value or expression. In general don't use casts to + * avoid warnings; instead expect the caller to fix their code. It is legal + * for p to be greater than PL_stack_max. If the allocated stack is already + * very large but current usage is small, then PL_stack_max - p might wrap + * round to a negative value, but this just gives a safe false positive */ # define _EXTEND_NEEDS_GROW(p,n) ((n) < 0 || PL_stack_max - (p) < (n)) @@ -389,252 +391,258 @@ Does not use C. See also C>, C> and C>. /* EXTEND_SKIP(): used for where you would normally call EXTEND(), but * you know for sure that a previous op will have already extended the - * stack sufficiently. For example pp_enteriter ensures that there - * is always at least 1 free slot, so pp_iter can return &PL_sv_yes/no - * without checking each time. Calling EXTEND_SKIP() defeats the HWM + * stack sufficiently. For example pp_enteriter ensures that there is + * always at least 1 free slot, so pp_iter can return &PL_sv_yes/no + * without checking each time. Calling EXTEND_SKIP() defeats the HWM * debugging mechanism which would otherwise whine */ -# define EXTEND_SKIP(p, n) STMT_START { \ - EXTEND_HWM_SET(p, n); \ - assert(!_EXTEND_NEEDS_GROW(p,n)); \ - } STMT_END - - -# define EXTEND(p,n) STMT_START { \ - EXTEND_HWM_SET(p, n); \ - if (UNLIKELY(_EXTEND_NEEDS_GROW(p,n))) { \ - sp = stack_grow(sp,p,_EXTEND_SAFE_N(n)); \ - PERL_UNUSED_VAR(sp); \ - } \ - } STMT_END +# define EXTEND_SKIP(p, n) \ + STMT_START { \ + EXTEND_HWM_SET(p, n); \ + assert(!_EXTEND_NEEDS_GROW(p,n)); \ + } STMT_END + + +# define EXTEND(p,n) \ + STMT_START { \ + EXTEND_HWM_SET(p, n); \ + if (UNLIKELY(_EXTEND_NEEDS_GROW(p,n))) { \ + sp = stack_grow(sp,p,_EXTEND_SAFE_N(n)); \ + PERL_UNUSED_VAR(sp); \ + } \ + } STMT_END /* Same thing, but update mark register too. */ -# define MEXTEND(p,n) STMT_START { \ - EXTEND_HWM_SET(p, n); \ - if (UNLIKELY(_EXTEND_NEEDS_GROW(p,n))) { \ - const SSize_t markoff = mark - PL_stack_base;\ - sp = stack_grow(sp,p,_EXTEND_SAFE_N(n)); \ - mark = PL_stack_base + markoff; \ - PERL_UNUSED_VAR(sp); \ - } \ - } STMT_END +# define MEXTEND(p,n) \ + STMT_START { \ + EXTEND_HWM_SET(p, n); \ + if (UNLIKELY(_EXTEND_NEEDS_GROW(p,n))) { \ + const SSize_t markoff = mark - PL_stack_base; \ + sp = stack_grow(sp,p,_EXTEND_SAFE_N(n)); \ + mark = PL_stack_base + markoff; \ + PERL_UNUSED_VAR(sp); \ + } \ + } STMT_END #endif -/* set TARG to the IV value i. If do_taint is false, +/* set TARG to the IV value i. If do_taint is false, * assume that PL_tainted can never be true */ -#define TARGi(i, do_taint) \ - STMT_START { \ - IV TARGi_iv = i; \ - if (LIKELY( \ - ((SvFLAGS(TARG) & (SVTYPEMASK|SVf_THINKFIRST|SVf_IVisUV)) == SVt_IV) \ - & (do_taint ? !TAINT_get : 1))) \ - { \ - /* Cheap SvIOK_only(). \ - * Assert that flags which SvIOK_only() would test or \ - * clear can't be set, because we're SVt_IV */ \ - assert(!(SvFLAGS(TARG) & \ - (SVf_OOK|SVf_UTF8|(SVf_OK & ~(SVf_IOK|SVp_IOK))))); \ - SvFLAGS(TARG) |= (SVf_IOK|SVp_IOK); \ - /* SvIV_set() where sv_any points to head */ \ - TARG->sv_u.svu_iv = TARGi_iv; \ - } \ - else \ - sv_setiv_mg(targ, TARGi_iv); \ +#define TARGi(i, do_taint) \ + STMT_START { \ + IV TARGi_iv = i; \ + if (LIKELY( \ + ((SvFLAGS(TARG) & (SVTYPEMASK|SVf_THINKFIRST|SVf_IVisUV)) == SVt_IV) \ + & (do_taint ? !TAINT_get : 1))) \ + { \ + /* Cheap SvIOK_only(). Assert that flags which SvIOK_only() would \ + * test or clear can't be set, because we're SVt_IV */ \ + assert(!(SvFLAGS(TARG) & \ + (SVf_OOK|SVf_UTF8|(SVf_OK & ~(SVf_IOK|SVp_IOK))))); \ + SvFLAGS(TARG) |= (SVf_IOK|SVp_IOK); \ + /* SvIV_set() where sv_any points to head */ \ + TARG->sv_u.svu_iv = TARGi_iv; \ + } \ + else \ + sv_setiv_mg(targ, TARGi_iv); \ } STMT_END -/* set TARG to the UV value u. If do_taint is false, +/* set TARG to the UV value u. If do_taint is false, * assume that PL_tainted can never be true */ -#define TARGu(u, do_taint) \ - STMT_START { \ - UV TARGu_uv = u; \ - if (LIKELY( \ - ((SvFLAGS(TARG) & (SVTYPEMASK|SVf_THINKFIRST|SVf_IVisUV)) == SVt_IV) \ - & (do_taint ? !TAINT_get : 1) \ - & (TARGu_uv <= (UV)IV_MAX))) \ - { \ - /* Cheap SvIOK_only(). \ - * Assert that flags which SvIOK_only() would test or \ - * clear can't be set, because we're SVt_IV */ \ - assert(!(SvFLAGS(TARG) & \ - (SVf_OOK|SVf_UTF8|(SVf_OK & ~(SVf_IOK|SVp_IOK))))); \ - SvFLAGS(TARG) |= (SVf_IOK|SVp_IOK); \ - /* SvIV_set() where sv_any points to head */ \ - TARG->sv_u.svu_iv = TARGu_uv; \ - } \ - else \ - sv_setuv_mg(targ, TARGu_uv); \ +#define TARGu(u, do_taint) \ + STMT_START { \ + UV TARGu_uv = u; \ + if (LIKELY( \ + ((SvFLAGS(TARG) & (SVTYPEMASK|SVf_THINKFIRST|SVf_IVisUV)) == SVt_IV) \ + & (do_taint ? !TAINT_get : 1) \ + & (TARGu_uv <= (UV)IV_MAX))) \ + { \ + /* Cheap SvIOK_only(). Assert that flags which SvIOK_only() would \ + * test or clear can't be set, because we're SVt_IV */ \ + assert(!(SvFLAGS(TARG) & \ + (SVf_OOK|SVf_UTF8|(SVf_OK & ~(SVf_IOK|SVp_IOK))))); \ + SvFLAGS(TARG) |= (SVf_IOK|SVp_IOK); \ + /* SvIV_set() where sv_any points to head */ \ + TARG->sv_u.svu_iv = TARGu_uv; \ + } \ + else \ + sv_setuv_mg(targ, TARGu_uv); \ } STMT_END -/* set TARG to the NV value n. If do_taint is false, +/* set TARG to the NV value n. If do_taint is false, * assume that PL_tainted can never be true */ -#define TARGn(n, do_taint) \ - STMT_START { \ - NV TARGn_nv = n; \ - if (LIKELY( \ - ((SvFLAGS(TARG) & (SVTYPEMASK|SVf_THINKFIRST)) == SVt_NV) \ - & (do_taint ? !TAINT_get : 1))) \ - { \ - /* Cheap SvNOK_only(). \ - * Assert that flags which SvNOK_only() would test or \ - * clear can't be set, because we're SVt_NV */ \ - assert(!(SvFLAGS(TARG) & \ - (SVf_OOK|SVf_UTF8|(SVf_OK & ~(SVf_NOK|SVp_NOK))))); \ - SvFLAGS(TARG) |= (SVf_NOK|SVp_NOK); \ - SvNV_set(TARG, TARGn_nv); \ - } \ - else \ - sv_setnv_mg(targ, TARGn_nv); \ +#define TARGn(n, do_taint) \ + STMT_START { \ + NV TARGn_nv = n; \ + if (LIKELY( \ + ((SvFLAGS(TARG) & (SVTYPEMASK|SVf_THINKFIRST)) == SVt_NV) \ + & (do_taint ? !TAINT_get : 1))) \ + { \ + /* Cheap SvNOK_only(). Assert that flags which SvNOK_only() would \ + * test or clear can't be set, because we're SVt_NV */ \ + assert(!(SvFLAGS(TARG) & \ + (SVf_OOK|SVf_UTF8|(SVf_OK & ~(SVf_NOK|SVp_NOK))))); \ + SvFLAGS(TARG) |= (SVf_NOK|SVp_NOK); \ + SvNV_set(TARG, TARGn_nv); \ + } \ + else \ + sv_setnv_mg(targ, TARGn_nv); \ } STMT_END -#define PUSHs(s) (*++sp = (s)) -#define PUSHTARG STMT_START { SvSETMAGIC(TARG); PUSHs(TARG); } STMT_END -#define PUSHp(p,l) STMT_START { sv_setpvn(TARG, (p), (l)); PUSHTARG; } STMT_END +#define PUSHs(s) (*++sp = (s)) +#define PUSHTARG STMT_START { SvSETMAGIC(TARG); PUSHs(TARG); } STMT_END +#define PUSHp(p,l) \ + STMT_START { sv_setpvn(TARG, (p), (l)); PUSHTARG; } STMT_END #define PUSHpvs(s) PUSHp("" s "", sizeof(s)-1) -#define PUSHn(n) STMT_START { TARGn(n,1); PUSHs(TARG); } STMT_END -#define PUSHi(i) STMT_START { TARGi(i,1); PUSHs(TARG); } STMT_END -#define PUSHu(u) STMT_START { TARGu(u,1); PUSHs(TARG); } STMT_END - -#define XPUSHs(s) STMT_START { EXTEND(sp,1); *++sp = (s); } STMT_END -#define XPUSHTARG STMT_START { SvSETMAGIC(TARG); XPUSHs(TARG); } STMT_END -#define XPUSHp(p,l) STMT_START { sv_setpvn(TARG, (p), (l)); XPUSHTARG; } STMT_END +#define PUSHn(n) STMT_START { TARGn(n,1); PUSHs(TARG); } STMT_END +#define PUSHi(i) STMT_START { TARGi(i,1); PUSHs(TARG); } STMT_END +#define PUSHu(u) STMT_START { TARGu(u,1); PUSHs(TARG); } STMT_END + +#define XPUSHs(s) STMT_START { EXTEND(sp,1); *++sp = (s); } STMT_END +#define XPUSHTARG STMT_START { SvSETMAGIC(TARG); XPUSHs(TARG); } STMT_END +#define XPUSHp(p,l) \ + STMT_START { sv_setpvn(TARG, (p), (l)); XPUSHTARG; } STMT_END #define XPUSHpvs(s) XPUSHp("" s "", sizeof(s)-1) -#define XPUSHn(n) STMT_START { TARGn(n,1); XPUSHs(TARG); } STMT_END -#define XPUSHi(i) STMT_START { TARGi(i,1); XPUSHs(TARG); } STMT_END -#define XPUSHu(u) STMT_START { TARGu(u,1); XPUSHs(TARG); } STMT_END -#define XPUSHundef STMT_START { SvOK_off(TARG); XPUSHs(TARG); } STMT_END - -#define mPUSHs(s) PUSHs(sv_2mortal(s)) -#define PUSHmortal PUSHs(sv_newmortal()) -#define mPUSHp(p,l) PUSHs(newSVpvn_flags((p), (l), SVs_TEMP)) +#define XPUSHn(n) STMT_START { TARGn(n,1); XPUSHs(TARG); } STMT_END +#define XPUSHi(i) STMT_START { TARGi(i,1); XPUSHs(TARG); } STMT_END +#define XPUSHu(u) STMT_START { TARGu(u,1); XPUSHs(TARG); } STMT_END +#define XPUSHundef STMT_START { SvOK_off(TARG); XPUSHs(TARG); } STMT_END + +#define mPUSHs(s) PUSHs(sv_2mortal(s)) +#define PUSHmortal PUSHs(sv_newmortal()) +#define mPUSHp(p,l) PUSHs(newSVpvn_flags((p), (l), SVs_TEMP)) #define mPUSHpvs(s) mPUSHp("" s "", sizeof(s)-1) -#define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n)) -#define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i)) -#define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u)) +#define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n)) +#define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i)) +#define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u)) -#define mXPUSHs(s) XPUSHs(sv_2mortal(s)) -#define XPUSHmortal XPUSHs(sv_newmortal()) -#define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); mPUSHp((p), (l)); } STMT_END +#define mXPUSHs(s) XPUSHs(sv_2mortal(s)) +#define XPUSHmortal XPUSHs(sv_newmortal()) +#define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); mPUSHp((p), (l)); } STMT_END #define mXPUSHpvs(s) mXPUSHp("" s "", sizeof(s)-1) -#define mXPUSHn(n) STMT_START { EXTEND(sp,1); mPUSHn(n); } STMT_END -#define mXPUSHi(i) STMT_START { EXTEND(sp,1); mPUSHi(i); } STMT_END -#define mXPUSHu(u) STMT_START { EXTEND(sp,1); mPUSHu(u); } STMT_END - -#define SETs(s) (*sp = s) -#define SETTARG STMT_START { SvSETMAGIC(TARG); SETs(TARG); } STMT_END -#define SETp(p,l) STMT_START { sv_setpvn(TARG, (p), (l)); SETTARG; } STMT_END -#define SETn(n) STMT_START { TARGn(n,1); SETs(TARG); } STMT_END -#define SETi(i) STMT_START { TARGi(i,1); SETs(TARG); } STMT_END -#define SETu(u) STMT_START { TARGu(u,1); SETs(TARG); } STMT_END - -#define dTOPss SV *sv = TOPs -#define dPOPss SV *sv = POPs -#define dTOPnv NV value = TOPn -#define dPOPnv NV value = POPn -#define dPOPnv_nomg NV value = (sp--, SvNV_nomg(TOPp1s)) -#define dTOPiv IV value = TOPi -#define dPOPiv IV value = POPi -#define dTOPuv UV value = TOPu -#define dPOPuv UV value = POPu - -#define dPOPXssrl(X) SV *right = POPs; SV *left = CAT2(X,s) -#define dPOPXnnrl(X) NV right = POPn; NV left = CAT2(X,n) -#define dPOPXiirl(X) IV right = POPi; IV left = CAT2(X,i) - -#define USE_LEFT(sv) \ - (SvOK(sv) || !(PL_op->op_flags & OPf_STACKED)) -#define dPOPXiirl_ul_nomg(X) \ - IV right = (sp--, SvIV_nomg(TOPp1s)); \ - SV *leftsv = CAT2(X,s); \ +#define mXPUSHn(n) STMT_START { EXTEND(sp,1); mPUSHn(n); } STMT_END +#define mXPUSHi(i) STMT_START { EXTEND(sp,1); mPUSHi(i); } STMT_END +#define mXPUSHu(u) STMT_START { EXTEND(sp,1); mPUSHu(u); } STMT_END + +#define SETs(s) (*sp = s) +#define SETTARG STMT_START { SvSETMAGIC(TARG); SETs(TARG); } STMT_END +#define SETp(p,l) \ + STMT_START { sv_setpvn(TARG, (p), (l)); SETTARG; } STMT_END +#define SETn(n) STMT_START { TARGn(n,1); SETs(TARG); } STMT_END +#define SETi(i) STMT_START { TARGi(i,1); SETs(TARG); } STMT_END +#define SETu(u) STMT_START { TARGu(u,1); SETs(TARG); } STMT_END + +#define dTOPss SV *sv = TOPs +#define dPOPss SV *sv = POPs +#define dTOPnv NV value = TOPn +#define dPOPnv NV value = POPn +#define dPOPnv_nomg NV value = (sp--, SvNV_nomg(TOPp1s)) +#define dTOPiv IV value = TOPi +#define dPOPiv IV value = POPi +#define dTOPuv UV value = TOPu +#define dPOPuv UV value = POPu + +#define dPOPXssrl(X) SV *right = POPs; SV *left = CAT2(X,s) +#define dPOPXnnrl(X) NV right = POPn; NV left = CAT2(X,n) +#define dPOPXiirl(X) IV right = POPi; IV left = CAT2(X,i) + +#define USE_LEFT(sv) \ + (SvOK(sv) || !(PL_op->op_flags & OPf_STACKED)) +#define dPOPXiirl_ul_nomg(X) \ + IV right = (sp--, SvIV_nomg(TOPp1s)); \ + SV *leftsv = CAT2(X,s); \ IV left = USE_LEFT(leftsv) ? SvIV_nomg(leftsv) : 0 -#define dPOPPOPssrl dPOPXssrl(POP) -#define dPOPPOPnnrl dPOPXnnrl(POP) -#define dPOPPOPiirl dPOPXiirl(POP) +#define dPOPPOPssrl dPOPXssrl(POP) +#define dPOPPOPnnrl dPOPXnnrl(POP) +#define dPOPPOPiirl dPOPXiirl(POP) -#define dPOPTOPssrl dPOPXssrl(TOP) -#define dPOPTOPnnrl dPOPXnnrl(TOP) -#define dPOPTOPnnrl_nomg \ +#define dPOPTOPssrl dPOPXssrl(TOP) +#define dPOPTOPnnrl dPOPXnnrl(TOP) +#define dPOPTOPnnrl_nomg \ NV right = SvNV_nomg(TOPs); NV left = (sp--, SvNV_nomg(TOPs)) -#define dPOPTOPiirl dPOPXiirl(TOP) +#define dPOPTOPiirl dPOPXiirl(TOP) #define dPOPTOPiirl_ul_nomg dPOPXiirl_ul_nomg(TOP) -#define dPOPTOPiirl_nomg \ +#define dPOPTOPiirl_nomg \ IV right = SvIV_nomg(TOPs); IV left = (sp--, SvIV_nomg(TOPs)) -#define RETPUSHYES RETURNX(PUSHs(&PL_sv_yes)) -#define RETPUSHNO RETURNX(PUSHs(&PL_sv_no)) -#define RETPUSHUNDEF RETURNX(PUSHs(&PL_sv_undef)) +#define RETPUSHYES RETURNX(PUSHs(&PL_sv_yes)) +#define RETPUSHNO RETURNX(PUSHs(&PL_sv_no)) +#define RETPUSHUNDEF RETURNX(PUSHs(&PL_sv_undef)) -#define RETSETYES RETURNX(SETs(&PL_sv_yes)) -#define RETSETNO RETURNX(SETs(&PL_sv_no)) -#define RETSETUNDEF RETURNX(SETs(&PL_sv_undef)) -#define RETSETTARG STMT_START { SETTARG; RETURN; } STMT_END +#define RETSETYES RETURNX(SETs(&PL_sv_yes)) +#define RETSETNO RETURNX(SETs(&PL_sv_no)) +#define RETSETUNDEF RETURNX(SETs(&PL_sv_undef)) +#define RETSETTARG STMT_START { SETTARG; RETURN; } STMT_END -#define ARGTARG PL_op->op_targ +#define ARGTARG PL_op->op_targ -#define MAXARG (PL_op->op_private & OPpARG4_MASK) +#define MAXARG (PL_op->op_private & OPpARG4_MASK) -#define SWITCHSTACK(f,t) \ - STMT_START { \ - AvFILLp(f) = sp - PL_stack_base; \ - PL_stack_base = AvARRAY(t); \ - PL_stack_max = PL_stack_base + AvMAX(t); \ - sp = PL_stack_sp = PL_stack_base + AvFILLp(t); \ - PL_curstack = t; \ +#define SWITCHSTACK(f,t) \ + STMT_START { \ + AvFILLp(f) = sp - PL_stack_base; \ + PL_stack_base = AvARRAY(t); \ + PL_stack_max = PL_stack_base + AvMAX(t); \ + sp = PL_stack_sp = PL_stack_base + AvFILLp(t); \ + PL_curstack = t; \ } STMT_END -#define EXTEND_MORTAL(n) \ - STMT_START { \ - SSize_t eMiX = PL_tmps_ix + (n); \ - if (UNLIKELY(eMiX >= PL_tmps_max)) \ - (void)Perl_tmps_grow_p(aTHX_ eMiX); \ +#define EXTEND_MORTAL(n) \ + STMT_START { \ + SSize_t eMiX = PL_tmps_ix + (n); \ + if (UNLIKELY(eMiX >= PL_tmps_max)) \ + (void)Perl_tmps_grow_p(aTHX_ eMiX); \ } STMT_END -#define AMGf_noright 1 -#define AMGf_noleft 2 -#define AMGf_assign 4 /* op supports mutator variant, e.g. $x += 1 */ -#define AMGf_unary 8 -#define AMGf_numeric 0x10 /* for Perl_try_amagic_bin */ +#define AMGf_noright 1 +#define AMGf_noleft 2 +#define AMGf_assign 4 /* op supports mutator variant, + e.g. $x += 1 */ +#define AMGf_unary 8 +#define AMGf_numeric 0x10 /* for Perl_try_amagic_bin */ -#define AMGf_want_list 0x40 -#define AMGf_numarg 0x80 +#define AMGf_want_list 0x40 +#define AMGf_numarg 0x80 /* do SvGETMAGIC on the stack args before checking for overload */ -#define tryAMAGICun_MG(method, flags) STMT_START { \ - if ( UNLIKELY((SvFLAGS(TOPs) & (SVf_ROK|SVs_GMG))) \ +#define tryAMAGICun_MG(method, flags) \ + STMT_START { \ + if ( UNLIKELY((SvFLAGS(TOPs) & (SVf_ROK|SVs_GMG))) \ && Perl_try_amagic_un(aTHX_ method, flags)) \ - return NORMAL; \ + return NORMAL; \ } STMT_END -#define tryAMAGICbin_MG(method, flags) STMT_START { \ - if ( UNLIKELY(((SvFLAGS(TOPm1s)|SvFLAGS(TOPs)) & (SVf_ROK|SVs_GMG))) \ - && Perl_try_amagic_bin(aTHX_ method, flags)) \ - return NORMAL; \ +#define tryAMAGICbin_MG(method, flags) \ + STMT_START { \ + if ( UNLIKELY(((SvFLAGS(TOPm1s)|SvFLAGS(TOPs)) & (SVf_ROK|SVs_GMG))) \ + && Perl_try_amagic_bin(aTHX_ method, flags)) \ + return NORMAL; \ } STMT_END -#define AMG_CALLunary(sv,meth) \ +#define AMG_CALLunary(sv,meth) \ amagic_call(sv,&PL_sv_undef, meth, AMGf_noright | AMGf_unary) -/* No longer used in core. Use AMG_CALLunary instead */ +/* No longer used in core. Use AMG_CALLunary instead */ #define AMG_CALLun(sv,meth) AMG_CALLunary(sv, CAT2(meth,_amg)) -#define tryAMAGICunTARGETlist(meth, jump) \ - STMT_START { \ - dSP; \ - SV *tmpsv; \ - SV *arg= *sp; \ - U8 gimme = GIMME_V; \ - if (UNLIKELY(SvAMAGIC(arg) && \ - (tmpsv = amagic_call(arg, &PL_sv_undef, meth, \ - AMGf_want_list | AMGf_noright \ +#define tryAMAGICunTARGETlist(meth, jump) \ + STMT_START { \ + dSP; \ + SV *tmpsv; \ + SV *arg= *sp; \ + U8 gimme = GIMME_V; \ + if (UNLIKELY(SvAMAGIC(arg) && \ + (tmpsv = amagic_call(arg, &PL_sv_undef, meth, \ + AMGf_want_list | AMGf_noright \ |AMGf_unary)))) \ - { \ - SPAGAIN; \ + { \ + SPAGAIN; \ if (gimme == G_VOID) { \ NOOP; \ } \ - else if (gimme == G_LIST) { \ + else if (gimme == G_LIST) { \ SSize_t i; \ SSize_t len; \ assert(SvTYPE(tmpsv) == SVt_PVAV); \ @@ -651,75 +659,75 @@ Does not use C. See also C>, C> and C>. sp--; \ SETTARG; \ } \ - PUTBACK; \ - if (jump) { \ + PUTBACK; \ + if (jump) { \ OP *jump_o = NORMAL->op_next; \ - while (jump_o->op_type == OP_NULL) \ - jump_o = jump_o->op_next; \ - assert(jump_o->op_type == OP_ENTERSUB); \ - (void)POPMARK; \ - return jump_o->op_next; \ - } \ - return NORMAL; \ - } \ + while (jump_o->op_type == OP_NULL) \ + jump_o = jump_o->op_next; \ + assert(jump_o->op_type == OP_ENTERSUB); \ + (void)POPMARK; \ + return jump_o->op_next; \ + } \ + return NORMAL; \ + } \ } STMT_END -/* This is no longer used anywhere in the core. You might wish to consider - calling amagic_deref_call() directly, as it has a cleaner interface. */ -#define tryAMAGICunDEREF(meth) \ - STMT_START { \ - sv = amagic_deref_call(*sp, CAT2(meth,_amg)); \ - SPAGAIN; \ +/* This is no longer used anywhere in the core. You might wish to consider + calling amagic_deref_call() directly, as it has a cleaner interface. */ +#define tryAMAGICunDEREF(meth) \ + STMT_START { \ + sv = amagic_deref_call(*sp, CAT2(meth,_amg)); \ + SPAGAIN; \ } STMT_END /* 2019: no longer used in core */ -#define opASSIGN (PL_op->op_flags & OPf_STACKED) +#define opASSIGN (PL_op->op_flags & OPf_STACKED) /* =for apidoc mnU||LVRET True if this op will be the return value of an lvalue subroutine =cut */ -#define LVRET ((PL_op->op_private & OPpMAYBE_LVSUB) && is_lvalue_sub()) +#define LVRET ((PL_op->op_private & OPpMAYBE_LVSUB) && is_lvalue_sub()) -#define SvCANEXISTDELETE(sv) \ - (!SvRMAGICAL(sv) \ - || !(mg = mg_find((const SV *) sv, PERL_MAGIC_tied)) \ - || ( (stash = SvSTASH(SvRV(SvTIED_obj(MUTABLE_SV(sv), mg)))) \ - && gv_fetchmethod_autoload(stash, "EXISTS", TRUE) \ - && gv_fetchmethod_autoload(stash, "DELETE", TRUE) \ - ) \ - ) +#define SvCANEXISTDELETE(sv) \ + (!SvRMAGICAL(sv) \ + || !(mg = mg_find((const SV *) sv, PERL_MAGIC_tied)) \ + || ( (stash = SvSTASH(SvRV(SvTIED_obj(MUTABLE_SV(sv), mg)))) \ + && gv_fetchmethod_autoload(stash, "EXISTS", TRUE) \ + && gv_fetchmethod_autoload(stash, "DELETE", TRUE) \ + ) \ + ) #ifdef PERL_CORE -/* These are just for Perl_tied_method(), which is not part of the public API. - Use 0x04 rather than the next available bit, to help the compiler if the - architecture can generate more efficient instructions. */ -# define TIED_METHOD_MORTALIZE_NOT_NEEDED 0x04 -# define TIED_METHOD_ARGUMENTS_ON_STACK 0x08 -# define TIED_METHOD_SAY 0x10 +/* These are just for Perl_tied_method(), which is not part of the public + API. Use 0x04 rather than the next available bit, to help the compiler + if the architecture can generate more efficient instructions. */ +# define TIED_METHOD_MORTALIZE_NOT_NEEDED 0x04 +# define TIED_METHOD_ARGUMENTS_ON_STACK 0x08 +# define TIED_METHOD_SAY 0x10 /* Used in various places that need to dereference a glob or globref */ -# define MAYBE_DEREF_GV_flags(sv,phlags) \ - ( \ - (void)(((phlags) & SV_GMAGIC) && (SvGETMAGIC(sv),0)), \ - isGV_with_GP(sv) \ - ? (GV *)(sv) \ - : SvROK(sv) && SvTYPE(SvRV(sv)) <= SVt_PVLV && \ - (SvGETMAGIC(SvRV(sv)), isGV_with_GP(SvRV(sv))) \ - ? (GV *)SvRV(sv) \ - : NULL \ - ) -# define MAYBE_DEREF_GV(sv) MAYBE_DEREF_GV_flags(sv,SV_GMAGIC) +# define MAYBE_DEREF_GV_flags(sv,phlags) \ + ( \ + (void)(((phlags) & SV_GMAGIC) && (SvGETMAGIC(sv),0)), \ + isGV_with_GP(sv) \ + ? (GV *)(sv) \ + : SvROK(sv) && SvTYPE(SvRV(sv)) <= SVt_PVLV && \ + (SvGETMAGIC(SvRV(sv)), isGV_with_GP(SvRV(sv))) \ + ? (GV *)SvRV(sv) \ + : NULL \ + ) +# define MAYBE_DEREF_GV(sv) MAYBE_DEREF_GV_flags(sv,SV_GMAGIC) # define MAYBE_DEREF_GV_nomg(sv) MAYBE_DEREF_GV_flags(sv,0) -# define FIND_RUNCV_padid_eq 1 -# define FIND_RUNCV_level_eq 2 +# define FIND_RUNCV_padid_eq 1 +# define FIND_RUNCV_level_eq 2 #endif /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/regcomp.h b/regcomp.h index 532c5e1327ad..1b33f6ee2b22 100644 --- a/regcomp.h +++ b/regcomp.h @@ -1,28 +1,29 @@ /* regcomp.h * * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, - * 2000, 2001, 2002, 2003, 2005, 2006, 2007, by Larry Wall and others + * 2000, 2001, 2002, 2003, 2005, 2006, 2007, 2008, 2009, 2010, 2011, + * 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021, 2022 by + * Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * */ -#if ! defined(PERL_REGCOMP_H_) && ( defined(PERL_CORE) \ - || defined(PERL_EXT_RE_BUILD)) +#if ! defined(PERL_REGCOMP_H_) && ( defined(PERL_CORE) \ + || defined(PERL_EXT_RE_BUILD)) #define PERL_REGCOMP_H_ #include "regcharclass.h" /* Convert branch sequences to more efficient trie ops? */ -#define PERL_ENABLE_TRIE_OPTIMISATION 1 +#define PERL_ENABLE_TRIE_OPTIMISATION 1 /* Be really aggressive about optimising patterns with trie sequences? */ -#define PERL_ENABLE_EXTENDED_TRIE_OPTIMISATION 1 +#define PERL_ENABLE_EXTENDED_TRIE_OPTIMISATION 1 /* Should the optimiser take positive assertions into account? */ -#define PERL_ENABLE_POSITIVE_ASSERTION_STUDY 0 +#define PERL_ENABLE_POSITIVE_ASSERTION_STUDY 0 /* Not for production use: */ #define PERL_ENABLE_EXPERIMENTAL_REGEX_OPTIMISATIONS 0 @@ -31,18 +32,18 @@ * Structure for regexp "program". This is essentially a linear encoding * of a nondeterministic finite-state machine (aka syntax charts or * "railroad normal form" in parsing technology). Each node is an opcode - * plus a "next" pointer, possibly plus an operand. "Next" pointers of - * all nodes except BRANCH implement concatenation; a "next" pointer with - * a BRANCH on both ends of it is connecting two alternatives. (Here we - * have one of the subtle syntax dependencies: an individual BRANCH (as - * opposed to a collection of them) is never concatenated with anything - * because of operator precedence.) The operand of some types of node is - * a literal string; for others, it is a node leading into a sub-FSM. In - * particular, the operand of a BRANCH node is the first node of the branch. - * (NB this is *not* a tree structure: the tail of the branch connects - * to the thing following the set of BRANCHes.) The opcodes are defined - * in regnodes.h which is generated from regcomp.sym by regcomp.pl. - */ + * plus a "next" pointer, possibly plus an operand. "Next" pointers of all + * nodes except BRANCH implement concatenation; a "next" pointer with a + * BRANCH on both ends of it is connecting two alternatives. (Here we have + * one of the subtle syntax dependencies: an individual BRANCH (as opposed + * to a collection of them) is never concatenated with anything because of + * operator precedence.) The operand of some types of node is a literal + * string; for others, it is a node leading into a sub-FSM. In particular, + * the operand of a BRANCH node is the first node of the branch. (NB this + * is *not* a tree structure: the tail of the branch connects to the thing + * following the set of BRANCHes.) The opcodes are defined in regnodes.h + * which is generated from regcomp.sym by regcomp.pl. +*/ /* * A node is one char of opcode followed by two chars of "next" pointer. @@ -51,136 +52,142 @@ * An operand, if any, simply follows the node. (Note that much of the * code generation knows about this implicit relationship.) * - * Using two bytes for the "next" pointer is vast overkill for most things, - * but allows patterns to get big without disasters. + * Using two bytes for the "next" pointer is vast overkill for most + * things, but allows patterns to get big without disasters. * - * [The "next" pointer is always aligned on an even - * boundary, and reads the offset directly as a short.] - */ + * [The "next" pointer is always aligned on an even boundary, and reads + * the offset directly as a short.] +*/ /* This is the stuff that used to live in regexp.h that was truly - private to the engine itself. It now lives here. */ + private to the engine itself. It now lives here. */ typedef struct regexp_internal { - regnode *regstclass; /* Optional startclass as identified or constructed - by the optimiser */ - struct reg_data *data; /* Additional miscellaneous data used by the program. - Used to make it easier to clone and free arbitrary - data that the regops need. Often the ARG field of - a regop is an index into this structure. NOTE the - 0th element of this structure is NEVER used and is - strictly reserved for internal purposes. */ - struct reg_code_blocks *code_blocks;/* positions of literal (?{}) */ - U32 proglen; /* size of the compiled program in regnodes */ - U32 name_list_idx; /* Optional data index of an array of paren names, - only valid when RXp_PAREN_NAMES(prog) is true, - 0 means "no value" like any other index into the - data array.*/ - regnode program[1]; /* Unwarranted chumminess with compiler. */ + regnode *regstclass; /* Optional startclass as + identified or constructed + by the optimiser */ + struct reg_data *data; /* Additional miscellaneous data + used by the program. Used to + make it easier to clone and free + arbitrary data that the regops + need. Often the ARG field of a + regop is an index into this + structure. NOTE the 0th element + of this structure is NEVER used + and is strictly reserved for + internal purposes. */ + struct reg_code_blocks *code_blocks; /* positions of literal (?{}) */ + U32 proglen; /* size of the compiled program + in regnodes */ + U32 name_list_idx; /* Optional data index of an array + of paren names, only valid when + RXp_PAREN_NAMES(prog) is true, 0 + means "no value" like any other + index into the data array. */ + regnode program[1]; /* Unwarranted chumminess + with compiler. */ } regexp_internal; -#define RXi_SET(x,y) (x)->pprivate = (void*)(y) -#define RXi_GET(x) ((regexp_internal *)((x)->pprivate)) -#define RXi_GET_DECL(r,ri) regexp_internal *ri = RXi_GET(r) +#define RXi_SET(x,y) (x)->pprivate = (void*)(y) +#define RXi_GET(x) ((regexp_internal *)((x)->pprivate)) +#define RXi_GET_DECL(r,ri) regexp_internal *ri = RXi_GET(r) #define RXi_GET_DECL_NULL(r,ri) regexp_internal *ri = (r) ? RXi_GET(r) : NULL /* - * Flags stored in regexp->intflags - * These are used only internally to the regexp engine + * Flags stored in regexp->intflags These are used only + * internally to the regexp engine * * See regexp.h for flags used externally to the regexp engine - */ -#define RXp_INTFLAGS(rx) ((rx)->intflags) -#define RX_INTFLAGS(prog) RXp_INTFLAGS(ReANY(prog)) - -#define PREGf_SKIP 0x00000001 -#define PREGf_IMPLICIT 0x00000002 /* Converted .* to ^.* */ -#define PREGf_NAUGHTY 0x00000004 /* how exponential is this pattern? */ -#define PREGf_VERBARG_SEEN 0x00000008 -#define PREGf_CUTGROUP_SEEN 0x00000010 -#define PREGf_USE_RE_EVAL 0x00000020 /* compiled with "use re 'eval'" */ +*/ +#define RXp_INTFLAGS(rx) ((rx)->intflags) +#define RX_INTFLAGS(prog) RXp_INTFLAGS(ReANY(prog)) + +#define PREGf_SKIP 0x00000001 +#define PREGf_IMPLICIT 0x00000002 /* Converted .* to ^.* */ +#define PREGf_NAUGHTY 0x00000004 /* how exponential is this pattern? */ +#define PREGf_VERBARG_SEEN 0x00000008 +#define PREGf_CUTGROUP_SEEN 0x00000010 +#define PREGf_USE_RE_EVAL 0x00000020 /* compiled with "use re 'eval'" */ /* these used to be extflags, but are now intflags */ -#define PREGf_NOSCAN 0x00000040 +#define PREGf_NOSCAN 0x00000040 /* spare */ -#define PREGf_GPOS_SEEN 0x00000100 -#define PREGf_GPOS_FLOAT 0x00000200 +#define PREGf_GPOS_SEEN 0x00000100 +#define PREGf_GPOS_FLOAT 0x00000200 -#define PREGf_ANCH_MBOL 0x00000400 -#define PREGf_ANCH_SBOL 0x00000800 -#define PREGf_ANCH_GPOS 0x00001000 -#define PREGf_RECURSE_SEEN 0x00002000 -#define PREGf_PESSIMIZE_SEEN 0x00004000 +#define PREGf_ANCH_MBOL 0x00000400 +#define PREGf_ANCH_SBOL 0x00000800 +#define PREGf_ANCH_GPOS 0x00001000 +#define PREGf_RECURSE_SEEN 0x00002000 +#define PREGf_PESSIMIZE_SEEN 0x00004000 -#define PREGf_ANCH \ +#define PREGf_ANCH \ ( PREGf_ANCH_SBOL | PREGf_ANCH_GPOS | PREGf_ANCH_MBOL ) /* this is where the old regcomp.h started */ -/* Define the various regnode structures. These all should be a multiple - * of 32 bits large, and they should by and large correspond with each other - * in terms of naming, etc. Things can and will break in subtle ways if you - * change things without care. If you look at regexp.h you will see it +/* Define the various regnode structures. These all should be a multiple of + * 32 bits large, and they should by and large correspond with each other in + * terms of naming, etc. Things can and will break in subtle ways if you + * change things without care. If you look at regexp.h you will see it * contains this: * - * struct regnode { - * U8 flags; - * U8 type; - * U16 next_off; - * }; + * struct regnode { U8 flags; U8 type; U16 next_off; }; * - * This structure is the base unit of elements in the regexp program. When + * This structure is the base unit of elements in the regexp program. When * we increment our way through the program we increment by the size of this * structure, and in all cases where regnode sizing is considered it is in * units of this structure. * - * This implies that no regnode style structure should contain 64 bit - * aligned members. Since the base regnode is 32 bits any member might - * not be 64 bit aligned no matter how you might try to pad out the - * struct itself (the regnode_ssc is special in this regard as it is - * never used in a program directly). If you want to store 64 bit - * members you need to store them specially. The struct regnode_p and the - * ARGp() and ARGp_SET() macros and related inline functions provide an example - * solution. Note they deal with a slightly more complicated problem than simple - * alignment, as pointers may be 32 bits or 64 bits depending on platform, - * but they illustrate the pattern to follow if you want to put a 64 bit value - * into a regnode. - - * NOTE: Ideally we do not put pointers into the regnodes in a program. Instead - * we put them in the "data" part of the regexp structure and store the index into - * the data in the pointers in the regnode. This allows the pointer to be handled - * properly during clone/free operations (eg refcount bookkeeping). See S_add_data(), - * Perl_regdupe_internal(), Perl_regfree_internal() in regcomp.c for how the data - * array can be used, the letters 'arsSu' all refer to different types of SV that - * we already have support for in the data array. + * This implies that no regnode style structure should contain 64 bit aligned + * members. Since the base regnode is 32 bits any member might not be 64 bit + * aligned no matter how you might try to pad out the struct itself (the + * regnode_ssc is special in this regard as it is never used in a program + * directly). If you want to store 64 bit members you need to store them + * specially. The struct regnode_p and the ARGp() and ARGp_SET() macros and + * related inline functions provide an example solution. Note they deal with + * a slightly more complicated problem than simple alignment, as pointers may + * be 32 bits or 64 bits depending on platform, but they illustrate the + * pattern to follow if you want to put a 64 bit value into a regnode. + * + * NOTE: Ideally we do not put pointers into the regnodes in a program. + * Instead we put them in the "data" part of the regexp structure and store + * the index into the data in the pointers in the regnode. This allows the + * pointer to be handled properly during clone/free operations (eg refcount + * bookkeeping). See S_add_data(), Perl_regdupe_internal(), + * Perl_regfree_internal() in regcomp.c for how the data array can be used, + * the letters 'arsSu' all refer to different types of SV that we already + * have support for in the data array. */ struct regnode_string { - U8 str_len; - U8 type; - U16 next_off; - char string[1]; + U8 str_len; + U8 type; + U16 next_off; + char string[1]; }; -struct regnode_lstring { /* Constructed this way to keep the string aligned. */ - U8 flags; - U8 type; - U16 next_off; - U32 str_len; /* Only 18 bits allowed before would overflow 'next_off' */ - char string[1]; +struct regnode_lstring { /* Constructed this way to keep + the string aligned. */ + U8 flags; + U8 type; + U16 next_off; + U32 str_len; /* Only 18 bits allowed before would + overflow 'next_off' */ + char string[1]; }; -struct regnode_anyofhs { /* Constructed this way to keep the string aligned. */ - U8 str_len; - U8 type; - U16 next_off; - U32 arg1; /* set by set_ANYOF_arg() */ - char string[1]; +struct regnode_anyofhs { /* Constructed this way to keep + the string aligned. */ + U8 str_len; + U8 type; + U16 next_off; + U32 arg1; /* set by set_ANYOF_arg() */ + char string[1]; }; -/* Argument bearing node - workhorse, - arg1 is often for the data field */ +/* Argument bearing node - workhorse, arg1 is often for the data field */ struct regnode_1 { - U8 flags; + U8 flags; U8 type; U16 next_off; U32 arg1; @@ -190,27 +197,27 @@ struct regnode_1 { * situations where pointers won't become invalid because of, say re-mallocs. * * Note that this regnode type is problematic and should not be used or copied - * and will be removed in the future. Pointers should be stored in the data[] - * array and an index into the data array stored in the regnode, which allows the - * pointers to be handled properly during clone/free operations on the regexp - * data structure. As a byproduct it also saves space, often we use a 16 bit - * member to store indexes into the data[] array. + * and will be removed in the future. Pointers should be stored in the data[] + * array and an index into the data array stored in the regnode, which allows + * the pointers to be handled properly during clone/free operations on the + * regexp data structure. As a byproduct it also saves space, often we use a + * 16 bit member to store indexes into the data[] array. * - * Also note that the weird storage here is because regnodes are 32 bit aligned, - * which means we cannot have a 64 bit aligned member. To make things more annoying - * the size of a pointer may vary by platform. Thus we use a character array, and - * then use inline functions to copy the data in or out. - * */ + * Also note that the weird storage here is because regnodes are 32 bit + * aligned, which means we cannot have a 64 bit aligned member. To make things + * more annoying the size of a pointer may vary by platform. Thus we use a + * character array, and then use inline functions to copy the data in or out. + */ struct regnode_p { - U8 flags; - U8 type; - U16 next_off; - char arg1_sv_ptr_bytes[sizeof(SV *)]; + U8 flags; + U8 type; + U16 next_off; + char arg1_sv_ptr_bytes[sizeof(SV *)]; }; /* Similar to a regnode_1 but with an extra signed argument */ struct regnode_2L { - U8 flags; + U8 flags; U8 type; U16 next_off; U32 arg1; @@ -219,93 +226,95 @@ struct regnode_2L { /* 'Two field' -- Two 32 bit signed args */ struct regnode_2 { - U8 flags; + U8 flags; U8 type; U16 next_off; I32 arg1; I32 arg2; }; -#define REGNODE_BBM_BITMAP_LEN \ - /* 6 info bits requires 64 bits; 5 => 32 */ \ - ((1 << (UTF_CONTINUATION_BYTE_INFO_BITS)) / CHARBITS) +#define REGNODE_BBM_BITMAP_LEN \ + /* 6 info bits requires 64 bits; 5 => 32 */ \ + ((1 << (UTF_CONTINUATION_BYTE_INFO_BITS)) / CHARBITS) -/* Used for matching any two-byte UTF-8 character whose start byte is known. - * The array is a bitmap capable of representing any possible continuation - * byte. */ +/* Used for matching any two-byte UTF-8 character whose + * start byte is known. The array is a bitmap capable + * of representing any possible continuation byte. */ struct regnode_bbm { - U8 first_byte; + U8 first_byte; U8 type; U16 next_off; - U8 bitmap[REGNODE_BBM_BITMAP_LEN]; + U8 bitmap[REGNODE_BBM_BITMAP_LEN]; }; -#define ANYOF_BITMAP_SIZE (NUM_ANYOF_CODE_POINTS / CHARBITS) +#define ANYOF_BITMAP_SIZE (NUM_ANYOF_CODE_POINTS / CHARBITS) -/* Note that these form structs which are supersets of the next smaller one, by - * appending fields. Alignment problems can occur if one of those optional - * fields requires stricter alignment than the base struct. And formal - * parameters that can really be two or more of the structs should be +/* Note that these form structs which are supersets of the next smaller one, + * by appending fields. Alignment problems can occur if one of those + * optional fields requires stricter alignment than the base struct. And + * formal parameters that can really be two or more of the structs should be * declared as the smallest one it could be. See commit message for * 7dcac5f6a5195002b55c935ee1d67f67e1df280b. Regnode allocation is done - * without regard to alignment, and changing it to would also require changing - * the code that inserts and deletes regnodes. The basic single-argument - * regnode has a U32, which is what reganode() allocates as a unit. Therefore - * no field can require stricter alignment than U32. */ + * without regard to alignment, and changing it to would also require + * changing the code that inserts and deletes regnodes. The basic + * single-argument regnode has a U32, which is what reganode() allocates as + * a unit. Therefore no field can require stricter alignment than U32. */ /* also used by trie */ struct regnode_charclass { - U8 flags; - U8 type; - U16 next_off; - U32 arg1; /* set by set_ANYOF_arg() */ - char bitmap[ANYOF_BITMAP_SIZE]; /* only compile-time */ + U8 flags; + U8 type; + U16 next_off; + U32 arg1; /* set by set_ANYOF_arg() */ + char bitmap[ANYOF_BITMAP_SIZE]; /* only compile-time */ }; /* has runtime (locale) \d, \w, ..., [:posix:] classes */ struct regnode_charclass_posixl { - U8 flags; /* ANYOF_MATCHES_POSIXL bit must go here */ - U8 type; - U16 next_off; - U32 arg1; - char bitmap[ANYOF_BITMAP_SIZE]; /* both compile-time ... */ - U32 classflags; /* and run-time */ + U8 flags; /* ANYOF_MATCHES_POSIXL + bit must go here */ + U8 type; + U16 next_off; + U32 arg1; + char bitmap[ANYOF_BITMAP_SIZE]; /* both compile-time ... */ + U32 classflags; /* and run-time */ }; /* A synthetic start class (SSC); is a regnode_charclass_posixl_fold, plus an * extra SV*, used only during regex construction and which is not used by the - * main machinery in regexec.c and which does not get embedded in the final compiled - * regex program. + * main machinery in regexec.c and which does not get embedded in the final + * compiled regex program. * - * Because it does not get embedded it does not have to comply with the alignment - * and sizing constraints required for a normal regnode structure: it MAY contain - * pointers or members of whatever size needed and the compiler will do the right - * thing. (Every other regnode type is 32 bit aligned.) + * Because it does not get embedded it does not have to comply with the + * alignment and sizing constraints required for a normal regnode structure: it + * MAY contain pointers or members of whatever size needed and the compiler + * will do the right thing. (Every other regnode type is 32 bit aligned.) * - * Note that the 'next_off' field is unused, as the SSC stands alone, so there is - * never a next node. + * Note that the 'next_off' field is unused, as the SSC stands alone, so there + * is never a next node. */ struct regnode_ssc { - U8 flags; /* ANYOF_MATCHES_POSIXL bit must go here */ - U8 type; - U16 next_off; - U32 arg1; - char bitmap[ANYOF_BITMAP_SIZE]; /* both compile-time ... */ - U32 classflags; /* ... and run-time */ - - /* Auxiliary, only used during construction; NULL afterwards: list of code - * points matched */ - SV* invlist; + U8 flags; /* ANYOF_MATCHES_POSIXL + bit must go here */ + U8 type; + U16 next_off; + U32 arg1; + char bitmap[ANYOF_BITMAP_SIZE]; /* both compile-time ... */ + U32 classflags; /* ... and run-time */ + + /* Auxiliary, only used during construction; NULL + * afterwards: list of code points matched */ + SV *invlist; }; /* We take advantage of 'next_off' not otherwise being used in the SSC by * actually using it: by setting it to 1. This allows us to test and - * distinguish between an SSC and other ANYOF node types, as 'next_off' cannot - * otherwise be 1, because it is the offset to the next regnode expressed in - * units of regnodes. Since an ANYOF node contains extra fields, it adds up - * to 12 regnode units on 32-bit systems, (hence the minimum this can be (if - * not 0) is 11 there. Even if things get tightly packed on a 64-bit system, - * it still would be more than 1. */ + * distinguish between an SSC and other ANYOF node types, as 'next_off' + * cannot otherwise be 1, because it is the offset to the next regnode + * expressed in units of regnodes. Since an ANYOF node contains extra + * fields, it adds up to 12 regnode units on 32-bit systems, (hence the + * minimum this can be (if not 0) is 11 there. Even if things get + * tightly packed on a 64-bit system, it still would be more than 1. */ #define set_ANYOF_SYNTHETIC(n) \ STMT_START{ \ OP(n) = ANYOF; \ @@ -314,145 +323,145 @@ struct regnode_ssc { #define is_ANYOF_SYNTHETIC(n) (REGNODE_TYPE(OP(n)) == ANYOF && NEXT_OFF(n) == 1) -/* XXX fix this description. - Impose a limit of REG_INFTY on various pattern matching operations - to limit stack growth and to avoid "infinite" recursions. -*/ +/* XXX fix this description. Impose a limit of REG_INFTY + on various pattern matching operations to limit stack + growth and to avoid "infinite" recursions. + */ /* The default size for REG_INFTY is I32_MAX, which is the same as UINT_MAX - (see perl.h). Unfortunately I32 isn't necessarily 32 bits (see handy.h). - On the Cray C90, or Cray T90, I32_MAX is considerably larger than it - might be elsewhere. To limit stack growth to reasonable sizes, supply a - smaller default. - --Andy Dougherty 11 June 1998 - --Amended by Yves Orton 15 Jan 2023 -*/ + (see perl.h). Unfortunately I32 isn't necessarily 32 bits (see handy.h). + On the Cray C90, or Cray T90, I32_MAX is considerably larger than it might + be elsewhere. To limit stack growth to reasonable sizes, supply a smaller + default. --Andy Dougherty 11 June 1998 --Amended by Yves Orton 15 Jan 2023 + */ #if INTSIZE > 4 # ifndef REG_INFTY -# define REG_INFTY nBIT_IMAX(32) +# define REG_INFTY nBIT_IMAX(32) # endif #endif #ifndef REG_INFTY -# define REG_INFTY I32_MAX +# define REG_INFTY I32_MAX #endif -#define ARG_VALUE(arg) (arg) -#define ARG__SET(arg,val) ((arg) = (val)) +#define ARG_VALUE(arg) (arg) +#define ARG__SET(arg,val) ((arg) = (val)) #undef ARG #undef ARG1 #undef ARG2 -#define ARG(p) ARG_VALUE(ARG_LOC(p)) -#define ARGp(p) ARGp_VALUE_inline(p) -#define ARG1(p) ARG_VALUE(ARG1_LOC(p)) -#define ARG2(p) ARG_VALUE(ARG2_LOC(p)) -#define ARG2L(p) ARG_VALUE(ARG2L_LOC(p)) +#define ARG(p) ARG_VALUE(ARG_LOC(p)) +#define ARGp(p) ARGp_VALUE_inline(p) +#define ARG1(p) ARG_VALUE(ARG1_LOC(p)) +#define ARG2(p) ARG_VALUE(ARG2_LOC(p)) +#define ARG2L(p) ARG_VALUE(ARG2L_LOC(p)) -#define ARG_SET(p, val) ARG__SET(ARG_LOC(p), (val)) -#define ARG1_SET(p, val) ARG__SET(ARG1_LOC(p), (val)) -#define ARG2_SET(p, val) ARG__SET(ARG2_LOC(p), (val)) -#define ARG2L_SET(p, val) ARG__SET(ARG2L_LOC(p), (val)) -#define ARGp_SET(p, val) ARGp_SET_inline((p),(val)) +#define ARG_SET(p, val) ARG__SET(ARG_LOC(p), (val)) +#define ARG1_SET(p, val) ARG__SET(ARG1_LOC(p), (val)) +#define ARG2_SET(p, val) ARG__SET(ARG2_LOC(p), (val)) +#define ARG2L_SET(p, val) ARG__SET(ARG2L_LOC(p), (val)) +#define ARGp_SET(p, val) ARGp_SET_inline((p),(val)) #undef NEXT_OFF #undef NODE_ALIGN -#define NEXT_OFF(p) ((p)->next_off) +#define NEXT_OFF(p) ((p)->next_off) #define NODE_ALIGN(node) -/* the following define was set to 0xde in 075abff3 - * as part of some linting logic. I have set it to 0 - * as otherwise in every place where we /might/ set flags - * we have to set it 0 explicitly, which duplicates - * assignments and IMO adds an unacceptable level of - * surprise to working in the regex engine. If this - * is changed from 0 then at the very least make sure - * that SBOL for /^/ sets the flags to 0 explicitly. - * -- Yves */ +/* the following define was set to 0xde in 075abff3 as part of some linting + * logic. I have set it to 0 as otherwise in every place where we /might/ + * set flags we have to set it 0 explicitly, which duplicates assignments + * and IMO adds an unacceptable level of surprise to working in the regex + * engine. If this is changed from 0 then at the very least make sure that + * SBOL for /^/ sets the flags to 0 explicitly. -- Yves */ #define NODE_ALIGN_FILL(node) ((node)->flags = 0) -#define SIZE_ALIGN NODE_ALIGN +#define SIZE_ALIGN NODE_ALIGN #undef OP #undef OPERAND #undef STRING -#define OP(p) ((p)->type) -#define FLAGS(p) ((p)->flags) /* Caution: Doesn't apply to all \ - regnode types. For some, it's the \ - character set of the regnode */ -#define STR_LENs(p) (__ASSERT_(OP(p) != LEXACT && OP(p) != LEXACT_REQ8) \ - ((struct regnode_string *)p)->str_len) -#define STRINGs(p) (__ASSERT_(OP(p) != LEXACT && OP(p) != LEXACT_REQ8) \ - ((struct regnode_string *)p)->string) -#define OPERANDs(p) STRINGs(p) - -#define PARNO(p) ARG(p) /* APPLIES for OPEN and CLOSE only */ +#define OP(p) ((p)->type) +#define FLAGS(p) \ + ((p)->flags) /* Caution: Doesn't apply to all regnode types. For \ + some, it's the character set of the regnode */ +#define STR_LENs(p) \ + (__ASSERT_(OP(p) != LEXACT && OP(p) != LEXACT_REQ8) \ + ((struct regnode_string *)p)->str_len) +#define STRINGs(p) \ + (__ASSERT_(OP(p) != LEXACT && OP(p) != LEXACT_REQ8) \ + ((struct regnode_string *)p)->string) +#define OPERANDs(p) STRINGs(p) + +#define PARNO(p) ARG(p) /* APPLIES for OPEN and + CLOSE only */ /* Long strings. Currently limited to length 18 bits, which handles a 262000 * byte string. The limiting factor is the 16 bit 'next_off' field, which * points to the next regnode, so the furthest away it can be is 2**16. On * most architectures, regnodes are 2**2 bytes long, so that yields 2**18 * bytes. Should a longer string be desired, we could increase it to 26 bits - * fairly easily, by changing this node to have longj type which causes the ARG - * field to be used for the link to the next regnode (although code would have - * to be changed to account for this), and then use a combination of the flags - * and next_off fields for the length. To get 34 bit length, also change the - * node to be an ARG2L, using the second 32 bit field for the length, and not - * using the flags nor next_off fields at all. One could have an llstring node - * and even an lllstring type. */ -#define STR_LENl(p) (__ASSERT_(OP(p) == LEXACT || OP(p) == LEXACT_REQ8) \ - (((struct regnode_lstring *)p)->str_len)) -#define STRINGl(p) (__ASSERT_(OP(p) == LEXACT || OP(p) == LEXACT_REQ8) \ - (((struct regnode_lstring *)p)->string)) -#define OPERANDl(p) STRINGl(p) - -#define STR_LEN(p) ((OP(p) == LEXACT || OP(p) == LEXACT_REQ8) \ - ? STR_LENl(p) : STR_LENs(p)) -#define STRING(p) ((OP(p) == LEXACT || OP(p) == LEXACT_REQ8) \ - ? STRINGl(p) : STRINGs(p)) -#define OPERAND(p) STRING(p) + * fairly easily, by changing this node to have longj type which causes the + * ARG field to be used for the link to the next regnode (although code would + * have to be changed to account for this), and then use a combination of the + * flags and next_off fields for the length. To get 34 bit length, also + * change the node to be an ARG2L, using the second 32 bit field for the + * length, and not using the flags nor next_off fields at all. One could + * have an llstring node and even an lllstring type. */ +#define STR_LENl(p) \ + (__ASSERT_(OP(p) == LEXACT || OP(p) == LEXACT_REQ8) \ + (((struct regnode_lstring *)p)->str_len)) +#define STRINGl(p) \ + (__ASSERT_(OP(p) == LEXACT || OP(p) == LEXACT_REQ8) \ + (((struct regnode_lstring *)p)->string)) +#define OPERANDl(p) STRINGl(p) + +#define STR_LEN(p) \ + ((OP(p) == LEXACT || OP(p) == LEXACT_REQ8) ? STR_LENl(p) : STR_LENs(p)) +#define STRING(p) \ + ((OP(p) == LEXACT || OP(p) == LEXACT_REQ8) ? STRINGl(p) : STRINGs(p)) +#define OPERAND(p) STRING(p) /* The number of (smallest) regnode equivalents that a string of length l bytes * occupies - Used by the REGNODE_AFTER() macros and functions. */ -#define STR_SZ(l) (((l) + sizeof(regnode) - 1) / sizeof(regnode)) - -#define setSTR_LEN(p,v) \ - STMT_START{ \ - if (OP(p) == LEXACT || OP(p) == LEXACT_REQ8) \ - ((struct regnode_lstring *)(p))->str_len = (v); \ - else \ - ((struct regnode_string *)(p))->str_len = (v); \ +#define STR_SZ(l) (((l) + sizeof(regnode) - 1) / sizeof(regnode)) + +#define setSTR_LEN(p,v) \ + STMT_START{ \ + if (OP(p) == LEXACT || OP(p) == LEXACT_REQ8) \ + ((struct regnode_lstring *)(p))->str_len = (v); \ + else \ + ((struct regnode_string *)(p))->str_len = (v); \ } STMT_END #define ANYOFR_BASE_BITS 20 -#define ANYOFRbase(p) (ARG(p) & nBIT_MASK(ANYOFR_BASE_BITS)) -#define ANYOFRdelta(p) (ARG(p) >> ANYOFR_BASE_BITS) +#define ANYOFRbase(p) (ARG(p) & nBIT_MASK(ANYOFR_BASE_BITS)) +#define ANYOFRdelta(p) (ARG(p) >> ANYOFR_BASE_BITS) #undef NODE_ALIGN #undef ARG_LOC -#define NODE_ALIGN(node) -#define ARG_LOC(p) (((struct regnode_1 *)p)->arg1) -#define ARGp_BYTES_LOC(p) (((struct regnode_p *)p)->arg1_sv_ptr_bytes) -#define ARG1_LOC(p) (((struct regnode_2 *)p)->arg1) -#define ARG2_LOC(p) (((struct regnode_2 *)p)->arg2) -#define ARG2L_LOC(p) (((struct regnode_2L *)p)->arg2) +#define NODE_ALIGN(node) +#define ARG_LOC(p) (((struct regnode_1 *)p)->arg1) +#define ARGp_BYTES_LOC(p) (((struct regnode_p *)p)->arg1_sv_ptr_bytes) +#define ARG1_LOC(p) (((struct regnode_2 *)p)->arg1) +#define ARG2_LOC(p) (((struct regnode_2 *)p)->arg2) +#define ARG2L_LOC(p) (((struct regnode_2L *)p)->arg2) -/* These should no longer be used directly in most cases. Please use - * the REGNODE_AFTER() macros instead. */ -#define NODE_STEP_REGNODE 1 /* sizeof(regnode)/sizeof(regnode) */ +/* These should no longer be used directly in most cases. + * Please use the REGNODE_AFTER() macros instead. */ +#define NODE_STEP_REGNODE 1 /* sizeof(regnode)/sizeof(regnode) */ -/* Core macros for computing "the regnode after this one". See also +/* Core macros for computing "the regnode after this one". See also * Perl_regnode_after() in reginline.h * - * At the struct level regnodes are a linked list, with each node pointing - * at the next (via offsets), usually via the C field in the - * structure. Where there is a need for a node to have two children the - * immediate physical successor of the node in the compiled program is used - * to represent one of them. A good example is the BRANCH construct, - * consider the pattern C + * At the struct level regnodes are a linked list, with each node pointing at + * the next (via offsets), usually via the C field in the structure. + * Where there is a need for a node to have two children the immediate physical + * successor of the node in the compiled program is used to represent one of + * them. A good example is the BRANCH construct, consider the pattern + * C * * 1: EXACT (3) * 3: BRANCH (8) @@ -465,122 +474,125 @@ struct regnode_ssc { * 14: EXACT (16) * 16: END (0) * - * The numbers in parens at the end of each line show the "next_off" value - * for that regnode in the program. We can see that the C of - * the first BRANCH node (#3) is the second BRANCH node (#8), and indicates - * where execution should go if the regnodes *following* the BRANCH node fail - * to accept the input string. Thus to find the "next BRANCH" we would do - * C and follow the C pointer, and to find - * the "BRANCHes contents" we would use C. + * The numbers in parens at the end of each line show the "next_off" value for + * that regnode in the program. We can see that the C of the first + * BRANCH node (#3) is the second BRANCH node (#8), and indicates where + * execution should go if the regnodes *following* the BRANCH node fail to + * accept the input string. Thus to find the "next BRANCH" we would do + * C and follow the C pointer, and to find the + * "BRANCHes contents" we would use C. * - * Be aware that C is not guaranteed to give a *useful* - * result once the regex peephole optimizer has run (it will be correct - * however!). By the time code in regexec.c executes various regnodes - * may have been optimized out of the the C chain. An example - * can be seen above, node 13 will never be reached during execution - * flow as it has been stitched out of the C chain. Both 6 and - * 11 would have pointed at it during compilation, but it exists only to - * facilitate the construction of the BRANCH structure and is effectively - * a NOOP, and thus the optimizer adjusts the links so it is skipped - * from execution time flow. In regexec.c it is only safe to use - * REGNODE_AFTER() on specific node types. + * Be aware that C is not guaranteed to give a *useful* result + * once the regex peephole optimizer has run (it will be correct however!). By + * the time code in regexec.c executes various regnodes may have been + * optimized out of the the C chain. An example can be seen above, + * node 13 will never be reached during execution flow as it has been stitched + * out of the C chain. Both 6 and 11 would have pointed at it during + * compilation, but it exists only to facilitate the construction of the BRANCH + * structure and is effectively a NOOP, and thus the optimizer adjusts the + * links so it is skipped from execution time flow. In regexec.c it is only + * safe to use REGNODE_AFTER() on specific node types. * - * Conversely during compilation C may not work properly - * as the C may not be known until "later", (such as in the - * case of BRANCH nodes) and thus in regcomp.c the REGNODE_AFTER() macro - * is used very heavily instead. + * Conversely during compilation C may not work properly as the + * C may not be known until "later", (such as in the case of BRANCH + * nodes) and thus in regcomp.c the REGNODE_AFTER() macro is used very heavily + * instead. * - * There are several variants of the REGNODE_AFTER_xxx() macros which - * are intended for use in different situations depending on how - * confident the code is about what type of node it is trying to find a - * successor for. + * There are several variants of the REGNODE_AFTER_xxx() macros which are + * intended for use in different situations depending on how confident the code + * is about what type of node it is trying to find a successor for. * * So for instance if you know you are dealing with a known node type of * constant size then you should use REGNODE_AFTER_type(n,TYPE). * - * If you have a regnode pointer and you know you are dealing with a - * regnode type of constant size and you have already extracted its - * opcode use: REGNODE_AFTER_opcode(n,OPCODE). + * If you have a regnode pointer and you know you are dealing with a regnode + * type of constant size and you have already extracted its opcode use: + * REGNODE_AFTER_opcode(n,OPCODE). * - * If you have a regnode and you know it is variable size then you - * you can produce optimized code by using REGNODE_AFTER_varies(n). + * If you have a regnode and you know it is variable size then you you can + * produce optimized code by using REGNODE_AFTER_varies(n). * - * If you have a regnode pointer and nothing else use: REGNODE_AFTER(n) - * This is the safest option and wraps C. It - * should produce the correct result regardless of its argument. The - * other options only produce correct results under specific - * constraints. + * If you have a regnode pointer and nothing else use: REGNODE_AFTER(n) This is + * the safest option and wraps C. It should produce the + * correct result regardless of its argument. The other options only produce + * correct results under specific constraints. */ -#define REGNODE_AFTER_PLUS(p,extra) ((p) + NODE_STEP_REGNODE + (extra)) -/* under DEBUGGING we check that all REGNODE_AFTER optimized macros did the - * same thing that Perl_regnode_after() would have done. Note that when - * not compiled under DEBUGGING the assert_() macro is empty. Thus we - * don't have to implement different versions for DEBUGGING and not DEBUGGING, - * and explains why all the macros use REGNODE_AFTER_PLUS_DEBUG() under the - * hood. */ -#define REGNODE_AFTER_PLUS_DEBUG(p,extra) \ +#define REGNODE_AFTER_PLUS(p,extra) \ + ((p) + NODE_STEP_REGNODE + (extra)) +/* under DEBUGGING we check that all REGNODE_AFTER optimized macros + * did the same thing that Perl_regnode_after() would have done. + * Note that when not compiled under DEBUGGING the assert_() macro + * is empty. Thus we don't have to implement different versions + * for DEBUGGING and not DEBUGGING, and explains why all the macros + * use REGNODE_AFTER_PLUS_DEBUG() under the hood. */ +#define REGNODE_AFTER_PLUS_DEBUG(p,extra) \ (assert_(check_regnode_after(p,extra)) REGNODE_AFTER_PLUS((p),(extra))) -/* find the regnode after this p by using the opcode we previously extracted - * with OP(p) */ -#define REGNODE_AFTER_opcode(p,op) REGNODE_AFTER_PLUS_DEBUG((p),REGNODE_ARG_LEN(op)) - -/* find the regnode after this p by using the size of the struct associated with - * the opcode for p. use this when you *know* that p is pointer to a given type*/ -#define REGNODE_AFTER_type(p,t) REGNODE_AFTER_PLUS_DEBUG((p),EXTRA_SIZE(t)) - -/* find the regnode after this p by using OP(p) to find the regnode type of p */ -#define REGNODE_AFTER_varies(p) regnode_after(p,TRUE) - -/* find the regnode after this p by using OP(p) to find the regnode type of p */ -#define REGNODE_AFTER(p) regnode_after(p,FALSE) - - -/* REGNODE_BEFORE() is trickier to deal with in terms of validation, execution. - * All the places that use it assume that p will be one struct regnode large. - * So to validate it we do the math to go backwards and then validate that the - * type of regnode we landed on is actually one regnode large. In theory if - * things go wrong the opcode should be illegal or say the item should be larger - * than it is, etc. */ -#define REGNODE_BEFORE_BASE(p) ((p) - NODE_STEP_REGNODE) -#define REGNODE_BEFORE_BASE_DEBUG(p) \ +/* find the regnode after this p by using the opcode + * we previously extracted with OP(p) */ +#define REGNODE_AFTER_opcode(p,op) \ + REGNODE_AFTER_PLUS_DEBUG((p),REGNODE_ARG_LEN(op)) + +/* find the regnode after this p by using the size of the + * struct associated with the opcode for p. use this + * when you *know* that p is pointer to a given type */ +#define REGNODE_AFTER_type(p,t) \ + REGNODE_AFTER_PLUS_DEBUG((p),EXTRA_SIZE(t)) + +/* find the regnode after this p by using OP(p) + to find the regnode type of p */ +#define REGNODE_AFTER_varies(p) regnode_after(p,TRUE) + +/* find the regnode after this p by using OP(p) + to find the regnode type of p */ +#define REGNODE_AFTER(p) regnode_after(p,FALSE) + + +/* REGNODE_BEFORE() is trickier to deal with in terms of validation, + * execution. All the places that use it assume that p will be one struct + * regnode large. So to validate it we do the math to go backwards and + * then validate that the type of regnode we landed on is actually one + * regnode large. In theory if things go wrong the opcode should be + * illegal or say the item should be larger than it is, etc. */ +#define REGNODE_BEFORE_BASE(p) ((p) - NODE_STEP_REGNODE) +#define REGNODE_BEFORE_BASE_DEBUG(p) \ (assert_(check_regnode_after(REGNODE_BEFORE_BASE(p),0)) REGNODE_BEFORE_BASE(p)) -#define REGNODE_BEFORE(p) REGNODE_BEFORE_BASE_DEBUG(p) +#define REGNODE_BEFORE(p) REGNODE_BEFORE_BASE_DEBUG(p) -#define FILL_NODE(offset, op) \ - STMT_START { \ - OP(REGNODE_p(offset)) = op; \ - NEXT_OFF(REGNODE_p(offset)) = 0; \ +#define FILL_NODE(offset, op) \ + STMT_START { \ + OP(REGNODE_p(offset)) = op; \ + NEXT_OFF(REGNODE_p(offset)) = 0; \ } STMT_END -#define FILL_ADVANCE_NODE(offset, op) \ - STMT_START { \ - FILL_NODE(offset, op); \ - (offset)++; \ +#define FILL_ADVANCE_NODE(offset, op) \ + STMT_START { \ + FILL_NODE(offset, op); \ + (offset)++; \ } STMT_END -#define FILL_ADVANCE_NODE_ARG(offset, op, arg) \ - STMT_START { \ - ARG_SET(REGNODE_p(offset), arg); \ - FILL_ADVANCE_NODE(offset, op); \ - /* This is used generically for other operations \ - * that have a longer argument */ \ - (offset) += REGNODE_ARG_LEN(op); \ +#define FILL_ADVANCE_NODE_ARG(offset, op, arg) \ + STMT_START { \ + ARG_SET(REGNODE_p(offset), arg); \ + FILL_ADVANCE_NODE(offset, op); \ + /* This is used generically for other operations \ + * that have a longer argument */ \ + (offset) += REGNODE_ARG_LEN(op); \ } STMT_END -#define FILL_ADVANCE_NODE_ARGp(offset, op, arg) \ - STMT_START { \ - ARGp_SET(REGNODE_p(offset), arg); \ - FILL_ADVANCE_NODE(offset, op); \ - (offset) += REGNODE_ARG_LEN(op); \ +#define FILL_ADVANCE_NODE_ARGp(offset, op, arg) \ + STMT_START { \ + ARGp_SET(REGNODE_p(offset), arg); \ + FILL_ADVANCE_NODE(offset, op); \ + (offset) += REGNODE_ARG_LEN(op); \ } STMT_END -#define FILL_ADVANCE_NODE_2L_ARG(offset, op, arg1, arg2) \ - STMT_START { \ - ARG_SET(REGNODE_p(offset), arg1); \ - ARG2L_SET(REGNODE_p(offset), arg2); \ - FILL_ADVANCE_NODE(offset, op); \ - (offset) += 2; \ +#define FILL_ADVANCE_NODE_2L_ARG(offset, op, arg1, arg2) \ + STMT_START { \ + ARG_SET(REGNODE_p(offset), arg1); \ + ARG2L_SET(REGNODE_p(offset), arg2); \ + FILL_ADVANCE_NODE(offset, op); \ + (offset) += 2; \ } STMT_END -/* define these after we define the normal macros, so we can use - * ARGp_BYTES_LOC(n) */ +/* define these after we define the normal macros, + * so we can use ARGp_BYTES_LOC(n) */ static inline SV * ARGp_VALUE_inline(struct regnode *node) { @@ -595,37 +607,37 @@ ARGp_SET_inline(struct regnode *node, SV *ptr) { memcpy(ARGp_BYTES_LOC(node), &ptr, sizeof(ptr)); } -#define REG_MAGIC 0234 - -/* An ANYOF node matches a single code point based on specified criteria. It - * now comes in several styles, but originally it was just a 256 element - * bitmap, indexed by the code point (which was always just a byte). If the - * corresponding bit for a code point is 1, the code point matches; if 0, it - * doesn't match (complemented if inverted). This worked fine before Unicode - * existed, but making a bit map long enough to accommodate a bit for every - * possible Unicode code point is prohibitively large. Therefore it is made - * much much smaller, and an inversion list is created to handle code points - * not represented by the bitmap. (It is now possible to compile the bitmap to - * a larger size to avoid the slower inversion list lookup for however big the - * bitmap is set to, but this is rarely done). If the bitmap is sufficient to - * specify all possible matches (with nothing outside it matching), no - * inversion list is needed nor included, and the argument to the ANYOF node is - * set to the following: */ - -#define ANYOF_MATCHES_ALL_OUTSIDE_BITMAP_VALUE U32_MAX -#define ANYOF_MATCHES_ALL_OUTSIDE_BITMAP(node) \ - (ARG(node) == ANYOF_MATCHES_ALL_OUTSIDE_BITMAP_VALUE) - -#define ANYOF_MATCHES_NONE_OUTSIDE_BITMAP_VALUE \ - /* Assumes ALL is odd */ (ANYOF_MATCHES_ALL_OUTSIDE_BITMAP_VALUE - 1) -#define ANYOF_MATCHES_NONE_OUTSIDE_BITMAP(node) \ - (ARG(node) == ANYOF_MATCHES_NONE_OUTSIDE_BITMAP_VALUE) +#define REG_MAGIC 0234 + +/* An ANYOF node matches a single code point based on specified criteria. + * It now comes in several styles, but originally it was just a 256 element + * bitmap, indexed by the code point (which was always just a byte). If + * the corresponding bit for a code point is 1, the code point matches; if + * 0, it doesn't match (complemented if inverted). This worked fine before + * Unicode existed, but making a bit map long enough to accommodate a bit + * for every possible Unicode code point is prohibitively large. Therefore + * it is made much much smaller, and an inversion list is created to handle + * code points not represented by the bitmap. (It is now possible to + * compile the bitmap to a larger size to avoid the slower inversion list + * lookup for however big the bitmap is set to, but this is rarely done). + * If the bitmap is sufficient to specify all possible matches (with + * nothing outside it matching), no inversion list is needed nor included, + * and the argument to the ANYOF node is set to the following: */ + +#define ANYOF_MATCHES_ALL_OUTSIDE_BITMAP_VALUE U32_MAX +#define ANYOF_MATCHES_ALL_OUTSIDE_BITMAP(node) \ + (ARG(node) == ANYOF_MATCHES_ALL_OUTSIDE_BITMAP_VALUE) + +#define ANYOF_MATCHES_NONE_OUTSIDE_BITMAP_VALUE \ + /* Assumes ALL is odd */ (ANYOF_MATCHES_ALL_OUTSIDE_BITMAP_VALUE - 1) +#define ANYOF_MATCHES_NONE_OUTSIDE_BITMAP(node) \ + (ARG(node) == ANYOF_MATCHES_NONE_OUTSIDE_BITMAP_VALUE) #define ANYOF_ONLY_HAS_BITMAP_MASK ANYOF_MATCHES_NONE_OUTSIDE_BITMAP_VALUE -#define ANYOF_ONLY_HAS_BITMAP(node) \ - ((ARG(node) & ANYOF_ONLY_HAS_BITMAP_MASK) == ANYOF_ONLY_HAS_BITMAP_MASK) +#define ANYOF_ONLY_HAS_BITMAP(node) \ + ((ARG(node) & ANYOF_ONLY_HAS_BITMAP_MASK) == ANYOF_ONLY_HAS_BITMAP_MASK) -#define ANYOF_HAS_AUX(node) (! ANYOF_ONLY_HAS_BITMAP(node)) +#define ANYOF_HAS_AUX(node) (! ANYOF_ONLY_HAS_BITMAP(node)) /* There are also ANYOFM nodes, used when the bit patterns representing the * matched code points happen to be such that they can be checked by ANDing @@ -735,43 +747,41 @@ ARGp_SET_inline(struct regnode *node, SV *ptr) { /* If this is set, the result of the match should be complemented. regexec.c * is expecting this to be in the low bit. Never in an SSC */ -#define ANYOF_INVERT 0x01 +#define ANYOF_INVERT 0x01 -/* For the SSC node only, which cannot be inverted, so is shared with that bit. - * This is used only during regex compilation. */ -#define SSC_MATCHES_EMPTY_STRING ANYOF_INVERT +/* For the SSC node only, which cannot be inverted, so is shared with + * that bit. This is used only during regex compilation. */ +#define SSC_MATCHES_EMPTY_STRING ANYOF_INVERT /* Set if this is a regnode_charclass_posixl vs a regnode_charclass. This * is used for runtime \d, \w, [:posix:], ..., which are used only in locale * and the optimizer's synthetic start class. Non-locale \d, etc are resolved * at compile-time. Only set under /l; can be in SSC */ -#define ANYOF_MATCHES_POSIXL 0x02 +#define ANYOF_MATCHES_POSIXL 0x02 -/* The fold is calculated and stored in the bitmap where possible at compile - * time. However under locale, the actual folding varies depending on - * what the locale is at the time of execution, so it has to be deferred until - * then. Only set under /l; never in an SSC */ -#define ANYOFL_FOLD 0x04 +/* The fold is calculated and stored in the bitmap where possible at + * compile time. However under locale, the actual folding varies + * depending on what the locale is at the time of execution, so it has to + * be deferred until then. Only set under /l; never in an SSC */ +#define ANYOFL_FOLD 0x04 -/* Warn if the runtime locale isn't a UTF-8 one (and the generated node assumes - * a UTF-8 locale. */ -#define ANYOFL_UTF8_LOCALE_REQD 0x08 +/* Warn if the runtime locale isn't a UTF-8 one (and + * the generated node assumes a UTF-8 locale. */ +#define ANYOFL_UTF8_LOCALE_REQD 0x08 -/* Spare: Be sure to change ANYOF_FLAGS_ALL if this gets used 0x10 */ +/* Spare: Be sure to change ANYOF_FLAGS_ALL if this gets used 0x10 */ -/* Spare: Be sure to change ANYOF_FLAGS_ALL if this gets used 0x20 */ +/* Spare: Be sure to change ANYOF_FLAGS_ALL if this gets used 0x20 */ /* Shared bit that indicates that there are potential additional matches stored * outside the bitmap, as pointed to by the AV given by the node's argument. * The node type is used at runtime (in conjunction with this flag and other * information available then) to decide if the flag should be acted upon. * This extra information is needed because of at least one of the following - * three reasons. - * Under /d and the matched string is in UTF-8, it means the ANYOFD node - * matches more things than in the bitmap. Those things will be any - * code point too high for the bitmap, but crucially, any non-ASCII - * characters that match iff when using Unicode rules. These all are - * < 256. + * three reasons. Under /d and the matched string is in UTF-8, it means the + * ANYOFD node matches more things than in the bitmap. Those things will be + * any code point too high for the bitmap, but crucially, any non-ASCII + * characters that match iff when using Unicode rules. These all are < 256. * * Under /l and ANYOFL_FOLD is set, this flag may indicate there are * potential matches valid only if the locale is a UTF-8 one. If so, @@ -785,199 +795,221 @@ ARGp_SET_inline(struct regnode *node, SV *ptr) { * Note that an ANYOFL node may contain both a user-defined property, and * folds not always valid. The important thing is that there is an AV to * look at. */ -#define ANYOF_HAS_EXTRA_RUNTIME_MATCHES 0x40 - -/* Shared bit: - * Under /d it means the ANYOFD node matches all non-ASCII Latin1 - * characters when the target string is not in utf8. - * When not under /d, it means the ANYOF node should raise a warning if - * matching against an above-Unicode code point. - * (These uses are mutually exclusive because the warning requires a \p{}, and - * \p{} implies /u which deselects /d). An SSC node only has this bit set if - * what is meant is the warning. The names are to make sure that you are - * cautioned about its shared nature */ +#define ANYOF_HAS_EXTRA_RUNTIME_MATCHES 0x40 + +/* Shared bit: Under /d it means the ANYOFD node matches all non-ASCII + * Latin1 characters when the target string is not in utf8. When not under + * /d, it means the ANYOF node should raise a warning if matching against an + * above-Unicode code point. (These uses are mutually exclusive because the + * warning requires a \p{}, and \p{} implies /u which deselects /d). An SSC + * node only has this bit set if what is meant is the warning. The names + * are to make sure that you are cautioned about its shared nature */ #define ANYOFD_NON_UTF8_MATCHES_ALL_NON_ASCII__shared 0x80 -#define ANYOF_WARN_SUPER__shared 0x80 +#define ANYOF_WARN_SUPER__shared 0x80 -#define ANYOF_FLAGS_ALL ((U8) ~(0x10|0x20)) +#define ANYOF_FLAGS_ALL ((U8) ~(0x10|0x20)) -#define ANYOF_LOCALE_FLAGS ( ANYOFL_FOLD \ - | ANYOF_MATCHES_POSIXL \ - | ANYOFL_UTF8_LOCALE_REQD) +#define ANYOF_LOCALE_FLAGS \ + ( ANYOFL_FOLD \ + | ANYOF_MATCHES_POSIXL \ + | ANYOFL_UTF8_LOCALE_REQD) /* These are the flags that apply to both regular ANYOF nodes and synthetic - * start class nodes during construction of the SSC. During finalization of - * the SSC, other of the flags may get added to it */ -#define ANYOF_COMMON_FLAGS 0 + * start class nodes during construction of the SSC. During finalization + * of the SSC, other of the flags may get added to it */ +#define ANYOF_COMMON_FLAGS 0 /* Character classes for node->classflags of ANYOF */ /* Should be synchronized with a table in regprop() */ /* 2n should be the normal one, paired with its complement at 2n+1 */ -#define ANYOF_ALPHA ((CC_ALPHA_) * 2) -#define ANYOF_NALPHA ((ANYOF_ALPHA) + 1) -#define ANYOF_ALPHANUMERIC ((CC_ALPHANUMERIC_) * 2) /* [[:alnum:]] isalnum(3), utf8::IsAlnum */ -#define ANYOF_NALPHANUMERIC ((ANYOF_ALPHANUMERIC) + 1) -#define ANYOF_ASCII ((CC_ASCII_) * 2) -#define ANYOF_NASCII ((ANYOF_ASCII) + 1) -#define ANYOF_BLANK ((CC_BLANK_) * 2) /* GNU extension: space and tab: non-vertical space */ -#define ANYOF_NBLANK ((ANYOF_BLANK) + 1) -#define ANYOF_CASED ((CC_CASED_) * 2) /* Pseudo class for [:lower:] or - [:upper:] under /i */ -#define ANYOF_NCASED ((ANYOF_CASED) + 1) -#define ANYOF_CNTRL ((CC_CNTRL_) * 2) -#define ANYOF_NCNTRL ((ANYOF_CNTRL) + 1) -#define ANYOF_DIGIT ((CC_DIGIT_) * 2) /* \d */ -#define ANYOF_NDIGIT ((ANYOF_DIGIT) + 1) -#define ANYOF_GRAPH ((CC_GRAPH_) * 2) -#define ANYOF_NGRAPH ((ANYOF_GRAPH) + 1) -#define ANYOF_LOWER ((CC_LOWER_) * 2) -#define ANYOF_NLOWER ((ANYOF_LOWER) + 1) -#define ANYOF_PRINT ((CC_PRINT_) * 2) -#define ANYOF_NPRINT ((ANYOF_PRINT) + 1) -#define ANYOF_PUNCT ((CC_PUNCT_) * 2) -#define ANYOF_NPUNCT ((ANYOF_PUNCT) + 1) -#define ANYOF_SPACE ((CC_SPACE_) * 2) /* \s */ -#define ANYOF_NSPACE ((ANYOF_SPACE) + 1) -#define ANYOF_UPPER ((CC_UPPER_) * 2) -#define ANYOF_NUPPER ((ANYOF_UPPER) + 1) -#define ANYOF_WORDCHAR ((CC_WORDCHAR_) * 2) /* \w, PL_utf8_alnum, utf8::IsWord, ALNUM */ -#define ANYOF_NWORDCHAR ((ANYOF_WORDCHAR) + 1) -#define ANYOF_XDIGIT ((CC_XDIGIT_) * 2) -#define ANYOF_NXDIGIT ((ANYOF_XDIGIT) + 1) - -/* pseudo classes below this, not stored in the class bitmap, but used as flags - during compilation of char classes */ - -#define ANYOF_VERTWS ((CC_VERTSPACE_) * 2) -#define ANYOF_NVERTWS ((ANYOF_VERTWS)+1) - -/* It is best if this is the last one, as all above it are stored as bits in a - * bitmap, and it isn't part of that bitmap */ +#define ANYOF_ALPHA ((CC_ALPHA_) * 2) +#define ANYOF_NALPHA ((ANYOF_ALPHA) + 1) +#define ANYOF_ALPHANUMERIC ((CC_ALPHANUMERIC_) * 2) /* [[:alnum:]] + isalnum(3), + utf8::IsAlnum + */ +#define ANYOF_NALPHANUMERIC ((ANYOF_ALPHANUMERIC) + 1) +#define ANYOF_ASCII ((CC_ASCII_) * 2) +#define ANYOF_NASCII ((ANYOF_ASCII) + 1) +#define ANYOF_BLANK ((CC_BLANK_) * 2) /* GNU extension: + space and tab: + non-vertical + space */ +#define ANYOF_NBLANK ((ANYOF_BLANK) + 1) +#define ANYOF_CASED ((CC_CASED_) * 2) /* Pseudo class + for [:lower:] + or [:upper:] + under /i */ +#define ANYOF_NCASED ((ANYOF_CASED) + 1) +#define ANYOF_CNTRL ((CC_CNTRL_) * 2) +#define ANYOF_NCNTRL ((ANYOF_CNTRL) + 1) +#define ANYOF_DIGIT ((CC_DIGIT_) * 2) /* \d */ +#define ANYOF_NDIGIT ((ANYOF_DIGIT) + 1) +#define ANYOF_GRAPH ((CC_GRAPH_) * 2) +#define ANYOF_NGRAPH ((ANYOF_GRAPH) + 1) +#define ANYOF_LOWER ((CC_LOWER_) * 2) +#define ANYOF_NLOWER ((ANYOF_LOWER) + 1) +#define ANYOF_PRINT ((CC_PRINT_) * 2) +#define ANYOF_NPRINT ((ANYOF_PRINT) + 1) +#define ANYOF_PUNCT ((CC_PUNCT_) * 2) +#define ANYOF_NPUNCT ((ANYOF_PUNCT) + 1) +#define ANYOF_SPACE ((CC_SPACE_) * 2) /* \s */ +#define ANYOF_NSPACE ((ANYOF_SPACE) + 1) +#define ANYOF_UPPER ((CC_UPPER_) * 2) +#define ANYOF_NUPPER ((ANYOF_UPPER) + 1) +#define ANYOF_WORDCHAR ((CC_WORDCHAR_) * 2) /* \w, + PL_utf8_alnum, + utf8::IsWord, + ALNUM */ +#define ANYOF_NWORDCHAR ((ANYOF_WORDCHAR) + 1) +#define ANYOF_XDIGIT ((CC_XDIGIT_) * 2) +#define ANYOF_NXDIGIT ((ANYOF_XDIGIT) + 1) + +/* pseudo classes below this, not stored in the class bitmap, + but used as flags during compilation of char classes */ + +#define ANYOF_VERTWS ((CC_VERTSPACE_) * 2) +#define ANYOF_NVERTWS ((ANYOF_VERTWS)+1) + +/* It is best if this is the last one, as all above it are stored + * as bits in a bitmap, and it isn't part of that bitmap */ #if CC_VERTSPACE_ != HIGHEST_REGCOMP_DOT_H_SYNC_ # error Problem with handy.h HIGHEST_REGCOMP_DOT_H_SYNC_ #define #endif -#define ANYOF_POSIXL_MAX (ANYOF_VERTWS) /* So upper loop limit is written: - * '< ANYOF_MAX' - * Hence doesn't include VERTWS, as that - * is a pseudo class */ -#define ANYOF_MAX ANYOF_POSIXL_MAX +#define ANYOF_POSIXL_MAX (ANYOF_VERTWS) /* So upper loop + * limit is + * written: '< + * ANYOF_MAX' Hence + * doesn't include + * VERTWS, as that + * is a pseudo + * class */ +#define ANYOF_MAX ANYOF_POSIXL_MAX #if (ANYOF_POSIXL_MAX > 32) /* Must fit in 32-bit word */ # error Problem with handy.h CC_foo_ #defines #endif -#define ANYOF_HORIZWS ((ANYOF_POSIXL_MAX)+2) /* = (ANYOF_NVERTWS + 1) */ -#define ANYOF_NHORIZWS ((ANYOF_POSIXL_MAX)+3) +#define ANYOF_HORIZWS ((ANYOF_POSIXL_MAX)+2) /* = (ANYOF_NVERTWS + + 1) */ +#define ANYOF_NHORIZWS ((ANYOF_POSIXL_MAX)+3) -#define ANYOF_UNIPROP ((ANYOF_POSIXL_MAX)+4) /* Used to indicate a Unicode - property: \p{} or \P{} */ +#define ANYOF_UNIPROP ((ANYOF_POSIXL_MAX)+4) /* Used to indicate + a Unicode + property: \p{} + or \P{} */ /* Backward source code compatibility. */ -#define ANYOF_ALNUML ANYOF_ALNUM -#define ANYOF_NALNUML ANYOF_NALNUM -#define ANYOF_SPACEL ANYOF_SPACE -#define ANYOF_NSPACEL ANYOF_NSPACE -#define ANYOF_ALNUM ANYOF_WORDCHAR -#define ANYOF_NALNUM ANYOF_NWORDCHAR +#define ANYOF_ALNUML ANYOF_ALNUM +#define ANYOF_NALNUML ANYOF_NALNUM +#define ANYOF_SPACEL ANYOF_SPACE +#define ANYOF_NSPACEL ANYOF_NSPACE +#define ANYOF_ALNUM ANYOF_WORDCHAR +#define ANYOF_NALNUM ANYOF_NWORDCHAR /* Utility macros for the bitmap and classes of ANYOF */ -#define BITMAP_BYTE(p, c) (( (U8*) (p)) [ ( ( (UV) (c)) >> 3) ] ) -#define BITMAP_BIT(c) (1U << ((c) & 7)) -#define BITMAP_TEST(p, c) (BITMAP_BYTE(p, c) & BITMAP_BIT((U8)(c))) +#define BITMAP_BYTE(p, c) (( (U8*) (p)) [ ( ( (UV) (c)) >> 3) ] ) +#define BITMAP_BIT(c) (1U << ((c) & 7)) +#define BITMAP_TEST(p, c) (BITMAP_BYTE(p, c) & BITMAP_BIT((U8)(c))) -#define ANYOF_FLAGS(p) ((p)->flags) +#define ANYOF_FLAGS(p) ((p)->flags) -#define ANYOF_BIT(c) BITMAP_BIT(c) +#define ANYOF_BIT(c) BITMAP_BIT(c) -#define ANYOF_POSIXL_BITMAP(p) (((regnode_charclass_posixl*) (p))->classflags) +#define ANYOF_POSIXL_BITMAP(p) (((regnode_charclass_posixl*) (p))->classflags) -#define POSIXL_SET(field, c) ((field) |= (1U << (c))) -#define ANYOF_POSIXL_SET(p, c) POSIXL_SET(ANYOF_POSIXL_BITMAP(p), (c)) +#define POSIXL_SET(field, c) ((field) |= (1U << (c))) +#define ANYOF_POSIXL_SET(p, c) POSIXL_SET(ANYOF_POSIXL_BITMAP(p), (c)) -#define POSIXL_CLEAR(field, c) ((field) &= ~ (1U <<(c))) -#define ANYOF_POSIXL_CLEAR(p, c) POSIXL_CLEAR(ANYOF_POSIXL_BITMAP(p), (c)) +#define POSIXL_CLEAR(field, c) ((field) &= ~ (1U <<(c))) +#define ANYOF_POSIXL_CLEAR(p, c) POSIXL_CLEAR(ANYOF_POSIXL_BITMAP(p), (c)) -#define POSIXL_TEST(field, c) ((field) & (1U << (c))) -#define ANYOF_POSIXL_TEST(p, c) POSIXL_TEST(ANYOF_POSIXL_BITMAP(p), (c)) +#define POSIXL_TEST(field, c) ((field) & (1U << (c))) +#define ANYOF_POSIXL_TEST(p, c) POSIXL_TEST(ANYOF_POSIXL_BITMAP(p), (c)) -#define POSIXL_ZERO(field) STMT_START { (field) = 0; } STMT_END -#define ANYOF_POSIXL_ZERO(ret) POSIXL_ZERO(ANYOF_POSIXL_BITMAP(ret)) +#define POSIXL_ZERO(field) STMT_START { (field) = 0; } STMT_END +#define ANYOF_POSIXL_ZERO(ret) POSIXL_ZERO(ANYOF_POSIXL_BITMAP(ret)) -#define ANYOF_POSIXL_SET_TO_BITMAP(p, bits) \ - STMT_START { ANYOF_POSIXL_BITMAP(p) = (bits); } STMT_END +#define ANYOF_POSIXL_SET_TO_BITMAP(p, bits) \ + STMT_START { ANYOF_POSIXL_BITMAP(p) = (bits); } STMT_END -/* Shifts a bit to get, eg. 0x4000_0000, then subtracts 1 to get 0x3FFF_FFFF */ -#define ANYOF_POSIXL_SETALL(ret) \ - STMT_START { \ - ANYOF_POSIXL_BITMAP(ret) = nBIT_MASK(ANYOF_POSIXL_MAX); \ - } STMT_END -#define ANYOF_CLASS_SETALL(ret) ANYOF_POSIXL_SETALL(ret) +/* Shifts a bit to get, eg. 0x4000_0000, then + subtracts 1 to get 0x3FFF_FFFF */ +#define ANYOF_POSIXL_SETALL(ret) \ + STMT_START { \ + ANYOF_POSIXL_BITMAP(ret) = nBIT_MASK(ANYOF_POSIXL_MAX); \ + } STMT_END +#define ANYOF_CLASS_SETALL(ret) ANYOF_POSIXL_SETALL(ret) -#define ANYOF_POSIXL_TEST_ANY_SET(p) \ - ((ANYOF_FLAGS(p) & ANYOF_MATCHES_POSIXL) && ANYOF_POSIXL_BITMAP(p)) +#define ANYOF_POSIXL_TEST_ANY_SET(p) \ + ((ANYOF_FLAGS(p) & ANYOF_MATCHES_POSIXL) && ANYOF_POSIXL_BITMAP(p)) #define ANYOF_CLASS_TEST_ANY_SET(p) ANYOF_POSIXL_TEST_ANY_SET(p) /* Since an SSC always has this field, we don't have to test for that; nor do * we want to because the bit isn't set for SSC during its construction */ -#define ANYOF_POSIXL_SSC_TEST_ANY_SET(p) \ - cBOOL(((regnode_ssc*)(p))->classflags) -#define ANYOF_POSIXL_SSC_TEST_ALL_SET(p) /* Are all bits set? */ \ - (((regnode_ssc*) (p))->classflags \ +#define ANYOF_POSIXL_SSC_TEST_ANY_SET(p) \ + cBOOL(((regnode_ssc*)(p))->classflags) +#define ANYOF_POSIXL_SSC_TEST_ALL_SET(p) \ + /* Are all bits set? */ \ + (((regnode_ssc*) (p))->classflags \ == nBIT_MASK(ANYOF_POSIXL_MAX)) -#define ANYOF_POSIXL_TEST_ALL_SET(p) \ - ((ANYOF_FLAGS(p) & ANYOF_MATCHES_POSIXL) \ - && ANYOF_POSIXL_BITMAP(p) == nBIT_MASK(ANYOF_POSIXL_MAX)) +#define ANYOF_POSIXL_TEST_ALL_SET(p) \ + ((ANYOF_FLAGS(p) & ANYOF_MATCHES_POSIXL) \ + && ANYOF_POSIXL_BITMAP(p) == nBIT_MASK(ANYOF_POSIXL_MAX)) -#define ANYOF_POSIXL_OR(source, dest) STMT_START { (dest)->classflags |= (source)->classflags ; } STMT_END +#define ANYOF_POSIXL_OR(source, dest) \ + STMT_START { (dest)->classflags |= (source)->classflags; } STMT_END #define ANYOF_CLASS_OR(source, dest) ANYOF_POSIXL_OR((source), (dest)) -#define ANYOF_POSIXL_AND(source, dest) STMT_START { (dest)->classflags &= (source)->classflags ; } STMT_END +#define ANYOF_POSIXL_AND(source, dest) \ + STMT_START { (dest)->classflags &= (source)->classflags; } STMT_END -#define ANYOF_BITMAP_ZERO(ret) Zero(((regnode_charclass*)(ret))->bitmap, ANYOF_BITMAP_SIZE, char) -#define ANYOF_BITMAP(p) ((regnode_charclass*)(p))->bitmap -#define ANYOF_BITMAP_BYTE(p, c) BITMAP_BYTE(ANYOF_BITMAP(p), c) -#define ANYOF_BITMAP_SET(p, c) (ANYOF_BITMAP_BYTE(p, c) |= ANYOF_BIT(c)) -#define ANYOF_BITMAP_CLEAR(p,c) (ANYOF_BITMAP_BYTE(p, c) &= ~ANYOF_BIT(c)) -#define ANYOF_BITMAP_TEST(p, c) cBOOL(ANYOF_BITMAP_BYTE(p, c) & ANYOF_BIT(c)) +#define ANYOF_BITMAP_ZERO(ret) \ + Zero(((regnode_charclass*)(ret))->bitmap, ANYOF_BITMAP_SIZE, char) +#define ANYOF_BITMAP(p) ((regnode_charclass*)(p))->bitmap +#define ANYOF_BITMAP_BYTE(p, c) BITMAP_BYTE(ANYOF_BITMAP(p), c) +#define ANYOF_BITMAP_SET(p, c) (ANYOF_BITMAP_BYTE(p, c) |= ANYOF_BIT(c)) +#define ANYOF_BITMAP_CLEAR(p,c) (ANYOF_BITMAP_BYTE(p, c) &= ~ANYOF_BIT(c)) +#define ANYOF_BITMAP_TEST(p, c) cBOOL(ANYOF_BITMAP_BYTE(p, c) & ANYOF_BIT(c)) -#define ANYOF_BITMAP_SETALL(p) \ - memset (ANYOF_BITMAP(p), 255, ANYOF_BITMAP_SIZE) -#define ANYOF_BITMAP_CLEARALL(p) \ - Zero (ANYOF_BITMAP(p), ANYOF_BITMAP_SIZE) +#define ANYOF_BITMAP_SETALL(p) \ + memset (ANYOF_BITMAP(p), 255, ANYOF_BITMAP_SIZE) +#define ANYOF_BITMAP_CLEARALL(p) \ + Zero (ANYOF_BITMAP(p), ANYOF_BITMAP_SIZE) /* * Utility definitions. - */ +*/ #ifndef CHARMASK -# define UCHARAT(p) ((int)*(const U8*)(p)) +# define UCHARAT(p) ((int)*(const U8*)(p)) #else -# define UCHARAT(p) ((int)*(p)&CHARMASK) +# define UCHARAT(p) ((int)*(p)&CHARMASK) #endif -/* Number of regnode equivalents that 'guy' occupies beyond the size of the - * smallest regnode. */ -#define EXTRA_SIZE(guy) ((sizeof(guy)-1)/sizeof(struct regnode)) +/* Number of regnode equivalents that 'guy' occupies + * beyond the size of the smallest regnode. */ +#define EXTRA_SIZE(guy) ((sizeof(guy)-1)/sizeof(struct regnode)) -#define REG_ZERO_LEN_SEEN 0x00000001 -#define REG_LOOKBEHIND_SEEN 0x00000002 +#define REG_ZERO_LEN_SEEN 0x00000001 +#define REG_LOOKBEHIND_SEEN 0x00000002 /* add a short form alias to keep the line length police happy */ -#define REG_LB_SEEN REG_LOOKBEHIND_SEEN -#define REG_GPOS_SEEN 0x00000004 +#define REG_LB_SEEN REG_LOOKBEHIND_SEEN +#define REG_GPOS_SEEN 0x00000004 /* spare */ -#define REG_RECURSE_SEEN 0x00000020 -#define REG_TOP_LEVEL_BRANCHES_SEEN 0x00000040 -#define REG_VERBARG_SEEN 0x00000080 -#define REG_CUTGROUP_SEEN 0x00000100 -#define REG_RUN_ON_COMMENT_SEEN 0x00000200 -#define REG_UNFOLDED_MULTI_SEEN 0x00000400 +#define REG_RECURSE_SEEN 0x00000020 +#define REG_TOP_LEVEL_BRANCHES_SEEN 0x00000040 +#define REG_VERBARG_SEEN 0x00000080 +#define REG_CUTGROUP_SEEN 0x00000100 +#define REG_RUN_ON_COMMENT_SEEN 0x00000200 +#define REG_UNFOLDED_MULTI_SEEN 0x00000400 /* spare */ -#define REG_UNBOUNDED_QUANTIFIER_SEEN 0x00001000 -#define REG_PESSIMIZE_SEEN 0x00002000 +#define REG_UNBOUNDED_QUANTIFIER_SEEN 0x00001000 +#define REG_PESSIMIZE_SEEN 0x00002000 START_EXTERN_C @@ -992,11 +1024,11 @@ START_EXTERN_C #ifndef DOINIT EXTCONST regexp_engine PL_core_reg_engine; #else /* DOINIT */ -EXTCONST regexp_engine PL_core_reg_engine = { +EXTCONST regexp_engine PL_core_reg_engine = { Perl_re_compile, Perl_regexec_flags, Perl_re_intuit_start, - Perl_re_intuit_string, + Perl_re_intuit_string, Perl_regfree_internal, Perl_reg_numbered_buff_fetch, Perl_reg_numbered_buff_store, @@ -1004,9 +1036,9 @@ EXTCONST regexp_engine PL_core_reg_engine = { Perl_reg_named_buff, Perl_reg_named_buff_iter, Perl_reg_qr_package, -#if defined(USE_ITHREADS) +#if defined(USE_ITHREADS) Perl_regdupe_internal, -#endif +#endif Perl_re_op_compile }; #endif /* DOINIT */ @@ -1017,65 +1049,58 @@ END_EXTERN_C /* .what is a character array with one character for each member of .data - * The character describes the function of the corresponding .data item: - * a - AV for paren_name_list under DEBUGGING - * f - start-class data for regstclass optimization - * l - start op for literal (?{EVAL}) item - * L - start op for literal (?{EVAL}) item, with separate CV (qr//) - * r - pointer to an embedded code-containing qr, e.g. /ab$qr/ - * s - inversion list for Unicode-style character class, and the - * multicharacter strings resulting from casefolding the single-character - * entries in the character class - * t - trie struct - * u - trie struct's widecharmap (a HV, so can't share, must dup) - * also used for revcharmap and words under DEBUGGING - * T - aho-trie struct - * S - sv for named capture lookup - * 20010712 mjd@plover.com + * The character describes the function of the corresponding .data item: a + * - AV for paren_name_list under DEBUGGING f - start-class data for + * regstclass optimization l - start op for literal (?{EVAL}) item L - + * start op for literal (?{EVAL}) item, with separate CV (qr//) r - pointer + * to an embedded code-containing qr, e.g. /ab$qr/ s - inversion list for + * Unicode-style character class, and the multicharacter strings resulting + * from casefolding the single-character entries in the character class t - + * trie struct u - trie struct's widecharmap (a HV, so can't share, must + * dup) also used for revcharmap and words under DEBUGGING T - aho-trie + * struct S - sv for named capture lookup 20010712 mjd@plover.com * (Remember to update re_dup() and pregfree() if you add any items.) */ struct reg_data { - U32 count; - U8 *what; - void* data[1]; + U32 count; + U8 *what; + void *data[1]; }; -/* Code in S_to_utf8_substr() and S_to_byte_substr() in regexec.c accesses - anchored* and float* via array indexes 0 and 1. */ -#define anchored_substr substrs->data[0].substr -#define anchored_utf8 substrs->data[0].utf8_substr -#define anchored_offset substrs->data[0].min_offset -#define anchored_end_shift substrs->data[0].end_shift - -#define float_substr substrs->data[1].substr -#define float_utf8 substrs->data[1].utf8_substr -#define float_min_offset substrs->data[1].min_offset -#define float_max_offset substrs->data[1].max_offset -#define float_end_shift substrs->data[1].end_shift - -#define check_substr substrs->data[2].substr -#define check_utf8 substrs->data[2].utf8_substr -#define check_offset_min substrs->data[2].min_offset -#define check_offset_max substrs->data[2].max_offset -#define check_end_shift substrs->data[2].end_shift - -#define RX_ANCHORED_SUBSTR(rx) (ReANY(rx)->anchored_substr) -#define RX_ANCHORED_UTF8(rx) (ReANY(rx)->anchored_utf8) -#define RX_FLOAT_SUBSTR(rx) (ReANY(rx)->float_substr) -#define RX_FLOAT_UTF8(rx) (ReANY(rx)->float_utf8) +/* Code in S_to_utf8_substr() and S_to_byte_substr() in regexec.c + accesses anchored* and float* via array indexes 0 and 1. */ +#define anchored_substr substrs->data[0].substr +#define anchored_utf8 substrs->data[0].utf8_substr +#define anchored_offset substrs->data[0].min_offset +#define anchored_end_shift substrs->data[0].end_shift + +#define float_substr substrs->data[1].substr +#define float_utf8 substrs->data[1].utf8_substr +#define float_min_offset substrs->data[1].min_offset +#define float_max_offset substrs->data[1].max_offset +#define float_end_shift substrs->data[1].end_shift + +#define check_substr substrs->data[2].substr +#define check_utf8 substrs->data[2].utf8_substr +#define check_offset_min substrs->data[2].min_offset +#define check_offset_max substrs->data[2].max_offset +#define check_end_shift substrs->data[2].end_shift + +#define RX_ANCHORED_SUBSTR(rx) (ReANY(rx)->anchored_substr) +#define RX_ANCHORED_UTF8(rx) (ReANY(rx)->anchored_utf8) +#define RX_FLOAT_SUBSTR(rx) (ReANY(rx)->float_substr) +#define RX_FLOAT_UTF8(rx) (ReANY(rx)->float_utf8) /* trie related stuff */ -/* a transition record for the state machine. the - check field determines which state "owns" the - transition. the char the transition is for is - determined by offset from the owning states base - field. the next field determines which state - is to be transitioned to if any. -*/ +/* a transition record for the state machine. the check field determines + which state "owns" the transition. the char the transition is for is + determined by offset from the owning states base field. the next + field determines which state is to be transitioned to if any. + */ struct _reg_trie_trans { - U32 next; - U32 check; + U32 next; + U32 check; }; /* a transition list element for the list based representation */ @@ -1085,27 +1110,25 @@ struct _reg_trie_trans_list_elem { }; typedef struct _reg_trie_trans_list_elem reg_trie_trans_le; -/* a state for compressed nodes. base is an offset - into an array of reg_trie_trans array. If wordnum is - nonzero the state is accepting. if base is zero then - the state has no children (and will be accepting) -*/ +/* a state for compressed nodes. base is an offset into an array of + reg_trie_trans array. If wordnum is nonzero the state is accepting. if + base is zero then the state has no children (and will be accepting) + */ struct _reg_trie_state { - U16 wordnum; - union { - U32 base; - reg_trie_trans_le* list; - } trans; + U16 wordnum; + union { + U32 base; + reg_trie_trans_le *list; + } trans; }; /* info per word; indexed by wordnum */ typedef struct { - U16 prev; /* previous word in acceptance chain; eg in - * zzz|abc|ab/ after matching the chars abc, the - * accepted word is #2, and the previous accepted - * word is #3 */ - U32 len; /* how many chars long is this word? */ - U32 accept; /* accept state for this word */ + U16 prev; /* previous word in acceptance chain; eg in zzz|abc|ab/ + * after matching the chars abc, the accepted word is + * #2, and the previous accepted word is #3 */ + U32 len; /* how many chars long is this word? */ + U32 accept; /* accept state for this word */ } reg_trie_wordinfo; @@ -1113,30 +1136,36 @@ typedef struct _reg_trie_state reg_trie_state; typedef struct _reg_trie_trans reg_trie_trans; -/* anything in here that needs to be freed later - should be dealt with in pregfree. - refcount is first in both this and _reg_ac_data to allow a space - optimisation in Perl_regdupe. */ +/* anything in here that needs to be freed later should be dealt with + in pregfree. refcount is first in both this and _reg_ac_data to + allow a space optimisation in Perl_regdupe. */ struct _reg_trie_data { - U32 refcount; /* number of times this trie is referenced */ - U32 lasttrans; /* last valid transition element */ - U16 *charmap; /* byte to charid lookup array */ - reg_trie_state *states; /* state data */ - reg_trie_trans *trans; /* array of transition elements */ - char *bitmap; /* stclass bitmap */ - U16 *jump; /* optional 1 indexed array of offsets before tail - for the node following a given word. */ - reg_trie_wordinfo *wordinfo; /* array of info per word */ - U16 uniquecharcount; /* unique chars in trie (width of trans table) */ - U32 startstate; /* initial state - used for common prefix optimisation */ - STRLEN minlen; /* minimum length of words in trie - build/opt only? */ - STRLEN maxlen; /* maximum length of words in trie - build/opt only? */ - U32 prefixlen; /* #chars in common prefix */ - U32 statecount; /* Build only - number of states in the states array - (including the unused zero state) */ - U32 wordcount; /* Build only */ + U32 refcount; /* number of times this trie + is referenced */ + U32 lasttrans; /* last valid transition element */ + U16 *charmap; /* byte to charid lookup array */ + reg_trie_state *states; /* state data */ + reg_trie_trans *trans; /* array of transition elements */ + char *bitmap; /* stclass bitmap */ + U16 *jump; /* optional 1 indexed array of + offsets before tail for the node + following a given word. */ + reg_trie_wordinfo *wordinfo; /* array of info per word */ + U16 uniquecharcount; /* unique chars in trie (width + of trans table) */ + U32 startstate; /* initial state - used for common + prefix optimisation */ + STRLEN minlen; /* minimum length of words in + trie - build/opt only? */ + STRLEN maxlen; /* maximum length of words in + trie - build/opt only? */ + U32 prefixlen; /* #chars in common prefix */ + U32 statecount; /* Build only - number of states + in the states array (including + the unused zero state) */ + U32 wordcount; /* Build only */ #ifdef DEBUGGING - STRLEN charcount; /* Build only */ + STRLEN charcount; /* Build only */ #endif }; /* There is one (3 under DEBUGGING) pointers that logically belong in this @@ -1149,17 +1178,17 @@ struct _reg_trie_data { #endif */ -#define TRIE_WORDS_OFFSET 2 +#define TRIE_WORDS_OFFSET 2 typedef struct _reg_trie_data reg_trie_data; -/* refcount is first in both this and _reg_trie_data to allow a space - optimisation in Perl_regdupe. */ +/* refcount is first in both this and _reg_trie_data to + allow a space optimisation in Perl_regdupe. */ struct _reg_ac_data { - U32 refcount; - U32 trie; - U32 *fail; - reg_trie_state *states; + U32 refcount; + U32 trie; + U32 *fail; + reg_trie_state *states; }; typedef struct _reg_ac_data reg_ac_data; @@ -1167,42 +1196,45 @@ typedef struct _reg_ac_data reg_ac_data; This is simpler than refactoring all of it as wed end up with three different sets... */ -#define TRIE_BITMAP(p) (((reg_trie_data *)(p))->bitmap) -#define TRIE_BITMAP_BYTE(p, c) BITMAP_BYTE(TRIE_BITMAP(p), c) -#define TRIE_BITMAP_SET(p, c) (TRIE_BITMAP_BYTE(p, c) |= ANYOF_BIT((U8)c)) -#define TRIE_BITMAP_CLEAR(p,c) (TRIE_BITMAP_BYTE(p, c) &= ~ANYOF_BIT((U8)c)) -#define TRIE_BITMAP_TEST(p, c) (TRIE_BITMAP_BYTE(p, c) & ANYOF_BIT((U8)c)) +#define TRIE_BITMAP(p) (((reg_trie_data *)(p))->bitmap) +#define TRIE_BITMAP_BYTE(p, c) BITMAP_BYTE(TRIE_BITMAP(p), c) +#define TRIE_BITMAP_SET(p, c) (TRIE_BITMAP_BYTE(p, c) |= ANYOF_BIT((U8)c)) +#define TRIE_BITMAP_CLEAR(p,c) (TRIE_BITMAP_BYTE(p, c) &= ~ANYOF_BIT((U8)c)) +#define TRIE_BITMAP_TEST(p, c) (TRIE_BITMAP_BYTE(p, c) & ANYOF_BIT((U8)c)) -#define IS_ANYOF_TRIE(op) ((op)==TRIEC || (op)==AHOCORASICKC) -#define IS_TRIE_AC(op) ((op)>=AHOCORASICK) +#define IS_ANYOF_TRIE(op) ((op)==TRIEC || (op)==AHOCORASICKC) +#define IS_TRIE_AC(op) ((op)>=AHOCORASICK) -/* these defines assume uniquecharcount is the correct variable, and state may be evaluated twice */ -#define TRIE_NODENUM(state) (((state)-1)/(trie->uniquecharcount)+1) -#define SAFE_TRIE_NODENUM(state) ((state) ? (((state)-1)/(trie->uniquecharcount)+1) : (state)) -#define TRIE_NODEIDX(state) ((state) ? (((state)-1)*(trie->uniquecharcount)+1) : (state)) +/* these defines assume uniquecharcount is the correct + variable, and state may be evaluated twice */ +#define TRIE_NODENUM(state) (((state)-1)/(trie->uniquecharcount)+1) +#define SAFE_TRIE_NODENUM(state) \ + ((state) ? (((state)-1)/(trie->uniquecharcount)+1) : (state)) +#define TRIE_NODEIDX(state) \ + ((state) ? (((state)-1)*(trie->uniquecharcount)+1) : (state)) #ifdef DEBUGGING -#define TRIE_CHARCOUNT(trie) ((trie)->charcount) +#define TRIE_CHARCOUNT(trie) ((trie)->charcount) #else -#define TRIE_CHARCOUNT(trie) (trie_charcount) +#define TRIE_CHARCOUNT(trie) (trie_charcount) #endif -#define RE_TRIE_MAXBUF_INIT 65536 +#define RE_TRIE_MAXBUF_INIT 65536 #define RE_TRIE_MAXBUF_NAME "\022E_TRIE_MAXBUF" -#define RE_DEBUG_FLAGS "\022E_DEBUG_FLAGS" +#define RE_DEBUG_FLAGS "\022E_DEBUG_FLAGS" -#define RE_COMPILE_RECURSION_INIT 1000 -#define RE_COMPILE_RECURSION_LIMIT "\022E_COMPILE_RECURSION_LIMIT" +#define RE_COMPILE_RECURSION_INIT 1000 +#define RE_COMPILE_RECURSION_LIMIT "\022E_COMPILE_RECURSION_LIMIT" /* -RE_DEBUG_FLAGS is used to control what debug output is emitted -its divided into three groups of options, some of which interact. -The three groups are: Compile, Execute, Extra. There is room for a +RE_DEBUG_FLAGS is used to control what debug output is emitted its +divided into three groups of options, some of which interact. The +three groups are: Compile, Execute, Extra. There is room for a further group, as currently only the low three bytes are used. Compile Options: - + PARSE PEEP TRIE @@ -1218,133 +1250,155 @@ further group, as currently only the low three bytes are used. TRIE -If you modify any of these make sure you make corresponding changes to -re.pm, especially to the documentation. - +If you modify any of these make sure you make corresponding +changes to re.pm, especially to the documentation. */ /* Compile */ -#define RE_DEBUG_COMPILE_MASK 0x0000FF -#define RE_DEBUG_COMPILE_PARSE 0x000001 -#define RE_DEBUG_COMPILE_OPTIMISE 0x000002 -#define RE_DEBUG_COMPILE_TRIE 0x000004 -#define RE_DEBUG_COMPILE_DUMP 0x000008 -#define RE_DEBUG_COMPILE_FLAGS 0x000010 -#define RE_DEBUG_COMPILE_TEST 0x000020 +#define RE_DEBUG_COMPILE_MASK 0x0000FF +#define RE_DEBUG_COMPILE_PARSE 0x000001 +#define RE_DEBUG_COMPILE_OPTIMISE 0x000002 +#define RE_DEBUG_COMPILE_TRIE 0x000004 +#define RE_DEBUG_COMPILE_DUMP 0x000008 +#define RE_DEBUG_COMPILE_FLAGS 0x000010 +#define RE_DEBUG_COMPILE_TEST 0x000020 /* Execute */ -#define RE_DEBUG_EXECUTE_MASK 0x00FF00 -#define RE_DEBUG_EXECUTE_INTUIT 0x000100 -#define RE_DEBUG_EXECUTE_MATCH 0x000200 -#define RE_DEBUG_EXECUTE_TRIE 0x000400 +#define RE_DEBUG_EXECUTE_MASK 0x00FF00 +#define RE_DEBUG_EXECUTE_INTUIT 0x000100 +#define RE_DEBUG_EXECUTE_MATCH 0x000200 +#define RE_DEBUG_EXECUTE_TRIE 0x000400 /* Extra */ -#define RE_DEBUG_EXTRA_MASK 0x3FF0000 -#define RE_DEBUG_EXTRA_TRIE 0x0010000 -#define RE_DEBUG_EXTRA_STATE 0x0080000 -#define RE_DEBUG_EXTRA_OPTIMISE 0x0100000 -#define RE_DEBUG_EXTRA_BUFFERS 0x0400000 -#define RE_DEBUG_EXTRA_GPOS 0x0800000 +#define RE_DEBUG_EXTRA_MASK 0x3FF0000 +#define RE_DEBUG_EXTRA_TRIE 0x0010000 +#define RE_DEBUG_EXTRA_STATE 0x0080000 +#define RE_DEBUG_EXTRA_OPTIMISE 0x0100000 +#define RE_DEBUG_EXTRA_BUFFERS 0x0400000 +#define RE_DEBUG_EXTRA_GPOS 0x0800000 #define RE_DEBUG_EXTRA_DUMP_PRE_OPTIMIZE 0x1000000 -#define RE_DEBUG_EXTRA_WILDCARD 0x2000000 +#define RE_DEBUG_EXTRA_WILDCARD 0x2000000 /* combined */ -#define RE_DEBUG_EXTRA_STACK 0x0280000 +#define RE_DEBUG_EXTRA_STACK 0x0280000 -#define RE_DEBUG_FLAG(x) (re_debug_flags & (x)) +#define RE_DEBUG_FLAG(x) (re_debug_flags & (x)) /* Compile */ -#define DEBUG_COMPILE_r(x) DEBUG_r( \ +#define DEBUG_COMPILE_r(x) \ + DEBUG_r( \ if (DEBUG_v_TEST || RE_DEBUG_FLAG(RE_DEBUG_COMPILE_MASK)) x ) -#define DEBUG_PARSE_r(x) DEBUG_r( \ +#define DEBUG_PARSE_r(x) \ + DEBUG_r( \ if (DEBUG_v_TEST || RE_DEBUG_FLAG(RE_DEBUG_COMPILE_PARSE)) x ) -#define DEBUG_OPTIMISE_r(x) DEBUG_r( \ +#define DEBUG_OPTIMISE_r(x) \ + DEBUG_r( \ if (DEBUG_v_TEST || RE_DEBUG_FLAG(RE_DEBUG_COMPILE_OPTIMISE)) x ) -#define DEBUG_DUMP_r(x) DEBUG_r( \ +#define DEBUG_DUMP_r(x) \ + DEBUG_r( \ if (DEBUG_v_TEST || RE_DEBUG_FLAG(RE_DEBUG_COMPILE_DUMP)) x ) -#define DEBUG_TRIE_COMPILE_r(x) DEBUG_r( \ +#define DEBUG_TRIE_COMPILE_r(x) \ + DEBUG_r( \ if (DEBUG_v_TEST || RE_DEBUG_FLAG(RE_DEBUG_COMPILE_TRIE)) x ) -#define DEBUG_FLAGS_r(x) DEBUG_r( \ +#define DEBUG_FLAGS_r(x) \ + DEBUG_r( \ if (DEBUG_v_TEST || RE_DEBUG_FLAG(RE_DEBUG_COMPILE_FLAGS)) x ) -#define DEBUG_TEST_r(x) DEBUG_r( \ +#define DEBUG_TEST_r(x) \ + DEBUG_r( \ if (DEBUG_v_TEST || RE_DEBUG_FLAG(RE_DEBUG_COMPILE_TEST)) x ) /* Execute */ -#define DEBUG_EXECUTE_r(x) DEBUG_r( \ +#define DEBUG_EXECUTE_r(x) \ + DEBUG_r( \ if (DEBUG_v_TEST || RE_DEBUG_FLAG(RE_DEBUG_EXECUTE_MASK)) x ) -#define DEBUG_INTUIT_r(x) DEBUG_r( \ +#define DEBUG_INTUIT_r(x) \ + DEBUG_r( \ if (DEBUG_v_TEST || RE_DEBUG_FLAG(RE_DEBUG_EXECUTE_INTUIT)) x ) -#define DEBUG_MATCH_r(x) DEBUG_r( \ +#define DEBUG_MATCH_r(x) \ + DEBUG_r( \ if (DEBUG_v_TEST || RE_DEBUG_FLAG(RE_DEBUG_EXECUTE_MATCH)) x ) -#define DEBUG_TRIE_EXECUTE_r(x) DEBUG_r( \ +#define DEBUG_TRIE_EXECUTE_r(x) \ + DEBUG_r( \ if (DEBUG_v_TEST || RE_DEBUG_FLAG(RE_DEBUG_EXECUTE_TRIE)) x ) /* Extra */ -#define DEBUG_EXTRA_r(x) DEBUG_r( \ +#define DEBUG_EXTRA_r(x) \ + DEBUG_r( \ if (DEBUG_v_TEST || RE_DEBUG_FLAG(RE_DEBUG_EXTRA_MASK)) x ) -#define DEBUG_STATE_r(x) DEBUG_r( \ +#define DEBUG_STATE_r(x) \ + DEBUG_r( \ if (DEBUG_v_TEST || RE_DEBUG_FLAG(RE_DEBUG_EXTRA_STATE)) x ) -#define DEBUG_STACK_r(x) DEBUG_r( \ +#define DEBUG_STACK_r(x) \ + DEBUG_r( \ if (DEBUG_v_TEST || RE_DEBUG_FLAG(RE_DEBUG_EXTRA_STACK)) x ) -#define DEBUG_BUFFERS_r(x) DEBUG_r( \ +#define DEBUG_BUFFERS_r(x) \ + DEBUG_r( \ if (DEBUG_v_TEST || RE_DEBUG_FLAG(RE_DEBUG_EXTRA_BUFFERS)) x ) -#define DEBUG_OPTIMISE_MORE_r(x) DEBUG_r( \ +#define DEBUG_OPTIMISE_MORE_r(x) \ + DEBUG_r( \ if (DEBUG_v_TEST || ((RE_DEBUG_EXTRA_OPTIMISE|RE_DEBUG_COMPILE_OPTIMISE) == \ RE_DEBUG_FLAG(RE_DEBUG_EXTRA_OPTIMISE|RE_DEBUG_COMPILE_OPTIMISE))) x ) -#define DEBUG_TRIE_COMPILE_MORE_r(x) DEBUG_TRIE_COMPILE_r( \ +#define DEBUG_TRIE_COMPILE_MORE_r(x) \ + DEBUG_TRIE_COMPILE_r( \ if (DEBUG_v_TEST || RE_DEBUG_FLAG(RE_DEBUG_EXTRA_TRIE)) x ) -#define DEBUG_TRIE_EXECUTE_MORE_r(x) DEBUG_TRIE_EXECUTE_r( \ +#define DEBUG_TRIE_EXECUTE_MORE_r(x) \ + DEBUG_TRIE_EXECUTE_r( \ if (DEBUG_v_TEST || RE_DEBUG_FLAG(RE_DEBUG_EXTRA_TRIE)) x ) -#define DEBUG_TRIE_r(x) DEBUG_r( \ +#define DEBUG_TRIE_r(x) \ + DEBUG_r( \ if (DEBUG_v_TEST || RE_DEBUG_FLAG(RE_DEBUG_COMPILE_TRIE \ | RE_DEBUG_EXECUTE_TRIE )) x ) -#define DEBUG_GPOS_r(x) DEBUG_r( \ +#define DEBUG_GPOS_r(x) \ + DEBUG_r( \ if (DEBUG_v_TEST || RE_DEBUG_FLAG(RE_DEBUG_EXTRA_GPOS)) x ) -#define DEBUG_DUMP_PRE_OPTIMIZE_r(x) DEBUG_r( \ +#define DEBUG_DUMP_PRE_OPTIMIZE_r(x) \ + DEBUG_r( \ if (DEBUG_v_TEST || RE_DEBUG_FLAG(RE_DEBUG_EXTRA_DUMP_PRE_OPTIMIZE)) x ) /* initialization */ -/* Get the debug flags for code not in regcomp.c nor regexec.c. This doesn't - * initialize the variable if it isn't already there, instead it just assumes - * the flags are 0 */ -#define DECLARE_AND_GET_RE_DEBUG_FLAGS_NON_REGEX \ - volatile IV re_debug_flags = 0; PERL_UNUSED_VAR(re_debug_flags); \ - STMT_START { \ - SV * re_debug_flags_sv = NULL; \ - /* get_sv() can return NULL during global destruction. */ \ - re_debug_flags_sv = PL_curcop ? get_sv(RE_DEBUG_FLAGS, GV_ADD) : NULL; \ - if (re_debug_flags_sv && SvIOK(re_debug_flags_sv)) \ - re_debug_flags=SvIV(re_debug_flags_sv); \ +/* Get the debug flags for code not in regcomp.c nor regexec.c. + * This doesn't initialize the variable if it isn't already there, + * instead it just assumes the flags are 0 */ +#define DECLARE_AND_GET_RE_DEBUG_FLAGS_NON_REGEX \ + volatile IV re_debug_flags = 0; PERL_UNUSED_VAR(re_debug_flags); \ + STMT_START { \ + SV * re_debug_flags_sv = NULL; \ + /* get_sv() can return NULL during global destruction. */ \ + re_debug_flags_sv = PL_curcop ? get_sv(RE_DEBUG_FLAGS, GV_ADD) : NULL; \ + if (re_debug_flags_sv && SvIOK(re_debug_flags_sv)) \ + re_debug_flags=SvIV(re_debug_flags_sv); \ } STMT_END #ifdef DEBUGGING -/* For use in regcomp.c and regexec.c, Get the debug flags, and initialize to - * the defaults if not done already */ -#define DECLARE_AND_GET_RE_DEBUG_FLAGS \ - volatile IV re_debug_flags = 0; PERL_UNUSED_VAR(re_debug_flags); \ - DEBUG_r({ \ - SV * re_debug_flags_sv = NULL; \ - /* get_sv() can return NULL during global destruction. */ \ - re_debug_flags_sv = PL_curcop ? get_sv(RE_DEBUG_FLAGS, GV_ADD) : NULL; \ - if (re_debug_flags_sv) { \ - if (!SvIOK(re_debug_flags_sv)) /* If doesn't exist set to default */\ - sv_setuv(re_debug_flags_sv, \ - /* These defaults should be kept in sync with re.pm */ \ - RE_DEBUG_COMPILE_DUMP | RE_DEBUG_EXECUTE_MASK ); \ - re_debug_flags=SvIV(re_debug_flags_sv); \ - } \ +/* For use in regcomp.c and regexec.c, Get the debug flags, + * and initialize to the defaults if not done already */ +#define DECLARE_AND_GET_RE_DEBUG_FLAGS \ + volatile IV re_debug_flags = 0; PERL_UNUSED_VAR(re_debug_flags); \ + DEBUG_r({ \ + SV * re_debug_flags_sv = NULL; \ + /* get_sv() can return NULL during global destruction. */ \ + re_debug_flags_sv = PL_curcop ? get_sv(RE_DEBUG_FLAGS, GV_ADD) : NULL; \ + if (re_debug_flags_sv) { \ + if (!SvIOK(re_debug_flags_sv)) /* If doesn't exist set + to default */ \ + sv_setuv(re_debug_flags_sv, \ + /* These defaults should be kept in sync with re.pm */ \ + RE_DEBUG_COMPILE_DUMP | RE_DEBUG_EXECUTE_MASK ); \ + re_debug_flags=SvIV(re_debug_flags_sv); \ + } \ }) -#define isDEBUG_WILDCARD (DEBUG_v_TEST || RE_DEBUG_FLAG(RE_DEBUG_EXTRA_WILDCARD)) +#define isDEBUG_WILDCARD \ + (DEBUG_v_TEST || RE_DEBUG_FLAG(RE_DEBUG_EXTRA_WILDCARD)) -#define RE_PV_COLOR_DECL(rpv,rlen,isuni,dsv,pv,l,m,c1,c2) \ - const char * const rpv = \ - pv_pretty((dsv), (pv), (l), (m), \ - PL_colors[(c1)],PL_colors[(c2)], \ - PERL_PV_ESCAPE_RE|PERL_PV_ESCAPE_NONASCII |((isuni) ? PERL_PV_ESCAPE_UNI : 0) ); \ +#define RE_PV_COLOR_DECL(rpv,rlen,isuni,dsv,pv,l,m,c1,c2) \ + const char * const rpv = \ + pv_pretty((dsv), (pv), (l), (m), \ + PL_colors[(c1)],PL_colors[(c2)], \ + PERL_PV_ESCAPE_RE|PERL_PV_ESCAPE_NONASCII |((isuni) ? PERL_PV_ESCAPE_UNI : 0) ); \ const int rlen = SvCUR(dsv) /* This is currently unsed in the core */ @@ -1354,30 +1408,30 @@ re.pm, especially to the documentation. PL_colors[(c1)],PL_colors[(c2)], \ PERL_PV_ESCAPE_RE|PERL_PV_ESCAPE_NONASCII |((isuni) ? PERL_PV_ESCAPE_UNI : 0) ) -#define RE_PV_QUOTED_DECL(rpv,isuni,dsv,pv,l,m) \ - const char * const rpv = \ - pv_pretty((dsv), (pv), (l), (m), \ - PL_colors[0], PL_colors[1], \ - ( PERL_PV_PRETTY_QUOTE | PERL_PV_ESCAPE_RE | PERL_PV_ESCAPE_NONASCII | PERL_PV_PRETTY_ELLIPSES | \ - ((isuni) ? PERL_PV_ESCAPE_UNI : 0)) \ +#define RE_PV_QUOTED_DECL(rpv,isuni,dsv,pv,l,m) \ + const char * const rpv = \ + pv_pretty((dsv), (pv), (l), (m), \ + PL_colors[0], PL_colors[1], \ + ( PERL_PV_PRETTY_QUOTE | PERL_PV_ESCAPE_RE | PERL_PV_ESCAPE_NONASCII | PERL_PV_PRETTY_ELLIPSES | \ + ((isuni) ? PERL_PV_ESCAPE_UNI : 0)) \ ) -#define RE_SV_DUMPLEN(ItEm) (SvCUR(ItEm) - (SvTAIL(ItEm)!=0)) -#define RE_SV_TAIL(ItEm) (SvTAIL(ItEm) ? "$" : "") - +#define RE_SV_DUMPLEN(ItEm) (SvCUR(ItEm) - (SvTAIL(ItEm)!=0)) +#define RE_SV_TAIL(ItEm) (SvTAIL(ItEm) ? "$" : "") + #else /* if not DEBUGGING */ -#define DECLARE_AND_GET_RE_DEBUG_FLAGS dNOOP -#define RE_PV_COLOR_DECL(rpv,rlen,isuni,dsv,pv,l,m,c1,c2) dNOOP +#define DECLARE_AND_GET_RE_DEBUG_FLAGS dNOOP +#define RE_PV_COLOR_DECL(rpv,rlen,isuni,dsv,pv,l,m,c1,c2) dNOOP #define RE_SV_ESCAPE(rpv,isuni,dsv,sv,m) -#define RE_PV_QUOTED_DECL(rpv,isuni,dsv,pv,l,m) dNOOP +#define RE_PV_QUOTED_DECL(rpv,isuni,dsv,pv,l,m) dNOOP #define RE_SV_DUMPLEN(ItEm) #define RE_SV_TAIL(ItEm) -#define isDEBUG_WILDCARD 0 +#define isDEBUG_WILDCARD 0 #endif /* DEBUG RELATED DEFINES */ -#define FIRST_NON_ASCII_DECIMAL_DIGIT 0x660 /* ARABIC_INDIC_DIGIT_ZERO */ +#define FIRST_NON_ASCII_DECIMAL_DIGIT 0x660 /* ARABIC_INDIC_DIGIT_ZERO */ typedef enum { TRADITIONAL_BOUND = CC_WORDCHAR_, @@ -1391,48 +1445,49 @@ typedef enum { * gives the strict lower bound for the UTF-8 start byte of any code point * matchable by the node, and a loose upper bound as well. * - * The low bound is stored as 0xC0 + ((the upper 6 bits) >> 2) - * The loose upper bound is determined from the lowest 2 bits and the low bound + * The low bound is stored as 0xC0 + ((the upper 6 bits) >> 2) The loose + * upper bound is determined from the lowest 2 bits and the low bound * (called x) as follows: * - * 11 The upper limit of the range can be as much as (EF - x) / 8 - * 10 The upper limit of the range can be as much as (EF - x) / 4 - * 01 The upper limit of the range can be as much as (EF - x) / 2 - * 00 The upper limit of the range can be as much as EF + * 11 The upper limit of the range can be as much as (EF - x) / 8 10 The + * upper limit of the range can be as much as (EF - x) / 4 01 The upper + * limit of the range can be as much as (EF - x) / 2 00 The upper limit of + * the range can be as much as EF * * For motivation of this design, see commit message in * 3146c00a633e9cbed741e10146662fbcedfdb8d3 */ #ifdef EBCDIC -# define MAX_ANYOF_HRx_BYTE 0xF4 +# define MAX_ANYOF_HRx_BYTE 0xF4 #else -# define MAX_ANYOF_HRx_BYTE 0xEF +# define MAX_ANYOF_HRx_BYTE 0xEF #endif -#define LOWEST_ANYOF_HRx_BYTE(b) (((b) >> 2) + 0xC0) -#define HIGHEST_ANYOF_HRx_BYTE(b) \ - (LOWEST_ANYOF_HRx_BYTE(b) \ - + ((MAX_ANYOF_HRx_BYTE - LOWEST_ANYOF_HRx_BYTE(b)) >> ((b) & 3))) +#define LOWEST_ANYOF_HRx_BYTE(b) (((b) >> 2) + 0xC0) +#define HIGHEST_ANYOF_HRx_BYTE(b) \ + (LOWEST_ANYOF_HRx_BYTE(b) \ + + ((MAX_ANYOF_HRx_BYTE - LOWEST_ANYOF_HRx_BYTE(b)) >> ((b) & 3))) #if !defined(PERL_IN_XSUB_RE) || defined(PLUGGABLE_RE_EXTENSION) # define GET_REGCLASS_AUX_DATA(a,b,c,d,e,f) get_regclass_aux_data(a,b,c,d,e,f) #else -# define GET_REGCLASS_AUX_DATA(a,b,c,d,e,f) get_re_gclass_aux_data(a,b,c,d,e,f) +# define GET_REGCLASS_AUX_DATA(a,b,c,d,e,f) \ + get_re_gclass_aux_data(a,b,c,d,e,f) #endif -#define REGNODE_TYPE(node) (PL_regnode_info[(node)].type) -#define REGNODE_OFF_BY_ARG(node) (PL_regnode_info[(node)].off_by_arg) -#define REGNODE_ARG_LEN(node) (PL_regnode_info[(node)].arg_len) -#define REGNODE_ARG_LEN_VARIES(node) (PL_regnode_info[(node)].arg_len_varies) -#define REGNODE_NAME(node) (PL_regnode_name[(node)]) +#define REGNODE_TYPE(node) (PL_regnode_info[(node)].type) +#define REGNODE_OFF_BY_ARG(node) (PL_regnode_info[(node)].off_by_arg) +#define REGNODE_ARG_LEN(node) (PL_regnode_info[(node)].arg_len) +#define REGNODE_ARG_LEN_VARIES(node) (PL_regnode_info[(node)].arg_len_varies) +#define REGNODE_NAME(node) (PL_regnode_name[(node)]) #if defined(PERL_IN_REGEX_ENGINE) #include "reginline.h" #endif #define EVAL_OPTIMISTIC_FLAG 128 -#define EVAL_FLAGS_MASK (EVAL_OPTIMISTIC_FLAG-1) +#define EVAL_FLAGS_MASK (EVAL_OPTIMISTIC_FLAG-1) #endif /* PERL_REGCOMP_H_ */ /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/regcomp_internal.h b/regcomp_internal.h index c273d2f70f0e..941127ca4396 100644 --- a/regcomp_internal.h +++ b/regcomp_internal.h @@ -1,76 +1,105 @@ #ifndef REGCOMP_INTERNAL_H #define REGCOMP_INTERNAL_H #ifndef STATIC -#define STATIC static +#define STATIC static #endif #ifndef RE_OPTIMIZE_CURLYX_TO_CURLYM -#define RE_OPTIMIZE_CURLYX_TO_CURLYM 1 +#define RE_OPTIMIZE_CURLYX_TO_CURLYM 1 #endif #ifndef RE_OPTIMIZE_CURLYX_TO_CURLYN -#define RE_OPTIMIZE_CURLYX_TO_CURLYN 1 +#define RE_OPTIMIZE_CURLYX_TO_CURLYN 1 #endif -/* this is a chain of data about sub patterns we are processing that - need to be handled separately/specially in study_chunk. Its so - we can simulate recursion without losing state. */ +/* this is a chain of data about sub patterns we are processing + that need to be handled separately/specially in study_chunk. + Its so we can simulate recursion without losing state. */ struct scan_frame; typedef struct scan_frame { - regnode *last_regnode; /* last node to process in this frame */ - regnode *next_regnode; /* next node to process when last is reached */ - U32 prev_recursed_depth; - I32 stopparen; /* what stopparen do we use */ - bool in_gosub; /* this or an outer frame is for GOSUB */ - - struct scan_frame *this_prev_frame; /* this previous frame */ - struct scan_frame *prev_frame; /* previous frame */ - struct scan_frame *next_frame; /* next frame */ + regnode *last_regnode; /* last node to process + in this frame */ + regnode *next_regnode; /* next node to process when + last is reached */ + U32 prev_recursed_depth; + I32 stopparen; /* what stopparen do we use */ + bool in_gosub; /* this or an outer frame + is for GOSUB */ + + struct scan_frame *this_prev_frame; /* this previous frame */ + struct scan_frame *prev_frame; /* previous frame */ + struct scan_frame *next_frame; /* next frame */ } scan_frame; -/* Certain characters are output as a sequence with the first being a - * backslash. */ -#define isBACKSLASHED_PUNCT(c) memCHRs("-[]\\^", c) +/* Certain characters are output as a sequence + * with the first being a backslash. */ +#define isBACKSLASHED_PUNCT(c) memCHRs("-[]\\^", c) struct RExC_state_t { - U32 flags; /* RXf_* are we folding, multilining? */ - U32 pm_flags; /* PMf_* stuff from the calling PMOP */ - char *precomp; /* uncompiled string. */ - char *precomp_end; /* pointer to end of uncompiled string. */ - REGEXP *rx_sv; /* The SV that is the regexp. */ - regexp *rx; /* perl core regexp structure */ - regexp_internal *rxi; /* internal data for regexp object - pprivate field */ - char *start; /* Start of input for compile */ - char *end; /* End of input for compile */ - char *parse; /* Input-scan pointer. */ - char *copy_start; /* start of copy of input within - constructed parse string */ - char *save_copy_start; /* Provides one level of saving - and restoring 'copy_start' */ - char *copy_start_in_input; /* Position in input string - corresponding to copy_start */ - SSize_t whilem_seen; /* number of WHILEM in this expr */ - regnode *emit_start; /* Start of emitted-code area */ - regnode_offset emit; /* Code-emit pointer */ - I32 naughty; /* How bad is this pattern? */ - I32 sawback; /* Did we see \1, ...? */ - SSize_t size; /* Number of regnode equivalents in - pattern */ - Size_t sets_depth; /* Counts recursion depth of already- - compiled regex set patterns */ - U32 seen; - - I32 parens_buf_size; /* #slots malloced open/close_parens */ - regnode_offset *open_parens; /* offsets to open parens */ - regnode_offset *close_parens; /* offsets to close parens */ - HV *paren_names; /* Paren names */ - - /* position beyond 'precomp' of the warning message furthest away from - * 'precomp'. During the parse, no warnings are raised for any problems - * earlier in the parse than this position. This works if warnings are - * raised the first time a given spot is parsed, and if only one - * independent warning is raised for any given spot */ - Size_t latest_warn_offset; + U32 flags; /* RXf_* are we + folding, + multilining? */ + U32 pm_flags; /* PMf_* stuff from the + calling PMOP */ + char *precomp; /* uncompiled string. + */ + char *precomp_end; /* pointer to end + of uncompiled + string. */ + REGEXP *rx_sv; /* The SV that is the + regexp. */ + regexp *rx; /* perl core regexp + structure */ + regexp_internal *rxi; /* internal data for + regexp object + pprivate field */ + char *start; /* Start of input for + compile */ + char *end; /* End of input for + compile */ + char *parse; /* Input-scan pointer. + */ + char *copy_start; /* start of copy of + input within + constructed + parse string */ + char *save_copy_start; /* Provides one level + of saving and + restoring + 'copy_start' */ + char *copy_start_in_input; /* Position in input + string corresponding + to copy_start */ + SSize_t whilem_seen; /* number of WHILEM + in this expr */ + regnode *emit_start; /* Start of + emitted-code area */ + regnode_offset emit; /* Code-emit pointer */ + I32 naughty; /* How bad is this + pattern? */ + I32 sawback; /* Did we see \1, ...? */ + SSize_t size; /* Number of regnode + equivalents in + pattern */ + Size_t sets_depth; /* Counts recursion + depth of already- + compiled regex + set patterns */ + U32 seen; + + I32 parens_buf_size; /* #slots malloced + open/close_parens */ + regnode_offset *open_parens; /* offsets to open + parens */ + regnode_offset *close_parens; /* offsets to close + parens */ + HV *paren_names; /* Paren names */ + + /* position beyond 'precomp' of the warning message furthest away + * from 'precomp'. During the parse, no warnings are raised for any + * problems earlier in the parse than this position. This works if + * warnings are raised the first time a given spot is parsed, and if + * only one independent warning is raised for any given spot */ + Size_t latest_warn_offset; /* Branch reset /(?|...|...)/ gives us two concepts of capture buffer id. * "Logical Parno" is the user visible view with branch reset taken into @@ -106,167 +135,201 @@ struct RExC_state_t { * used we do not need to populate this data into the final regexp. * */ - I32 *logical_to_parno; /* logical_parno to parno */ - I32 *parno_to_logical; /* parno to logical_parno */ - I32 *parno_to_logical_next; /* parno to next (greater value) - parno with the same - logical_parno as parno.*/ - - I32 npar; /* Capture buffer count so far in the - parse, (OPEN) plus one. ("par" 0 is - the whole pattern)*/ - I32 logical_npar; /* Logical version of npar */ - I32 total_par; /* During initial parse, is either 0, - or -1; the latter indicating a - reparse is needed. After that pass, - it is what 'npar' became after the - pass. Hence, it being > 0 indicates - we are in a reparse situation */ - I32 logical_total_par; /* Logical version to total par */ - I32 nestroot; /* root parens we are in - used by - accept */ - I32 seen_zerolen; - regnode *end_op; /* END node in program */ - I32 utf8; /* whether the pattern is utf8 or not */ - I32 orig_utf8; /* whether the pattern was originally in utf8 */ - /* XXX use this for future optimisation of case - * where pattern must be upgraded to utf8. */ - I32 uni_semantics; /* If a d charset modifier should use unicode - rules, even if the pattern is not in - utf8 */ - - I32 recurse_count; /* Number of recurse regops we have generated */ - regnode **recurse; /* Recurse regops */ - U8 *study_chunk_recursed; /* bitmap of which subs we have moved - through */ - U32 study_chunk_recursed_bytes; /* bytes in bitmap */ - I32 in_lookaround; - I32 contains_locale; - I32 override_recoding; - I32 recode_x_to_native; - I32 in_multi_char_class; - int code_index; /* next code_blocks[] slot */ - struct reg_code_blocks *code_blocks;/* positions of literal (?{}) - within pattern */ - SSize_t maxlen; /* mininum possible number of chars in string to match */ - scan_frame *frame_head; - scan_frame *frame_last; - U32 frame_count; - AV *warn_text; - HV *unlexed_names; - SV *runtime_code_qr; /* qr with the runtime code blocks */ + I32 *logical_to_parno; /* logical_parno + to parno */ + I32 *parno_to_logical; /* parno to + logical_parno */ + I32 *parno_to_logical_next; /* parno to next + (greater value) + parno with the same + logical_parno as + parno. */ + + I32 npar; /* Capture buffer count + so far in the parse, + (OPEN) plus one. + ("par" 0 is the + whole pattern) */ + I32 logical_npar; /* Logical version + of npar */ + I32 total_par; /* During initial + parse, is either 0, + or -1; the latter + indicating a + reparse is needed. + After that pass, it + is what 'npar' + became after the + pass. Hence, it + being > 0 indicates + we are in a reparse + situation */ + I32 logical_total_par; /* Logical version to + total par */ + I32 nestroot; /* root parens we + are in - used + by accept */ + I32 seen_zerolen; + regnode *end_op; /* END node in + program */ + I32 utf8; /* whether the pattern + is utf8 or not */ + I32 orig_utf8; /* whether the pattern + was originally in + utf8 */ + /* XXX use this for future optimisation of case + * where pattern must be upgraded to utf8. */ + I32 uni_semantics; /* If a d charset + modifier should use + unicode rules, even + if the pattern is + not in utf8 */ + + I32 recurse_count; /* Number of recurse + regops we have + generated */ + regnode **recurse; /* Recurse regops */ + U8 *study_chunk_recursed; /* bitmap of which + subs we have moved + through */ + U32 study_chunk_recursed_bytes; /* bytes in bitmap */ + I32 in_lookaround; + I32 contains_locale; + I32 override_recoding; + I32 recode_x_to_native; + I32 in_multi_char_class; + int code_index; /* next code_blocks[] + slot */ + struct reg_code_blocks *code_blocks; /* positions of literal + (?{}) within pattern + */ + SSize_t maxlen; /* mininum possible + number of chars in + string to match */ + scan_frame *frame_head; + scan_frame *frame_last; + U32 frame_count; + AV *warn_text; + HV *unlexed_names; + SV *runtime_code_qr; /* qr with the runtime + code blocks */ #ifdef DEBUGGING - const char *lastparse; - I32 lastnum; - U32 study_chunk_recursed_count; - AV *paren_name_list; /* idx -> name */ - SV *mysv1; - SV *mysv2; + const char *lastparse; + I32 lastnum; + U32 study_chunk_recursed_count; + AV *paren_name_list; /* idx -> name */ + SV *mysv1; + SV *mysv2; #endif - bool seen_d_op; - bool strict; - bool study_started; - bool in_script_run; - bool use_BRANCHJ; - bool sWARN_EXPERIMENTAL__VLB; - bool sWARN_EXPERIMENTAL__REGEX_SETS; + bool seen_d_op; + bool strict; + bool study_started; + bool in_script_run; + bool use_BRANCHJ; + bool sWARN_EXPERIMENTAL__VLB; + bool sWARN_EXPERIMENTAL__REGEX_SETS; }; #ifdef DEBUGGING -#define RExC_lastparse (pRExC_state->lastparse) -#define RExC_lastnum (pRExC_state->lastnum) -#define RExC_paren_name_list (pRExC_state->paren_name_list) -#define RExC_study_chunk_recursed_count (pRExC_state->study_chunk_recursed_count) -#define RExC_mysv (pRExC_state->mysv1) -#define RExC_mysv1 (pRExC_state->mysv1) -#define RExC_mysv2 (pRExC_state->mysv2) +#define RExC_lastparse (pRExC_state->lastparse) +#define RExC_lastnum (pRExC_state->lastnum) +#define RExC_paren_name_list (pRExC_state->paren_name_list) +#define RExC_study_chunk_recursed_count \ + (pRExC_state->study_chunk_recursed_count) +#define RExC_mysv (pRExC_state->mysv1) +#define RExC_mysv1 (pRExC_state->mysv1) +#define RExC_mysv2 (pRExC_state->mysv2) #endif -#define RExC_flags (pRExC_state->flags) -#define RExC_pm_flags (pRExC_state->pm_flags) -#define RExC_precomp (pRExC_state->precomp) -#define RExC_copy_start_in_input (pRExC_state->copy_start_in_input) -#define RExC_copy_start_in_constructed (pRExC_state->copy_start) -#define RExC_save_copy_start_in_constructed (pRExC_state->save_copy_start) -#define RExC_precomp_end (pRExC_state->precomp_end) -#define RExC_rx_sv (pRExC_state->rx_sv) -#define RExC_rx (pRExC_state->rx) -#define RExC_rxi (pRExC_state->rxi) -#define RExC_start (pRExC_state->start) -#define RExC_end (pRExC_state->end) -#define RExC_parse (pRExC_state->parse) -#define RExC_latest_warn_offset (pRExC_state->latest_warn_offset ) -#define RExC_whilem_seen (pRExC_state->whilem_seen) -#define RExC_seen_d_op (pRExC_state->seen_d_op) /* Seen something that differs - under /d from /u ? */ - -#define RExC_emit (pRExC_state->emit) -#define RExC_emit_start (pRExC_state->emit_start) -#define RExC_sawback (pRExC_state->sawback) -#define RExC_seen (pRExC_state->seen) -#define RExC_size (pRExC_state->size) -#define RExC_maxlen (pRExC_state->maxlen) +#define RExC_flags (pRExC_state->flags) +#define RExC_pm_flags (pRExC_state->pm_flags) +#define RExC_precomp (pRExC_state->precomp) +#define RExC_copy_start_in_input (pRExC_state->copy_start_in_input) +#define RExC_copy_start_in_constructed (pRExC_state->copy_start) +#define RExC_save_copy_start_in_constructed (pRExC_state->save_copy_start) +#define RExC_precomp_end (pRExC_state->precomp_end) +#define RExC_rx_sv (pRExC_state->rx_sv) +#define RExC_rx (pRExC_state->rx) +#define RExC_rxi (pRExC_state->rxi) +#define RExC_start (pRExC_state->start) +#define RExC_end (pRExC_state->end) +#define RExC_parse (pRExC_state->parse) +#define RExC_latest_warn_offset (pRExC_state->latest_warn_offset ) +#define RExC_whilem_seen (pRExC_state->whilem_seen) +#define RExC_seen_d_op (pRExC_state->seen_d_op) /* Seen something + that differs + under /d from + /u ? */ + +#define RExC_emit (pRExC_state->emit) +#define RExC_emit_start (pRExC_state->emit_start) +#define RExC_sawback (pRExC_state->sawback) +#define RExC_seen (pRExC_state->seen) +#define RExC_size (pRExC_state->size) +#define RExC_maxlen (pRExC_state->maxlen) #define RExC_logical_npar (pRExC_state->logical_npar) #define RExC_logical_total_parens (pRExC_state->logical_total_par) #define RExC_logical_to_parno (pRExC_state->logical_to_parno) #define RExC_parno_to_logical (pRExC_state->parno_to_logical) #define RExC_parno_to_logical_next (pRExC_state->parno_to_logical_next) -#define RExC_npar (pRExC_state->npar) -#define RExC_total_parens (pRExC_state->total_par) -#define RExC_parens_buf_size (pRExC_state->parens_buf_size) -#define RExC_nestroot (pRExC_state->nestroot) -#define RExC_seen_zerolen (pRExC_state->seen_zerolen) -#define RExC_utf8 (pRExC_state->utf8) -#define RExC_uni_semantics (pRExC_state->uni_semantics) -#define RExC_orig_utf8 (pRExC_state->orig_utf8) -#define RExC_open_parens (pRExC_state->open_parens) -#define RExC_close_parens (pRExC_state->close_parens) -#define RExC_end_op (pRExC_state->end_op) -#define RExC_paren_names (pRExC_state->paren_names) -#define RExC_recurse (pRExC_state->recurse) -#define RExC_recurse_count (pRExC_state->recurse_count) -#define RExC_sets_depth (pRExC_state->sets_depth) -#define RExC_study_chunk_recursed (pRExC_state->study_chunk_recursed) -#define RExC_study_chunk_recursed_bytes \ - (pRExC_state->study_chunk_recursed_bytes) -#define RExC_in_lookaround (pRExC_state->in_lookaround) -#define RExC_contains_locale (pRExC_state->contains_locale) -#define RExC_recode_x_to_native (pRExC_state->recode_x_to_native) +#define RExC_npar (pRExC_state->npar) +#define RExC_total_parens (pRExC_state->total_par) +#define RExC_parens_buf_size (pRExC_state->parens_buf_size) +#define RExC_nestroot (pRExC_state->nestroot) +#define RExC_seen_zerolen (pRExC_state->seen_zerolen) +#define RExC_utf8 (pRExC_state->utf8) +#define RExC_uni_semantics (pRExC_state->uni_semantics) +#define RExC_orig_utf8 (pRExC_state->orig_utf8) +#define RExC_open_parens (pRExC_state->open_parens) +#define RExC_close_parens (pRExC_state->close_parens) +#define RExC_end_op (pRExC_state->end_op) +#define RExC_paren_names (pRExC_state->paren_names) +#define RExC_recurse (pRExC_state->recurse) +#define RExC_recurse_count (pRExC_state->recurse_count) +#define RExC_sets_depth (pRExC_state->sets_depth) +#define RExC_study_chunk_recursed (pRExC_state->study_chunk_recursed) +#define RExC_study_chunk_recursed_bytes \ + (pRExC_state->study_chunk_recursed_bytes) +#define RExC_in_lookaround (pRExC_state->in_lookaround) +#define RExC_contains_locale (pRExC_state->contains_locale) +#define RExC_recode_x_to_native (pRExC_state->recode_x_to_native) #ifdef EBCDIC -# define SET_recode_x_to_native(x) \ - STMT_START { RExC_recode_x_to_native = (x); } STMT_END +# define SET_recode_x_to_native(x) \ + STMT_START { RExC_recode_x_to_native = (x); } STMT_END #else -# define SET_recode_x_to_native(x) NOOP +# define SET_recode_x_to_native(x) NOOP #endif -#define RExC_in_multi_char_class (pRExC_state->in_multi_char_class) -#define RExC_frame_head (pRExC_state->frame_head) -#define RExC_frame_last (pRExC_state->frame_last) -#define RExC_frame_count (pRExC_state->frame_count) -#define RExC_strict (pRExC_state->strict) -#define RExC_study_started (pRExC_state->study_started) -#define RExC_warn_text (pRExC_state->warn_text) -#define RExC_in_script_run (pRExC_state->in_script_run) -#define RExC_use_BRANCHJ (pRExC_state->use_BRANCHJ) -#define RExC_warned_WARN_EXPERIMENTAL__VLB (pRExC_state->sWARN_EXPERIMENTAL__VLB) -#define RExC_warned_WARN_EXPERIMENTAL__REGEX_SETS (pRExC_state->sWARN_EXPERIMENTAL__REGEX_SETS) -#define RExC_unlexed_names (pRExC_state->unlexed_names) - - -/***********************************************************************/ +#define RExC_in_multi_char_class (pRExC_state->in_multi_char_class) +#define RExC_frame_head (pRExC_state->frame_head) +#define RExC_frame_last (pRExC_state->frame_last) +#define RExC_frame_count (pRExC_state->frame_count) +#define RExC_strict (pRExC_state->strict) +#define RExC_study_started (pRExC_state->study_started) +#define RExC_warn_text (pRExC_state->warn_text) +#define RExC_in_script_run (pRExC_state->in_script_run) +#define RExC_use_BRANCHJ (pRExC_state->use_BRANCHJ) +#define RExC_warned_WARN_EXPERIMENTAL__VLB \ + (pRExC_state->sWARN_EXPERIMENTAL__VLB) +#define RExC_warned_WARN_EXPERIMENTAL__REGEX_SETS \ + (pRExC_state->sWARN_EXPERIMENTAL__REGEX_SETS) +#define RExC_unlexed_names (pRExC_state->unlexed_names) + + +/********************************************************************** */ /* UTILITY MACROS FOR ADVANCING OR SETTING THE PARSE "CURSOR" RExC_parse * * All of these macros depend on the above RExC_ accessor macros, which * in turns depend on a variable pRExC_state being in scope where they - * are used. This is the standard regexp parser context variable which is - * passed into every non-trivial parse function in this file. + * are used. This is the standard regexp parser context variable which + * is passed into every non-trivial parse function in this file. * * Note that the UTF macro is itself a wrapper around RExC_utf8, so all * of the macros which do not take an argument will operate on the * pRExC_state structure *only*. * - * Please do NOT modify RExC_parse without using these macros. In the + * Please do NOT modify RExC_parse without using these macros. In the * future these macros will be extended for enhanced debugging and trace * output during the parse process. */ @@ -275,7 +338,7 @@ struct RExC_state_t { * * Increment RExC_parse to point at the next codepoint, while doing * the right thing depending on whether we are parsing UTF-8 strings - * or not. The 'flag' argument determines if content is UTF-8 or not, + * or not. The 'flag' argument determines if content is UTF-8 or not, * intended for cases where this is NOT governed by the UTF macro. * * Use RExC_parse_inc() if UTF-8ness is controlled by the UTF macro. @@ -285,146 +348,151 @@ struct RExC_state_t { * RExC_parse to ensure that when processing UTF-8 we would not read * past the end of the string. */ -#define RExC_parse_incf(flag) STMT_START { \ - RExC_parse += (flag) ? UTF8SKIP(RExC_parse) : 1; \ -} STMT_END +#define RExC_parse_incf(flag) \ + STMT_START { \ + RExC_parse += (flag) ? UTF8SKIP(RExC_parse) : 1; \ + } STMT_END /* RExC_parse_inc_safef(flag) * - * Safely increment RExC_parse to point at the next codepoint, - * doing the right thing depending on whether we are parsing - * UTF-8 strings or not and NOT reading past the end of the buffer. - * The 'flag' argument determines if content is UTF-8 or not, - * intended for cases where this is NOT governed by the UTF macro. + * Safely increment RExC_parse to point at the next codepoint, doing + * the right thing depending on whether we are parsing UTF-8 strings + * or not and NOT reading past the end of the buffer. The 'flag' + * argument determines if content is UTF-8 or not, intended for cases + * where this is NOT governed by the UTF macro. * * Use RExC_parse_safe() if UTF-8ness is controlled by the UTF macro. * * NOTE: Will NOT read past RExC_end when content is UTF-8. */ -#define RExC_parse_inc_safef(flag) STMT_START { \ - RExC_parse += (flag) ? UTF8_SAFE_SKIP(RExC_parse,RExC_end) : 1; \ -} STMT_END +#define RExC_parse_inc_safef(flag) \ + STMT_START { \ + RExC_parse += (flag) ? UTF8_SAFE_SKIP(RExC_parse,RExC_end) : 1; \ + } STMT_END /* RExC_parse_inc() * - * Increment RExC_parse to point at the next codepoint, - * doing the right thing depending on whether we are parsing - * UTF-8 strings or not. + * Increment RExC_parse to point at the next codepoint, doing the right + * thing depending on whether we are parsing UTF-8 strings or not. * * WARNING: Does NOT take into account RExC_end, it is the callers * responsibility to make sure there are enough octets left in * RExC_parse to ensure that when processing UTF-8 we would not read * past the end of the string. * - * NOTE: whether we are parsing UTF-8 or not is determined by the - * UTF macro which is defined as cBOOL(RExC_parse_utf8), thus this - * macro operates on the pRExC_state structure only. + * NOTE: whether we are parsing UTF-8 or not is determined by the UTF + * macro which is defined as cBOOL(RExC_parse_utf8), thus this macro + * operates on the pRExC_state structure only. */ -#define RExC_parse_inc() RExC_parse_incf(UTF) +#define RExC_parse_inc() RExC_parse_incf(UTF) /* RExC_parse_inc_safe() * * Safely increment RExC_parse to point at the next codepoint, - * doing the right thing depending on whether we are parsing - * UTF-8 strings or not and NOT reading past the end of the buffer. + * doing the right thing depending on whether we are parsing UTF-8 + * strings or not and NOT reading past the end of the buffer. * * NOTE: whether we are parsing UTF-8 or not is determined by the * UTF macro which is defined as cBOOL(RExC_parse_utf8), thus this * macro operates on the pRExC_state structure only. */ -#define RExC_parse_inc_safe() RExC_parse_inc_safef(UTF) +#define RExC_parse_inc_safe() RExC_parse_inc_safef(UTF) /* RExC_parse_inc_utf8() * - * Increment RExC_parse to point at the next utf8 codepoint, - * assumes content is UTF-8. + * Increment RExC_parse to point at the next utf8 + * codepoint, assumes content is UTF-8. * - * WARNING: Does NOT take into account RExC_end; it is the callers - * responsibility to make sure there are enough octets left in RExC_parse - * to ensure that when processing UTF-8 we would not read past the end - * of the string. + * WARNING: Does NOT take into account RExC_end; it is the + * callers responsibility to make sure there are enough + * octets left in RExC_parse to ensure that when processing + * UTF-8 we would not read past the end of the string. */ -#define RExC_parse_inc_utf8() STMT_START { \ - RExC_parse += UTF8SKIP(RExC_parse); \ -} STMT_END +#define RExC_parse_inc_utf8() \ + STMT_START { \ + RExC_parse += UTF8SKIP(RExC_parse); \ + } STMT_END /* RExC_parse_inc_if_char() * * Increment RExC_parse to point at the next codepoint, if and only - * if the current parse point is NOT a NULL, while doing the right thing - * depending on whether we are parsing UTF-8 strings or not. + * if the current parse point is NOT a NULL, while doing the right + * thing depending on whether we are parsing UTF-8 strings or not. * * WARNING: Does NOT take into account RExC_end, it is the callers - * responsibility to make sure there are enough octets left in RExC_parse - * to ensure that when processing UTF-8 we would not read past the end - * of the string. + * responsibility to make sure there are enough octets left in + * RExC_parse to ensure that when processing UTF-8 we would not + * read past the end of the string. * * NOTE: whether we are parsing UTF-8 or not is determined by the * UTF macro which is defined as cBOOL(RExC_parse_utf8), thus this * macro operates on the pRExC_state structure only. */ -#define RExC_parse_inc_if_char() STMT_START { \ - RExC_parse += SKIP_IF_CHAR(RExC_parse,RExC_end); \ -} STMT_END +#define RExC_parse_inc_if_char() \ + STMT_START { \ + RExC_parse += SKIP_IF_CHAR(RExC_parse,RExC_end); \ + } STMT_END /* RExC_parse_inc_by(n_octets) * * Increment the parse cursor by the number of octets specified by * the 'n_octets' argument. * - * NOTE: Does NOT check ANY constraints. It is the callers responsibility - * that this will not move past the end of the string, or leave the - * pointer in the middle of a UTF-8 sequence. + * NOTE: Does NOT check ANY constraints. It is the callers + * responsibility that this will not move past the end of the string, + * or leave the pointer in the middle of a UTF-8 sequence. * * Typically used to advanced past previously analyzed content. */ -#define RExC_parse_inc_by(n_octets) STMT_START { \ - RExC_parse += (n_octets); \ -} STMT_END +#define RExC_parse_inc_by(n_octets) \ + STMT_START { \ + RExC_parse += (n_octets); \ + } STMT_END /* RExC_parse_set(to_ptr) * - * Sets the RExC_parse pointer to the pointer specified by the 'to' - * argument. No validation whatsoever is performed on the to pointer. + * Sets the RExC_parse pointer to the pointer specified by the 'to' argument. + * No validation whatsoever is performed on the to pointer. */ -#define RExC_parse_set(to_ptr) STMT_START { \ - RExC_parse = (to_ptr); \ -} STMT_END +#define RExC_parse_set(to_ptr) \ + STMT_START { \ + RExC_parse = (to_ptr); \ + } STMT_END -/**********************************************************************/ +/********************************************************************* */ /* Heuristic check on the complexity of the pattern: if TOO_NAUGHTY, we set - * a flag to disable back-off on the fixed/floating substrings - if it's - * a high complexity pattern we assume the benefit of avoiding a full match - * is worth the cost of checking for the substrings even if they rarely help. + * a flag to disable back-off on the fixed/floating substrings - if it's a + * high complexity pattern we assume the benefit of avoiding a full match is + * worth the cost of checking for the substrings even if they rarely help. */ -#define RExC_naughty (pRExC_state->naughty) -#define TOO_NAUGHTY (10) -#define MARK_NAUGHTY(add) \ +#define RExC_naughty (pRExC_state->naughty) +#define TOO_NAUGHTY (10) +#define MARK_NAUGHTY(add) \ if (RExC_naughty < TOO_NAUGHTY) \ RExC_naughty += (add) -#define MARK_NAUGHTY_EXP(exp, add) \ +#define MARK_NAUGHTY_EXP(exp, add) \ if (RExC_naughty < TOO_NAUGHTY) \ RExC_naughty += RExC_naughty / (exp) + (add) #define isNON_BRACE_QUANTIFIER(c) ((c) == '*' || (c) == '+' || (c) == '?') -#define isQUANTIFIER(s,e) ( isNON_BRACE_QUANTIFIER(*s) \ - || ((*s) == '{' && regcurly(s, e, NULL))) +#define isQUANTIFIER(s,e) \ + ( isNON_BRACE_QUANTIFIER(*s) || ((*s) == '{' && regcurly(s, e, NULL))) /* * Flags to be passed up. - */ -#define HASWIDTH 0x01 /* Known to not match null strings, could match - non-null ones. */ +*/ +#define HASWIDTH 0x01 /* Known to not match null strings, + could match non-null ones. */ #define SIMPLE 0x02 /* Exactly one character wide */ /* (or LNBREAK as a special case) */ #define POSTPONED 0x08 /* (?1),(?&name), (??{...}) or similar */ #define TRYAGAIN 0x10 /* Weeded out a declaration. */ #define RESTART_PARSE 0x20 /* Need to redo the parse */ -#define NEED_UTF8 0x40 /* In conjunction with RESTART_PARSE, need to - calcuate sizes as UTF-8 */ +#define NEED_UTF8 0x40 /* In conjunction with RESTART_PARSE, need + to calcuate sizes as UTF-8 */ -#define REG_NODE_NUM(x) ((x) ? (int)((x)-RExC_emit_start) : -1) +#define REG_NODE_NUM(x) ((x) ? (int)((x)-RExC_emit_start) : -1) /* whether trie related optimizations are enabled */ #if PERL_ENABLE_EXTENDED_TRIE_OPTIMISATION @@ -441,127 +509,128 @@ struct RExC_state_t { * Specifically, when TRIE_STUDY_OPT is defined, and it is defined in normal * builds, (see above), during compilation SCF_TRIE_RESTUDY may be enabled * which then causes the Perl_re_op_compile() to then call the optimizer - * S_study_chunk() a second time to perform additional optimizations, - * including the aho_corasick startclass optimization. - * This additional pass will only happen once, which is managed by the - * 'restudied' variable in Perl_re_op_compile(). + * S_study_chunk() a second time to perform additional optimizations, including + * the aho_corasick startclass optimization. This additional pass will only + * happen once, which is managed by the 'restudied' variable in + * Perl_re_op_compile(). * * When this second pass is under way the flags passed into study_chunk() will - * include SCF_TRIE_DOING_RESTUDY and this flag is and must be cascaded down - * to any recursive calls to S_study_chunk(). + * include SCF_TRIE_DOING_RESTUDY and this flag is and must be cascaded down to + * any recursive calls to S_study_chunk(). * * IMPORTANT: Any logic in study_chunk() that emits warnings should check that - * the SCF_TRIE_DOING_RESTUDY flag is NOT set in 'flags', or the warning may - * be produced twice. + * the SCF_TRIE_DOING_RESTUDY flag is NOT set in 'flags', or the warning may be + * produced twice. * * See commit 07be1b83a6b2d24b492356181ddf70e1c7917ae3 and * 688e03912e3bff2d2419c457d8b0e1bab3eb7112 for more details. */ -#define PBYTE(u8str,paren) ((U8*)(u8str))[(paren) >> 3] -#define PBITVAL(paren) (1 << ((paren) & 7)) +#define PBYTE(u8str,paren) ((U8*)(u8str))[(paren) >> 3] +#define PBITVAL(paren) (1 << ((paren) & 7)) #define PAREN_OFFSET(depth) \ (RExC_study_chunk_recursed + (depth) * RExC_study_chunk_recursed_bytes) -#define PAREN_TEST(depth, paren) \ +#define PAREN_TEST(depth, paren) \ (PBYTE(PAREN_OFFSET(depth), paren) & PBITVAL(paren)) #define PAREN_SET(depth, paren) \ (PBYTE(PAREN_OFFSET(depth), paren) |= PBITVAL(paren)) -#define PAREN_UNSET(depth, paren) \ +#define PAREN_UNSET(depth, paren) \ (PBYTE(PAREN_OFFSET(depth), paren) &= ~PBITVAL(paren)) -#define REQUIRE_UTF8(flagp) STMT_START { \ - if (!UTF) { \ - *flagp = RESTART_PARSE|NEED_UTF8; \ - return 0; \ - } \ - } STMT_END +#define REQUIRE_UTF8(flagp) \ + STMT_START { \ + if (!UTF) { \ + *flagp = RESTART_PARSE|NEED_UTF8; \ + return 0; \ + } \ + } STMT_END -/* /u is to be chosen if we are supposed to use Unicode rules, or if the - * pattern is in UTF-8. This latter condition is in case the outermost rules - * are locale. See GH #17278 */ -#define toUSE_UNI_CHARSET_NOT_DEPENDS (RExC_uni_semantics || UTF) +/* /u is to be chosen if we are supposed to use Unicode rules, + * or if the pattern is in UTF-8. This latter condition is in + * case the outermost rules are locale. See GH #17278 */ +#define toUSE_UNI_CHARSET_NOT_DEPENDS (RExC_uni_semantics || UTF) -/* Change from /d into /u rules, and restart the parse. RExC_uni_semantics is - * a flag that indicates we need to override /d with /u as a result of +/* Change from /d into /u rules, and restart the parse. RExC_uni_semantics + * is a flag that indicates we need to override /d with /u as a result of * something in the pattern. It should only be used in regards to calling * set_regex_charset() or get_regex_charset() */ -#define REQUIRE_UNI_RULES(flagp, restart_retval) \ - STMT_START { \ - if (DEPENDS_SEMANTICS) { \ - set_regex_charset(&RExC_flags, REGEX_UNICODE_CHARSET); \ - RExC_uni_semantics = 1; \ - if (RExC_seen_d_op && LIKELY(! IN_PARENS_PASS)) { \ - /* No need to restart the parse if we haven't seen \ - * anything that differs between /u and /d, and no need \ - * to restart immediately if we're going to reparse \ - * anyway to count parens */ \ - *flagp |= RESTART_PARSE; \ - return restart_retval; \ - } \ - } \ +#define REQUIRE_UNI_RULES(flagp, restart_retval) \ + STMT_START { \ + if (DEPENDS_SEMANTICS) { \ + set_regex_charset(&RExC_flags, REGEX_UNICODE_CHARSET); \ + RExC_uni_semantics = 1; \ + if (RExC_seen_d_op && LIKELY(! IN_PARENS_PASS)) { \ + /* No need to restart the parse if we haven't seen \ + * anything that differs between /u and /d, and no \ + * need to restart immediately if we're going to \ + * reparse anyway to count parens */ \ + *flagp |= RESTART_PARSE; \ + return restart_retval; \ + } \ + } \ } STMT_END -#define REQUIRE_BRANCHJ(flagp, restart_retval) \ - STMT_START { \ - RExC_use_BRANCHJ = 1; \ - *flagp |= RESTART_PARSE; \ - return restart_retval; \ +#define REQUIRE_BRANCHJ(flagp, restart_retval) \ + STMT_START { \ + RExC_use_BRANCHJ = 1; \ + *flagp |= RESTART_PARSE; \ + return restart_retval; \ } STMT_END -/* Until we have completed the parse, we leave RExC_total_parens at 0 or - * less. After that, it must always be positive, because the whole re is - * considered to be surrounded by virtual parens. Setting it to negative - * indicates there is some construct that needs to know the actual number of - * parens to be properly handled. And that means an extra pass will be - * required after we've counted them all */ -#define ALL_PARENS_COUNTED (RExC_total_parens > 0) -#define REQUIRE_PARENS_PASS \ - STMT_START { /* No-op if have completed a pass */ \ - if (! ALL_PARENS_COUNTED) RExC_total_parens = -1; \ +/* Until we have completed the parse, we leave RExC_total_parens at 0 + * or less. After that, it must always be positive, because the whole + * re is considered to be surrounded by virtual parens. Setting it to + * negative indicates there is some construct that needs to know the + * actual number of parens to be properly handled. And that means an + * extra pass will be required after we've counted them all */ +#define ALL_PARENS_COUNTED (RExC_total_parens > 0) +#define REQUIRE_PARENS_PASS \ + STMT_START { /* No-op if have completed a pass */ \ + if (! ALL_PARENS_COUNTED) RExC_total_parens = -1; \ } STMT_END -#define IN_PARENS_PASS (RExC_total_parens < 0) - - -/* This is used to return failure (zero) early from the calling function if - * various flags in 'flags' are set. Two flags always cause a return: - * 'RESTART_PARSE' and 'NEED_UTF8'. 'extra' can be used to specify any - * additional flags that should cause a return; 0 if none. If the return will - * be done, '*flagp' is first set to be all of the flags that caused the - * return. */ -#define RETURN_FAIL_ON_RESTART_OR_FLAGS(flags,flagp,extra) \ - STMT_START { \ - if ((flags) & (RESTART_PARSE|NEED_UTF8|(extra))) { \ - *(flagp) = (flags) & (RESTART_PARSE|NEED_UTF8|(extra)); \ - return 0; \ - } \ +#define IN_PARENS_PASS (RExC_total_parens < 0) + + +/* This is used to return failure (zero) early from the calling + * function if various flags in 'flags' are set. Two flags always + * cause a return: 'RESTART_PARSE' and 'NEED_UTF8'. 'extra' can be + * used to specify any additional flags that should cause a return; + * 0 if none. If the return will be done, '*flagp' is first set to + * be all of the flags that caused the return. */ +#define RETURN_FAIL_ON_RESTART_OR_FLAGS(flags,flagp,extra) \ + STMT_START { \ + if ((flags) & (RESTART_PARSE|NEED_UTF8|(extra))) { \ + *(flagp) = (flags) & (RESTART_PARSE|NEED_UTF8|(extra)); \ + return 0; \ + } \ } STMT_END -#define MUST_RESTART(flags) ((flags) & (RESTART_PARSE)) +#define MUST_RESTART(flags) ((flags) & (RESTART_PARSE)) -#define RETURN_FAIL_ON_RESTART(flags,flagp) \ - RETURN_FAIL_ON_RESTART_OR_FLAGS( flags, flagp, 0) -#define RETURN_FAIL_ON_RESTART_FLAGP(flagp) \ - if (MUST_RESTART(*(flagp))) return 0 +#define RETURN_FAIL_ON_RESTART(flags,flagp) \ + RETURN_FAIL_ON_RESTART_OR_FLAGS( flags, flagp, 0) +#define RETURN_FAIL_ON_RESTART_FLAGP(flagp) \ + if (MUST_RESTART(*(flagp))) return 0 -/* This converts the named class defined in regcomp.h to its equivalent class - * number defined in handy.h. */ -#define namedclass_to_classnum(class) ((int) ((class) / 2)) -#define classnum_to_namedclass(classnum) ((classnum) * 2) +/* This converts the named class defined in regcomp.h to + * its equivalent class number defined in handy.h. */ +#define namedclass_to_classnum(class) ((int) ((class) / 2)) +#define classnum_to_namedclass(classnum) ((classnum) * 2) #define _invlist_union_complement_2nd(a, b, output) \ - _invlist_union_maybe_complement_2nd(a, b, TRUE, output) -#define _invlist_intersection_complement_2nd(a, b, output) \ - _invlist_intersection_maybe_complement_2nd(a, b, TRUE, output) + _invlist_union_maybe_complement_2nd(a, b, TRUE, output) +#define _invlist_intersection_complement_2nd(a, b, output) \ + _invlist_intersection_maybe_complement_2nd(a, b, TRUE, output) -/* We add a marker if we are deferring expansion of a property that is both - * 1) potentiallly user-defined; and - * 2) could also be an official Unicode property. +/* We add a marker if we are deferring expansion of a property + * that is both 1) potentiallly user-defined; and 2) could also + * be an official Unicode property. * - * Without this marker, any deferred expansion can only be for a user-defined - * one. This marker shouldn't conflict with any that could be in a legal name, - * and is appended to its name to indicate this. There is a string and - * character form */ + * Without this marker, any deferred expansion can only be for + * a user-defined one. This marker shouldn't conflict with any + * that could be in a legal name, and is appended to its name + * to indicate this. There is a string and character form */ #define DEFERRED_COULD_BE_OFFICIAL_MARKERs "~" #define DEFERRED_COULD_BE_OFFICIAL_MARKERc '~' @@ -570,47 +639,43 @@ struct RExC_state_t { /* About scan_data_t. - During optimisation we recurse through the regexp program performing - various inplace (keyhole style) optimisations. In addition study_chunk - and scan_commit populate this data structure with information about - what strings MUST appear in the pattern. We look for the longest - string that must appear at a fixed location, and we look for the - longest string that may appear at a floating location. So for instance - in the pattern: + During optimisation we recurse through the regexp program performing + various inplace (keyhole style) optimisations. In addition study_chunk + and scan_commit populate this data structure with information about what + strings MUST appear in the pattern. We look for the longest string that + must appear at a fixed location, and we look for the longest string that + may appear at a floating location. So for instance in the pattern: /FOO[xX]A.*B[xX]BAR/ - Both 'FOO' and 'A' are fixed strings. Both 'B' and 'BAR' are floating - strings (because they follow a .* construct). study_chunk will identify - both FOO and BAR as being the longest fixed and floating strings respectively. + Both 'FOO' and 'A' are fixed strings. Both 'B' and 'BAR' are floating + strings (because they follow a .* construct). study_chunk will identify + both FOO and BAR as being the longest fixed and floating strings + respectively. - The strings can be composites, for instance + The strings can be composites, for instance /(f)(o)(o)/ - will result in a composite fixed substring 'foo'. + will result in a composite fixed substring 'foo'. - For each string some basic information is maintained: + For each string some basic information is maintained: - - min_offset - This is the position the string must appear at, or not before. - It also implicitly (when combined with minlenp) tells us how many - characters must match before the string we are searching for. - Likewise when combined with minlenp and the length of the string it - tells us how many characters must appear after the string we have - found. + - min_offset This is the position the string must appear at, or not + before. It also implicitly (when combined with minlenp) tells us how + many characters must match before the string we are searching for. + Likewise when combined with minlenp and the length of the string it tells + us how many characters must appear after the string we have found. - - max_offset - Only used for floating strings. This is the rightmost point that - the string can appear at. If set to OPTIMIZE_INFTY it indicates that the - string can occur infinitely far to the right. - For fixed strings, it is equal to min_offset. + - max_offset Only used for floating strings. This is the rightmost point + that the string can appear at. If set to OPTIMIZE_INFTY it indicates + that the string can occur infinitely far to the right. For fixed + strings, it is equal to min_offset. - - minlenp - A pointer to the minimum number of characters of the pattern that the - string was found inside. This is important as in the case of positive - lookahead or positive lookbehind we can have multiple patterns - involved. Consider + - minlenp A pointer to the minimum number of characters of the pattern + that the string was found inside. This is important as in the case of + positive lookahead or positive lookbehind we can have multiple patterns + involved. Consider /(?=FOO).*F/ @@ -625,7 +690,7 @@ struct RExC_state_t { are not known until the full pattern has been compiled, thus the pointer to the value. - - lookbehind + - lookbehind In the case of lookbehind the string being searched for can be offset past the start point of the final matching string. @@ -639,10 +704,9 @@ struct RExC_state_t { have been lost precalculated in the end_shift field for the associated string. - The fields pos_min and pos_delta are used to store the minimum offset - and the delta to the maximum offset at the current point in the pattern. - -*/ + The fields pos_min and pos_delta are used to store the minimum offset and + the delta to the maximum offset at the current point in the pattern. + */ struct scan_data_substrs { SV *str; /* longest substring found in pattern */ @@ -650,39 +714,44 @@ struct scan_data_substrs { SSize_t max_offset; /* latest point in string it can appear */ SSize_t *minlenp; /* pointer to the minlen relevant to the string */ SSize_t lookbehind; /* is the pos of the string modified by LB */ - I32 flags; /* per substring SF_* and SCF_* flags */ + I32 flags; /* per substring SF_* and SCF_* flags */ }; /* this is typedef'ed in perl.h */ -struct scan_data_t { - /*I32 len_min; unused */ - /*I32 len_delta; unused */ - SSize_t pos_min; - SSize_t pos_delta; - SV *last_found; - SSize_t last_end; /* min value, <0 unless valid. */ - SSize_t last_start_min; - SSize_t last_start_max; - U8 cur_is_floating; /* whether the last_* values should be set as - * the next fixed (0) or floating (1) - * substring */ +struct scan_data_t { /*I32 len_min; unused */ + /*I32 len_delta; unused */ + SSize_t pos_min; + SSize_t pos_delta; + SV *last_found; + SSize_t last_end; /* min value, <0 unless + valid. */ + SSize_t last_start_min; + SSize_t last_start_max; + U8 cur_is_floating; /* whether the last_* + * values should be set + * as the next fixed + * (0) or floating (1) + * substring */ /* [0] is longest fixed substring so far, [1] is longest float so far */ - struct scan_data_substrs substrs[2]; - - I32 flags; /* common SF_* and SCF_* flags */ - I32 whilem_c; - SSize_t *last_closep; - regnode **last_close_opp; /* pointer to pointer to last CLOSE regop - seen. DO NOT DEREFERENCE the regnode - pointer - the op may have been optimized - away */ - regnode_ssc *start_class; + struct scan_data_substrs substrs[2]; + + I32 flags; /* common SF_* and + SCF_* flags */ + I32 whilem_c; + SSize_t *last_closep; + regnode **last_close_opp; /* pointer to pointer to + last CLOSE regop seen. + DO NOT DEREFERENCE the + regnode pointer - the + op may have been + optimized away */ + regnode_ssc *start_class; }; /* * Forward declarations for pregcomp()'s friends. - */ +*/ static const scan_data_t zero_scan_data = { 0, 0, NULL, 0, 0, 0, 0, @@ -695,14 +764,14 @@ static const scan_data_t zero_scan_data = { /* study flags */ -#define SF_BEFORE_SEOL 0x0001 -#define SF_BEFORE_MEOL 0x0002 -#define SF_BEFORE_EOL (SF_BEFORE_SEOL|SF_BEFORE_MEOL) +#define SF_BEFORE_SEOL 0x0001 +#define SF_BEFORE_MEOL 0x0002 +#define SF_BEFORE_EOL (SF_BEFORE_SEOL|SF_BEFORE_MEOL) -#define SF_IS_INF 0x0040 -#define SF_HAS_PAR 0x0080 -#define SF_IN_PAR 0x0100 -#define SF_HAS_EVAL 0x0200 +#define SF_IS_INF 0x0040 +#define SF_HAS_PAR 0x0080 +#define SF_IN_PAR 0x0100 +#define SF_HAS_EVAL 0x0200 /* SCF_DO_SUBSTR is the flag that tells the regexp analyzer to track the @@ -715,70 +784,74 @@ static const scan_data_t zero_scan_data = { * Similarly, /foo.*(blah|erm|huh).*fnorble/ will have "foo" and "fnorble" * parsed with SCF_DO_SUBSTR on, but while processing the (...) it will be * turned off because of the alternation (BRANCH). */ -#define SCF_DO_SUBSTR 0x0400 +#define SCF_DO_SUBSTR 0x0400 -#define SCF_DO_STCLASS_AND 0x0800 -#define SCF_DO_STCLASS_OR 0x1000 -#define SCF_DO_STCLASS (SCF_DO_STCLASS_AND|SCF_DO_STCLASS_OR) -#define SCF_WHILEM_VISITED_POS 0x2000 +#define SCF_DO_STCLASS_AND 0x0800 +#define SCF_DO_STCLASS_OR 0x1000 +#define SCF_DO_STCLASS (SCF_DO_STCLASS_AND|SCF_DO_STCLASS_OR) +#define SCF_WHILEM_VISITED_POS 0x2000 -#define SCF_TRIE_RESTUDY 0x4000 /* Need to do restudy in study_chunk()? - Search for "restudy" in this file - to find a detailed explanation.*/ -#define SCF_SEEN_ACCEPT 0x8000 -#define SCF_TRIE_DOING_RESTUDY 0x10000 /* Are we in restudy right now? - Search for "restudy" in this file - to find a detailed explanation. */ -#define SCF_IN_DEFINE 0x20000 +#define SCF_TRIE_RESTUDY 0x4000 /* Need to do restudy in + study_chunk()? Search for + "restudy" in this file to find a + detailed explanation. */ +#define SCF_SEEN_ACCEPT 0x8000 +#define SCF_TRIE_DOING_RESTUDY 0x10000 /* Are we in restudy right now? + Search for "restudy" in this + file to find a detailed + explanation. */ +#define SCF_IN_DEFINE 0x20000 -#define UTF cBOOL(RExC_utf8) +#define UTF cBOOL(RExC_utf8) /* The enums for all these are ordered so things work out correctly */ -#define LOC (get_regex_charset(RExC_flags) == REGEX_LOCALE_CHARSET) -#define DEPENDS_SEMANTICS (get_regex_charset(RExC_flags) \ - == REGEX_DEPENDS_CHARSET) -#define UNI_SEMANTICS (get_regex_charset(RExC_flags) == REGEX_UNICODE_CHARSET) -#define AT_LEAST_UNI_SEMANTICS (get_regex_charset(RExC_flags) \ - >= REGEX_UNICODE_CHARSET) -#define ASCII_RESTRICTED (get_regex_charset(RExC_flags) \ - == REGEX_ASCII_RESTRICTED_CHARSET) -#define AT_LEAST_ASCII_RESTRICTED (get_regex_charset(RExC_flags) \ - >= REGEX_ASCII_RESTRICTED_CHARSET) -#define ASCII_FOLD_RESTRICTED (get_regex_charset(RExC_flags) \ - == REGEX_ASCII_MORE_RESTRICTED_CHARSET) +#define LOC (get_regex_charset(RExC_flags) == REGEX_LOCALE_CHARSET) +#define DEPENDS_SEMANTICS \ + (get_regex_charset(RExC_flags) == REGEX_DEPENDS_CHARSET) +#define UNI_SEMANTICS (get_regex_charset(RExC_flags) == REGEX_UNICODE_CHARSET) +#define AT_LEAST_UNI_SEMANTICS \ + (get_regex_charset(RExC_flags) >= REGEX_UNICODE_CHARSET) +#define ASCII_RESTRICTED \ + (get_regex_charset(RExC_flags) == REGEX_ASCII_RESTRICTED_CHARSET) +#define AT_LEAST_ASCII_RESTRICTED \ + (get_regex_charset(RExC_flags) >= REGEX_ASCII_RESTRICTED_CHARSET) +#define ASCII_FOLD_RESTRICTED \ + (get_regex_charset(RExC_flags) == REGEX_ASCII_MORE_RESTRICTED_CHARSET) -#define FOLD cBOOL(RExC_flags & RXf_PMf_FOLD) +#define FOLD cBOOL(RExC_flags & RXf_PMf_FOLD) -/* For programs that want to be strictly Unicode compatible by dying if any - * attempt is made to match a non-Unicode code point against a Unicode - * property. */ -#define ALWAYS_WARN_SUPER ckDEAD(packWARN(WARN_NON_UNICODE)) +/* For programs that want to be strictly Unicode compatible + * by dying if any attempt is made to match a non-Unicode + * code point against a Unicode property. */ +#define ALWAYS_WARN_SUPER ckDEAD(packWARN(WARN_NON_UNICODE)) -#define OOB_NAMEDCLASS -1 +#define OOB_NAMEDCLASS -1 -/* There is no code point that is out-of-bounds, so this is problematic. But - * its only current use is to initialize a variable that is always set before - * looked at. */ -#define OOB_UNICODE 0xDEADBEEF +/* There is no code point that is out-of-bounds, so this is + * problematic. But its only current use is to initialize + * a variable that is always set before looked at. */ +#define OOB_UNICODE 0xDEADBEEF -#define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv)) +#define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv)) /* length of regex to show in messages that don't mark a position within */ -#define RegexLengthToShowInErrorMessages 127 +#define RegexLengthToShowInErrorMessages 127 /* - * If MARKER[12] are adjusted, be sure to adjust the constants at the top - * of t/op/regmesg.t, the tests in t/op/re_tests, and those in - * op/pragma/warn/regcomp. - */ -#define MARKER1 "<-- HERE" /* marker as it appears in the description */ -#define MARKER2 " <-- HERE " /* marker as it appears within the regex */ + * If MARKER[12] are adjusted, be sure to adjust the constants + * at the top of t/op/regmesg.t, the tests in t/op/re_tests, + * and those in op/pragma/warn/regcomp. +*/ +#define MARKER1 "<-- HERE" /* marker as it appears in + the description */ +#define MARKER2 " <-- HERE " /* marker as it appears within the regex */ -#define REPORT_LOCATION " in regex; marked by " MARKER1 \ - " in m/%" UTF8f MARKER2 "%" UTF8f "/" +#define REPORT_LOCATION \ + " in regex; marked by " MARKER1 \ + " in m/%" UTF8f MARKER2 "%" UTF8f "/" /* The code in this file in places uses one level of recursion with parsing * rebased to an alternate string constructed by us in memory. This can take @@ -787,16 +860,14 @@ static const scan_data_t zero_scan_data = { * there should be no possibility of an error, as we are in complete control of * the alternate string. But in the second case we don't completely control * the input portion, so there may be errors in that. Here's an example: - * /[abc\x{DF}def]/ui - * is handled specially because \x{df} folds to a sequence of more than one - * character: 'ss'. What is done is to create and parse an alternate string, - * which looks like this: - * /(?:\x{DF}|[abc\x{DF}def])/ui - * where it uses the input unchanged in the middle of something it constructs, - * which is a branch for the DF outside the character class, and clustering - * parens around the whole thing. (It knows enough to skip the DF inside the - * class while in this substitute parse.) 'abc' and 'def' may have errors that - * need to be reported. The general situation looks like this: + * /[abc\x{DF}def]/ui is handled specially because \x{df} folds to a sequence + * of more than one character: 'ss'. What is done is to create and parse an + * alternate string, which looks like this: /(?:\x{DF}|[abc\x{DF}def])/ui where + * it uses the input unchanged in the middle of something it constructs, which + * is a branch for the DF outside the character class, and clustering parens + * around the whole thing. (It knows enough to skip the DF inside the class + * while in this substitute parse.) 'abc' and 'def' may have errors that need + * to be reported. The general situation looks like this: * * |<------- identical ------>| * sI tI xI eI @@ -805,42 +876,36 @@ static const scan_data_t zero_scan_data = { * sC tC xC eC EC * |<------- identical ------>| * - * sI..eI is the portion of the input pattern we are concerned with here. - * sC..EC is the constructed substitute parse string. - * sC..tC is constructed by us - * tC..eC is an exact duplicate of the portion of the input pattern tI..eI. - * In the diagram, these are vertically aligned. - * eC..EC is also constructed by us. - * xC is the position in the substitute parse string where we found a - * problem. - * xI is the position in the original pattern corresponding to xC. + * sI..eI is the portion of the input pattern we are concerned with here. + * sC..EC is the constructed substitute parse string. sC..tC is constructed + * by us tC..eC is an exact duplicate of the portion of the input pattern + * tI..eI. In the diagram, these are vertically aligned. eC..EC is also + * constructed by us. xC is the position in the substitute parse string where + * we found a problem. xI is the position in the original pattern + * corresponding to xC. * * We want to display a message showing the real input string. Thus we need to * translate from xC to xI. We know that xC >= tC, since the portion of the * string sC..tC has been constructed by us, and so shouldn't have errors. We - * get: - * xI = tI + (xC - tC) + * get: xI = tI + (xC - tC) * - * When the substitute parse is constructed, the code needs to set: - * RExC_start (sC) - * RExC_end (eC) - * RExC_copy_start_in_input (tI) - * RExC_copy_start_in_constructed (tC) - * and restore them when done. + * When the substitute parse is constructed, the code needs to set: RExC_start + * (sC) RExC_end (eC) RExC_copy_start_in_input (tI) + * RExC_copy_start_in_constructed (tC) and restore them when done. * * During normal processing of the input pattern, both * 'RExC_copy_start_in_input' and 'RExC_copy_start_in_constructed' are set to * sI, so that xC equals xI. */ -#define sI RExC_precomp -#define eI RExC_precomp_end -#define sC RExC_start -#define eC RExC_end -#define tI RExC_copy_start_in_input -#define tC RExC_copy_start_in_constructed -#define xI(xC) (tI + (xC - tC)) -#define xI_offset(xC) (xI(xC) - sI) +#define sI RExC_precomp +#define eI RExC_precomp_end +#define sC RExC_start +#define eC RExC_end +#define tI RExC_copy_start_in_input +#define tC RExC_copy_start_in_constructed +#define xI(xC) (tI + (xC - tC)) +#define xI_offset(xC) (xI(xC) - sI) #define REPORT_LOCATION_ARGS(xC) \ UTF8fARG(UTF, \ @@ -858,23 +923,23 @@ static const scan_data_t zero_scan_data = { (xI(xC) > eI) ? 0 : eI - xI(xC), /* Length after <--HERE */ \ (xI(xC) > eI) ? eI : xI(xC)) /* pattern after <--HERE */ -/* Used to point after bad bytes for an error message, but avoid skipping - * past a nul byte. */ -#define SKIP_IF_CHAR(s, e) (!*(s) ? 0 : UTF ? UTF8_SAFE_SKIP(s, e) : 1) +/* Used to point after bad bytes for an error message, + * but avoid skipping past a nul byte. */ +#define SKIP_IF_CHAR(s, e) (!*(s) ? 0 : UTF ? UTF8_SAFE_SKIP(s, e) : 1) /* Set up to clean up after our imminent demise */ -#define PREPARE_TO_DIE \ - STMT_START { \ - if (RExC_rx_sv) \ - SAVEFREESV(RExC_rx_sv); \ - if (RExC_open_parens) \ - SAVEFREEPV(RExC_open_parens); \ - if (RExC_close_parens) \ - SAVEFREEPV(RExC_close_parens); \ - if (RExC_logical_to_parno) \ - SAVEFREEPV(RExC_logical_to_parno); \ - if (RExC_parno_to_logical) \ - SAVEFREEPV(RExC_parno_to_logical); \ +#define PREPARE_TO_DIE \ + STMT_START { \ + if (RExC_rx_sv) \ + SAVEFREESV(RExC_rx_sv); \ + if (RExC_open_parens) \ + SAVEFREEPV(RExC_open_parens); \ + if (RExC_close_parens) \ + SAVEFREEPV(RExC_close_parens); \ + if (RExC_logical_to_parno) \ + SAVEFREEPV(RExC_logical_to_parno); \ + if (RExC_parno_to_logical) \ + SAVEFREEPV(RExC_parno_to_logical); \ } STMT_END /* @@ -882,125 +947,139 @@ static const scan_data_t zero_scan_data = { * arg. Show regex, up to a maximum length. If it's too long, chop and add * "...". */ -#define _FAIL(code) STMT_START { \ - const char *ellipses = ""; \ - IV len = RExC_precomp_end - RExC_precomp; \ - \ - PREPARE_TO_DIE; \ - if (len > RegexLengthToShowInErrorMessages) { \ - /* chop 10 shorter than the max, to ensure meaning of "..." */ \ - len = RegexLengthToShowInErrorMessages - 10; \ - ellipses = "..."; \ - } \ - code; \ -} STMT_END - -#define FAIL(msg) _FAIL( \ - Perl_croak(aTHX_ "%s in regex m/%" UTF8f "%s/", \ +#define _FAIL(code) \ + STMT_START { \ + const char *ellipses = ""; \ + IV len = RExC_precomp_end - RExC_precomp; \ + \ + PREPARE_TO_DIE; \ + if (len > RegexLengthToShowInErrorMessages) { \ + /* chop 10 shorter than the max, to ensure meaning of "..." */ \ + len = RegexLengthToShowInErrorMessages - 10; \ + ellipses = "..."; \ + } \ + code; \ + } STMT_END + +#define FAIL(msg) \ + _FAIL( \ + Perl_croak(aTHX_ "%s in regex m/%" UTF8f "%s/", \ msg, UTF8fARG(UTF, len, RExC_precomp), ellipses)) -#define FAIL2(msg,arg) _FAIL( \ - Perl_croak(aTHX_ msg " in regex m/%" UTF8f "%s/", \ +#define FAIL2(msg,arg) \ + _FAIL( \ + Perl_croak(aTHX_ msg " in regex m/%" UTF8f "%s/", \ arg, UTF8fARG(UTF, len, RExC_precomp), ellipses)) -#define FAIL3(msg,arg1,arg2) _FAIL( \ - Perl_croak(aTHX_ msg " in regex m/%" UTF8f "%s/", \ +#define FAIL3(msg,arg1,arg2) \ + _FAIL( \ + Perl_croak(aTHX_ msg " in regex m/%" UTF8f "%s/", \ arg1, arg2, UTF8fARG(UTF, len, RExC_precomp), ellipses)) /* * Simple_vFAIL -- like FAIL, but marks the current location in the scan - */ -#define Simple_vFAIL(m) STMT_START { \ - Perl_croak(aTHX_ "%s" REPORT_LOCATION, \ - m, REPORT_LOCATION_ARGS(RExC_parse)); \ -} STMT_END +*/ +#define Simple_vFAIL(m) \ + STMT_START { \ + Perl_croak(aTHX_ "%s" REPORT_LOCATION, \ + m, REPORT_LOCATION_ARGS(RExC_parse)); \ + } STMT_END /* * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL() - */ -#define vFAIL(m) STMT_START { \ - PREPARE_TO_DIE; \ - Simple_vFAIL(m); \ -} STMT_END +*/ +#define vFAIL(m) \ + STMT_START { \ + PREPARE_TO_DIE; \ + Simple_vFAIL(m); \ + } STMT_END /* * Like Simple_vFAIL(), but accepts two arguments. - */ -#define Simple_vFAIL2(m,a1) STMT_START { \ - S_re_croak(aTHX_ UTF, m REPORT_LOCATION, a1, \ - REPORT_LOCATION_ARGS(RExC_parse)); \ -} STMT_END +*/ +#define Simple_vFAIL2(m,a1) \ + STMT_START { \ + S_re_croak(aTHX_ UTF, m REPORT_LOCATION, a1, \ + REPORT_LOCATION_ARGS(RExC_parse)); \ + } STMT_END /* * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL2(). - */ -#define vFAIL2(m,a1) STMT_START { \ - PREPARE_TO_DIE; \ - Simple_vFAIL2(m, a1); \ -} STMT_END +*/ +#define vFAIL2(m,a1) \ + STMT_START { \ + PREPARE_TO_DIE; \ + Simple_vFAIL2(m, a1); \ + } STMT_END /* * Like Simple_vFAIL(), but accepts three arguments. - */ -#define Simple_vFAIL3(m, a1, a2) STMT_START { \ - S_re_croak(aTHX_ UTF, m REPORT_LOCATION, a1, a2, \ - REPORT_LOCATION_ARGS(RExC_parse)); \ -} STMT_END +*/ +#define Simple_vFAIL3(m, a1, a2) \ + STMT_START { \ + S_re_croak(aTHX_ UTF, m REPORT_LOCATION, a1, a2, \ + REPORT_LOCATION_ARGS(RExC_parse)); \ + } STMT_END /* * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL3(). - */ -#define vFAIL3(m,a1,a2) STMT_START { \ - PREPARE_TO_DIE; \ - Simple_vFAIL3(m, a1, a2); \ -} STMT_END +*/ +#define vFAIL3(m,a1,a2) \ + STMT_START { \ + PREPARE_TO_DIE; \ + Simple_vFAIL3(m, a1, a2); \ + } STMT_END /* * Like Simple_vFAIL(), but accepts four arguments. - */ -#define Simple_vFAIL4(m, a1, a2, a3) STMT_START { \ - S_re_croak(aTHX_ UTF, m REPORT_LOCATION, a1, a2, a3, \ - REPORT_LOCATION_ARGS(RExC_parse)); \ -} STMT_END +*/ +#define Simple_vFAIL4(m, a1, a2, a3) \ + STMT_START { \ + S_re_croak(aTHX_ UTF, m REPORT_LOCATION, a1, a2, a3, \ + REPORT_LOCATION_ARGS(RExC_parse)); \ + } STMT_END -#define vFAIL4(m,a1,a2,a3) STMT_START { \ - PREPARE_TO_DIE; \ - Simple_vFAIL4(m, a1, a2, a3); \ -} STMT_END +#define vFAIL4(m,a1,a2,a3) \ + STMT_START { \ + PREPARE_TO_DIE; \ + Simple_vFAIL4(m, a1, a2, a3); \ + } STMT_END /* A specialized version of vFAIL2 that works with UTF8f */ -#define vFAIL2utf8f(m, a1) STMT_START { \ - PREPARE_TO_DIE; \ - S_re_croak(aTHX_ UTF, m REPORT_LOCATION, a1, \ - REPORT_LOCATION_ARGS(RExC_parse)); \ -} STMT_END - -#define vFAIL3utf8f(m, a1, a2) STMT_START { \ - PREPARE_TO_DIE; \ - S_re_croak(aTHX_ UTF, m REPORT_LOCATION, a1, a2, \ - REPORT_LOCATION_ARGS(RExC_parse)); \ -} STMT_END +#define vFAIL2utf8f(m, a1) \ + STMT_START { \ + PREPARE_TO_DIE; \ + S_re_croak(aTHX_ UTF, m REPORT_LOCATION, a1, \ + REPORT_LOCATION_ARGS(RExC_parse)); \ + } STMT_END + +#define vFAIL3utf8f(m, a1, a2) \ + STMT_START { \ + PREPARE_TO_DIE; \ + S_re_croak(aTHX_ UTF, m REPORT_LOCATION, a1, a2, \ + REPORT_LOCATION_ARGS(RExC_parse)); \ + } STMT_END /* Setting this to NULL is a signal to not output warnings */ -#define TURN_OFF_WARNINGS_IN_SUBSTITUTE_PARSE \ - STMT_START { \ - RExC_save_copy_start_in_constructed = RExC_copy_start_in_constructed;\ - RExC_copy_start_in_constructed = NULL; \ +#define TURN_OFF_WARNINGS_IN_SUBSTITUTE_PARSE \ + STMT_START { \ + RExC_save_copy_start_in_constructed = RExC_copy_start_in_constructed; \ + RExC_copy_start_in_constructed = NULL; \ } STMT_END -#define RESTORE_WARNINGS \ +#define RESTORE_WARNINGS \ RExC_copy_start_in_constructed = RExC_save_copy_start_in_constructed -/* Since a warning can be generated multiple times as the input is reparsed, we - * output it the first time we come to that point in the parse, but suppress it - * otherwise. 'RExC_copy_start_in_constructed' being NULL is a flag to not - * generate any warnings */ -#define TO_OUTPUT_WARNINGS(loc) \ - ( RExC_copy_start_in_constructed \ - && ((xI(loc)) - RExC_precomp) > (Ptrdiff_t) RExC_latest_warn_offset) +/* Since a warning can be generated multiple times as the input is + * reparsed, we output it the first time we come to that point in the + * parse, but suppress it otherwise. 'RExC_copy_start_in_constructed' + * being NULL is a flag to not generate any warnings */ +#define TO_OUTPUT_WARNINGS(loc) \ + ( RExC_copy_start_in_constructed \ + && ((xI(loc)) - RExC_precomp) > (Ptrdiff_t) RExC_latest_warn_offset) -/* After we've emitted a warning, we save the position in the input so we don't - * output it again */ +/* After we've emitted a warning, we save the position + * in the input so we don't output it again */ #define UPDATE_WARNINGS_LOC(loc) \ STMT_START { \ if (TO_OUTPUT_WARNINGS(loc)) { \ @@ -1026,44 +1105,44 @@ static const scan_data_t zero_scan_data = { } STMT_END /* m is not necessarily a "literal string", in this macro */ -#define warn_non_literal_string(loc, packed_warn, m) \ - _WARN_HELPER(loc, packed_warn, \ - Perl_warner(aTHX_ packed_warn, \ - "%s" REPORT_LOCATION, \ +#define warn_non_literal_string(loc, packed_warn, m) \ + _WARN_HELPER(loc, packed_warn, \ + Perl_warner(aTHX_ packed_warn, \ + "%s" REPORT_LOCATION, \ m, REPORT_LOCATION_ARGS(loc))) -#define reg_warn_non_literal_string(loc, m) \ - warn_non_literal_string(loc, packWARN(WARN_REGEXP), m) +#define reg_warn_non_literal_string(loc, m) \ + warn_non_literal_string(loc, packWARN(WARN_REGEXP), m) -#define ckWARN2_non_literal_string(loc, packwarn, m, a1) \ - STMT_START { \ - char * format; \ - Size_t format_size = strlen(m) + strlen(REPORT_LOCATION)+ 1;\ - Newx(format, format_size, char); \ - my_strlcpy(format, m, format_size); \ - my_strlcat(format, REPORT_LOCATION, format_size); \ - SAVEFREEPV(format); \ - _WARN_HELPER(loc, packwarn, \ - Perl_ck_warner(aTHX_ packwarn, \ - format, \ - a1, REPORT_LOCATION_ARGS(loc))); \ +#define ckWARN2_non_literal_string(loc, packwarn, m, a1) \ + STMT_START { \ + char * format; \ + Size_t format_size = strlen(m) + strlen(REPORT_LOCATION)+ 1; \ + Newx(format, format_size, char); \ + my_strlcpy(format, m, format_size); \ + my_strlcat(format, REPORT_LOCATION, format_size); \ + SAVEFREEPV(format); \ + _WARN_HELPER(loc, packwarn, \ + Perl_ck_warner(aTHX_ packwarn, \ + format, \ + a1, REPORT_LOCATION_ARGS(loc))); \ } STMT_END -#define ckWARNreg(loc,m) \ - _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ - Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), \ - m REPORT_LOCATION, \ +#define ckWARNreg(loc,m) \ + _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ + Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), \ + m REPORT_LOCATION, \ REPORT_LOCATION_ARGS(loc))) -#define vWARN(loc, m) \ - _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ - Perl_warner(aTHX_ packWARN(WARN_REGEXP), \ - m REPORT_LOCATION, \ - REPORT_LOCATION_ARGS(loc))) \ +#define vWARN(loc, m) \ + _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ + Perl_warner(aTHX_ packWARN(WARN_REGEXP), \ + m REPORT_LOCATION, \ + REPORT_LOCATION_ARGS(loc))) \ -#define vWARN_dep(loc, m) \ - _WARN_HELPER(loc, packWARN(WARN_DEPRECATED), \ - Perl_warner(aTHX_ packWARN(WARN_DEPRECATED), \ - m REPORT_LOCATION, \ +#define vWARN_dep(loc, m) \ + _WARN_HELPER(loc, packWARN(WARN_DEPRECATED), \ + Perl_warner(aTHX_ packWARN(WARN_DEPRECATED), \ + m REPORT_LOCATION, \ REPORT_LOCATION_ARGS(loc))) #define ckWARNdep(loc,m) \ @@ -1072,175 +1151,176 @@ static const scan_data_t zero_scan_data = { m REPORT_LOCATION, \ REPORT_LOCATION_ARGS(loc))) -#define ckWARNregdep(loc,m) \ - _WARN_HELPER(loc, packWARN2(WARN_DEPRECATED, WARN_REGEXP), \ - Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, \ - WARN_REGEXP), \ - m REPORT_LOCATION, \ +#define ckWARNregdep(loc,m) \ + _WARN_HELPER(loc, packWARN2(WARN_DEPRECATED, WARN_REGEXP), \ + Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, \ + WARN_REGEXP), \ + m REPORT_LOCATION, \ REPORT_LOCATION_ARGS(loc))) -#define ckWARN2reg_d(loc,m, a1) \ - _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ - Perl_ck_warner_d(aTHX_ packWARN(WARN_REGEXP), \ - m REPORT_LOCATION, \ +#define ckWARN2reg_d(loc,m, a1) \ + _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ + Perl_ck_warner_d(aTHX_ packWARN(WARN_REGEXP), \ + m REPORT_LOCATION, \ a1, REPORT_LOCATION_ARGS(loc))) -#define ckWARN2reg(loc, m, a1) \ - _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ - Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), \ - m REPORT_LOCATION, \ +#define ckWARN2reg(loc, m, a1) \ + _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ + Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), \ + m REPORT_LOCATION, \ a1, REPORT_LOCATION_ARGS(loc))) -#define vWARN3(loc, m, a1, a2) \ - _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ - Perl_warner(aTHX_ packWARN(WARN_REGEXP), \ - m REPORT_LOCATION, \ +#define vWARN3(loc, m, a1, a2) \ + _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ + Perl_warner(aTHX_ packWARN(WARN_REGEXP), \ + m REPORT_LOCATION, \ a1, a2, REPORT_LOCATION_ARGS(loc))) -#define ckWARN3reg(loc, m, a1, a2) \ - _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ - Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), \ - m REPORT_LOCATION, \ - a1, a2, \ +#define ckWARN3reg(loc, m, a1, a2) \ + _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ + Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), \ + m REPORT_LOCATION, \ + a1, a2, \ REPORT_LOCATION_ARGS(loc))) -#define vWARN4(loc, m, a1, a2, a3) \ - _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ - Perl_warner(aTHX_ packWARN(WARN_REGEXP), \ - m REPORT_LOCATION, \ - a1, a2, a3, \ +#define vWARN4(loc, m, a1, a2, a3) \ + _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ + Perl_warner(aTHX_ packWARN(WARN_REGEXP), \ + m REPORT_LOCATION, \ + a1, a2, a3, \ REPORT_LOCATION_ARGS(loc))) -#define ckWARN4reg(loc, m, a1, a2, a3) \ - _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ - Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), \ - m REPORT_LOCATION, \ - a1, a2, a3, \ +#define ckWARN4reg(loc, m, a1, a2, a3) \ + _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ + Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), \ + m REPORT_LOCATION, \ + a1, a2, a3, \ REPORT_LOCATION_ARGS(loc))) -#define vWARN5(loc, m, a1, a2, a3, a4) \ - _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ - Perl_warner(aTHX_ packWARN(WARN_REGEXP), \ - m REPORT_LOCATION, \ - a1, a2, a3, a4, \ +#define vWARN5(loc, m, a1, a2, a3, a4) \ + _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ + Perl_warner(aTHX_ packWARN(WARN_REGEXP), \ + m REPORT_LOCATION, \ + a1, a2, a3, a4, \ REPORT_LOCATION_ARGS(loc))) -#define ckWARNexperimental(loc, class, m) \ - STMT_START { \ - if (! RExC_warned_ ## class) { /* warn once per compilation */ \ - RExC_warned_ ## class = 1; \ - _WARN_HELPER(loc, packWARN(class), \ - Perl_ck_warner_d(aTHX_ packWARN(class), \ - m REPORT_LOCATION, \ - REPORT_LOCATION_ARGS(loc)));\ - } \ +#define ckWARNexperimental(loc, class, m) \ + STMT_START { \ + if (! RExC_warned_ ## class) { /* warn once per compilation */ \ + RExC_warned_ ## class = 1; \ + _WARN_HELPER(loc, packWARN(class), \ + Perl_ck_warner_d(aTHX_ packWARN(class), \ + m REPORT_LOCATION, \ + REPORT_LOCATION_ARGS(loc))); \ + } \ } STMT_END -#define ckWARNexperimental_with_arg(loc, class, m, arg) \ - STMT_START { \ - if (! RExC_warned_ ## class) { /* warn once per compilation */ \ - RExC_warned_ ## class = 1; \ - _WARN_HELPER(loc, packWARN(class), \ - Perl_ck_warner_d(aTHX_ packWARN(class), \ - m REPORT_LOCATION, \ - arg, REPORT_LOCATION_ARGS(loc)));\ - } \ +#define ckWARNexperimental_with_arg(loc, class, m, arg) \ + STMT_START { \ + if (! RExC_warned_ ## class) { /* warn once per compilation */ \ + RExC_warned_ ## class = 1; \ + _WARN_HELPER(loc, packWARN(class), \ + Perl_ck_warner_d(aTHX_ packWARN(class), \ + m REPORT_LOCATION, \ + arg, REPORT_LOCATION_ARGS(loc))); \ + } \ } STMT_END -/* Convert between a pointer to a node and its offset from the beginning of the - * program */ -#define REGNODE_p(offset) (RExC_emit_start + (offset)) -#define REGNODE_OFFSET(node) (__ASSERT_((node) >= RExC_emit_start) \ - (SSize_t) ((node) - RExC_emit_start)) +/* Convert between a pointer to a node and its offset + * from the beginning of the program */ +#define REGNODE_p(offset) (RExC_emit_start + (offset)) +#define REGNODE_OFFSET(node) \ + (__ASSERT_((node) >= RExC_emit_start) \ + (SSize_t) ((node) - RExC_emit_start)) -#define ProgLen(ri) ri->proglen -#define SetProgLen(ri,x) ri->proglen = x +#define ProgLen(ri) ri->proglen +#define SetProgLen(ri,x) ri->proglen = x #if PERL_ENABLE_EXPERIMENTAL_REGEX_OPTIMISATIONS #define EXPERIMENTAL_INPLACESCAN -#endif /*PERL_ENABLE_EXPERIMENTAL_REGEX_OPTIMISATIONS*/ +#endif /*PERL_ENABLE_EXPERIMENTAL_REGEX_OPTIMISATIONS */ -#define DEBUG_RExC_seen() \ - DEBUG_OPTIMISE_MORE_r({ \ - Perl_re_printf( aTHX_ "RExC_seen: "); \ - \ - if (RExC_seen & REG_ZERO_LEN_SEEN) \ - Perl_re_printf( aTHX_ "REG_ZERO_LEN_SEEN "); \ - \ - if (RExC_seen & REG_LOOKBEHIND_SEEN) \ - Perl_re_printf( aTHX_ "REG_LOOKBEHIND_SEEN "); \ - \ - if (RExC_seen & REG_GPOS_SEEN) \ - Perl_re_printf( aTHX_ "REG_GPOS_SEEN "); \ - \ - if (RExC_seen & REG_RECURSE_SEEN) \ - Perl_re_printf( aTHX_ "REG_RECURSE_SEEN "); \ - \ - if (RExC_seen & REG_TOP_LEVEL_BRANCHES_SEEN) \ - Perl_re_printf( aTHX_ "REG_TOP_LEVEL_BRANCHES_SEEN "); \ - \ - if (RExC_seen & REG_VERBARG_SEEN) \ - Perl_re_printf( aTHX_ "REG_VERBARG_SEEN "); \ - \ - if (RExC_seen & REG_CUTGROUP_SEEN) \ - Perl_re_printf( aTHX_ "REG_CUTGROUP_SEEN "); \ - \ - if (RExC_seen & REG_RUN_ON_COMMENT_SEEN) \ - Perl_re_printf( aTHX_ "REG_RUN_ON_COMMENT_SEEN "); \ - \ - if (RExC_seen & REG_UNFOLDED_MULTI_SEEN) \ - Perl_re_printf( aTHX_ "REG_UNFOLDED_MULTI_SEEN "); \ - \ - if (RExC_seen & REG_UNBOUNDED_QUANTIFIER_SEEN) \ - Perl_re_printf( aTHX_ "REG_UNBOUNDED_QUANTIFIER_SEEN "); \ - \ - if (RExC_seen & REG_PESSIMIZE_SEEN) \ - Perl_re_printf( aTHX_ "REG_PESSIMIZE_SEEN "); \ - \ - Perl_re_printf( aTHX_ "\n"); \ - }); +#define DEBUG_RExC_seen() \ + DEBUG_OPTIMISE_MORE_r({ \ + Perl_re_printf( aTHX_ "RExC_seen: "); \ + \ + if (RExC_seen & REG_ZERO_LEN_SEEN) \ + Perl_re_printf( aTHX_ "REG_ZERO_LEN_SEEN "); \ + \ + if (RExC_seen & REG_LOOKBEHIND_SEEN) \ + Perl_re_printf( aTHX_ "REG_LOOKBEHIND_SEEN "); \ + \ + if (RExC_seen & REG_GPOS_SEEN) \ + Perl_re_printf( aTHX_ "REG_GPOS_SEEN "); \ + \ + if (RExC_seen & REG_RECURSE_SEEN) \ + Perl_re_printf( aTHX_ "REG_RECURSE_SEEN "); \ + \ + if (RExC_seen & REG_TOP_LEVEL_BRANCHES_SEEN) \ + Perl_re_printf( aTHX_ "REG_TOP_LEVEL_BRANCHES_SEEN "); \ + \ + if (RExC_seen & REG_VERBARG_SEEN) \ + Perl_re_printf( aTHX_ "REG_VERBARG_SEEN "); \ + \ + if (RExC_seen & REG_CUTGROUP_SEEN) \ + Perl_re_printf( aTHX_ "REG_CUTGROUP_SEEN "); \ + \ + if (RExC_seen & REG_RUN_ON_COMMENT_SEEN) \ + Perl_re_printf( aTHX_ "REG_RUN_ON_COMMENT_SEEN "); \ + \ + if (RExC_seen & REG_UNFOLDED_MULTI_SEEN) \ + Perl_re_printf( aTHX_ "REG_UNFOLDED_MULTI_SEEN "); \ + \ + if (RExC_seen & REG_UNBOUNDED_QUANTIFIER_SEEN) \ + Perl_re_printf( aTHX_ "REG_UNBOUNDED_QUANTIFIER_SEEN "); \ + \ + if (RExC_seen & REG_PESSIMIZE_SEEN) \ + Perl_re_printf( aTHX_ "REG_PESSIMIZE_SEEN "); \ + \ + Perl_re_printf( aTHX_ "\n"); \ + }); -#define DEBUG_SHOW_STUDY_FLAG(flags,flag) \ - if ((flags) & flag) Perl_re_printf( aTHX_ "%s ", #flag) +#define DEBUG_SHOW_STUDY_FLAG(flags,flag) \ + if ((flags) & flag) Perl_re_printf( aTHX_ "%s ", #flag) #ifdef DEBUGGING -# define DEBUG_STUDYDATA(where, data, depth, is_inf, min, stopmin, delta) \ - debug_studydata(where, data, depth, is_inf, min, stopmin, delta) +# define DEBUG_STUDYDATA(where, data, depth, is_inf, min, stopmin, delta) \ + debug_studydata(where, data, depth, is_inf, min, stopmin, delta) # define DEBUG_PEEP(str, scan, depth, flags) \ - debug_peep(str, pRExC_state, scan, depth, flags) + debug_peep(str, pRExC_state, scan, depth, flags) #else # define DEBUG_STUDYDATA(where, data, depth, is_inf, min, stopmin, delta) NOOP -# define DEBUG_PEEP(str, scan, depth, flags) NOOP +# define DEBUG_PEEP(str, scan, depth, flags) NOOP #endif -#define REGTAIL(x,y,z) regtail((x),(y),(z),depth+1) +#define REGTAIL(x,y,z) regtail((x),(y),(z),depth+1) #ifdef DEBUGGING -#define REGTAIL_STUDY(x,y,z) regtail_study((x),(y),(z),depth+1) +#define REGTAIL_STUDY(x,y,z) regtail_study((x),(y),(z),depth+1) #else -#define REGTAIL_STUDY(x,y,z) regtail((x),(y),(z),depth+1) +#define REGTAIL_STUDY(x,y,z) regtail((x),(y),(z),depth+1) #endif -#define MADE_TRIE 1 -#define MADE_JUMP_TRIE 2 -#define MADE_EXACT_TRIE 4 +#define MADE_TRIE 1 +#define MADE_JUMP_TRIE 2 +#define MADE_EXACT_TRIE 4 -#define INVLIST_INDEX 0 -#define ONLY_LOCALE_MATCHES_INDEX 1 -#define DEFERRED_USER_DEFINED_INDEX 2 +#define INVLIST_INDEX 0 +#define ONLY_LOCALE_MATCHES_INDEX 1 +#define DEFERRED_USER_DEFINED_INDEX 2 /* These two functions currently do the exact same thing */ #define ssc_init_zero ssc_init -#define ssc_add_cp(ssc, cp) ssc_add_range((ssc), (cp), (cp)) -#define ssc_match_all_cp(ssc) ssc_add_range(ssc, 0, UV_MAX) +#define ssc_add_cp(ssc, cp) ssc_add_range((ssc), (cp), (cp)) +#define ssc_match_all_cp(ssc) ssc_add_range(ssc, 0, UV_MAX) #ifdef DEBUGGING -#define REGNODE_GUTS(state,op,extra_size) \ +#define REGNODE_GUTS(state,op,extra_size) \ regnode_guts_debug(state,op,extra_size) #else -#define REGNODE_GUTS(state,op,extra_size) \ +#define REGNODE_GUTS(state,op,extra_size) \ regnode_guts(state,extra_size) #endif @@ -1251,11 +1331,11 @@ static const scan_data_t zero_scan_data = { optstart=NULL; \ } STMT_END -#define DUMPUNTIL(b,e) \ - CLEAR_OPTSTART; \ +#define DUMPUNTIL(b,e) \ + CLEAR_OPTSTART; \ node = dumpuntil(r,start,(b),(e),last,sv,indent+1,depth+1); -#define REGNODE_STEP_OVER(ret,t1,t2) \ +#define REGNODE_STEP_OVER(ret,t1,t2) \ NEXT_OFF(REGNODE_p(ret)) = ((sizeof(t1)+sizeof(t2))/sizeof(regnode)) #endif /* REGCOMP_INTERNAL_H */ diff --git a/regexp.h b/regexp.h index 036f6810184a..1f00c476edfa 100644 --- a/regexp.h +++ b/regexp.h @@ -1,36 +1,36 @@ /* regexp.h * - * Copyright (C) 1993, 1994, 1996, 1997, 1999, 2000, 2001, 2003, - * 2005, 2006, 2007, 2008 by Larry Wall and others + * Copyright (C) 1993, 1994, 1996, 1997, 1999, 2000, 2001, 2003, 2005, + * 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, + * 2017, 2018, 2019, 2020, 2021, 2022 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * */ /* - * Definitions etc. for regexp(3) routines. + * Definitions etc. for regexp(3) routines. * - * Caveat: this is V8 regexp(3) [actually, a reimplementation thereof], - * not the System V one. - */ + * Caveat: this is V8 regexp(3) [actually, a reimplementation + * thereof], not the System V one. +*/ #ifndef PLUGGABLE_RE_EXTENSION -/* we don't want to include this stuff if we are inside of - an external regex engine based on the core one - like re 'debug'*/ +/* we don't want to include this stuff if we are inside of an external + regex engine based on the core one - like re 'debug' */ # include "utf8.h" typedef SSize_t regnode_offset; struct regnode_meta { - U8 type; - U8 arg_len; - U8 arg_len_varies; - U8 off_by_arg; + U8 type; + U8 arg_len; + U8 arg_len_varies; + U8 off_by_arg; }; struct regnode { - U8 flags; + U8 flags; U8 type; U16 next_off; }; @@ -45,19 +45,20 @@ struct regexp_engine; struct regexp; struct reg_substr_datum { - SSize_t min_offset; /* min pos (in chars) that substr must appear */ - SSize_t max_offset; /* max pos (in chars) that substr must appear */ - SV *substr; /* non-utf8 variant */ - SV *utf8_substr; /* utf8 variant */ - SSize_t end_shift; /* how many fixed chars must end the string */ + SSize_t min_offset; /* min pos (in chars) that substr must appear */ + SSize_t max_offset; /* max pos (in chars) that substr must appear */ + SV *substr; /* non-utf8 variant */ + SV *utf8_substr; /* utf8 variant */ + SSize_t end_shift; /* how many fixed chars must end the string */ }; struct reg_substr_data { - U8 check_ix; /* index into data[] of check substr */ - struct reg_substr_datum data[3]; /* Actual array */ + U8 check_ix; /* index into data[] of check substr */ + struct reg_substr_datum data[3]; /* Actual array */ }; # ifdef PERL_ANY_COW -# define SV_SAVED_COPY SV *saved_copy; /* If non-NULL, SV which is COW from original */ +# define SV_SAVED_COPY SV *saved_copy; /* If non-NULL, SV which is + COW from original */ # else # define SV_SAVED_COPY # endif @@ -67,39 +68,41 @@ struct reg_substr_data { typedef struct regexp_paren_pair { SSize_t start; SSize_t end; - /* 'start_tmp' records a new opening position before the matching end - * has been found, so that the old start and end values are still - * valid, e.g. - * "abc" =~ /(.(?{print "[$1]"}))+/ - *outputs [][a][b] - * This field is not part of the API. */ + /* 'start_tmp' records a new opening position before the matching + * end has been found, so that the old start and end values are + * still valid, e.g. "abc" =~ /(.(?{print "[$1]"}))+/ outputs + * [][a][b] This field is not part of the API. */ SSize_t start_tmp; } regexp_paren_pair; # if defined(PERL_IN_REGCOMP_ANY) || defined(PERL_IN_UTF8_C) -# define _invlist_union(a, b, output) _invlist_union_maybe_complement_2nd(a, b, FALSE, output) -# define _invlist_intersection(a, b, output) _invlist_intersection_maybe_complement_2nd(a, b, FALSE, output) - -/* Subtracting b from a leaves in a everything that was there that isn't in b, - * that is the intersection of a with b's complement */ -# define _invlist_subtract(a, b, output) _invlist_intersection_maybe_complement_2nd(a, b, TRUE, output) +# define _invlist_union(a, b, output) \ + _invlist_union_maybe_complement_2nd(a, b, FALSE, output) +# define _invlist_intersection(a, b, output) \ + _invlist_intersection_maybe_complement_2nd(a, b, FALSE, output) + +/* Subtracting b from a leaves in a everything that was there that isn't + * in b, that is the intersection of a with b's complement */ +# define _invlist_subtract(a, b, output) \ + _invlist_intersection_maybe_complement_2nd(a, b, TRUE, output) # endif /* record the position of a (?{...}) within a pattern */ struct reg_code_block { - STRLEN start; - STRLEN end; - OP *block; - REGEXP *src_regex; + STRLEN start; + STRLEN end; + OP *block; + REGEXP *src_regex; }; /* array of reg_code_block's plus header info */ struct reg_code_blocks { - int refcnt; /* we may be pointed to from a regex and from the savestack */ - int count; /* how many code blocks */ - struct reg_code_block *cb; /* array of reg_code_block's */ + int refcnt; /* we may be pointed to from a regex + and from the savestack */ + int count; /* how many code blocks */ + struct reg_code_block *cb; /* array of reg_code_block's */ }; @@ -117,80 +120,120 @@ struct reg_code_blocks { typedef struct regexp { _XPV_HEAD; - const struct regexp_engine* engine; /* what engine created this regexp? */ - REGEXP *mother_re; /* what re is this a lightweight copy of? */ - HV *paren_names; /* Optional hash of paren names */ - - /*---------------------------------------------------------------------- + const struct regexp_engine *engine; /* what engine created + this regexp? */ + REGEXP *mother_re; /* what re is this + a lightweight + copy of? */ + HV *paren_names; /* Optional hash of + paren names */ + + /* ---------------------------------------------------------------------- * Information about the match that the perl core uses to manage things */ /* see comment in regcomp_internal.h about branch reset to understand the distinction between physical and logical capture buffers */ - U32 nparens; /* physical number of capture buffers */ - U32 logical_nparens; /* logical_number of capture buffers */ - I32 *logical_to_parno; /* map logical parno to first physcial */ - I32 *parno_to_logical; /* map every physical parno to logical */ - I32 *parno_to_logical_next; /* map every physical parno to the next - physical with the same logical id */ - - U32 extflags; /* Flags used both externally and internally */ - SSize_t minlen; /* minimum possible number of chars in string to match */ - SSize_t minlenret; /* minimum possible number of chars in $& */ - STRLEN gofs; /* chars left of pos that we search from */ - /* substring data about strings that must appear in - * the final match, used for optimisations */ - - struct reg_substr_data *substrs; + U32 nparens; /* physical number of + capture buffers */ + U32 logical_nparens; /* logical_number of + capture buffers */ + I32 *logical_to_parno; /* map logical parno to + first physcial */ + I32 *parno_to_logical; /* map every physical + parno to logical */ + I32 *parno_to_logical_next; /* map every physical + parno to the next + physical with the + same logical id */ + + U32 extflags; /* Flags used both + externally and + internally */ + SSize_t minlen; /* minimum possible + number of chars in + string to match */ + SSize_t minlenret; /* minimum possible + number of chars + in $& */ + STRLEN gofs; /* chars left of pos + that we search + from */ + /* substring data about strings that must appear in + * the final match, used for optimisations */ + + struct reg_substr_data *substrs; /* private engine specific data */ - void *pprivate; /* Data private to the regex engine which - * created this object. */ - U32 intflags; /* Engine Specific Internal flags */ + void *pprivate; /* Data private to + * the regex engine + * which created this + * object. */ + U32 intflags; /* Engine Specific + Internal flags */ - /*---------------------------------------------------------------------- - * Data about the last/current match. These are modified during matching + /* ---------------------------------------------------------------------- + * Data about the last/current match. These are modified during matching */ - U32 lastparen; /* highest close paren matched ($+) */ - regexp_paren_pair *offs; /* Array of offsets for (@-) and (@+) */ - char **recurse_locinput; /* used to detect infinite recursion, XXX: move to internal */ - U32 lastcloseparen; /* last close paren matched ($^N) */ + U32 lastparen; /* highest close paren + matched ($+) */ + regexp_paren_pair *offs; /* Array of offsets for + (@-) and (@+) */ + char **recurse_locinput; /* used to detect + infinite recursion, + XXX: move to + internal */ + U32 lastcloseparen; /* last close paren + matched ($^N) */ /*---------------------------------------------------------------------- */ /* offset from wrapped to the start of precomp */ - PERL_BITFIELD32 pre_prefix:4; + PERL_BITFIELD32 pre_prefix:4; - /* original flags used to compile the pattern, may differ from - * extflags in various ways */ - PERL_BITFIELD32 compflags:9; + /* original flags used to compile the pattern, may + * differ from extflags in various ways */ + PERL_BITFIELD32 compflags:9; /*---------------------------------------------------------------------- */ - char *subbeg; /* saved or original string so \digit works forever. */ - SV_SAVED_COPY /* If non-NULL, SV which is COW from original */ - SSize_t sublen; /* Length of string pointed by subbeg */ - SSize_t suboffset; /* byte offset of subbeg from logical start of str */ - SSize_t subcoffset; /* suboffset equiv, but in chars (for @-/@+) */ - SSize_t maxlen; /* minimum possible number of chars in string to match */ + char *subbeg; /* saved or original + string so \digit + works forever. */ + SV_SAVED_COPY /* If non-NULL, SV + which is COW from + original */ + SSize_t sublen; /* Length of string + pointed by subbeg */ + SSize_t suboffset; /* byte offset of + subbeg from logical + start of str */ + SSize_t subcoffset; /* suboffset equiv, + but in chars + (for @-/@+) */ + SSize_t maxlen; /* minimum possible + number of chars in + string to match */ /*---------------------------------------------------------------------- */ - CV *qr_anoncv; /* the anon sub wrapped round qr/(?{..})/ */ + CV *qr_anoncv; /* the anon sub wrapped + round qr/(?{..})/ + */ } regexp; -#define RXp_PAREN_NAMES(rx) ((rx)->paren_names) +#define RXp_PAREN_NAMES(rx) ((rx)->paren_names) -#define RXp_OFFS_START(rx,n) ((rx)->offs[(n)].start) +#define RXp_OFFS_START(rx,n) ((rx)->offs[(n)].start) -#define RXp_OFFS_END(rx,n) ((rx)->offs[(n)].end) +#define RXp_OFFS_END(rx,n) ((rx)->offs[(n)].end) -#define RXp_OFFS_VALID(rx,n) \ +#define RXp_OFFS_VALID(rx,n) \ ( (rx)->offs[(n)].end != -1 && (rx)->offs[(n)].start != -1 ) #define RX_OFFS_START(rx_sv,n) RXp_OFFS_START(ReANY(rx_sv),n) @@ -200,46 +243,46 @@ typedef struct regexp { /* used for high speed searches */ typedef struct re_scream_pos_data_s { - char **scream_olds; /* match pos */ - SSize_t *scream_pos; /* Internal iterator of scream. */ + char **scream_olds; /* match pos */ + SSize_t *scream_pos; /* Internal iterator of scream. */ } re_scream_pos_data; -/* regexp_engine structure. This is the dispatch table for regexes. - * Any regex engine implementation must be able to build one of these. +/* regexp_engine structure. This is the dispatch table for regexes. Any + * regex engine implementation must be able to build one of these. */ typedef struct regexp_engine { - REGEXP* (*comp) (pTHX_ SV * const pattern, U32 flags); - I32 (*exec) (pTHX_ REGEXP * const rx, char* stringarg, char* strend, - char* strbeg, SSize_t minend, SV* sv, - void* data, U32 flags); - char* (*intuit) (pTHX_ - REGEXP * const rx, - SV *sv, - const char * const strbeg, - char *strpos, - char *strend, - const U32 flags, - re_scream_pos_data *data); - SV* (*checkstr) (pTHX_ REGEXP * const rx); - void (*rxfree) (pTHX_ REGEXP * const rx); + REGEXP *(*comp) (pTHX_ SV * const pattern, U32 flags); + I32 (*exec) (pTHX_ REGEXP * const rx, char* stringarg, char* strend, + char* strbeg, SSize_t minend, SV* sv, + void* data, U32 flags); + char *(*intuit) (pTHX_ + REGEXP * const rx, + SV *sv, + const char * const strbeg, + char *strpos, + char *strend, + const U32 flags, + re_scream_pos_data *data); + SV *(*checkstr) (pTHX_ REGEXP * const rx); + void (*rxfree) (pTHX_ REGEXP * const rx); void (*numbered_buff_FETCH) (pTHX_ REGEXP * const rx, const I32 paren, SV * const sv); void (*numbered_buff_STORE) (pTHX_ REGEXP * const rx, const I32 paren, - SV const * const value); - I32 (*numbered_buff_LENGTH) (pTHX_ REGEXP * const rx, const SV * const sv, - const I32 paren); - SV* (*named_buff) (pTHX_ REGEXP * const rx, SV * const key, - SV * const value, const U32 flags); - SV* (*named_buff_iter) (pTHX_ REGEXP * const rx, const SV * const lastkey, - const U32 flags); - SV* (*qr_package)(pTHX_ REGEXP * const rx); + SV const * const value); + I32 (*numbered_buff_LENGTH)(pTHX_ REGEXP * const rx, const SV * const sv, + const I32 paren); + SV *(*named_buff) (pTHX_ REGEXP * const rx, SV * const key, + SV * const value, const U32 flags); + SV *(*named_buff_iter) (pTHX_ REGEXP * const rx, const SV * const lastkey, + const U32 flags); + SV *(*qr_package) (pTHX_ REGEXP * const rx); # ifdef USE_ITHREADS - void* (*dupe) (pTHX_ REGEXP * const rx, CLONE_PARAMS *param); + void *(*dupe) (pTHX_ REGEXP * const rx, CLONE_PARAMS *param); # endif - REGEXP* (*op_comp) (pTHX_ SV ** const patternp, int pat_count, - OP *expr, const struct regexp_engine* eng, - REGEXP *old_re, - bool *is_bare_re, U32 orig_rx_flags, U32 pm_flags); + REGEXP *(*op_comp) (pTHX_ SV ** const patternp, int pat_count, + OP *expr, const struct regexp_engine* eng, + REGEXP *old_re, + bool *is_bare_re, U32 orig_rx_flags, U32 pm_flags); } regexp_engine; /* @@ -247,12 +290,12 @@ typedef struct regexp_engine { paren name. >= 1 is reserved for actual numbered captures, i.e. $1, $2 etc. */ -# define RX_BUFF_IDX_CARET_PREMATCH -5 /* ${^PREMATCH} */ -# define RX_BUFF_IDX_CARET_POSTMATCH -4 /* ${^POSTMATCH} */ -# define RX_BUFF_IDX_CARET_FULLMATCH -3 /* ${^MATCH} */ -# define RX_BUFF_IDX_PREMATCH -2 /* $` */ -# define RX_BUFF_IDX_POSTMATCH -1 /* $' */ -# define RX_BUFF_IDX_FULLMATCH 0 /* $& */ +# define RX_BUFF_IDX_CARET_PREMATCH -5 /* ${^PREMATCH} */ +# define RX_BUFF_IDX_CARET_POSTMATCH -4 /* ${^POSTMATCH} */ +# define RX_BUFF_IDX_CARET_FULLMATCH -3 /* ${^MATCH} */ +# define RX_BUFF_IDX_PREMATCH -2 /* $` */ +# define RX_BUFF_IDX_POSTMATCH -1 /* $' */ +# define RX_BUFF_IDX_FULLMATCH 0 /* $& */ /* Flags that are passed to the named_buff and named_buff_iter @@ -262,29 +305,29 @@ typedef struct regexp_engine { */ /* The Tie::Hash::NamedCapture operation this is part of, if any */ -# define RXapif_FETCH 0x0001 -# define RXapif_STORE 0x0002 -# define RXapif_DELETE 0x0004 -# define RXapif_CLEAR 0x0008 -# define RXapif_EXISTS 0x0010 -# define RXapif_SCALAR 0x0020 -# define RXapif_FIRSTKEY 0x0040 -# define RXapif_NEXTKEY 0x0080 +# define RXapif_FETCH 0x0001 +# define RXapif_STORE 0x0002 +# define RXapif_DELETE 0x0004 +# define RXapif_CLEAR 0x0008 +# define RXapif_EXISTS 0x0010 +# define RXapif_SCALAR 0x0020 +# define RXapif_FIRSTKEY 0x0040 +# define RXapif_NEXTKEY 0x0080 /* Whether %+ or %- is being operated on */ -# define RXapif_ONE 0x0100 /* %+ */ -# define RXapif_ALL 0x0200 /* %- */ +# define RXapif_ONE 0x0100 /* %+ */ +# define RXapif_ALL 0x0200 /* %- */ /* Whether this is being called from a re:: function */ -# define RXapif_REGNAME 0x0400 -# define RXapif_REGNAMES 0x0800 -# define RXapif_REGNAMES_COUNT 0x1000 +# define RXapif_REGNAME 0x0400 +# define RXapif_REGNAMES 0x0800 +# define RXapif_REGNAMES_COUNT 0x1000 /* =for apidoc Am|REGEXP *|SvRX|SV *sv -Convenience macro to get the REGEXP from a SV. This is approximately -equivalent to the following snippet: +Convenience macro to get the REGEXP from a SV. This is +approximately equivalent to the following snippet: if (SvMAGICAL(sv)) mg_get(sv); @@ -297,52 +340,52 @@ C will be returned if a REGEXP* is not found. =for apidoc Am|bool|SvRXOK|SV* sv -Returns a boolean indicating whether the SV (or the one it references) -is a REGEXP. +Returns a boolean indicating whether the SV (or the one +it references) is a REGEXP. -If you want to do something with the REGEXP* later use SvRX instead -and check for NULL. +If you want to do something with the REGEXP* later use +SvRX instead and check for NULL. =cut */ -# define SvRX(sv) (Perl_get_re_arg(aTHX_ sv)) -# define SvRXOK(sv) cBOOL(Perl_get_re_arg(aTHX_ sv)) +# define SvRX(sv) (Perl_get_re_arg(aTHX_ sv)) +# define SvRXOK(sv) cBOOL(Perl_get_re_arg(aTHX_ sv)) -/* Flags stored in regexp->extflags - * These are used by code external to the regexp engine +/* Flags stored in regexp->extflags These are used by code external to the + * regexp engine * * Note that the flags whose names start with RXf_PMf_ are defined in * op_reg_common.h, being copied from the parallel flags of op_pmflags * * NOTE: if you modify any RXf flags you should run regen.pl or * regen/regcomp.pl so that regnodes.h is updated with the changes. - * */ # include "op_reg_common.h" -# define RXf_PMf_STD_PMMOD (RXf_PMf_MULTILINE|RXf_PMf_SINGLELINE|RXf_PMf_FOLD|RXf_PMf_EXTENDED|RXf_PMf_EXTENDED_MORE|RXf_PMf_NOCAPTURE) - -# define CASE_STD_PMMOD_FLAGS_PARSE_SET(pmfl, x_count) \ - case IGNORE_PAT_MOD: *(pmfl) |= RXf_PMf_FOLD; break; \ - case MULTILINE_PAT_MOD: *(pmfl) |= RXf_PMf_MULTILINE; break; \ - case SINGLE_PAT_MOD: *(pmfl) |= RXf_PMf_SINGLELINE; break; \ - case XTENDED_PAT_MOD: if (x_count == 0) { \ - *(pmfl) |= RXf_PMf_EXTENDED; \ - *(pmfl) &= ~RXf_PMf_EXTENDED_MORE; \ - } \ - else { \ - *(pmfl) |= RXf_PMf_EXTENDED \ - |RXf_PMf_EXTENDED_MORE; \ - } \ - (x_count)++; break; \ - case NOCAPTURE_PAT_MOD: *(pmfl) |= RXf_PMf_NOCAPTURE; break; +# define RXf_PMf_STD_PMMOD \ + (RXf_PMf_MULTILINE|RXf_PMf_SINGLELINE|RXf_PMf_FOLD|RXf_PMf_EXTENDED|RXf_PMf_EXTENDED_MORE|RXf_PMf_NOCAPTURE) + +# define CASE_STD_PMMOD_FLAGS_PARSE_SET(pmfl, x_count) \ + case IGNORE_PAT_MOD: *(pmfl) |= RXf_PMf_FOLD; break; \ + case MULTILINE_PAT_MOD: *(pmfl) |= RXf_PMf_MULTILINE; break; \ + case SINGLE_PAT_MOD: *(pmfl) |= RXf_PMf_SINGLELINE; break; \ + case XTENDED_PAT_MOD: if (x_count == 0) { \ + *(pmfl) |= RXf_PMf_EXTENDED; \ + *(pmfl) &= ~RXf_PMf_EXTENDED_MORE; \ + } \ + else { \ + *(pmfl) |= RXf_PMf_EXTENDED \ + |RXf_PMf_EXTENDED_MORE; \ + } \ + (x_count)++; break; \ + case NOCAPTURE_PAT_MOD: *(pmfl) |= RXf_PMf_NOCAPTURE; break; /* Note, includes charset ones, assumes 0 is the default for them */ -# define STD_PMMOD_FLAGS_CLEAR(pmfl) \ - *(pmfl) &= ~(RXf_PMf_FOLD|RXf_PMf_MULTILINE|RXf_PMf_SINGLELINE|RXf_PMf_EXTENDED|RXf_PMf_EXTENDED_MORE|RXf_PMf_CHARSET|RXf_PMf_NOCAPTURE) +# define STD_PMMOD_FLAGS_CLEAR(pmfl) \ + *(pmfl) &= ~(RXf_PMf_FOLD|RXf_PMf_MULTILINE|RXf_PMf_SINGLELINE|RXf_PMf_EXTENDED|RXf_PMf_EXTENDED_MORE|RXf_PMf_CHARSET|RXf_PMf_NOCAPTURE) /* chars and strings used as regex pattern modifiers * Singular is a 'c'har, plural is a "string" @@ -351,133 +394,136 @@ and check for NULL. * for compatibility reasons with Regexp::Common which highjacked (?k:...) * for its own uses. So 'k' is out as well. */ -# define DEFAULT_PAT_MOD '^' /* Short for all the default modifiers */ -# define EXEC_PAT_MOD 'e' -# define KEEPCOPY_PAT_MOD 'p' -# define NOCAPTURE_PAT_MOD 'n' -# define ONCE_PAT_MOD 'o' -# define GLOBAL_PAT_MOD 'g' -# define CONTINUE_PAT_MOD 'c' -# define MULTILINE_PAT_MOD 'm' -# define SINGLE_PAT_MOD 's' -# define IGNORE_PAT_MOD 'i' -# define XTENDED_PAT_MOD 'x' -# define NONDESTRUCT_PAT_MOD 'r' -# define LOCALE_PAT_MOD 'l' -# define UNICODE_PAT_MOD 'u' -# define DEPENDS_PAT_MOD 'd' +# define DEFAULT_PAT_MOD '^' /* Short for all the default modifiers */ +# define EXEC_PAT_MOD 'e' +# define KEEPCOPY_PAT_MOD 'p' +# define NOCAPTURE_PAT_MOD 'n' +# define ONCE_PAT_MOD 'o' +# define GLOBAL_PAT_MOD 'g' +# define CONTINUE_PAT_MOD 'c' +# define MULTILINE_PAT_MOD 'm' +# define SINGLE_PAT_MOD 's' +# define IGNORE_PAT_MOD 'i' +# define XTENDED_PAT_MOD 'x' +# define NONDESTRUCT_PAT_MOD 'r' +# define LOCALE_PAT_MOD 'l' +# define UNICODE_PAT_MOD 'u' +# define DEPENDS_PAT_MOD 'd' # define ASCII_RESTRICT_PAT_MOD 'a' -# define ONCE_PAT_MODS "o" -# define KEEPCOPY_PAT_MODS "p" -# define NOCAPTURE_PAT_MODS "n" -# define EXEC_PAT_MODS "e" -# define LOOP_PAT_MODS "gc" -# define NONDESTRUCT_PAT_MODS "r" -# define LOCALE_PAT_MODS "l" -# define UNICODE_PAT_MODS "u" -# define DEPENDS_PAT_MODS "d" +# define ONCE_PAT_MODS "o" +# define KEEPCOPY_PAT_MODS "p" +# define NOCAPTURE_PAT_MODS "n" +# define EXEC_PAT_MODS "e" +# define LOOP_PAT_MODS "gc" +# define NONDESTRUCT_PAT_MODS "r" +# define LOCALE_PAT_MODS "l" +# define UNICODE_PAT_MODS "u" +# define DEPENDS_PAT_MODS "d" # define ASCII_RESTRICT_PAT_MODS "a" # define ASCII_MORE_RESTRICT_PAT_MODS "aa" -/* This string is expected by regcomp.c to be ordered so that the first - * character is the flag in bit RXf_PMf_STD_PMMOD_SHIFT of extflags; the next - * character is bit +1, etc. */ -# define STD_PAT_MODS "msixxn" +/* This string is expected by regcomp.c to be ordered so that + * the first character is the flag in bit RXf_PMf_STD_PMMOD_SHIFT + * of extflags; the next character is bit +1, etc. */ +# define STD_PAT_MODS "msixxn" -# define CHARSET_PAT_MODS ASCII_RESTRICT_PAT_MODS DEPENDS_PAT_MODS LOCALE_PAT_MODS UNICODE_PAT_MODS +# define CHARSET_PAT_MODS \ + ASCII_RESTRICT_PAT_MODS DEPENDS_PAT_MODS LOCALE_PAT_MODS UNICODE_PAT_MODS -/* This string is expected by XS_re_regexp_pattern() in universal.c to be ordered - * so that the first character is the flag in bit RXf_PMf_STD_PMMOD_SHIFT of +/* This string is expected by XS_re_regexp_pattern() in + * universal.c to be ordered so that the first character + * is the flag in bit RXf_PMf_STD_PMMOD_SHIFT of * extflags; the next character is in bit +1, etc. */ -# define INT_PAT_MODS STD_PAT_MODS KEEPCOPY_PAT_MODS +# define INT_PAT_MODS STD_PAT_MODS KEEPCOPY_PAT_MODS -# define EXT_PAT_MODS ONCE_PAT_MODS KEEPCOPY_PAT_MODS NOCAPTURE_PAT_MODS -# define QR_PAT_MODS STD_PAT_MODS EXT_PAT_MODS CHARSET_PAT_MODS -# define M_PAT_MODS QR_PAT_MODS LOOP_PAT_MODS -# define S_PAT_MODS M_PAT_MODS EXEC_PAT_MODS NONDESTRUCT_PAT_MODS +# define EXT_PAT_MODS ONCE_PAT_MODS KEEPCOPY_PAT_MODS NOCAPTURE_PAT_MODS +# define QR_PAT_MODS STD_PAT_MODS EXT_PAT_MODS CHARSET_PAT_MODS +# define M_PAT_MODS QR_PAT_MODS LOOP_PAT_MODS +# define S_PAT_MODS \ + M_PAT_MODS EXEC_PAT_MODS NONDESTRUCT_PAT_MODS /* * NOTE: if you modify any RXf flags you should run regen.pl or * regen/regcomp.pl so that regnodes.h is updated with the changes. - * - */ +*/ /* Set in Perl_pmruntime for a split. Will be used by regex engines to check whether they should set RXf_SKIPWHITE */ -# define RXf_SPLIT RXf_PMf_SPLIT +# define RXf_SPLIT RXf_PMf_SPLIT /* Currently the regex flags occupy a single 32-bit word. Not all bits are - * currently used. The lower bits are shared with their corresponding PMf flag - * bits, up to but not including _RXf_PMf_SHIFT_NEXT. The unused bits - * immediately follow; finally the used RXf-only (unshared) bits, so that the - * highest bit in the word is used. This gathers all the unused bits as a pool - * in the middle, like so: 11111111111111110000001111111111 - * where the '1's represent used bits, and the '0's unused. This design allows - * us to allocate off one end of the pool if we need to add a shared bit, and - * off the other end if we need a non-shared bit, without disturbing the other - * bits. This maximizes the likelihood of being able to change things without - * breaking binary compatibility. + * currently used. The lower bits are shared with their corresponding PMf + * flag bits, up to but not including _RXf_PMf_SHIFT_NEXT. The unused bits + * immediately follow; finally the used RXf-only (unshared) bits, so that + * the highest bit in the word is used. This gathers all the unused bits as + * a pool in the middle, like so: 11111111111111110000001111111111 where the + * '1's represent used bits, and the '0's unused. This design allows us to + * allocate off one end of the pool if we need to add a shared bit, and off + * the other end if we need a non-shared bit, without disturbing the other + * bits. This maximizes the likelihood of being able to change things + * without breaking binary compatibility. * * To add shared bits, do so in op_reg_common.h. This should change - * _RXf_PMf_SHIFT_NEXT so that things won't compile. Then come to regexp.h and - * op.h and adjust the constant adders in the definitions of RXf_BASE_SHIFT and - * Pmf_BASE_SHIFT down by the number of shared bits you added. That's it. - * Things should be binary compatible. But if either of these gets to having - * to subtract rather than add, leave at 0 and instead adjust all the entries - * that are in terms of it. But if the first one of those is already - * RXf_BASE_SHIFT+0, there are no bits left, and a redesign is in order. + * _RXf_PMf_SHIFT_NEXT so that things won't compile. Then come to regexp.h + * and op.h and adjust the constant adders in the definitions of + * RXf_BASE_SHIFT and Pmf_BASE_SHIFT down by the number of shared bits you + * added. That's it. Things should be binary compatible. But if either of + * these gets to having to subtract rather than add, leave at 0 and instead + * adjust all the entries that are in terms of it. But if the first one of + * those is already RXf_BASE_SHIFT+0, there are no bits left, and a redesign + * is in order. * * To remove unshared bits, just delete its entry. If you're where breaking * binary compatibility is ok to do, you might want to adjust things to move * the newly opened space so that it gets absorbed into the common pool. * * To add unshared bits, first use up any gaps in the middle. Otherwise, - * allocate off the low end until you get to RXf_BASE_SHIFT+0. If that isn't - * enough, move RXf_BASE_SHIFT down (if possible) and add the new bit at the - * other end instead; this preserves binary compatibility. + * allocate off the low end until you get to RXf_BASE_SHIFT+0. If that + * isn't enough, move RXf_BASE_SHIFT down (if possible) and add the new bit + * at the other end instead; this preserves binary compatibility. * * For the regexp bits, PL_reg_extflags_name[] in regnodes.h has a comment * giving which bits are used/unused */ -# define RXf_BASE_SHIFT (_RXf_PMf_SHIFT_NEXT + 2) +# define RXf_BASE_SHIFT (_RXf_PMf_SHIFT_NEXT + 2) /* What we have seen */ -# define RXf_NO_INPLACE_SUBST (1U<<(RXf_BASE_SHIFT+2)) -# define RXf_EVAL_SEEN (1U<<(RXf_BASE_SHIFT+3)) +# define RXf_NO_INPLACE_SUBST (1U<<(RXf_BASE_SHIFT+2)) +# define RXf_EVAL_SEEN (1U<<(RXf_BASE_SHIFT+3)) /* Special */ -# define RXf_UNBOUNDED_QUANTIFIER_SEEN (1U<<(RXf_BASE_SHIFT+4)) -# define RXf_CHECK_ALL (1U<<(RXf_BASE_SHIFT+5)) +# define RXf_UNBOUNDED_QUANTIFIER_SEEN (1U<<(RXf_BASE_SHIFT+4)) +# define RXf_CHECK_ALL (1U<<(RXf_BASE_SHIFT+5)) /* UTF8 related */ -# define RXf_MATCH_UTF8 (1U<<(RXf_BASE_SHIFT+6)) /* $1 etc are utf8 */ +# define RXf_MATCH_UTF8 (1U<<(RXf_BASE_SHIFT+6)) /* $1 etc are utf8 */ /* Intuit related */ -# define RXf_USE_INTUIT_NOML (1U<<(RXf_BASE_SHIFT+7)) -# define RXf_USE_INTUIT_ML (1U<<(RXf_BASE_SHIFT+8)) -# define RXf_INTUIT_TAIL (1U<<(RXf_BASE_SHIFT+9)) -# define RXf_USE_INTUIT (RXf_USE_INTUIT_NOML|RXf_USE_INTUIT_ML) +# define RXf_USE_INTUIT_NOML (1U<<(RXf_BASE_SHIFT+7)) +# define RXf_USE_INTUIT_ML (1U<<(RXf_BASE_SHIFT+8)) +# define RXf_INTUIT_TAIL (1U<<(RXf_BASE_SHIFT+9)) +# define RXf_USE_INTUIT (RXf_USE_INTUIT_NOML|RXf_USE_INTUIT_ML) /* Do we have some sort of anchor? */ -# define RXf_IS_ANCHORED (1U<<(RXf_BASE_SHIFT+10)) +# define RXf_IS_ANCHORED (1U<<(RXf_BASE_SHIFT+10)) /* Copy and tainted info */ -# define RXf_COPY_DONE (1U<<(RXf_BASE_SHIFT+11)) +# define RXf_COPY_DONE (1U<<(RXf_BASE_SHIFT+11)) /* post-execution: $1 et al are tainted */ -# define RXf_TAINTED_SEEN (1U<<(RXf_BASE_SHIFT+12)) +# define RXf_TAINTED_SEEN (1U<<(RXf_BASE_SHIFT+12)) /* this pattern was tainted during compilation */ -# define RXf_TAINTED (1U<<(RXf_BASE_SHIFT+13)) +# define RXf_TAINTED (1U<<(RXf_BASE_SHIFT+13)) /* Flags indicating special patterns */ -# define RXf_START_ONLY (1U<<(RXf_BASE_SHIFT+14)) /* Pattern is /^/ */ -# define RXf_SKIPWHITE (1U<<(RXf_BASE_SHIFT+15)) /* Pattern is for a */ +# define RXf_START_ONLY (1U<<(RXf_BASE_SHIFT+14)) /* Pattern is /^/ */ +# define RXf_SKIPWHITE (1U<<(RXf_BASE_SHIFT+15)) /* Pattern is for a */ /* split " " */ -# define RXf_WHITE (1U<<(RXf_BASE_SHIFT+16)) /* Pattern is /\s+/ */ -# define RXf_NULL (1U<<(RXf_BASE_SHIFT+17)) /* Pattern is // */ +# define RXf_WHITE (1U<<(RXf_BASE_SHIFT+16)) /* Pattern is /\s+/ */ +# define RXf_NULL (1U<<(RXf_BASE_SHIFT+17)) /* Pattern is // */ /* See comments at the beginning of these defines about adding bits. The * highest bit position should be used, so that if RXf_BASE_SHIFT gets @@ -490,200 +536,215 @@ and check for NULL. /* * NOTE: if you modify any RXf flags you should run regen.pl or * regen/regcomp.pl so that regnodes.h is updated with the changes. - * - */ +*/ # ifdef NO_TAINT_SUPPORT -# define RX_ISTAINTED(rx_sv) 0 -# define RXp_ISTAINTED(prog) 0 -# define RX_TAINT_on(rx_sv) NOOP -# define RXp_MATCH_TAINTED(prog) 0 -# define RX_MATCH_TAINTED(rx_sv) 0 -# define RXp_MATCH_TAINTED_on(prog) NOOP -# define RX_MATCH_TAINTED_on(rx_sv) NOOP -# define RXp_MATCH_TAINTED_off(prog) NOOP -# define RX_MATCH_TAINTED_off(rx_sv) NOOP +# define RX_ISTAINTED(rx_sv) 0 +# define RXp_ISTAINTED(prog) 0 +# define RX_TAINT_on(rx_sv) NOOP +# define RXp_MATCH_TAINTED(prog) 0 +# define RX_MATCH_TAINTED(rx_sv) 0 +# define RXp_MATCH_TAINTED_on(prog) NOOP +# define RX_MATCH_TAINTED_on(rx_sv) NOOP +# define RXp_MATCH_TAINTED_off(prog) NOOP +# define RX_MATCH_TAINTED_off(rx_sv) NOOP # else -# define RX_ISTAINTED(rx_sv) (RX_EXTFLAGS(rx_sv) & RXf_TAINTED) -# define RXp_ISTAINTED(prog) (RXp_EXTFLAGS(prog) & RXf_TAINTED) -# define RX_TAINT_on(rx_sv) (RX_EXTFLAGS(rx_sv) |= RXf_TAINTED) -# define RXp_MATCH_TAINTED(prog) (RXp_EXTFLAGS(prog) & RXf_TAINTED_SEEN) -# define RX_MATCH_TAINTED(rx_sv) (RX_EXTFLAGS(rx_sv) & RXf_TAINTED_SEEN) -# define RXp_MATCH_TAINTED_on(prog) (RXp_EXTFLAGS(prog) |= RXf_TAINTED_SEEN) -# define RX_MATCH_TAINTED_on(rx_sv) (RX_EXTFLAGS(rx_sv) |= RXf_TAINTED_SEEN) -# define RXp_MATCH_TAINTED_off(prog) (RXp_EXTFLAGS(prog) &= ~RXf_TAINTED_SEEN) -# define RX_MATCH_TAINTED_off(rx_sv) (RX_EXTFLAGS(rx_sv) &= ~RXf_TAINTED_SEEN) +# define RX_ISTAINTED(rx_sv) (RX_EXTFLAGS(rx_sv) & RXf_TAINTED) +# define RXp_ISTAINTED(prog) (RXp_EXTFLAGS(prog) & RXf_TAINTED) +# define RX_TAINT_on(rx_sv) (RX_EXTFLAGS(rx_sv) |= RXf_TAINTED) +# define RXp_MATCH_TAINTED(prog) \ + (RXp_EXTFLAGS(prog) & RXf_TAINTED_SEEN) +# define RX_MATCH_TAINTED(rx_sv) \ + (RX_EXTFLAGS(rx_sv) & RXf_TAINTED_SEEN) +# define RXp_MATCH_TAINTED_on(prog) \ + (RXp_EXTFLAGS(prog) |= RXf_TAINTED_SEEN) +# define RX_MATCH_TAINTED_on(rx_sv) \ + (RX_EXTFLAGS(rx_sv) |= RXf_TAINTED_SEEN) +# define RXp_MATCH_TAINTED_off(prog) \ + (RXp_EXTFLAGS(prog) &= ~RXf_TAINTED_SEEN) +# define RX_MATCH_TAINTED_off(rx_sv) \ + (RX_EXTFLAGS(rx_sv) &= ~RXf_TAINTED_SEEN) # endif -# define RXp_HAS_CUTGROUP(prog) ((prog)->intflags & PREGf_CUTGROUP_SEEN) - -# define RX_MATCH_TAINTED_set(rx_sv, t) ((t) \ - ? RX_MATCH_TAINTED_on(rx_sv) \ - : RX_MATCH_TAINTED_off(rx_sv)) - -# define RXp_MATCH_COPIED(prog) (RXp_EXTFLAGS(prog) & RXf_COPY_DONE) -# define RX_MATCH_COPIED(rx_sv) (RX_EXTFLAGS(rx_sv) & RXf_COPY_DONE) -# define RXp_MATCH_COPIED_on(prog) (RXp_EXTFLAGS(prog) |= RXf_COPY_DONE) -# define RX_MATCH_COPIED_on(rx_sv) (RX_EXTFLAGS(rx_sv) |= RXf_COPY_DONE) -# define RXp_MATCH_COPIED_off(prog) (RXp_EXTFLAGS(prog) &= ~RXf_COPY_DONE) -# define RX_MATCH_COPIED_off(rx_sv) (RX_EXTFLAGS(rx_sv) &= ~RXf_COPY_DONE) -# define RX_MATCH_COPIED_set(rx_sv,t) ((t) \ - ? RX_MATCH_COPIED_on(rx_sv) \ - : RX_MATCH_COPIED_off(rx_sv)) - -# define RXp_EXTFLAGS(rx) ((rx)->extflags) -# define RXp_COMPFLAGS(rx) ((rx)->compflags) - -/* For source compatibility. We used to store these explicitly. */ -# define RX_PRECOMP(rx_sv) (RX_WRAPPED(rx_sv) \ - + ReANY(rx_sv)->pre_prefix) -# define RX_PRECOMP_const(rx_sv) (RX_WRAPPED_const(rx_sv) \ - + ReANY(rx_sv)->pre_prefix) +# define RXp_HAS_CUTGROUP(prog) \ + ((prog)->intflags & PREGf_CUTGROUP_SEEN) + +# define RX_MATCH_TAINTED_set(rx_sv, t) \ + ((t) \ + ? RX_MATCH_TAINTED_on(rx_sv) \ + : RX_MATCH_TAINTED_off(rx_sv)) + +# define RXp_MATCH_COPIED(prog) (RXp_EXTFLAGS(prog) & RXf_COPY_DONE) +# define RX_MATCH_COPIED(rx_sv) (RX_EXTFLAGS(rx_sv) & RXf_COPY_DONE) +# define RXp_MATCH_COPIED_on(prog) (RXp_EXTFLAGS(prog) |= RXf_COPY_DONE) +# define RX_MATCH_COPIED_on(rx_sv) (RX_EXTFLAGS(rx_sv) |= RXf_COPY_DONE) +# define RXp_MATCH_COPIED_off(prog) (RXp_EXTFLAGS(prog) &= ~RXf_COPY_DONE) +# define RX_MATCH_COPIED_off(rx_sv) (RX_EXTFLAGS(rx_sv) &= ~RXf_COPY_DONE) +# define RX_MATCH_COPIED_set(rx_sv,t) \ + ((t) \ + ? RX_MATCH_COPIED_on(rx_sv) \ + : RX_MATCH_COPIED_off(rx_sv)) + +# define RXp_EXTFLAGS(rx) ((rx)->extflags) +# define RXp_COMPFLAGS(rx) ((rx)->compflags) + +/* For source compatibility. We used to store these explicitly. */ +# define RX_PRECOMP(rx_sv) \ + (RX_WRAPPED(rx_sv) + ReANY(rx_sv)->pre_prefix) +# define RX_PRECOMP_const(rx_sv) \ + (RX_WRAPPED_const(rx_sv) + ReANY(rx_sv)->pre_prefix) /* FIXME? Are we hardcoding too much here and constraining plugin extension writers? Specifically, the value 1 assumes that the wrapped version always - has exactly one character at the end, a ')'. Will that always be true? */ -# define RX_PRELEN(rx_sv) (RX_WRAPLEN(rx_sv) \ - - ReANY(rx_sv)->pre_prefix - 1) - -# define RX_WRAPPED(rx_sv) SvPVX(rx_sv) -# define RX_WRAPPED_const(rx_sv) SvPVX_const(rx_sv) -# define RX_WRAPLEN(rx_sv) SvCUR(rx_sv) -# define RX_CHECK_SUBSTR(rx_sv) (ReANY(rx_sv)->check_substr) -# define RX_REFCNT(rx_sv) SvREFCNT(rx_sv) -# define RX_EXTFLAGS(rx_sv) RXp_EXTFLAGS(ReANY(rx_sv)) -# define RX_COMPFLAGS(rx_sv) RXp_COMPFLAGS(ReANY(rx_sv)) -# define RXp_ENGINE(prog) ((prog)->engine) -# define RX_ENGINE(rx_sv) (RXp_ENGINE(ReANY(rx_sv))) -# define RXp_SUBBEG(prog) (prog->subbeg) -# define RX_SUBBEG(rx_sv) (RXp_SUBBEG(ReANY(rx_sv))) -# define RXp_SUBOFFSET(prog) (prog->suboffset) -# define RX_SUBOFFSET(rx_sv) (RXp_SUBOFFSET(ReANY(rx_sv))) -# define RX_SUBCOFFSET(rx_sv) (ReANY(rx_sv)->subcoffset) -# define RXp_OFFSp(prog) (prog->offs) -# define RX_OFFSp(rx_sv) (RXp_OFFSp(ReANY(rx_sv))) -# define RXp_LOGICAL_NPARENS(prog) (prog->logical_nparens) -# define RX_LOGICAL_NPARENS(rx_sv) (RXp_LOGICAL_NPARENS(ReANY(rx_sv))) -# define RXp_LOGICAL_TO_PARNO(prog) (prog->logical_to_parno) -# define RX_LOGICAL_TO_PARNO(rx_sv) (RXp_LOGICAL_TO_PARNO(ReANY(rx_sv))) -# define RXp_PARNO_TO_LOGICAL(prog) (prog->parno_to_logical) -# define RX_PARNO_TO_LOGICAL(rx_sv) (RXp_PARNO_TO_LOGICAL(ReANY(rx_sv))) + has exactly one character at the end, a ')'. Will that always be true? */ +# define RX_PRELEN(rx_sv) \ + (RX_WRAPLEN(rx_sv) - ReANY(rx_sv)->pre_prefix - 1) + +# define RX_WRAPPED(rx_sv) SvPVX(rx_sv) +# define RX_WRAPPED_const(rx_sv) SvPVX_const(rx_sv) +# define RX_WRAPLEN(rx_sv) SvCUR(rx_sv) +# define RX_CHECK_SUBSTR(rx_sv) (ReANY(rx_sv)->check_substr) +# define RX_REFCNT(rx_sv) SvREFCNT(rx_sv) +# define RX_EXTFLAGS(rx_sv) RXp_EXTFLAGS(ReANY(rx_sv)) +# define RX_COMPFLAGS(rx_sv) RXp_COMPFLAGS(ReANY(rx_sv)) +# define RXp_ENGINE(prog) ((prog)->engine) +# define RX_ENGINE(rx_sv) (RXp_ENGINE(ReANY(rx_sv))) +# define RXp_SUBBEG(prog) (prog->subbeg) +# define RX_SUBBEG(rx_sv) (RXp_SUBBEG(ReANY(rx_sv))) +# define RXp_SUBOFFSET(prog) (prog->suboffset) +# define RX_SUBOFFSET(rx_sv) (RXp_SUBOFFSET(ReANY(rx_sv))) +# define RX_SUBCOFFSET(rx_sv) (ReANY(rx_sv)->subcoffset) +# define RXp_OFFSp(prog) (prog->offs) +# define RX_OFFSp(rx_sv) (RXp_OFFSp(ReANY(rx_sv))) +# define RXp_LOGICAL_NPARENS(prog) (prog->logical_nparens) +# define RX_LOGICAL_NPARENS(rx_sv) (RXp_LOGICAL_NPARENS(ReANY(rx_sv))) +# define RXp_LOGICAL_TO_PARNO(prog) (prog->logical_to_parno) +# define RX_LOGICAL_TO_PARNO(rx_sv) (RXp_LOGICAL_TO_PARNO(ReANY(rx_sv))) +# define RXp_PARNO_TO_LOGICAL(prog) (prog->parno_to_logical) +# define RX_PARNO_TO_LOGICAL(rx_sv) (RXp_PARNO_TO_LOGICAL(ReANY(rx_sv))) # define RXp_PARNO_TO_LOGICAL_NEXT(prog) (prog->parno_to_logical_next) -# define RX_PARNO_TO_LOGICAL_NEXT(rx_sv) (RXp_PARNO_TO_LOGICAL_NEXT(ReANY(rx_sv))) -# define RXp_NPARENS(prog) (prog->nparens) -# define RX_NPARENS(rx_sv) (RXp_NPARENS(ReANY(rx_sv))) -# define RX_SUBLEN(rx_sv) (ReANY(rx_sv)->sublen) -# define RXp_MINLEN(prog) (prog->minlen) -# define RX_MINLEN(rx_sv) (RXp_MINLEN(ReANY(rx_sv))) -# define RXp_MINLENRET(prog) (prog->minlenret) -# define RX_MINLENRET(rx_sv) (RXp_MINLENRET(ReANY(rx_sv))) -# define RXp_GOFS(prog) (prog->gofs) -# define RX_GOFS(rx_sv) (RXp_GOFS(ReANY(rx_sv))) -# define RX_LASTPAREN(rx_sv) (ReANY(rx_sv)->lastparen) -# define RX_LASTCLOSEPAREN(rx_sv) (ReANY(rx_sv)->lastcloseparen) -# define RXp_SAVED_COPY(prog) (prog->saved_copy) -# define RX_SAVED_COPY(rx_sv) (RXp_SAVED_COPY(ReANY(rx_sv))) +# define RX_PARNO_TO_LOGICAL_NEXT(rx_sv) \ + (RXp_PARNO_TO_LOGICAL_NEXT(ReANY(rx_sv))) +# define RXp_NPARENS(prog) (prog->nparens) +# define RX_NPARENS(rx_sv) (RXp_NPARENS(ReANY(rx_sv))) +# define RX_SUBLEN(rx_sv) (ReANY(rx_sv)->sublen) +# define RXp_MINLEN(prog) (prog->minlen) +# define RX_MINLEN(rx_sv) (RXp_MINLEN(ReANY(rx_sv))) +# define RXp_MINLENRET(prog) (prog->minlenret) +# define RX_MINLENRET(rx_sv) (RXp_MINLENRET(ReANY(rx_sv))) +# define RXp_GOFS(prog) (prog->gofs) +# define RX_GOFS(rx_sv) (RXp_GOFS(ReANY(rx_sv))) +# define RX_LASTPAREN(rx_sv) (ReANY(rx_sv)->lastparen) +# define RX_LASTCLOSEPAREN(rx_sv) (ReANY(rx_sv)->lastcloseparen) +# define RXp_SAVED_COPY(prog) (prog->saved_copy) +# define RX_SAVED_COPY(rx_sv) (RXp_SAVED_COPY(ReANY(rx_sv))) /* last match was zero-length */ -# define RXp_ZERO_LEN(prog) \ - (RXp_OFFS_START(prog,0) + (SSize_t)RXp_GOFS(prog) \ - == RXp_OFFS_END(prog,0)) -# define RX_ZERO_LEN(rx_sv) (RXp_ZERO_LEN(ReANY(rx_sv))) +# define RXp_ZERO_LEN(prog) \ + (RXp_OFFS_START(prog,0) + (SSize_t)RXp_GOFS(prog) \ + == RXp_OFFS_END(prog,0)) +# define RX_ZERO_LEN(rx_sv) (RXp_ZERO_LEN(ReANY(rx_sv))) #endif /* PLUGGABLE_RE_EXTENSION */ -/* Stuff that needs to be included in the pluggable extension goes below here */ +/* Stuff that needs to be included in the pluggable + extension goes below here */ #ifdef PERL_ANY_COW # define RXp_MATCH_COPY_FREE(prog) \ - STMT_START { \ - if (RXp_SAVED_COPY(prog)) { \ - SV_CHECK_THINKFIRST_COW_DROP(RXp_SAVED_COPY(prog)); \ - } \ - if (RXp_MATCH_COPIED(prog)) { \ - Safefree(RXp_SUBBEG(prog)); \ - RXp_MATCH_COPIED_off(prog); \ - } \ - } STMT_END + STMT_START { \ + if (RXp_SAVED_COPY(prog)) { \ + SV_CHECK_THINKFIRST_COW_DROP(RXp_SAVED_COPY(prog)); \ + } \ + if (RXp_MATCH_COPIED(prog)) { \ + Safefree(RXp_SUBBEG(prog)); \ + RXp_MATCH_COPIED_off(prog); \ + } \ + } STMT_END #else -# define RXp_MATCH_COPY_FREE(prog) \ - STMT_START { \ - if (RXp_MATCH_COPIED(prog)) { \ - Safefree(RXp_SUBBEG(prog)); \ - RXp_MATCH_COPIED_off(prog); \ - } \ - } STMT_END +# define RXp_MATCH_COPY_FREE(prog) \ + STMT_START { \ + if (RXp_MATCH_COPIED(prog)) { \ + Safefree(RXp_SUBBEG(prog)); \ + RXp_MATCH_COPIED_off(prog); \ + } \ + } STMT_END #endif -#define RX_MATCH_COPY_FREE(rx_sv) RXp_MATCH_COPY_FREE(ReANY(rx_sv)) +#define RX_MATCH_COPY_FREE(rx_sv) RXp_MATCH_COPY_FREE(ReANY(rx_sv)) -#define RXp_MATCH_UTF8(prog) (RXp_EXTFLAGS(prog) & RXf_MATCH_UTF8) -#define RX_MATCH_UTF8(rx_sv) (RX_EXTFLAGS(rx_sv) & RXf_MATCH_UTF8) -#define RXp_MATCH_UTF8_on(prog) (RXp_EXTFLAGS(prog) |= RXf_MATCH_UTF8) -#define RX_MATCH_UTF8_on(rx_sv) (RXp_MATCH_UTF8_on(ReANY(rx_sv))) -#define RXp_MATCH_UTF8_off(prog) (RXp_EXTFLAGS(prog) &= ~RXf_MATCH_UTF8) -#define RX_MATCH_UTF8_off(rx_sv) (RXp_MATCH_UTF8_off(ReANY(rx_sv)) -#define RXp_MATCH_UTF8_set(prog, t) ((t) \ - ? RXp_MATCH_UTF8_on(prog) \ - : RXp_MATCH_UTF8_off(prog)) -#define RX_MATCH_UTF8_set(rx_sv, t) (RXp_MATCH_UTF8_set(ReANY(rx_sv), t)) +#define RXp_MATCH_UTF8(prog) (RXp_EXTFLAGS(prog) & RXf_MATCH_UTF8) +#define RX_MATCH_UTF8(rx_sv) (RX_EXTFLAGS(rx_sv) & RXf_MATCH_UTF8) +#define RXp_MATCH_UTF8_on(prog) (RXp_EXTFLAGS(prog) |= RXf_MATCH_UTF8) +#define RX_MATCH_UTF8_on(rx_sv) (RXp_MATCH_UTF8_on(ReANY(rx_sv))) +#define RXp_MATCH_UTF8_off(prog) (RXp_EXTFLAGS(prog) &= ~RXf_MATCH_UTF8) +#define RX_MATCH_UTF8_off(rx_sv) (RXp_MATCH_UTF8_off(ReANY(rx_sv)) +#define RXp_MATCH_UTF8_set(prog, t) \ + ((t) \ + ? RXp_MATCH_UTF8_on(prog) \ + : RXp_MATCH_UTF8_off(prog)) +#define RX_MATCH_UTF8_set(rx_sv, t) (RXp_MATCH_UTF8_set(ReANY(rx_sv), t)) -/* Whether the pattern stored at RX_WRAPPED is in UTF-8 */ -#define RX_UTF8(rx_sv) SvUTF8(rx_sv) +/* Whether the pattern stored at RX_WRAPPED is in UTF-8 */ +#define RX_UTF8(rx_sv) SvUTF8(rx_sv) /* bits in flags arg of Perl_regexec_flags() */ -#define REXEC_COPY_STR 0x01 /* Need to copy the string for captures. */ -#define REXEC_CHECKED 0x02 /* re_intuit_start() already called. */ -#define REXEC_SCREAM 0x04 /* currently unused. */ -#define REXEC_IGNOREPOS 0x08 /* use stringarg, not pos(), for \G match */ -#define REXEC_NOT_FIRST 0x10 /* This is another iteration of //g: - no need to copy string again */ +#define REXEC_COPY_STR 0x01 /* Need to copy the string + for captures. */ +#define REXEC_CHECKED 0x02 /* re_intuit_start() already + called. */ +#define REXEC_SCREAM 0x04 /* currently unused. */ +#define REXEC_IGNOREPOS 0x08 /* use stringarg, not pos(), + for \G match */ +#define REXEC_NOT_FIRST 0x10 /* This is another iteration of //g: + no need to copy string again */ /* under REXEC_COPY_STR, it's ok for the engine (modulo PL_sawamperand etc) to skip copying: ... */ -#define REXEC_COPY_SKIP_PRE 0x20 /* ...the $` part of the string, or */ -#define REXEC_COPY_SKIP_POST 0x40 /* ...the $' part of the string */ -#define REXEC_FAIL_ON_UNDERFLOW 0x80 /* fail the match if $& would start before - the start pos (so s/.\G// would fail - on second iteration */ +#define REXEC_COPY_SKIP_PRE 0x20 /* ...the $` part of the string, or */ +#define REXEC_COPY_SKIP_POST 0x40 /* ...the $' part of the string */ +#define REXEC_FAIL_ON_UNDERFLOW 0x80 /* fail the match if $& would start + before the start pos (so s/.\G// + would fail on second iteration */ #if defined(PERL_USE_GCC_BRACE_GROUPS) -# define ReREFCNT_inc(re) \ - ({ \ - /* This is here to generate a casting warning if incorrect. */ \ - REGEXP *const _rerefcnt_inc = (re); \ - assert(SvTYPE(_rerefcnt_inc) == SVt_REGEXP); \ - SvREFCNT_inc(_rerefcnt_inc); \ - _rerefcnt_inc; \ - }) -# define ReREFCNT_dec(re) \ - ({ \ - /* This is here to generate a casting warning if incorrect. */ \ - REGEXP *const _rerefcnt_dec = (re); \ - SvREFCNT_dec(_rerefcnt_dec); \ - }) +# define ReREFCNT_inc(re) \ + ({ \ + /* This is here to generate a casting warning if incorrect. */ \ + REGEXP *const _rerefcnt_inc = (re); \ + assert(SvTYPE(_rerefcnt_inc) == SVt_REGEXP); \ + SvREFCNT_inc(_rerefcnt_inc); \ + _rerefcnt_inc; \ + }) +# define ReREFCNT_dec(re) \ + ({ \ + /* This is here to generate a casting warning if incorrect. */ \ + REGEXP *const _rerefcnt_dec = (re); \ + SvREFCNT_dec(_rerefcnt_dec); \ + }) #else -# define ReREFCNT_dec(re) SvREFCNT_dec(re) -# define ReREFCNT_inc(re) ((REGEXP *) SvREFCNT_inc(re)) +# define ReREFCNT_dec(re) SvREFCNT_dec(re) +# define ReREFCNT_inc(re) ((REGEXP *) SvREFCNT_inc(re)) #endif -#define ReANY(re) Perl_ReANY((const REGEXP *)(re)) +#define ReANY(re) Perl_ReANY((const REGEXP *)(re)) /* FIXME for plugins. */ -#define FBMcf_TAIL_DOLLAR 1 -#define FBMcf_TAIL_DOLLARM 2 -#define FBMcf_TAIL_Z 4 -#define FBMcf_TAIL_z 8 -#define FBMcf_TAIL (FBMcf_TAIL_DOLLAR|FBMcf_TAIL_DOLLARM|FBMcf_TAIL_Z|FBMcf_TAIL_z) +#define FBMcf_TAIL_DOLLAR 1 +#define FBMcf_TAIL_DOLLARM 2 +#define FBMcf_TAIL_Z 4 +#define FBMcf_TAIL_z 8 +#define FBMcf_TAIL \ + (FBMcf_TAIL_DOLLAR|FBMcf_TAIL_DOLLARM|FBMcf_TAIL_Z|FBMcf_TAIL_z) -#define FBMrf_MULTILINE 1 +#define FBMrf_MULTILINE 1 struct regmatch_state; struct regmatch_slab; -/* like regmatch_info_aux, but contains extra fields only needed if the - * pattern contains (?{}). If used, is snuck into the second slot in the - * regmatch_state stack at the start of execution */ +/* like regmatch_info_aux, but contains extra fields only needed if + * the pattern contains (?{}). If used, is snuck into the second + * slot in the regmatch_state stack at the start of execution */ typedef struct { regexp *rex; @@ -691,18 +752,18 @@ typedef struct { #ifdef PERL_ANY_COW SV *saved_copy; /* saved saved_copy field from rex */ #endif - char *subbeg; /* saved subbeg field from rex */ - STRLEN sublen; /* saved sublen field from rex */ - STRLEN suboffset; /* saved suboffset field from rex */ + char *subbeg; /* saved subbeg field from rex */ + STRLEN sublen; /* saved sublen field from rex */ + STRLEN suboffset; /* saved suboffset field from rex */ STRLEN subcoffset; /* saved subcoffset field from rex */ - SV *sv; /* $_ during (?{}) */ + SV *sv; /* $_ during (?{}) */ MAGIC *pos_magic; /* pos() magic attached to $_ */ SSize_t pos; /* the original value of pos() in pos_magic */ - U8 pos_flags; /* flags to be restored; currently only MGf_BYTES*/ + U8 pos_flags; /* flags to be restored; currently only MGf_BYTES */ } regmatch_info_aux_eval; -/* fields that logically live in regmatch_info, but which need cleaning +/* fields that logically live in regmatch_info, but which need cleaning * up on croak(), and so are instead are snuck into the first slot in * the regmatch_state stack at the start of execution */ @@ -710,18 +771,17 @@ typedef struct { regmatch_info_aux_eval *info_aux_eval; struct regmatch_state *old_regmatch_state; /* saved PL_regmatch_state */ struct regmatch_slab *old_regmatch_slab; /* saved PL_regmatch_slab */ - char *poscache; /* S-L cache of fail positions of WHILEMs */ + char *poscache; /* S-L cache of fail positions of WHILEMs */ } regmatch_info_aux; /* =for apidoc Ay||regmatch_info Some basic information about the current match that is created by -Perl_regexec_flags and then passed to regtry(), regmatch() etc. -It is allocated as a local var on the stack, so nothing should be -stored in it that needs preserving or clearing up on croak(). -For that, see the aux_info and aux_info_eval members of the -regmatch_state union. +Perl_regexec_flags and then passed to regtry(), regmatch() etc. It is +allocated as a local var on the stack, so nothing should be stored in +it that needs preserving or clearing up on croak(). For that, see the +aux_info and aux_info_eval members of the regmatch_state union. =cut */ @@ -736,7 +796,8 @@ typedef struct { char *cutpoint; /* (*COMMIT) position (if any) */ regmatch_info_aux *info_aux; /* extra fields that need cleanup */ regmatch_info_aux_eval *info_aux_eval; /* extra saved state for (?{}) */ - I32 poscache_maxiter; /* how many whilems todo before S-L cache kicks in */ + I32 poscache_maxiter; /* how many whilems todo before + S-L cache kicks in */ I32 poscache_iter; /* current countdown from _maxiter to zero */ STRLEN poscache_size; /* size of regmatch_info_aux.poscache */ bool intuit; /* re_intuit_start() is the top-level caller */ @@ -749,7 +810,7 @@ typedef struct { /* structures for holding and saving the state maintained by regmatch() */ #ifndef MAX_RECURSE_EVAL_NOCHANGE_DEPTH -# define MAX_RECURSE_EVAL_NOCHANGE_DEPTH 10 +# define MAX_RECURSE_EVAL_NOCHANGE_DEPTH 10 #endif /* The +1 is because everything matches itself, which isn't included in @@ -757,221 +818,247 @@ typedef struct { * is unlikely to change. An assertion should fail in regexec.c if it is too * low. It is needed for certain edge cases involving multi-character folds * when the first component also participates in a fold individually. */ -#define MAX_MATCHES (MAX_FOLD_FROMS + 1 + 2) +#define MAX_MATCHES (MAX_FOLD_FROMS + 1 + 2) struct next_matchable_info { - U8 first_byte_mask; - U8 first_byte_anded; - U32 mask32; - U32 anded32; - PERL_INT_FAST8_T count; /* Negative means not initialized */ - PERL_UINT_FAST8_T min_length; - PERL_UINT_FAST8_T max_length; - PERL_UINT_FAST8_T initial_definitive; - PERL_UINT_FAST8_T initial_exact; - PERL_UINT_FAST8_T lengths[MAX_MATCHES]; - - /* The size is from trial and error, and could change with new Unicode - * standards, in which case there is an assertion that should start - * failing. This size could be calculated in one of the regen scripts - * dealing with Unicode, but khw thinks the likelihood of it changing is - * low enough that it isn't worth the effort. */ - U8 matches[18]; + U8 first_byte_mask; + U8 first_byte_anded; + U32 mask32; + U32 anded32; + PERL_INT_FAST8_T count; /* Negative means not + initialized */ + PERL_UINT_FAST8_T min_length; + PERL_UINT_FAST8_T max_length; + PERL_UINT_FAST8_T initial_definitive; + PERL_UINT_FAST8_T initial_exact; + PERL_UINT_FAST8_T lengths[MAX_MATCHES]; + + /* The size is from trial and error, and could change with new + * Unicode standards, in which case there is an assertion that should + * start failing. This size could be calculated in one of the regen + * scripts dealing with Unicode, but khw thinks the likelihood of it + * changing is low enough that it isn't worth the effort. */ + U8 matches[18]; }; typedef I32 CHECKPOINT; typedef struct regmatch_state { - int resume_state; /* where to jump to on return */ - char *locinput; /* where to backtrack in string on failure */ - char *loceol; - U8 *sr0; /* position of start of script run, or NULL */ + int resume_state; /* where to jump to on return */ + char *locinput; /* where to backtrack in string on failure */ + char *loceol; + U8 *sr0; /* position of start of script run, or NULL */ union { - /* the 'info_aux' and 'info_aux_eval' union members are cuckoos in - * the nest. They aren't saved backtrack state; rather they - * represent one or two extra chunks of data that need allocating - * at the start of a match. These fields would logically live in - * the regmatch_info struct, except that is allocated on the - * C stack, and these fields are all things that require cleanup - * after a croak(), when the stack is lost. - * As a convenience, we just use the first 1 or 2 regmatch_state - * slots to store this info, as we will be allocating a slab of - * these anyway. Otherwise we'd have to malloc and then free them, - * or allocate them on the save stack (where they will get - * realloced if the save stack grows). + * the nest. They aren't saved backtrack state; rather they + * represent one or two extra chunks of data that need allocating at + * the start of a match. These fields would logically live in the + * regmatch_info struct, except that is allocated on the C stack, + * and these fields are all things that require cleanup after a + * croak(), when the stack is lost. As a convenience, we just use + * the first 1 or 2 regmatch_state slots to store this info, as we + * will be allocating a slab of these anyway. Otherwise we'd have + * to malloc and then free them, or allocate them on the save stack + * (where they will get realloced if the save stack grows). * info_aux contains the extra fields that are always needed; - * info_aux_eval contains extra fields that only needed if - * the pattern contains code blocks - * We split them into two separate structs to avoid increasing - * the size of the union. + * info_aux_eval contains extra fields that only needed if the + * pattern contains code blocks We split them into two separate + * structs to avoid increasing the size of the union. */ - regmatch_info_aux info_aux; + regmatch_info_aux info_aux; - regmatch_info_aux_eval info_aux_eval; + regmatch_info_aux_eval info_aux_eval; - /* this is a fake union member that matches the first element - * of each member that needs to store positive backtrack - * information */ + /* this is a fake union member that matches the first element of each + * member that needs to store positive backtrack information */ struct { - struct regmatch_state *prev_yes_state; - } yes; + struct regmatch_state *prev_yes_state; + } yes; /* branchlike members */ /* this is a fake union member that matches the first elements * of each member that needs to behave like a branch */ - struct { - /* this first element must match u.yes */ - struct regmatch_state *prev_yes_state; - U32 lastparen; - U32 lastcloseparen; - CHECKPOINT cp; - - } branchlike; - - struct { - /* the first elements must match u.branchlike */ - struct regmatch_state *prev_yes_state; - U32 lastparen; - U32 lastcloseparen; - CHECKPOINT cp; - - regnode *next_branch; /* next branch node */ - } branch; - - struct { - /* the first elements must match u.branchlike */ - struct regmatch_state *prev_yes_state; - U32 lastparen; - U32 lastcloseparen; - CHECKPOINT cp; - - U32 accepted; /* how many accepting states left */ - bool longfold;/* saw a fold with a 1->n char mapping */ - U16 *jump; /* positive offsets from me */ - regnode *me; /* Which node am I - needed for jump tries*/ - U8 *firstpos;/* pos in string of first trie match */ - U32 firstchars;/* len in chars of firstpos from start */ - U16 nextword;/* next word to try */ - U16 topword; /* longest accepted word */ - } trie; + struct { /* this first element must match u.yes */ + struct regmatch_state *prev_yes_state; + U32 lastparen; + U32 lastcloseparen; + CHECKPOINT cp; + + } branchlike; + + struct { /* the first elements must match u.branchlike */ + struct regmatch_state *prev_yes_state; + U32 lastparen; + U32 lastcloseparen; + CHECKPOINT cp; + + regnode *next_branch; /* next branch node */ + } branch; + + struct { /* the first elements must match u.branchlike */ + struct regmatch_state *prev_yes_state; + U32 lastparen; + U32 lastcloseparen; + CHECKPOINT cp; + + U32 accepted; /* how many accepting + states left */ + bool longfold; /* saw a fold with a + 1->n char mapping */ + U16 *jump; /* positive offsets + from me */ + regnode *me; /* Which node am I + - needed for + jump tries */ + U8 *firstpos; /* pos in string of + first trie match */ + U32 firstchars; /* len in chars of + firstpos from + start */ + U16 nextword; /* next word to try */ + U16 topword; /* longest accepted + word */ + } trie; /* special types - these members are used to store state for special regops like eval, if/then, lookaround and the markpoint state */ - struct { - /* this first element must match u.yes */ - struct regmatch_state *prev_yes_state; - struct regmatch_state *prev_curlyx; - struct regmatch_state *prev_eval; - REGEXP *prev_rex; - CHECKPOINT cp; /* remember current savestack indexes */ - CHECKPOINT lastcp; - U32 close_paren; /* which close bracket is our end (+1) */ - regnode *B; /* the node following us */ - char *prev_recurse_locinput; - } eval; - - struct { - /* this first element must match u.yes */ - struct regmatch_state *prev_yes_state; - I32 wanted; - I32 logical; /* saved copy of 'logical' var */ - U8 count; /* number of beginning positions */ - char *start; - char *end; - regnode *me; /* the IFMATCH/SUSPEND/UNLESSM node */ - char *prev_match_end; - } ifmatch; /* and SUSPEND/UNLESSM */ - - struct { - /* this first element must match u.yes */ - struct regmatch_state *prev_yes_state; - struct regmatch_state *prev_mark; - SV* mark_name; - char *mark_loc; - } mark; + struct { /* this first element must match u.yes */ + struct regmatch_state *prev_yes_state; + struct regmatch_state *prev_curlyx; + struct regmatch_state *prev_eval; + REGEXP *prev_rex; + CHECKPOINT cp; /* remember current + savestack + indexes */ + CHECKPOINT lastcp; + U32 close_paren; /* which close + bracket is our + end (+1) */ + regnode *B; /* the node + following us */ + char *prev_recurse_locinput; + } eval; + + struct { /* this first element must match u.yes */ + struct regmatch_state *prev_yes_state; + I32 wanted; + I32 logical; /* saved copy of + 'logical' var */ + U8 count; /* number of beginning + positions */ + char *start; + char *end; + regnode *me; /* the + IFMATCH/SUSPEND/UNLESSM + node */ + char *prev_match_end; + } ifmatch; /* and SUSPEND/UNLESSM */ + + struct { /* this first element must match u.yes */ + struct regmatch_state *prev_yes_state; + struct regmatch_state *prev_mark; + SV *mark_name; + char *mark_loc; + } mark; struct { int val; - } keeper; - - /* quantifiers - these members are used for storing state for - the regops used to implement quantifiers */ - struct { - /* this first element must match u.yes */ - struct regmatch_state *prev_yes_state; - struct regmatch_state *prev_curlyx; /* previous cur_curlyx */ - regnode *me; /* the CURLYX node */ - regnode *B; /* the B node in /A*B/ */ - CHECKPOINT cp; /* remember current savestack index */ - bool minmod; - int parenfloor;/* how far back to strip paren data */ + } keeper; + + /* quantifiers - these members are used for storing state + for the regops used to implement quantifiers */ + struct { /* this first element must match u.yes */ + struct regmatch_state *prev_yes_state; + struct regmatch_state *prev_curlyx; /* previous cur_curlyx + */ + regnode *me; /* the CURLYX node */ + regnode *B; /* the B node in + /A*B/ */ + CHECKPOINT cp; /* remember current + savestack index */ + bool minmod; + int parenfloor; /* how far back to + strip paren data */ /* these two are modified by WHILEM */ - int count; /* how many instances of A we've matched */ - char *lastloc;/* where previous A matched (0-len detect) */ - } curlyx; - - struct { - /* this first element must match u.yes */ - struct regmatch_state *prev_yes_state; - struct regmatch_state *save_curlyx; - CHECKPOINT cp; /* remember current savestack indexes */ - CHECKPOINT lastcp; - char *save_lastloc; /* previous curlyx.lastloc */ - I32 cache_offset; - I32 cache_mask; - } whilem; + int count; /* how many instances + of A we've matched + */ + char *lastloc; /* where previous A + matched (0-len + detect) */ + } curlyx; + + struct { /* this first element must match u.yes */ + struct regmatch_state *prev_yes_state; + struct regmatch_state *save_curlyx; + CHECKPOINT cp; /* remember current + savestack indexes */ + CHECKPOINT lastcp; + char *save_lastloc; /* previous + curlyx.lastloc */ + I32 cache_offset; + I32 cache_mask; + } whilem; + + struct { /* this first element must match u.yes */ + struct regmatch_state *prev_yes_state; + CHECKPOINT cp; + U32 lastparen; + U32 lastcloseparen; + I32 alen; /* length of + first-matched A + string */ + I32 count; + bool minmod; + regnode *A, *B; /* the nodes + corresponding to + /A*B/ */ + regnode *me; /* the curlym + node */ + struct next_matchable_info Binfo; + } curlym; struct { - /* this first element must match u.yes */ - struct regmatch_state *prev_yes_state; - CHECKPOINT cp; - U32 lastparen; - U32 lastcloseparen; - I32 alen; /* length of first-matched A string */ - I32 count; - bool minmod; - regnode *A, *B; /* the nodes corresponding to /A*B/ */ - regnode *me; /* the curlym node */ - struct next_matchable_info Binfo; - } curlym; - - struct { - U32 paren; - CHECKPOINT cp; - U32 lastparen; - U32 lastcloseparen; - char *maxpos; /* highest possible point in string to match */ - char *oldloc; /* the previous locinput */ - int count; - int min, max; /* {m,n} */ - regnode *A, *B; /* the nodes corresponding to /A*B/ */ - struct next_matchable_info Binfo; - } curly; /* and CURLYN/PLUS/STAR */ - - } u; + U32 paren; + CHECKPOINT cp; + U32 lastparen; + U32 lastcloseparen; + char *maxpos; /* highest possible + point in string + to match */ + char *oldloc; /* the previous + locinput */ + int count; + int min, max; /* {m,n} */ + regnode *A, *B; /* the nodes + corresponding to + /A*B/ */ + struct next_matchable_info Binfo; + } curly; /* and CURLYN/PLUS/STAR */ + + } u; } regmatch_state; -/* how many regmatch_state structs to allocate as a single slab. - * We do it in 4K blocks for efficiency. The "3" is 2 for the next/prev - * pointers, plus 1 for any mythical malloc overhead. */ +/* how many regmatch_state structs to allocate as a single slab. We + * do it in 4K blocks for efficiency. The "3" is 2 for the + * next/prev pointers, plus 1 for any mythical malloc overhead. */ -#define PERL_REGMATCH_SLAB_SLOTS \ +#define PERL_REGMATCH_SLAB_SLOTS \ ((4096 - 3 * sizeof (void*)) / sizeof(regmatch_state)) typedef struct regmatch_slab { - regmatch_state states[PERL_REGMATCH_SLAB_SLOTS]; - struct regmatch_slab *prev, *next; + regmatch_state states[PERL_REGMATCH_SLAB_SLOTS]; + struct regmatch_slab *prev, *next; } regmatch_slab; -#define REG_FETCH_ABSOLUTE 1 +#define REG_FETCH_ABSOLUTE 1 /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/reginline.h b/reginline.h index db6657fc6a6d..4f85319a8522 100644 --- a/reginline.h +++ b/reginline.h @@ -3,7 +3,7 @@ /* - regnext - dig the "next" pointer out of a node - */ +*/ PERL_STATIC_INLINE regnode * Perl_regnext(pTHX_ const regnode *p) @@ -29,7 +29,7 @@ Perl_regnext(pTHX_ const regnode *p) - regnode_after - find the node physically following p in memory, taking into account the size of p as determined by OP(p), our sizing data, and possibly the STR_SZ() macro. - */ +*/ PERL_STATIC_INLINE regnode * Perl_regnode_after(pTHX_ const regnode *p, const bool varies) @@ -43,8 +43,8 @@ Perl_regnode_after(pTHX_ const regnode *p, const bool varies) return (regnode *)ret; } -/* validate that the passed in node and extra length would match that - * returned by regnode_after() */ +/* validate that the passed in node and extra length + * would match that returned by regnode_after() */ PERL_STATIC_INLINE bool Perl_check_regnode_after(pTHX_ const regnode *p, const STRLEN extra) @@ -61,4 +61,4 @@ Perl_check_regnode_after(pTHX_ const regnode *p, const STRLEN extra) #endif /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/sbox32_hash.h b/sbox32_hash.h index 594431ba0d43..69eef9475f29 100644 --- a/sbox32_hash.h +++ b/sbox32_hash.h @@ -1,23 +1,24 @@ #ifndef DEBUG_SBOX32_HASH -#define DEBUG_SBOX32_HASH 0 +#define DEBUG_SBOX32_HASH 0 #include "zaphod32_hash.h" #if DEBUG_SBOX32_HASH == 1 #include -#define SBOX32_WARN6(pat,v0,v1,v2,v3,v4,v5) printf(pat, v0, v1, v2, v3, v4, v5) -#define SBOX32_WARN5(pat,v0,v1,v2,v3,v4) printf(pat, v0, v1, v2, v3, v4) -#define SBOX32_WARN4(pat,v0,v1,v2,v3) printf(pat, v0, v1, v2, v3) -#define SBOX32_WARN3(pat,v0,v1,v2) printf(pat, v0, v1, v2) -#define SBOX32_WARN2(pat,v0,v1) printf(pat, v0, v1) -#define NOTE3(pat,v0,v1,v2) printf(pat, v0, v1, v2) +#define SBOX32_WARN6(pat,v0,v1,v2,v3,v4,v5) \ + printf(pat, v0, v1, v2, v3, v4, v5) +#define SBOX32_WARN5(pat,v0,v1,v2,v3,v4) printf(pat, v0, v1, v2, v3, v4) +#define SBOX32_WARN4(pat,v0,v1,v2,v3) printf(pat, v0, v1, v2, v3) +#define SBOX32_WARN3(pat,v0,v1,v2) printf(pat, v0, v1, v2) +#define SBOX32_WARN2(pat,v0,v1) printf(pat, v0, v1) +#define NOTE3(pat,v0,v1,v2) printf(pat, v0, v1, v2) #elif DEBUG_SBOX32_HASH == 2 #define SBOX32_WARN6(pat,v0,v1,v2,v3,v4,v5) #define SBOX32_WARN5(pat,v0,v1,v2,v3,v4) #define SBOX32_WARN4(pat,v0,v1,v2,v3) #define SBOX32_WARN3(pat,v0,v1,v2) #define SBOX32_WARN2(pat,v0,v1) -#define NOTE3(pat,v0,v1,v2) printf(pat, v0, v1, v2) +#define NOTE3(pat,v0,v1,v2) printf(pat, v0, v1, v2) #else #define SBOX32_WARN6(pat,v0,v1,v2,v3,v4,v5) #define SBOX32_WARN5(pat,v0,v1,v2,v3,v4) @@ -28,1380 +29,1384 @@ #endif #ifndef PERL_SEEN_HV_FUNC_H_ -#if !defined(U32) +#if !defined(U32) #include -#define U32 uint32_t +#define U32 uint32_t #endif #if !defined(U8) -#define U8 unsigned char +#define U8 unsigned char #endif #if !defined(U16) -#define U16 uint16_t +#define U16 uint16_t #endif #ifndef STRLEN -#define STRLEN int +#define STRLEN int #endif #endif #ifndef SBOX32_STATIC_INLINE #ifdef PERL_STATIC_INLINE -#define SBOX32_STATIC_INLINE PERL_STATIC_INLINE +#define SBOX32_STATIC_INLINE PERL_STATIC_INLINE #else -#define SBOX32_STATIC_INLINE static inline +#define SBOX32_STATIC_INLINE static inline #endif #endif #ifndef STMT_START -#define STMT_START do -#define STMT_END while(0) +#define STMT_START do +#define STMT_END while(0) #endif /* Find best way to ROTL32/ROTL64 */ #ifndef ROTL32 #if defined(_MSC_VER) #include /* Microsoft put _rotl declaration in here */ -#define ROTL32(x,r) _rotl(x,r) -#define ROTR32(x,r) _rotr(x,r) +#define ROTL32(x,r) _rotl(x,r) +#define ROTR32(x,r) _rotr(x,r) #else -/* gcc recognises this code and generates a rotate instruction for CPUs with one */ -#define ROTL32(x,r) (((U32)(x) << (r)) | ((U32)(x) >> (32 - (r)))) -#define ROTR32(x,r) (((U32)(x) << (32 - (r))) | ((U32)(x) >> (r))) +/* gcc recognises this code and generates a + rotate instruction for CPUs with one */ +#define ROTL32(x,r) (((U32)(x) << (r)) | ((U32)(x) >> (32 - (r)))) +#define ROTR32(x,r) (((U32)(x) << (32 - (r))) | ((U32)(x) >> (r))) #endif #endif #ifndef SBOX32_MAX_LEN -#define SBOX32_MAX_LEN 256 +#define SBOX32_MAX_LEN 256 #endif #ifndef SBOX32_STATE_WORDS -#define SBOX32_STATE_WORDS (1 + (SBOX32_MAX_LEN * 256)) -#define SBOX32_STATE_BYTES (SBOX32_STATE_WORDS * sizeof(U32)) -#define SBOX32_STATE_BITS (SBOX32_STATE_BYTES * 8) +#define SBOX32_STATE_WORDS (1 + (SBOX32_MAX_LEN * 256)) +#define SBOX32_STATE_BYTES (SBOX32_STATE_WORDS * sizeof(U32)) +#define SBOX32_STATE_BITS (SBOX32_STATE_BYTES * 8) #endif -#define SBOX32_MIX4(v0,v1,v2,v3,text) STMT_START { \ - SBOX32_WARN5("v0=%08x v1=%08x v2=%08x v3=%08x - SBOX32_MIX4 %s\n", \ - (unsigned int)v0, (unsigned int)v1, \ - (unsigned int)v2, (unsigned int)v3, text); \ - v0 = ROTL32(v0,13) - v3; \ - v1 ^= v2; \ - v3 = ROTL32(v3, 9) + v1; \ - v2 ^= v0; \ - v0 = ROTL32(v0,14) ^ v3; \ - v1 = ROTL32(v1,25) - v2; \ - v3 ^= v1; \ - v2 = ROTL32(v2, 4) - v0; \ -} STMT_END +#define SBOX32_MIX4(v0,v1,v2,v3,text) \ + STMT_START { \ + SBOX32_WARN5("v0=%08x v1=%08x v2=%08x v3=%08x - SBOX32_MIX4 %s\n", \ + (unsigned int)v0, (unsigned int)v1, \ + (unsigned int)v2, (unsigned int)v3, text); \ + v0 = ROTL32(v0,13) - v3; \ + v1 ^= v2; \ + v3 = ROTL32(v3, 9) + v1; \ + v2 ^= v0; \ + v0 = ROTL32(v0,14) ^ v3; \ + v1 = ROTL32(v1,25) - v2; \ + v3 ^= v1; \ + v2 = ROTL32(v2, 4) - v0; \ + } STMT_END -#define SBOX32_MIX3(v0,v1,v2,text) STMT_START { \ - SBOX32_WARN4("v0=%08x v1=%08x v2=%08x - SBOX32_MIX3 %s\n", \ - (unsigned int)v0,(unsigned int)v1,(unsigned int)v2, text ); \ - v0 = ROTL32(v0,16) - v2; \ - v1 = ROTR32(v1,13) ^ v2; \ - v2 = ROTL32(v2,17) + v1; \ - v0 = ROTR32(v0, 2) + v1; \ - v1 = ROTR32(v1,17) - v0; \ - v2 = ROTR32(v2, 7) ^ v0; \ -} STMT_END +#define SBOX32_MIX3(v0,v1,v2,text) \ + STMT_START { \ + SBOX32_WARN4("v0=%08x v1=%08x v2=%08x - SBOX32_MIX3 %s\n", \ + (unsigned int)v0,(unsigned int)v1,(unsigned int)v2, text ); \ + v0 = ROTL32(v0,16) - v2; \ + v1 = ROTR32(v1,13) ^ v2; \ + v2 = ROTL32(v2,17) + v1; \ + v0 = ROTR32(v0, 2) + v1; \ + v1 = ROTR32(v1,17) - v0; \ + v2 = ROTR32(v2, 7) ^ v0; \ + } STMT_END #if SBOX32_MAX_LEN > 256 #error "SBOX32_MAX_LEN is set too high!" #elif SBOX32_MAX_LEN == 256 -#define case_256_SBOX32(hash,state,key) _SBOX32_CASE(256,hash,state,key) +#define case_256_SBOX32(hash,state,key) _SBOX32_CASE(256,hash,state,key) #else -#define case_256_SBOX32(hash,state,key) /**/ +#define case_256_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 255 -#define case_255_SBOX32(hash,state,key) _SBOX32_CASE(255,hash,state,key) +#define case_255_SBOX32(hash,state,key) _SBOX32_CASE(255,hash,state,key) #else -#define case_255_SBOX32(hash,state,key) /**/ +#define case_255_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 254 -#define case_254_SBOX32(hash,state,key) _SBOX32_CASE(254,hash,state,key) +#define case_254_SBOX32(hash,state,key) _SBOX32_CASE(254,hash,state,key) #else -#define case_254_SBOX32(hash,state,key) /**/ +#define case_254_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 253 -#define case_253_SBOX32(hash,state,key) _SBOX32_CASE(253,hash,state,key) +#define case_253_SBOX32(hash,state,key) _SBOX32_CASE(253,hash,state,key) #else -#define case_253_SBOX32(hash,state,key) /**/ +#define case_253_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 252 -#define case_252_SBOX32(hash,state,key) _SBOX32_CASE(252,hash,state,key) +#define case_252_SBOX32(hash,state,key) _SBOX32_CASE(252,hash,state,key) #else -#define case_252_SBOX32(hash,state,key) /**/ +#define case_252_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 251 -#define case_251_SBOX32(hash,state,key) _SBOX32_CASE(251,hash,state,key) +#define case_251_SBOX32(hash,state,key) _SBOX32_CASE(251,hash,state,key) #else -#define case_251_SBOX32(hash,state,key) /**/ +#define case_251_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 250 -#define case_250_SBOX32(hash,state,key) _SBOX32_CASE(250,hash,state,key) +#define case_250_SBOX32(hash,state,key) _SBOX32_CASE(250,hash,state,key) #else -#define case_250_SBOX32(hash,state,key) /**/ +#define case_250_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 249 -#define case_249_SBOX32(hash,state,key) _SBOX32_CASE(249,hash,state,key) +#define case_249_SBOX32(hash,state,key) _SBOX32_CASE(249,hash,state,key) #else -#define case_249_SBOX32(hash,state,key) /**/ +#define case_249_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 248 -#define case_248_SBOX32(hash,state,key) _SBOX32_CASE(248,hash,state,key) +#define case_248_SBOX32(hash,state,key) _SBOX32_CASE(248,hash,state,key) #else -#define case_248_SBOX32(hash,state,key) /**/ +#define case_248_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 247 -#define case_247_SBOX32(hash,state,key) _SBOX32_CASE(247,hash,state,key) +#define case_247_SBOX32(hash,state,key) _SBOX32_CASE(247,hash,state,key) #else -#define case_247_SBOX32(hash,state,key) /**/ +#define case_247_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 246 -#define case_246_SBOX32(hash,state,key) _SBOX32_CASE(246,hash,state,key) +#define case_246_SBOX32(hash,state,key) _SBOX32_CASE(246,hash,state,key) #else -#define case_246_SBOX32(hash,state,key) /**/ +#define case_246_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 245 -#define case_245_SBOX32(hash,state,key) _SBOX32_CASE(245,hash,state,key) +#define case_245_SBOX32(hash,state,key) _SBOX32_CASE(245,hash,state,key) #else -#define case_245_SBOX32(hash,state,key) /**/ +#define case_245_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 244 -#define case_244_SBOX32(hash,state,key) _SBOX32_CASE(244,hash,state,key) +#define case_244_SBOX32(hash,state,key) _SBOX32_CASE(244,hash,state,key) #else -#define case_244_SBOX32(hash,state,key) /**/ +#define case_244_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 243 -#define case_243_SBOX32(hash,state,key) _SBOX32_CASE(243,hash,state,key) +#define case_243_SBOX32(hash,state,key) _SBOX32_CASE(243,hash,state,key) #else -#define case_243_SBOX32(hash,state,key) /**/ +#define case_243_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 242 -#define case_242_SBOX32(hash,state,key) _SBOX32_CASE(242,hash,state,key) +#define case_242_SBOX32(hash,state,key) _SBOX32_CASE(242,hash,state,key) #else -#define case_242_SBOX32(hash,state,key) /**/ +#define case_242_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 241 -#define case_241_SBOX32(hash,state,key) _SBOX32_CASE(241,hash,state,key) +#define case_241_SBOX32(hash,state,key) _SBOX32_CASE(241,hash,state,key) #else -#define case_241_SBOX32(hash,state,key) /**/ +#define case_241_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 240 -#define case_240_SBOX32(hash,state,key) _SBOX32_CASE(240,hash,state,key) +#define case_240_SBOX32(hash,state,key) _SBOX32_CASE(240,hash,state,key) #else -#define case_240_SBOX32(hash,state,key) /**/ +#define case_240_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 239 -#define case_239_SBOX32(hash,state,key) _SBOX32_CASE(239,hash,state,key) +#define case_239_SBOX32(hash,state,key) _SBOX32_CASE(239,hash,state,key) #else -#define case_239_SBOX32(hash,state,key) /**/ +#define case_239_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 238 -#define case_238_SBOX32(hash,state,key) _SBOX32_CASE(238,hash,state,key) +#define case_238_SBOX32(hash,state,key) _SBOX32_CASE(238,hash,state,key) #else -#define case_238_SBOX32(hash,state,key) /**/ +#define case_238_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 237 -#define case_237_SBOX32(hash,state,key) _SBOX32_CASE(237,hash,state,key) +#define case_237_SBOX32(hash,state,key) _SBOX32_CASE(237,hash,state,key) #else -#define case_237_SBOX32(hash,state,key) /**/ +#define case_237_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 236 -#define case_236_SBOX32(hash,state,key) _SBOX32_CASE(236,hash,state,key) +#define case_236_SBOX32(hash,state,key) _SBOX32_CASE(236,hash,state,key) #else -#define case_236_SBOX32(hash,state,key) /**/ +#define case_236_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 235 -#define case_235_SBOX32(hash,state,key) _SBOX32_CASE(235,hash,state,key) +#define case_235_SBOX32(hash,state,key) _SBOX32_CASE(235,hash,state,key) #else -#define case_235_SBOX32(hash,state,key) /**/ +#define case_235_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 234 -#define case_234_SBOX32(hash,state,key) _SBOX32_CASE(234,hash,state,key) +#define case_234_SBOX32(hash,state,key) _SBOX32_CASE(234,hash,state,key) #else -#define case_234_SBOX32(hash,state,key) /**/ +#define case_234_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 233 -#define case_233_SBOX32(hash,state,key) _SBOX32_CASE(233,hash,state,key) +#define case_233_SBOX32(hash,state,key) _SBOX32_CASE(233,hash,state,key) #else -#define case_233_SBOX32(hash,state,key) /**/ +#define case_233_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 232 -#define case_232_SBOX32(hash,state,key) _SBOX32_CASE(232,hash,state,key) +#define case_232_SBOX32(hash,state,key) _SBOX32_CASE(232,hash,state,key) #else -#define case_232_SBOX32(hash,state,key) /**/ +#define case_232_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 231 -#define case_231_SBOX32(hash,state,key) _SBOX32_CASE(231,hash,state,key) +#define case_231_SBOX32(hash,state,key) _SBOX32_CASE(231,hash,state,key) #else -#define case_231_SBOX32(hash,state,key) /**/ +#define case_231_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 230 -#define case_230_SBOX32(hash,state,key) _SBOX32_CASE(230,hash,state,key) +#define case_230_SBOX32(hash,state,key) _SBOX32_CASE(230,hash,state,key) #else -#define case_230_SBOX32(hash,state,key) /**/ +#define case_230_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 229 -#define case_229_SBOX32(hash,state,key) _SBOX32_CASE(229,hash,state,key) +#define case_229_SBOX32(hash,state,key) _SBOX32_CASE(229,hash,state,key) #else -#define case_229_SBOX32(hash,state,key) /**/ +#define case_229_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 228 -#define case_228_SBOX32(hash,state,key) _SBOX32_CASE(228,hash,state,key) +#define case_228_SBOX32(hash,state,key) _SBOX32_CASE(228,hash,state,key) #else -#define case_228_SBOX32(hash,state,key) /**/ +#define case_228_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 227 -#define case_227_SBOX32(hash,state,key) _SBOX32_CASE(227,hash,state,key) +#define case_227_SBOX32(hash,state,key) _SBOX32_CASE(227,hash,state,key) #else -#define case_227_SBOX32(hash,state,key) /**/ +#define case_227_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 226 -#define case_226_SBOX32(hash,state,key) _SBOX32_CASE(226,hash,state,key) +#define case_226_SBOX32(hash,state,key) _SBOX32_CASE(226,hash,state,key) #else -#define case_226_SBOX32(hash,state,key) /**/ +#define case_226_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 225 -#define case_225_SBOX32(hash,state,key) _SBOX32_CASE(225,hash,state,key) +#define case_225_SBOX32(hash,state,key) _SBOX32_CASE(225,hash,state,key) #else -#define case_225_SBOX32(hash,state,key) /**/ +#define case_225_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 224 -#define case_224_SBOX32(hash,state,key) _SBOX32_CASE(224,hash,state,key) +#define case_224_SBOX32(hash,state,key) _SBOX32_CASE(224,hash,state,key) #else -#define case_224_SBOX32(hash,state,key) /**/ +#define case_224_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 223 -#define case_223_SBOX32(hash,state,key) _SBOX32_CASE(223,hash,state,key) +#define case_223_SBOX32(hash,state,key) _SBOX32_CASE(223,hash,state,key) #else -#define case_223_SBOX32(hash,state,key) /**/ +#define case_223_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 222 -#define case_222_SBOX32(hash,state,key) _SBOX32_CASE(222,hash,state,key) +#define case_222_SBOX32(hash,state,key) _SBOX32_CASE(222,hash,state,key) #else -#define case_222_SBOX32(hash,state,key) /**/ +#define case_222_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 221 -#define case_221_SBOX32(hash,state,key) _SBOX32_CASE(221,hash,state,key) +#define case_221_SBOX32(hash,state,key) _SBOX32_CASE(221,hash,state,key) #else -#define case_221_SBOX32(hash,state,key) /**/ +#define case_221_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 220 -#define case_220_SBOX32(hash,state,key) _SBOX32_CASE(220,hash,state,key) +#define case_220_SBOX32(hash,state,key) _SBOX32_CASE(220,hash,state,key) #else -#define case_220_SBOX32(hash,state,key) /**/ +#define case_220_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 219 -#define case_219_SBOX32(hash,state,key) _SBOX32_CASE(219,hash,state,key) +#define case_219_SBOX32(hash,state,key) _SBOX32_CASE(219,hash,state,key) #else -#define case_219_SBOX32(hash,state,key) /**/ +#define case_219_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 218 -#define case_218_SBOX32(hash,state,key) _SBOX32_CASE(218,hash,state,key) +#define case_218_SBOX32(hash,state,key) _SBOX32_CASE(218,hash,state,key) #else -#define case_218_SBOX32(hash,state,key) /**/ +#define case_218_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 217 -#define case_217_SBOX32(hash,state,key) _SBOX32_CASE(217,hash,state,key) +#define case_217_SBOX32(hash,state,key) _SBOX32_CASE(217,hash,state,key) #else -#define case_217_SBOX32(hash,state,key) /**/ +#define case_217_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 216 -#define case_216_SBOX32(hash,state,key) _SBOX32_CASE(216,hash,state,key) +#define case_216_SBOX32(hash,state,key) _SBOX32_CASE(216,hash,state,key) #else -#define case_216_SBOX32(hash,state,key) /**/ +#define case_216_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 215 -#define case_215_SBOX32(hash,state,key) _SBOX32_CASE(215,hash,state,key) +#define case_215_SBOX32(hash,state,key) _SBOX32_CASE(215,hash,state,key) #else -#define case_215_SBOX32(hash,state,key) /**/ +#define case_215_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 214 -#define case_214_SBOX32(hash,state,key) _SBOX32_CASE(214,hash,state,key) +#define case_214_SBOX32(hash,state,key) _SBOX32_CASE(214,hash,state,key) #else -#define case_214_SBOX32(hash,state,key) /**/ +#define case_214_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 213 -#define case_213_SBOX32(hash,state,key) _SBOX32_CASE(213,hash,state,key) +#define case_213_SBOX32(hash,state,key) _SBOX32_CASE(213,hash,state,key) #else -#define case_213_SBOX32(hash,state,key) /**/ +#define case_213_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 212 -#define case_212_SBOX32(hash,state,key) _SBOX32_CASE(212,hash,state,key) +#define case_212_SBOX32(hash,state,key) _SBOX32_CASE(212,hash,state,key) #else -#define case_212_SBOX32(hash,state,key) /**/ +#define case_212_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 211 -#define case_211_SBOX32(hash,state,key) _SBOX32_CASE(211,hash,state,key) +#define case_211_SBOX32(hash,state,key) _SBOX32_CASE(211,hash,state,key) #else -#define case_211_SBOX32(hash,state,key) /**/ +#define case_211_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 210 -#define case_210_SBOX32(hash,state,key) _SBOX32_CASE(210,hash,state,key) +#define case_210_SBOX32(hash,state,key) _SBOX32_CASE(210,hash,state,key) #else -#define case_210_SBOX32(hash,state,key) /**/ +#define case_210_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 209 -#define case_209_SBOX32(hash,state,key) _SBOX32_CASE(209,hash,state,key) +#define case_209_SBOX32(hash,state,key) _SBOX32_CASE(209,hash,state,key) #else -#define case_209_SBOX32(hash,state,key) /**/ +#define case_209_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 208 -#define case_208_SBOX32(hash,state,key) _SBOX32_CASE(208,hash,state,key) +#define case_208_SBOX32(hash,state,key) _SBOX32_CASE(208,hash,state,key) #else -#define case_208_SBOX32(hash,state,key) /**/ +#define case_208_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 207 -#define case_207_SBOX32(hash,state,key) _SBOX32_CASE(207,hash,state,key) +#define case_207_SBOX32(hash,state,key) _SBOX32_CASE(207,hash,state,key) #else -#define case_207_SBOX32(hash,state,key) /**/ +#define case_207_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 206 -#define case_206_SBOX32(hash,state,key) _SBOX32_CASE(206,hash,state,key) +#define case_206_SBOX32(hash,state,key) _SBOX32_CASE(206,hash,state,key) #else -#define case_206_SBOX32(hash,state,key) /**/ +#define case_206_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 205 -#define case_205_SBOX32(hash,state,key) _SBOX32_CASE(205,hash,state,key) +#define case_205_SBOX32(hash,state,key) _SBOX32_CASE(205,hash,state,key) #else -#define case_205_SBOX32(hash,state,key) /**/ +#define case_205_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 204 -#define case_204_SBOX32(hash,state,key) _SBOX32_CASE(204,hash,state,key) +#define case_204_SBOX32(hash,state,key) _SBOX32_CASE(204,hash,state,key) #else -#define case_204_SBOX32(hash,state,key) /**/ +#define case_204_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 203 -#define case_203_SBOX32(hash,state,key) _SBOX32_CASE(203,hash,state,key) +#define case_203_SBOX32(hash,state,key) _SBOX32_CASE(203,hash,state,key) #else -#define case_203_SBOX32(hash,state,key) /**/ +#define case_203_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 202 -#define case_202_SBOX32(hash,state,key) _SBOX32_CASE(202,hash,state,key) +#define case_202_SBOX32(hash,state,key) _SBOX32_CASE(202,hash,state,key) #else -#define case_202_SBOX32(hash,state,key) /**/ +#define case_202_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 201 -#define case_201_SBOX32(hash,state,key) _SBOX32_CASE(201,hash,state,key) +#define case_201_SBOX32(hash,state,key) _SBOX32_CASE(201,hash,state,key) #else -#define case_201_SBOX32(hash,state,key) /**/ +#define case_201_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 200 -#define case_200_SBOX32(hash,state,key) _SBOX32_CASE(200,hash,state,key) +#define case_200_SBOX32(hash,state,key) _SBOX32_CASE(200,hash,state,key) #else -#define case_200_SBOX32(hash,state,key) /**/ +#define case_200_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 199 -#define case_199_SBOX32(hash,state,key) _SBOX32_CASE(199,hash,state,key) +#define case_199_SBOX32(hash,state,key) _SBOX32_CASE(199,hash,state,key) #else -#define case_199_SBOX32(hash,state,key) /**/ +#define case_199_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 198 -#define case_198_SBOX32(hash,state,key) _SBOX32_CASE(198,hash,state,key) +#define case_198_SBOX32(hash,state,key) _SBOX32_CASE(198,hash,state,key) #else -#define case_198_SBOX32(hash,state,key) /**/ +#define case_198_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 197 -#define case_197_SBOX32(hash,state,key) _SBOX32_CASE(197,hash,state,key) +#define case_197_SBOX32(hash,state,key) _SBOX32_CASE(197,hash,state,key) #else -#define case_197_SBOX32(hash,state,key) /**/ +#define case_197_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 196 -#define case_196_SBOX32(hash,state,key) _SBOX32_CASE(196,hash,state,key) +#define case_196_SBOX32(hash,state,key) _SBOX32_CASE(196,hash,state,key) #else -#define case_196_SBOX32(hash,state,key) /**/ +#define case_196_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 195 -#define case_195_SBOX32(hash,state,key) _SBOX32_CASE(195,hash,state,key) +#define case_195_SBOX32(hash,state,key) _SBOX32_CASE(195,hash,state,key) #else -#define case_195_SBOX32(hash,state,key) /**/ +#define case_195_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 194 -#define case_194_SBOX32(hash,state,key) _SBOX32_CASE(194,hash,state,key) +#define case_194_SBOX32(hash,state,key) _SBOX32_CASE(194,hash,state,key) #else -#define case_194_SBOX32(hash,state,key) /**/ +#define case_194_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 193 -#define case_193_SBOX32(hash,state,key) _SBOX32_CASE(193,hash,state,key) +#define case_193_SBOX32(hash,state,key) _SBOX32_CASE(193,hash,state,key) #else -#define case_193_SBOX32(hash,state,key) /**/ +#define case_193_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 192 -#define case_192_SBOX32(hash,state,key) _SBOX32_CASE(192,hash,state,key) +#define case_192_SBOX32(hash,state,key) _SBOX32_CASE(192,hash,state,key) #else -#define case_192_SBOX32(hash,state,key) /**/ +#define case_192_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 191 -#define case_191_SBOX32(hash,state,key) _SBOX32_CASE(191,hash,state,key) +#define case_191_SBOX32(hash,state,key) _SBOX32_CASE(191,hash,state,key) #else -#define case_191_SBOX32(hash,state,key) /**/ +#define case_191_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 190 -#define case_190_SBOX32(hash,state,key) _SBOX32_CASE(190,hash,state,key) +#define case_190_SBOX32(hash,state,key) _SBOX32_CASE(190,hash,state,key) #else -#define case_190_SBOX32(hash,state,key) /**/ +#define case_190_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 189 -#define case_189_SBOX32(hash,state,key) _SBOX32_CASE(189,hash,state,key) +#define case_189_SBOX32(hash,state,key) _SBOX32_CASE(189,hash,state,key) #else -#define case_189_SBOX32(hash,state,key) /**/ +#define case_189_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 188 -#define case_188_SBOX32(hash,state,key) _SBOX32_CASE(188,hash,state,key) +#define case_188_SBOX32(hash,state,key) _SBOX32_CASE(188,hash,state,key) #else -#define case_188_SBOX32(hash,state,key) /**/ +#define case_188_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 187 -#define case_187_SBOX32(hash,state,key) _SBOX32_CASE(187,hash,state,key) +#define case_187_SBOX32(hash,state,key) _SBOX32_CASE(187,hash,state,key) #else -#define case_187_SBOX32(hash,state,key) /**/ +#define case_187_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 186 -#define case_186_SBOX32(hash,state,key) _SBOX32_CASE(186,hash,state,key) +#define case_186_SBOX32(hash,state,key) _SBOX32_CASE(186,hash,state,key) #else -#define case_186_SBOX32(hash,state,key) /**/ +#define case_186_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 185 -#define case_185_SBOX32(hash,state,key) _SBOX32_CASE(185,hash,state,key) +#define case_185_SBOX32(hash,state,key) _SBOX32_CASE(185,hash,state,key) #else -#define case_185_SBOX32(hash,state,key) /**/ +#define case_185_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 184 -#define case_184_SBOX32(hash,state,key) _SBOX32_CASE(184,hash,state,key) +#define case_184_SBOX32(hash,state,key) _SBOX32_CASE(184,hash,state,key) #else -#define case_184_SBOX32(hash,state,key) /**/ +#define case_184_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 183 -#define case_183_SBOX32(hash,state,key) _SBOX32_CASE(183,hash,state,key) +#define case_183_SBOX32(hash,state,key) _SBOX32_CASE(183,hash,state,key) #else -#define case_183_SBOX32(hash,state,key) /**/ +#define case_183_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 182 -#define case_182_SBOX32(hash,state,key) _SBOX32_CASE(182,hash,state,key) +#define case_182_SBOX32(hash,state,key) _SBOX32_CASE(182,hash,state,key) #else -#define case_182_SBOX32(hash,state,key) /**/ +#define case_182_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 181 -#define case_181_SBOX32(hash,state,key) _SBOX32_CASE(181,hash,state,key) +#define case_181_SBOX32(hash,state,key) _SBOX32_CASE(181,hash,state,key) #else -#define case_181_SBOX32(hash,state,key) /**/ +#define case_181_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 180 -#define case_180_SBOX32(hash,state,key) _SBOX32_CASE(180,hash,state,key) +#define case_180_SBOX32(hash,state,key) _SBOX32_CASE(180,hash,state,key) #else -#define case_180_SBOX32(hash,state,key) /**/ +#define case_180_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 179 -#define case_179_SBOX32(hash,state,key) _SBOX32_CASE(179,hash,state,key) +#define case_179_SBOX32(hash,state,key) _SBOX32_CASE(179,hash,state,key) #else -#define case_179_SBOX32(hash,state,key) /**/ +#define case_179_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 178 -#define case_178_SBOX32(hash,state,key) _SBOX32_CASE(178,hash,state,key) +#define case_178_SBOX32(hash,state,key) _SBOX32_CASE(178,hash,state,key) #else -#define case_178_SBOX32(hash,state,key) /**/ +#define case_178_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 177 -#define case_177_SBOX32(hash,state,key) _SBOX32_CASE(177,hash,state,key) +#define case_177_SBOX32(hash,state,key) _SBOX32_CASE(177,hash,state,key) #else -#define case_177_SBOX32(hash,state,key) /**/ +#define case_177_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 176 -#define case_176_SBOX32(hash,state,key) _SBOX32_CASE(176,hash,state,key) +#define case_176_SBOX32(hash,state,key) _SBOX32_CASE(176,hash,state,key) #else -#define case_176_SBOX32(hash,state,key) /**/ +#define case_176_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 175 -#define case_175_SBOX32(hash,state,key) _SBOX32_CASE(175,hash,state,key) +#define case_175_SBOX32(hash,state,key) _SBOX32_CASE(175,hash,state,key) #else -#define case_175_SBOX32(hash,state,key) /**/ +#define case_175_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 174 -#define case_174_SBOX32(hash,state,key) _SBOX32_CASE(174,hash,state,key) +#define case_174_SBOX32(hash,state,key) _SBOX32_CASE(174,hash,state,key) #else -#define case_174_SBOX32(hash,state,key) /**/ +#define case_174_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 173 -#define case_173_SBOX32(hash,state,key) _SBOX32_CASE(173,hash,state,key) +#define case_173_SBOX32(hash,state,key) _SBOX32_CASE(173,hash,state,key) #else -#define case_173_SBOX32(hash,state,key) /**/ +#define case_173_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 172 -#define case_172_SBOX32(hash,state,key) _SBOX32_CASE(172,hash,state,key) +#define case_172_SBOX32(hash,state,key) _SBOX32_CASE(172,hash,state,key) #else -#define case_172_SBOX32(hash,state,key) /**/ +#define case_172_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 171 -#define case_171_SBOX32(hash,state,key) _SBOX32_CASE(171,hash,state,key) +#define case_171_SBOX32(hash,state,key) _SBOX32_CASE(171,hash,state,key) #else -#define case_171_SBOX32(hash,state,key) /**/ +#define case_171_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 170 -#define case_170_SBOX32(hash,state,key) _SBOX32_CASE(170,hash,state,key) +#define case_170_SBOX32(hash,state,key) _SBOX32_CASE(170,hash,state,key) #else -#define case_170_SBOX32(hash,state,key) /**/ +#define case_170_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 169 -#define case_169_SBOX32(hash,state,key) _SBOX32_CASE(169,hash,state,key) +#define case_169_SBOX32(hash,state,key) _SBOX32_CASE(169,hash,state,key) #else -#define case_169_SBOX32(hash,state,key) /**/ +#define case_169_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 168 -#define case_168_SBOX32(hash,state,key) _SBOX32_CASE(168,hash,state,key) +#define case_168_SBOX32(hash,state,key) _SBOX32_CASE(168,hash,state,key) #else -#define case_168_SBOX32(hash,state,key) /**/ +#define case_168_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 167 -#define case_167_SBOX32(hash,state,key) _SBOX32_CASE(167,hash,state,key) +#define case_167_SBOX32(hash,state,key) _SBOX32_CASE(167,hash,state,key) #else -#define case_167_SBOX32(hash,state,key) /**/ +#define case_167_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 166 -#define case_166_SBOX32(hash,state,key) _SBOX32_CASE(166,hash,state,key) +#define case_166_SBOX32(hash,state,key) _SBOX32_CASE(166,hash,state,key) #else -#define case_166_SBOX32(hash,state,key) /**/ +#define case_166_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 165 -#define case_165_SBOX32(hash,state,key) _SBOX32_CASE(165,hash,state,key) +#define case_165_SBOX32(hash,state,key) _SBOX32_CASE(165,hash,state,key) #else -#define case_165_SBOX32(hash,state,key) /**/ +#define case_165_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 164 -#define case_164_SBOX32(hash,state,key) _SBOX32_CASE(164,hash,state,key) +#define case_164_SBOX32(hash,state,key) _SBOX32_CASE(164,hash,state,key) #else -#define case_164_SBOX32(hash,state,key) /**/ +#define case_164_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 163 -#define case_163_SBOX32(hash,state,key) _SBOX32_CASE(163,hash,state,key) +#define case_163_SBOX32(hash,state,key) _SBOX32_CASE(163,hash,state,key) #else -#define case_163_SBOX32(hash,state,key) /**/ +#define case_163_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 162 -#define case_162_SBOX32(hash,state,key) _SBOX32_CASE(162,hash,state,key) +#define case_162_SBOX32(hash,state,key) _SBOX32_CASE(162,hash,state,key) #else -#define case_162_SBOX32(hash,state,key) /**/ +#define case_162_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 161 -#define case_161_SBOX32(hash,state,key) _SBOX32_CASE(161,hash,state,key) +#define case_161_SBOX32(hash,state,key) _SBOX32_CASE(161,hash,state,key) #else -#define case_161_SBOX32(hash,state,key) /**/ +#define case_161_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 160 -#define case_160_SBOX32(hash,state,key) _SBOX32_CASE(160,hash,state,key) +#define case_160_SBOX32(hash,state,key) _SBOX32_CASE(160,hash,state,key) #else -#define case_160_SBOX32(hash,state,key) /**/ +#define case_160_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 159 -#define case_159_SBOX32(hash,state,key) _SBOX32_CASE(159,hash,state,key) +#define case_159_SBOX32(hash,state,key) _SBOX32_CASE(159,hash,state,key) #else -#define case_159_SBOX32(hash,state,key) /**/ +#define case_159_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 158 -#define case_158_SBOX32(hash,state,key) _SBOX32_CASE(158,hash,state,key) +#define case_158_SBOX32(hash,state,key) _SBOX32_CASE(158,hash,state,key) #else -#define case_158_SBOX32(hash,state,key) /**/ +#define case_158_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 157 -#define case_157_SBOX32(hash,state,key) _SBOX32_CASE(157,hash,state,key) +#define case_157_SBOX32(hash,state,key) _SBOX32_CASE(157,hash,state,key) #else -#define case_157_SBOX32(hash,state,key) /**/ +#define case_157_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 156 -#define case_156_SBOX32(hash,state,key) _SBOX32_CASE(156,hash,state,key) +#define case_156_SBOX32(hash,state,key) _SBOX32_CASE(156,hash,state,key) #else -#define case_156_SBOX32(hash,state,key) /**/ +#define case_156_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 155 -#define case_155_SBOX32(hash,state,key) _SBOX32_CASE(155,hash,state,key) +#define case_155_SBOX32(hash,state,key) _SBOX32_CASE(155,hash,state,key) #else -#define case_155_SBOX32(hash,state,key) /**/ +#define case_155_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 154 -#define case_154_SBOX32(hash,state,key) _SBOX32_CASE(154,hash,state,key) +#define case_154_SBOX32(hash,state,key) _SBOX32_CASE(154,hash,state,key) #else -#define case_154_SBOX32(hash,state,key) /**/ +#define case_154_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 153 -#define case_153_SBOX32(hash,state,key) _SBOX32_CASE(153,hash,state,key) +#define case_153_SBOX32(hash,state,key) _SBOX32_CASE(153,hash,state,key) #else -#define case_153_SBOX32(hash,state,key) /**/ +#define case_153_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 152 -#define case_152_SBOX32(hash,state,key) _SBOX32_CASE(152,hash,state,key) +#define case_152_SBOX32(hash,state,key) _SBOX32_CASE(152,hash,state,key) #else -#define case_152_SBOX32(hash,state,key) /**/ +#define case_152_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 151 -#define case_151_SBOX32(hash,state,key) _SBOX32_CASE(151,hash,state,key) +#define case_151_SBOX32(hash,state,key) _SBOX32_CASE(151,hash,state,key) #else -#define case_151_SBOX32(hash,state,key) /**/ +#define case_151_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 150 -#define case_150_SBOX32(hash,state,key) _SBOX32_CASE(150,hash,state,key) +#define case_150_SBOX32(hash,state,key) _SBOX32_CASE(150,hash,state,key) #else -#define case_150_SBOX32(hash,state,key) /**/ +#define case_150_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 149 -#define case_149_SBOX32(hash,state,key) _SBOX32_CASE(149,hash,state,key) +#define case_149_SBOX32(hash,state,key) _SBOX32_CASE(149,hash,state,key) #else -#define case_149_SBOX32(hash,state,key) /**/ +#define case_149_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 148 -#define case_148_SBOX32(hash,state,key) _SBOX32_CASE(148,hash,state,key) +#define case_148_SBOX32(hash,state,key) _SBOX32_CASE(148,hash,state,key) #else -#define case_148_SBOX32(hash,state,key) /**/ +#define case_148_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 147 -#define case_147_SBOX32(hash,state,key) _SBOX32_CASE(147,hash,state,key) +#define case_147_SBOX32(hash,state,key) _SBOX32_CASE(147,hash,state,key) #else -#define case_147_SBOX32(hash,state,key) /**/ +#define case_147_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 146 -#define case_146_SBOX32(hash,state,key) _SBOX32_CASE(146,hash,state,key) +#define case_146_SBOX32(hash,state,key) _SBOX32_CASE(146,hash,state,key) #else -#define case_146_SBOX32(hash,state,key) /**/ +#define case_146_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 145 -#define case_145_SBOX32(hash,state,key) _SBOX32_CASE(145,hash,state,key) +#define case_145_SBOX32(hash,state,key) _SBOX32_CASE(145,hash,state,key) #else -#define case_145_SBOX32(hash,state,key) /**/ +#define case_145_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 144 -#define case_144_SBOX32(hash,state,key) _SBOX32_CASE(144,hash,state,key) +#define case_144_SBOX32(hash,state,key) _SBOX32_CASE(144,hash,state,key) #else -#define case_144_SBOX32(hash,state,key) /**/ +#define case_144_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 143 -#define case_143_SBOX32(hash,state,key) _SBOX32_CASE(143,hash,state,key) +#define case_143_SBOX32(hash,state,key) _SBOX32_CASE(143,hash,state,key) #else -#define case_143_SBOX32(hash,state,key) /**/ +#define case_143_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 142 -#define case_142_SBOX32(hash,state,key) _SBOX32_CASE(142,hash,state,key) +#define case_142_SBOX32(hash,state,key) _SBOX32_CASE(142,hash,state,key) #else -#define case_142_SBOX32(hash,state,key) /**/ +#define case_142_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 141 -#define case_141_SBOX32(hash,state,key) _SBOX32_CASE(141,hash,state,key) +#define case_141_SBOX32(hash,state,key) _SBOX32_CASE(141,hash,state,key) #else -#define case_141_SBOX32(hash,state,key) /**/ +#define case_141_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 140 -#define case_140_SBOX32(hash,state,key) _SBOX32_CASE(140,hash,state,key) +#define case_140_SBOX32(hash,state,key) _SBOX32_CASE(140,hash,state,key) #else -#define case_140_SBOX32(hash,state,key) /**/ +#define case_140_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 139 -#define case_139_SBOX32(hash,state,key) _SBOX32_CASE(139,hash,state,key) +#define case_139_SBOX32(hash,state,key) _SBOX32_CASE(139,hash,state,key) #else -#define case_139_SBOX32(hash,state,key) /**/ +#define case_139_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 138 -#define case_138_SBOX32(hash,state,key) _SBOX32_CASE(138,hash,state,key) +#define case_138_SBOX32(hash,state,key) _SBOX32_CASE(138,hash,state,key) #else -#define case_138_SBOX32(hash,state,key) /**/ +#define case_138_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 137 -#define case_137_SBOX32(hash,state,key) _SBOX32_CASE(137,hash,state,key) +#define case_137_SBOX32(hash,state,key) _SBOX32_CASE(137,hash,state,key) #else -#define case_137_SBOX32(hash,state,key) /**/ +#define case_137_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 136 -#define case_136_SBOX32(hash,state,key) _SBOX32_CASE(136,hash,state,key) +#define case_136_SBOX32(hash,state,key) _SBOX32_CASE(136,hash,state,key) #else -#define case_136_SBOX32(hash,state,key) /**/ +#define case_136_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 135 -#define case_135_SBOX32(hash,state,key) _SBOX32_CASE(135,hash,state,key) +#define case_135_SBOX32(hash,state,key) _SBOX32_CASE(135,hash,state,key) #else -#define case_135_SBOX32(hash,state,key) /**/ +#define case_135_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 134 -#define case_134_SBOX32(hash,state,key) _SBOX32_CASE(134,hash,state,key) +#define case_134_SBOX32(hash,state,key) _SBOX32_CASE(134,hash,state,key) #else -#define case_134_SBOX32(hash,state,key) /**/ +#define case_134_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 133 -#define case_133_SBOX32(hash,state,key) _SBOX32_CASE(133,hash,state,key) +#define case_133_SBOX32(hash,state,key) _SBOX32_CASE(133,hash,state,key) #else -#define case_133_SBOX32(hash,state,key) /**/ +#define case_133_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 132 -#define case_132_SBOX32(hash,state,key) _SBOX32_CASE(132,hash,state,key) +#define case_132_SBOX32(hash,state,key) _SBOX32_CASE(132,hash,state,key) #else -#define case_132_SBOX32(hash,state,key) /**/ +#define case_132_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 131 -#define case_131_SBOX32(hash,state,key) _SBOX32_CASE(131,hash,state,key) +#define case_131_SBOX32(hash,state,key) _SBOX32_CASE(131,hash,state,key) #else -#define case_131_SBOX32(hash,state,key) /**/ +#define case_131_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 130 -#define case_130_SBOX32(hash,state,key) _SBOX32_CASE(130,hash,state,key) +#define case_130_SBOX32(hash,state,key) _SBOX32_CASE(130,hash,state,key) #else -#define case_130_SBOX32(hash,state,key) /**/ +#define case_130_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 129 -#define case_129_SBOX32(hash,state,key) _SBOX32_CASE(129,hash,state,key) +#define case_129_SBOX32(hash,state,key) _SBOX32_CASE(129,hash,state,key) #else -#define case_129_SBOX32(hash,state,key) /**/ +#define case_129_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 128 -#define case_128_SBOX32(hash,state,key) _SBOX32_CASE(128,hash,state,key) +#define case_128_SBOX32(hash,state,key) _SBOX32_CASE(128,hash,state,key) #else -#define case_128_SBOX32(hash,state,key) /**/ +#define case_128_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 127 -#define case_127_SBOX32(hash,state,key) _SBOX32_CASE(127,hash,state,key) +#define case_127_SBOX32(hash,state,key) _SBOX32_CASE(127,hash,state,key) #else -#define case_127_SBOX32(hash,state,key) /**/ +#define case_127_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 126 -#define case_126_SBOX32(hash,state,key) _SBOX32_CASE(126,hash,state,key) +#define case_126_SBOX32(hash,state,key) _SBOX32_CASE(126,hash,state,key) #else -#define case_126_SBOX32(hash,state,key) /**/ +#define case_126_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 125 -#define case_125_SBOX32(hash,state,key) _SBOX32_CASE(125,hash,state,key) +#define case_125_SBOX32(hash,state,key) _SBOX32_CASE(125,hash,state,key) #else -#define case_125_SBOX32(hash,state,key) /**/ +#define case_125_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 124 -#define case_124_SBOX32(hash,state,key) _SBOX32_CASE(124,hash,state,key) +#define case_124_SBOX32(hash,state,key) _SBOX32_CASE(124,hash,state,key) #else -#define case_124_SBOX32(hash,state,key) /**/ +#define case_124_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 123 -#define case_123_SBOX32(hash,state,key) _SBOX32_CASE(123,hash,state,key) +#define case_123_SBOX32(hash,state,key) _SBOX32_CASE(123,hash,state,key) #else -#define case_123_SBOX32(hash,state,key) /**/ +#define case_123_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 122 -#define case_122_SBOX32(hash,state,key) _SBOX32_CASE(122,hash,state,key) +#define case_122_SBOX32(hash,state,key) _SBOX32_CASE(122,hash,state,key) #else -#define case_122_SBOX32(hash,state,key) /**/ +#define case_122_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 121 -#define case_121_SBOX32(hash,state,key) _SBOX32_CASE(121,hash,state,key) +#define case_121_SBOX32(hash,state,key) _SBOX32_CASE(121,hash,state,key) #else -#define case_121_SBOX32(hash,state,key) /**/ +#define case_121_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 120 -#define case_120_SBOX32(hash,state,key) _SBOX32_CASE(120,hash,state,key) +#define case_120_SBOX32(hash,state,key) _SBOX32_CASE(120,hash,state,key) #else -#define case_120_SBOX32(hash,state,key) /**/ +#define case_120_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 119 -#define case_119_SBOX32(hash,state,key) _SBOX32_CASE(119,hash,state,key) +#define case_119_SBOX32(hash,state,key) _SBOX32_CASE(119,hash,state,key) #else -#define case_119_SBOX32(hash,state,key) /**/ +#define case_119_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 118 -#define case_118_SBOX32(hash,state,key) _SBOX32_CASE(118,hash,state,key) +#define case_118_SBOX32(hash,state,key) _SBOX32_CASE(118,hash,state,key) #else -#define case_118_SBOX32(hash,state,key) /**/ +#define case_118_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 117 -#define case_117_SBOX32(hash,state,key) _SBOX32_CASE(117,hash,state,key) +#define case_117_SBOX32(hash,state,key) _SBOX32_CASE(117,hash,state,key) #else -#define case_117_SBOX32(hash,state,key) /**/ +#define case_117_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 116 -#define case_116_SBOX32(hash,state,key) _SBOX32_CASE(116,hash,state,key) +#define case_116_SBOX32(hash,state,key) _SBOX32_CASE(116,hash,state,key) #else -#define case_116_SBOX32(hash,state,key) /**/ +#define case_116_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 115 -#define case_115_SBOX32(hash,state,key) _SBOX32_CASE(115,hash,state,key) +#define case_115_SBOX32(hash,state,key) _SBOX32_CASE(115,hash,state,key) #else -#define case_115_SBOX32(hash,state,key) /**/ +#define case_115_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 114 -#define case_114_SBOX32(hash,state,key) _SBOX32_CASE(114,hash,state,key) +#define case_114_SBOX32(hash,state,key) _SBOX32_CASE(114,hash,state,key) #else -#define case_114_SBOX32(hash,state,key) /**/ +#define case_114_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 113 -#define case_113_SBOX32(hash,state,key) _SBOX32_CASE(113,hash,state,key) +#define case_113_SBOX32(hash,state,key) _SBOX32_CASE(113,hash,state,key) #else -#define case_113_SBOX32(hash,state,key) /**/ +#define case_113_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 112 -#define case_112_SBOX32(hash,state,key) _SBOX32_CASE(112,hash,state,key) +#define case_112_SBOX32(hash,state,key) _SBOX32_CASE(112,hash,state,key) #else -#define case_112_SBOX32(hash,state,key) /**/ +#define case_112_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 111 -#define case_111_SBOX32(hash,state,key) _SBOX32_CASE(111,hash,state,key) +#define case_111_SBOX32(hash,state,key) _SBOX32_CASE(111,hash,state,key) #else -#define case_111_SBOX32(hash,state,key) /**/ +#define case_111_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 110 -#define case_110_SBOX32(hash,state,key) _SBOX32_CASE(110,hash,state,key) +#define case_110_SBOX32(hash,state,key) _SBOX32_CASE(110,hash,state,key) #else -#define case_110_SBOX32(hash,state,key) /**/ +#define case_110_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 109 -#define case_109_SBOX32(hash,state,key) _SBOX32_CASE(109,hash,state,key) +#define case_109_SBOX32(hash,state,key) _SBOX32_CASE(109,hash,state,key) #else -#define case_109_SBOX32(hash,state,key) /**/ +#define case_109_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 108 -#define case_108_SBOX32(hash,state,key) _SBOX32_CASE(108,hash,state,key) +#define case_108_SBOX32(hash,state,key) _SBOX32_CASE(108,hash,state,key) #else -#define case_108_SBOX32(hash,state,key) /**/ +#define case_108_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 107 -#define case_107_SBOX32(hash,state,key) _SBOX32_CASE(107,hash,state,key) +#define case_107_SBOX32(hash,state,key) _SBOX32_CASE(107,hash,state,key) #else -#define case_107_SBOX32(hash,state,key) /**/ +#define case_107_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 106 -#define case_106_SBOX32(hash,state,key) _SBOX32_CASE(106,hash,state,key) +#define case_106_SBOX32(hash,state,key) _SBOX32_CASE(106,hash,state,key) #else -#define case_106_SBOX32(hash,state,key) /**/ +#define case_106_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 105 -#define case_105_SBOX32(hash,state,key) _SBOX32_CASE(105,hash,state,key) +#define case_105_SBOX32(hash,state,key) _SBOX32_CASE(105,hash,state,key) #else -#define case_105_SBOX32(hash,state,key) /**/ +#define case_105_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 104 -#define case_104_SBOX32(hash,state,key) _SBOX32_CASE(104,hash,state,key) +#define case_104_SBOX32(hash,state,key) _SBOX32_CASE(104,hash,state,key) #else -#define case_104_SBOX32(hash,state,key) /**/ +#define case_104_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 103 -#define case_103_SBOX32(hash,state,key) _SBOX32_CASE(103,hash,state,key) +#define case_103_SBOX32(hash,state,key) _SBOX32_CASE(103,hash,state,key) #else -#define case_103_SBOX32(hash,state,key) /**/ +#define case_103_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 102 -#define case_102_SBOX32(hash,state,key) _SBOX32_CASE(102,hash,state,key) +#define case_102_SBOX32(hash,state,key) _SBOX32_CASE(102,hash,state,key) #else -#define case_102_SBOX32(hash,state,key) /**/ +#define case_102_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 101 -#define case_101_SBOX32(hash,state,key) _SBOX32_CASE(101,hash,state,key) +#define case_101_SBOX32(hash,state,key) _SBOX32_CASE(101,hash,state,key) #else -#define case_101_SBOX32(hash,state,key) /**/ +#define case_101_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 100 -#define case_100_SBOX32(hash,state,key) _SBOX32_CASE(100,hash,state,key) +#define case_100_SBOX32(hash,state,key) _SBOX32_CASE(100,hash,state,key) #else -#define case_100_SBOX32(hash,state,key) /**/ +#define case_100_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 99 -#define case_99_SBOX32(hash,state,key) _SBOX32_CASE(99,hash,state,key) +#define case_99_SBOX32(hash,state,key) _SBOX32_CASE(99,hash,state,key) #else -#define case_99_SBOX32(hash,state,key) /**/ +#define case_99_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 98 -#define case_98_SBOX32(hash,state,key) _SBOX32_CASE(98,hash,state,key) +#define case_98_SBOX32(hash,state,key) _SBOX32_CASE(98,hash,state,key) #else -#define case_98_SBOX32(hash,state,key) /**/ +#define case_98_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 97 -#define case_97_SBOX32(hash,state,key) _SBOX32_CASE(97,hash,state,key) +#define case_97_SBOX32(hash,state,key) _SBOX32_CASE(97,hash,state,key) #else -#define case_97_SBOX32(hash,state,key) /**/ +#define case_97_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 96 -#define case_96_SBOX32(hash,state,key) _SBOX32_CASE(96,hash,state,key) +#define case_96_SBOX32(hash,state,key) _SBOX32_CASE(96,hash,state,key) #else -#define case_96_SBOX32(hash,state,key) /**/ +#define case_96_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 95 -#define case_95_SBOX32(hash,state,key) _SBOX32_CASE(95,hash,state,key) +#define case_95_SBOX32(hash,state,key) _SBOX32_CASE(95,hash,state,key) #else -#define case_95_SBOX32(hash,state,key) /**/ +#define case_95_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 94 -#define case_94_SBOX32(hash,state,key) _SBOX32_CASE(94,hash,state,key) +#define case_94_SBOX32(hash,state,key) _SBOX32_CASE(94,hash,state,key) #else -#define case_94_SBOX32(hash,state,key) /**/ +#define case_94_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 93 -#define case_93_SBOX32(hash,state,key) _SBOX32_CASE(93,hash,state,key) +#define case_93_SBOX32(hash,state,key) _SBOX32_CASE(93,hash,state,key) #else -#define case_93_SBOX32(hash,state,key) /**/ +#define case_93_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 92 -#define case_92_SBOX32(hash,state,key) _SBOX32_CASE(92,hash,state,key) +#define case_92_SBOX32(hash,state,key) _SBOX32_CASE(92,hash,state,key) #else -#define case_92_SBOX32(hash,state,key) /**/ +#define case_92_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 91 -#define case_91_SBOX32(hash,state,key) _SBOX32_CASE(91,hash,state,key) +#define case_91_SBOX32(hash,state,key) _SBOX32_CASE(91,hash,state,key) #else -#define case_91_SBOX32(hash,state,key) /**/ +#define case_91_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 90 -#define case_90_SBOX32(hash,state,key) _SBOX32_CASE(90,hash,state,key) +#define case_90_SBOX32(hash,state,key) _SBOX32_CASE(90,hash,state,key) #else -#define case_90_SBOX32(hash,state,key) /**/ +#define case_90_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 89 -#define case_89_SBOX32(hash,state,key) _SBOX32_CASE(89,hash,state,key) +#define case_89_SBOX32(hash,state,key) _SBOX32_CASE(89,hash,state,key) #else -#define case_89_SBOX32(hash,state,key) /**/ +#define case_89_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 88 -#define case_88_SBOX32(hash,state,key) _SBOX32_CASE(88,hash,state,key) +#define case_88_SBOX32(hash,state,key) _SBOX32_CASE(88,hash,state,key) #else -#define case_88_SBOX32(hash,state,key) /**/ +#define case_88_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 87 -#define case_87_SBOX32(hash,state,key) _SBOX32_CASE(87,hash,state,key) +#define case_87_SBOX32(hash,state,key) _SBOX32_CASE(87,hash,state,key) #else -#define case_87_SBOX32(hash,state,key) /**/ +#define case_87_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 86 -#define case_86_SBOX32(hash,state,key) _SBOX32_CASE(86,hash,state,key) +#define case_86_SBOX32(hash,state,key) _SBOX32_CASE(86,hash,state,key) #else -#define case_86_SBOX32(hash,state,key) /**/ +#define case_86_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 85 -#define case_85_SBOX32(hash,state,key) _SBOX32_CASE(85,hash,state,key) +#define case_85_SBOX32(hash,state,key) _SBOX32_CASE(85,hash,state,key) #else -#define case_85_SBOX32(hash,state,key) /**/ +#define case_85_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 84 -#define case_84_SBOX32(hash,state,key) _SBOX32_CASE(84,hash,state,key) +#define case_84_SBOX32(hash,state,key) _SBOX32_CASE(84,hash,state,key) #else -#define case_84_SBOX32(hash,state,key) /**/ +#define case_84_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 83 -#define case_83_SBOX32(hash,state,key) _SBOX32_CASE(83,hash,state,key) +#define case_83_SBOX32(hash,state,key) _SBOX32_CASE(83,hash,state,key) #else -#define case_83_SBOX32(hash,state,key) /**/ +#define case_83_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 82 -#define case_82_SBOX32(hash,state,key) _SBOX32_CASE(82,hash,state,key) +#define case_82_SBOX32(hash,state,key) _SBOX32_CASE(82,hash,state,key) #else -#define case_82_SBOX32(hash,state,key) /**/ +#define case_82_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 81 -#define case_81_SBOX32(hash,state,key) _SBOX32_CASE(81,hash,state,key) +#define case_81_SBOX32(hash,state,key) _SBOX32_CASE(81,hash,state,key) #else -#define case_81_SBOX32(hash,state,key) /**/ +#define case_81_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 80 -#define case_80_SBOX32(hash,state,key) _SBOX32_CASE(80,hash,state,key) +#define case_80_SBOX32(hash,state,key) _SBOX32_CASE(80,hash,state,key) #else -#define case_80_SBOX32(hash,state,key) /**/ +#define case_80_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 79 -#define case_79_SBOX32(hash,state,key) _SBOX32_CASE(79,hash,state,key) +#define case_79_SBOX32(hash,state,key) _SBOX32_CASE(79,hash,state,key) #else -#define case_79_SBOX32(hash,state,key) /**/ +#define case_79_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 78 -#define case_78_SBOX32(hash,state,key) _SBOX32_CASE(78,hash,state,key) +#define case_78_SBOX32(hash,state,key) _SBOX32_CASE(78,hash,state,key) #else -#define case_78_SBOX32(hash,state,key) /**/ +#define case_78_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 77 -#define case_77_SBOX32(hash,state,key) _SBOX32_CASE(77,hash,state,key) +#define case_77_SBOX32(hash,state,key) _SBOX32_CASE(77,hash,state,key) #else -#define case_77_SBOX32(hash,state,key) /**/ +#define case_77_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 76 -#define case_76_SBOX32(hash,state,key) _SBOX32_CASE(76,hash,state,key) +#define case_76_SBOX32(hash,state,key) _SBOX32_CASE(76,hash,state,key) #else -#define case_76_SBOX32(hash,state,key) /**/ +#define case_76_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 75 -#define case_75_SBOX32(hash,state,key) _SBOX32_CASE(75,hash,state,key) +#define case_75_SBOX32(hash,state,key) _SBOX32_CASE(75,hash,state,key) #else -#define case_75_SBOX32(hash,state,key) /**/ +#define case_75_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 74 -#define case_74_SBOX32(hash,state,key) _SBOX32_CASE(74,hash,state,key) +#define case_74_SBOX32(hash,state,key) _SBOX32_CASE(74,hash,state,key) #else -#define case_74_SBOX32(hash,state,key) /**/ +#define case_74_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 73 -#define case_73_SBOX32(hash,state,key) _SBOX32_CASE(73,hash,state,key) +#define case_73_SBOX32(hash,state,key) _SBOX32_CASE(73,hash,state,key) #else -#define case_73_SBOX32(hash,state,key) /**/ +#define case_73_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 72 -#define case_72_SBOX32(hash,state,key) _SBOX32_CASE(72,hash,state,key) +#define case_72_SBOX32(hash,state,key) _SBOX32_CASE(72,hash,state,key) #else -#define case_72_SBOX32(hash,state,key) /**/ +#define case_72_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 71 -#define case_71_SBOX32(hash,state,key) _SBOX32_CASE(71,hash,state,key) +#define case_71_SBOX32(hash,state,key) _SBOX32_CASE(71,hash,state,key) #else -#define case_71_SBOX32(hash,state,key) /**/ +#define case_71_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 70 -#define case_70_SBOX32(hash,state,key) _SBOX32_CASE(70,hash,state,key) +#define case_70_SBOX32(hash,state,key) _SBOX32_CASE(70,hash,state,key) #else -#define case_70_SBOX32(hash,state,key) /**/ +#define case_70_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 69 -#define case_69_SBOX32(hash,state,key) _SBOX32_CASE(69,hash,state,key) +#define case_69_SBOX32(hash,state,key) _SBOX32_CASE(69,hash,state,key) #else -#define case_69_SBOX32(hash,state,key) /**/ +#define case_69_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 68 -#define case_68_SBOX32(hash,state,key) _SBOX32_CASE(68,hash,state,key) +#define case_68_SBOX32(hash,state,key) _SBOX32_CASE(68,hash,state,key) #else -#define case_68_SBOX32(hash,state,key) /**/ +#define case_68_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 67 -#define case_67_SBOX32(hash,state,key) _SBOX32_CASE(67,hash,state,key) +#define case_67_SBOX32(hash,state,key) _SBOX32_CASE(67,hash,state,key) #else -#define case_67_SBOX32(hash,state,key) /**/ +#define case_67_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 66 -#define case_66_SBOX32(hash,state,key) _SBOX32_CASE(66,hash,state,key) +#define case_66_SBOX32(hash,state,key) _SBOX32_CASE(66,hash,state,key) #else -#define case_66_SBOX32(hash,state,key) /**/ +#define case_66_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 65 -#define case_65_SBOX32(hash,state,key) _SBOX32_CASE(65,hash,state,key) +#define case_65_SBOX32(hash,state,key) _SBOX32_CASE(65,hash,state,key) #else -#define case_65_SBOX32(hash,state,key) /**/ +#define case_65_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 64 -#define case_64_SBOX32(hash,state,key) _SBOX32_CASE(64,hash,state,key) +#define case_64_SBOX32(hash,state,key) _SBOX32_CASE(64,hash,state,key) #else -#define case_64_SBOX32(hash,state,key) /**/ +#define case_64_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 63 -#define case_63_SBOX32(hash,state,key) _SBOX32_CASE(63,hash,state,key) +#define case_63_SBOX32(hash,state,key) _SBOX32_CASE(63,hash,state,key) #else -#define case_63_SBOX32(hash,state,key) /**/ +#define case_63_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 62 -#define case_62_SBOX32(hash,state,key) _SBOX32_CASE(62,hash,state,key) +#define case_62_SBOX32(hash,state,key) _SBOX32_CASE(62,hash,state,key) #else -#define case_62_SBOX32(hash,state,key) /**/ +#define case_62_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 61 -#define case_61_SBOX32(hash,state,key) _SBOX32_CASE(61,hash,state,key) +#define case_61_SBOX32(hash,state,key) _SBOX32_CASE(61,hash,state,key) #else -#define case_61_SBOX32(hash,state,key) /**/ +#define case_61_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 60 -#define case_60_SBOX32(hash,state,key) _SBOX32_CASE(60,hash,state,key) +#define case_60_SBOX32(hash,state,key) _SBOX32_CASE(60,hash,state,key) #else -#define case_60_SBOX32(hash,state,key) /**/ +#define case_60_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 59 -#define case_59_SBOX32(hash,state,key) _SBOX32_CASE(59,hash,state,key) +#define case_59_SBOX32(hash,state,key) _SBOX32_CASE(59,hash,state,key) #else -#define case_59_SBOX32(hash,state,key) /**/ +#define case_59_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 58 -#define case_58_SBOX32(hash,state,key) _SBOX32_CASE(58,hash,state,key) +#define case_58_SBOX32(hash,state,key) _SBOX32_CASE(58,hash,state,key) #else -#define case_58_SBOX32(hash,state,key) /**/ +#define case_58_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 57 -#define case_57_SBOX32(hash,state,key) _SBOX32_CASE(57,hash,state,key) +#define case_57_SBOX32(hash,state,key) _SBOX32_CASE(57,hash,state,key) #else -#define case_57_SBOX32(hash,state,key) /**/ +#define case_57_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 56 -#define case_56_SBOX32(hash,state,key) _SBOX32_CASE(56,hash,state,key) +#define case_56_SBOX32(hash,state,key) _SBOX32_CASE(56,hash,state,key) #else -#define case_56_SBOX32(hash,state,key) /**/ +#define case_56_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 55 -#define case_55_SBOX32(hash,state,key) _SBOX32_CASE(55,hash,state,key) +#define case_55_SBOX32(hash,state,key) _SBOX32_CASE(55,hash,state,key) #else -#define case_55_SBOX32(hash,state,key) /**/ +#define case_55_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 54 -#define case_54_SBOX32(hash,state,key) _SBOX32_CASE(54,hash,state,key) +#define case_54_SBOX32(hash,state,key) _SBOX32_CASE(54,hash,state,key) #else -#define case_54_SBOX32(hash,state,key) /**/ +#define case_54_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 53 -#define case_53_SBOX32(hash,state,key) _SBOX32_CASE(53,hash,state,key) +#define case_53_SBOX32(hash,state,key) _SBOX32_CASE(53,hash,state,key) #else -#define case_53_SBOX32(hash,state,key) /**/ +#define case_53_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 52 -#define case_52_SBOX32(hash,state,key) _SBOX32_CASE(52,hash,state,key) +#define case_52_SBOX32(hash,state,key) _SBOX32_CASE(52,hash,state,key) #else -#define case_52_SBOX32(hash,state,key) /**/ +#define case_52_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 51 -#define case_51_SBOX32(hash,state,key) _SBOX32_CASE(51,hash,state,key) +#define case_51_SBOX32(hash,state,key) _SBOX32_CASE(51,hash,state,key) #else -#define case_51_SBOX32(hash,state,key) /**/ +#define case_51_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 50 -#define case_50_SBOX32(hash,state,key) _SBOX32_CASE(50,hash,state,key) +#define case_50_SBOX32(hash,state,key) _SBOX32_CASE(50,hash,state,key) #else -#define case_50_SBOX32(hash,state,key) /**/ +#define case_50_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 49 -#define case_49_SBOX32(hash,state,key) _SBOX32_CASE(49,hash,state,key) +#define case_49_SBOX32(hash,state,key) _SBOX32_CASE(49,hash,state,key) #else -#define case_49_SBOX32(hash,state,key) /**/ +#define case_49_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 48 -#define case_48_SBOX32(hash,state,key) _SBOX32_CASE(48,hash,state,key) +#define case_48_SBOX32(hash,state,key) _SBOX32_CASE(48,hash,state,key) #else -#define case_48_SBOX32(hash,state,key) /**/ +#define case_48_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 47 -#define case_47_SBOX32(hash,state,key) _SBOX32_CASE(47,hash,state,key) +#define case_47_SBOX32(hash,state,key) _SBOX32_CASE(47,hash,state,key) #else -#define case_47_SBOX32(hash,state,key) /**/ +#define case_47_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 46 -#define case_46_SBOX32(hash,state,key) _SBOX32_CASE(46,hash,state,key) +#define case_46_SBOX32(hash,state,key) _SBOX32_CASE(46,hash,state,key) #else -#define case_46_SBOX32(hash,state,key) /**/ +#define case_46_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 45 -#define case_45_SBOX32(hash,state,key) _SBOX32_CASE(45,hash,state,key) +#define case_45_SBOX32(hash,state,key) _SBOX32_CASE(45,hash,state,key) #else -#define case_45_SBOX32(hash,state,key) /**/ +#define case_45_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 44 -#define case_44_SBOX32(hash,state,key) _SBOX32_CASE(44,hash,state,key) +#define case_44_SBOX32(hash,state,key) _SBOX32_CASE(44,hash,state,key) #else -#define case_44_SBOX32(hash,state,key) /**/ +#define case_44_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 43 -#define case_43_SBOX32(hash,state,key) _SBOX32_CASE(43,hash,state,key) +#define case_43_SBOX32(hash,state,key) _SBOX32_CASE(43,hash,state,key) #else -#define case_43_SBOX32(hash,state,key) /**/ +#define case_43_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 42 -#define case_42_SBOX32(hash,state,key) _SBOX32_CASE(42,hash,state,key) +#define case_42_SBOX32(hash,state,key) _SBOX32_CASE(42,hash,state,key) #else -#define case_42_SBOX32(hash,state,key) /**/ +#define case_42_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 41 -#define case_41_SBOX32(hash,state,key) _SBOX32_CASE(41,hash,state,key) +#define case_41_SBOX32(hash,state,key) _SBOX32_CASE(41,hash,state,key) #else -#define case_41_SBOX32(hash,state,key) /**/ +#define case_41_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 40 -#define case_40_SBOX32(hash,state,key) _SBOX32_CASE(40,hash,state,key) +#define case_40_SBOX32(hash,state,key) _SBOX32_CASE(40,hash,state,key) #else -#define case_40_SBOX32(hash,state,key) /**/ +#define case_40_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 39 -#define case_39_SBOX32(hash,state,key) _SBOX32_CASE(39,hash,state,key) +#define case_39_SBOX32(hash,state,key) _SBOX32_CASE(39,hash,state,key) #else -#define case_39_SBOX32(hash,state,key) /**/ +#define case_39_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 38 -#define case_38_SBOX32(hash,state,key) _SBOX32_CASE(38,hash,state,key) +#define case_38_SBOX32(hash,state,key) _SBOX32_CASE(38,hash,state,key) #else -#define case_38_SBOX32(hash,state,key) /**/ +#define case_38_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 37 -#define case_37_SBOX32(hash,state,key) _SBOX32_CASE(37,hash,state,key) +#define case_37_SBOX32(hash,state,key) _SBOX32_CASE(37,hash,state,key) #else -#define case_37_SBOX32(hash,state,key) /**/ +#define case_37_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 36 -#define case_36_SBOX32(hash,state,key) _SBOX32_CASE(36,hash,state,key) +#define case_36_SBOX32(hash,state,key) _SBOX32_CASE(36,hash,state,key) #else -#define case_36_SBOX32(hash,state,key) /**/ +#define case_36_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 35 -#define case_35_SBOX32(hash,state,key) _SBOX32_CASE(35,hash,state,key) +#define case_35_SBOX32(hash,state,key) _SBOX32_CASE(35,hash,state,key) #else -#define case_35_SBOX32(hash,state,key) /**/ +#define case_35_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 34 -#define case_34_SBOX32(hash,state,key) _SBOX32_CASE(34,hash,state,key) +#define case_34_SBOX32(hash,state,key) _SBOX32_CASE(34,hash,state,key) #else -#define case_34_SBOX32(hash,state,key) /**/ +#define case_34_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 33 -#define case_33_SBOX32(hash,state,key) _SBOX32_CASE(33,hash,state,key) +#define case_33_SBOX32(hash,state,key) _SBOX32_CASE(33,hash,state,key) #else -#define case_33_SBOX32(hash,state,key) /**/ +#define case_33_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 32 -#define case_32_SBOX32(hash,state,key) _SBOX32_CASE(32,hash,state,key) +#define case_32_SBOX32(hash,state,key) _SBOX32_CASE(32,hash,state,key) #else -#define case_32_SBOX32(hash,state,key) /**/ +#define case_32_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 31 -#define case_31_SBOX32(hash,state,key) _SBOX32_CASE(31,hash,state,key) +#define case_31_SBOX32(hash,state,key) _SBOX32_CASE(31,hash,state,key) #else -#define case_31_SBOX32(hash,state,key) /**/ +#define case_31_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 30 -#define case_30_SBOX32(hash,state,key) _SBOX32_CASE(30,hash,state,key) +#define case_30_SBOX32(hash,state,key) _SBOX32_CASE(30,hash,state,key) #else -#define case_30_SBOX32(hash,state,key) /**/ +#define case_30_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 29 -#define case_29_SBOX32(hash,state,key) _SBOX32_CASE(29,hash,state,key) +#define case_29_SBOX32(hash,state,key) _SBOX32_CASE(29,hash,state,key) #else -#define case_29_SBOX32(hash,state,key) /**/ +#define case_29_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 28 -#define case_28_SBOX32(hash,state,key) _SBOX32_CASE(28,hash,state,key) +#define case_28_SBOX32(hash,state,key) _SBOX32_CASE(28,hash,state,key) #else -#define case_28_SBOX32(hash,state,key) /**/ +#define case_28_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 27 -#define case_27_SBOX32(hash,state,key) _SBOX32_CASE(27,hash,state,key) +#define case_27_SBOX32(hash,state,key) _SBOX32_CASE(27,hash,state,key) #else -#define case_27_SBOX32(hash,state,key) /**/ +#define case_27_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 26 -#define case_26_SBOX32(hash,state,key) _SBOX32_CASE(26,hash,state,key) +#define case_26_SBOX32(hash,state,key) _SBOX32_CASE(26,hash,state,key) #else -#define case_26_SBOX32(hash,state,key) /**/ +#define case_26_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 25 -#define case_25_SBOX32(hash,state,key) _SBOX32_CASE(25,hash,state,key) +#define case_25_SBOX32(hash,state,key) _SBOX32_CASE(25,hash,state,key) #else -#define case_25_SBOX32(hash,state,key) /**/ +#define case_25_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 24 -#define case_24_SBOX32(hash,state,key) _SBOX32_CASE(24,hash,state,key) +#define case_24_SBOX32(hash,state,key) _SBOX32_CASE(24,hash,state,key) #else -#define case_24_SBOX32(hash,state,key) /**/ +#define case_24_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 23 -#define case_23_SBOX32(hash,state,key) _SBOX32_CASE(23,hash,state,key) +#define case_23_SBOX32(hash,state,key) _SBOX32_CASE(23,hash,state,key) #else -#define case_23_SBOX32(hash,state,key) /**/ +#define case_23_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 22 -#define case_22_SBOX32(hash,state,key) _SBOX32_CASE(22,hash,state,key) +#define case_22_SBOX32(hash,state,key) _SBOX32_CASE(22,hash,state,key) #else -#define case_22_SBOX32(hash,state,key) /**/ +#define case_22_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 21 -#define case_21_SBOX32(hash,state,key) _SBOX32_CASE(21,hash,state,key) +#define case_21_SBOX32(hash,state,key) _SBOX32_CASE(21,hash,state,key) #else -#define case_21_SBOX32(hash,state,key) /**/ +#define case_21_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 20 -#define case_20_SBOX32(hash,state,key) _SBOX32_CASE(20,hash,state,key) +#define case_20_SBOX32(hash,state,key) _SBOX32_CASE(20,hash,state,key) #else -#define case_20_SBOX32(hash,state,key) /**/ +#define case_20_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 19 -#define case_19_SBOX32(hash,state,key) _SBOX32_CASE(19,hash,state,key) +#define case_19_SBOX32(hash,state,key) _SBOX32_CASE(19,hash,state,key) #else -#define case_19_SBOX32(hash,state,key) /**/ +#define case_19_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 18 -#define case_18_SBOX32(hash,state,key) _SBOX32_CASE(18,hash,state,key) +#define case_18_SBOX32(hash,state,key) _SBOX32_CASE(18,hash,state,key) #else -#define case_18_SBOX32(hash,state,key) /**/ +#define case_18_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 17 -#define case_17_SBOX32(hash,state,key) _SBOX32_CASE(17,hash,state,key) +#define case_17_SBOX32(hash,state,key) _SBOX32_CASE(17,hash,state,key) #else -#define case_17_SBOX32(hash,state,key) /**/ +#define case_17_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 16 -#define case_16_SBOX32(hash,state,key) _SBOX32_CASE(16,hash,state,key) +#define case_16_SBOX32(hash,state,key) _SBOX32_CASE(16,hash,state,key) #else -#define case_16_SBOX32(hash,state,key) /**/ +#define case_16_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 15 -#define case_15_SBOX32(hash,state,key) _SBOX32_CASE(15,hash,state,key) +#define case_15_SBOX32(hash,state,key) _SBOX32_CASE(15,hash,state,key) #else -#define case_15_SBOX32(hash,state,key) /**/ +#define case_15_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 14 -#define case_14_SBOX32(hash,state,key) _SBOX32_CASE(14,hash,state,key) +#define case_14_SBOX32(hash,state,key) _SBOX32_CASE(14,hash,state,key) #else -#define case_14_SBOX32(hash,state,key) /**/ +#define case_14_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 13 -#define case_13_SBOX32(hash,state,key) _SBOX32_CASE(13,hash,state,key) +#define case_13_SBOX32(hash,state,key) _SBOX32_CASE(13,hash,state,key) #else -#define case_13_SBOX32(hash,state,key) /**/ +#define case_13_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 12 -#define case_12_SBOX32(hash,state,key) _SBOX32_CASE(12,hash,state,key) +#define case_12_SBOX32(hash,state,key) _SBOX32_CASE(12,hash,state,key) #else -#define case_12_SBOX32(hash,state,key) /**/ +#define case_12_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 11 -#define case_11_SBOX32(hash,state,key) _SBOX32_CASE(11,hash,state,key) +#define case_11_SBOX32(hash,state,key) _SBOX32_CASE(11,hash,state,key) #else -#define case_11_SBOX32(hash,state,key) /**/ +#define case_11_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 10 -#define case_10_SBOX32(hash,state,key) _SBOX32_CASE(10,hash,state,key) +#define case_10_SBOX32(hash,state,key) _SBOX32_CASE(10,hash,state,key) #else -#define case_10_SBOX32(hash,state,key) /**/ +#define case_10_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 9 -#define case_9_SBOX32(hash,state,key) _SBOX32_CASE(9,hash,state,key) +#define case_9_SBOX32(hash,state,key) _SBOX32_CASE(9,hash,state,key) #else -#define case_9_SBOX32(hash,state,key) /**/ +#define case_9_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 8 -#define case_8_SBOX32(hash,state,key) _SBOX32_CASE(8,hash,state,key) +#define case_8_SBOX32(hash,state,key) _SBOX32_CASE(8,hash,state,key) #else -#define case_8_SBOX32(hash,state,key) /**/ +#define case_8_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 7 -#define case_7_SBOX32(hash,state,key) _SBOX32_CASE(7,hash,state,key) +#define case_7_SBOX32(hash,state,key) _SBOX32_CASE(7,hash,state,key) #else -#define case_7_SBOX32(hash,state,key) /**/ +#define case_7_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 6 -#define case_6_SBOX32(hash,state,key) _SBOX32_CASE(6,hash,state,key) +#define case_6_SBOX32(hash,state,key) _SBOX32_CASE(6,hash,state,key) #else -#define case_6_SBOX32(hash,state,key) /**/ +#define case_6_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 5 -#define case_5_SBOX32(hash,state,key) _SBOX32_CASE(5,hash,state,key) +#define case_5_SBOX32(hash,state,key) _SBOX32_CASE(5,hash,state,key) #else -#define case_5_SBOX32(hash,state,key) /**/ +#define case_5_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 4 -#define case_4_SBOX32(hash,state,key) _SBOX32_CASE(4,hash,state,key) +#define case_4_SBOX32(hash,state,key) _SBOX32_CASE(4,hash,state,key) #else -#define case_4_SBOX32(hash,state,key) /**/ +#define case_4_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 3 -#define case_3_SBOX32(hash,state,key) _SBOX32_CASE(3,hash,state,key) +#define case_3_SBOX32(hash,state,key) _SBOX32_CASE(3,hash,state,key) #else -#define case_3_SBOX32(hash,state,key) /**/ +#define case_3_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 2 -#define case_2_SBOX32(hash,state,key) _SBOX32_CASE(2,hash,state,key) +#define case_2_SBOX32(hash,state,key) _SBOX32_CASE(2,hash,state,key) #else -#define case_2_SBOX32(hash,state,key) /**/ +#define case_2_SBOX32(hash,state,key) /**/ #endif #if SBOX32_MAX_LEN >= 1 -#define case_1_SBOX32(hash,state,key) _SBOX32_CASE(1,hash,state,key) +#define case_1_SBOX32(hash,state,key) _SBOX32_CASE(1,hash,state,key) #else -#define case_1_SBOX32(hash,state,key) /**/ +#define case_1_SBOX32(hash,state,key) /**/ #endif -#define XORSHIFT128_set(r,x,y,z,w,t) STMT_START { \ - t = ( x ^ ( x << 5 ) ); \ - x = y; y = z; z = w; \ - r = w = ( w ^ ( w >> 29 ) ) ^ ( t ^ ( t >> 12 ) ); \ -} STMT_END +#define XORSHIFT128_set(r,x,y,z,w,t) \ + STMT_START { \ + t = ( x ^ ( x << 5 ) ); \ + x = y; y = z; z = w; \ + r = w = ( w ^ ( w >> 29 ) ) ^ ( t ^ ( t >> 12 ) ); \ + } STMT_END -#ifndef SBOX32_CHURN_ROUNDS -#define SBOX32_CHURN_ROUNDS 128 +#ifndef SBOX32_CHURN_ROUNDS +#define SBOX32_CHURN_ROUNDS 128 #endif -#define _SBOX32_CASE(len,hash,state,key) \ - /* FALLTHROUGH */ \ +#define _SBOX32_CASE(len,hash,state,key) \ + /* FALLTHROUGH */ \ case len: hash ^= state[ 1 + ( 256 * ( len - 1 ) ) + key[ len - 1 ] ]; @@ -1440,13 +1445,13 @@ SBOX32_STATIC_INLINE void sbox32_seed_state128 ( if (!s1) s1 = 4; if (!s2) s2 = 2; if (!s3) s3 = 1; - + for ( i = 0; i < SBOX32_CHURN_ROUNDS; i++ ) SBOX32_MIX4(s0,s1,s2,s3,"SEED STATE"); while ( state_cursor < sbox32_end ) { - U32 *row_end = state_cursor + 256; - for ( ; state_cursor < row_end; state_cursor++ ) { + U32 *row_end = state_cursor + 256; + for (; state_cursor < row_end; state_cursor++ ) { XORSHIFT128_set(*state_cursor,s0,s1,s2,s3,t1); } } diff --git a/scope.h b/scope.h index 21ad7202aea1..a5c2f992eed7 100644 --- a/scope.h +++ b/scope.h @@ -1,86 +1,86 @@ /* scope.h * - * Copyright (C) 1993, 1994, 1996, 1997, 1998, 1999, 2000, 2001, - * 2002, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others + * Copyright (C) 1993, 1994, 1996, 1997, 1998, 1999, 2000, 2001, 2002, + * 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, + * 2016, 2017, 2018, 2019, 2020, 2021, 2022 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * */ #include "scope_types.h" -#define SAVEf_SETMAGIC 1 -#define SAVEf_KEEPOLDELEM 2 +#define SAVEf_SETMAGIC 1 +#define SAVEf_KEEPOLDELEM 2 -#define SAVE_TIGHT_SHIFT 6 -#define SAVE_MASK 0x3F +#define SAVE_TIGHT_SHIFT 6 +#define SAVE_MASK 0x3F -#define save_aelem(av,idx,sptr) save_aelem_flags(av,idx,sptr,SAVEf_SETMAGIC) -#define save_helem(hv,key,sptr) save_helem_flags(hv,key,sptr,SAVEf_SETMAGIC) +#define save_aelem(av,idx,sptr) save_aelem_flags(av,idx,sptr,SAVEf_SETMAGIC) +#define save_helem(hv,key,sptr) save_helem_flags(hv,key,sptr,SAVEf_SETMAGIC) #ifndef SCOPE_SAVES_SIGNAL_MASK #define SCOPE_SAVES_SIGNAL_MASK 0 #endif -/* the maximum number of entries that might be pushed using the SS_ADD* - * macros */ -#define SS_MAXPUSH 4 - -#define SSGROW(need) if (UNLIKELY(PL_savestack_ix + (I32)(need) > PL_savestack_max)) savestack_grow_cnt(need) -#define SSCHECK(need) SSGROW(need) /* legacy */ -#define SSPUSHINT(i) (PL_savestack[PL_savestack_ix++].any_i32 = (I32)(i)) -#define SSPUSHLONG(i) (PL_savestack[PL_savestack_ix++].any_long = (long)(i)) -#define SSPUSHBOOL(p) (PL_savestack[PL_savestack_ix++].any_bool = (p)) -#define SSPUSHIV(i) (PL_savestack[PL_savestack_ix++].any_iv = (IV)(i)) -#define SSPUSHUV(u) (PL_savestack[PL_savestack_ix++].any_uv = (UV)(u)) -#define SSPUSHPTR(p) (PL_savestack[PL_savestack_ix++].any_ptr = (void*)(p)) -#define SSPUSHDPTR(p) (PL_savestack[PL_savestack_ix++].any_dptr = (p)) -#define SSPUSHDXPTR(p) (PL_savestack[PL_savestack_ix++].any_dxptr = (p)) - -/* SS_ADD*: newer, faster versions of the above. Don't mix the two sets of - * macros. These are fast because they save reduce accesses to the PL_ - * vars and move the size check to the end. Doing the check last means - * that values in registers will have been pushed and no longer needed, so - * don't need saving around the call to grow. Also, tail-call elimination - * of the grow() can be done. These changes reduce the code of something - * like save_pushptrptr() to half its former size. - * Of course, doing the size check *after* pushing means we must always - * ensure there are SS_MAXPUSH free slots on the savestack. This is ensured by - * savestack_grow_cnt always allocating SS_MAXPUSH slots - * more than asked for, or that it sets PL_savestack_max to +/* the maximum number of entries that might + * be pushed using the SS_ADD* macros */ +#define SS_MAXPUSH 4 + +#define SSGROW(need) \ + if (UNLIKELY(PL_savestack_ix + (I32)(need) > PL_savestack_max)) savestack_grow_cnt(need) +#define SSCHECK(need) SSGROW(need) /* legacy */ +#define SSPUSHINT(i) (PL_savestack[PL_savestack_ix++].any_i32 = (I32)(i)) +#define SSPUSHLONG(i) (PL_savestack[PL_savestack_ix++].any_long = (long)(i)) +#define SSPUSHBOOL(p) (PL_savestack[PL_savestack_ix++].any_bool = (p)) +#define SSPUSHIV(i) (PL_savestack[PL_savestack_ix++].any_iv = (IV)(i)) +#define SSPUSHUV(u) (PL_savestack[PL_savestack_ix++].any_uv = (UV)(u)) +#define SSPUSHPTR(p) (PL_savestack[PL_savestack_ix++].any_ptr = (void*)(p)) +#define SSPUSHDPTR(p) (PL_savestack[PL_savestack_ix++].any_dptr = (p)) +#define SSPUSHDXPTR(p) (PL_savestack[PL_savestack_ix++].any_dxptr = (p)) + +/* SS_ADD*: newer, faster versions of the above. Don't mix the two sets of + * macros. These are fast because they save reduce accesses to the PL_ vars + * and move the size check to the end. Doing the check last means that values + * in registers will have been pushed and no longer needed, so don't need + * saving around the call to grow. Also, tail-call elimination of the grow() + * can be done. These changes reduce the code of something like + * save_pushptrptr() to half its former size. Of course, doing the size check + * *after* pushing means we must always ensure there are SS_MAXPUSH free slots + * on the savestack. This is ensured by savestack_grow_cnt always allocating + * SS_MAXPUSH slots more than asked for, or that it sets PL_savestack_max to * * These are for internal core use only and are subject to change */ -#define dSS_ADD \ - I32 ix = PL_savestack_ix; \ +#define dSS_ADD \ + I32 ix = PL_savestack_ix; \ ANY *ssp = &PL_savestack[ix] -#define SS_ADD_END(need) \ - assert((need) <= SS_MAXPUSH); \ - ix += (need); \ - PL_savestack_ix = ix; \ - assert(ix <= PL_savestack_max + SS_MAXPUSH); \ - if (UNLIKELY(ix > PL_savestack_max)) savestack_grow_cnt(ix - PL_savestack_max); \ +#define SS_ADD_END(need) \ + assert((need) <= SS_MAXPUSH); \ + ix += (need); \ + PL_savestack_ix = ix; \ + assert(ix <= PL_savestack_max + SS_MAXPUSH); \ + if (UNLIKELY(ix > PL_savestack_max)) savestack_grow_cnt(ix - PL_savestack_max); \ assert(PL_savestack_ix <= PL_savestack_max); -#define SS_ADD_INT(i) ((ssp++)->any_i32 = (I32)(i)) -#define SS_ADD_LONG(i) ((ssp++)->any_long = (long)(i)) -#define SS_ADD_BOOL(p) ((ssp++)->any_bool = (p)) -#define SS_ADD_IV(i) ((ssp++)->any_iv = (IV)(i)) -#define SS_ADD_UV(u) ((ssp++)->any_uv = (UV)(u)) -#define SS_ADD_PTR(p) ((ssp++)->any_ptr = (void*)(p)) -#define SS_ADD_DPTR(p) ((ssp++)->any_dptr = (p)) -#define SS_ADD_DXPTR(p) ((ssp++)->any_dxptr = (p)) - -#define SSPOPINT (PL_savestack[--PL_savestack_ix].any_i32) -#define SSPOPLONG (PL_savestack[--PL_savestack_ix].any_long) -#define SSPOPBOOL (PL_savestack[--PL_savestack_ix].any_bool) -#define SSPOPIV (PL_savestack[--PL_savestack_ix].any_iv) -#define SSPOPUV (PL_savestack[--PL_savestack_ix].any_uv) -#define SSPOPPTR (PL_savestack[--PL_savestack_ix].any_ptr) -#define SSPOPDPTR (PL_savestack[--PL_savestack_ix].any_dptr) -#define SSPOPDXPTR (PL_savestack[--PL_savestack_ix].any_dxptr) +#define SS_ADD_INT(i) ((ssp++)->any_i32 = (I32)(i)) +#define SS_ADD_LONG(i) ((ssp++)->any_long = (long)(i)) +#define SS_ADD_BOOL(p) ((ssp++)->any_bool = (p)) +#define SS_ADD_IV(i) ((ssp++)->any_iv = (IV)(i)) +#define SS_ADD_UV(u) ((ssp++)->any_uv = (UV)(u)) +#define SS_ADD_PTR(p) ((ssp++)->any_ptr = (void*)(p)) +#define SS_ADD_DPTR(p) ((ssp++)->any_dptr = (p)) +#define SS_ADD_DXPTR(p) ((ssp++)->any_dxptr = (p)) + +#define SSPOPINT (PL_savestack[--PL_savestack_ix].any_i32) +#define SSPOPLONG (PL_savestack[--PL_savestack_ix].any_long) +#define SSPOPBOOL (PL_savestack[--PL_savestack_ix].any_bool) +#define SSPOPIV (PL_savestack[--PL_savestack_ix].any_iv) +#define SSPOPUV (PL_savestack[--PL_savestack_ix].any_uv) +#define SSPOPPTR (PL_savestack[--PL_savestack_ix].any_ptr) +#define SSPOPDPTR (PL_savestack[--PL_savestack_ix].any_dptr) +#define SSPOPDXPTR (PL_savestack[--PL_savestack_ix].any_dxptr) /* @@ -102,149 +102,152 @@ Closing bracket on a callback. See C> and L. =for apidoc Am;||ENTER_with_name|"name" -Same as C>, but when debugging is enabled it also associates the -given literal string with the new scope. +Same as C>, but when debugging is enabled it also associates +the given literal string with the new scope. =for apidoc Am;||LEAVE_with_name|"name" -Same as C>, but when debugging is enabled it first checks that the -scope has the given name. C must be a literal string. +Same as C>, but when debugging is enabled it first checks that +the scope has the given name. C must be a literal string. =cut */ -#define SAVETMPS Perl_savetmps(aTHX) +#define SAVETMPS Perl_savetmps(aTHX) -#define FREETMPS if (PL_tmps_ix > PL_tmps_floor) free_tmps() +#define FREETMPS if (PL_tmps_ix > PL_tmps_floor) free_tmps() #ifdef DEBUGGING -#define ENTER \ - STMT_START { \ - push_scope(); \ - DEBUG_SCOPE("ENTER") \ +#define ENTER \ + STMT_START { \ + push_scope(); \ + DEBUG_SCOPE("ENTER") \ } STMT_END -#define LEAVE \ - STMT_START { \ - DEBUG_SCOPE("LEAVE") \ - pop_scope(); \ +#define LEAVE \ + STMT_START { \ + DEBUG_SCOPE("LEAVE") \ + pop_scope(); \ } STMT_END -#define ENTER_with_name(name) \ - STMT_START { \ - push_scope(); \ - if (PL_scopestack_name) \ - PL_scopestack_name[PL_scopestack_ix-1] = ASSERT_IS_LITERAL(name);\ - DEBUG_SCOPE("ENTER \"" name "\"") \ +#define ENTER_with_name(name) \ + STMT_START { \ + push_scope(); \ + if (PL_scopestack_name) \ + PL_scopestack_name[PL_scopestack_ix-1] = ASSERT_IS_LITERAL(name); \ + DEBUG_SCOPE("ENTER \"" name "\"") \ } STMT_END -#define LEAVE_with_name(name) \ - STMT_START { \ - DEBUG_SCOPE("LEAVE \"" name "\"") \ - if (PL_scopestack_name) { \ - CLANG_DIAG_IGNORE_STMT(-Wstring-compare); \ - assert(((char*)PL_scopestack_name[PL_scopestack_ix-1] \ - == (char*)ASSERT_IS_LITERAL(name)) \ - || strEQ(PL_scopestack_name[PL_scopestack_ix-1], name)); \ - CLANG_DIAG_RESTORE_STMT; \ - } \ - pop_scope(); \ +#define LEAVE_with_name(name) \ + STMT_START { \ + DEBUG_SCOPE("LEAVE \"" name "\"") \ + if (PL_scopestack_name) { \ + CLANG_DIAG_IGNORE_STMT(-Wstring-compare); \ + assert(((char*)PL_scopestack_name[PL_scopestack_ix-1] \ + == (char*)ASSERT_IS_LITERAL(name)) \ + || strEQ(PL_scopestack_name[PL_scopestack_ix-1], name)); \ + CLANG_DIAG_RESTORE_STMT; \ + } \ + pop_scope(); \ } STMT_END #else -#define ENTER push_scope() -#define LEAVE pop_scope() +#define ENTER push_scope() +#define LEAVE pop_scope() #define ENTER_with_name(name) ENTER #define LEAVE_with_name(name) LEAVE #endif -#define LEAVE_SCOPE(old) STMT_START { \ - if (PL_savestack_ix > old) leave_scope(old); \ +#define LEAVE_SCOPE(old) \ + STMT_START { \ + if (PL_savestack_ix > old) leave_scope(old); \ } STMT_END -#define SAVEI8(i) save_I8((I8*)&(i)) -#define SAVEI16(i) save_I16((I16*)&(i)) -#define SAVEI32(i) save_I32((I32*)&(i)) -#define SAVEINT(i) save_int((int*)&(i)) -#define SAVEIV(i) save_iv((IV*)&(i)) -#define SAVELONG(l) save_long((long*)&(l)) -#define SAVESTRLEN(l) Perl_save_strlen(aTHX_ (STRLEN*)&(l)) -#define SAVEBOOL(b) save_bool(&(b)) -#define SAVESPTR(s) save_sptr((SV**)&(s)) -#define SAVEPPTR(s) save_pptr((char**)&(s)) -#define SAVEVPTR(s) save_vptr((void*)&(s)) -#define SAVEPADSVANDMORTALIZE(s) save_padsv_and_mortalize(s) -#define SAVEFREESV(s) save_freesv(MUTABLE_SV(s)) -#define SAVEFREEPADNAME(s) save_pushptr((void *)(s), SAVEt_FREEPADNAME) -#define SAVEMORTALIZESV(s) save_mortalizesv(MUTABLE_SV(s)) -#define SAVEFREEOP(o) save_freeop((OP*)(o)) -#define SAVEFREEPV(p) save_freepv((char*)(p)) -#define SAVECLEARSV(sv) save_clearsv((SV**)&(sv)) -#define SAVEGENERICSV(s) save_generic_svref((SV**)&(s)) -#define SAVEGENERICPV(s) save_generic_pvref((char**)&(s)) -#define SAVERCPVFREE(s) save_rcpv_free((char**)&(s)) -#define SAVESHAREDPV(s) save_shared_pvref((char**)&(s)) +#define SAVEI8(i) save_I8((I8*)&(i)) +#define SAVEI16(i) save_I16((I16*)&(i)) +#define SAVEI32(i) save_I32((I32*)&(i)) +#define SAVEINT(i) save_int((int*)&(i)) +#define SAVEIV(i) save_iv((IV*)&(i)) +#define SAVELONG(l) save_long((long*)&(l)) +#define SAVESTRLEN(l) Perl_save_strlen(aTHX_ (STRLEN*)&(l)) +#define SAVEBOOL(b) save_bool(&(b)) +#define SAVESPTR(s) save_sptr((SV**)&(s)) +#define SAVEPPTR(s) save_pptr((char**)&(s)) +#define SAVEVPTR(s) save_vptr((void*)&(s)) +#define SAVEPADSVANDMORTALIZE(s) save_padsv_and_mortalize(s) +#define SAVEFREESV(s) save_freesv(MUTABLE_SV(s)) +#define SAVEFREEPADNAME(s) save_pushptr((void *)(s), SAVEt_FREEPADNAME) +#define SAVEMORTALIZESV(s) save_mortalizesv(MUTABLE_SV(s)) +#define SAVEFREEOP(o) save_freeop((OP*)(o)) +#define SAVEFREEPV(p) save_freepv((char*)(p)) +#define SAVECLEARSV(sv) save_clearsv((SV**)&(sv)) +#define SAVEGENERICSV(s) save_generic_svref((SV**)&(s)) +#define SAVEGENERICPV(s) save_generic_pvref((char**)&(s)) +#define SAVERCPVFREE(s) save_rcpv_free((char**)&(s)) +#define SAVESHAREDPV(s) save_shared_pvref((char**)&(s)) #define SAVESETSVFLAGS(sv,mask,val) save_set_svflags(sv,mask,val) -#define SAVEFREECOPHH(h) save_pushptr((void *)(h), SAVEt_FREECOPHH) - -#define SAVEDELETE(h,k,l) \ - save_delete(MUTABLE_HV(h), (char*)(k), (I32)(l)) -#define SAVEHDELETE(h,s) \ - save_hdelete(MUTABLE_HV(h), (s)) -#define SAVEADELETE(a,k) \ - save_adelete(MUTABLE_AV(a), (SSize_t)(k)) +#define SAVEFREECOPHH(h) save_pushptr((void *)(h), SAVEt_FREECOPHH) + +#define SAVEDELETE(h,k,l) \ + save_delete(MUTABLE_HV(h), (char*)(k), (I32)(l)) +#define SAVEHDELETE(h,s) \ + save_hdelete(MUTABLE_HV(h), (s)) +#define SAVEADELETE(a,k) \ + save_adelete(MUTABLE_AV(a), (SSize_t)(k)) #define SAVEDESTRUCTOR(f,p) \ - save_destructor((DESTRUCTORFUNC_NOCONTEXT_t)(f), (void*)(p)) + save_destructor((DESTRUCTORFUNC_NOCONTEXT_t)(f), (void*)(p)) -#define SAVEDESTRUCTOR_X(f,p) \ - save_destructor_x((DESTRUCTORFUNC_t)(f), (void*)(p)) +#define SAVEDESTRUCTOR_X(f,p) \ + save_destructor_x((DESTRUCTORFUNC_t)(f), (void*)(p)) -#define SAVESTACK_POS() \ - STMT_START { \ - dSS_ADD; \ - SS_ADD_INT(PL_stack_sp - PL_stack_base); \ - SS_ADD_UV(SAVEt_STACK_POS); \ - SS_ADD_END(2); \ +#define SAVESTACK_POS() \ + STMT_START { \ + dSS_ADD; \ + SS_ADD_INT(PL_stack_sp - PL_stack_base); \ + SS_ADD_UV(SAVEt_STACK_POS); \ + SS_ADD_END(2); \ } STMT_END -#define SAVEOP() save_op() +#define SAVEOP() save_op() -#define SAVEHINTS() save_hints() +#define SAVEHINTS() save_hints() -#define SAVECOMPPAD() save_pushptr(MUTABLE_SV(PL_comppad), SAVEt_COMPPAD) +#define SAVECOMPPAD() save_pushptr(MUTABLE_SV(PL_comppad), SAVEt_COMPPAD) -#define SAVESWITCHSTACK(f,t) \ - STMT_START { \ - save_pushptrptr(MUTABLE_SV(f), MUTABLE_SV(t), SAVEt_SAVESWITCHSTACK); \ - SWITCHSTACK((f),(t)); \ - PL_curstackinfo->si_stack = (t); \ +#define SAVESWITCHSTACK(f,t) \ + STMT_START { \ + save_pushptrptr(MUTABLE_SV(f), MUTABLE_SV(t), SAVEt_SAVESWITCHSTACK); \ + SWITCHSTACK((f),(t)); \ + PL_curstackinfo->si_stack = (t); \ } STMT_END /* Note these are special, we can't just use a save_pushptrptr() on them * as the target might change after a fork or thread start. */ -#define SAVECOMPILEWARNINGS() save_pushptr(PL_compiling.cop_warnings, SAVEt_COMPILE_WARNINGS) -#define SAVECURCOPWARNINGS() save_pushptr(PL_curcop->cop_warnings, SAVEt_CURCOP_WARNINGS) +#define SAVECOMPILEWARNINGS() \ + save_pushptr(PL_compiling.cop_warnings, SAVEt_COMPILE_WARNINGS) +#define SAVECURCOPWARNINGS() \ + save_pushptr(PL_curcop->cop_warnings, SAVEt_CURCOP_WARNINGS) -#define SAVEPARSER(p) save_pushptr((p), SAVEt_PARSER) +#define SAVEPARSER(p) save_pushptr((p), SAVEt_PARSER) #ifdef USE_ITHREADS -# define SAVECOPSTASH_FREE(c) SAVEIV((c)->cop_stashoff) -# define SAVECOPFILE_x(c) SAVEPPTR((c)->cop_file) -# define SAVECOPFILE(c) \ - STMT_START { \ - SAVECOPFILE_x(c); \ - CopFILE_debug((c),"SAVECOPFILE",0); \ - } STMT_END -# define SAVECOPFILE_FREE_x(c) SAVERCPVFREE((c)->cop_file) -# define SAVECOPFILE_FREE(c) \ - STMT_START { \ - SAVECOPFILE_FREE_x(c); \ - CopFILE_debug((c),"SAVECOPFILE_FREE",0); \ - } STMT_END +# define SAVECOPSTASH_FREE(c) SAVEIV((c)->cop_stashoff) +# define SAVECOPFILE_x(c) SAVEPPTR((c)->cop_file) +# define SAVECOPFILE(c) \ + STMT_START { \ + SAVECOPFILE_x(c); \ + CopFILE_debug((c),"SAVECOPFILE",0); \ + } STMT_END +# define SAVECOPFILE_FREE_x(c) SAVERCPVFREE((c)->cop_file) +# define SAVECOPFILE_FREE(c) \ + STMT_START { \ + SAVECOPFILE_FREE_x(c); \ + CopFILE_debug((c),"SAVECOPFILE_FREE",0); \ + } STMT_END #else # /* XXX not refcounted */ -# define SAVECOPSTASH_FREE(c) SAVESPTR(CopSTASH(c)) -# define SAVECOPFILE(c) SAVESPTR(CopFILEGV(c)) -# define SAVECOPFILE_FREE(c) SAVEGENERICSV(CopFILEGV(c)) +# define SAVECOPSTASH_FREE(c) SAVESPTR(CopSTASH(c)) +# define SAVECOPFILE(c) SAVESPTR(CopFILEGV(c)) +# define SAVECOPFILE_FREE(c) SAVEGENERICSV(CopFILEGV(c)) #endif -#define SAVECOPLINE(c) SAVEI32(CopLINE(c)) +#define SAVECOPLINE(c) SAVEI32(CopLINE(c)) /* =for apidoc_section $stack @@ -253,50 +256,54 @@ scope has the given name. C must be a literal string. =for apidoc_item | |SSNEWat|Size_t_size|type|Size_t align =for apidoc_item | |SSNEWt |Size_t size|type -These temporarily allocates data on the savestack, returning an SSize_t index into -the savestack, because a pointer would get broken if the savestack is moved on -reallocation. Use L> to convert the returned index into a pointer. +These temporarily allocates data on the savestack, returning an +SSize_t index into the savestack, because a pointer would get +broken if the savestack is moved on reallocation. Use +L> to convert the returned index into a pointer. The forms differ in that plain C allocates C bytes; -C and C allocate C objects, each of which is type -C; -and and C make sure to align the new data to an C -boundary. The most useful value for the alignment is likely to be -L>. The alignment will be preserved through savestack -reallocation B if realloc returns data aligned to a size divisible by -"align"! +C and C allocate C objects, each of which +is type C; and and C make sure to align +the new data to an C boundary. The most useful value for +the alignment is likely to be L>. The +alignment will be preserved through savestack reallocation B +if realloc returns data aligned to a size divisible by "align"! =for apidoc Am|type |SSPTR |SSize_t index|type =for apidoc_item|type *|SSPTRt|SSize_t index|type -These convert the C returned by L/> and kin into actual pointers. +These convert the C returned by L/> and kin into +actual pointers. -The difference is that C casts the result to C, and C -casts it to a pointer of that C. +The difference is that C casts the result to C, and +C casts it to a pointer of that C. =cut - */ +*/ -#define SSNEW(size) Perl_save_alloc(aTHX_ (size), 0) -#define SSNEWt(n,t) SSNEW((n)*sizeof(t)) -#define SSNEWa(size,align) Perl_save_alloc(aTHX_ (size), \ +#define SSNEW(size) Perl_save_alloc(aTHX_ (size), 0) +#define SSNEWt(n,t) SSNEW((n)*sizeof(t)) +#define SSNEWa(size,align) \ + Perl_save_alloc(aTHX_ (size), \ (I32)(align - ((size_t)((caddr_t)&PL_savestack[PL_savestack_ix]) % align)) % align) -#define SSNEWat(n,t,align) SSNEWa((n)*sizeof(t), align) +#define SSNEWat(n,t,align) SSNEWa((n)*sizeof(t), align) -#define SSPTR(off,type) (assert(sizeof(off) >= sizeof(SSize_t)), (type) ((char*)PL_savestack + off)) -#define SSPTRt(off,type) (assert(sizeof(off) >= sizeof(SSize_t)), (type*) ((char*)PL_savestack + off)) +#define SSPTR(off,type) \ + (assert(sizeof(off) >= sizeof(SSize_t)), (type) ((char*)PL_savestack + off)) +#define SSPTRt(off,type) \ + (assert(sizeof(off) >= sizeof(SSize_t)), (type*) ((char*)PL_savestack + off)) -#define save_freesv(op) save_pushptr((void *)(op), SAVEt_FREESV) -#define save_mortalizesv(op) save_pushptr((void *)(op), SAVEt_MORTALIZESV) +#define save_freesv(op) save_pushptr((void *)(op), SAVEt_FREESV) +#define save_mortalizesv(op) save_pushptr((void *)(op), SAVEt_MORTALIZESV) -# define save_freeop(op) \ -STMT_START { \ - OP * const _o = (OP *)(op); \ - assert(!_o->op_savefree); \ - _o->op_savefree = 1; \ - save_pushptr((void *)(_o), SAVEt_FREEOP); \ - } STMT_END -#define save_freepv(pv) save_pushptr((void *)(pv), SAVEt_FREEPV) +# define save_freeop(op) \ + STMT_START { \ + OP * const _o = (OP *)(op); \ + assert(!_o->op_savefree); \ + _o->op_savefree = 1; \ + save_pushptr((void *)(_o), SAVEt_FREEOP); \ + } STMT_END +#define save_freepv(pv) save_pushptr((void *)(pv), SAVEt_FREEPV) /* =for apidoc_section $callback @@ -305,10 +312,10 @@ STMT_START { \ Implements C. =cut - */ +*/ -#define save_op() save_pushptr((void *)(PL_op), SAVEt_OP) +#define save_op() save_pushptr((void *)(PL_op), SAVEt_OP) /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/sv.h b/sv.h index 28aefd2e8fd2..c3ef8ab29f03 100644 --- a/sv.h +++ b/sv.h @@ -1,23 +1,24 @@ /* sv.h * - * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, - * 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 by Larry Wall and others + * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, + * 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, + * 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021, + * 2022 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * */ #ifdef sv_flags -#undef sv_flags /* Convex has this in for sigvec() */ +#undef sv_flags /* Convex has this in for sigvec() */ #endif /* =for apidoc_section $SV_flags =for apidoc Ay||svtype -An enum of flags for Perl types. These are found in the file F -in the C enum. Test these flags with the C macro. +An enum of flags for Perl types. These are found in the file F in the +C enum. Test these flags with the C macro. The types are: @@ -46,22 +47,21 @@ C is for object instances of the new `use feature 'class'` kind. C is for I/O objects, C for formats, C for subroutines, C for hashes and C for arrays. -All the others are scalar types, that is, things that can be bound to a -C<$> variable. For these, the internal types are mostly orthogonal to -types in the Perl language. +All the others are scalar types, that is, things that can be bound to a C<$> +variable. For these, the internal types are mostly orthogonal to types in the +Perl language. Hence, checking C<< SvTYPE(sv) < SVt_PVAV >> is the best way to see whether something is a scalar. C represents a typeglob. If C, then it is a real, incoercible typeglob. If C, then it is a scalar to which a -typeglob has been assigned. Assigning to it again will stop it from being -a typeglob. C represents a scalar that delegates to another scalar +typeglob has been assigned. Assigning to it again will stop it from being a +typeglob. C represents a scalar that delegates to another scalar behind the scenes. It is used, e.g., for the return value of C and -for tied hash and array elements. It can hold any scalar value, including -a typeglob. C is for regular -expressions. C is for Perl -core internal use only. +for tied hash and array elements. It can hold any scalar value, including a +typeglob. C is for regular expressions. C is for +Perl core internal use only. C represents a "normal" scalar (not a typeglob, regular expression, or delegate). Since most scalars do not need all the internal fields of a @@ -69,12 +69,12 @@ PVMG, we save memory by allocating smaller structs when possible. All the other types are just simpler forms of C, with fewer internal fields. C can only hold undef. C can hold undef, an integer, or a reference. (C is an alias for C, which exists for backward -compatibility.) C can hold undef or a double. (In builds that support +compatibility.) C can hold undef or a double. (In builds that support headless NVs, these could also hold a reference via a suitable offset, in the -same way that SVt_IV does, but this is not currently supported and seems to -be a rare use case.) C can hold C, a string, or a reference. -C is a superset of C and C. C is a -superset of C and C. C can hold anything C +same way that SVt_IV does, but this is not currently supported and seems to be +a rare use case.) C can hold C, a string, or a reference. +C is a superset of C and C. C is a +superset of C and C. C can hold anything C can hold, but it may also be blessed or magical. =for apidoc AmnU||SVt_NULL @@ -138,65 +138,66 @@ Type flag for object instances. See L. typedef enum { - SVt_NULL, /* 0 */ - /* BIND was here, before INVLIST replaced it. */ - SVt_IV, /* 1 */ - SVt_NV, /* 2 */ - /* RV was here, before it was merged with IV. */ - SVt_PV, /* 3 */ - SVt_INVLIST, /* 4, implemented as a PV */ - SVt_PVIV, /* 5 */ - SVt_PVNV, /* 6 */ - SVt_PVMG, /* 7 */ - SVt_REGEXP, /* 8 */ - /* PVBM was here, before BIND replaced it. */ - SVt_PVGV, /* 9 */ - SVt_PVLV, /* 10 */ - SVt_PVAV, /* 11 */ - SVt_PVHV, /* 12 */ - SVt_PVCV, /* 13 */ - SVt_PVFM, /* 14 */ - SVt_PVIO, /* 15 */ + SVt_NULL, /* 0 */ + /* BIND was here, before INVLIST replaced it. */ + SVt_IV, /* 1 */ + SVt_NV, /* 2 */ + /* RV was here, before it was merged with IV. */ + SVt_PV, /* 3 */ + SVt_INVLIST, /* 4, implemented as a PV */ + SVt_PVIV, /* 5 */ + SVt_PVNV, /* 6 */ + SVt_PVMG, /* 7 */ + SVt_REGEXP, /* 8 */ + /* PVBM was here, before BIND replaced it. */ + SVt_PVGV, /* 9 */ + SVt_PVLV, /* 10 */ + SVt_PVAV, /* 11 */ + SVt_PVHV, /* 12 */ + SVt_PVCV, /* 13 */ + SVt_PVFM, /* 14 */ + SVt_PVIO, /* 15 */ SVt_PVOBJ, /* 16 */ - /* 17-31: Unused, though one should be reserved for a - * freed sv, if the other 3 bits below the flags ones - * get allocated */ - SVt_LAST /* keep last in enum. used to size arrays */ + /* 17-31: Unused, though one should be reserved + * for a freed sv, if the other 3 bits below + * the flags ones get allocated */ + SVt_LAST /* keep last in enum. used to size arrays */ } svtype; /* *** any alterations to the SV types above need to be reflected in - * SVt_MASK and the various PL_valid_types_* tables. As of this writing those - * tables are in perl.h. There are also two affected names tables in dump.c, - * one in B.xs, and 'bodies_by_type[]' in sv_inline.h. + * SVt_MASK and the various PL_valid_types_* tables. As of this writing + * those tables are in perl.h. There are also two affected names tables + * in dump.c, one in B.xs, and 'bodies_by_type[]' in sv_inline.h. * - * The bits that match 0xe0 are CURRENTLY UNUSED - * The bits above that are for flags, like SVf_IOK */ + * The bits that match 0xe0 are CURRENTLY UNUSED The bits above that are + * for flags, like SVf_IOK */ -#define SVt_MASK 0x1f /* smallest bitmask that covers all types */ +#define SVt_MASK 0x1f /* smallest bitmask that covers all types */ #ifndef PERL_CORE /* Fast Boyer Moore tables are now stored in magic attached to PVMGs */ -# define SVt_PVBM SVt_PVMG -/* Anything wanting to create a reference from clean should ensure that it has - a scalar of type SVt_IV now: */ -# define SVt_RV SVt_IV +# define SVt_PVBM SVt_PVMG +/* Anything wanting to create a reference from clean should + ensure that it has a scalar of type SVt_IV now: */ +# define SVt_RV SVt_IV #endif -/* The array of arena roots for SV bodies is indexed by SvTYPE. SVt_NULL doesn't - * use a body, so that arena root is re-used for HEs. SVt_IV also doesn't, so - * that arena root is used for HVs with struct xpvhv_aux. */ +/* The array of arena roots for SV bodies is indexed by SvTYPE. SVt_NULL + * doesn't use a body, so that arena root is re-used for HEs. SVt_IV also + * doesn't, so that arena root is used for HVs with struct xpvhv_aux. */ #if defined(PERL_IN_HV_C) || defined(PERL_IN_XS_APITEST) -# define HE_ARENA_ROOT_IX SVt_NULL +# define HE_ARENA_ROOT_IX SVt_NULL #endif #if defined(PERL_IN_HV_C) || defined(PERL_IN_SV_C) -# define HVAUX_ARENA_ROOT_IX SVt_IV +# define HVAUX_ARENA_ROOT_IX SVt_IV #endif #ifdef PERL_IN_SV_C -# define SVt_FIRST SVt_NULL /* the type of SV that new_SV() in sv.c returns */ +# define SVt_FIRST SVt_NULL /* the type of SV that new_SV() + in sv.c returns */ #endif -#define PERL_ARENA_ROOTS_SIZE (SVt_LAST) +#define PERL_ARENA_ROOTS_SIZE (SVt_LAST) /* typedefs to eliminate some typing */ typedef struct he HE; @@ -205,97 +206,98 @@ typedef struct hek HEK; /* Using C's structural equivalence to help emulate C++ inheritance here... */ /* start with 2 sv-head building blocks */ -#define _SV_HEAD(ptrtype) \ - ptrtype sv_any; /* pointer to body */ \ - U32 sv_refcnt; /* how many references to us */ \ - U32 sv_flags /* what we are */ +#define _SV_HEAD(ptrtype) \ + ptrtype sv_any; /* pointer to body */ \ + U32 sv_refcnt; /* how many references to us */ \ + U32 sv_flags /* what we are */ #if NVSIZE <= IVSIZE -# define _NV_BODYLESS_UNION NV svu_nv; +# define _NV_BODYLESS_UNION NV svu_nv; #else # define _NV_BODYLESS_UNION #endif -#define _SV_HEAD_UNION \ - union { \ - char* svu_pv; /* pointer to malloced string */ \ - IV svu_iv; \ - UV svu_uv; \ - _NV_BODYLESS_UNION \ - SV* svu_rv; /* pointer to another SV */ \ - SV** svu_array; \ - HE** svu_hash; \ - GP* svu_gp; \ - PerlIO *svu_fp; \ - } sv_u \ +#define _SV_HEAD_UNION \ + union { \ + char* svu_pv; /* pointer to malloced string */ \ + IV svu_iv; \ + UV svu_uv; \ + _NV_BODYLESS_UNION \ + SV* svu_rv; /* pointer to another SV */ \ + SV** svu_array; \ + HE** svu_hash; \ + GP* svu_gp; \ + PerlIO *svu_fp; \ + } sv_u \ _SV_HEAD_DEBUG #ifdef DEBUG_LEAKING_SCALARS -#define _SV_HEAD_DEBUG ;\ - PERL_BITFIELD32 sv_debug_optype:9; /* the type of OP that allocated us */ \ - PERL_BITFIELD32 sv_debug_inpad:1; /* was allocated in a pad for an OP */ \ - PERL_BITFIELD32 sv_debug_line:16; /* the line where we were allocated */ \ - UV sv_debug_serial; /* serial number of sv allocation */ \ - char * sv_debug_file; /* the file where we were allocated */ \ - SV * sv_debug_parent /* what we were cloned from (ithreads)*/ +#define _SV_HEAD_DEBUG; \ + PERL_BITFIELD32 sv_debug_optype:9; /* the type of OP that allocated us */ \ + PERL_BITFIELD32 sv_debug_inpad:1; /* was allocated in a pad for an OP */ \ + PERL_BITFIELD32 sv_debug_line:16; /* the line where we were allocated */ \ + UV sv_debug_serial; /* serial number of sv allocation */ \ + char * sv_debug_file; /* the file where we were allocated */ \ + SV * sv_debug_parent /* what we were cloned + from (ithreads) */ #else #define _SV_HEAD_DEBUG #endif -struct STRUCT_SV { /* struct sv { */ +struct STRUCT_SV { /* struct sv { */ _SV_HEAD(void*); _SV_HEAD_UNION; }; struct gv { - _SV_HEAD(XPVGV*); /* pointer to xpvgv body */ + _SV_HEAD(XPVGV*); /* pointer to xpvgv body */ _SV_HEAD_UNION; }; struct cv { - _SV_HEAD(XPVCV*); /* pointer to xpvcv body */ + _SV_HEAD(XPVCV*); /* pointer to xpvcv body */ _SV_HEAD_UNION; }; struct av { - _SV_HEAD(XPVAV*); /* pointer to xpvav body */ + _SV_HEAD(XPVAV*); /* pointer to xpvav body */ _SV_HEAD_UNION; }; struct hv { - _SV_HEAD(XPVHV*); /* pointer to xpvhv body */ + _SV_HEAD(XPVHV*); /* pointer to xpvhv body */ _SV_HEAD_UNION; }; struct io { - _SV_HEAD(XPVIO*); /* pointer to xpvio body */ + _SV_HEAD(XPVIO*); /* pointer to xpvio body */ _SV_HEAD_UNION; }; struct p5rx { - _SV_HEAD(struct regexp*); /* pointer to regexp body */ + _SV_HEAD(struct regexp*); /* pointer to regexp body */ _SV_HEAD_UNION; }; struct invlist { - _SV_HEAD(XINVLIST*); /* pointer to xpvinvlist body */ + _SV_HEAD(XINVLIST*); /* pointer to xpvinvlist body */ _SV_HEAD_UNION; }; struct object { - _SV_HEAD(XPVOBJ*); /* pointer to xobject body */ + _SV_HEAD(XPVOBJ*); /* pointer to xobject body */ _SV_HEAD_UNION; }; #undef _SV_HEAD -#undef _SV_HEAD_UNION /* ensure no pollution */ +#undef _SV_HEAD_UNION /* ensure no pollution */ /* =for apidoc_section $SV =for apidoc Am|U32|SvREFCNT|SV* sv -Returns the value of the object's reference count. Exposed -to perl code via Internals::SvREFCNT(). +Returns the value of the object's reference count. Exposed to perl code via +Internals::SvREFCNT(). =for apidoc SvREFCNT_inc =for apidoc_item SvREFCNT_inc_NN @@ -306,8 +308,8 @@ to perl code via Internals::SvREFCNT(). =for apidoc_item SvREFCNT_inc_void =for apidoc_item |void|SvREFCNT_inc_void_NN|SV* sv -These all increment the reference count of the given SV. -The ones without C in their names return the SV. +These all increment the reference count of the given SV. The ones without +C in their names return the SV. C is the base operation; the rest are optimizations if various input constraints are known to be true; hence, all can be replaced with @@ -316,15 +318,15 @@ C. C can only be used if you know C is not C. Since we don't have to check the NULLness, it's faster and smaller. -C can only be used if you don't need the -return value. The macro doesn't need to return a meaningful value. +C can only be used if you don't need the return value. The +macro doesn't need to return a meaningful value. C can only be used if you both don't need the return value, and you know that C is not C. The macro doesn't need to return a meaningful value, or check for NULLness, so it's smaller and faster. -C can only be used with expressions without side -effects. Since we don't have to store a temporary value, it's faster. +C can only be used with expressions without side effects. +Since we don't have to store a temporary value, it's faster. C can only be used with expressions without side effects and you know C is not C. Since we don't have to store a @@ -347,189 +349,184 @@ C may only be used when C is known to not be C. Returns the type of the SV. See C>. =for apidoc Am|void|SvUPGRADE|SV* sv|svtype type -Used to upgrade an SV to a more complex form. Uses C to -perform the upgrade if necessary. See C>. +Used to upgrade an SV to a more complex form. Uses C to perform +the upgrade if necessary. See C>. =cut */ -#define SvANY(sv) (sv)->sv_any -#define SvFLAGS(sv) (sv)->sv_flags -#define SvREFCNT(sv) (sv)->sv_refcnt +#define SvANY(sv) (sv)->sv_any +#define SvFLAGS(sv) (sv)->sv_flags +#define SvREFCNT(sv) (sv)->sv_refcnt -#define SvREFCNT_inc(sv) Perl_SvREFCNT_inc(MUTABLE_SV(sv)) -#define SvREFCNT_inc_simple(sv) SvREFCNT_inc(sv) -#define SvREFCNT_inc_NN(sv) Perl_SvREFCNT_inc_NN(MUTABLE_SV(sv)) -#define SvREFCNT_inc_void(sv) Perl_SvREFCNT_inc_void(MUTABLE_SV(sv)) +#define SvREFCNT_inc(sv) Perl_SvREFCNT_inc(MUTABLE_SV(sv)) +#define SvREFCNT_inc_simple(sv) SvREFCNT_inc(sv) +#define SvREFCNT_inc_NN(sv) Perl_SvREFCNT_inc_NN(MUTABLE_SV(sv)) +#define SvREFCNT_inc_void(sv) Perl_SvREFCNT_inc_void(MUTABLE_SV(sv)) /* These guys don't need the curly blocks */ -#define SvREFCNT_inc_simple_void(sv) \ - STMT_START { \ - SV * sv_ = MUTABLE_SV(sv); \ - if (sv_) \ - SvREFCNT(sv_)++; \ - } STMT_END +#define SvREFCNT_inc_simple_void(sv) \ + STMT_START { \ + SV * sv_ = MUTABLE_SV(sv); \ + if (sv_) \ + SvREFCNT(sv_)++; \ + } STMT_END -#define SvREFCNT_inc_simple_NN(sv) (++(SvREFCNT(sv)),MUTABLE_SV(sv)) -#define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT(MUTABLE_SV(sv))) -#define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT(MUTABLE_SV(sv))) +#define SvREFCNT_inc_simple_NN(sv) (++(SvREFCNT(sv)),MUTABLE_SV(sv)) +#define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT(MUTABLE_SV(sv))) +#define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT(MUTABLE_SV(sv))) -#define SvREFCNT_dec(sv) Perl_SvREFCNT_dec(aTHX_ MUTABLE_SV(sv)) -#define SvREFCNT_dec_NN(sv) Perl_SvREFCNT_dec_NN(aTHX_ MUTABLE_SV(sv)) +#define SvREFCNT_dec(sv) Perl_SvREFCNT_dec(aTHX_ MUTABLE_SV(sv)) +#define SvREFCNT_dec_NN(sv) Perl_SvREFCNT_dec_NN(aTHX_ MUTABLE_SV(sv)) -#define SVTYPEMASK 0xff -#define SvTYPE(sv) ((svtype)((sv)->sv_flags & SVTYPEMASK)) +#define SVTYPEMASK 0xff +#define SvTYPE(sv) ((svtype)((sv)->sv_flags & SVTYPEMASK)) -/* Sadly there are some parts of the core that have pointers to already-freed - SV heads, and rely on being able to tell that they are now free. So mark - them all by using a consistent macro. */ -#define SvIS_FREED(sv) UNLIKELY(((sv)->sv_flags == SVTYPEMASK)) +/* Sadly there are some parts of the core that have pointers to + already-freed SV heads, and rely on being able to tell that they are now + free. So mark them all by using a consistent macro. */ +#define SvIS_FREED(sv) UNLIKELY(((sv)->sv_flags == SVTYPEMASK)) /* this is defined in this peculiar way to avoid compiler warnings. * See the <20121213131428.GD1842@iabyn.com> thread in p5p */ -#define SvUPGRADE(sv, mt) \ +#define SvUPGRADE(sv, mt) \ ((void)(SvTYPE(sv) >= (mt) || (sv_upgrade(sv, mt),1))) -#define SVf_IOK 0x00000100 /* has valid public integer value */ -#define SVf_NOK 0x00000200 /* has valid public numeric value */ -#define SVf_POK 0x00000400 /* has valid public pointer value */ -#define SVf_ROK 0x00000800 /* has a valid reference pointer */ - -#define SVp_IOK 0x00001000 /* has valid non-public integer value */ -#define SVp_NOK 0x00002000 /* has valid non-public numeric value */ -#define SVp_POK 0x00004000 /* has valid non-public pointer value */ -#define SVp_SCREAM 0x00008000 /* currently unused on plain scalars */ -#define SVphv_CLONEABLE SVp_SCREAM /* PVHV (stashes) clone its objects */ -#define SVpgv_GP SVp_SCREAM /* GV has a valid GP */ +#define SVf_IOK 0x00000100 /* has valid public integer value */ +#define SVf_NOK 0x00000200 /* has valid public numeric value */ +#define SVf_POK 0x00000400 /* has valid public pointer value */ +#define SVf_ROK 0x00000800 /* has a valid reference pointer */ + +#define SVp_IOK 0x00001000 /* has valid non-public integer value */ +#define SVp_NOK 0x00002000 /* has valid non-public numeric value */ +#define SVp_POK 0x00004000 /* has valid non-public pointer value */ +#define SVp_SCREAM 0x00008000 /* currently unused on plain scalars */ +#define SVphv_CLONEABLE SVp_SCREAM /* PVHV (stashes) clone its objects */ +#define SVpgv_GP SVp_SCREAM /* GV has a valid GP */ #define SVprv_PCS_IMPORTED SVp_SCREAM /* RV is a proxy for a constant - subroutine in another package. Set the - GvIMPORTED_CV_on() if it needs to be - expanded to a real GV */ - -/* SVf_PROTECT is what SVf_READONLY should have been: i.e. modifying - * this SV is completely illegal. However, SVf_READONLY (via - * Internals::SvREADONLY()) has come to be seen as a flag that can be - * temporarily set and unset by the user to indicate e.g. whether a hash - * is "locked". Now, Hash::Util et al only set SVf_READONLY, while core - * sets both (SVf_READONLY|SVf_PROTECT) to indicate both to core and user - * code that this SV should not be messed with. + subroutine in another package. Set + the GvIMPORTED_CV_on() if it needs + to be expanded to a real GV */ + +/* SVf_PROTECT is what SVf_READONLY should have been: i.e. modifying this SV + * is completely illegal. However, SVf_READONLY (via Internals::SvREADONLY()) + * has come to be seen as a flag that can be temporarily set and unset by the + * user to indicate e.g. whether a hash is "locked". Now, Hash::Util et al + * only set SVf_READONLY, while core sets both (SVf_READONLY|SVf_PROTECT) to + * indicate both to core and user code that this SV should not be messed with. */ -#define SVf_PROTECT 0x00010000 /* very read-only */ -#define SVs_PADTMP 0x00020000 /* in use as tmp */ -#define SVs_PADSTALE 0x00040000 /* lexical has gone out of scope; - only used when !PADTMP */ -#define SVs_TEMP 0x00080000 /* mortal (implies string is stealable) */ -#define SVs_OBJECT 0x00100000 /* is "blessed" */ -#define SVs_GMG 0x00200000 /* has magical get method */ -#define SVs_SMG 0x00400000 /* has magical set method */ -#define SVs_RMG 0x00800000 /* has random magical methods */ - -#define SVf_FAKE 0x01000000 /* 0: glob is just a copy - 1: SV head arena wasn't malloc()ed - 2: For PVCV, whether CvUNIQUE(cv) - refers to an eval or once only - [CvEVAL(cv), CvSPECIAL(cv)] - 3: HV: informally reserved by DAPM - for vtables - 4: Together with other flags (or - lack thereof) indicates a regex, - including PVLV-as-regex. See - isREGEXP(). - */ -#define SVf_OOK 0x02000000 /* has valid offset value */ +#define SVf_PROTECT 0x00010000 /* very read-only */ +#define SVs_PADTMP 0x00020000 /* in use as tmp */ +#define SVs_PADSTALE 0x00040000 /* lexical has gone out of scope; + only used when !PADTMP */ +#define SVs_TEMP 0x00080000 /* mortal (implies string is stealable) */ +#define SVs_OBJECT 0x00100000 /* is "blessed" */ +#define SVs_GMG 0x00200000 /* has magical get method */ +#define SVs_SMG 0x00400000 /* has magical set method */ +#define SVs_RMG 0x00800000 /* has random magical methods */ + +#define SVf_FAKE 0x01000000 /* 0: glob is just a copy 1: SV head arena + wasn't malloc()ed 2: For PVCV, whether + CvUNIQUE(cv) refers to an eval or once + only [CvEVAL(cv), CvSPECIAL(cv)] 3: HV: + informally reserved by DAPM for vtables + 4: Together with other flags (or lack + thereof) indicates a regex, including + PVLV-as-regex. See isREGEXP(). */ +#define SVf_OOK 0x02000000 /* has valid offset value */ #define SVphv_HasAUX SVf_OOK /* PVHV has an additional hv_aux struct */ -#define SVf_BREAK 0x04000000 /* refcnt is artificially low - used by - SVs in final arena cleanup. - Set in S_regtry on PL_reg_curpm, so that - perl_destruct will skip it. - Used for mark and sweep by OP_AASSIGN - */ -#define SVf_READONLY 0x08000000 /* may not be modified */ +#define SVf_BREAK 0x04000000 /* refcnt is artificially low - used by + SVs in final arena cleanup. Set in + S_regtry on PL_reg_curpm, so that + perl_destruct will skip it. Used + for mark and sweep by OP_AASSIGN */ +#define SVf_READONLY 0x08000000 /* may not be modified */ -#define SVf_THINKFIRST (SVf_READONLY|SVf_PROTECT|SVf_ROK|SVf_FAKE \ - |SVs_RMG|SVf_IsCOW) +#define SVf_THINKFIRST \ + (SVf_READONLY|SVf_PROTECT|SVf_ROK|SVf_FAKE |SVs_RMG|SVf_IsCOW) -#define SVf_OK (SVf_IOK|SVf_NOK|SVf_POK|SVf_ROK| \ - SVp_IOK|SVp_NOK|SVp_POK|SVpgv_GP) +#define SVf_OK \ + (SVf_IOK|SVf_NOK|SVf_POK|SVf_ROK| SVp_IOK|SVp_NOK|SVp_POK|SVpgv_GP) -#define PRIVSHIFT 4 /* (SVp_?OK >> PRIVSHIFT) == SVf_?OK */ +#define PRIVSHIFT 4 /* (SVp_?OK >> PRIVSHIFT) == SVf_?OK */ -/* SVf_AMAGIC means that the stash *may* have overload methods. It's - * set each time a function is compiled into a stash, and is reset by the - * overload code when called for the first time and finds that there are - * no overload methods. Note that this used to be set on the object; but - * is now only set on stashes. +/* SVf_AMAGIC means that the stash *may* have overload methods. + * It's set each time a function is compiled into a stash, and is + * reset by the overload code when called for the first time and + * finds that there are no overload methods. Note that this used + * to be set on the object; but is now only set on stashes. */ -#define SVf_AMAGIC 0x10000000 /* has magical overloaded methods */ -#define SVf_IsCOW 0x10000000 /* copy on write (shared hash key if - SvLEN == 0) */ - -/* Ensure this value does not clash with the GV_ADD* flags in gv.h, or the - CV_CKPROTO_* flags in op.c, or the padadd_* flags in pad.h: */ -#define SVf_UTF8 0x20000000 /* SvPV is UTF-8 encoded - This is also set on RVs whose overloaded - stringification is UTF-8. This might - only happen as a side effect of SvPV() */ +#define SVf_AMAGIC 0x10000000 /* has magical overloaded methods */ +#define SVf_IsCOW 0x10000000 /* copy on write (shared hash + key if SvLEN == 0) */ + +/* Ensure this value does not clash with the GV_ADD* flags in gv.h, or + the CV_CKPROTO_* flags in op.c, or the padadd_* flags in pad.h: */ +#define SVf_UTF8 0x20000000 /* SvPV is UTF-8 encoded This is also set + on RVs whose overloaded stringification + is UTF-8. This might only happen as a + side effect of SvPV() */ /* PVHV */ #define SVphv_SHAREKEYS 0x20000000 /* PVHV keys live on shared string table */ -/* PVAV could probably use 0x2000000 without conflict. I assume that PVFM can - be UTF-8 encoded, and PVCVs could well have UTF-8 prototypes. PVIOs haven't - been restructured, so sometimes get used as string buffers. */ +/* PVAV could probably use 0x2000000 without conflict. I assume that PVFM can + be UTF-8 encoded, and PVCVs could well have UTF-8 prototypes. PVIOs + haven't been restructured, so sometimes get used as string buffers. */ /* Some private flags. */ /* scalar SVs with SVp_POK */ -#define SVppv_STATIC 0x40000000 /* PV is pointer to static const; must be set with SVf_IsCOW */ +#define SVppv_STATIC 0x40000000 /* PV is pointer to static const; + must be set with SVf_IsCOW */ /* PVAV */ -#define SVpav_REAL 0x40000000 /* free old entries */ +#define SVpav_REAL 0x40000000 /* free old entries */ /* PVHV */ -#define SVphv_LAZYDEL 0x40000000 /* entry in xhv_eiter must be deleted */ +#define SVphv_LAZYDEL 0x40000000 /* entry in xhv_eiter must be deleted */ -/* IV, PVIV, PVNV, PVMG, PVGV and (I assume) PVLV */ -#define SVf_IVisUV 0x80000000 /* use XPVUV instead of XPVIV */ +/* IV, PVIV, PVNV, PVMG, PVGV and (I assume) PVLV */ +#define SVf_IVisUV 0x80000000 /* use XPVUV instead of XPVIV */ /* PVAV */ -#define SVpav_REIFY 0x80000000 /* can become real */ +#define SVpav_REIFY 0x80000000 /* can become real */ /* PVHV */ -#define SVphv_HASKFLAGS 0x80000000 /* keys have flag byte after hash */ -/* RV upwards. However, SVf_ROK and SVp_IOK are exclusive */ +#define SVphv_HASKFLAGS 0x80000000 /* keys have flag byte after hash */ +/* RV upwards. However, SVf_ROK and SVp_IOK are exclusive */ #define SVprv_WEAKREF 0x80000000 /* Weak reference */ /* pad name vars only */ -#define _XPV_HEAD \ - HV* xmg_stash; /* class package */ \ - union _xmgu xmg_u; \ - STRLEN xpv_cur; /* length of svu_pv as a C string */ \ - union { \ - STRLEN xpvlenu_len; /* allocated size */ \ +#define _XPV_HEAD \ + HV* xmg_stash; /* class package */ \ + union _xmgu xmg_u; \ + STRLEN xpv_cur; /* length of svu_pv as a C string */ \ + union { \ + STRLEN xpvlenu_len; /* allocated size */ \ struct regexp* xpvlenu_rx; /* regex when SV body is XPVLV */ \ } xpv_len_u -#define xpv_len xpv_len_u.xpvlenu_len +#define xpv_len xpv_len_u.xpvlenu_len union _xnvu { - NV xnv_nv; /* numeric value, if any */ - HV * xgv_stash; - line_t xnv_lines; /* used internally by S_scan_subst() */ - bool xnv_bm_tail; /* an SvVALID (BM) SV has an implicit "\n" */ + NV xnv_nv; /* numeric value, if any */ + HV *xgv_stash; + line_t xnv_lines; /* used internally by S_scan_subst() */ + bool xnv_bm_tail; /* an SvVALID (BM) SV has an implicit "\n" */ }; union _xivu { - IV xivu_iv; /* integer value */ - UV xivu_uv; - HEK * xivu_namehek; /* xpvlv, xpvgv: GvNAME */ - bool xivu_eval_seen; /* used internally by S_scan_subst() */ + IV xivu_iv; /* integer value */ + UV xivu_uv; + HEK *xivu_namehek; /* xpvlv, xpvgv: GvNAME */ + bool xivu_eval_seen; /* used internally by S_scan_subst() */ }; union _xmgu { - MAGIC* xmg_magic; /* linked list of magicalness */ - STRLEN xmg_hash_index; /* used while freeing hash entries */ + MAGIC *xmg_magic; /* linked list of magicalness */ + STRLEN xmg_hash_index; /* used while freeing hash entries */ }; struct xpv { @@ -541,14 +538,14 @@ struct xpviv { union _xivu xiv_u; }; -#define xiv_iv xiv_u.xivu_iv +#define xiv_iv xiv_u.xivu_iv struct xpvuv { _XPV_HEAD; union _xivu xuv_u; }; -#define xuv_uv xuv_u.xivu_uv +#define xuv_uv xuv_u.xivu_uv struct xpvnv { _XPV_HEAD; @@ -568,29 +565,29 @@ struct xpvlv { union _xivu xiv_u; union _xnvu xnv_u; union { - STRLEN xlvu_targoff; + STRLEN xlvu_targoff; SSize_t xlvu_stargoff; - } xlv_targoff_u; - STRLEN xlv_targlen; - SV* xlv_targ; - char xlv_type; /* k=keys .=pos x=substr v=vec /=join/re + } xlv_targoff_u; + STRLEN xlv_targlen; + SV *xlv_targ; + char xlv_type; /* k=keys .=pos x=substr v=vec /=join/re * y=alem/helem/iter t=tie T=tied HE */ - char xlv_flags; /* 1 = negative offset 2 = negative len - 4 = out of range (vec) */ + char xlv_flags; /* 1 = negative offset 2 = negative + len 4 = out of range (vec) */ }; -#define xlv_targoff xlv_targoff_u.xlvu_targoff +#define xlv_targoff xlv_targoff_u.xlvu_targoff struct xpvinvlist { _XPV_HEAD; - IV prev_index; /* caches result of previous invlist_search() */ - STRLEN iterator; /* Stores where we are in iterating */ - bool is_offset; /* The data structure for all inversion lists - begins with an element for code point U+0000. - If this bool is set, the actual list contains - that 0; otherwise, the list actually begins - with the following element. Thus to invert - the list, merely toggle this flag */ + IV prev_index; /* caches result of previous invlist_search() */ + STRLEN iterator; /* Stores where we are in iterating */ + bool is_offset; /* The data structure for all inversion lists + begins with an element for code point U+0000. + If this bool is set, the actual list contains + that 0; otherwise, the list actually begins + with the following element. Thus to invert + the list, merely toggle this flag */ }; /* This structure works in 2 ways - regular scalar, or GV with GP */ @@ -603,31 +600,31 @@ struct xpvgv { typedef U32 cv_flags_t; -#define _XPVCV_COMMON \ - HV * xcv_stash; \ - union { \ - OP * xcv_start; \ - ANY xcv_xsubany; \ - } xcv_start_u; \ - union { \ - OP * xcv_root; \ - void (*xcv_xsub) (pTHX_ CV*); \ - } xcv_root_u; \ - union { \ - GV * xcv_gv; \ - HEK * xcv_hek; \ - } xcv_gv_u; \ - char * xcv_file; \ - union { \ - PADLIST * xcv_padlist; \ - void * xcv_hscxt; \ - } xcv_padlist_u; \ - CV * xcv_outside; \ - U32 xcv_outside_seq; /* the COP sequence (at the point of our \ - * compilation) in the lexically enclosing \ - * sub */ \ - cv_flags_t xcv_flags; \ - I32 xcv_depth /* >= 2 indicates recursive call */ +#define _XPVCV_COMMON \ + HV * xcv_stash; \ + union { \ + OP * xcv_start; \ + ANY xcv_xsubany; \ + } xcv_start_u; \ + union { \ + OP * xcv_root; \ + void (*xcv_xsub) (pTHX_ CV*); \ + } xcv_root_u; \ + union { \ + GV * xcv_gv; \ + HEK * xcv_hek; \ + } xcv_gv_u; \ + char * xcv_file; \ + union { \ + PADLIST * xcv_padlist; \ + void * xcv_hscxt; \ + } xcv_padlist_u; \ + CV * xcv_outside; \ + U32 xcv_outside_seq; /* the COP sequence (at the point \ + * of our compilation) in the \ + * lexically enclosing sub */ \ + cv_flags_t xcv_flags; \ + I32 xcv_depth /* >= 2 indicates recursive call */ /* This structure must match XPVCV in cv.h */ @@ -641,59 +638,59 @@ struct xpvio { _XPV_HEAD; union _xivu xiv_u; /* ifp and ofp are normally the same, but sockets need separate streams */ - PerlIO * xio_ofp; - /* Cray addresses everything by word boundaries (64 bits) and - * code and data pointers cannot be mixed (which is exactly what - * Perl_filter_add() tries to do with the dirp), hence the - * following union trick (as suggested by Gurusamy Sarathy). - * For further information see Geir Johansen's problem report - * titled [ID 20000612.002 (#3366)] Perl problem on Cray system - * The any pointer (known as IoANY()) will also be a good place - * to hang any IO disciplines to. + PerlIO *xio_ofp; + /* Cray addresses everything by word boundaries (64 bits) and code and + * data pointers cannot be mixed (which is exactly what Perl_filter_add() + * tries to do with the dirp), hence the following union trick (as + * suggested by Gurusamy Sarathy). For further information see Geir + * Johansen's problem report titled [ID 20000612.002 (#3366)] Perl + * problem on Cray system The any pointer (known as IoANY()) will also be + * a good place to hang any IO disciplines to. */ union { - DIR * xiou_dirp; /* for opendir, readdir, etc */ - void * xiou_any; /* for alignment */ - } xio_dirpu; - /* IV xio_lines is now in IVX $. */ - IV xio_page; /* $% */ - IV xio_page_len; /* $= */ - IV xio_lines_left; /* $- */ - char * xio_top_name; /* $^ */ - GV * xio_top_gv; /* $^ */ - char * xio_fmt_name; /* $~ */ - GV * xio_fmt_gv; /* $~ */ - char * xio_bottom_name;/* $^B */ - GV * xio_bottom_gv; /* $^B */ - char xio_type; - U8 xio_flags; + DIR *xiou_dirp; /* for opendir, readdir, etc */ + void *xiou_any; /* for alignment */ + } xio_dirpu; + /* IV xio_lines is now in IVX $. */ + IV xio_page; /* $% */ + IV xio_page_len; /* $= */ + IV xio_lines_left; /* $- */ + char *xio_top_name; /* $^ */ + GV *xio_top_gv; /* $^ */ + char *xio_fmt_name; /* $~ */ + GV *xio_fmt_gv; /* $~ */ + char *xio_bottom_name; /* $^B */ + GV *xio_bottom_gv; /* $^B */ + char xio_type; + U8 xio_flags; }; -#define xio_dirp xio_dirpu.xiou_dirp -#define xio_any xio_dirpu.xiou_any +#define xio_dirp xio_dirpu.xiou_dirp +#define xio_any xio_dirpu.xiou_any -#define IOf_ARGV 1 /* this fp iterates over ARGV */ -#define IOf_START 2 /* check for null ARGV and substitute '-' */ -#define IOf_FLUSH 4 /* this fp wants a flush after write op */ -#define IOf_DIDTOP 8 /* just did top of form */ -#define IOf_UNTAINT 16 /* consider this fp (and its data) "safe" */ -#define IOf_NOLINE 32 /* slurped a pseudo-line from empty file */ -#define IOf_FAKE_DIRP 64 /* xio_dirp is fake (source filters kludge) - Also, when this is set, SvPVX() is valid */ +#define IOf_ARGV 1 /* this fp iterates over ARGV */ +#define IOf_START 2 /* check for null ARGV and substitute '-' */ +#define IOf_FLUSH 4 /* this fp wants a flush after write op */ +#define IOf_DIDTOP 8 /* just did top of form */ +#define IOf_UNTAINT 16 /* consider this fp (and its data) "safe" */ +#define IOf_NOLINE 32 /* slurped a pseudo-line from empty file */ +#define IOf_FAKE_DIRP 64 /* xio_dirp is fake (source filters kludge) Also, + when this is set, SvPVX() is valid */ struct xobject { - HV* xmg_stash; + HV *xmg_stash; union _xmgu xmg_u; SSize_t xobject_maxfield; SSize_t xobject_iter_sv_at; /* this is only used by Perl_sv_clear() */ - SV** xobject_fields; + SV **xobject_fields; }; -#define ObjectMAXFIELD(inst) ((XPVOBJ *)SvANY(inst))->xobject_maxfield -#define ObjectITERSVAT(inst) ((XPVOBJ *)SvANY(inst))->xobject_iter_sv_at -#define ObjectFIELDS(inst) ((XPVOBJ *)SvANY(inst))->xobject_fields +#define ObjectMAXFIELD(inst) ((XPVOBJ *)SvANY(inst))->xobject_maxfield +#define ObjectITERSVAT(inst) ((XPVOBJ *)SvANY(inst))->xobject_iter_sv_at +#define ObjectFIELDS(inst) ((XPVOBJ *)SvANY(inst))->xobject_fields -/* The following macros define implementation-independent predicates on SVs. */ +/* The following macros define implementation-independent + predicates on SVs. */ /* =for apidoc Am|U32|SvNIOK|SV* sv @@ -708,12 +705,12 @@ double. Checks the B setting. Use C instead. Unsets the NV/IV status of an SV. =for apidoc Am|U32|SvOK|SV* sv -Returns a U32 value indicating whether the value is defined. This is -only meaningful for scalars. +Returns a U32 value indicating whether the value is defined. This is only +meaningful for scalars. =for apidoc Am|U32|SvIOKp|SV* sv -Returns a U32 value indicating whether the SV contains an integer. Checks -the B setting. Use C instead. +Returns a U32 value indicating whether the SV contains an integer. Checks the +B setting. Use C instead. =for apidoc Am|U32|SvNOKp|SV* sv Returns a U32 value indicating whether the SV contains a double. Checks the @@ -764,8 +761,7 @@ Unsets the NV status of an SV. Tells an SV that it is a double and disables all other OK bits. =for apidoc Am|U32|SvPOK|SV* sv -Returns a U32 value indicating whether the SV contains a character -string. +Returns a U32 value indicating whether the SV contains a character string. =for apidoc Am|void|SvPOK_on|SV* sv Tells an SV that it is a string. @@ -774,57 +770,52 @@ Tells an SV that it is a string. Unsets the PV status of an SV. =for apidoc Am|void|SvPOK_only|SV* sv -Tells an SV that it is a string and disables all other C bits. -Will also turn off the UTF-8 status. +Tells an SV that it is a string and disables all other C bits. Will also +turn off the UTF-8 status. =for apidoc Am|U32|SvBoolFlagsOK|SV* sv -Returns a bool indicating whether the SV has the right flags set such -that it is safe to call C or -C or -C. Currently equivalent to -C or C. Serialization may want to -unroll this check. If so you are strongly recommended to add code like -C B calling using any of the -BOOL_INTERNALS macros. +Returns a bool indicating whether the SV has the right flags set such that it +is safe to call C or +C or C. +Currently equivalent to C or C. +Serialization may want to unroll this check. If so you are strongly +recommended to add code like C B calling +using any of the BOOL_INTERNALS macros. =for apidoc Am|U32|SvIandPOK|SV* sv -Returns a bool indicating whether the SV is both C and -C at the same time. Equivalent to C but -more efficient. +Returns a bool indicating whether the SV is both C and C at +the same time. Equivalent to C but more efficient. =for apidoc Am|void|SvIandPOK_on|SV* sv -Tells an SV that is a string and a number in one operation. Equivalent -to C but more efficient. +Tells an SV that is a string and a number in one operation. Equivalent to +C but more efficient. =for apidoc Am|void|SvIandPOK_off|SV* sv -Unsets the PV and IV status of an SV in one operation. Equivalent to +Unsets the PV and IV status of an SV in one operation. Equivalent to C but more efficient. =for apidoc Am|bool|BOOL_INTERNALS_sv_isbool|SV* sv -Checks if a C sv is a bool. B that it is the -caller's responsibility to ensure that the sv is C before -calling this. This is only useful in specialized logic like -serialization code where performance is critical and the flags have -already been checked to be correct. Almost always you should be using -C instead. +Checks if a C sv is a bool. B that it is the caller's +responsibility to ensure that the sv is C before calling +this. This is only useful in specialized logic like serialization code where +performance is critical and the flags have already been checked to be +correct. Almost always you should be using C instead. =for apidoc Am|bool|BOOL_INTERNALS_sv_isbool_true|SV* sv -Checks if a C sv is a true bool. B that it is -the caller's responsibility to ensure that the sv is C -before calling this. This is only useful in specialized logic like -serialization code where performance is critical and the flags have -already been checked to be correct. This is B what you should use -to check if an SV is "true", for that you should be using -C instead. +Checks if a C sv is a true bool. B that it is the +caller's responsibility to ensure that the sv is C before +calling this. This is only useful in specialized logic like serialization +code where performance is critical and the flags have already been checked to +be correct. This is B what you should use to check if an SV is "true", +for that you should be using C instead. =for apidoc Am|bool|BOOL_INTERNALS_sv_isbool_false|SV* sv -Checks if a C sv is a false bool. B that it is -the caller's responsibility to ensure that the sv is C -before calling this. This is only useful in specialized logic like -serialization code where performance is critical and the flags have -already been checked to be correct. This is B what you should use -to check if an SV is "false", for that you should be using -C instead. +Checks if a C sv is a false bool. B that it is the +caller's responsibility to ensure that the sv is C before +calling this. This is only useful in specialized logic like serialization +code where performance is critical and the flags have already been checked to +be correct. This is B what you should use to check if an SV is "false", +for that you should be using C instead. =for apidoc Am|bool|SvVOK|SV* sv Returns a boolean indicating whether the SV contains a v-string. @@ -869,8 +860,8 @@ Only use when you are sure C is true. See also C>. =for apidoc_item |char* |SvPVX_mutable|SV* sv =for apidoc_item |char* |SvPVXx|SV* sv -These return a pointer to the physical string in the SV. The SV must contain a -string. Prior to 5.9.3 it is not safe to execute these unless the SV's +These return a pointer to the physical string in the SV. The SV must contain +a string. Prior to 5.9.3 it is not safe to execute these unless the SV's type >= C. These are also used to store the name of an autoloaded subroutine in an XS @@ -878,39 +869,39 @@ AUTOLOAD routine. See L. C is identical to C. -C is merely a synonym for C, but its name emphasizes that -the string is modifiable by the caller. +C is merely a synonym for C, but its name emphasizes +that the string is modifiable by the caller. C differs in that the return value has been cast so that the -compiler will complain if you were to try to modify the contents of the string, -(unless you cast away const yourself). +compiler will complain if you were to try to modify the contents of the +string, (unless you cast away const yourself). =for apidoc Am|STRLEN|SvCUR|SV* sv -Returns the length, in bytes, of the PV inside the SV. -Note that this may not match Perl's C; for that, use -C. See C> also. +Returns the length, in bytes, of the PV inside the SV. Note that this may not +match Perl's C; for that, use C. See C> +also. =for apidoc Am|STRLEN|SvLEN|SV* sv Returns the size of the string buffer in the SV, not including any part attributable to C. See C>. =for apidoc Am|char*|SvEND|SV* sv -Returns a pointer to the spot just after the last character in -the string which is in the SV, where there is usually a trailing -C character (even though Perl scalars do not strictly require it). -See C>. Access the character as C<*(SvEND(sv))>. +Returns a pointer to the spot just after the last character in the string +which is in the SV, where there is usually a trailing C character (even +though Perl scalars do not strictly require it). See C>. Access +the character as C<*(SvEND(sv))>. -Warning: If C is equal to C, then C points to -unallocated memory. +Warning: If C is equal to C, then C points to unallocated +memory. =for apidoc Am|HV*|SvSTASH|SV* sv Returns the stash of the SV. =for apidoc Am|void|SvIV_set|SV* sv|IV val -Set the value of the IV pointer in sv to val. It is possible to perform -the same function of this macro with an lvalue assignment to C. -With future Perls, however, it will be more efficient to use -C instead of the lvalue assignment to C. +Set the value of the IV pointer in sv to val. It is possible to perform the +same function of this macro with an lvalue assignment to C. With +future Perls, however, it will be more efficient to use C instead of +the lvalue assignment to C. =for apidoc Am|void|SvNV_set|SV* sv|NV val Set the value of the NV pointer in C to val. See C>. @@ -922,12 +913,12 @@ L or L or L. Set the value of the PV pointer in C to the Perl allocated C-terminated string C. See also C>. -Remember to free the previous PV buffer. There are many things to check. +Remember to free the previous PV buffer. There are many things to check. Beware that the existing pointer may be involved in copy-on-write or other -mischief, so do C and use C or -C (or check the C flag) first to make sure this -modification is safe. Then finally, if it is not a COW, call -C> to free the previous PV buffer. +mischief, so do C and use C or C +(or check the C flag) first to make sure this modification is safe. +Then finally, if it is not a COW, call C> to free the previous +PV buffer. =for apidoc Am|void|SvUV_set|SV* sv|UV val Set the value of the UV pointer in C to val. See C>. @@ -942,82 +933,93 @@ Set the value of the MAGIC pointer in C to val. See C>. Set the value of the STASH pointer in C to val. See C>. =for apidoc Am|void|SvCUR_set|SV* sv|STRLEN len -Sets the current length, in bytes, of the C string which is in the SV. -See C> and C>. +Sets the current length, in bytes, of the C string which is in the SV. See +C> and C>. =for apidoc Am|void|SvLEN_set|SV* sv|STRLEN len -Set the size of the string buffer for the SV. See C>. +Set the size of the string buffer for the SV. See C>. =cut */ -#define SvNIOK(sv) (SvFLAGS(sv) & (SVf_IOK|SVf_NOK)) -#define SvNIOKp(sv) (SvFLAGS(sv) & (SVp_IOK|SVp_NOK)) -#define SvNIOK_off(sv) (SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK| \ - SVp_IOK|SVp_NOK|SVf_IVisUV)) - -#define assert_not_ROK(sv) assert_(!SvROK(sv) || !SvRV(sv)) -#define assert_not_glob(sv) assert_(!isGV_with_GP(sv)) - -#define SvOK(sv) (SvFLAGS(sv) & SVf_OK) -#define SvOK_off(sv) (assert_not_ROK(sv) assert_not_glob(sv) \ - SvFLAGS(sv) &= ~(SVf_OK| \ - SVf_IVisUV|SVf_UTF8), \ - SvOOK_off(sv)) -#define SvOK_off_exc_UV(sv) (assert_not_ROK(sv) \ - SvFLAGS(sv) &= ~(SVf_OK| \ - SVf_UTF8), \ - SvOOK_off(sv)) - -#define SvOKp(sv) (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) -#define SvIOKp(sv) (SvFLAGS(sv) & SVp_IOK) -#define SvIOKp_on(sv) (assert_not_glob(sv) \ - SvFLAGS(sv) |= SVp_IOK) -#define SvNOKp(sv) (SvFLAGS(sv) & SVp_NOK) -#define SvNOKp_on(sv) (assert_not_glob(sv) SvFLAGS(sv) |= SVp_NOK) -#define SvPOKp(sv) (SvFLAGS(sv) & SVp_POK) -#define SvPOKp_on(sv) (assert_not_ROK(sv) assert_not_glob(sv) \ - SvFLAGS(sv) |= SVp_POK) - -#define SvIOK(sv) (SvFLAGS(sv) & SVf_IOK) -#define SvIOK_on(sv) (assert_not_glob(sv) \ - SvFLAGS(sv) |= (SVf_IOK|SVp_IOK)) -#define SvIOK_off(sv) (SvFLAGS(sv) &= ~(SVf_IOK|SVp_IOK|SVf_IVisUV)) -#define SvIOK_only(sv) (SvOK_off(sv), \ - SvFLAGS(sv) |= (SVf_IOK|SVp_IOK)) -#define SvIOK_only_UV(sv) (assert_not_glob(sv) SvOK_off_exc_UV(sv), \ - SvFLAGS(sv) |= (SVf_IOK|SVp_IOK)) - -#define SvIOK_UV(sv) ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV)) \ - == (SVf_IOK|SVf_IVisUV)) -#define SvUOK(sv) SvIOK_UV(sv) -#define SvIOK_notUV(sv) ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV)) \ - == SVf_IOK) - -#define SvIandPOK(sv) ((SvFLAGS(sv) & (SVf_IOK|SVf_POK)) == (SVf_IOK|SVf_POK)) -#define SvIandPOK_on(sv) (assert_not_glob(sv) \ - (SvFLAGS(sv) |= (SVf_IOK|SVp_IOK|SVf_POK|SVp_POK))) -#define SvIandPOK_off(sv) (SvFLAGS(sv) &= ~(SVf_IOK|SVp_IOK|SVf_IVisUV|SVf_POK|SVp_POK)) - -#define SvBoolFlagsOK(sv) SvIandPOK(sv) - -#define BOOL_INTERNALS_sv_isbool(sv) (SvIsCOW_static(sv) && \ +#define SvNIOK(sv) (SvFLAGS(sv) & (SVf_IOK|SVf_NOK)) +#define SvNIOKp(sv) (SvFLAGS(sv) & (SVp_IOK|SVp_NOK)) +#define SvNIOK_off(sv) \ + (SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK| SVp_IOK|SVp_NOK|SVf_IVisUV)) + +#define assert_not_ROK(sv) assert_(!SvROK(sv) || !SvRV(sv)) +#define assert_not_glob(sv) assert_(!isGV_with_GP(sv)) + +#define SvOK(sv) (SvFLAGS(sv) & SVf_OK) +#define SvOK_off(sv) \ + (assert_not_ROK(sv) assert_not_glob(sv) \ + SvFLAGS(sv) &= ~(SVf_OK| \ + SVf_IVisUV|SVf_UTF8), \ + SvOOK_off(sv)) +#define SvOK_off_exc_UV(sv) \ + (assert_not_ROK(sv) \ + SvFLAGS(sv) &= ~(SVf_OK| \ + SVf_UTF8), \ + SvOOK_off(sv)) + +#define SvOKp(sv) (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) +#define SvIOKp(sv) (SvFLAGS(sv) & SVp_IOK) +#define SvIOKp_on(sv) \ + (assert_not_glob(sv) \ + SvFLAGS(sv) |= SVp_IOK) +#define SvNOKp(sv) (SvFLAGS(sv) & SVp_NOK) +#define SvNOKp_on(sv) (assert_not_glob(sv) SvFLAGS(sv) |= SVp_NOK) +#define SvPOKp(sv) (SvFLAGS(sv) & SVp_POK) +#define SvPOKp_on(sv) \ + (assert_not_ROK(sv) assert_not_glob(sv) \ + SvFLAGS(sv) |= SVp_POK) + +#define SvIOK(sv) (SvFLAGS(sv) & SVf_IOK) +#define SvIOK_on(sv) \ + (assert_not_glob(sv) \ + SvFLAGS(sv) |= (SVf_IOK|SVp_IOK)) +#define SvIOK_off(sv) (SvFLAGS(sv) &= ~(SVf_IOK|SVp_IOK|SVf_IVisUV)) +#define SvIOK_only(sv) \ + (SvOK_off(sv), SvFLAGS(sv) |= (SVf_IOK|SVp_IOK)) +#define SvIOK_only_UV(sv) \ + (assert_not_glob(sv) SvOK_off_exc_UV(sv), \ + SvFLAGS(sv) |= (SVf_IOK|SVp_IOK)) + +#define SvIOK_UV(sv) \ + ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV)) == (SVf_IOK|SVf_IVisUV)) +#define SvUOK(sv) SvIOK_UV(sv) +#define SvIOK_notUV(sv) \ + ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV)) == SVf_IOK) + +#define SvIandPOK(sv) \ + ((SvFLAGS(sv) & (SVf_IOK|SVf_POK)) == (SVf_IOK|SVf_POK)) +#define SvIandPOK_on(sv) \ + (assert_not_glob(sv) \ + (SvFLAGS(sv) |= (SVf_IOK|SVp_IOK|SVf_POK|SVp_POK))) +#define SvIandPOK_off(sv) \ + (SvFLAGS(sv) &= ~(SVf_IOK|SVp_IOK|SVf_IVisUV|SVf_POK|SVp_POK)) + +#define SvBoolFlagsOK(sv) SvIandPOK(sv) + +#define BOOL_INTERNALS_sv_isbool(sv) \ + (SvIsCOW_static(sv) && \ (SvPVX_const(sv) == PL_Yes || SvPVX_const(sv) == PL_No)) -#define BOOL_INTERNALS_sv_isbool_true(sv) (SvIsCOW_static(sv) && \ - (SvPVX_const(sv) == PL_Yes)) -#define BOOL_INTERNALS_sv_isbool_false(sv) (SvIsCOW_static(sv) && \ - (SvPVX_const(sv) == PL_No)) - -#define SvIsUV(sv) (SvFLAGS(sv) & SVf_IVisUV) -#define SvIsUV_on(sv) (SvFLAGS(sv) |= SVf_IVisUV) -#define SvIsUV_off(sv) (SvFLAGS(sv) &= ~SVf_IVisUV) - -#define SvNOK(sv) (SvFLAGS(sv) & SVf_NOK) -#define SvNOK_on(sv) (assert_not_glob(sv) \ - SvFLAGS(sv) |= (SVf_NOK|SVp_NOK)) -#define SvNOK_off(sv) (SvFLAGS(sv) &= ~(SVf_NOK|SVp_NOK)) -#define SvNOK_only(sv) (SvOK_off(sv), \ - SvFLAGS(sv) |= (SVf_NOK|SVp_NOK)) +#define BOOL_INTERNALS_sv_isbool_true(sv) \ + (SvIsCOW_static(sv) && (SvPVX_const(sv) == PL_Yes)) +#define BOOL_INTERNALS_sv_isbool_false(sv) \ + (SvIsCOW_static(sv) && (SvPVX_const(sv) == PL_No)) + +#define SvIsUV(sv) (SvFLAGS(sv) & SVf_IVisUV) +#define SvIsUV_on(sv) (SvFLAGS(sv) |= SVf_IVisUV) +#define SvIsUV_off(sv) (SvFLAGS(sv) &= ~SVf_IVisUV) + +#define SvNOK(sv) (SvFLAGS(sv) & SVf_NOK) +#define SvNOK_on(sv) \ + (assert_not_glob(sv) \ + SvFLAGS(sv) |= (SVf_NOK|SVp_NOK)) +#define SvNOK_off(sv) (SvFLAGS(sv) &= ~(SVf_NOK|SVp_NOK)) +#define SvNOK_only(sv) \ + (SvOK_off(sv), SvFLAGS(sv) |= (SVf_NOK|SVp_NOK)) /* =for apidoc Am|U32|SvUTF8|SV* sv @@ -1030,41 +1032,44 @@ If you want to take into account the L pragma, use C> instead. =for apidoc Am|void|SvUTF8_on|SV *sv -Turn on the UTF-8 status of an SV (the data is not changed, just the flag). -Do not use frivolously. +Turn on the UTF-8 status of an SV (the data is not changed, just the flag). Do +not use frivolously. =for apidoc Am|void|SvUTF8_off|SV *sv -Unsets the UTF-8 status of an SV (the data is not changed, just the flag). -Do not use frivolously. +Unsets the UTF-8 status of an SV (the data is not changed, just the flag). Do +not use frivolously. =for apidoc Am|void|SvPOK_only_UTF8|SV* sv -Tells an SV that it is a string and disables all other C bits, -and leaves the UTF-8 status as it was. +Tells an SV that it is a string and disables all other C bits, and leaves +the UTF-8 status as it was. =cut - */ +*/ -/* Ensure the return value of this macro does not clash with the GV_ADD* flags -in gv.h: */ -#define SvUTF8(sv) (SvFLAGS(sv) & SVf_UTF8) -#define SvUTF8_on(sv) (SvFLAGS(sv) |= (SVf_UTF8)) -#define SvUTF8_off(sv) (SvFLAGS(sv) &= ~(SVf_UTF8)) - -#define SvPOK(sv) (SvFLAGS(sv) & SVf_POK) -#define SvPOK_on(sv) (assert_not_ROK(sv) assert_not_glob(sv) \ - SvFLAGS(sv) |= (SVf_POK|SVp_POK)) -#define SvPOK_off(sv) (SvFLAGS(sv) &= ~(SVf_POK|SVp_POK)) -#define SvPOK_only(sv) (assert_not_ROK(sv) assert_not_glob(sv) \ - SvFLAGS(sv) &= ~(SVf_OK| \ - SVf_IVisUV|SVf_UTF8), \ - SvFLAGS(sv) |= (SVf_POK|SVp_POK)) -#define SvPOK_only_UTF8(sv) (assert_not_ROK(sv) assert_not_glob(sv) \ - SvFLAGS(sv) &= ~(SVf_OK| \ - SVf_IVisUV), \ - SvFLAGS(sv) |= (SVf_POK|SVp_POK)) - -#define SvVOK(sv) (SvMAGICAL(sv) \ - && mg_find(sv,PERL_MAGIC_vstring)) +/* Ensure the return value of this macro does not + clash with the GV_ADD* flags in gv.h: */ +#define SvUTF8(sv) (SvFLAGS(sv) & SVf_UTF8) +#define SvUTF8_on(sv) (SvFLAGS(sv) |= (SVf_UTF8)) +#define SvUTF8_off(sv) (SvFLAGS(sv) &= ~(SVf_UTF8)) + +#define SvPOK(sv) (SvFLAGS(sv) & SVf_POK) +#define SvPOK_on(sv) \ + (assert_not_ROK(sv) assert_not_glob(sv) \ + SvFLAGS(sv) |= (SVf_POK|SVp_POK)) +#define SvPOK_off(sv) (SvFLAGS(sv) &= ~(SVf_POK|SVp_POK)) +#define SvPOK_only(sv) \ + (assert_not_ROK(sv) assert_not_glob(sv) \ + SvFLAGS(sv) &= ~(SVf_OK| \ + SVf_IVisUV|SVf_UTF8), \ + SvFLAGS(sv) |= (SVf_POK|SVp_POK)) +#define SvPOK_only_UTF8(sv) \ + (assert_not_ROK(sv) assert_not_glob(sv) \ + SvFLAGS(sv) &= ~(SVf_OK| \ + SVf_IVisUV), \ + SvFLAGS(sv) |= (SVf_POK|SVp_POK)) + +#define SvVOK(sv) \ + (SvMAGICAL(sv) && mg_find(sv,PERL_MAGIC_vstring)) /* =for apidoc Am|MAGIC*|SvVSTRING_mg|SV * sv @@ -1072,11 +1077,11 @@ Returns the vstring magic, or NULL if none =cut */ -#define SvVSTRING_mg(sv) (SvMAGICAL(sv) \ - ? mg_find(sv,PERL_MAGIC_vstring) : NULL) +#define SvVSTRING_mg(sv) \ + (SvMAGICAL(sv) ? mg_find(sv,PERL_MAGIC_vstring) : NULL) -#define SvOOK(sv) (SvFLAGS(sv) & SVf_OOK) -#define SvOOK_on(sv) (SvFLAGS(sv) |= SVf_OOK) +#define SvOOK(sv) (SvFLAGS(sv) & SVf_OOK) +#define SvOOK_on(sv) (SvFLAGS(sv) |= SVf_OOK) /* @@ -1087,74 +1092,84 @@ Remove any string offset. =cut */ -#define SvOOK_off(sv) ((void)(SvOOK(sv) && (sv_backoff(sv),0))) +#define SvOOK_off(sv) ((void)(SvOOK(sv) && (sv_backoff(sv),0))) -#define SvFAKE(sv) (SvFLAGS(sv) & SVf_FAKE) -#define SvFAKE_on(sv) (SvFLAGS(sv) |= SVf_FAKE) -#define SvFAKE_off(sv) (SvFLAGS(sv) &= ~SVf_FAKE) +#define SvFAKE(sv) (SvFLAGS(sv) & SVf_FAKE) +#define SvFAKE_on(sv) (SvFLAGS(sv) |= SVf_FAKE) +#define SvFAKE_off(sv) (SvFLAGS(sv) &= ~SVf_FAKE) -#define SvROK(sv) (SvFLAGS(sv) & SVf_ROK) -#define SvROK_on(sv) (SvFLAGS(sv) |= SVf_ROK) -#define SvROK_off(sv) (SvFLAGS(sv) &= ~(SVf_ROK)) +#define SvROK(sv) (SvFLAGS(sv) & SVf_ROK) +#define SvROK_on(sv) (SvFLAGS(sv) |= SVf_ROK) +#define SvROK_off(sv) (SvFLAGS(sv) &= ~(SVf_ROK)) -#define SvMAGICAL(sv) (SvFLAGS(sv) & (SVs_GMG|SVs_SMG|SVs_RMG)) -#define SvMAGICAL_on(sv) (SvFLAGS(sv) |= (SVs_GMG|SVs_SMG|SVs_RMG)) -#define SvMAGICAL_off(sv) (SvFLAGS(sv) &= ~(SVs_GMG|SVs_SMG|SVs_RMG)) +#define SvMAGICAL(sv) (SvFLAGS(sv) & (SVs_GMG|SVs_SMG|SVs_RMG)) +#define SvMAGICAL_on(sv) (SvFLAGS(sv) |= (SVs_GMG|SVs_SMG|SVs_RMG)) +#define SvMAGICAL_off(sv) (SvFLAGS(sv) &= ~(SVs_GMG|SVs_SMG|SVs_RMG)) -#define SvGMAGICAL(sv) (SvFLAGS(sv) & SVs_GMG) -#define SvGMAGICAL_on(sv) (SvFLAGS(sv) |= SVs_GMG) -#define SvGMAGICAL_off(sv) (SvFLAGS(sv) &= ~SVs_GMG) +#define SvGMAGICAL(sv) (SvFLAGS(sv) & SVs_GMG) +#define SvGMAGICAL_on(sv) (SvFLAGS(sv) |= SVs_GMG) +#define SvGMAGICAL_off(sv) (SvFLAGS(sv) &= ~SVs_GMG) -#define SvSMAGICAL(sv) (SvFLAGS(sv) & SVs_SMG) -#define SvSMAGICAL_on(sv) (SvFLAGS(sv) |= SVs_SMG) -#define SvSMAGICAL_off(sv) (SvFLAGS(sv) &= ~SVs_SMG) +#define SvSMAGICAL(sv) (SvFLAGS(sv) & SVs_SMG) +#define SvSMAGICAL_on(sv) (SvFLAGS(sv) |= SVs_SMG) +#define SvSMAGICAL_off(sv) (SvFLAGS(sv) &= ~SVs_SMG) -#define SvRMAGICAL(sv) (SvFLAGS(sv) & SVs_RMG) -#define SvRMAGICAL_on(sv) (SvFLAGS(sv) |= SVs_RMG) -#define SvRMAGICAL_off(sv) (SvFLAGS(sv) &= ~SVs_RMG) +#define SvRMAGICAL(sv) (SvFLAGS(sv) & SVs_RMG) +#define SvRMAGICAL_on(sv) (SvFLAGS(sv) |= SVs_RMG) +#define SvRMAGICAL_off(sv) (SvFLAGS(sv) &= ~SVs_RMG) /* =for apidoc Am|bool|SvAMAGIC|SV * sv -Returns a boolean as to whether C has overloading (active magic) enabled or -not. +Returns a boolean as to whether C has overloading +(active magic) enabled or not. =cut */ -#define SvAMAGIC(sv) (SvROK(sv) && SvOBJECT(SvRV(sv)) && \ - HvAMAGIC(SvSTASH(SvRV(sv)))) +#define SvAMAGIC(sv) \ + (SvROK(sv) && SvOBJECT(SvRV(sv)) && HvAMAGIC(SvSTASH(SvRV(sv)))) /* To be used on the stashes themselves: */ -#define HvAMAGIC(hv) (SvFLAGS(hv) & SVf_AMAGIC) -#define HvAMAGIC_on(hv) (SvFLAGS(hv) |= SVf_AMAGIC) -#define HvAMAGIC_off(hv) (SvFLAGS(hv) &=~ SVf_AMAGIC) +#define HvAMAGIC(hv) (SvFLAGS(hv) & SVf_AMAGIC) +#define HvAMAGIC_on(hv) (SvFLAGS(hv) |= SVf_AMAGIC) +#define HvAMAGIC_off(hv) (SvFLAGS(hv) &=~ SVf_AMAGIC) /* "nog" means "doesn't have get magic" */ -#define SvPOK_nog(sv) ((SvFLAGS(sv) & (SVf_POK|SVs_GMG)) == SVf_POK) -#define SvIOK_nog(sv) ((SvFLAGS(sv) & (SVf_IOK|SVs_GMG)) == SVf_IOK) -#define SvUOK_nog(sv) ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV|SVs_GMG)) == (SVf_IOK|SVf_IVisUV)) -#define SvNOK_nog(sv) ((SvFLAGS(sv) & (SVf_NOK|SVs_GMG)) == SVf_NOK) -#define SvNIOK_nog(sv) (SvNIOK(sv) && !(SvFLAGS(sv) & SVs_GMG)) - -#define SvPOK_nogthink(sv) ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST|SVs_GMG)) == SVf_POK) -#define SvIOK_nogthink(sv) ((SvFLAGS(sv) & (SVf_IOK|SVf_THINKFIRST|SVs_GMG)) == SVf_IOK) -#define SvUOK_nogthink(sv) ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV|SVf_THINKFIRST|SVs_GMG)) == (SVf_IOK|SVf_IVisUV)) -#define SvNOK_nogthink(sv) ((SvFLAGS(sv) & (SVf_NOK|SVf_THINKFIRST|SVs_GMG)) == SVf_NOK) -#define SvNIOK_nogthink(sv) (SvNIOK(sv) && !(SvFLAGS(sv) & (SVf_THINKFIRST|SVs_GMG))) - -#define SvPOK_utf8_nog(sv) ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVs_GMG)) == (SVf_POK|SVf_UTF8)) -#define SvPOK_utf8_nogthink(sv) ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_THINKFIRST|SVs_GMG)) == (SVf_POK|SVf_UTF8)) - -#define SvPOK_byte_nog(sv) ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVs_GMG)) == SVf_POK) -#define SvPOK_byte_nogthink(sv) ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_THINKFIRST|SVs_GMG)) == SVf_POK) +#define SvPOK_nog(sv) ((SvFLAGS(sv) & (SVf_POK|SVs_GMG)) == SVf_POK) +#define SvIOK_nog(sv) ((SvFLAGS(sv) & (SVf_IOK|SVs_GMG)) == SVf_IOK) +#define SvUOK_nog(sv) \ + ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV|SVs_GMG)) == (SVf_IOK|SVf_IVisUV)) +#define SvNOK_nog(sv) ((SvFLAGS(sv) & (SVf_NOK|SVs_GMG)) == SVf_NOK) +#define SvNIOK_nog(sv) (SvNIOK(sv) && !(SvFLAGS(sv) & SVs_GMG)) + +#define SvPOK_nogthink(sv) \ + ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST|SVs_GMG)) == SVf_POK) +#define SvIOK_nogthink(sv) \ + ((SvFLAGS(sv) & (SVf_IOK|SVf_THINKFIRST|SVs_GMG)) == SVf_IOK) +#define SvUOK_nogthink(sv) \ + ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV|SVf_THINKFIRST|SVs_GMG)) == (SVf_IOK|SVf_IVisUV)) +#define SvNOK_nogthink(sv) \ + ((SvFLAGS(sv) & (SVf_NOK|SVf_THINKFIRST|SVs_GMG)) == SVf_NOK) +#define SvNIOK_nogthink(sv) \ + (SvNIOK(sv) && !(SvFLAGS(sv) & (SVf_THINKFIRST|SVs_GMG))) + +#define SvPOK_utf8_nog(sv) \ + ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVs_GMG)) == (SVf_POK|SVf_UTF8)) +#define SvPOK_utf8_nogthink(sv) \ + ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_THINKFIRST|SVs_GMG)) == (SVf_POK|SVf_UTF8)) + +#define SvPOK_byte_nog(sv) \ + ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVs_GMG)) == SVf_POK) +#define SvPOK_byte_nogthink(sv) \ + ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_THINKFIRST|SVs_GMG)) == SVf_POK) #define SvPOK_pure_nogthink(sv) \ ((SvFLAGS(sv) & (SVf_POK|SVf_IOK|SVf_NOK|SVf_ROK|SVpgv_GP|SVf_THINKFIRST|SVs_GMG)) == SVf_POK) -#define SvPOK_utf8_pure_nogthink(sv) \ +#define SvPOK_utf8_pure_nogthink(sv) \ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_IOK|SVf_NOK|SVf_ROK|SVpgv_GP|SVf_THINKFIRST|SVs_GMG)) == (SVf_POK|SVf_UTF8)) -#define SvPOK_byte_pure_nogthink(sv) \ +#define SvPOK_byte_pure_nogthink(sv) \ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_IOK|SVf_NOK|SVf_ROK|SVpgv_GP|SVf_THINKFIRST|SVs_GMG)) == SVf_POK) /* @@ -1166,44 +1181,44 @@ PL_sv_no), or is a regular SV whose last assignment stored a copy of one. =cut */ -#define SvIsBOOL(sv) Perl_sv_isbool(aTHX_ sv) +#define SvIsBOOL(sv) Perl_sv_isbool(aTHX_ sv) /* =for apidoc Am|U32|SvGAMAGIC|SV* sv -Returns true if the SV has get magic or -overloading. If either is true then -the scalar is active data, and has the potential to return a new value every -time it is accessed. Hence you must be careful to -only read it once per user logical operation and work -with that returned value. If neither is true then -the scalar's value cannot change unless written to. +Returns true if the SV has get magic or overloading. If either is true +then the scalar is active data, and has the potential to return a new value +every time it is accessed. Hence you must be careful to only read it once +per user logical operation and work with that returned value. If neither +is true then the scalar's value cannot change unless written to. =cut */ -#define SvGAMAGIC(sv) (SvGMAGICAL(sv) || SvAMAGIC(sv)) +#define SvGAMAGIC(sv) (SvGMAGICAL(sv) || SvAMAGIC(sv)) -#define Gv_AMG(stash) \ - (HvNAME(stash) && Gv_AMupdate(stash,FALSE) \ - ? 1 \ - : (HvAMAGIC_off(stash), 0)) +#define Gv_AMG(stash) \ + (HvNAME(stash) && Gv_AMupdate(stash,FALSE) \ + ? 1 \ + : (HvAMAGIC_off(stash), 0)) -#define SvWEAKREF(sv) ((SvFLAGS(sv) & (SVf_ROK|SVprv_WEAKREF)) \ - == (SVf_ROK|SVprv_WEAKREF)) -#define SvWEAKREF_on(sv) (SvFLAGS(sv) |= (SVf_ROK|SVprv_WEAKREF)) -#define SvWEAKREF_off(sv) (SvFLAGS(sv) &= ~(SVf_ROK|SVprv_WEAKREF)) +#define SvWEAKREF(sv) \ + ((SvFLAGS(sv) & (SVf_ROK|SVprv_WEAKREF)) == (SVf_ROK|SVprv_WEAKREF)) +#define SvWEAKREF_on(sv) (SvFLAGS(sv) |= (SVf_ROK|SVprv_WEAKREF)) +#define SvWEAKREF_off(sv) (SvFLAGS(sv) &= ~(SVf_ROK|SVprv_WEAKREF)) -#define SvPCS_IMPORTED(sv) ((SvFLAGS(sv) & (SVf_ROK|SVprv_PCS_IMPORTED)) \ - == (SVf_ROK|SVprv_PCS_IMPORTED)) -#define SvPCS_IMPORTED_on(sv) (SvFLAGS(sv) |= (SVf_ROK|SVprv_PCS_IMPORTED)) -#define SvPCS_IMPORTED_off(sv) (SvFLAGS(sv) &= ~(SVf_ROK|SVprv_PCS_IMPORTED)) +#define SvPCS_IMPORTED(sv) \ + ((SvFLAGS(sv) & (SVf_ROK|SVprv_PCS_IMPORTED)) \ + == (SVf_ROK|SVprv_PCS_IMPORTED)) +#define SvPCS_IMPORTED_on(sv) (SvFLAGS(sv) |= (SVf_ROK|SVprv_PCS_IMPORTED)) +#define SvPCS_IMPORTED_off(sv) (SvFLAGS(sv) &= ~(SVf_ROK|SVprv_PCS_IMPORTED)) /* =for apidoc m|U32|SvTHINKFIRST|SV *sv -A quick flag check to see whether an C should be passed to C -to be "downgraded" before C or C can be modified directly. +A quick flag check to see whether an C should be passed to +C to be "downgraded" before C or C can be +modified directly. For example, if your scalar is a reference and you want to modify the C slot, you can't just do C, as that will leak the referent. @@ -1223,29 +1238,29 @@ C does nothing. =cut */ -#define SvTHINKFIRST(sv) (SvFLAGS(sv) & SVf_THINKFIRST) +#define SvTHINKFIRST(sv) (SvFLAGS(sv) & SVf_THINKFIRST) -#define SVs_PADMY 0 -#define SvPADMY(sv) !(SvFLAGS(sv) & SVs_PADTMP) +#define SVs_PADMY 0 +#define SvPADMY(sv) !(SvFLAGS(sv) & SVs_PADTMP) #ifndef PERL_CORE -# define SvPADMY_on(sv) SvPADTMP_off(sv) +# define SvPADMY_on(sv) SvPADTMP_off(sv) #endif -#define SvPADTMP(sv) (SvFLAGS(sv) & (SVs_PADTMP)) -#define SvPADSTALE(sv) (SvFLAGS(sv) & (SVs_PADSTALE)) +#define SvPADTMP(sv) (SvFLAGS(sv) & (SVs_PADTMP)) +#define SvPADSTALE(sv) (SvFLAGS(sv) & (SVs_PADSTALE)) -#define SvPADTMP_on(sv) (SvFLAGS(sv) |= SVs_PADTMP) -#define SvPADTMP_off(sv) (SvFLAGS(sv) &= ~SVs_PADTMP) -#define SvPADSTALE_on(sv) Perl_SvPADSTALE_on(MUTABLE_SV(sv)) -#define SvPADSTALE_off(sv) Perl_SvPADSTALE_off(MUTABLE_SV(sv)) +#define SvPADTMP_on(sv) (SvFLAGS(sv) |= SVs_PADTMP) +#define SvPADTMP_off(sv) (SvFLAGS(sv) &= ~SVs_PADTMP) +#define SvPADSTALE_on(sv) Perl_SvPADSTALE_on(MUTABLE_SV(sv)) +#define SvPADSTALE_off(sv) Perl_SvPADSTALE_off(MUTABLE_SV(sv)) -#define SvTEMP(sv) (SvFLAGS(sv) & SVs_TEMP) -#define SvTEMP_on(sv) (SvFLAGS(sv) |= SVs_TEMP) -#define SvTEMP_off(sv) (SvFLAGS(sv) &= ~SVs_TEMP) +#define SvTEMP(sv) (SvFLAGS(sv) & SVs_TEMP) +#define SvTEMP_on(sv) (SvFLAGS(sv) |= SVs_TEMP) +#define SvTEMP_off(sv) (SvFLAGS(sv) &= ~SVs_TEMP) -#define SvOBJECT(sv) (SvFLAGS(sv) & SVs_OBJECT) -#define SvOBJECT_on(sv) (SvFLAGS(sv) |= SVs_OBJECT) -#define SvOBJECT_off(sv) (SvFLAGS(sv) &= ~SVs_OBJECT) +#define SvOBJECT(sv) (SvFLAGS(sv) & SVs_OBJECT) +#define SvOBJECT_on(sv) (SvFLAGS(sv) |= SVs_OBJECT) +#define SvOBJECT_off(sv) (SvFLAGS(sv) &= ~SVs_OBJECT) /* =for apidoc Am|U32|SvREADONLY|SV* sv @@ -1253,418 +1268,423 @@ Returns true if the argument is readonly, otherwise returns false. Exposed to perl code via Internals::SvREADONLY(). =for apidoc Am|U32|SvREADONLY_on|SV* sv -Mark an object as readonly. Exactly what this means depends on the object -type. Exposed to perl code via Internals::SvREADONLY(). +Mark an object as readonly. Exactly what this means depends on the +object type. Exposed to perl code via Internals::SvREADONLY(). =for apidoc Am|U32|SvREADONLY_off|SV* sv -Mark an object as not-readonly. Exactly what this mean depends on the -object type. Exposed to perl code via Internals::SvREADONLY(). +Mark an object as not-readonly. Exactly what this mean depends on the +object type. Exposed to perl code via Internals::SvREADONLY(). =cut */ -#define SvREADONLY(sv) (SvFLAGS(sv) & (SVf_READONLY|SVf_PROTECT)) +#define SvREADONLY(sv) (SvFLAGS(sv) & (SVf_READONLY|SVf_PROTECT)) #ifdef PERL_CORE -# define SvREADONLY_on(sv) (SvFLAGS(sv) |= (SVf_READONLY|SVf_PROTECT)) -# define SvREADONLY_off(sv) (SvFLAGS(sv) &=~(SVf_READONLY|SVf_PROTECT)) +# define SvREADONLY_on(sv) (SvFLAGS(sv) |= (SVf_READONLY|SVf_PROTECT)) +# define SvREADONLY_off(sv) (SvFLAGS(sv) &=~(SVf_READONLY|SVf_PROTECT)) #else -# define SvREADONLY_on(sv) (SvFLAGS(sv) |= SVf_READONLY) -# define SvREADONLY_off(sv) (SvFLAGS(sv) &= ~SVf_READONLY) +# define SvREADONLY_on(sv) (SvFLAGS(sv) |= SVf_READONLY) +# define SvREADONLY_off(sv) (SvFLAGS(sv) &= ~SVf_READONLY) #endif -#define SvSCREAM(sv) ((SvFLAGS(sv) & (SVp_SCREAM|SVp_POK)) == (SVp_SCREAM|SVp_POK)) -#define SvSCREAM_on(sv) (SvFLAGS(sv) |= SVp_SCREAM) -#define SvSCREAM_off(sv) (SvFLAGS(sv) &= ~SVp_SCREAM) +#define SvSCREAM(sv) \ + ((SvFLAGS(sv) & (SVp_SCREAM|SVp_POK)) == (SVp_SCREAM|SVp_POK)) +#define SvSCREAM_on(sv) (SvFLAGS(sv) |= SVp_SCREAM) +#define SvSCREAM_off(sv) (SvFLAGS(sv) &= ~SVp_SCREAM) #ifndef PERL_CORE -# define SvCOMPILED(sv) 0 +# define SvCOMPILED(sv) 0 # define SvCOMPILED_on(sv) # define SvCOMPILED_off(sv) #endif #if defined (DEBUGGING) && defined(PERL_USE_GCC_BRACE_GROUPS) -# define SvTAIL(sv) ({ const SV *const _svtail = (const SV *)(sv); \ - assert(SvTYPE(_svtail) != SVt_PVAV); \ - assert(SvTYPE(_svtail) != SVt_PVHV); \ - assert(!(SvFLAGS(_svtail) & (SVf_NOK|SVp_NOK))); \ - assert(SvVALID(_svtail)); \ - ((XPVNV*)SvANY(_svtail))->xnv_u.xnv_bm_tail; \ - }) +# define SvTAIL(sv) \ + ({ const SV *const _svtail = (const SV *)(sv); \ + assert(SvTYPE(_svtail) != SVt_PVAV); \ + assert(SvTYPE(_svtail) != SVt_PVHV); \ + assert(!(SvFLAGS(_svtail) & (SVf_NOK|SVp_NOK))); \ + assert(SvVALID(_svtail)); \ + ((XPVNV*)SvANY(_svtail))->xnv_u.xnv_bm_tail; \ + }) #else -# define SvTAIL(_svtail) (((XPVNV*)SvANY(_svtail))->xnv_u.xnv_bm_tail) +# define SvTAIL(_svtail) (((XPVNV*)SvANY(_svtail))->xnv_u.xnv_bm_tail) #endif -/* Does the SV have a Boyer-Moore table attached as magic? - * 'VALID' is a poor name, but is kept for historical reasons. */ -#define SvVALID(_svvalid) ( \ - SvPOKp(_svvalid) \ - && SvSMAGICAL(_svvalid) \ - && SvMAGIC(_svvalid) \ - && (SvMAGIC(_svvalid)->mg_type == PERL_MAGIC_bm \ - || mg_find(_svvalid, PERL_MAGIC_bm)) \ +/* Does the SV have a Boyer-Moore table attached as magic? 'VALID' + * is a poor name, but is kept for historical reasons. */ +#define SvVALID(_svvalid) \ + ( \ + SvPOKp(_svvalid) \ + && SvSMAGICAL(_svvalid) \ + && SvMAGIC(_svvalid) \ + && (SvMAGIC(_svvalid)->mg_type == PERL_MAGIC_bm \ + || mg_find(_svvalid, PERL_MAGIC_bm)) \ ) -#define SvRVx(sv) SvRV(sv) +#define SvRVx(sv) SvRV(sv) #ifdef PERL_DEBUG_COW -/* Need -0.0 for SvNVX to preserve IEEE FP "negative zero" because - +0.0 + -0.0 => +0.0 but -0.0 + -0.0 => -0.0 */ -# define SvIVX(sv) (0 + ((XPVIV*) SvANY(sv))->xiv_iv) -# define SvUVX(sv) (0 + ((XPVUV*) SvANY(sv))->xuv_uv) -# define SvNVX(sv) (-0.0 + ((XPVNV*) SvANY(sv))->xnv_u.xnv_nv) -# define SvRV(sv) (0 + (sv)->sv_u.svu_rv) -# define SvRV_const(sv) (0 + (sv)->sv_u.svu_rv) -/* Don't test the core XS code yet. */ +/* Need -0.0 for SvNVX to preserve IEEE FP "negative zero" + because +0.0 + -0.0 => +0.0 but -0.0 + -0.0 => -0.0 */ +# define SvIVX(sv) (0 + ((XPVIV*) SvANY(sv))->xiv_iv) +# define SvUVX(sv) (0 + ((XPVUV*) SvANY(sv))->xuv_uv) +# define SvNVX(sv) (-0.0 + ((XPVNV*) SvANY(sv))->xnv_u.xnv_nv) +# define SvRV(sv) (0 + (sv)->sv_u.svu_rv) +# define SvRV_const(sv) (0 + (sv)->sv_u.svu_rv) +/* Don't test the core XS code yet. */ # if defined (PERL_CORE) && PERL_DEBUG_COW > 1 -# define SvPVX(sv) (0 + (assert_(!SvREADONLY(sv)) (sv)->sv_u.svu_pv)) +# define SvPVX(sv) (0 + (assert_(!SvREADONLY(sv)) (sv)->sv_u.svu_pv)) # else -# define SvPVX(sv) SvPVX_mutable(sv) +# define SvPVX(sv) SvPVX_mutable(sv) # endif -# define SvCUR(sv) (0 + ((XPV*) SvANY(sv))->xpv_cur) -# define SvLEN(sv) (0 + ((XPV*) SvANY(sv))->xpv_len) -# define SvEND(sv) ((sv)->sv_u.svu_pv + ((XPV*)SvANY(sv))->xpv_cur) - -# define SvMAGIC(sv) (0 + *(assert_(SvTYPE(sv) >= SVt_PVMG) &((XPVMG*) SvANY(sv))->xmg_u.xmg_magic)) -# define SvSTASH(sv) (0 + *(assert_(SvTYPE(sv) >= SVt_PVMG) &((XPVMG*) SvANY(sv))->xmg_stash)) +# define SvCUR(sv) (0 + ((XPV*) SvANY(sv))->xpv_cur) +# define SvLEN(sv) (0 + ((XPV*) SvANY(sv))->xpv_len) +# define SvEND(sv) ((sv)->sv_u.svu_pv + ((XPV*)SvANY(sv))->xpv_cur) + +# define SvMAGIC(sv) \ + (0 + *(assert_(SvTYPE(sv) >= SVt_PVMG) &((XPVMG*) SvANY(sv))->xmg_u.xmg_magic)) +# define SvSTASH(sv) \ + (0 + *(assert_(SvTYPE(sv) >= SVt_PVMG) &((XPVMG*) SvANY(sv))->xmg_stash)) #else /* Below is not PERL_DEBUG_COW */ # ifdef PERL_CORE -# define SvLEN(sv) (0 + ((XPV*) SvANY(sv))->xpv_len) +# define SvLEN(sv) (0 + ((XPV*) SvANY(sv))->xpv_len) # else -# define SvLEN(sv) ((XPV*) SvANY(sv))->xpv_len +# define SvLEN(sv) ((XPV*) SvANY(sv))->xpv_len # endif -# define SvEND(sv) ((sv)->sv_u.svu_pv + ((XPV*)SvANY(sv))->xpv_cur) +# define SvEND(sv) ((sv)->sv_u.svu_pv + ((XPV*)SvANY(sv))->xpv_cur) # if defined (DEBUGGING) && defined(PERL_USE_GCC_BRACE_GROUPS) -/* These get expanded inside other macros that already use a variable _sv */ -# define SvPVX(sv) \ - (*({ SV *const _svpvx = MUTABLE_SV(sv); \ - assert(PL_valid_types_PVX[SvTYPE(_svpvx) & SVt_MASK]); \ - assert(!isGV_with_GP(_svpvx)); \ - assert(!(SvTYPE(_svpvx) == SVt_PVIO \ - && !(IoFLAGS(_svpvx) & IOf_FAKE_DIRP))); \ - &((_svpvx)->sv_u.svu_pv); \ - })) +/* These get expanded inside other macros that already use a variable _sv */ +# define SvPVX(sv) \ + (*({ SV *const _svpvx = MUTABLE_SV(sv); \ + assert(PL_valid_types_PVX[SvTYPE(_svpvx) & SVt_MASK]); \ + assert(!isGV_with_GP(_svpvx)); \ + assert(!(SvTYPE(_svpvx) == SVt_PVIO \ + && !(IoFLAGS(_svpvx) & IOf_FAKE_DIRP))); \ + &((_svpvx)->sv_u.svu_pv); \ + })) # ifdef PERL_CORE -# define SvCUR(sv) \ - ({ const SV *const _svcur = (const SV *)(sv); \ - assert(PL_valid_types_PVX[SvTYPE(_svcur) & SVt_MASK]); \ - assert(!isGV_with_GP(_svcur)); \ - assert(!(SvTYPE(_svcur) == SVt_PVIO \ - && !(IoFLAGS(_svcur) & IOf_FAKE_DIRP))); \ - (((XPV*) MUTABLE_PTR(SvANY(_svcur)))->xpv_cur); \ - }) +# define SvCUR(sv) \ + ({ const SV *const _svcur = (const SV *)(sv); \ + assert(PL_valid_types_PVX[SvTYPE(_svcur) & SVt_MASK]); \ + assert(!isGV_with_GP(_svcur)); \ + assert(!(SvTYPE(_svcur) == SVt_PVIO \ + && !(IoFLAGS(_svcur) & IOf_FAKE_DIRP))); \ + (((XPV*) MUTABLE_PTR(SvANY(_svcur)))->xpv_cur); \ + }) # else -# define SvCUR(sv) \ - (*({ const SV *const _svcur = (const SV *)(sv); \ - assert(PL_valid_types_PVX[SvTYPE(_svcur) & SVt_MASK]); \ - assert(!isGV_with_GP(_svcur)); \ - assert(!(SvTYPE(_svcur) == SVt_PVIO \ - && !(IoFLAGS(_svcur) & IOf_FAKE_DIRP))); \ - &(((XPV*) MUTABLE_PTR(SvANY(_svcur)))->xpv_cur); \ - })) +# define SvCUR(sv) \ + (*({ const SV *const _svcur = (const SV *)(sv); \ + assert(PL_valid_types_PVX[SvTYPE(_svcur) & SVt_MASK]); \ + assert(!isGV_with_GP(_svcur)); \ + assert(!(SvTYPE(_svcur) == SVt_PVIO \ + && !(IoFLAGS(_svcur) & IOf_FAKE_DIRP))); \ + &(((XPV*) MUTABLE_PTR(SvANY(_svcur)))->xpv_cur); \ + })) # endif -# define SvIVX(sv) \ - (*({ const SV *const _svivx = (const SV *)(sv); \ - assert(PL_valid_types_IVX[SvTYPE(_svivx) & SVt_MASK]); \ - assert(!isGV_with_GP(_svivx)); \ - &(((XPVIV*) MUTABLE_PTR(SvANY(_svivx)))->xiv_iv); \ - })) -# define SvUVX(sv) \ - (*({ const SV *const _svuvx = (const SV *)(sv); \ - assert(PL_valid_types_IVX[SvTYPE(_svuvx) & SVt_MASK]); \ - assert(!isGV_with_GP(_svuvx)); \ - &(((XPVUV*) MUTABLE_PTR(SvANY(_svuvx)))->xuv_uv); \ - })) -# define SvNVX(sv) \ - (*({ const SV *const _svnvx = (const SV *)(sv); \ - assert(PL_valid_types_NVX[SvTYPE(_svnvx) & SVt_MASK]); \ - assert(!isGV_with_GP(_svnvx)); \ - &(((XPVNV*) MUTABLE_PTR(SvANY(_svnvx)))->xnv_u.xnv_nv); \ - })) -# define SvRV(sv) \ - (*({ SV *const _svrv = MUTABLE_SV(sv); \ - assert(PL_valid_types_RV[SvTYPE(_svrv) & SVt_MASK]); \ - assert(!isGV_with_GP(_svrv)); \ - assert(!(SvTYPE(_svrv) == SVt_PVIO \ - && !(IoFLAGS(_svrv) & IOf_FAKE_DIRP))); \ - &((_svrv)->sv_u.svu_rv); \ - })) -# define SvRV_const(sv) \ - ({ const SV *const _svrv = (const SV *)(sv); \ - assert(PL_valid_types_RV[SvTYPE(_svrv) & SVt_MASK]); \ - assert(!isGV_with_GP(_svrv)); \ - assert(!(SvTYPE(_svrv) == SVt_PVIO \ - && !(IoFLAGS(_svrv) & IOf_FAKE_DIRP))); \ - (_svrv)->sv_u.svu_rv; \ - }) -# define SvMAGIC(sv) \ - (*({ const SV *const _svmagic = (const SV *)(sv); \ - assert(SvTYPE(_svmagic) >= SVt_PVMG); \ - &(((XPVMG*) MUTABLE_PTR(SvANY(_svmagic)))->xmg_u.xmg_magic); \ +# define SvIVX(sv) \ + (*({ const SV *const _svivx = (const SV *)(sv); \ + assert(PL_valid_types_IVX[SvTYPE(_svivx) & SVt_MASK]); \ + assert(!isGV_with_GP(_svivx)); \ + &(((XPVIV*) MUTABLE_PTR(SvANY(_svivx)))->xiv_iv); \ + })) +# define SvUVX(sv) \ + (*({ const SV *const _svuvx = (const SV *)(sv); \ + assert(PL_valid_types_IVX[SvTYPE(_svuvx) & SVt_MASK]); \ + assert(!isGV_with_GP(_svuvx)); \ + &(((XPVUV*) MUTABLE_PTR(SvANY(_svuvx)))->xuv_uv); \ })) -# define SvSTASH(sv) \ - (*({ const SV *const _svstash = (const SV *)(sv); \ - assert(SvTYPE(_svstash) >= SVt_PVMG); \ - &(((XPVMG*) MUTABLE_PTR(SvANY(_svstash)))->xmg_stash); \ +# define SvNVX(sv) \ + (*({ const SV *const _svnvx = (const SV *)(sv); \ + assert(PL_valid_types_NVX[SvTYPE(_svnvx) & SVt_MASK]); \ + assert(!isGV_with_GP(_svnvx)); \ + &(((XPVNV*) MUTABLE_PTR(SvANY(_svnvx)))->xnv_u.xnv_nv); \ })) +# define SvRV(sv) \ + (*({ SV *const _svrv = MUTABLE_SV(sv); \ + assert(PL_valid_types_RV[SvTYPE(_svrv) & SVt_MASK]); \ + assert(!isGV_with_GP(_svrv)); \ + assert(!(SvTYPE(_svrv) == SVt_PVIO \ + && !(IoFLAGS(_svrv) & IOf_FAKE_DIRP))); \ + &((_svrv)->sv_u.svu_rv); \ + })) +# define SvRV_const(sv) \ + ({ const SV *const _svrv = (const SV *)(sv); \ + assert(PL_valid_types_RV[SvTYPE(_svrv) & SVt_MASK]); \ + assert(!isGV_with_GP(_svrv)); \ + assert(!(SvTYPE(_svrv) == SVt_PVIO \ + && !(IoFLAGS(_svrv) & IOf_FAKE_DIRP))); \ + (_svrv)->sv_u.svu_rv; \ + }) +# define SvMAGIC(sv) \ + (*({ const SV *const _svmagic = (const SV *)(sv); \ + assert(SvTYPE(_svmagic) >= SVt_PVMG); \ + &(((XPVMG*) MUTABLE_PTR(SvANY(_svmagic)))->xmg_u.xmg_magic); \ + })) +# define SvSTASH(sv) \ + (*({ const SV *const _svstash = (const SV *)(sv); \ + assert(SvTYPE(_svstash) >= SVt_PVMG); \ + &(((XPVMG*) MUTABLE_PTR(SvANY(_svstash)))->xmg_stash); \ + })) # else /* Below is not DEBUGGING or can't use brace groups */ -# define SvPVX(sv) ((sv)->sv_u.svu_pv) -# define SvCUR(sv) ((XPV*) SvANY(sv))->xpv_cur -# define SvIVX(sv) ((XPVIV*) SvANY(sv))->xiv_iv -# define SvUVX(sv) ((XPVUV*) SvANY(sv))->xuv_uv -# define SvNVX(sv) ((XPVNV*) SvANY(sv))->xnv_u.xnv_nv -# define SvRV(sv) ((sv)->sv_u.svu_rv) -# define SvRV_const(sv) (0 + (sv)->sv_u.svu_rv) -# define SvMAGIC(sv) ((XPVMG*) SvANY(sv))->xmg_u.xmg_magic -# define SvSTASH(sv) ((XPVMG*) SvANY(sv))->xmg_stash +# define SvPVX(sv) ((sv)->sv_u.svu_pv) +# define SvCUR(sv) ((XPV*) SvANY(sv))->xpv_cur +# define SvIVX(sv) ((XPVIV*) SvANY(sv))->xiv_iv +# define SvUVX(sv) ((XPVUV*) SvANY(sv))->xuv_uv +# define SvNVX(sv) ((XPVNV*) SvANY(sv))->xnv_u.xnv_nv +# define SvRV(sv) ((sv)->sv_u.svu_rv) +# define SvRV_const(sv) (0 + (sv)->sv_u.svu_rv) +# define SvMAGIC(sv) ((XPVMG*) SvANY(sv))->xmg_u.xmg_magic +# define SvSTASH(sv) ((XPVMG*) SvANY(sv))->xmg_stash # endif #endif #ifndef PERL_POISON -/* Given that these two are new, there can't be any existing code using them - * as LVALUEs, so prevent that from happening */ -# define SvPVX_mutable(sv) ((char *)((sv)->sv_u.svu_pv)) -# define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv)) +/* Given that these two are new, there can't be any existing code + * using them as LVALUEs, so prevent that from happening */ +# define SvPVX_mutable(sv) ((char *)((sv)->sv_u.svu_pv)) +# define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv)) #else -/* Except for the poison code, which uses & to scribble over the pointer after - free() is called. */ -# define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv) -# define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv)) +/* Except for the poison code, which uses & to scribble + over the pointer after free() is called. */ +# define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv) +# define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv)) #endif -#define SvIVXx(sv) SvIVX(sv) -#define SvUVXx(sv) SvUVX(sv) -#define SvNVXx(sv) SvNVX(sv) -#define SvPVXx(sv) SvPVX(sv) -#define SvLENx(sv) SvLEN(sv) -#define SvENDx(sv) ((PL_Sv = (sv)), SvEND(PL_Sv)) +#define SvIVXx(sv) SvIVX(sv) +#define SvUVXx(sv) SvUVX(sv) +#define SvNVXx(sv) SvNVX(sv) +#define SvPVXx(sv) SvPVX(sv) +#define SvLENx(sv) SvLEN(sv) +#define SvENDx(sv) ((PL_Sv = (sv)), SvEND(PL_Sv)) /* Ask a scalar nicely to try to become an IV, if possible. Not guaranteed to stay returning void */ /* Macro won't actually call sv_2iv if already IOK */ -#define SvIV_please(sv) \ - STMT_START { \ - SV * sv_ = MUTABLE_SV(sv); \ - if (!SvIOKp(sv_) && (SvFLAGS(sv_) & (SVf_NOK|SVf_POK))) \ - (void) SvIV(sv_); \ - } STMT_END -#define SvIV_please_nomg(sv) \ - (!(SvFLAGS(sv) & (SVf_IOK|SVp_IOK)) && (SvFLAGS(sv) & (SVf_NOK|SVf_POK)) \ - ? (sv_2iv_flags(sv, 0), SvIOK(sv)) \ - : SvIOK(sv)) - -#define SvIV_set(sv, val) \ - STMT_START { \ - SV * sv_ = MUTABLE_SV(sv); \ - assert(PL_valid_types_IV_set[SvTYPE(sv_) & SVt_MASK]); \ - assert(!isGV_with_GP(sv_)); \ - (((XPVIV*) SvANY(sv_))->xiv_iv = (val)); \ - } STMT_END - -#define SvNV_set(sv, val) \ - STMT_START { \ - SV * sv_ = MUTABLE_SV(sv); \ - assert(PL_valid_types_NV_set[SvTYPE(sv_) & SVt_MASK]); \ - assert(!isGV_with_GP(sv_)); \ - (((XPVNV*)SvANY(sv_))->xnv_u.xnv_nv = (val)); \ - } STMT_END - -#define SvPV_set(sv, val) \ - STMT_START { \ - SV * sv_ = MUTABLE_SV(sv); \ - assert(PL_valid_types_PVX[SvTYPE(sv_) & SVt_MASK]); \ - assert(!isGV_with_GP(sv_)); \ - assert(!(SvTYPE(sv_) == SVt_PVIO \ - && !(IoFLAGS(sv_) & IOf_FAKE_DIRP))); \ - ((sv_)->sv_u.svu_pv = (val)); \ - } STMT_END - -#define SvUV_set(sv, val) \ - STMT_START { \ - SV * sv_ = MUTABLE_SV(sv); \ - assert(PL_valid_types_IV_set[SvTYPE(sv_) & SVt_MASK]); \ - assert(!isGV_with_GP(sv_)); \ - (((XPVUV*)SvANY(sv_))->xuv_uv = (val)); \ - } STMT_END - -#define SvRV_set(sv, val) \ - STMT_START { \ - SV * sv_ = MUTABLE_SV(sv); \ - assert(PL_valid_types_RV[SvTYPE(sv_) & SVt_MASK]); \ - assert(!isGV_with_GP(sv_)); \ - assert(!(SvTYPE(sv_) == SVt_PVIO \ - && !(IoFLAGS(sv_) & IOf_FAKE_DIRP))); \ - ((sv_)->sv_u.svu_rv = (val)); \ - } STMT_END -#define SvMAGIC_set(sv, val) \ - STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \ - (((XPVMG*)SvANY(sv))->xmg_u.xmg_magic = (val)); } STMT_END -#define SvSTASH_set(sv, val) \ - STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \ - (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END -#define SvCUR_set(sv, val) \ - STMT_START { \ - assert(PL_valid_types_PVX[SvTYPE(sv) & SVt_MASK]); \ - assert(!isGV_with_GP(sv)); \ - assert(!(SvTYPE(sv) == SVt_PVIO \ - && !(IoFLAGS(sv) & IOf_FAKE_DIRP))); \ - (((XPV*) SvANY(sv))->xpv_cur = (val)); } STMT_END -#define SvLEN_set(sv, val) \ - STMT_START { \ - assert(PL_valid_types_PVX[SvTYPE(sv) & SVt_MASK]); \ - assert(!isGV_with_GP(sv)); \ - assert(!(SvTYPE(sv) == SVt_PVIO \ - && !(IoFLAGS(sv) & IOf_FAKE_DIRP))); \ - (((XPV*) SvANY(sv))->xpv_len = (val)); } STMT_END -#define SvEND_set(sv, val) \ - STMT_START { assert(SvTYPE(sv) >= SVt_PV); \ - SvCUR_set(sv, (val) - SvPVX(sv)); } STMT_END +#define SvIV_please(sv) \ + STMT_START { \ + SV * sv_ = MUTABLE_SV(sv); \ + if (!SvIOKp(sv_) && (SvFLAGS(sv_) & (SVf_NOK|SVf_POK))) \ + (void) SvIV(sv_); \ + } STMT_END +#define SvIV_please_nomg(sv) \ + (!(SvFLAGS(sv) & (SVf_IOK|SVp_IOK)) && (SvFLAGS(sv) & (SVf_NOK|SVf_POK)) \ + ? (sv_2iv_flags(sv, 0), SvIOK(sv)) \ + : SvIOK(sv)) + +#define SvIV_set(sv, val) \ + STMT_START { \ + SV * sv_ = MUTABLE_SV(sv); \ + assert(PL_valid_types_IV_set[SvTYPE(sv_) & SVt_MASK]); \ + assert(!isGV_with_GP(sv_)); \ + (((XPVIV*) SvANY(sv_))->xiv_iv = (val)); \ + } STMT_END + +#define SvNV_set(sv, val) \ + STMT_START { \ + SV * sv_ = MUTABLE_SV(sv); \ + assert(PL_valid_types_NV_set[SvTYPE(sv_) & SVt_MASK]); \ + assert(!isGV_with_GP(sv_)); \ + (((XPVNV*)SvANY(sv_))->xnv_u.xnv_nv = (val)); \ + } STMT_END + +#define SvPV_set(sv, val) \ + STMT_START { \ + SV * sv_ = MUTABLE_SV(sv); \ + assert(PL_valid_types_PVX[SvTYPE(sv_) & SVt_MASK]); \ + assert(!isGV_with_GP(sv_)); \ + assert(!(SvTYPE(sv_) == SVt_PVIO \ + && !(IoFLAGS(sv_) & IOf_FAKE_DIRP))); \ + ((sv_)->sv_u.svu_pv = (val)); \ + } STMT_END + +#define SvUV_set(sv, val) \ + STMT_START { \ + SV * sv_ = MUTABLE_SV(sv); \ + assert(PL_valid_types_IV_set[SvTYPE(sv_) & SVt_MASK]); \ + assert(!isGV_with_GP(sv_)); \ + (((XPVUV*)SvANY(sv_))->xuv_uv = (val)); \ + } STMT_END + +#define SvRV_set(sv, val) \ + STMT_START { \ + SV * sv_ = MUTABLE_SV(sv); \ + assert(PL_valid_types_RV[SvTYPE(sv_) & SVt_MASK]); \ + assert(!isGV_with_GP(sv_)); \ + assert(!(SvTYPE(sv_) == SVt_PVIO \ + && !(IoFLAGS(sv_) & IOf_FAKE_DIRP))); \ + ((sv_)->sv_u.svu_rv = (val)); \ + } STMT_END +#define SvMAGIC_set(sv, val) \ + STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \ + (((XPVMG*)SvANY(sv))->xmg_u.xmg_magic = (val)); } STMT_END +#define SvSTASH_set(sv, val) \ + STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \ + (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END +#define SvCUR_set(sv, val) \ + STMT_START { \ + assert(PL_valid_types_PVX[SvTYPE(sv) & SVt_MASK]); \ + assert(!isGV_with_GP(sv)); \ + assert(!(SvTYPE(sv) == SVt_PVIO \ + && !(IoFLAGS(sv) & IOf_FAKE_DIRP))); \ + (((XPV*) SvANY(sv))->xpv_cur = (val)); } STMT_END +#define SvLEN_set(sv, val) \ + STMT_START { \ + assert(PL_valid_types_PVX[SvTYPE(sv) & SVt_MASK]); \ + assert(!isGV_with_GP(sv)); \ + assert(!(SvTYPE(sv) == SVt_PVIO \ + && !(IoFLAGS(sv) & IOf_FAKE_DIRP))); \ + (((XPV*) SvANY(sv))->xpv_len = (val)); } STMT_END +#define SvEND_set(sv, val) \ + STMT_START { assert(SvTYPE(sv) >= SVt_PV); \ + SvCUR_set(sv, (val) - SvPVX(sv)); } STMT_END /* =for apidoc Am|void|SvPV_renew|SV* sv|STRLEN len -Low level micro optimization of C>. It is generally better to use -C instead. This is because C ignores potential issues that -C handles. C needs to have a real C that is unencumbered by -things like COW. Using C or -C before calling this should clean it up, but -why not just use C if you're not sure about the provenance? +Low level micro optimization of C>. It is generally better to +use C instead. This is because C ignores potential +issues that C handles. C needs to have a real C that is +unencumbered by things like COW. Using C or +C before calling this should clean it up, +but why not just use C if you're not sure about the provenance? =cut */ -#define SvPV_renew(sv,n) \ - STMT_START { SvLEN_set(sv, n); \ - SvPV_set((sv), (MEM_WRAP_CHECK_(n,char) \ - (char*)saferealloc((Malloc_t)SvPVX(sv), \ - (MEM_SIZE)((n))))); \ - } STMT_END +#define SvPV_renew(sv,n) \ + STMT_START { SvLEN_set(sv, n); \ + SvPV_set((sv), (MEM_WRAP_CHECK_(n,char) \ + (char*)saferealloc((Malloc_t)SvPVX(sv), \ + (MEM_SIZE)((n))))); \ + } STMT_END /* =for apidoc Am|void|SvPV_shrink_to_cur|SV* sv -Trim any trailing unused memory in the PV of C, which needs to have a real -C that is unencumbered by things like COW. Think first before using this -functionality. Is the space saving really worth giving up COW? Will the -needed size of C stay the same? +Trim any trailing unused memory in the PV of C, which needs to +have a real C that is unencumbered by things like COW. Think +first before using this functionality. Is the space saving really +worth giving up COW? Will the needed size of C stay the same? -If the answers are both yes, then use L> or -L> before calling this. +If the answers are both yes, then use L> +or L> before calling this. =cut */ -#define SvPV_shrink_to_cur(sv) STMT_START { \ - const STRLEN _lEnGtH = SvCUR(sv) + 1; \ - SvPV_renew(sv, _lEnGtH); \ - } STMT_END +#define SvPV_shrink_to_cur(sv) \ + STMT_START { \ + const STRLEN _lEnGtH = SvCUR(sv) + 1; \ + SvPV_renew(sv, _lEnGtH); \ + } STMT_END /* =for apidoc Am|void|SvPV_free|SV * sv -Frees the PV buffer in C, leaving things in a precarious state, so should -only be used as part of a larger operation +Frees the PV buffer in C, leaving things in a precarious +state, so should only be used as part of a larger operation =cut */ -#define SvPV_free(sv) \ - STMT_START { \ - assert(SvTYPE(sv) >= SVt_PV); \ - if (SvLEN(sv)) { \ - assert(!SvROK(sv)); \ - if(UNLIKELY(SvOOK(sv))) { \ - STRLEN zok; \ - SvOOK_offset(sv, zok); \ - SvPV_set(sv, SvPVX_mutable(sv) - zok); \ - SvFLAGS(sv) &= ~SVf_OOK; \ - } \ - Safefree(SvPVX(sv)); \ - } \ - } STMT_END +#define SvPV_free(sv) \ + STMT_START { \ + assert(SvTYPE(sv) >= SVt_PV); \ + if (SvLEN(sv)) { \ + assert(!SvROK(sv)); \ + if(UNLIKELY(SvOOK(sv))) { \ + STRLEN zok; \ + SvOOK_offset(sv, zok); \ + SvPV_set(sv, SvPVX_mutable(sv) - zok); \ + SvFLAGS(sv) &= ~SVf_OOK; \ + } \ + Safefree(SvPVX(sv)); \ + } \ + } STMT_END #ifdef PERL_CORE -/* Code that crops up in three places to take a scalar and ready it to hold - a reference */ -# define prepare_SV_for_RV(sv) \ - STMT_START { \ - if (SvTYPE(sv) < SVt_PV && SvTYPE(sv) != SVt_IV) \ - sv_upgrade(sv, SVt_IV); \ - else if (SvTYPE(sv) >= SVt_PV) { \ - SvPV_free(sv); \ - SvLEN_set(sv, 0); \ - SvCUR_set(sv, 0); \ - } \ - } STMT_END +/* Code that crops up in three places to take a + scalar and ready it to hold a reference */ +# define prepare_SV_for_RV(sv) \ + STMT_START { \ + if (SvTYPE(sv) < SVt_PV && SvTYPE(sv) != SVt_IV) \ + sv_upgrade(sv, SVt_IV); \ + else if (SvTYPE(sv) >= SVt_PV) { \ + SvPV_free(sv); \ + SvLEN_set(sv, 0); \ + SvCUR_set(sv, 0); \ + } \ + } STMT_END #endif #ifndef PERL_CORE -# define BmFLAGS(sv) (SvTAIL(sv) ? FBMcf_TAIL : 0) +# define BmFLAGS(sv) (SvTAIL(sv) ? FBMcf_TAIL : 0) #endif #if defined (DEBUGGING) && defined(PERL_USE_GCC_BRACE_GROUPS) -# define BmUSEFUL(sv) \ - (*({ SV *const _bmuseful = MUTABLE_SV(sv); \ - assert(SvTYPE(_bmuseful) >= SVt_PVIV); \ - assert(SvVALID(_bmuseful)); \ - assert(!SvIOK(_bmuseful)); \ - &(((XPVIV*) SvANY(_bmuseful))->xiv_u.xivu_iv); \ - })) +# define BmUSEFUL(sv) \ + (*({ SV *const _bmuseful = MUTABLE_SV(sv); \ + assert(SvTYPE(_bmuseful) >= SVt_PVIV); \ + assert(SvVALID(_bmuseful)); \ + assert(!SvIOK(_bmuseful)); \ + &(((XPVIV*) SvANY(_bmuseful))->xiv_u.xivu_iv); \ + })) #else -# define BmUSEFUL(sv) ((XPVIV*) SvANY(sv))->xiv_u.xivu_iv +# define BmUSEFUL(sv) ((XPVIV*) SvANY(sv))->xiv_u.xivu_iv #endif #ifndef PERL_CORE -# define BmRARE(sv) 0 -# define BmPREVIOUS(sv) 0 +# define BmRARE(sv) 0 +# define BmPREVIOUS(sv) 0 #endif -#define FmLINES(sv) ((XPVIV*) SvANY(sv))->xiv_iv +#define FmLINES(sv) ((XPVIV*) SvANY(sv))->xiv_iv -#define LvTYPE(sv) ((XPVLV*) SvANY(sv))->xlv_type -#define LvTARG(sv) ((XPVLV*) SvANY(sv))->xlv_targ -#define LvTARGOFF(sv) ((XPVLV*) SvANY(sv))->xlv_targoff -#define LvSTARGOFF(sv) ((XPVLV*) SvANY(sv))->xlv_targoff_u.xlvu_stargoff -#define LvTARGLEN(sv) ((XPVLV*) SvANY(sv))->xlv_targlen -#define LvFLAGS(sv) ((XPVLV*) SvANY(sv))->xlv_flags +#define LvTYPE(sv) ((XPVLV*) SvANY(sv))->xlv_type +#define LvTARG(sv) ((XPVLV*) SvANY(sv))->xlv_targ +#define LvTARGOFF(sv) ((XPVLV*) SvANY(sv))->xlv_targoff +#define LvSTARGOFF(sv) ((XPVLV*) SvANY(sv))->xlv_targoff_u.xlvu_stargoff +#define LvTARGLEN(sv) ((XPVLV*) SvANY(sv))->xlv_targlen +#define LvFLAGS(sv) ((XPVLV*) SvANY(sv))->xlv_flags -#define LVf_NEG_OFF 0x1 -#define LVf_NEG_LEN 0x2 +#define LVf_NEG_OFF 0x1 +#define LVf_NEG_LEN 0x2 #define LVf_OUT_OF_RANGE 0x4 -#define IoIFP(sv) (sv)->sv_u.svu_fp -#define IoOFP(sv) ((XPVIO*) SvANY(sv))->xio_ofp -#define IoDIRP(sv) ((XPVIO*) SvANY(sv))->xio_dirp -#define IoANY(sv) ((XPVIO*) SvANY(sv))->xio_any -#define IoLINES(sv) ((XPVIO*) SvANY(sv))->xiv_u.xivu_iv -#define IoPAGE(sv) ((XPVIO*) SvANY(sv))->xio_page -#define IoPAGE_LEN(sv) ((XPVIO*) SvANY(sv))->xio_page_len +#define IoIFP(sv) (sv)->sv_u.svu_fp +#define IoOFP(sv) ((XPVIO*) SvANY(sv))->xio_ofp +#define IoDIRP(sv) ((XPVIO*) SvANY(sv))->xio_dirp +#define IoANY(sv) ((XPVIO*) SvANY(sv))->xio_any +#define IoLINES(sv) ((XPVIO*) SvANY(sv))->xiv_u.xivu_iv +#define IoPAGE(sv) ((XPVIO*) SvANY(sv))->xio_page +#define IoPAGE_LEN(sv) ((XPVIO*) SvANY(sv))->xio_page_len #define IoLINES_LEFT(sv)((XPVIO*) SvANY(sv))->xio_lines_left -#define IoTOP_NAME(sv) ((XPVIO*) SvANY(sv))->xio_top_name -#define IoTOP_GV(sv) ((XPVIO*) SvANY(sv))->xio_top_gv -#define IoFMT_NAME(sv) ((XPVIO*) SvANY(sv))->xio_fmt_name -#define IoFMT_GV(sv) ((XPVIO*) SvANY(sv))->xio_fmt_gv +#define IoTOP_NAME(sv) ((XPVIO*) SvANY(sv))->xio_top_name +#define IoTOP_GV(sv) ((XPVIO*) SvANY(sv))->xio_top_gv +#define IoFMT_NAME(sv) ((XPVIO*) SvANY(sv))->xio_fmt_name +#define IoFMT_GV(sv) ((XPVIO*) SvANY(sv))->xio_fmt_gv #define IoBOTTOM_NAME(sv)((XPVIO*) SvANY(sv))->xio_bottom_name -#define IoBOTTOM_GV(sv) ((XPVIO*) SvANY(sv))->xio_bottom_gv -#define IoTYPE(sv) ((XPVIO*) SvANY(sv))->xio_type -#define IoFLAGS(sv) ((XPVIO*) SvANY(sv))->xio_flags +#define IoBOTTOM_GV(sv) ((XPVIO*) SvANY(sv))->xio_bottom_gv +#define IoTYPE(sv) ((XPVIO*) SvANY(sv))->xio_type +#define IoFLAGS(sv) ((XPVIO*) SvANY(sv))->xio_flags /* IoTYPE(sv) is a single character telling the type of I/O connection. */ -#define IoTYPE_RDONLY '<' -#define IoTYPE_WRONLY '>' -#define IoTYPE_RDWR '+' -#define IoTYPE_APPEND 'a' -#define IoTYPE_PIPE '|' -#define IoTYPE_STD '-' /* stdin or stdout */ -#define IoTYPE_SOCKET 's' -#define IoTYPE_CLOSED ' ' -#define IoTYPE_IMPLICIT 'I' /* stdin or stdout or stderr */ -#define IoTYPE_NUMERIC '#' /* fdopen */ +#define IoTYPE_RDONLY '<' +#define IoTYPE_WRONLY '>' +#define IoTYPE_RDWR '+' +#define IoTYPE_APPEND 'a' +#define IoTYPE_PIPE '|' +#define IoTYPE_STD '-' /* stdin or stdout */ +#define IoTYPE_SOCKET 's' +#define IoTYPE_CLOSED ' ' +#define IoTYPE_IMPLICIT 'I' /* stdin or stdout or stderr */ +#define IoTYPE_NUMERIC '#' /* fdopen */ /* =for apidoc_section $tainting =for apidoc Am|bool|SvTAINTED|SV* sv -Checks to see if an SV is tainted. Returns TRUE if it is, FALSE if -not. +Checks to see if an SV is tainted. Returns TRUE if it is, FALSE if not. =for apidoc Am|void|SvTAINTED_on|SV* sv Marks an SV as tainted if tainting is enabled. @@ -1679,29 +1699,31 @@ untainting variables. =for apidoc Am|void|SvTAINT|SV* sv Taints an SV if tainting is enabled, and if some input to the current -expression is tainted--usually a variable, but possibly also implicit -inputs such as locale settings. C propagates that taintedness to -the outputs of an expression in a pessimistic fashion; i.e., without paying +expression is tainted--usually a variable, but possibly also implicit inputs +such as locale settings. C propagates that taintedness to the +outputs of an expression in a pessimistic fashion; i.e., without paying attention to precisely which outputs are influenced by which inputs. =cut */ -#define sv_taint(sv) sv_magic((sv), NULL, PERL_MAGIC_taint, NULL, 0) +#define sv_taint(sv) sv_magic((sv), NULL, PERL_MAGIC_taint, NULL, 0) #ifdef NO_TAINT_SUPPORT -# define SvTAINTED(sv) 0 +# define SvTAINTED(sv) 0 #else -# define SvTAINTED(sv) (SvMAGICAL(sv) && sv_tainted(sv)) +# define SvTAINTED(sv) (SvMAGICAL(sv) && sv_tainted(sv)) #endif -#define SvTAINTED_on(sv) STMT_START{ if(UNLIKELY(TAINTING_get)){sv_taint(sv);} }STMT_END -#define SvTAINTED_off(sv) STMT_START{ if(UNLIKELY(TAINTING_get)){sv_untaint(sv);} }STMT_END +#define SvTAINTED_on(sv) \ + STMT_START{ if(UNLIKELY(TAINTING_get)){sv_taint(sv);} }STMT_END +#define SvTAINTED_off(sv) \ + STMT_START{ if(UNLIKELY(TAINTING_get)){sv_untaint(sv);} }STMT_END -#define SvTAINT(sv) \ - STMT_START { \ +#define SvTAINT(sv) \ + STMT_START { \ assert(TAINTING_get || !TAINT_get); \ - if (UNLIKELY(TAINT_get)) \ - SvTAINTED_on(sv); \ + if (UNLIKELY(TAINT_get)) \ + SvTAINTED_on(sv); \ } STMT_END /* @@ -1725,11 +1747,11 @@ SV into containing a string (C>), and only a string (C>), by hook or by crook. You need to use one of these C routines if you are going to update the C> directly. -Note that coercing an arbitrary scalar into a plain PV will potentially -strip useful data from it. For example if the SV was C, then the -referent will have its reference count decremented, and the SV itself may -be converted to an C scalar with a string buffer containing a value -such as C<"ARRAY(0x1234)">. +Note that coercing an arbitrary scalar into a plain PV will potentially strip +useful data from it. For example if the SV was C, then the referent +will have its reference count decremented, and the SV itself may be converted +to an C scalar with a string buffer containing a value such as +C<"ARRAY(0x1234)">. The differences between the forms are: @@ -1746,9 +1768,9 @@ parameter. They should be used only when it is known that the PV is a C string, terminated by a NUL byte, and without intermediate NUL characters; or when you don't care about its length. -The forms with C in their names are effectively the same as those without, -but the name emphasizes that the string is modifiable by the caller, which it is -in all the forms. +The forms with C in their names are effectively the same as those +without, but the name emphasizes that the string is modifiable by the caller, +which it is in all the forms. C is like C, but converts C to UTF-8 first if not already UTF-8. @@ -1812,11 +1834,11 @@ see C>. The differences between the forms are: The forms with neither C nor C in their names (e.g., C or -C) can expose the SV's internal string buffer. If -that buffer consists entirely of bytes 0-255 and includes any bytes above -127, then you B consult C to determine the actual code points -the string is meant to contain. Generally speaking, it is probably safer to -prefer C, C, and the like. See +C) can expose the SV's internal string buffer. If that buffer +consists entirely of bytes 0-255 and includes any bytes above 127, then you +B consult C to determine the actual code points the string is +meant to contain. Generally speaking, it is probably safer to prefer +C, C, and the like. See L for more details. The forms with C in their names allow you to use the C parameter @@ -1867,17 +1889,16 @@ is like C, but when C is undef, it returns C. These return a boolean indicating whether Perl would evaluate the SV as true or false. See C> for a defined/undefined test. -As of Perl 5.32, all are guaranteed to evaluate C only once. Prior to that -release, only C guaranteed single evaluation; now C is +As of Perl 5.32, all are guaranteed to evaluate C only once. Prior to +that release, only C guaranteed single evaluation; now C is identical to C. C and C do not perform 'get' magic; the others do unless the scalar is already C, C, or C (the public, not the private flags). -C is like C>, but C is assumed to be -non-null (NN). If there is a possibility that it is NULL, use plain -C. +C is like C>, but C is assumed to be non-null (NN). +If there is a possibility that it is NULL, use plain C. C is like C>, but C is assumed to be non-null (NN). If there is a possibility that it is NULL, use plain @@ -1907,8 +1928,8 @@ typedef enum { START_EXTERN_C -/* When this code was written, embed.fnc could not handle function pointer - * parameters; perhaps it still can't */ +/* When this code was written, embed.fnc could not handle function + * pointer parameters; perhaps it still can't */ #ifndef PERL_NO_INLINE_FUNCTIONS PERL_STATIC_INLINE char* Perl_SvPV_helper(pTHX_ SV *const sv, STRLEN *const lp, const U32 flags, const PL_SvPVtype type, char * (*non_trivial)(pTHX_ SV *, STRLEN * const, const U32), const bool or_null, const U32 return_flags); @@ -1916,37 +1937,35 @@ Perl_SvPV_helper(pTHX_ SV *const sv, STRLEN *const lp, const U32 flags, const PL END_EXTERN_C -/* This test is "is there a cached PV that we can use directly?" - * We can if - * a) SVf_POK is true and there's definitely no get magic on the scalar - * b) SVp_POK is true, there's no get magic, and we know that the cached PV - * came from an IV conversion. - * For the latter case, we don't set SVf_POK so that we can distinguish whether - * the value originated as a string or as an integer, before we cached the - * second representation. */ -#define SvPOK_or_cached_IV(sv) \ +/* This test is "is there a cached PV that we can use directly?" We can if + * a) SVf_POK is true and there's definitely no get magic on the scalar b) + * SVp_POK is true, there's no get magic, and we know that the cached PV + * came from an IV conversion. For the latter case, we don't set SVf_POK + * so that we can distinguish whether the value originated as a string or + * as an integer, before we cached the second representation. */ +#define SvPOK_or_cached_IV(sv) \ (((SvFLAGS(sv) & (SVf_POK|SVs_GMG)) == SVf_POK) || ((SvFLAGS(sv) & (SVf_IOK|SVp_POK|SVs_GMG)) == (SVf_IOK|SVp_POK))) -#define SvPV_flags(sv, len, flags) \ - Perl_SvPV_helper(aTHX_ sv, &len, flags, SvPVnormal_type_, \ - Perl_sv_2pv_flags, FALSE, 0) -#define SvPV_flags_const(sv, len, flags) \ - ((const char*) Perl_SvPV_helper(aTHX_ sv, &len, flags, SvPVnormal_type_, \ - Perl_sv_2pv_flags, FALSE, \ - SV_CONST_RETURN)) -#define SvPV_flags_const_nolen(sv, flags) \ - ((const char*) Perl_SvPV_helper(aTHX_ sv, NULL, flags, SvPVnormal_type_, \ - Perl_sv_2pv_flags, FALSE, \ - SV_CONST_RETURN)) -#define SvPV_flags_mutable(sv, len, flags) \ - Perl_SvPV_helper(aTHX_ sv, &len, flags, SvPVnormal_type_, \ +#define SvPV_flags(sv, len, flags) \ + Perl_SvPV_helper(aTHX_ sv, &len, flags, SvPVnormal_type_, \ + Perl_sv_2pv_flags, FALSE, 0) +#define SvPV_flags_const(sv, len, flags) \ + ((const char*) Perl_SvPV_helper(aTHX_ sv, &len, flags, SvPVnormal_type_, \ + Perl_sv_2pv_flags, FALSE, \ + SV_CONST_RETURN)) +#define SvPV_flags_const_nolen(sv, flags) \ + ((const char*) Perl_SvPV_helper(aTHX_ sv, NULL, flags, SvPVnormal_type_, \ + Perl_sv_2pv_flags, FALSE, \ + SV_CONST_RETURN)) +#define SvPV_flags_mutable(sv, len, flags) \ + Perl_SvPV_helper(aTHX_ sv, &len, flags, SvPVnormal_type_, \ Perl_sv_2pv_flags, FALSE, SV_MUTABLE_RETURN) -#define SvPV_nolen(sv) \ - Perl_SvPV_helper(aTHX_ sv, NULL, SV_GMAGIC, SvPVnormal_type_, \ +#define SvPV_nolen(sv) \ + Perl_SvPV_helper(aTHX_ sv, NULL, SV_GMAGIC, SvPVnormal_type_, \ Perl_sv_2pv_flags, FALSE, 0) -#define SvPV_nolen_const(sv) SvPV_flags_const_nolen(sv, SV_GMAGIC) +#define SvPV_nolen_const(sv) SvPV_flags_const_nolen(sv, SV_GMAGIC) #define SvPV(sv, len) SvPV_flags(sv, len, SV_GMAGIC) #define SvPV_const(sv, len) SvPV_flags_const(sv, len, SV_GMAGIC) @@ -1959,14 +1978,14 @@ END_EXTERN_C #define SvPV_nomg_const(sv, len) SvPV_flags_const(sv, len, 0) #define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0) -#define SvPV_force_flags(sv, len, flags) \ - Perl_SvPV_helper(aTHX_ sv, &len, flags, SvPVforce_type_, \ +#define SvPV_force_flags(sv, len, flags) \ + Perl_SvPV_helper(aTHX_ sv, &len, flags, SvPVforce_type_, \ Perl_sv_pvn_force_flags, FALSE, 0) -#define SvPV_force_flags_nolen(sv, flags) \ - Perl_SvPV_helper(aTHX_ sv, NULL, flags, SvPVforce_type_, \ +#define SvPV_force_flags_nolen(sv, flags) \ + Perl_SvPV_helper(aTHX_ sv, NULL, flags, SvPVforce_type_, \ Perl_sv_pvn_force_flags, FALSE, 0) -#define SvPV_force_flags_mutable(sv, len, flags) \ - Perl_SvPV_helper(aTHX_ sv, &len, flags, SvPVforce_type_, \ +#define SvPV_force_flags_mutable(sv, len, flags) \ + Perl_SvPV_helper(aTHX_ sv, &len, flags, SvPVforce_type_, \ Perl_sv_pvn_force_flags, FALSE, SV_MUTABLE_RETURN) #define SvPV_force(sv, len) SvPV_force_flags(sv, len, SV_GMAGIC) @@ -1977,103 +1996,105 @@ END_EXTERN_C #define SvPV_force_nomg(sv, len) SvPV_force_flags(sv, len, 0) #define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0) -#define SvPVutf8(sv, len) \ - Perl_SvPV_helper(aTHX_ sv, &len, SV_GMAGIC, SvPVutf8_type_, \ +#define SvPVutf8(sv, len) \ + Perl_SvPV_helper(aTHX_ sv, &len, SV_GMAGIC, SvPVutf8_type_, \ Perl_sv_2pvutf8_flags, FALSE, 0) -#define SvPVutf8_nomg(sv, len) \ - Perl_SvPV_helper(aTHX_ sv, &len, 0, SvPVutf8_type_, \ +#define SvPVutf8_nomg(sv, len) \ + Perl_SvPV_helper(aTHX_ sv, &len, 0, SvPVutf8_type_, \ Perl_sv_2pvutf8_flags, FALSE, 0) -#define SvPVutf8_nolen(sv) \ - Perl_SvPV_helper(aTHX_ sv, NULL, SV_GMAGIC, SvPVutf8_type_, \ +#define SvPVutf8_nolen(sv) \ + Perl_SvPV_helper(aTHX_ sv, NULL, SV_GMAGIC, SvPVutf8_type_, \ Perl_sv_2pvutf8_flags, FALSE, 0) -#define SvPVutf8_or_null(sv, len) \ - Perl_SvPV_helper(aTHX_ sv, &len, SV_GMAGIC, SvPVutf8_type_, \ +#define SvPVutf8_or_null(sv, len) \ + Perl_SvPV_helper(aTHX_ sv, &len, SV_GMAGIC, SvPVutf8_type_, \ Perl_sv_2pvutf8_flags, TRUE, 0) -#define SvPVutf8_or_null_nomg(sv, len) \ - Perl_SvPV_helper(aTHX_ sv, &len, 0, SvPVutf8_type_, \ +#define SvPVutf8_or_null_nomg(sv, len) \ + Perl_SvPV_helper(aTHX_ sv, &len, 0, SvPVutf8_type_, \ Perl_sv_2pvutf8_flags, TRUE, 0) -#define SvPVbyte(sv, len) \ - Perl_SvPV_helper(aTHX_ sv, &len, SV_GMAGIC, SvPVbyte_type_, \ +#define SvPVbyte(sv, len) \ + Perl_SvPV_helper(aTHX_ sv, &len, SV_GMAGIC, SvPVbyte_type_, \ Perl_sv_2pvbyte_flags, FALSE, 0) -#define SvPVbyte_nomg(sv, len) \ - Perl_SvPV_helper(aTHX_ sv, &len, 0, SvPVbyte_type_, \ +#define SvPVbyte_nomg(sv, len) \ + Perl_SvPV_helper(aTHX_ sv, &len, 0, SvPVbyte_type_, \ Perl_sv_2pvbyte_flags, FALSE, 0) -#define SvPVbyte_nolen(sv) \ - Perl_SvPV_helper(aTHX_ sv, NULL, SV_GMAGIC, SvPVbyte_type_, \ +#define SvPVbyte_nolen(sv) \ + Perl_SvPV_helper(aTHX_ sv, NULL, SV_GMAGIC, SvPVbyte_type_, \ Perl_sv_2pvbyte_flags, FALSE, 0) -#define SvPVbyte_or_null(sv, len) \ - Perl_SvPV_helper(aTHX_ sv, &len, SV_GMAGIC, SvPVbyte_type_, \ +#define SvPVbyte_or_null(sv, len) \ + Perl_SvPV_helper(aTHX_ sv, &len, SV_GMAGIC, SvPVbyte_type_, \ Perl_sv_2pvbyte_flags, TRUE, 0) -#define SvPVbyte_or_null_nomg(sv, len) \ - Perl_SvPV_helper(aTHX_ sv, &len, 0, SvPVbyte_type_, \ +#define SvPVbyte_or_null_nomg(sv, len) \ + Perl_SvPV_helper(aTHX_ sv, &len, 0, SvPVbyte_type_, \ Perl_sv_2pvbyte_flags, TRUE, 0) -#define SvPVutf8_force(sv, len) \ - Perl_SvPV_helper(aTHX_ sv, &len, 0, SvPVutf8_pure_type_, \ +#define SvPVutf8_force(sv, len) \ + Perl_SvPV_helper(aTHX_ sv, &len, 0, SvPVutf8_pure_type_, \ Perl_sv_pvutf8n_force_wrapper, FALSE, 0) -#define SvPVbyte_force(sv, len) \ - Perl_SvPV_helper(aTHX_ sv, &len, 0, SvPVbyte_pure_type_, \ +#define SvPVbyte_force(sv, len) \ + Perl_SvPV_helper(aTHX_ sv, &len, 0, SvPVbyte_pure_type_, \ Perl_sv_pvbyten_force_wrapper, FALSE, 0) -/* define FOOx(): Before FOO(x) was inlined, these were idempotent versions of - * FOO(). */ +/* define FOOx(): Before FOO(x) was inlined, these + * were idempotent versions of FOO(). */ -#define SvPVx_force(sv, len) sv_pvn_force(sv, &len) -#define SvPVutf8x_force(sv, len) sv_pvutf8n_force(sv, &len) -#define SvPVbytex_force(sv, len) sv_pvbyten_force(sv, &len) +#define SvPVx_force(sv, len) sv_pvn_force(sv, &len) +#define SvPVutf8x_force(sv, len) sv_pvutf8n_force(sv, &len) +#define SvPVbytex_force(sv, len) sv_pvbyten_force(sv, &len) -#define SvTRUEx(sv) SvTRUE(sv) -#define SvTRUEx_nomg(sv) SvTRUE_nomg(sv) -#define SvTRUE_nomg_NN(sv) SvTRUE_common(sv, TRUE) +#define SvTRUEx(sv) SvTRUE(sv) +#define SvTRUEx_nomg(sv) SvTRUE_nomg(sv) +#define SvTRUE_nomg_NN(sv) SvTRUE_common(sv, TRUE) -# define SvIVx(sv) SvIV(sv) -# define SvUVx(sv) SvUV(sv) -# define SvNVx(sv) SvNV(sv) +# define SvIVx(sv) SvIV(sv) +# define SvUVx(sv) SvUV(sv) +# define SvNVx(sv) SvNV(sv) #if defined(PERL_USE_GCC_BRACE_GROUPS) -# define SvPVx(sv, len) ({SV *_sv = (sv); SvPV(_sv, len); }) -# define SvPVx_const(sv, len) ({SV *_sv = (sv); SvPV_const(_sv, len); }) -# define SvPVx_nolen(sv) ({SV *_sv = (sv); SvPV_nolen(_sv); }) -# define SvPVx_nolen_const(sv) ({SV *_sv = (sv); SvPV_nolen_const(_sv); }) -# define SvPVutf8x(sv, len) ({SV *_sv = (sv); SvPVutf8(_sv, len); }) -# define SvPVbytex(sv, len) ({SV *_sv = (sv); SvPVbyte(_sv, len); }) -# define SvPVbytex_nolen(sv) ({SV *_sv = (sv); SvPVbyte_nolen(_sv); }) +# define SvPVx(sv, len) ({SV *_sv = (sv); SvPV(_sv, len); }) +# define SvPVx_const(sv, len) ({SV *_sv = (sv); SvPV_const(_sv, len); }) +# define SvPVx_nolen(sv) ({SV *_sv = (sv); SvPV_nolen(_sv); }) +# define SvPVx_nolen_const(sv) ({SV *_sv = (sv); SvPV_nolen_const(_sv); }) +# define SvPVutf8x(sv, len) ({SV *_sv = (sv); SvPVutf8(_sv, len); }) +# define SvPVbytex(sv, len) ({SV *_sv = (sv); SvPVbyte(_sv, len); }) +# define SvPVbytex_nolen(sv) ({SV *_sv = (sv); SvPVbyte_nolen(_sv); }) #else /* __GNUC__ */ /* These inlined macros use globals, which will require a thread * declaration in user code, so we avoid them under threads */ -# define SvPVx(sv, len) ((PL_Sv = (sv)), SvPV(PL_Sv, len)) -# define SvPVx_const(sv, len) ((PL_Sv = (sv)), SvPV_const(PL_Sv, len)) -# define SvPVx_nolen(sv) ((PL_Sv = (sv)), SvPV_nolen(PL_Sv)) -# define SvPVx_nolen_const(sv) ((PL_Sv = (sv)), SvPV_nolen_const(PL_Sv)) -# define SvPVutf8x(sv, len) ((PL_Sv = (sv)), SvPVutf8(PL_Sv, len)) -# define SvPVbytex(sv, len) ((PL_Sv = (sv)), SvPVbyte(PL_Sv, len)) -# define SvPVbytex_nolen(sv) ((PL_Sv = (sv)), SvPVbyte_nolen(PL_Sv)) +# define SvPVx(sv, len) ((PL_Sv = (sv)), SvPV(PL_Sv, len)) +# define SvPVx_const(sv, len) ((PL_Sv = (sv)), SvPV_const(PL_Sv, len)) +# define SvPVx_nolen(sv) ((PL_Sv = (sv)), SvPV_nolen(PL_Sv)) +# define SvPVx_nolen_const(sv) ((PL_Sv = (sv)), SvPV_nolen_const(PL_Sv)) +# define SvPVutf8x(sv, len) ((PL_Sv = (sv)), SvPVutf8(PL_Sv, len)) +# define SvPVbytex(sv, len) ((PL_Sv = (sv)), SvPVbyte(PL_Sv, len)) +# define SvPVbytex_nolen(sv) ((PL_Sv = (sv)), SvPVbyte_nolen(PL_Sv)) #endif /* __GNU__ */ -#define SvIsCOW(sv) (SvFLAGS(sv) & SVf_IsCOW) -#define SvIsCOW_on(sv) (SvFLAGS(sv) |= SVf_IsCOW) -#define SvIsCOW_off(sv) (SvFLAGS(sv) &= ~(SVf_IsCOW|SVppv_STATIC)) -#define SvIsCOW_shared_hash(sv) ((SvFLAGS(sv) & (SVf_IsCOW|SVppv_STATIC)) == (SVf_IsCOW) && SvLEN(sv) == 0) -#define SvIsCOW_static(sv) ((SvFLAGS(sv) & (SVf_IsCOW|SVppv_STATIC)) == (SVf_IsCOW|SVppv_STATIC)) +#define SvIsCOW(sv) (SvFLAGS(sv) & SVf_IsCOW) +#define SvIsCOW_on(sv) (SvFLAGS(sv) |= SVf_IsCOW) +#define SvIsCOW_off(sv) (SvFLAGS(sv) &= ~(SVf_IsCOW|SVppv_STATIC)) +#define SvIsCOW_shared_hash(sv) \ + ((SvFLAGS(sv) & (SVf_IsCOW|SVppv_STATIC)) == (SVf_IsCOW) && SvLEN(sv) == 0) +#define SvIsCOW_static(sv) \ + ((SvFLAGS(sv) & (SVf_IsCOW|SVppv_STATIC)) == (SVf_IsCOW|SVppv_STATIC)) -#define SvSHARED_HEK_FROM_PV(pvx) \ - ((struct hek*)(pvx - STRUCT_OFFSET(struct hek, hek_key))) +#define SvSHARED_HEK_FROM_PV(pvx) \ + ((struct hek*)(pvx - STRUCT_OFFSET(struct hek, hek_key))) /* =for apidoc Am|struct hek*|SvSHARED_HASH|SV * sv Returns the hash for C created by C>. =cut */ -#define SvSHARED_HASH(sv) (0 + SvSHARED_HEK_FROM_PV(SvPVX_const(sv))->hek_hash) +#define SvSHARED_HASH(sv) (0 + SvSHARED_HEK_FROM_PV(SvPVX_const(sv))->hek_hash) /* flag values for sv_*_flags functions */ -#define SV_UTF8_NO_ENCODING 0 /* No longer used */ +#define SV_UTF8_NO_ENCODING 0 /* No longer used */ /* =for apidoc AmnhD||SV_UTF8_NO_ENCODING @@ -2082,197 +2103,204 @@ Returns the hash for C created by C>. */ /* Flags used as `U32 flags` arguments to various functions */ -#define SV_IMMEDIATE_UNREF (1 << 0) /* 0x0001 - 1 */ -#define SV_GMAGIC (1 << 1) /* 0x0002 - 2 */ -#define SV_COW_DROP_PV (1 << 2) /* 0x0004 - 4 */ -#define SV_FLAG_BIT3_UNUSED (1 << 3) /* 0x0008 - 8 */ -#define SV_NOSTEAL (1 << 4) /* 0x0010 - 16 */ -#define SV_CONST_RETURN (1 << 5) /* 0x0020 - 32 */ -#define SV_MUTABLE_RETURN (1 << 6) /* 0x0040 - 64 */ -#define SV_SMAGIC (1 << 7) /* 0x0080 - 128 */ -#define SV_HAS_TRAILING_NUL (1 << 8) /* 0x0100 - 256 */ -#define SV_COW_SHARED_HASH_KEYS (1 << 9) /* 0x0200 - 512 */ +#define SV_IMMEDIATE_UNREF (1 << 0) /* 0x0001 - 1 */ +#define SV_GMAGIC (1 << 1) /* 0x0002 - 2 */ +#define SV_COW_DROP_PV (1 << 2) /* 0x0004 - 4 */ +#define SV_FLAG_BIT3_UNUSED (1 << 3) /* 0x0008 - 8 */ +#define SV_NOSTEAL (1 << 4) /* 0x0010 - 16 */ +#define SV_CONST_RETURN (1 << 5) /* 0x0020 - 32 */ +#define SV_MUTABLE_RETURN (1 << 6) /* 0x0040 - 64 */ +#define SV_SMAGIC (1 << 7) /* 0x0080 - 128 */ +#define SV_HAS_TRAILING_NUL (1 << 8) /* 0x0100 - 256 */ +#define SV_COW_SHARED_HASH_KEYS (1 << 9) /* 0x0200 - 512 */ /* This one is only enabled for PERL_OLD_COPY_ON_WRITE */ /* XXX This flag actually enabled for any COW. But it appears not to do - anything. Can we just remove it? Or will it serve some future - purpose. */ -#define SV_COW_OTHER_PVS (1 << 10) /* 0x0400 - 1024 */ -/* Make sv_2pv_flags return NULL if something is undefined. */ -#define SV_UNDEF_RETURNS_NULL (1 << 11) /* 0x0800 - 2048 */ -/* Tell sv_utf8_upgrade() to not check to see if an upgrade is really needed. - * This is used when the caller has already determined it is, and avoids - * redundant work */ -#define SV_FORCE_UTF8_UPGRADE (1 << 12) /* 0x1000 - 4096 */ + anything. Can we just remove it? Or will it serve some future purpose. */ +#define SV_COW_OTHER_PVS (1 << 10) /* 0x0400 - 1024 */ +/* Make sv_2pv_flags return NULL if something is undefined. */ +#define SV_UNDEF_RETURNS_NULL (1 << 11) /* 0x0800 - 2048 */ +/* Tell sv_utf8_upgrade() to not check to see if an upgrade + * is really needed. This is used when the caller has + * already determined it is, and avoids redundant work */ +#define SV_FORCE_UTF8_UPGRADE (1 << 12) /* 0x1000 - 4096 */ /* if (after resolving magic etc), the SV is found to be overloaded, * don't call the overload magic, just return as-is */ -#define SV_SKIP_OVERLOAD (1 << 13) /* 0x2000 - 8192 */ -#define SV_CATBYTES (1 << 14) /* 0x4000 - 16384 */ -#define SV_CATUTF8 (1 << 15) /* 0x8000 - 32768 */ +#define SV_SKIP_OVERLOAD (1 << 13) /* 0x2000 - 8192 */ +#define SV_CATBYTES (1 << 14) /* 0x4000 - 16384 */ +#define SV_CATUTF8 (1 << 15) /* 0x8000 - 32768 */ -/* The core is safe for this COW optimisation. XS code on CPAN may not be. - So only default to doing the COW setup if we're in the core. +/* The core is safe for this COW optimisation. XS code on CPAN may not + be. So only default to doing the COW setup if we're in the core. */ #ifdef PERL_CORE # ifndef SV_DO_COW_SVSETSV -# define SV_DO_COW_SVSETSV SV_COW_SHARED_HASH_KEYS|SV_COW_OTHER_PVS +# define SV_DO_COW_SVSETSV SV_COW_SHARED_HASH_KEYS|SV_COW_OTHER_PVS # endif #endif #ifndef SV_DO_COW_SVSETSV -# define SV_DO_COW_SVSETSV 0 +# define SV_DO_COW_SVSETSV 0 #endif -#define sv_unref(sv) sv_unref_flags(sv, 0) -#define sv_force_normal(sv) sv_force_normal_flags(sv, 0) -#define sv_usepvn(sv, p, l) sv_usepvn_flags(sv, p, l, 0) -#define sv_usepvn_mg(sv, p, l) sv_usepvn_flags(sv, p, l, SV_SMAGIC) +#define sv_unref(sv) sv_unref_flags(sv, 0) +#define sv_force_normal(sv) sv_force_normal_flags(sv, 0) +#define sv_usepvn(sv, p, l) sv_usepvn_flags(sv, p, l, 0) +#define sv_usepvn_mg(sv, p, l) sv_usepvn_flags(sv, p, l, SV_SMAGIC) /* =for apidoc Am|void|SV_CHECK_THINKFIRST_COW_DROP|SV * sv Call this when you are about to replace the PV value in C, which is potentially copy-on-write. It stops any sharing with other SVs, so that no -Copy on Write (COW) actually happens. This COW would be useless, as it would -immediately get changed to something else. This function also removes any -other encumbrances that would be problematic when changing C. +Copy on Write (COW) actually happens. This COW would be useless, as it +would immediately get changed to something else. This function also removes +any other encumbrances that would be problematic when changing C. =cut */ -#define SV_CHECK_THINKFIRST_COW_DROP(sv) if (SvTHINKFIRST(sv)) \ +#define SV_CHECK_THINKFIRST_COW_DROP(sv) \ + if (SvTHINKFIRST(sv)) \ sv_force_normal_flags(sv, SV_COW_DROP_PV) #ifdef PERL_COPY_ON_WRITE -# define SvCANCOW(sv) \ - (SvIsCOW(sv) \ - ? SvLEN(sv) ? CowREFCNT(sv) != SV_COW_REFCNT_MAX : 1 \ - : (SvFLAGS(sv) & CAN_COW_MASK) == CAN_COW_FLAGS \ +# define SvCANCOW(sv) \ + (SvIsCOW(sv) \ + ? SvLEN(sv) ? CowREFCNT(sv) != SV_COW_REFCNT_MAX : 1 \ + : (SvFLAGS(sv) & CAN_COW_MASK) == CAN_COW_FLAGS \ && SvCUR(sv)+1 < SvLEN(sv)) /* Note: To allow 256 COW "copies", a refcnt of 0 means 1. */ -# define CowREFCNT(sv) (*(U8 *)(SvPVX(sv)+SvLEN(sv)-1)) -# define SV_COW_REFCNT_MAX nBIT_UMAX(sizeof(U8) * CHARBITS) -# define CAN_COW_MASK (SVf_POK|SVf_ROK|SVp_POK|SVf_FAKE| \ - SVf_OOK|SVf_BREAK|SVf_READONLY|SVf_PROTECT) +# define CowREFCNT(sv) (*(U8 *)(SvPVX(sv)+SvLEN(sv)-1)) +# define SV_COW_REFCNT_MAX nBIT_UMAX(sizeof(U8) * CHARBITS) +# define CAN_COW_MASK \ + (SVf_POK|SVf_ROK|SVp_POK|SVf_FAKE| \ + SVf_OOK|SVf_BREAK|SVf_READONLY|SVf_PROTECT) #endif -#define CAN_COW_FLAGS (SVp_POK|SVf_POK) +#define CAN_COW_FLAGS (SVp_POK|SVf_POK) /* =for apidoc Am|void|SV_CHECK_THINKFIRST|SV * sv -Remove any encumbrances from C, that need to be taken care of before it -is modifiable. For example if it is Copy on Write (COW), now is the time to -make that copy. +Remove any encumbrances from C, that need to be taken care +of before it is modifiable. For example if it is Copy on Write +(COW), now is the time to make that copy. -If you know that you are about to change the PV value of C, instead use -L> to avoid the write that would be -immediately written again. +If you know that you are about to change the PV value of C, +instead use L> to avoid the +write that would be immediately written again. =cut */ -#define SV_CHECK_THINKFIRST(sv) if (SvTHINKFIRST(sv)) \ - sv_force_normal_flags(sv, 0) +#define SV_CHECK_THINKFIRST(sv) \ + if (SvTHINKFIRST(sv)) \ + sv_force_normal_flags(sv, 0) /* all these 'functions' are now just macros */ -#define sv_pv(sv) SvPV_nolen(sv) -#define sv_pvutf8(sv) SvPVutf8_nolen(sv) -#define sv_pvbyte(sv) SvPVbyte_nolen(sv) - -#define sv_pvn_force_nomg(sv, lp) sv_pvn_force_flags(sv, lp, 0) -#define sv_utf8_upgrade_flags(sv, flags) sv_utf8_upgrade_flags_grow(sv, flags, 0) -#define sv_utf8_upgrade_nomg(sv) sv_utf8_upgrade_flags(sv, 0) -#define sv_utf8_downgrade(sv, fail_ok) sv_utf8_downgrade_flags(sv, fail_ok, SV_GMAGIC) -#define sv_utf8_downgrade_nomg(sv, fail_ok) sv_utf8_downgrade_flags(sv, fail_ok, 0) +#define sv_pv(sv) SvPV_nolen(sv) +#define sv_pvutf8(sv) SvPVutf8_nolen(sv) +#define sv_pvbyte(sv) SvPVbyte_nolen(sv) + +#define sv_pvn_force_nomg(sv, lp) sv_pvn_force_flags(sv, lp, 0) +#define sv_utf8_upgrade_flags(sv, flags) \ + sv_utf8_upgrade_flags_grow(sv, flags, 0) +#define sv_utf8_upgrade_nomg(sv) sv_utf8_upgrade_flags(sv, 0) +#define sv_utf8_downgrade(sv, fail_ok) \ + sv_utf8_downgrade_flags(sv, fail_ok, SV_GMAGIC) +#define sv_utf8_downgrade_nomg(sv, fail_ok) \ + sv_utf8_downgrade_flags(sv, fail_ok, 0) #define sv_catpvn_nomg(dsv, sstr, slen) sv_catpvn_flags(dsv, sstr, slen, 0) -#define sv_catpv_nomg(dsv, sstr) sv_catpv_flags(dsv, sstr, 0) -#define sv_setsv(dsv, ssv) \ - sv_setsv_flags(dsv, ssv, SV_GMAGIC|SV_DO_COW_SVSETSV) -#define sv_setsv_nomg(dsv, ssv) sv_setsv_flags(dsv, ssv, SV_DO_COW_SVSETSV) -#define sv_catsv(dsv, ssv) sv_catsv_flags(dsv, ssv, SV_GMAGIC) -#define sv_catsv_nomg(dsv, ssv) sv_catsv_flags(dsv, ssv, 0) -#define sv_catsv_mg(dsv, ssv) sv_catsv_flags(dsv, ssv, SV_GMAGIC|SV_SMAGIC) -#define sv_catpvn(dsv, sstr, slen) sv_catpvn_flags(dsv, sstr, slen, SV_GMAGIC) -#define sv_catpvn_mg(dsv, sstr, slen) sv_catpvn_flags(dsv, sstr, slen, SV_GMAGIC|SV_SMAGIC); -#define sv_copypv(dsv, ssv) sv_copypv_flags(dsv, ssv, SV_GMAGIC) -#define sv_copypv_nomg(dsv, ssv) sv_copypv_flags(dsv, ssv, 0) -#define sv_2pv(sv, lp) sv_2pv_flags(sv, lp, SV_GMAGIC) -#define sv_2pv_nolen(sv) sv_2pv(sv, 0) -#define sv_2pvbyte(sv, lp) sv_2pvbyte_flags(sv, lp, SV_GMAGIC) -#define sv_2pvbyte_nolen(sv) sv_2pvbyte(sv, 0) -#define sv_2pvutf8(sv, lp) sv_2pvutf8_flags(sv, lp, SV_GMAGIC) -#define sv_2pvutf8_nolen(sv) sv_2pvutf8(sv, 0) -#define sv_2pv_nomg(sv, lp) sv_2pv_flags(sv, lp, 0) -#define sv_pvn_force(sv, lp) sv_pvn_force_flags(sv, lp, SV_GMAGIC) -#define sv_utf8_upgrade(sv) sv_utf8_upgrade_flags(sv, SV_GMAGIC) -#define sv_2iv(sv) sv_2iv_flags(sv, SV_GMAGIC) -#define sv_2uv(sv) sv_2uv_flags(sv, SV_GMAGIC) -#define sv_2nv(sv) sv_2nv_flags(sv, SV_GMAGIC) -#define sv_eq(sv1, sv2) sv_eq_flags(sv1, sv2, SV_GMAGIC) -#define sv_cmp(sv1, sv2) sv_cmp_flags(sv1, sv2, SV_GMAGIC) -#define sv_cmp_locale(sv1, sv2) sv_cmp_locale_flags(sv1, sv2, SV_GMAGIC) -#define sv_numeq(sv1, sv2) sv_numeq_flags(sv1, sv2, SV_GMAGIC) -#define sv_streq(sv1, sv2) sv_streq_flags(sv1, sv2, SV_GMAGIC) -#define sv_collxfrm(sv, nxp) sv_collxfrm_flags(sv, nxp, SV_GMAGIC) -#define sv_2bool(sv) sv_2bool_flags(sv, SV_GMAGIC) -#define sv_2bool_nomg(sv) sv_2bool_flags(sv, 0) -#define sv_insert(bigstr, offset, len, little, littlelen) \ - Perl_sv_insert_flags(aTHX_ (bigstr),(offset), (len), (little), \ - (littlelen), SV_GMAGIC) -#define sv_mortalcopy(sv) \ - Perl_sv_mortalcopy_flags(aTHX_ sv, SV_GMAGIC|SV_DO_COW_SVSETSV) -#define sv_cathek(sv,hek) \ - STMT_START { \ - HEK * const bmxk = hek; \ - sv_catpvn_flags(sv, HEK_KEY(bmxk), HEK_LEN(bmxk), \ - HEK_UTF8(bmxk) ? SV_CATUTF8 : SV_CATBYTES); \ - } STMT_END +#define sv_catpv_nomg(dsv, sstr) sv_catpv_flags(dsv, sstr, 0) +#define sv_setsv(dsv, ssv) \ + sv_setsv_flags(dsv, ssv, SV_GMAGIC|SV_DO_COW_SVSETSV) +#define sv_setsv_nomg(dsv, ssv) sv_setsv_flags(dsv, ssv, SV_DO_COW_SVSETSV) +#define sv_catsv(dsv, ssv) sv_catsv_flags(dsv, ssv, SV_GMAGIC) +#define sv_catsv_nomg(dsv, ssv) sv_catsv_flags(dsv, ssv, 0) +#define sv_catsv_mg(dsv, ssv) sv_catsv_flags(dsv, ssv, SV_GMAGIC|SV_SMAGIC) +#define sv_catpvn(dsv, sstr, slen) sv_catpvn_flags(dsv, sstr, slen, SV_GMAGIC) +#define sv_catpvn_mg(dsv, sstr, slen) \ + sv_catpvn_flags(dsv, sstr, slen, SV_GMAGIC|SV_SMAGIC); +#define sv_copypv(dsv, ssv) sv_copypv_flags(dsv, ssv, SV_GMAGIC) +#define sv_copypv_nomg(dsv, ssv) sv_copypv_flags(dsv, ssv, 0) +#define sv_2pv(sv, lp) sv_2pv_flags(sv, lp, SV_GMAGIC) +#define sv_2pv_nolen(sv) sv_2pv(sv, 0) +#define sv_2pvbyte(sv, lp) sv_2pvbyte_flags(sv, lp, SV_GMAGIC) +#define sv_2pvbyte_nolen(sv) sv_2pvbyte(sv, 0) +#define sv_2pvutf8(sv, lp) sv_2pvutf8_flags(sv, lp, SV_GMAGIC) +#define sv_2pvutf8_nolen(sv) sv_2pvutf8(sv, 0) +#define sv_2pv_nomg(sv, lp) sv_2pv_flags(sv, lp, 0) +#define sv_pvn_force(sv, lp) sv_pvn_force_flags(sv, lp, SV_GMAGIC) +#define sv_utf8_upgrade(sv) sv_utf8_upgrade_flags(sv, SV_GMAGIC) +#define sv_2iv(sv) sv_2iv_flags(sv, SV_GMAGIC) +#define sv_2uv(sv) sv_2uv_flags(sv, SV_GMAGIC) +#define sv_2nv(sv) sv_2nv_flags(sv, SV_GMAGIC) +#define sv_eq(sv1, sv2) sv_eq_flags(sv1, sv2, SV_GMAGIC) +#define sv_cmp(sv1, sv2) sv_cmp_flags(sv1, sv2, SV_GMAGIC) +#define sv_cmp_locale(sv1, sv2) sv_cmp_locale_flags(sv1, sv2, SV_GMAGIC) +#define sv_numeq(sv1, sv2) sv_numeq_flags(sv1, sv2, SV_GMAGIC) +#define sv_streq(sv1, sv2) sv_streq_flags(sv1, sv2, SV_GMAGIC) +#define sv_collxfrm(sv, nxp) sv_collxfrm_flags(sv, nxp, SV_GMAGIC) +#define sv_2bool(sv) sv_2bool_flags(sv, SV_GMAGIC) +#define sv_2bool_nomg(sv) sv_2bool_flags(sv, 0) +#define sv_insert(bigstr, offset, len, little, littlelen) \ + Perl_sv_insert_flags(aTHX_ (bigstr),(offset), (len), (little), \ + (littlelen), SV_GMAGIC) +#define sv_mortalcopy(sv) \ + Perl_sv_mortalcopy_flags(aTHX_ sv, SV_GMAGIC|SV_DO_COW_SVSETSV) +#define sv_cathek(sv,hek) \ + STMT_START { \ + HEK * const bmxk = hek; \ + sv_catpvn_flags(sv, HEK_KEY(bmxk), HEK_LEN(bmxk), \ + HEK_UTF8(bmxk) ? SV_CATUTF8 : SV_CATBYTES); \ + } STMT_END /* Should be named SvCatPVN_utf8_upgrade? */ -#define sv_catpvn_nomg_utf8_upgrade(dsv, sstr, slen, nsv) \ - STMT_START { \ - if (!(nsv)) \ - nsv = newSVpvn_flags(sstr, slen, SVs_TEMP); \ - else \ - sv_setpvn(nsv, sstr, slen); \ - SvUTF8_off(nsv); \ - sv_utf8_upgrade(nsv); \ - sv_catsv_nomg(dsv, nsv); \ - } STMT_END -#define sv_catpvn_nomg_maybeutf8(dsv, sstr, len, is_utf8) \ - sv_catpvn_flags(dsv, sstr, len, (is_utf8)?SV_CATUTF8:SV_CATBYTES) +#define sv_catpvn_nomg_utf8_upgrade(dsv, sstr, slen, nsv) \ + STMT_START { \ + if (!(nsv)) \ + nsv = newSVpvn_flags(sstr, slen, SVs_TEMP); \ + else \ + sv_setpvn(nsv, sstr, slen); \ + SvUTF8_off(nsv); \ + sv_utf8_upgrade(nsv); \ + sv_catsv_nomg(dsv, nsv); \ + } STMT_END +#define sv_catpvn_nomg_maybeutf8(dsv, sstr, len, is_utf8) \ + sv_catpvn_flags(dsv, sstr, len, (is_utf8)?SV_CATUTF8:SV_CATBYTES) #if defined(PERL_CORE) || defined(PERL_EXT) -# define sv_or_pv_len_utf8(sv, pv, bytelen) \ - (SvGAMAGIC(sv) \ - ? utf8_length((U8 *)(pv), (U8 *)(pv)+(bytelen)) \ - : sv_len_utf8(sv)) +# define sv_or_pv_len_utf8(sv, pv, bytelen) \ + (SvGAMAGIC(sv) \ + ? utf8_length((U8 *)(pv), (U8 *)(pv)+(bytelen)) \ + : sv_len_utf8(sv)) #endif /* =for apidoc newRV =for apidoc_item ||newRV_inc| -These are identical. They create an RV wrapper for an SV. The reference count -for the original SV is incremented. +These are identical. They create an RV wrapper for an SV. +The reference count for the original SV is incremented. =cut */ -#define newRV_inc(sv) newRV(sv) +#define newRV_inc(sv) newRV(sv) -/* the following macros update any magic values this C is associated with */ +/* the following macros update any magic values + this C is associated with */ /* =for apidoc_section $SV =for apidoc Am|void|SvSETMAGIC|SV* sv Invokes C> on an SV if it has 'set' magic. This is necessary -after modifying a scalar, in case it is a magical variable like C<$|> -or a tied variable (it calls C). This macro evaluates its -argument more than once. +after modifying a scalar, in case it is a magical variable like C<$|> or a +tied variable (it calls C). This macro evaluates its argument more +than once. =for apidoc Am|void|SvSetMagicSV|SV* dsv|SV* ssv =for apidoc_item SvSetMagicSV_nosteal @@ -2292,111 +2320,110 @@ C C call a non-destructive version of C. =for apidoc Am|void|SvSHARE|SV* sv -Arranges for C to be shared between threads if a suitable module -has been loaded. +Arranges for C to be shared between threads if a suitable module has been +loaded. =for apidoc Am|void|SvLOCK|SV* sv -Arranges for a mutual exclusion lock to be obtained on C if a suitable module -has been loaded. +Arranges for a mutual exclusion lock to be obtained on C if a suitable +module has been loaded. =for apidoc Am|void|SvUNLOCK|SV* sv -Releases a mutual exclusion lock on C if a suitable module -has been loaded. +Releases a mutual exclusion lock on C if a suitable module has been +loaded. =for apidoc_section $SV =for apidoc Am|char *|SvGROW|SV* sv|STRLEN len -Expands the character buffer in the SV so that it has room for the -indicated number of bytes (remember to reserve space for an extra trailing -C character). Calls C to perform the expansion if necessary. -Returns a pointer to the character -buffer. SV must be of type >= C. One +Expands the character buffer in the SV so that it has room for the indicated +number of bytes (remember to reserve space for an extra trailing C +character). Calls C to perform the expansion if necessary. Returns +a pointer to the character buffer. SV must be of type >= C. One alternative is to call C if you are not sure of the type of SV. You might mistakenly think that C is the number of bytes to add to the existing size, but instead it is the total size C should be. =for apidoc Am|char *|SvPVCLEAR|SV* sv -Ensures that sv is a SVt_PV and that its SvCUR is 0, and that it is -properly null terminated. Equivalent to sv_setpvs(""), but more efficient. +Ensures that sv is a SVt_PV and that its SvCUR is 0, and that it is properly +null terminated. Equivalent to sv_setpvs(""), but more efficient. =for apidoc Am|char *|SvPVCLEAR_FRESH|SV* sv -Like SvPVCLEAR, but optimized for newly-minted SVt_PV/PVIV/PVNV/PVMG -that already have a PV buffer allocated, but no SvTHINKFIRST. +Like SvPVCLEAR, but optimized for newly-minted SVt_PV/PVIV/PVNV/PVMG that +already have a PV buffer allocated, but no SvTHINKFIRST. =cut */ -#define SvPVCLEAR(sv) sv_setpv_bufsize(sv,0,0) -#define SvPVCLEAR_FRESH(sv) sv_setpv_freshbuf(sv) -#define SvSHARE(sv) PL_sharehook(aTHX_ sv) -#define SvLOCK(sv) PL_lockhook(aTHX_ sv) -#define SvUNLOCK(sv) PL_unlockhook(aTHX_ sv) -#define SvDESTROYABLE(sv) PL_destroyhook(aTHX_ sv) - -#define SvSETMAGIC(x) STMT_START { if (UNLIKELY(SvSMAGICAL(x))) mg_set(x); } STMT_END - -#define SvSetSV_and(dst,src,finally) \ - STMT_START { \ - SV * src_ = src; \ - SV * dst_ = dst; \ - if (LIKELY((dst_) != (src_))) { \ - sv_setsv(dst_, src_); \ - finally; \ - } \ - } STMT_END - -#define SvSetSV_nosteal_and(dst,src,finally) \ - STMT_START { \ - SV * src_ = src; \ - SV * dst_ = dst; \ - if (LIKELY((dst_) != (src_))) { \ - sv_setsv_flags(dst_, src_, \ - SV_GMAGIC \ - | SV_NOSTEAL \ - | SV_DO_COW_SVSETSV); \ - finally; \ - } \ - } STMT_END - -#define SvSetSV(dst,src) \ - SvSetSV_and(dst,src,/*nothing*/;) -#define SvSetSV_nosteal(dst,src) \ - SvSetSV_nosteal_and(dst,src,/*nothing*/;) - -#define SvSetMagicSV(dst,src) \ - SvSetSV_and(dst,src,SvSETMAGIC(dst)) -#define SvSetMagicSV_nosteal(dst,src) \ - SvSetSV_nosteal_and(dst,src,SvSETMAGIC(dst)) +#define SvPVCLEAR(sv) sv_setpv_bufsize(sv,0,0) +#define SvPVCLEAR_FRESH(sv) sv_setpv_freshbuf(sv) +#define SvSHARE(sv) PL_sharehook(aTHX_ sv) +#define SvLOCK(sv) PL_lockhook(aTHX_ sv) +#define SvUNLOCK(sv) PL_unlockhook(aTHX_ sv) +#define SvDESTROYABLE(sv) PL_destroyhook(aTHX_ sv) + +#define SvSETMAGIC(x) \ + STMT_START { if (UNLIKELY(SvSMAGICAL(x))) mg_set(x); } STMT_END + +#define SvSetSV_and(dst,src,finally) \ + STMT_START { \ + SV * src_ = src; \ + SV * dst_ = dst; \ + if (LIKELY((dst_) != (src_))) { \ + sv_setsv(dst_, src_); \ + finally; \ + } \ + } STMT_END + +#define SvSetSV_nosteal_and(dst,src,finally) \ + STMT_START { \ + SV * src_ = src; \ + SV * dst_ = dst; \ + if (LIKELY((dst_) != (src_))) { \ + sv_setsv_flags(dst_, src_, \ + SV_GMAGIC \ + | SV_NOSTEAL \ + | SV_DO_COW_SVSETSV); \ + finally; \ + } \ + } STMT_END + +#define SvSetSV(dst,src) \ + SvSetSV_and(dst,src,/*nothing */;) +#define SvSetSV_nosteal(dst,src) \ + SvSetSV_nosteal_and(dst,src,/*nothing */;) + +#define SvSetMagicSV(dst,src) \ + SvSetSV_and(dst,src,SvSETMAGIC(dst)) +#define SvSetMagicSV_nosteal(dst,src) \ + SvSetSV_nosteal_and(dst,src,SvSETMAGIC(dst)) #if !defined(SKIP_DEBUGGING) -#define SvPEEK(sv) sv_peek(sv) +#define SvPEEK(sv) sv_peek(sv) #else -#define SvPEEK(sv) "" +#define SvPEEK(sv) "" #endif -/* Is this a per-interpreter immortal SV (rather than global)? - * These should either occupy adjacent entries in the interpreter struct - * (MULTIPLICITY) or adjacent elements of PL_sv_immortals[] otherwise. - * The unsigned (Size_t) cast avoids the need for a second < 0 condition. +/* Is this a per-interpreter immortal SV (rather than global)? These should + * either occupy adjacent entries in the interpreter struct (MULTIPLICITY) + * or adjacent elements of PL_sv_immortals[] otherwise. The unsigned + * (Size_t) cast avoids the need for a second < 0 condition. */ -#define SvIMMORTAL_INTERP(sv) ((Size_t)((sv) - &PL_sv_yes) < 4) +#define SvIMMORTAL_INTERP(sv) ((Size_t)((sv) - &PL_sv_yes) < 4) /* Does this immortal have a true value? Currently only PL_sv_yes does. */ -#define SvIMMORTAL_TRUE(sv) ((sv) == &PL_sv_yes) +#define SvIMMORTAL_TRUE(sv) ((sv) == &PL_sv_yes) /* the SvREADONLY() test is to quickly reject most SVs */ -#define SvIMMORTAL(sv) \ - ( SvREADONLY(sv) \ - && (SvIMMORTAL_INTERP(sv) || (sv) == &PL_sv_placeholder)) +#define SvIMMORTAL(sv) \ + ( SvREADONLY(sv) && (SvIMMORTAL_INTERP(sv) || (sv) == &PL_sv_placeholder)) #ifdef DEBUGGING /* exercise the immortal resurrection code in sv_free2() */ -# define SvREFCNT_IMMORTAL 1000 +# define SvREFCNT_IMMORTAL 1000 #else -# define SvREFCNT_IMMORTAL ((~(U32)0)/2) +# define SvREFCNT_IMMORTAL ((~(U32)0)/2) #endif /* @@ -2409,99 +2436,100 @@ See also C> and C>. =cut */ -#define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no) +#define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no) /* =for apidoc Am|void|sv_setbool|SV *sv|bool b =for apidoc_item |void|sv_setbool_mg|SV *sv|bool b -These set an SV to a true or false boolean value, upgrading first if necessary. +These set an SV to a true or false boolean value, +upgrading first if necessary. -They differ only in that C handles 'set' magic; C -does not. +They differ only in that C handles +'set' magic; C does not. =cut */ -#define sv_setbool(sv, b) sv_setsv(sv, boolSV(b)) -#define sv_setbool_mg(sv, b) sv_setsv_mg(sv, boolSV(b)) +#define sv_setbool(sv, b) sv_setsv(sv, boolSV(b)) +#define sv_setbool_mg(sv, b) sv_setsv_mg(sv, boolSV(b)) -#define isGV(sv) (SvTYPE(sv) == SVt_PVGV) -/* If I give every macro argument a different name, then there won't be bugs - where nested macros get confused. Been there, done that. */ +#define isGV(sv) (SvTYPE(sv) == SVt_PVGV) +/* If I give every macro argument a different name, then there won't be + bugs where nested macros get confused. Been there, done that. */ /* =for apidoc Am|bool|isGV_with_GP|SV * sv -Returns a boolean as to whether or not C is a GV with a pointer to a GP -(glob pointer). +Returns a boolean as to whether or not C is +a GV with a pointer to a GP (glob pointer). =cut */ -#define isGV_with_GP(pwadak) \ - (((SvFLAGS(pwadak) & (SVp_POK|SVpgv_GP)) == SVpgv_GP) \ - && (SvTYPE(pwadak) == SVt_PVGV || SvTYPE(pwadak) == SVt_PVLV)) - -#define isGV_with_GP_on(sv) \ - STMT_START { \ - SV * sv_ = MUTABLE_SV(sv); \ - assert (SvTYPE(sv_) == SVt_PVGV || SvTYPE(sv_) == SVt_PVLV); \ - assert (!SvPOKp(sv_)); \ - assert (!SvIOKp(sv_)); \ - (SvFLAGS(sv_) |= SVpgv_GP); \ +#define isGV_with_GP(pwadak) \ + (((SvFLAGS(pwadak) & (SVp_POK|SVpgv_GP)) == SVpgv_GP) \ + && (SvTYPE(pwadak) == SVt_PVGV || SvTYPE(pwadak) == SVt_PVLV)) + +#define isGV_with_GP_on(sv) \ + STMT_START { \ + SV * sv_ = MUTABLE_SV(sv); \ + assert (SvTYPE(sv_) == SVt_PVGV || SvTYPE(sv_) == SVt_PVLV); \ + assert (!SvPOKp(sv_)); \ + assert (!SvIOKp(sv_)); \ + (SvFLAGS(sv_) |= SVpgv_GP); \ } STMT_END -#define isGV_with_GP_off(sv) \ - STMT_START { \ - SV * sv_ = MUTABLE_SV(sv); \ - assert (SvTYPE(sv_) == SVt_PVGV || SvTYPE(sv_) == SVt_PVLV); \ - assert (!SvPOKp(sv_)); \ - assert (!SvIOKp(sv_)); \ - (SvFLAGS(sv_) &= ~SVpgv_GP); \ +#define isGV_with_GP_off(sv) \ + STMT_START { \ + SV * sv_ = MUTABLE_SV(sv); \ + assert (SvTYPE(sv_) == SVt_PVGV || SvTYPE(sv_) == SVt_PVLV); \ + assert (!SvPOKp(sv_)); \ + assert (!SvIOKp(sv_)); \ + (SvFLAGS(sv_) &= ~SVpgv_GP); \ } STMT_END #ifdef PERL_CORE -# define isGV_or_RVCV(kadawp) \ - (isGV(kadawp) || (SvROK(kadawp) && SvTYPE(SvRV(kadawp)) == SVt_PVCV)) +# define isGV_or_RVCV(kadawp) \ + (isGV(kadawp) || (SvROK(kadawp) && SvTYPE(SvRV(kadawp)) == SVt_PVCV)) #endif -#define isREGEXP(sv) \ - (SvTYPE(sv) == SVt_REGEXP \ - || (SvFLAGS(sv) & (SVTYPEMASK|SVpgv_GP|SVf_FAKE)) \ +#define isREGEXP(sv) \ + (SvTYPE(sv) == SVt_REGEXP \ + || (SvFLAGS(sv) & (SVTYPEMASK|SVpgv_GP|SVf_FAKE)) \ == (SVt_PVLV|SVf_FAKE)) #ifdef PERL_ANY_COW # define SvGROW(sv,len) \ - (SvIsCOW(sv) || SvLEN(sv) < (len) ? sv_grow(sv,len) : SvPVX(sv)) + (SvIsCOW(sv) || SvLEN(sv) < (len) ? sv_grow(sv,len) : SvPVX(sv)) #else -# define SvGROW(sv,len) (SvLEN(sv) < (len) ? sv_grow(sv,len) : SvPVX(sv)) +# define SvGROW(sv,len) (SvLEN(sv) < (len) ? sv_grow(sv,len) : SvPVX(sv)) #endif -#define SvGROW_mutable(sv,len) \ +#define SvGROW_mutable(sv,len) \ (SvLEN(sv) < (len) ? sv_grow(sv,len) : SvPVX_mutable(sv)) -#define Sv_Grow sv_grow +#define Sv_Grow sv_grow -#define CLONEf_COPY_STACKS 1 +#define CLONEf_COPY_STACKS 1 #define CLONEf_KEEP_PTR_TABLE 2 -#define CLONEf_CLONE_HOST 4 -#define CLONEf_JOIN_IN 8 +#define CLONEf_CLONE_HOST 4 +#define CLONEf_JOIN_IN 8 struct clone_params { - AV* stashes; - UV flags; - PerlInterpreter *proto_perl; - PerlInterpreter *new_perl; - AV *unreferenced; + AV *stashes; + UV flags; + PerlInterpreter *proto_perl; + PerlInterpreter *new_perl; + AV *unreferenced; }; /* SV_NOSTEAL prevents TEMP buffers being, well, stolen, and saves games - with SvTEMP_off and SvTEMP_on round a call to sv_setsv. */ -#define newSVsv(sv) newSVsv_flags((sv), SV_GMAGIC|SV_NOSTEAL) -#define newSVsv_nomg(sv) newSVsv_flags((sv), SV_NOSTEAL) + with SvTEMP_off and SvTEMP_on round a call to sv_setsv. */ +#define newSVsv(sv) newSVsv_flags((sv), SV_GMAGIC|SV_NOSTEAL) +#define newSVsv_nomg(sv) newSVsv_flags((sv), SV_NOSTEAL) /* =for apidoc Am|SV*|newSVpvn_utf8|const char* s|STRLEN len|U32 utf8 Creates a new SV and copies a string (which may contain C (C<\0>) -characters) into it. If C is true, calls -C on the new SV. Implemented as a wrapper around C. +characters) into it. If C is true, calls C on the +new SV. Implemented as a wrapper around C. =cut */ @@ -2516,7 +2544,7 @@ Creates a new SV containing the pad name. =cut */ -#define newSVpadname(pn) newSVpvn_utf8(PadnamePV(pn), PadnameLEN(pn), TRUE) +#define newSVpadname(pn) newSVpvn_utf8(PadnamePV(pn), PadnameLEN(pn), TRUE) /* =for apidoc Am|void|SvOOK_offset|SV*sv|STRLEN len @@ -2531,46 +2559,47 @@ Evaluates C more than once. Sets C to 0 if C is false. */ #ifdef DEBUGGING -/* Does the bot know something I don't? -10:28 <@Nicholas> metabatman -10:28 <+meta> Nicholas: crash -*/ -# define SvOOK_offset(sv, offset) STMT_START { \ - STATIC_ASSERT_STMT(sizeof(offset) == sizeof(STRLEN)); \ - if (SvOOK(sv)) { \ - const U8 *_crash = (U8*)SvPVX_const(sv); \ - (offset) = *--_crash; \ - if (!(offset)) { \ - _crash -= sizeof(STRLEN); \ - Copy(_crash, (U8 *)&(offset), sizeof(STRLEN), U8); \ - } \ - { \ - /* Validate the preceding buffer's sentinels to \ - verify that no-one is using it. */ \ - const U8 *const _bonk = (U8*)SvPVX_const(sv) - (offset);\ - while (_crash > _bonk) { \ - --_crash; \ - assert (*_crash == (U8)PTR2UV(_crash)); \ - } \ - } \ - } else { \ - (offset) = 0; \ - } \ - } STMT_END +/* Does the bot know something I don't? 10:28 <@Nicholas> + metabatman 10:28 <+meta> Nicholas: crash + */ +# define SvOOK_offset(sv, offset) \ + STMT_START { \ + STATIC_ASSERT_STMT(sizeof(offset) == sizeof(STRLEN)); \ + if (SvOOK(sv)) { \ + const U8 *_crash = (U8*)SvPVX_const(sv); \ + (offset) = *--_crash; \ + if (!(offset)) { \ + _crash -= sizeof(STRLEN); \ + Copy(_crash, (U8 *)&(offset), sizeof(STRLEN), U8); \ + } \ + { \ + /* Validate the preceding buffer's sentinels \ + to verify that no-one is using it. */ \ + const U8 *const _bonk = (U8*)SvPVX_const(sv) - (offset); \ + while (_crash > _bonk) { \ + --_crash; \ + assert (*_crash == (U8)PTR2UV(_crash)); \ + } \ + } \ + } else { \ + (offset) = 0; \ + } \ + } STMT_END #else - /* This is the same code, but avoids using any temporary variables: */ -# define SvOOK_offset(sv, offset) STMT_START { \ - STATIC_ASSERT_STMT(sizeof(offset) == sizeof(STRLEN)); \ - if (SvOOK(sv)) { \ - (offset) = ((U8*)SvPVX_const(sv))[-1]; \ - if (!(offset)) { \ - Copy(SvPVX_const(sv) - 1 - sizeof(STRLEN), \ - (U8*)&(offset), sizeof(STRLEN), U8); \ - } \ - } else { \ - (offset) = 0; \ - } \ - } STMT_END + /* This is the same code, but avoids using any temporary variables: */ +# define SvOOK_offset(sv, offset) \ + STMT_START { \ + STATIC_ASSERT_STMT(sizeof(offset) == sizeof(STRLEN)); \ + if (SvOOK(sv)) { \ + (offset) = ((U8*)SvPVX_const(sv))[-1]; \ + if (!(offset)) { \ + Copy(SvPVX_const(sv) - 1 - sizeof(STRLEN), \ + (U8*)&(offset), sizeof(STRLEN), U8); \ + } \ + } else { \ + (offset) = 0; \ + } \ + } STMT_END #endif /* @@ -2581,115 +2610,114 @@ Create a new IO, setting the reference count to 1. =cut */ -#define newIO() MUTABLE_IO(newSV_type(SVt_PVIO)) +#define newIO() MUTABLE_IO(newSV_type(SVt_PVIO)) #if defined(PERL_CORE) || defined(PERL_EXT) -# define SV_CONST(name) \ - PL_sv_consts[SV_CONST_##name] \ - ? PL_sv_consts[SV_CONST_##name] \ - : (PL_sv_consts[SV_CONST_##name] = newSVpv_share(#name, 0)) - -# define SV_CONST_TIESCALAR 0 -# define SV_CONST_TIEARRAY 1 -# define SV_CONST_TIEHASH 2 -# define SV_CONST_TIEHANDLE 3 - -# define SV_CONST_FETCH 4 -# define SV_CONST_FETCHSIZE 5 -# define SV_CONST_STORE 6 -# define SV_CONST_STORESIZE 7 -# define SV_CONST_EXISTS 8 - -# define SV_CONST_PUSH 9 -# define SV_CONST_POP 10 -# define SV_CONST_SHIFT 11 -# define SV_CONST_UNSHIFT 12 -# define SV_CONST_SPLICE 13 -# define SV_CONST_EXTEND 14 - -# define SV_CONST_FIRSTKEY 15 -# define SV_CONST_NEXTKEY 16 -# define SV_CONST_SCALAR 17 - -# define SV_CONST_OPEN 18 -# define SV_CONST_WRITE 19 -# define SV_CONST_PRINT 20 -# define SV_CONST_PRINTF 21 -# define SV_CONST_READ 22 -# define SV_CONST_READLINE 23 -# define SV_CONST_GETC 24 -# define SV_CONST_SEEK 25 -# define SV_CONST_TELL 26 -# define SV_CONST_EOF 27 -# define SV_CONST_BINMODE 28 -# define SV_CONST_FILENO 29 -# define SV_CONST_CLOSE 30 - -# define SV_CONST_DELETE 31 -# define SV_CONST_CLEAR 32 -# define SV_CONST_UNTIE 33 -# define SV_CONST_DESTROY 34 +# define SV_CONST(name) \ + PL_sv_consts[SV_CONST_##name] \ + ? PL_sv_consts[SV_CONST_##name] \ + : (PL_sv_consts[SV_CONST_##name] = newSVpv_share(#name, 0)) + +# define SV_CONST_TIESCALAR 0 +# define SV_CONST_TIEARRAY 1 +# define SV_CONST_TIEHASH 2 +# define SV_CONST_TIEHANDLE 3 + +# define SV_CONST_FETCH 4 +# define SV_CONST_FETCHSIZE 5 +# define SV_CONST_STORE 6 +# define SV_CONST_STORESIZE 7 +# define SV_CONST_EXISTS 8 + +# define SV_CONST_PUSH 9 +# define SV_CONST_POP 10 +# define SV_CONST_SHIFT 11 +# define SV_CONST_UNSHIFT 12 +# define SV_CONST_SPLICE 13 +# define SV_CONST_EXTEND 14 + +# define SV_CONST_FIRSTKEY 15 +# define SV_CONST_NEXTKEY 16 +# define SV_CONST_SCALAR 17 + +# define SV_CONST_OPEN 18 +# define SV_CONST_WRITE 19 +# define SV_CONST_PRINT 20 +# define SV_CONST_PRINTF 21 +# define SV_CONST_READ 22 +# define SV_CONST_READLINE 23 +# define SV_CONST_GETC 24 +# define SV_CONST_SEEK 25 +# define SV_CONST_TELL 26 +# define SV_CONST_EOF 27 +# define SV_CONST_BINMODE 28 +# define SV_CONST_FILENO 29 +# define SV_CONST_CLOSE 30 + +# define SV_CONST_DELETE 31 +# define SV_CONST_CLEAR 32 +# define SV_CONST_UNTIE 33 +# define SV_CONST_DESTROY 34 #endif -#define SV_CONSTS_COUNT 35 +#define SV_CONSTS_COUNT 35 /* * Bodyless IVs and NVs! * * Since 5.9.2, we can avoid allocating a body for SVt_IV-type SVs. - * Since the larger IV-holding variants of SVs store their integer - * values in their respective bodies, the family of SvIV() accessor - * macros would naively have to branch on the SV type to find the - * integer value either in the HEAD or BODY. In order to avoid this - * expensive branch, a clever soul has deployed a great hack: - * We set up the SvANY pointer such that instead of pointing to a - * real body, it points into the memory before the location of the - * head. We compute this pointer such that the location of - * the integer member of the hypothetical body struct happens to - * be the same as the location of the integer member of the bodyless - * SV head. This now means that the SvIV() family of accessors can - * always read from the (hypothetical or real) body via SvANY. + * Since the larger IV-holding variants of SVs store their integer values + * in their respective bodies, the family of SvIV() accessor macros would + * naively have to branch on the SV type to find the integer value either + * in the HEAD or BODY. In order to avoid this expensive branch, a clever + * soul has deployed a great hack: We set up the SvANY pointer such that + * instead of pointing to a real body, it points into the memory before + * the location of the head. We compute this pointer such that the + * location of the integer member of the hypothetical body struct happens + * to be the same as the location of the integer member of the bodyless SV + * head. This now means that the SvIV() family of accessors can always + * read from the (hypothetical or real) body via SvANY. * - * Since the 5.21 dev series, we employ the same trick for NVs - * if the architecture can support it (NVSIZE <= IVSIZE). - */ + * Since the 5.21 dev series, we employ the same trick for NVs if the + * architecture can support it (NVSIZE <= IVSIZE). +*/ /* The following two macros compute the necessary offsets for the above * trick and store them in SvANY for SvIV() (and friends) to use. */ -# define SET_SVANY_FOR_BODYLESS_IV(sv) \ - STMT_START { \ - SV * sv_ = MUTABLE_SV(sv); \ - SvANY(sv_) = (XPVIV*)((char*)&(sv_->sv_u.svu_iv) \ - - STRUCT_OFFSET(XPVIV, xiv_iv)); \ - } STMT_END +# define SET_SVANY_FOR_BODYLESS_IV(sv) \ + STMT_START { \ + SV * sv_ = MUTABLE_SV(sv); \ + SvANY(sv_) = (XPVIV*)((char*)&(sv_->sv_u.svu_iv) \ + - STRUCT_OFFSET(XPVIV, xiv_iv)); \ + } STMT_END -# define SET_SVANY_FOR_BODYLESS_NV(sv) \ - STMT_START { \ - SV * sv_ = MUTABLE_SV(sv); \ - SvANY(sv_) = (XPVNV*)((char*)&(sv_->sv_u.svu_nv) \ - - STRUCT_OFFSET(XPVNV, xnv_u.xnv_nv)); \ - } STMT_END +# define SET_SVANY_FOR_BODYLESS_NV(sv) \ + STMT_START { \ + SV * sv_ = MUTABLE_SV(sv); \ + SvANY(sv_) = (XPVNV*)((char*)&(sv_->sv_u.svu_nv) \ + - STRUCT_OFFSET(XPVNV, xnv_u.xnv_nv)); \ + } STMT_END #if defined(PERL_CORE) && defined(USE_ITHREADS) -/* Certain cases in Perl_ss_dup have been merged, by relying on the fact - that currently av_dup, gv_dup and hv_dup are the same as sv_dup. - If this changes, please unmerge ss_dup. - Likewise, sv_dup_inc_multiple() relies on this fact. */ -# define sv_dup_inc_NN(s,t) SvREFCNT_inc_NN(sv_dup_inc(s,t)) -# define av_dup(s,t) MUTABLE_AV(sv_dup((const SV *)s,t)) -# define av_dup_inc(s,t) MUTABLE_AV(sv_dup_inc((const SV *)s,t)) -# define hv_dup(s,t) MUTABLE_HV(sv_dup((const SV *)s,t)) -# define hv_dup_inc(s,t) MUTABLE_HV(sv_dup_inc((const SV *)s,t)) -# define cv_dup(s,t) MUTABLE_CV(sv_dup((const SV *)s,t)) -# define cv_dup_inc(s,t) MUTABLE_CV(sv_dup_inc((const SV *)s,t)) -# define io_dup(s,t) MUTABLE_IO(sv_dup((const SV *)s,t)) -# define io_dup_inc(s,t) MUTABLE_IO(sv_dup_inc((const SV *)s,t)) -# define gv_dup(s,t) MUTABLE_GV(sv_dup((const SV *)s,t)) -# define gv_dup_inc(s,t) MUTABLE_GV(sv_dup_inc((const SV *)s,t)) +/* Certain cases in Perl_ss_dup have been merged, by relying on + the fact that currently av_dup, gv_dup and hv_dup are the + same as sv_dup. If this changes, please unmerge ss_dup. + Likewise, sv_dup_inc_multiple() relies on this fact. */ +# define sv_dup_inc_NN(s,t) SvREFCNT_inc_NN(sv_dup_inc(s,t)) +# define av_dup(s,t) MUTABLE_AV(sv_dup((const SV *)s,t)) +# define av_dup_inc(s,t) MUTABLE_AV(sv_dup_inc((const SV *)s,t)) +# define hv_dup(s,t) MUTABLE_HV(sv_dup((const SV *)s,t)) +# define hv_dup_inc(s,t) MUTABLE_HV(sv_dup_inc((const SV *)s,t)) +# define cv_dup(s,t) MUTABLE_CV(sv_dup((const SV *)s,t)) +# define cv_dup_inc(s,t) MUTABLE_CV(sv_dup_inc((const SV *)s,t)) +# define io_dup(s,t) MUTABLE_IO(sv_dup((const SV *)s,t)) +# define io_dup_inc(s,t) MUTABLE_IO(sv_dup_inc((const SV *)s,t)) +# define gv_dup(s,t) MUTABLE_GV(sv_dup((const SV *)s,t)) +# define gv_dup_inc(s,t) MUTABLE_GV(sv_dup_inc((const SV *)s,t)) #endif /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/sv_inline.h b/sv_inline.h index 1bb8c2897d3d..f3b745b7a83b 100644 --- a/sv_inline.h +++ b/sv_inline.h @@ -4,63 +4,63 @@ * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * */ -/* This file contains the newSV_type and newSV_type_mortal functions, as well as - * the various struct and macro definitions they require. In the main, these - * definitions were moved from sv.c, where many of them continue to also be used. - * (In Perl_more_bodies, Perl_sv_upgrade and Perl_sv_clear, for example.) Code - * comments associated with definitions and functions were also copied across - * verbatim. +/* This file contains the newSV_type and newSV_type_mortal functions, as + * well as the various struct and macro definitions they require. In the + * main, these definitions were moved from sv.c, where many of them + * continue to also be used. (In Perl_more_bodies, Perl_sv_upgrade and + * Perl_sv_clear, for example.) Code comments associated with definitions + * and functions were also copied across verbatim. * - * The rationale for having these as inline functions, rather than in sv.c, is - * that the target type is very often known at compile time, and therefore - * optimum code can be emitted by the compiler, rather than having all calls - * traverse the many branches of Perl_sv_upgrade at runtime. + * The rationale for having these as inline functions, rather than in sv.c, + * is that the target type is very often known at compile time, and + * therefore optimum code can be emitted by the compiler, rather than having + * all calls traverse the many branches of Perl_sv_upgrade at runtime. */ -/* This definition came from perl.h*/ +/* This definition came from perl.h */ -/* The old value was hard coded at 1008. (4096-16) seems to be a bit faster, - at least on FreeBSD. YMMV, so experiment. */ +/* The old value was hard coded at 1008. (4096-16) seems to be a + bit faster, at least on FreeBSD. YMMV, so experiment. */ #ifndef PERL_ARENA_SIZE -#define PERL_ARENA_SIZE 4080 +#define PERL_ARENA_SIZE 4080 #endif -/* All other pre-existing definitions and functions that were moved into this - * file originally came from sv.c. */ +/* All other pre-existing definitions and functions that were + * moved into this file originally came from sv.c. */ #ifdef PERL_POISON -# define SvARENA_CHAIN(sv) ((sv)->sv_u.svu_rv) -# define SvARENA_CHAIN_SET(sv,val) (sv)->sv_u.svu_rv = MUTABLE_SV((val)) -/* Whilst I'd love to do this, it seems that things like to check on - unreferenced scalars -# define POISON_SV_HEAD(sv) PoisonNew(sv, 1, struct STRUCT_SV) -*/ -# define POISON_SV_HEAD(sv) PoisonNew(&SvANY(sv), 1, void *), \ - PoisonNew(&SvREFCNT(sv), 1, U32) +# define SvARENA_CHAIN(sv) ((sv)->sv_u.svu_rv) +# define SvARENA_CHAIN_SET(sv,val) (sv)->sv_u.svu_rv = MUTABLE_SV((val)) +/* Whilst I'd love to do this, it seems that things like to + check on unreferenced scalars # define + POISON_SV_HEAD(sv) PoisonNew(sv, 1, struct STRUCT_SV) + */ +# define POISON_SV_HEAD(sv) \ + PoisonNew(&SvANY(sv), 1, void *), \ + PoisonNew(&SvREFCNT(sv), 1, U32) #else -# define SvARENA_CHAIN(sv) SvANY(sv) -# define SvARENA_CHAIN_SET(sv,val) SvANY(sv) = (void *)(val) +# define SvARENA_CHAIN(sv) SvANY(sv) +# define SvARENA_CHAIN_SET(sv,val) SvANY(sv) = (void *)(val) # define POISON_SV_HEAD(sv) #endif #ifdef PERL_MEM_LOG # define MEM_LOG_NEW_SV(sv, file, line, func) \ - Perl_mem_log_new_sv(sv, file, line, func) + Perl_mem_log_new_sv(sv, file, line, func) # define MEM_LOG_DEL_SV(sv, file, line, func) \ - Perl_mem_log_del_sv(sv, file, line, func) + Perl_mem_log_del_sv(sv, file, line, func) #else -# define MEM_LOG_NEW_SV(sv, file, line, func) NOOP -# define MEM_LOG_DEL_SV(sv, file, line, func) NOOP +# define MEM_LOG_NEW_SV(sv, file, line, func) NOOP +# define MEM_LOG_DEL_SV(sv, file, line, func) NOOP #endif -#define uproot_SV(p) \ - STMT_START { \ - (p) = PL_sv_root; \ - PL_sv_root = MUTABLE_SV(SvARENA_CHAIN(p)); \ - ++PL_sv_count; \ +#define uproot_SV(p) \ + STMT_START { \ + (p) = PL_sv_root; \ + PL_sv_root = MUTABLE_SV(SvARENA_CHAIN(p)); \ + ++PL_sv_count; \ } STMT_END /* Perl_more_sv lives in sv.c, we don't want to inline it. @@ -102,42 +102,46 @@ S_new_SV(pTHX_ const char *file, int line, const char *func) return sv; } -# define new_SV(p) (p)=S_new_SV(aTHX_ __FILE__, __LINE__, FUNCTION__) +# define new_SV(p) (p)=S_new_SV(aTHX_ __FILE__, __LINE__, FUNCTION__) #else -# define new_SV(p) \ - STMT_START { \ - if (PL_sv_root) \ - uproot_SV(p); \ - else \ - (p) = Perl_more_sv(aTHX); \ - SvANY(p) = 0; \ - SvREFCNT(p) = 1; \ - SvFLAGS(p) = 0; \ - MEM_LOG_NEW_SV(p, __FILE__, __LINE__, FUNCTION__); \ - } STMT_END +# define new_SV(p) \ + STMT_START { \ + if (PL_sv_root) \ + uproot_SV(p); \ + else \ + (p) = Perl_more_sv(aTHX); \ + SvANY(p) = 0; \ + SvREFCNT(p) = 1; \ + SvFLAGS(p) = 0; \ + MEM_LOG_NEW_SV(p, __FILE__, __LINE__, FUNCTION__); \ + } STMT_END #endif typedef struct xpvhv_with_aux XPVHV_WITH_AUX; struct body_details { - U8 body_size; /* Size to allocate */ - U8 copy; /* Size of structure to copy (may be shorter) */ - U8 offset; /* Size of unalloced ghost fields to first alloced field*/ - PERL_BITFIELD8 type : 5; /* We have space for a sanity check. */ - PERL_BITFIELD8 cant_upgrade : 1;/* Cannot upgrade this type */ - PERL_BITFIELD8 zero_nv : 1; /* zero the NV when upgrading from this */ - PERL_BITFIELD8 arena : 1; /* Allocated from an arena */ - U32 arena_size; /* Size of arena to allocate */ + U8 body_size; /* Size to allocate */ + U8 copy; /* Size of structure to copy + (may be shorter) */ + U8 offset; /* Size of unalloced ghost fields + to first alloced field */ + PERL_BITFIELD8 type : 5; /* We have space for a + sanity check. */ + PERL_BITFIELD8 cant_upgrade : 1; /* Cannot upgrade this type */ + PERL_BITFIELD8 zero_nv : 1; /* zero the NV when upgrading + from this */ + PERL_BITFIELD8 arena : 1; /* Allocated from an arena */ + U32 arena_size; /* Size of arena to allocate */ }; -#define ALIGNED_TYPE_NAME(name) name##_aligned -#define ALIGNED_TYPE(name) \ - typedef union { \ - name align_me; \ - NV nv; \ - IV iv; \ +#define ALIGNED_TYPE_NAME(name) name##_aligned +#define ALIGNED_TYPE(name) \ + typedef union { \ + name align_me; \ + NV nv; \ + IV iv; \ } ALIGNED_TYPE_NAME(name) ALIGNED_TYPE(regexp); @@ -151,55 +155,54 @@ ALIGNED_TYPE(XPVFM); ALIGNED_TYPE(XPVIO); ALIGNED_TYPE(XPVOBJ); -#define HADNV FALSE -#define NONV TRUE +#define HADNV FALSE +#define NONV TRUE #ifdef PURIFY -/* With -DPURFIY we allocate everything directly, and don't use arenas. - This seems a rather elegant way to simplify some of the code below. */ -#define HASARENA FALSE +/* With -DPURFIY we allocate everything directly, and don't use arenas. This + seems a rather elegant way to simplify some of the code below. */ +#define HASARENA FALSE #else -#define HASARENA TRUE +#define HASARENA TRUE #endif -#define NOARENA FALSE +#define NOARENA FALSE -/* Size the arenas to exactly fit a given number of bodies. A count - of 0 fits the max number bodies into a PERL_ARENA_SIZE.block, +/* Size the arenas to exactly fit a given number of bodies. A count of + 0 fits the max number bodies into a PERL_ARENA_SIZE.block, simplifying the default. If count > 0, the arena is sized to fit only that many bodies, allowing arenas to be used for large, rare - bodies (XPVFM, XPVIO) without undue waste. The arena size is - limited by PERL_ARENA_SIZE, so we can safely oversize the - declarations. + bodies (XPVFM, XPVIO) without undue waste. The arena size is limited + by PERL_ARENA_SIZE, so we can safely oversize the declarations. */ -#define FIT_ARENA0(body_size) \ +#define FIT_ARENA0(body_size) \ ((size_t)(PERL_ARENA_SIZE / body_size) * body_size) -#define FIT_ARENAn(count,body_size) \ - ( count * body_size <= PERL_ARENA_SIZE) \ - ? count * body_size \ +#define FIT_ARENAn(count,body_size) \ + ( count * body_size <= PERL_ARENA_SIZE) \ + ? count * body_size \ : FIT_ARENA0 (body_size) -#define FIT_ARENA(count,body_size) \ - (U32)(count \ - ? FIT_ARENAn (count, body_size) \ - : FIT_ARENA0 (body_size)) +#define FIT_ARENA(count,body_size) \ + (U32)(count \ + ? FIT_ARENAn (count, body_size) \ + : FIT_ARENA0 (body_size)) -/* Calculate the length to copy. Specifically work out the length less any - final padding the compiler needed to add. See the comment in sv_upgrade - for why copying the padding proved to be a bug. */ +/* Calculate the length to copy. Specifically work out the length less + any final padding the compiler needed to add. See the comment in + sv_upgrade for why copying the padding proved to be a bug. */ -#define copy_length(type, last_member) \ - STRUCT_OFFSET(type, last_member) \ - + sizeof (((type*)SvANY((const SV *)0))->last_member) +#define copy_length(type, last_member) \ + STRUCT_OFFSET(type, last_member) \ + + sizeof (((type*)SvANY((const SV *)0))->last_member) static const struct body_details bodies_by_type[] = { - /* HEs use this offset for their arena. */ + /* HEs use this offset for their arena. */ { 0, 0, 0, SVt_NULL, FALSE, NONV, NOARENA, 0 }, - /* IVs are in the head, so the allocation size is 0. */ + /* IVs are in the head, so the allocation size is 0. */ { 0, - sizeof(IV), /* This is used to copy out the IV body. */ + sizeof(IV), /* This is used to copy out the IV body. */ STRUCT_OFFSET(XPVIV, xiv_iv), SVt_IV, FALSE, NONV, - NOARENA /* IVS don't need an arena */, 0 + NOARENA /* IVS don't need an arena */, 0 }, #if NVSIZE <= IVSIZE @@ -289,51 +292,52 @@ static const struct body_details bodies_by_type[] = { FIT_ARENA(0, sizeof(ALIGNED_TYPE_NAME(XPVOBJ))) }, }; -#define new_body_allocated(sv_type) \ - (void *)((char *)S_new_body(aTHX_ sv_type) \ +#define new_body_allocated(sv_type) \ + (void *)((char *)S_new_body(aTHX_ sv_type) \ - bodies_by_type[sv_type].offset) #ifdef PURIFY #if !(NVSIZE <= IVSIZE) -# define new_XNV() safemalloc(sizeof(XPVNV)) +# define new_XNV() safemalloc(sizeof(XPVNV)) #endif -#define new_XPVNV() safemalloc(sizeof(XPVNV)) -#define new_XPVMG() safemalloc(sizeof(XPVMG)) +#define new_XPVNV() safemalloc(sizeof(XPVNV)) +#define new_XPVMG() safemalloc(sizeof(XPVMG)) -#define del_body_by_type(p, type) safefree(p) +#define del_body_by_type(p, type) safefree(p) #else /* !PURIFY */ #if !(NVSIZE <= IVSIZE) -# define new_XNV() new_body_allocated(SVt_NV) +# define new_XNV() new_body_allocated(SVt_NV) #endif -#define new_XPVNV() new_body_allocated(SVt_PVNV) -#define new_XPVMG() new_body_allocated(SVt_PVMG) +#define new_XPVNV() new_body_allocated(SVt_PVNV) +#define new_XPVMG() new_body_allocated(SVt_PVMG) -#define del_body_by_type(p, type) \ - del_body(p + bodies_by_type[(type)].offset, \ +#define del_body_by_type(p, type) \ + del_body(p + bodies_by_type[(type)].offset, \ &PL_body_roots[(type)]) #endif /* PURIFY */ /* no arena for you! */ -#define new_NOARENA(details) \ - safemalloc((details)->body_size + (details)->offset) -#define new_NOARENAZ(details) \ - safecalloc((details)->body_size + (details)->offset, 1) +#define new_NOARENA(details) \ + safemalloc((details)->body_size + (details)->offset) +#define new_NOARENAZ(details) \ + safecalloc((details)->body_size + (details)->offset, 1) #ifndef PURIFY -/* grab a new thing from the arena's free list, allocating more if necessary. */ -#define new_body_from_arena(xpv, root_index, type_meta) \ - STMT_START { \ - void ** const r3wt = &PL_body_roots[root_index]; \ - xpv = (PTR_TBL_ENT_t*) (*((void **)(r3wt)) \ - ? *((void **)(r3wt)) : Perl_more_bodies(aTHX_ root_index, \ - type_meta.body_size,\ - type_meta.arena_size)); \ - *(r3wt) = *(void**)(xpv); \ +/* grab a new thing from the arena's free list, + allocating more if necessary. */ +#define new_body_from_arena(xpv, root_index, type_meta) \ + STMT_START { \ + void ** const r3wt = &PL_body_roots[root_index]; \ + xpv = (PTR_TBL_ENT_t*) (*((void **)(r3wt)) \ + ? *((void **)(r3wt)) : Perl_more_bodies(aTHX_ root_index, \ + type_meta.body_size, \ + type_meta.arena_size)); \ + *(r3wt) = *(void**)(xpv); \ } STMT_END PERL_STATIC_INLINE void * @@ -350,7 +354,7 @@ static const struct body_details fake_rv = { 0, 0, 0, SVt_IV, FALSE, NONV, NOARENA, 0 }; static const struct body_details fake_hv_with_aux = - /* The SVt_IV arena is used for (larger) PVHV bodies. */ + /* The SVt_IV arena is used for (larger) PVHV bodies. */ { sizeof(ALIGNED_TYPE_NAME(XPVHV_WITH_AUX)), copy_length(XPVHV, xhv_max), 0, @@ -360,8 +364,8 @@ static const struct body_details fake_hv_with_aux = /* =for apidoc newSV_type -Creates a new SV, of the type specified. The reference count for the new SV -is set to 1. +Creates a new SV, of the type specified. The +reference count for the new SV is set to 1. =cut */ @@ -403,13 +407,13 @@ Perl_newSV_type(pTHX_ const svtype type) #ifndef PURIFY assert(type_details->arena); assert(type_details->arena_size); - /* This points to the start of the allocated area. */ + /* This points to the start of the allocated area. */ new_body = S_new_body(aTHX_ type); /* xpvav and xpvhv have no offset, so no need to adjust new_body */ assert(!(type_details->offset)); #else - /* We always allocated the full length item with PURIFY. To do this - we fake things so that arena is false for all 16 types.. */ + /* We always allocated the full length item with PURIFY. To do this + we fake things so that arena is false for all 16 types.. */ new_body = new_NOARENAZ(type_details); #endif SvANY(sv) = new_body; @@ -446,7 +450,7 @@ Perl_newSV_type(pTHX_ const svtype type) NOT_REACHED; } - sv->sv_u.svu_array = NULL; /* or svu_hash */ + sv->sv_u.svu_array = NULL; /* or svu_hash */ break; case SVt_PVIV: @@ -462,13 +466,13 @@ Perl_newSV_type(pTHX_ const svtype type) /* For a type known at compile time, it should be possible for the * compiler to deduce the value of (type_details->arena), resolve * that branch below, and inline the relevant values from - * bodies_by_type. Except, at least for gcc, it seems not to do that. - * We help it out here with two deviations from sv_upgrade: - * (1) Minor rearrangement here, so that PVFM - the only type at this - * point not to be allocated from an array appears last, not PV. - * (2) The ASSUME() statement here for everything that isn't PVFM. - * Obviously this all only holds as long as it's a true reflection of - * the bodies_by_type lookup table. */ + * bodies_by_type. Except, at least for gcc, it seems not to do + * that. We help it out here with two deviations from sv_upgrade: + * (1) Minor rearrangement here, so that PVFM - the only type at + * this point not to be allocated from an array appears last, not + * PV. (2) The ASSUME() statement here for everything that isn't + * PVFM. Obviously this all only holds as long as it's a true + * reflection of the bodies_by_type lookup table. */ #ifndef PURIFY ASSUME(type_details->arena); #endif @@ -476,11 +480,11 @@ Perl_newSV_type(pTHX_ const svtype type) case SVt_PVFM: assert(type_details->body_size); - /* We always allocated the full length item with PURIFY. To do this - we fake things so that arena is false for all 16 types.. */ + /* We always allocated the full length item with PURIFY. To do this + we fake things so that arena is false for all 16 types.. */ #ifndef PURIFY if(type_details->arena) { - /* This points to the start of the allocated area. */ + /* This points to the start of the allocated area. */ new_body = S_new_body(aTHX_ type); Zero(new_body, type_details->body_size, char); new_body = ((char *)new_body) - type_details->offset; @@ -496,8 +500,8 @@ Perl_newSV_type(pTHX_ const svtype type) GV *iogv = gv_fetchpvs("IO::File::", GV_ADD, SVt_PVHV); SvOBJECT_on(io); - /* Clear the stashcache because a new IO could overrule a package - name */ + /* Clear the stashcache because a new IO + could overrule a package name */ DEBUG_o(Perl_deb(aTHX_ "sv_upgrade clearing PL_stashcache\n")); hv_clear(PL_stashcache); @@ -521,13 +525,9 @@ Perl_newSV_type(pTHX_ const svtype type) Creates a new mortal SV, of the type specified. The reference count for the new SV is set to 1. -This is equivalent to - SV* sv = sv_2mortal(newSV_type()) -and - SV* sv = sv_newmortal(); - sv_upgrade(sv, ) -but should be more efficient than both of them. (Unless sv_2mortal is inlined -at some point in the future.) +This is equivalent to SV* sv = sv_2mortal(newSV_type()) and SV* sv = +sv_newmortal(); sv_upgrade(sv, ) but should be more efficient than +both of them. (Unless sv_2mortal is inlined at some point in the future.) =cut */ @@ -544,20 +544,20 @@ Perl_newSV_type_mortal(pTHX_ const svtype type) return sv; } -/* The following functions started out in sv.h and then moved to inline.h. They - * moved again into this file during the 5.37.x development cycle. */ +/* The following functions started out in sv.h and then moved to inline.h. + * They moved again into this file during the 5.37.x development cycle. */ /* =for apidoc_section $SV =for apidoc SvPVXtrue -Returns a boolean as to whether or not C contains a PV that is considered -TRUE. FALSE is returned if C doesn't contain a PV, or if the PV it does -contain is zero length, or consists of just the single character '0'. Every -other PV value is considered TRUE. +Returns a boolean as to whether or not C contains a PV that is +considered TRUE. FALSE is returned if C doesn't contain a PV, +or if the PV it does contain is zero length, or consists of just the +single character '0'. Every other PV value is considered TRUE. -As of Perl v5.37.1, C is evaluated exactly once; in earlier releases, it -could be evaluated more than once. +As of Perl v5.37.1, C is evaluated exactly once; in earlier +releases, it could be evaluated more than once. =cut */ @@ -584,9 +584,9 @@ Perl_SvPVXtrue(pTHX_ SV *sv) /* =for apidoc SvGETMAGIC -Invokes C> on an SV if it has 'get' magic. For example, this -will call C on a tied variable. As of 5.37.1, this function is -guaranteed to evaluate its argument exactly once. +Invokes C> on an SV if it has 'get' magic. For example, +this will call C on a tied variable. As of 5.37.1, this +function is guaranteed to evaluate its argument exactly once. =cut */ @@ -756,14 +756,14 @@ Perl_SvPADSTALE_off(SV *sv) =for apidoc_item SvIV_nomg =for apidoc_item SvIVx -These each coerce the given SV to IV and return it. The returned value in many -circumstances will get stored in C's IV slot, but not in all cases. (Use -C> to make sure it does). +These each coerce the given SV to IV and return it. The returned value +in many circumstances will get stored in C's IV slot, but not in +all cases. (Use C> to make sure it does). As of 5.37.1, all are guaranteed to evaluate C only once. -C is now identical to C, but prior to 5.37.1, it was the only form -guaranteed to evaluate C only once. +C is now identical to C, but prior to 5.37.1, it was the +only form guaranteed to evaluate C only once. C is the same as C, but does not perform 'get' magic. @@ -771,14 +771,14 @@ C is the same as C, but does not perform 'get' magic. =for apidoc_item SvNV_nomg =for apidoc_item SvNVx -These each coerce the given SV to NV and return it. The returned value in many -circumstances will get stored in C's NV slot, but not in all cases. (Use -C> to make sure it does). +These each coerce the given SV to NV and return it. The returned value +in many circumstances will get stored in C's NV slot, but not in +all cases. (Use C> to make sure it does). As of 5.37.1, all are guaranteed to evaluate C only once. -C is now identical to C, but prior to 5.37.1, it was the only form -guaranteed to evaluate C only once. +C is now identical to C, but prior to 5.37.1, it was the +only form guaranteed to evaluate C only once. C is the same as C, but does not perform 'get' magic. @@ -786,14 +786,14 @@ C is the same as C, but does not perform 'get' magic. =for apidoc_item SvUV_nomg =for apidoc_item SvUVx -These each coerce the given SV to UV and return it. The returned value in many -circumstances will get stored in C's UV slot, but not in all cases. (Use -C> to make sure it does). +These each coerce the given SV to UV and return it. The returned value +in many circumstances will get stored in C's UV slot, but not in +all cases. (Use C> to make sure it does). As of 5.37.1, all are guaranteed to evaluate C only once. -C is now identical to C, but prior to 5.37.1, it was the only form -guaranteed to evaluate C only once. +C is now identical to C, but prior to 5.37.1, it was the +only form guaranteed to evaluate C only once. =cut */ @@ -869,9 +869,9 @@ S_sv_or_pv_pos_u2b(pTHX_ SV *sv, const char *pv, STRLEN pos, STRLEN *lenp) PERL_STATIC_INLINE char * Perl_sv_pvutf8n_force_wrapper(pTHX_ SV * const sv, STRLEN * const lp, const U32 dummy) { - /* This is just so can be passed to Perl_SvPV_helper() as a function - * pointer with the same signature as all the other such pointers, and - * having hence an unused parameter */ + /* This is just so can be passed to Perl_SvPV_helper() as a + * function pointer with the same signature as all the other + * such pointers, and having hence an unused parameter */ PERL_ARGS_ASSERT_SV_PVUTF8N_FORCE_WRAPPER; PERL_UNUSED_ARG(dummy); @@ -881,9 +881,9 @@ Perl_sv_pvutf8n_force_wrapper(pTHX_ SV * const sv, STRLEN * const lp, const U32 PERL_STATIC_INLINE char * Perl_sv_pvbyten_force_wrapper(pTHX_ SV * const sv, STRLEN * const lp, const U32 dummy) { - /* This is just so can be passed to Perl_SvPV_helper() as a function - * pointer with the same signature as all the other such pointers, and - * having hence an unused parameter */ + /* This is just so can be passed to Perl_SvPV_helper() as a + * function pointer with the same signature as all the other + * such pointers, and having hence an unused parameter */ PERL_ARGS_ASSERT_SV_PVBYTEN_FORCE_WRAPPER; PERL_UNUSED_ARG(dummy); @@ -901,8 +901,8 @@ Perl_SvPV_helper(pTHX_ const U32 return_flags ) { - /* 'type' should be known at compile time, so this is reduced to a single - * conditional at runtime */ + /* 'type' should be known at compile time, so this is + * reduced to a single conditional at runtime */ if ( (type == SvPVbyte_type_ && SvPOK_byte_nog(sv)) || (type == SvPVforce_type_ && SvPOK_pure_nogthink(sv)) || (type == SvPVutf8_type_ && SvPOK_utf8_nog(sv)) @@ -914,8 +914,8 @@ Perl_SvPV_helper(pTHX_ *lp = SvCUR(sv); } - /* Similarly 'return_flags is known at compile time, so this becomes - * branchless */ + /* Similarly 'return_flags is known at compile + * time, so this becomes branchless */ if (return_flags & SV_MUTABLE_RETURN) { return SvPVX_mutable(sv); } @@ -948,8 +948,8 @@ Perl_SvPV_helper(pTHX_ /* =for apidoc newRV_noinc -Creates an RV wrapper for an SV. The reference count for the original -SV is B incremented. +Creates an RV wrapper for an SV. The reference count +for the original SV is B incremented. =cut */ @@ -987,4 +987,4 @@ Perl_sv_setpv_freshbuf(pTHX_ SV *const sv) /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/thread.h b/thread.h index 474c2b43b660..f5f351cba0a5 100644 --- a/thread.h +++ b/thread.h @@ -1,11 +1,10 @@ /* thread.h * - * Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, - * by Larry Wall and others + * Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, by + * Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * */ #if defined(USE_ITHREADS) @@ -18,56 +17,59 @@ # include #else # ifdef OLD_PTHREADS_API /* Here be dragons. */ -# define DETACH(t) \ - STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_detach(&(t)->self))) { \ - MUTEX_UNLOCK(&(t)->mutex); \ - Perl_croak_nocontext("panic: DETACH (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ - } \ - } STMT_END - -# define PERL_GET_CONTEXT Perl_get_context() -# define PERL_SET_CONTEXT(t) Perl_set_context((void*)t) +# define DETACH(t) \ + STMT_START { \ + int _eC_; \ + if ((_eC_ = pthread_detach(&(t)->self))) { \ + MUTEX_UNLOCK(&(t)->mutex); \ + Perl_croak_nocontext("panic: DETACH (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ + } \ + } STMT_END + +# define PERL_GET_CONTEXT Perl_get_context() +# define PERL_SET_CONTEXT(t) Perl_set_context((void*)t) # define PTHREAD_GETSPECIFIC_INT # ifdef OEMVS -# define pthread_addr_t void * -# define pthread_create(t,a,s,d) pthread_create(t,&(a),s,d) -# define pthread_keycreate pthread_key_create +# define pthread_addr_t void * +# define pthread_create(t,a,s,d) pthread_create(t,&(a),s,d) +# define pthread_keycreate pthread_key_create # endif # ifdef VMS -# define pthread_attr_init(a) pthread_attr_create(a) +# define pthread_attr_init(a) pthread_attr_create(a) # define PTHREAD_ATTR_SETDETACHSTATE(a,s) pthread_setdetach_np(a,s) -# define PTHREAD_CREATE(t,a,s,d) pthread_create(t,a,s,d) -# define pthread_key_create(k,d) pthread_keycreate(k,(pthread_destructor_t)(d)) -# define pthread_mutexattr_init(a) pthread_mutexattr_create(a) -# define pthread_mutexattr_settype(a,t) pthread_mutexattr_setkind_np(a,t) +# define PTHREAD_CREATE(t,a,s,d) pthread_create(t,a,s,d) +# define pthread_key_create(k,d) \ + pthread_keycreate(k,(pthread_destructor_t)(d)) +# define pthread_mutexattr_init(a) pthread_mutexattr_create(a) +# define pthread_mutexattr_settype(a,t) pthread_mutexattr_setkind_np(a,t) # endif # if defined(__hpux) && defined(__ux_version) && __ux_version <= 1020 -# define pthread_attr_init(a) pthread_attr_create(a) +# define pthread_attr_init(a) pthread_attr_create(a) /* XXX pthread_setdetach_np() missing in DCE threads on HP-UX 10.20 */ -# define PTHREAD_ATTR_SETDETACHSTATE(a,s) (0) -# define PTHREAD_CREATE(t,a,s,d) pthread_create(t,a,s,d) -# define pthread_key_create(k,d) pthread_keycreate(k,(pthread_destructor_t)(d)) -# define pthread_mutexattr_init(a) pthread_mutexattr_create(a) -# define pthread_mutexattr_settype(a,t) pthread_mutexattr_setkind_np(a,t) +# define PTHREAD_ATTR_SETDETACHSTATE(a,s) (0) +# define PTHREAD_CREATE(t,a,s,d) pthread_create(t,a,s,d) +# define pthread_key_create(k,d) \ + pthread_keycreate(k,(pthread_destructor_t)(d)) +# define pthread_mutexattr_init(a) pthread_mutexattr_create(a) +# define pthread_mutexattr_settype(a,t) pthread_mutexattr_setkind_np(a,t) # endif # if defined(OEMVS) -# define PTHREAD_ATTR_SETDETACHSTATE(a,s) pthread_attr_setdetachstate(a,&(s)) -# define YIELD pthread_yield(NULL) +# define PTHREAD_ATTR_SETDETACHSTATE(a,s) \ + pthread_attr_setdetachstate(a,&(s)) +# define YIELD pthread_yield(NULL) # endif # endif # if !defined(__hpux) || !defined(__ux_version) || __ux_version > 1020 -# define pthread_mutexattr_default NULL -# define pthread_condattr_default NULL +# define pthread_mutexattr_default NULL +# define pthread_condattr_default NULL # endif #endif #ifndef PTHREAD_CREATE /* You are not supposed to pass NULL as the 2nd arg of PTHREAD_CREATE(). */ -# define PTHREAD_CREATE(t,a,s,d) pthread_create(t,&(a),s,d) +# define PTHREAD_CREATE(t,a,s,d) pthread_create(t,&(a),s,d) #endif #ifndef PTHREAD_ATTR_SETDETACHSTATE @@ -76,18 +78,18 @@ #ifndef PTHREAD_CREATE_JOINABLE # ifdef OLD_PTHREAD_CREATE_JOINABLE -# define PTHREAD_CREATE_JOINABLE OLD_PTHREAD_CREATE_JOINABLE +# define PTHREAD_CREATE_JOINABLE OLD_PTHREAD_CREATE_JOINABLE # else -# define PTHREAD_CREATE_JOINABLE 0 /* Panic? No, guess. */ +# define PTHREAD_CREATE_JOINABLE 0 /* Panic? No, guess. */ # endif #endif #ifdef __VMS /* Default is 1024 on VAX, 8192 otherwise */ # ifdef __ia64 -# define THREAD_CREATE_NEEDS_STACK (48*1024) +# define THREAD_CREATE_NEEDS_STACK (48*1024) # else -# define THREAD_CREATE_NEEDS_STACK (32*1024) +# define THREAD_CREATE_NEEDS_STACK (32*1024) # endif #endif @@ -97,71 +99,71 @@ /* #include is in perl.h #ifdef I_MACH_CTHREADS */ -#define MUTEX_INIT(m) \ - STMT_START { \ - *m = mutex_alloc(); \ - if (*m) { \ - mutex_init(*m); \ - } else { \ - Perl_croak_nocontext("panic: MUTEX_INIT [%s:%d]", \ - __FILE__, __LINE__); \ - } \ +#define MUTEX_INIT(m) \ + STMT_START { \ + *m = mutex_alloc(); \ + if (*m) { \ + mutex_init(*m); \ + } else { \ + Perl_croak_nocontext("panic: MUTEX_INIT [%s:%d]", \ + __FILE__, __LINE__); \ + } \ } STMT_END -#define MUTEX_LOCK(m) mutex_lock(*m) -#define MUTEX_UNLOCK(m) mutex_unlock(*m) -#define MUTEX_DESTROY(m) \ - STMT_START { \ - mutex_free(*m); \ - *m = 0; \ +#define MUTEX_LOCK(m) mutex_lock(*m) +#define MUTEX_UNLOCK(m) mutex_unlock(*m) +#define MUTEX_DESTROY(m) \ + STMT_START { \ + mutex_free(*m); \ + *m = 0; \ } STMT_END -#define COND_INIT(c) \ - STMT_START { \ - *c = condition_alloc(); \ - if (*c) { \ - condition_init(*c); \ - } \ - else { \ - Perl_croak_nocontext("panic: COND_INIT [%s:%d]", \ - __FILE__, __LINE__); \ - } \ +#define COND_INIT(c) \ + STMT_START { \ + *c = condition_alloc(); \ + if (*c) { \ + condition_init(*c); \ + } \ + else { \ + Perl_croak_nocontext("panic: COND_INIT [%s:%d]", \ + __FILE__, __LINE__); \ + } \ } STMT_END -#define COND_SIGNAL(c) condition_signal(*c) -#define COND_BROADCAST(c) condition_broadcast(*c) -#define COND_WAIT(c, m) condition_wait(*c, *m) -#define COND_DESTROY(c) \ - STMT_START { \ - condition_free(*c); \ - *c = 0; \ +#define COND_SIGNAL(c) condition_signal(*c) +#define COND_BROADCAST(c) condition_broadcast(*c) +#define COND_WAIT(c, m) condition_wait(*c, *m) +#define COND_DESTROY(c) \ + STMT_START { \ + condition_free(*c); \ + *c = 0; \ } STMT_END -#define THREAD_RET_TYPE any_t +#define THREAD_RET_TYPE any_t -#define DETACH(t) cthread_detach(t->self) -#define JOIN(t, avp) (*(avp) = MUTABLE_AV(cthread_join(t->self))) +#define DETACH(t) cthread_detach(t->self) +#define JOIN(t, avp) (*(avp) = MUTABLE_AV(cthread_join(t->self))) -#define PERL_SET_CONTEXT(t) cthread_set_data(cthread_self(), t) -#define PERL_GET_CONTEXT cthread_data(cthread_self()) +#define PERL_SET_CONTEXT(t) cthread_set_data(cthread_self(), t) +#define PERL_GET_CONTEXT cthread_data(cthread_self()) -#define INIT_THREADS cthread_init() -#define YIELD cthread_yield() -#define ALLOC_THREAD_KEY NOOP -#define FREE_THREAD_KEY NOOP -#define SET_THREAD_SELF(thr) (thr->self = cthread_self()) +#define INIT_THREADS cthread_init() +#define YIELD cthread_yield() +#define ALLOC_THREAD_KEY NOOP +#define FREE_THREAD_KEY NOOP +#define SET_THREAD_SELF(thr) (thr->self = cthread_self()) #endif /* I_MACH_CTHREADS */ #ifndef YIELD # ifdef SCHED_YIELD -# define YIELD SCHED_YIELD +# define YIELD SCHED_YIELD # elif defined(HAS_SCHED_YIELD) -# define YIELD sched_yield() +# define YIELD sched_yield() # elif defined(HAS_PTHREAD_YIELD) - /* pthread_yield(NULL) platforms are expected - * to have #defined YIELD for themselves. */ -# define YIELD pthread_yield() + /* pthread_yield(NULL) platforms are expected to + * have #defined YIELD for themselves. */ +# define YIELD pthread_yield() # endif #endif @@ -172,378 +174,380 @@ #ifndef MUTEX_INIT # ifdef MUTEX_INIT_NEEDS_MUTEX_ZEROED - /* Temporary workaround, true bug is deeper. --jhi 1999-02-25 */ -# define MUTEX_INIT(m) \ - STMT_START { \ - int _eC_; \ - Zero((m), 1, perl_mutex); \ - if ((_eC_ = pthread_mutex_init((m), pthread_mutexattr_default)))\ - Perl_croak_nocontext("panic: MUTEX_INIT (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ - } STMT_END + /* Temporary workaround, true bug is deeper. --jhi 1999-02-25 */ +# define MUTEX_INIT(m) \ + STMT_START { \ + int _eC_; \ + Zero((m), 1, perl_mutex); \ + if ((_eC_ = pthread_mutex_init((m), pthread_mutexattr_default))) \ + Perl_croak_nocontext("panic: MUTEX_INIT (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ + } STMT_END # else -# define MUTEX_INIT(m) \ - STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_mutex_init((m), pthread_mutexattr_default))) \ - Perl_croak_nocontext("panic: MUTEX_INIT (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ - } STMT_END +# define MUTEX_INIT(m) \ + STMT_START { \ + int _eC_; \ + if ((_eC_ = pthread_mutex_init((m), pthread_mutexattr_default))) \ + Perl_croak_nocontext("panic: MUTEX_INIT (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ + } STMT_END # endif # ifdef PERL_TSA_ACTIVE -# define perl_pthread_mutex_lock(m) perl_tsa_mutex_lock(m) +# define perl_pthread_mutex_lock(m) perl_tsa_mutex_lock(m) # define perl_pthread_mutex_unlock(m) perl_tsa_mutex_unlock(m) # else -# define perl_pthread_mutex_lock(m) pthread_mutex_lock(m) +# define perl_pthread_mutex_lock(m) pthread_mutex_lock(m) # define perl_pthread_mutex_unlock(m) pthread_mutex_unlock(m) # endif -# define MUTEX_LOCK(m) \ - STMT_START { \ - dSAVE_ERRNO; \ - int _eC_; \ - if ((_eC_ = perl_pthread_mutex_lock((m)))) \ - Perl_croak_nocontext("panic: MUTEX_LOCK (%d) [%s:%d]",\ - _eC_, __FILE__, __LINE__); \ - RESTORE_ERRNO; \ - } STMT_END - -# define MUTEX_UNLOCK(m) \ - STMT_START { \ - dSAVE_ERRNO; /* Shouldn't be necessary as panics if fails */\ - int _eC_; \ - if ((_eC_ = perl_pthread_mutex_unlock((m)))) { \ - Perl_croak_nocontext( \ - "panic: MUTEX_UNLOCK (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ - } \ - RESTORE_ERRNO; \ - } STMT_END - -# define MUTEX_DESTROY(m) \ - STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_mutex_destroy((m)))) { \ - dTHX; \ - if (PL_phase != PERL_PHASE_DESTRUCT) { \ - Perl_croak_nocontext("panic: MUTEX_DESTROY (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ - } \ - } \ - } STMT_END +# define MUTEX_LOCK(m) \ + STMT_START { \ + dSAVE_ERRNO; \ + int _eC_; \ + if ((_eC_ = perl_pthread_mutex_lock((m)))) \ + Perl_croak_nocontext("panic: MUTEX_LOCK (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ + RESTORE_ERRNO; \ + } STMT_END + +# define MUTEX_UNLOCK(m) \ + STMT_START { \ + dSAVE_ERRNO; /* Shouldn't be necessary as panics if fails */ \ + int _eC_; \ + if ((_eC_ = perl_pthread_mutex_unlock((m)))) { \ + Perl_croak_nocontext( \ + "panic: MUTEX_UNLOCK (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ + } \ + RESTORE_ERRNO; \ + } STMT_END + +# define MUTEX_DESTROY(m) \ + STMT_START { \ + int _eC_; \ + if ((_eC_ = pthread_mutex_destroy((m)))) { \ + dTHX; \ + if (PL_phase != PERL_PHASE_DESTRUCT) { \ + Perl_croak_nocontext("panic: MUTEX_DESTROY (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ + } \ + } \ + } STMT_END #endif /* MUTEX_INIT */ #ifndef COND_INIT -# define COND_INIT(c) \ - STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_cond_init((c), pthread_condattr_default))) \ - Perl_croak_nocontext("panic: COND_INIT (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ - } STMT_END - -# define COND_SIGNAL(c) \ - STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_cond_signal((c)))) \ - Perl_croak_nocontext("panic: COND_SIGNAL (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ - } STMT_END - -# define COND_BROADCAST(c) \ - STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_cond_broadcast((c)))) \ - Perl_croak_nocontext("panic: COND_BROADCAST (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ - } STMT_END - -# define COND_WAIT(c, m) \ - STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_cond_wait((c), (m)))) \ - Perl_croak_nocontext("panic: COND_WAIT (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ - } STMT_END - -# define COND_DESTROY(c) \ - STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_cond_destroy((c)))) { \ - dTHX; \ - if (PL_phase != PERL_PHASE_DESTRUCT) { \ - Perl_croak_nocontext("panic: COND_DESTROY (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ - } \ - } \ - } STMT_END +# define COND_INIT(c) \ + STMT_START { \ + int _eC_; \ + if ((_eC_ = pthread_cond_init((c), pthread_condattr_default))) \ + Perl_croak_nocontext("panic: COND_INIT (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ + } STMT_END + +# define COND_SIGNAL(c) \ + STMT_START { \ + int _eC_; \ + if ((_eC_ = pthread_cond_signal((c)))) \ + Perl_croak_nocontext("panic: COND_SIGNAL (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ + } STMT_END + +# define COND_BROADCAST(c) \ + STMT_START { \ + int _eC_; \ + if ((_eC_ = pthread_cond_broadcast((c)))) \ + Perl_croak_nocontext("panic: COND_BROADCAST (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ + } STMT_END + +# define COND_WAIT(c, m) \ + STMT_START { \ + int _eC_; \ + if ((_eC_ = pthread_cond_wait((c), (m)))) \ + Perl_croak_nocontext("panic: COND_WAIT (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ + } STMT_END + +# define COND_DESTROY(c) \ + STMT_START { \ + int _eC_; \ + if ((_eC_ = pthread_cond_destroy((c)))) { \ + dTHX; \ + if (PL_phase != PERL_PHASE_DESTRUCT) { \ + Perl_croak_nocontext("panic: COND_DESTROY (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ + } \ + } \ + } STMT_END #endif /* COND_INIT */ -#if defined(MUTEX_LOCK) && defined(MUTEX_UNLOCK) \ - && defined(COND_SIGNAL) && defined(COND_WAIT) +#if defined(MUTEX_LOCK) && defined(MUTEX_UNLOCK) \ + && defined(COND_SIGNAL) && defined(COND_WAIT) -/* These emulate native many-reader/1-writer locks. - * Basically a locking reader just locks the semaphore long enough to increment - * a counter; and similarly decrements it when when through. Any writer will - * run only when the count of readers is 0. That is because it blocks on that +/* These emulate native many-reader/1-writer locks. Basically a locking + * reader just locks the semaphore long enough to increment a counter; and + * similarly decrements it when when through. Any writer will run only + * when the count of readers is 0. That is because it blocks on that * semaphore (doing a COND_WAIT) until it gets control of it, which won't - * happen unless the count becomes 0. ALL readers and other writers are then - * blocked until it releases the semaphore. The reader whose unlocking causes - * the count to become 0 signals any waiting writers, and the system guarantees - * that only one gets control at a time */ - -# define PERL_READ_LOCK(mutex) \ - STMT_START { \ - MUTEX_LOCK(&(mutex)->lock); \ - (mutex)->readers_count++; \ - MUTEX_UNLOCK(&(mutex)->lock); \ - } STMT_END - -# define PERL_READ_UNLOCK(mutex) \ - STMT_START { \ - MUTEX_LOCK(&(mutex)->lock); \ - (mutex)->readers_count--; \ - if ((mutex)->readers_count <= 0) { \ - assert((mutex)->readers_count == 0); \ - COND_SIGNAL(&(mutex)->wakeup); \ - (mutex)->readers_count = 0; \ - } \ - MUTEX_UNLOCK(&(mutex)->lock); \ - } STMT_END - -# define PERL_WRITE_LOCK(mutex) \ - STMT_START { \ - MUTEX_LOCK(&(mutex)->lock); \ - do { \ - if ((mutex)->readers_count <= 0) { \ - assert((mutex)->readers_count == 0); \ - (mutex)->readers_count = 0; \ - break; \ - } \ - COND_WAIT(&(mutex)->wakeup, &(mutex)->lock); \ - } \ - while (1); \ - \ - /* Here, the mutex is locked, with no readers */ \ - } STMT_END - -# define PERL_WRITE_UNLOCK(mutex) \ - STMT_START { \ - COND_SIGNAL(&(mutex)->wakeup); \ - MUTEX_UNLOCK(&(mutex)->lock); \ - } STMT_END - -# define PERL_RW_MUTEX_INIT(mutex) \ - STMT_START { \ - MUTEX_INIT(&(mutex)->lock); \ - COND_INIT(&(mutex)->wakeup); \ - (mutex)->readers_count = 0; \ - } STMT_END - -# define PERL_RW_MUTEX_DESTROY(mutex) \ - STMT_START { \ - COND_DESTROY(&(mutex)->wakeup); \ - MUTEX_DESTROY(&(mutex)->lock); \ - } STMT_END + * happen unless the count becomes 0. ALL readers and other writers are + * then blocked until it releases the semaphore. The reader whose + * unlocking causes the count to become 0 signals any waiting writers, and + * the system guarantees that only one gets control at a time */ + +# define PERL_READ_LOCK(mutex) \ + STMT_START { \ + MUTEX_LOCK(&(mutex)->lock); \ + (mutex)->readers_count++; \ + MUTEX_UNLOCK(&(mutex)->lock); \ + } STMT_END + +# define PERL_READ_UNLOCK(mutex) \ + STMT_START { \ + MUTEX_LOCK(&(mutex)->lock); \ + (mutex)->readers_count--; \ + if ((mutex)->readers_count <= 0) { \ + assert((mutex)->readers_count == 0); \ + COND_SIGNAL(&(mutex)->wakeup); \ + (mutex)->readers_count = 0; \ + } \ + MUTEX_UNLOCK(&(mutex)->lock); \ + } STMT_END + +# define PERL_WRITE_LOCK(mutex) \ + STMT_START { \ + MUTEX_LOCK(&(mutex)->lock); \ + do { \ + if ((mutex)->readers_count <= 0) { \ + assert((mutex)->readers_count == 0); \ + (mutex)->readers_count = 0; \ + break; \ + } \ + COND_WAIT(&(mutex)->wakeup, &(mutex)->lock); \ + } \ + while (1); \ + \ + /* Here, the mutex is locked, with no readers */ \ + } STMT_END + +# define PERL_WRITE_UNLOCK(mutex) \ + STMT_START { \ + COND_SIGNAL(&(mutex)->wakeup); \ + MUTEX_UNLOCK(&(mutex)->lock); \ + } STMT_END + +# define PERL_RW_MUTEX_INIT(mutex) \ + STMT_START { \ + MUTEX_INIT(&(mutex)->lock); \ + COND_INIT(&(mutex)->wakeup); \ + (mutex)->readers_count = 0; \ + } STMT_END + +# define PERL_RW_MUTEX_DESTROY(mutex) \ + STMT_START { \ + COND_DESTROY(&(mutex)->wakeup); \ + MUTEX_DESTROY(&(mutex)->lock); \ + } STMT_END #endif /* DETACH(t) must only be called while holding t->mutex */ #ifndef DETACH -# define DETACH(t) \ - STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_detach((t)->self))) { \ - MUTEX_UNLOCK(&(t)->mutex); \ - Perl_croak_nocontext("panic: DETACH (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ - } \ - } STMT_END +# define DETACH(t) \ + STMT_START { \ + int _eC_; \ + if ((_eC_ = pthread_detach((t)->self))) { \ + MUTEX_UNLOCK(&(t)->mutex); \ + Perl_croak_nocontext("panic: DETACH (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ + } \ + } STMT_END #endif /* DETACH */ #ifndef JOIN -# define JOIN(t, avp) \ - STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_join((t)->self, (void**)(avp)))) \ - Perl_croak_nocontext("panic: pthread_join (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ - } STMT_END +# define JOIN(t, avp) \ + STMT_START { \ + int _eC_; \ + if ((_eC_ = pthread_join((t)->self, (void**)(avp)))) \ + Perl_croak_nocontext("panic: pthread_join (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ + } STMT_END #endif /* JOIN */ -/* Use an unchecked fetch of thread-specific data instead of a checked one. - * It would fail if the key were bogus, but if the key were bogus then - * Really Bad Things would be happening anyway. --dan */ -#if (defined(__ALPHA) && (__VMS_VER >= 70000000)) || \ - (defined(__alpha) && defined(__osf__) && !defined(__GNUC__)) /* Available only on >= 4.0 */ +/* Use an unchecked fetch of thread-specific data instead of a checked + * one. It would fail if the key were bogus, but if the key were + * bogus then Really Bad Things would be happening anyway. --dan */ +#if (defined(__ALPHA) && (__VMS_VER >= 70000000)) || \ + (defined(__alpha) && defined(__osf__) && !defined(__GNUC__)) /* Available + only on >= + 4.0 */ # define HAS_PTHREAD_UNCHECKED_GETSPECIFIC_NP /* Configure test needed */ #endif #ifdef HAS_PTHREAD_UNCHECKED_GETSPECIFIC_NP -# define PTHREAD_GETSPECIFIC(key) pthread_unchecked_getspecific_np(key) +# define PTHREAD_GETSPECIFIC(key) pthread_unchecked_getspecific_np(key) #else -# define PTHREAD_GETSPECIFIC(key) pthread_getspecific(key) +# define PTHREAD_GETSPECIFIC(key) pthread_getspecific(key) #endif #if defined(PERL_THREAD_LOCAL) && !defined(PERL_GET_CONTEXT) && !defined(PERL_SET_CONTEXT) && !defined(__cplusplus) -/* Use C11 thread-local storage, where possible. - * Frustratingly we can't use it for C++ extensions, C++ and C disagree on the - * syntax used for thread local storage, meaning that the working token that - * Configure probed for C turns out to be a compiler error on C++. Great. - * (Well, unless one or both is supporting non-standard syntax as an extension) - * As Configure doesn't have a way to probe for C++ dialects, we just take the - * safe option and do the same as 5.34.0 and earlier - use pthreads on C++. - * Of course, if C++ XS extensions really want to avoid *all* this overhead, - * they should #define PERL_NO_GET_CONTEXT and pass aTHX/aTHX_ explicitly) */ +/* Use C11 thread-local storage, where possible. Frustratingly we can't use + * it for C++ extensions, C++ and C disagree on the syntax used for thread + * local storage, meaning that the working token that Configure probed for C + * turns out to be a compiler error on C++. Great. (Well, unless one or + * both is supporting non-standard syntax as an extension) As Configure + * doesn't have a way to probe for C++ dialects, we just take the safe option + * and do the same as 5.34.0 and earlier - use pthreads on C++. Of course, + * if C++ XS extensions really want to avoid *all* this overhead, they should + * #define PERL_NO_GET_CONTEXT and pass aTHX/aTHX_ explicitly) */ # define PERL_USE_THREAD_LOCAL extern PERL_THREAD_LOCAL void *PL_current_context; -# define PERL_GET_CONTEXT PL_current_context +# define PERL_GET_CONTEXT PL_current_context -/* We must also call pthread_setspecific() always, as C++ code has to read it - * with pthreads (the #else side just below) */ +/* We must also call pthread_setspecific() always, as C++ code has + * to read it with pthreads (the #else side just below) */ -# define PERL_SET_CONTEXT(t) \ - STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_setspecific(PL_thr_key, \ - PL_current_context = (void *)(t)))) \ - Perl_croak_nocontext("panic: pthread_setspecific (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ - PERL_SET_NON_tTHX_CONTEXT(t); \ - } STMT_END +# define PERL_SET_CONTEXT(t) \ + STMT_START { \ + int _eC_; \ + if ((_eC_ = pthread_setspecific(PL_thr_key, \ + PL_current_context = (void *)(t)))) \ + Perl_croak_nocontext("panic: pthread_setspecific (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ + PERL_SET_NON_tTHX_CONTEXT(t); \ + } STMT_END #else /* else fall back to pthreads */ # ifndef PERL_GET_CONTEXT -# define PERL_GET_CONTEXT PTHREAD_GETSPECIFIC(PL_thr_key) +# define PERL_GET_CONTEXT PTHREAD_GETSPECIFIC(PL_thr_key) # endif /* For C++ extensions built on a system where the C compiler provides thread * local storage that call PERL_SET_CONTEXT() also need to set - * PL_current_context, so need to call into C code to do this. - * To avoid exploding code complexity, do this also on C platforms that don't - * support thread local storage. PERL_SET_CONTEXT is not called that often. */ + * PL_current_context, so need to call into C code to do this. To avoid + * exploding code complexity, do this also on C platforms that don't support + * thread local storage. PERL_SET_CONTEXT is not called that often. */ # ifndef PERL_SET_CONTEXT -# define PERL_SET_CONTEXT(t) Perl_set_context((void*)t) +# define PERL_SET_CONTEXT(t) Perl_set_context((void*)t) # endif /* PERL_SET_CONTEXT */ #endif /* PERL_THREAD_LOCAL */ #ifndef INIT_THREADS # ifdef NEED_PTHREAD_INIT -# define INIT_THREADS pthread_init() +# define INIT_THREADS pthread_init() # endif #endif #ifndef ALLOC_THREAD_KEY -# define ALLOC_THREAD_KEY \ - STMT_START { \ - if (pthread_key_create(&PL_thr_key, 0)) { \ - PERL_UNUSED_RESULT(write(2, STR_WITH_LEN("panic: pthread_key_create failed\n"))); \ - exit(1); \ - } \ - } STMT_END +# define ALLOC_THREAD_KEY \ + STMT_START { \ + if (pthread_key_create(&PL_thr_key, 0)) { \ + PERL_UNUSED_RESULT(write(2, STR_WITH_LEN("panic: pthread_key_create failed\n"))); \ + exit(1); \ + } \ + } STMT_END #endif #ifndef FREE_THREAD_KEY -# define FREE_THREAD_KEY \ - STMT_START { \ - pthread_key_delete(PL_thr_key); \ - } STMT_END +# define FREE_THREAD_KEY \ + STMT_START { \ + pthread_key_delete(PL_thr_key); \ + } STMT_END #endif #ifndef PTHREAD_ATFORK # ifdef HAS_PTHREAD_ATFORK -# define PTHREAD_ATFORK(prepare,parent,child) \ - pthread_atfork(prepare,parent,child) +# define PTHREAD_ATFORK(prepare,parent,child) \ + pthread_atfork(prepare,parent,child) # else -# define PTHREAD_ATFORK(prepare,parent,child) \ - NOOP +# define PTHREAD_ATFORK(prepare,parent,child) \ + NOOP # endif #endif #ifndef THREAD_RET_TYPE -# define THREAD_RET_TYPE void * +# define THREAD_RET_TYPE void * #endif /* THREAD_RET */ -# define LOCK_DOLLARZERO_MUTEX MUTEX_LOCK(&PL_dollarzero_mutex) -# define UNLOCK_DOLLARZERO_MUTEX MUTEX_UNLOCK(&PL_dollarzero_mutex) +# define LOCK_DOLLARZERO_MUTEX MUTEX_LOCK(&PL_dollarzero_mutex) +# define UNLOCK_DOLLARZERO_MUTEX MUTEX_UNLOCK(&PL_dollarzero_mutex) #endif /* USE_ITHREADS */ #ifndef MUTEX_LOCK -# define MUTEX_LOCK(m) NOOP +# define MUTEX_LOCK(m) NOOP #endif #ifndef MUTEX_UNLOCK -# define MUTEX_UNLOCK(m) NOOP +# define MUTEX_UNLOCK(m) NOOP #endif #ifndef MUTEX_INIT -# define MUTEX_INIT(m) NOOP +# define MUTEX_INIT(m) NOOP #endif #ifndef MUTEX_DESTROY -# define MUTEX_DESTROY(m) NOOP +# define MUTEX_DESTROY(m) NOOP #endif #ifndef COND_INIT -# define COND_INIT(c) NOOP +# define COND_INIT(c) NOOP #endif #ifndef COND_SIGNAL -# define COND_SIGNAL(c) NOOP +# define COND_SIGNAL(c) NOOP #endif #ifndef COND_BROADCAST -# define COND_BROADCAST(c) NOOP +# define COND_BROADCAST(c) NOOP #endif #ifndef COND_WAIT -# define COND_WAIT(c, m) NOOP +# define COND_WAIT(c, m) NOOP #endif #ifndef COND_DESTROY -# define COND_DESTROY(c) NOOP +# define COND_DESTROY(c) NOOP #endif #ifndef PERL_READ_LOCK -# define PERL_READ_LOCK NOOP -# define PERL_READ_UNLOCK NOOP -# define PERL_WRITE_LOCK NOOP -# define PERL_WRITE_UNLOCK NOOP -# define PERL_RW_MUTEX_INIT NOOP -# define PERL_RW_MUTEX_DESTROY NOOP +# define PERL_READ_LOCK NOOP +# define PERL_READ_UNLOCK NOOP +# define PERL_WRITE_LOCK NOOP +# define PERL_WRITE_UNLOCK NOOP +# define PERL_RW_MUTEX_INIT NOOP +# define PERL_RW_MUTEX_DESTROY NOOP #endif #ifndef LOCK_DOLLARZERO_MUTEX -# define LOCK_DOLLARZERO_MUTEX NOOP +# define LOCK_DOLLARZERO_MUTEX NOOP #endif #ifndef UNLOCK_DOLLARZERO_MUTEX -# define UNLOCK_DOLLARZERO_MUTEX NOOP +# define UNLOCK_DOLLARZERO_MUTEX NOOP #endif /* THR, SET_THR, and dTHR are there for compatibility with old versions */ #ifndef THR -# define THR PERL_GET_THX +# define THR PERL_GET_THX #endif #ifndef SET_THR -# define SET_THR(t) PERL_SET_THX(t) +# define SET_THR(t) PERL_SET_THX(t) #endif #ifndef dTHR -# define dTHR dNOOP +# define dTHR dNOOP #endif #ifndef INIT_THREADS -# define INIT_THREADS NOOP +# define INIT_THREADS NOOP #endif /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/time64.h b/time64.h index 8064ae7cf1a9..91d84b414400 100644 --- a/time64.h +++ b/time64.h @@ -13,31 +13,31 @@ typedef I32 Year; /* A copy of the tm struct but with a 64 bit year */ struct TM64 { - int tm_sec; - int tm_min; - int tm_hour; - int tm_mday; - int tm_mon; - Year tm_year; - int tm_wday; - int tm_yday; - int tm_isdst; + int tm_sec; + int tm_min; + int tm_hour; + int tm_mday; + int tm_mon; + Year tm_year; + int tm_wday; + int tm_yday; + int tm_isdst; #ifdef HAS_TM_TM_GMTOFF - long tm_gmtoff; + long tm_gmtoff; #endif #ifdef HAS_TM_TM_ZONE - const char *tm_zone; + const char *tm_zone; #endif }; /* Decide which tm struct to use */ #ifdef USE_TM64 -#define TM TM64 +#define TM TM64 #else -#define TM tm +#define TM tm #endif diff --git a/time64_config.h b/time64_config.h index 8a8dbef6dd7e..5a2d500edb00 100644 --- a/time64_config.h +++ b/time64_config.h @@ -3,82 +3,66 @@ #include "reentr.h" -/* Configuration - ------------- - Define as appropriate for your system. - Sensible defaults provided. -*/ - -/* Debugging - TIME_64_DEBUG - Define if you want debugging messages -*/ +/* Configuration ------------- Define as appropriate + for your system. Sensible defaults provided. + */ + +/* Debugging TIME_64_DEBUG Define if you want debugging messages + */ /* #define TIME_64_DEBUG */ -/* INT_64_T - A numeric type to store time and others. - Must be defined. -*/ +/* INT_64_T A numeric type to store time and others. Must be defined. + */ #define INT_64_T NV -/* USE_TM64 - Should we use a 64 bit safe replacement for tm? This will +/* USE_TM64 Should we use a 64 bit safe replacement for tm? This will let you go past year 2 billion but the struct will be incompatible with tm. Conversion functions will be provided. -*/ + */ #define USE_TM64 /* Availability of system functions. - HAS_GMTIME_R - Define if your system has gmtime_r() + HAS_GMTIME_R Define if your system has gmtime_r() - HAS_LOCALTIME_R - Define if your system has localtime_r() + HAS_LOCALTIME_R Define if your system has localtime_r() - HAS_TIMEGM - Define if your system has timegm(), a GNU extension. -*/ + HAS_TIMEGM Define if your system has timegm(), a GNU extension. + */ /* Set in config.h */ /* Details of non-standard tm struct elements. - HAS_TM_TM_GMTOFF - True if your tm struct has a "tm_gmtoff" element. - A BSD extension. + HAS_TM_TM_GMTOFF True if your tm struct has + a "tm_gmtoff" element. A BSD extension. - HAS_TM_TM_ZONE - True if your tm struct has a "tm_zone" element. - A BSD extension. -*/ + HAS_TM_TM_ZONE True if your tm struct has a + "tm_zone" element. A BSD extension. + */ /* Set in config.h */ -/* USE_SYSTEM_LOCALTIME - USE_SYSTEM_GMTIME - Should we use the system functions if the time is inside their range? - Your system localtime() is probably more accurate, but our gmtime() is - fast and safe. Except on VMS, where we need the homegrown gmtime() - override to shift between UTC and local for the vmsish 'time' pragma. -*/ +/* USE_SYSTEM_LOCALTIME USE_SYSTEM_GMTIME Should we use the system + functions if the time is inside their range? Your system + localtime() is probably more accurate, but our gmtime() is fast and + safe. Except on VMS, where we need the homegrown gmtime() override + to shift between UTC and local for the vmsish 'time' pragma. + */ #define USE_SYSTEM_LOCALTIME #ifdef VMS # define USE_SYSTEM_GMTIME #endif -/* SYSTEM_LOCALTIME_MAX - SYSTEM_LOCALTIME_MIN - SYSTEM_GMTIME_MAX - SYSTEM_GMTIME_MIN - Maximum and minimum values your system's gmtime() and localtime() - can handle. We will use your system functions if the time falls - inside these ranges. -*/ +/* SYSTEM_LOCALTIME_MAX SYSTEM_LOCALTIME_MIN SYSTEM_GMTIME_MAX + SYSTEM_GMTIME_MIN Maximum and minimum values your system's + gmtime() and localtime() can handle. We will use your + system functions if the time falls inside these ranges. + */ #define SYSTEM_LOCALTIME_MAX CAT2(LOCALTIME_MAX,.0) #define SYSTEM_LOCALTIME_MIN CAT2(LOCALTIME_MIN,.0) #define SYSTEM_GMTIME_MAX CAT2(GMTIME_MAX,.0) diff --git a/unixish.h b/unixish.h index 28ebcbe95382..000adde9ba48 100644 --- a/unixish.h +++ b/unixish.h @@ -1,174 +1,162 @@ /* unixish.h * * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1999, 2000, 2001, 2002, - * 2003, 2006, 2007, by Larry Wall and others + * 2003, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, + * 2016, 2017, 2018, 2019, 2020, 2021, 2022 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * */ /* * The following symbols are defined if your operating system supports - * functions by that name. All Unixes I know of support them, thus they - * are not checked by the configuration script, but are directly defined - * here. - */ + * functions by that name. All Unixes I know of support them, thus they are + * not checked by the configuration script, but are directly defined here. +*/ #ifndef PERL_MICRO -/* HAS_IOCTL: - * This symbol, if defined, indicates that the ioctl() routine is - * available to set I/O characteristics +/* HAS_IOCTL: This symbol, if defined, indicates that the ioctl() + * routine is available to set I/O characteristics */ -#define HAS_IOCTL /**/ - -/* HAS_UTIME: - * This symbol, if defined, indicates that the routine utime() is - * available to update the access and modification times of files. +#define HAS_IOCTL /**/ + +/* HAS_UTIME: This symbol, if defined, indicates that the routine utime() + * is available to update the access and modification times of files. */ -#define HAS_UTIME /**/ +#define HAS_UTIME /**/ -/* HAS_GROUP - * This symbol, if defined, indicates that the getgrnam() and - * getgrgid() routines are available to get group entries. - * The getgrent() has a separate definition, HAS_GETGRENT. +/* HAS_GROUP This symbol, if defined, indicates that the getgrnam() + * and getgrgid() routines are available to get group entries. The + * getgrent() has a separate definition, HAS_GETGRENT. */ -#define HAS_GROUP /**/ +#define HAS_GROUP /**/ -/* HAS_PASSWD - * This symbol, if defined, indicates that the getpwnam() and - * getpwuid() routines are available to get password entries. - * The getpwent() has a separate definition, HAS_GETPWENT. +/* HAS_PASSWD This symbol, if defined, indicates that the getpwnam() + * and getpwuid() routines are available to get password entries. + * The getpwent() has a separate definition, HAS_GETPWENT. */ -#define HAS_PASSWD /**/ +#define HAS_PASSWD /**/ #define HAS_KILL #define HAS_WAIT #endif /* !PERL_MICRO */ - -/* USEMYBINMODE - * This symbol, if defined, indicates that the program should - * use the routine my_binmode(FILE *fp, char iotype) to insure - * that a file is in "binary" mode -- that is, that no translation - * of bytes occurs on read or write operations. + +/* USEMYBINMODE This symbol, if defined, indicates that the program + * should use the routine my_binmode(FILE *fp, char iotype) to + * insure that a file is in "binary" mode -- that is, that no + * translation of bytes occurs on read or write operations. */ #undef USEMYBINMODE -/* Stat_t: - * This symbol holds the type used to declare buffers for information - * returned by stat(). It's usually just struct stat. It may be necessary - * to include and to get any typedef'ed - * information. +/* Stat_t: This symbol holds the type used to declare buffers for information + * returned by stat(). It's usually just struct stat. It may be necessary to + * include and to get any typedef'ed information. */ -#define Stat_t struct stat +#define Stat_t struct stat -/* USE_STAT_RDEV: - * This symbol is defined if this system has a stat structure declaring - * st_rdev +/* USE_STAT_RDEV: This symbol is defined if this system + * has a stat structure declaring st_rdev */ -#define USE_STAT_RDEV /**/ +#define USE_STAT_RDEV /**/ -/* ACME_MESS: - * This symbol, if defined, indicates that error messages should be - * should be generated in a format that allows the use of the Acme - * GUI/editor's autofind feature. +/* ACME_MESS: This symbol, if defined, indicates that error + * messages should be should be generated in a format that allows + * the use of the Acme GUI/editor's autofind feature. */ -#undef ACME_MESS /**/ +#undef ACME_MESS /**/ -/* UNLINK_ALL_VERSIONS: - * This symbol, if defined, indicates that the program should arrange - * to remove all versions of a file if unlink() is called. This is - * probably only relevant for VMS. +/* UNLINK_ALL_VERSIONS: This symbol, if defined, indicates that the + * program should arrange to remove all versions of a file if + * unlink() is called. This is probably only relevant for VMS. */ -/* #define UNLINK_ALL_VERSIONS / **/ +/* #define UNLINK_ALL_VERSIONS / * */ -/* VMS: - * This symbol, if defined, indicates that the program is running under - * VMS. It is currently automatically set by cpps running under VMS, - * and is included here for completeness only. +/* VMS: This symbol, if defined, indicates that the program is running + * under VMS. It is currently automatically set by cpps running under + * VMS, and is included here for completeness only. */ -/* #define VMS / **/ - -/* ALTERNATE_SHEBANG: - * This symbol, if defined, contains a "magic" string which may be used - * as the first line of a Perl program designed to be executed directly - * by name, instead of the standard Unix #!. If ALTERNATE_SHEBANG - * begins with a character other then #, then Perl will only treat - * it as a command line if it finds the string "perl" in the first - * word; otherwise it's treated as the first line of code in the script. - * (IOW, Perl won't hand off to another interpreter via an alternate - * shebang sequence that might be legal Perl code.) +/* #define VMS / * */ + +/* ALTERNATE_SHEBANG: This symbol, if defined, contains a "magic" string + * which may be used as the first line of a Perl program designed to be + * executed directly by name, instead of the standard Unix #!. If + * ALTERNATE_SHEBANG begins with a character other then #, then Perl + * will only treat it as a command line if it finds the string "perl" in + * the first word; otherwise it's treated as the first line of code in + * the script. (IOW, Perl won't hand off to another interpreter via an + * alternate shebang sequence that might be legal Perl code.) */ -/* #define ALTERNATE_SHEBANG "#!" / **/ +/* #define ALTERNATE_SHEBANG "#!" / * */ # include #ifndef SIGABRT -# define SIGABRT SIGILL +# define SIGABRT SIGILL #endif #ifndef SIGILL -# define SIGILL 6 /* blech */ +# define SIGILL 6 /* blech */ #endif -#define ABORT() kill(PerlProc_getpid(),SIGABRT); +#define ABORT() kill(PerlProc_getpid(),SIGABRT); /* - * fwrite1() should be a routine with the same calling sequence as fwrite(), - * but which outputs all of the bytes requested as a single stream (unlike - * fwrite() itself, which on some systems outputs several distinct records - * if the number_of_items parameter is >1). - */ -#define fwrite1 fwrite + * fwrite1() should be a routine with the same calling sequence as + * fwrite(), but which outputs all of the bytes requested as a single + * stream (unlike fwrite() itself, which on some systems outputs several + * distinct records if the number_of_items parameter is >1). +*/ +#define fwrite1 fwrite -#define Stat(fname,bufptr) stat((fname),(bufptr)) +#define Stat(fname,bufptr) stat((fname),(bufptr)) #ifdef __amigaos4__ int afstat(int fd, struct stat *statb); -# define Fstat(fd,bufptr) afstat((fd),(bufptr)) +# define Fstat(fd,bufptr) afstat((fd),(bufptr)) #endif #ifndef Fstat -# define Fstat(fd,bufptr) fstat((fd),(bufptr)) +# define Fstat(fd,bufptr) fstat((fd),(bufptr)) #endif -#define Fflush(fp) fflush(fp) -#define Mkdir(path,mode) mkdir((path),(mode)) +#define Fflush(fp) fflush(fp) +#define Mkdir(path,mode) mkdir((path),(mode)) #if defined(__amigaos4__) # define PLATFORM_SYS_TERM_ amigaos4_dispose_fork_array() -# define PLATFORM_SYS_INIT_ STMT_START { \ - amigaos4_init_fork_array(); \ - amigaos4_init_environ_sema(); \ - } STMT_END -#else +# define PLATFORM_SYS_INIT_ \ + STMT_START { \ + amigaos4_init_fork_array(); \ + amigaos4_init_environ_sema(); \ + } STMT_END +#else # define PLATFORM_SYS_TERM_ NOOP # define PLATFORM_SYS_INIT_ NOOP #endif #ifndef PERL_SYS_INIT_BODY -#define PERL_SYS_INIT_BODY(c,v) \ - MALLOC_CHECK_TAINT2(*c,*v) PERL_FPU_INIT; PERLIO_INIT; \ - MALLOC_INIT; PLATFORM_SYS_INIT_; +#define PERL_SYS_INIT_BODY(c,v) \ + MALLOC_CHECK_TAINT2(*c,*v) PERL_FPU_INIT; PERLIO_INIT; \ + MALLOC_INIT; PLATFORM_SYS_INIT_; #endif -/* Generally add things last-in first-terminated. IO and memory terminations - * need to be generally last +/* Generally add things last-in first-terminated. IO and memory + * terminations need to be generally last * - * BEWARE that using PerlIO in these will be using freed memory, so may appear - * to work, but must NOT be retained in production code. */ + * BEWARE that using PerlIO in these will be using freed memory, so may + * appear to work, but must NOT be retained in production code. */ #ifndef PERL_SYS_TERM_BODY -# define PERL_SYS_TERM_BODY() \ - ENV_TERM; USER_PROP_MUTEX_TERM; LOCALE_TERM; \ - HINTS_REFCNT_TERM; KEYWORD_PLUGIN_MUTEX_TERM; \ - OP_CHECK_MUTEX_TERM; OP_REFCNT_TERM; \ - PERLIO_TERM; MALLOC_TERM; \ - PLATFORM_SYS_TERM_; +# define PERL_SYS_TERM_BODY() \ + ENV_TERM; USER_PROP_MUTEX_TERM; LOCALE_TERM; \ + HINTS_REFCNT_TERM; KEYWORD_PLUGIN_MUTEX_TERM; \ + OP_CHECK_MUTEX_TERM; OP_REFCNT_TERM; \ + PERLIO_TERM; MALLOC_TERM; \ + PLATFORM_SYS_TERM_; #endif -#define BIT_BUCKET "/dev/null" +#define BIT_BUCKET "/dev/null" -#define dXSUB_SYS dNOOP +#define dXSUB_SYS dNOOP #ifndef NO_ENVIRON_ARRAY #define USE_ENVIRON_ARRAY @@ -176,4 +164,4 @@ int afstat(int fd, struct stat *statb); /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/utf8.h b/utf8.h index e0b08ad6fb21..284e887bd7ce 100644 --- a/utf8.h +++ b/utf8.h @@ -1,36 +1,37 @@ /* utf8.h * - * This file contains definitions for use with the UTF-8 encoding. It - * actually also works with the variant UTF-8 encoding called UTF-EBCDIC, and - * hides almost all of the differences between these from the caller. In other - * words, someone should #include this file, and if the code is being compiled - * on an EBCDIC platform, things should mostly just work. + * This file contains definitions for use with the UTF-8 encoding. It + * actually also works with the variant UTF-8 encoding called UTF-EBCDIC, + * and hides almost all of the differences between these from the caller. + * In other words, someone should #include this file, and if the code is + * being compiled on an EBCDIC platform, things should mostly just work. * - * Copyright (C) 2000, 2001, 2002, 2005, 2006, 2007, 2009, - * 2010, 2011 by Larry Wall and others + * Copyright (C) 2000, 2001, 2002, 2005, 2006, 2007, 2009, 2010, 2011, 2012, + * 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021, 2022 by Larry Wall + * and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * - * A note on nomenclature: The term UTF-8 is used loosely and inconsistently - * in Perl documentation. For one, perl uses an extension of UTF-8 to - * represent code points that Unicode considers illegal. For another, ASCII - * platform UTF-8 is usually conflated with EBCDIC platform UTF-EBCDIC, because - * outside some of the macros in this this file, the differences are hopefully - * invisible at the semantic level. + * A note on nomenclature: The term UTF-8 is used loosely and inconsistently + * in Perl documentation. For one, perl uses an extension of UTF-8 to + * represent code points that Unicode considers illegal. For another, ASCII + * platform UTF-8 is usually conflated with EBCDIC platform UTF-EBCDIC, + * because outside some of the macros in this this file, the differences are + * hopefully invisible at the semantic level. * - * UTF-EBCDIC has an isomorphic translation named I8 (for "Intermediate eight") - * which differs from UTF-8 only in a few details. It is often useful to - * translate UTF-EBCDIC into this form for processing. In general, macros and - * functions that are expecting their inputs to be either in I8 or UTF-8 are - * named UTF_foo (without an '8'), to indicate this. - * - * Unfortunately there are inconsistencies. + * UTF-EBCDIC has an isomorphic translation named I8 (for "Intermediate + * eight") which differs from UTF-8 only in a few details. It is often + * useful to translate UTF-EBCDIC into this form for processing. In + * general, macros and functions that are expecting their inputs to be + * either in I8 or UTF-8 are named UTF_foo (without an '8'), to indicate + * this. * + * Unfortunately there are inconsistencies. */ #ifndef PERL_UTF8_H_ /* Guard against recursive inclusion */ -#define PERL_UTF8_H_ 1 +#define PERL_UTF8_H_ 1 /* =for apidoc Ay||utf8ness_t @@ -101,83 +102,82 @@ the string may be treated in code as encoded in UTF-8 typedef enum { UTF8NESS_NO = 0, /* Definitely not UTF-8 */ - UTF8NESS_IMMATERIAL = 1, /* Representation is the same in UTF-8 as - not, so the UTF8ness doesn't actually - matter */ + UTF8NESS_IMMATERIAL = 1, /* Representation is the same in + UTF-8 as not, so the UTF8ness + doesn't actually matter */ UTF8NESS_YES = 2, /* Defintely is UTF-8, wideness unspecified */ UTF8NESS_UNKNOWN = (STRLEN) -1, /* Undetermined so far */ } utf8ness_t; -/* Use UTF-8 as the default script encoding? - * Turning this on will break scripts having non-UTF-8 binary - * data (such as Latin-1) in string literals. */ +/* Use UTF-8 as the default script encoding? Turning this on will break scripts + * having non-UTF-8 binary data (such as Latin-1) in string literals. */ #ifdef USE_UTF8_SCRIPTS -# define USE_UTF8_IN_NAMES (!IN_BYTES) +# define USE_UTF8_IN_NAMES (!IN_BYTES) #else -# define USE_UTF8_IN_NAMES (PL_hints & HINT_UTF8) +# define USE_UTF8_IN_NAMES (PL_hints & HINT_UTF8) #endif #include "regcharclass.h" #include "unicode_constants.h" /* For to_utf8_fold_flags, q.v. */ -#define FOLD_FLAGS_LOCALE 0x1 -#define FOLD_FLAGS_FULL 0x2 -#define FOLD_FLAGS_NOMIX_ASCII 0x4 +#define FOLD_FLAGS_LOCALE 0x1 +#define FOLD_FLAGS_FULL 0x2 +#define FOLD_FLAGS_NOMIX_ASCII 0x4 /* =for apidoc is_ascii_string -This is a misleadingly-named synonym for L. -On ASCII-ish platforms, the name isn't misleading: the ASCII-range characters -are exactly the UTF-8 invariants. But EBCDIC machines have more invariants -than just the ASCII characters, so C is preferred. +This is a misleadingly-named synonym for L. On +ASCII-ish platforms, the name isn't misleading: the ASCII-range characters are +exactly the UTF-8 invariants. But EBCDIC machines have more invariants than +just the ASCII characters, so C is preferred. =for apidoc is_invariant_string -This is a somewhat misleadingly-named synonym for L. -C is preferred, as it indicates under what conditions -the string is invariant. +This is a somewhat misleadingly-named synonym for +L. C is preferred, as it +indicates under what conditions the string is invariant. =cut */ #define is_ascii_string(s, len) is_utf8_invariant_string(s, len) #define is_invariant_string(s, len) is_utf8_invariant_string(s, len) -#define uvoffuni_to_utf8_flags(d,uv,flags) \ - uvoffuni_to_utf8_flags_msgs(d, uv, flags, 0) +#define uvoffuni_to_utf8_flags(d,uv,flags) \ + uvoffuni_to_utf8_flags_msgs(d, uv, flags, 0) #define uvchr_to_utf8(a,b) uvchr_to_utf8_flags(a,b,0) -#define uvchr_to_utf8_flags(d,uv,flags) \ - uvchr_to_utf8_flags_msgs(d,uv,flags, 0) -#define uvchr_to_utf8_flags_msgs(d,uv,flags,msgs) \ - uvoffuni_to_utf8_flags_msgs(d,NATIVE_TO_UNI(uv),flags, msgs) -#define utf8_to_uvchr_buf(s, e, lenp) \ - utf8_to_uvchr_buf_helper((const U8 *) (s), (const U8 *) e, lenp) -#define utf8n_to_uvchr(s, len, lenp, flags) \ - utf8n_to_uvchr_error(s, len, lenp, flags, 0) -#define utf8n_to_uvchr_error(s, len, lenp, flags, errors) \ - utf8n_to_uvchr_msgs(s, len, lenp, flags, errors, 0) - -#define utf16_to_utf8(p, d, bytelen, newlen) \ - utf16_to_utf8_base(p, d, bytelen, newlen, 0, 1) -#define utf16_to_utf8_reversed(p, d, bytelen, newlen) \ - utf16_to_utf8_base(p, d, bytelen, newlen, 1, 0) -#define utf8_to_utf16(p, d, bytelen, newlen) \ - utf8_to_utf16_base(p, d, bytelen, newlen, 0, 1) -#define utf8_to_utf16_reversed(p, d, bytelen, newlen) \ - utf8_to_utf16_base(p, d, bytelen, newlen, 1, 0) - -#define to_uni_fold(c, p, lenp) _to_uni_fold_flags(c, p, lenp, FOLD_FLAGS_FULL) - -#define foldEQ_utf8(s1, pe1, l1, u1, s2, pe2, l2, u2) \ - foldEQ_utf8_flags(s1, pe1, l1, u1, s2, pe2, l2, u2, 0) -#define FOLDEQ_UTF8_NOMIX_ASCII (1 << 0) -#define FOLDEQ_LOCALE (1 << 1) -#define FOLDEQ_S1_ALREADY_FOLDED (1 << 2) -#define FOLDEQ_S2_ALREADY_FOLDED (1 << 3) -#define FOLDEQ_S1_FOLDS_SANE (1 << 4) -#define FOLDEQ_S2_FOLDS_SANE (1 << 5) +#define uvchr_to_utf8_flags(d,uv,flags) \ + uvchr_to_utf8_flags_msgs(d,uv,flags, 0) +#define uvchr_to_utf8_flags_msgs(d,uv,flags,msgs) \ + uvoffuni_to_utf8_flags_msgs(d,NATIVE_TO_UNI(uv),flags, msgs) +#define utf8_to_uvchr_buf(s, e, lenp) \ + utf8_to_uvchr_buf_helper((const U8 *) (s), (const U8 *) e, lenp) +#define utf8n_to_uvchr(s, len, lenp, flags) \ + utf8n_to_uvchr_error(s, len, lenp, flags, 0) +#define utf8n_to_uvchr_error(s, len, lenp, flags, errors) \ + utf8n_to_uvchr_msgs(s, len, lenp, flags, errors, 0) + +#define utf16_to_utf8(p, d, bytelen, newlen) \ + utf16_to_utf8_base(p, d, bytelen, newlen, 0, 1) +#define utf16_to_utf8_reversed(p, d, bytelen, newlen) \ + utf16_to_utf8_base(p, d, bytelen, newlen, 1, 0) +#define utf8_to_utf16(p, d, bytelen, newlen) \ + utf8_to_utf16_base(p, d, bytelen, newlen, 0, 1) +#define utf8_to_utf16_reversed(p, d, bytelen, newlen) \ + utf8_to_utf16_base(p, d, bytelen, newlen, 1, 0) + +#define to_uni_fold(c, p, lenp) _to_uni_fold_flags(c, p, lenp, FOLD_FLAGS_FULL) + +#define foldEQ_utf8(s1, pe1, l1, u1, s2, pe2, l2, u2) \ + foldEQ_utf8_flags(s1, pe1, l1, u1, s2, pe2, l2, u2, 0) +#define FOLDEQ_UTF8_NOMIX_ASCII (1 << 0) +#define FOLDEQ_LOCALE (1 << 1) +#define FOLDEQ_S1_ALREADY_FOLDED (1 << 2) +#define FOLDEQ_S2_ALREADY_FOLDED (1 << 3) +#define FOLDEQ_S1_FOLDS_SANE (1 << 4) +#define FOLDEQ_S2_FOLDS_SANE (1 << 5) /* This will be described more fully below, but it turns out that the * fundamental difference between UTF-8 and UTF-EBCDIC is that the former has @@ -186,18 +186,18 @@ the string is invariant. * * It is helpful to know the EBCDIC value on ASCII platforms, mainly to avoid * some #ifdef's */ -#define UTF_EBCDIC_CONTINUATION_BYTE_INFO_BITS 5 +#define UTF_EBCDIC_CONTINUATION_BYTE_INFO_BITS 5 /* See explanation below at 'UTF8_MAXBYTES' */ -#define ASCII_PLATFORM_UTF8_MAXBYTES 13 +#define ASCII_PLATFORM_UTF8_MAXBYTES 13 #ifdef EBCDIC -/* The equivalent of the next few macros but implementing UTF-EBCDIC are in the - * following header file: */ +/* The equivalent of the next few macros but implementing + * UTF-EBCDIC are in the following header file: */ # include "utfebcdic.h" -# else /* ! EBCDIC */ +# else /* ! EBCDIC */ START_EXTERN_C @@ -217,11 +217,11 @@ EXTCONST unsigned char PL_utf8skip[] = { /* 0x90 */ 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, /* bogus: continuation byte */ /* 0xA0 */ 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, /* bogus: continuation byte */ /* 0xB0 */ 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, /* bogus: continuation byte */ -/* 0xC0 */ 2,2, /* overlong */ +/* 0xC0 */ 2,2, /* overlong */ /* 0xC2 */ 2,2,2,2,2,2,2,2,2,2,2,2,2,2, /* U+0080 to U+03FF */ /* 0xD0 */ 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, /* U+0400 to U+07FF */ /* 0xE0 */ 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, /* U+0800 to U+FFFF */ -/* 0xF0 */ 4,4,4,4,4,4,4,4,5,5,5,5,6,6, /* above BMP to 2**31 - 1 */ +/* 0xF0 */ 4,4,4,4,4,4,4,4,5,5,5,5,6,6, /* above BMP to 2**31 - 1 */ /* Perl extended (never was official UTF-8). Up to 36 bit */ /* 0xFE */ 7, /* More extended, Up to 72 bits (64-bit + reserved) */ @@ -235,49 +235,49 @@ END_EXTERN_C =for apidoc Am|U8|NATIVE_TO_LATIN1|U8 ch -Returns the Latin-1 (including ASCII and control characters) equivalent of the -input native code point given by C. Thus, C on -EBCDIC platforms returns 65. These each represent the character C<"A"> on -their respective platforms. On ASCII platforms no conversion is needed, so -this macro expands to just its input, adding no time nor space requirements to -the implementation. +Returns the Latin-1 (including ASCII and control characters) equivalent of +the input native code point given by C. Thus, +C on EBCDIC platforms returns 65. These each +represent the character C<"A"> on their respective platforms. On ASCII +platforms no conversion is needed, so this macro expands to just its +input, adding no time nor space requirements to the implementation. -For conversion of code points potentially larger than will fit in a character, -use L. +For conversion of code points potentially larger than will fit in a +character, use L. =for apidoc Am|U8|LATIN1_TO_NATIVE|U8 ch -Returns the native equivalent of the input Latin-1 code point (including ASCII -and control characters) given by C. Thus, C on -EBCDIC platforms returns 194. These each represent the character C<"B"> on -their respective platforms. On ASCII platforms no conversion is needed, so -this macro expands to just its input, adding no time nor space requirements to -the implementation. +Returns the native equivalent of the input Latin-1 code point (including +ASCII and control characters) given by C. Thus, +C on EBCDIC platforms returns 194. These each +represent the character C<"B"> on their respective platforms. On ASCII +platforms no conversion is needed, so this macro expands to just its +input, adding no time nor space requirements to the implementation. -For conversion of code points potentially larger than will fit in a character, -use L. +For conversion of code points potentially larger than will fit in a +character, use L. =for apidoc Am|UV|NATIVE_TO_UNI|UV ch -Returns the Unicode equivalent of the input native code point given by C. -Thus, C on EBCDIC platforms returns 67. These each -represent the character C<"C"> on their respective platforms. On ASCII -platforms no conversion is needed, so this macro expands to just its input, -adding no time nor space requirements to the implementation. +Returns the Unicode equivalent of the input native code point given by +C. Thus, C on EBCDIC platforms returns 67. These +each represent the character C<"C"> on their respective platforms. On +ASCII platforms no conversion is needed, so this macro expands to just its +input, adding no time nor space requirements to the implementation. =for apidoc Am|UV|UNI_TO_NATIVE|UV ch -Returns the native equivalent of the input Unicode code point given by C. -Thus, C on EBCDIC platforms returns 196. These each -represent the character C<"D"> on their respective platforms. On ASCII -platforms no conversion is needed, so this macro expands to just its input, -adding no time nor space requirements to the implementation. +Returns the native equivalent of the input Unicode code point given by +C. Thus, C on EBCDIC platforms returns 196. These +each represent the character C<"D"> on their respective platforms. On +ASCII platforms no conversion is needed, so this macro expands to just its +input, adding no time nor space requirements to the implementation. =cut */ -#define NATIVE_TO_LATIN1(ch) (__ASSERT_(FITS_IN_8_BITS(ch)) ((U8) (ch))) -#define LATIN1_TO_NATIVE(ch) (__ASSERT_(FITS_IN_8_BITS(ch)) ((U8) (ch))) +#define NATIVE_TO_LATIN1(ch) (__ASSERT_(FITS_IN_8_BITS(ch)) ((U8) (ch))) +#define LATIN1_TO_NATIVE(ch) (__ASSERT_(FITS_IN_8_BITS(ch)) ((U8) (ch))) /* I8 is an intermediate version of UTF-8 used only in UTF-EBCDIC. We thus * consider it to be identical to UTF-8 on ASCII platforms. Strictly speaking @@ -285,32 +285,32 @@ adding no time nor space requirements to the implementation. * because they are 8-bit encodings that serve the same purpose in Perl, and * rarely do we need to distinguish them. The term "NATIVE_UTF8" applies to * whichever one is applicable on the current platform */ -#define NATIVE_UTF8_TO_I8(ch) (__ASSERT_(FITS_IN_8_BITS(ch)) ((U8) (ch))) -#define I8_TO_NATIVE_UTF8(ch) (__ASSERT_(FITS_IN_8_BITS(ch)) ((U8) (ch))) +#define NATIVE_UTF8_TO_I8(ch) (__ASSERT_(FITS_IN_8_BITS(ch)) ((U8) (ch))) +#define I8_TO_NATIVE_UTF8(ch) (__ASSERT_(FITS_IN_8_BITS(ch)) ((U8) (ch))) -#define UNI_TO_NATIVE(ch) ((UV) ASSERT_NOT_PTR(ch)) -#define NATIVE_TO_UNI(ch) ((UV) ASSERT_NOT_PTR(ch)) +#define UNI_TO_NATIVE(ch) ((UV) ASSERT_NOT_PTR(ch)) +#define NATIVE_TO_UNI(ch) ((UV) ASSERT_NOT_PTR(ch)) /* The following table is from Unicode 3.2, plus the Perl extensions for above U+10FFFF - Code Points 1st Byte 2nd Byte 3rd 4th 5th 6th 7th 8th-13th + Code Points 1st Byte 2nd Byte 3rd 4th 5th 6th 7th 8th-13th - U+0000..U+007F 00..7F + U+0000..U+007F 00..7F U+0080..U+07FF * C2..DF 80..BF - U+0800..U+0FFF E0 * A0..BF 80..BF + U+0800..U+0FFF E0 * A0..BF 80..BF U+1000..U+CFFF E1..EC 80..BF 80..BF U+D000..U+D7FF ED 80..9F 80..BF U+D800..U+DFFF ED A0..BF 80..BF (surrogates) U+E000..U+FFFF EE..EF 80..BF 80..BF - U+10000..U+3FFFF F0 * 90..BF 80..BF 80..BF - U+40000..U+FFFFF F1..F3 80..BF 80..BF 80..BF - U+100000..U+10FFFF F4 80..8F 80..BF 80..BF + U+10000..U+3FFFF F0 * 90..BF 80..BF 80..BF + U+40000..U+FFFFF F1..F3 80..BF 80..BF 80..BF + U+100000..U+10FFFF F4 80..8F 80..BF 80..BF Below are above-Unicode code points - U+110000..U+13FFFF F4 90..BF 80..BF 80..BF - U+110000..U+1FFFFF F5..F7 80..BF 80..BF 80..BF + U+110000..U+13FFFF F4 90..BF 80..BF 80..BF + U+110000..U+1FFFFF F5..F7 80..BF 80..BF 80..BF U+200000..U+FFFFFF F8 * 88..BF 80..BF 80..BF 80..BF U+1000000..U+3FFFFFF F9..FB 80..BF 80..BF 80..BF 80..BF U+4000000..U+3FFFFFFF FC * 84..BF 80..BF 80..BF 80..BF 80..BF @@ -343,37 +343,37 @@ platforms. FF signals to use 13 bytes for the encoded character. This breaks the paradigm that the number of leading bits gives how many total bytes there are in the character. */ -/* This is the number of low-order bits a continuation byte in a UTF-8 encoded - * sequence contributes to the specification of the code point. In the bit - * maps above, you see that the first 2 bits are a constant '10', leaving 6 of - * real information */ -# define UTF_CONTINUATION_BYTE_INFO_BITS 6 +/* This is the number of low-order bits a continuation byte in a + * UTF-8 encoded sequence contributes to the specification of the + * code point. In the bit maps above, you see that the first 2 + * bits are a constant '10', leaving 6 of real information */ +# define UTF_CONTINUATION_BYTE_INFO_BITS 6 -/* ^? is defined to be DEL on ASCII systems. See the definition of toCTRL() - * for more */ -# define QUESTION_MARK_CTRL DEL_NATIVE +/* ^? is defined to be DEL on ASCII systems. See + * the definition of toCTRL() for more */ +# define QUESTION_MARK_CTRL DEL_NATIVE #endif /* EBCDIC vs ASCII */ -/* It turns out that in a number of cases, that handling ASCII vs EBCDIC is a - * matter of being off-by-one. So this is a convenience macro, used to avoid - * some #ifdefs. */ -#define ONE_IF_EBCDIC_ZERO_IF_NOT \ - (UTF_CONTINUATION_BYTE_INFO_BITS == UTF_EBCDIC_CONTINUATION_BYTE_INFO_BITS) - -/* Since the significant bits in a continuation byte are stored in the - * least-significant positions, we often find ourselves shifting by that - * amount. This is a clearer name in such situations */ -#define UTF_ACCUMULATION_SHIFT UTF_CONTINUATION_BYTE_INFO_BITS - -/* 2**info_bits - 1. This masks out all but the bits that carry real - * information in a continuation byte. This turns out to be 0x3F in UTF-8, - * 0x1F in UTF-EBCDIC. */ -#define UTF_CONTINUATION_MASK \ - ((U8) nBIT_MASK(UTF_CONTINUATION_BYTE_INFO_BITS)) - -/* For use in UTF8_IS_CONTINUATION(). This turns out to be 0xC0 in UTF-8, - * E0 in UTF-EBCDIC */ +/* It turns out that in a number of cases, that handling ASCII + * vs EBCDIC is a matter of being off-by-one. So this is a + * convenience macro, used to avoid some #ifdefs. */ +#define ONE_IF_EBCDIC_ZERO_IF_NOT \ + (UTF_CONTINUATION_BYTE_INFO_BITS == UTF_EBCDIC_CONTINUATION_BYTE_INFO_BITS) + +/* Since the significant bits in a continuation byte are stored in + * the least-significant positions, we often find ourselves shifting + * by that amount. This is a clearer name in such situations */ +#define UTF_ACCUMULATION_SHIFT UTF_CONTINUATION_BYTE_INFO_BITS + +/* 2**info_bits - 1. This masks out all but the bits that + * carry real information in a continuation byte. This + * turns out to be 0x3F in UTF-8, 0x1F in UTF-EBCDIC. */ +#define UTF_CONTINUATION_MASK \ + ((U8) nBIT_MASK(UTF_CONTINUATION_BYTE_INFO_BITS)) + +/* For use in UTF8_IS_CONTINUATION(). This turns + * out to be 0xC0 in UTF-8, E0 in UTF-EBCDIC */ #define UTF_IS_CONTINUATION_MASK ((U8) (0xFF << UTF_ACCUMULATION_SHIFT)) /* This defines the bits that are to be in the continuation bytes of a @@ -384,58 +384,56 @@ are in the character. */ #define UTF_CONTINUATION_MARK (UTF_IS_CONTINUATION_MASK & 0xB0) /* This value is clearer in some contexts */ -#define UTF_MIN_CONTINUATION_BYTE UTF_CONTINUATION_MARK +#define UTF_MIN_CONTINUATION_BYTE UTF_CONTINUATION_MARK -/* Is the byte 'c' part of a multi-byte UTF8-8 encoded sequence, and not the - * first byte thereof? */ -#define UTF8_IS_CONTINUATION(c) (__ASSERT_(FITS_IN_8_BITS(c)) \ - (((NATIVE_UTF8_TO_I8(c) & UTF_IS_CONTINUATION_MASK) \ - == UTF_CONTINUATION_MARK))) +/* Is the byte 'c' part of a multi-byte UTF8-8 encoded + * sequence, and not the first byte thereof? */ +#define UTF8_IS_CONTINUATION(c) \ + (__ASSERT_(FITS_IN_8_BITS(c)) \ + (((NATIVE_UTF8_TO_I8(c) & UTF_IS_CONTINUATION_MASK) \ + == UTF_CONTINUATION_MARK))) -/* Is the representation of the Unicode code point 'cp' the same regardless of - * being encoded in UTF-8 or not? This is a fundamental property of - * UTF-8,EBCDIC */ -#define OFFUNI_IS_INVARIANT(c) \ - (((WIDEST_UTYPE)(c)) < UTF_MIN_CONTINUATION_BYTE) +/* Is the representation of the Unicode code point 'cp' + * the same regardless of being encoded in UTF-8 or not? + * This is a fundamental property of UTF-8,EBCDIC */ +#define OFFUNI_IS_INVARIANT(c) \ + (((WIDEST_UTYPE)(c)) < UTF_MIN_CONTINUATION_BYTE) /* =for apidoc Am|bool|UVCHR_IS_INVARIANT|UV cp -Evaluates to 1 if the representation of code point C is the same whether or -not it is encoded in UTF-8; otherwise evaluates to 0. UTF-8 invariant +Evaluates to 1 if the representation of code point C is the same whether +or not it is encoded in UTF-8; otherwise evaluates to 0. UTF-8 invariant characters can be copied as-is when converting to/from UTF-8, saving time. C is Unicode if above 255; otherwise is platform-native. =cut - */ -#define UVCHR_IS_INVARIANT(cp) (OFFUNI_IS_INVARIANT(NATIVE_TO_UNI(cp))) +*/ +#define UVCHR_IS_INVARIANT(cp) (OFFUNI_IS_INVARIANT(NATIVE_TO_UNI(cp))) /* This defines the 1-bits that are to be in the first byte of a multi-byte - * UTF-8 encoded character that mark it as a start byte and give the number of - * bytes that comprise the character. 'len' is that number. + * UTF-8 encoded character that mark it as a start byte and give the number + * of bytes that comprise the character. 'len' is that number. * - * To illustrate: len = 2 => ((U8) ~ 0b0011_1111) or 1100_0000 - * 7 => ((U8) ~ 0b0000_0001) or 1111_1110 - * > 7 => 0xFF + * To illustrate: len = 2 => ((U8) ~ 0b0011_1111) or 1100_0000 7 => ((U8) ~ + * 0b0000_0001) or 1111_1110 > 7 => 0xFF * * This is not to be used on a single-byte character. As in many places in * perl, U8 must be 8 bits */ -#define UTF_START_MARK(len) ((U8) ~(0xFF >> (len))) +#define UTF_START_MARK(len) ((U8) ~(0xFF >> (len))) /* Masks out the initial one bits in a start byte, leaving the following 0 bit * and the real data bits. 'len' is the number of bytes in the multi-byte * sequence that comprises the character. * - * To illustrate: len = 2 => 0b0011_1111 works on start byte 110xxxxx - * 6 => 0b0000_0011 works on start byte 1111110x - * >= 7 => There are no data bits in the start byte - * Note that on ASCII platforms, this can be passed a len=1 byte; and all the - * real data bits will be returned: - len = 1 => 0b0111_1111 + * To illustrate: len = 2 => 0b0011_1111 works on start byte 110xxxxx 6 => + * 0b0000_0011 works on start byte 1111110x >= 7 => There are no data bits in + * the start byte Note that on ASCII platforms, this can be passed a len=1 + * byte; and all the real data bits will be returned: len = 1 => 0b0111_1111 * This isn't true on EBCDIC platforms, where some len=1 bytes are of the form * 0b101x_xxxx, so this can't be used there on single-byte characters. */ -#define UTF_START_MASK(len) (0xFF >> (len)) +#define UTF_START_MASK(len) (0xFF >> (len)) /* @@ -443,10 +441,10 @@ C is Unicode if above 255; otherwise is platform-native. The maximum width of a single UTF-8 encoded character, in bytes. -NOTE: Strictly speaking Perl's UTF-8 should not be called UTF-8 since UTF-8 -is an encoding of Unicode, and Unicode's upper limit, 0x10FFFF, can be -expressed with 4 bytes. However, Perl thinks of UTF-8 as a way to encode -non-negative integers in a binary format, even those above Unicode. +NOTE: Strictly speaking Perl's UTF-8 should not be called UTF-8 since UTF-8 is +an encoding of Unicode, and Unicode's upper limit, 0x10FFFF, can be expressed +with 4 bytes. However, Perl thinks of UTF-8 as a way to encode non-negative +integers in a binary format, even those above Unicode. =cut @@ -456,93 +454,82 @@ sequence of 7 bytes. And in fact, this is exactly what standard UTF-EBCDIC does. The start byte FF, on the other hand could have several different plausible -meanings: - 1) The meaning in standard UTF-EBCDIC, namely as an FE start byte, with the - bottom bit that should be a fixed '0' to form FE, instead acting as an - info bit, 0 or 1. - 2) That the sequence should have exactly 8 bytes. - 3) That the next byte is to be treated as a sort of extended start byte, - which in combination with this one gives the total length of the sequence. - There are published UTF-8 extensions that do this, some string together - multiple initial FF start bytes to achieve arbitrary precision. - 4) That the sequence has exactly n bytes, where n is what the implementation - chooses. - -Perl has chosen 4). -The goal is to be able to represent 64-bit values in UTF-8 or UTF-EBCDIC. That -rules out items 1) and 2). Item 3) has the deal-breaking disadvantage of -requiring one to read more than one byte to determine the total length of the -sequence. So in Perl, a start byte of FF indicates a UTF-8 string consisting -of the start byte, plus enough continuation bytes to encode a 64 bit value. -This turns out to be 13 total bytes in UTF-8 and 14 in UTF-EBCDIC. This is -because we get zero info bits from the start byte, plus - 12 * 6 bits of info per continuation byte (could encode 72-bit numbers) on - UTF-8 (khw knows not why 11, which would encode 66 bits wasn't - chosen instead); and - 13 * 5 bits of info per byte (could encode 65-bit numbers) on UTF-EBCDIC - -The disadvantages of this method are: - 1) There's potentially a lot of wasted bytes for all but the largest values. - For example, something that could be represented by 7 continuation bytes, - instead requires the full 12 or 13. - 2) There would be problems should larger values, 128-bit say, ever need to be - represented. +meanings: 1) The meaning in standard UTF-EBCDIC, namely as an FE start byte, +with the bottom bit that should be a fixed '0' to form FE, instead acting as an +info bit, 0 or 1. 2) That the sequence should have exactly 8 bytes. 3) That +the next byte is to be treated as a sort of extended start byte, which in +combination with this one gives the total length of the sequence. There are +published UTF-8 extensions that do this, some string together multiple initial +FF start bytes to achieve arbitrary precision. 4) That the sequence has +exactly n bytes, where n is what the implementation chooses. + +Perl has chosen 4). The goal is to be able to represent 64-bit values in UTF-8 +or UTF-EBCDIC. That rules out items 1) and 2). Item 3) has the deal-breaking +disadvantage of requiring one to read more than one byte to determine the total +length of the sequence. So in Perl, a start byte of FF indicates a UTF-8 +string consisting of the start byte, plus enough continuation bytes to encode a +64 bit value. This turns out to be 13 total bytes in UTF-8 and 14 in +UTF-EBCDIC. This is because we get zero info bits from the start byte, plus 12 +* 6 bits of info per continuation byte (could encode 72-bit numbers) on UTF-8 +(khw knows not why 11, which would encode 66 bits wasn't chosen instead); and +13 * 5 bits of info per byte (could encode 65-bit numbers) on UTF-EBCDIC + +The disadvantages of this method are: 1) There's potentially a lot of wasted +bytes for all but the largest values. For example, something that could be +represented by 7 continuation bytes, instead requires the full 12 or 13. 2) +There would be problems should larger values, 128-bit say, ever need to be +represented. WARNING: This number must be in sync with the value in regen/charset_translations.pl. */ -#define UTF8_MAXBYTES \ - (ASCII_PLATFORM_UTF8_MAXBYTES + ONE_IF_EBCDIC_ZERO_IF_NOT) +#define UTF8_MAXBYTES \ + (ASCII_PLATFORM_UTF8_MAXBYTES + ONE_IF_EBCDIC_ZERO_IF_NOT) /* Calculate how many bytes are necessary to represent a value whose most - * significant 1 bit is in bit position 'pos' of the word. For 0x1, 'pos would - * be 0; and for 0x400, 'pos' would be 10, and the result would be: - * EBCDIC floor((-1 + (10 + 5 - 1 - 1)) / (5 - 1)) - * = floor((-1 + (13)) / 4) - * = floor(12 / 4) - * = 3 - * ASCII floor(( 0 + (10 + 6 - 1 - 1)) / (6 - 1)) - * = floor(14 / 5) - * = 2 - * The reason this works is because the number of bits needed to represent a - * value is proportional to (UTF_CONTINUATION_BYTE_INFO_BITS - 1). The -1 is - * because each new continuation byte removes one bit of information from the - * start byte. + * significant 1 bit is in bit position 'pos' of the word. For 0x1, 'pos + * would be 0; and for 0x400, 'pos' would be 10, and the result would be: + * EBCDIC floor((-1 + (10 + 5 - 1 - 1)) / (5 - 1)) = floor((-1 + (13)) / + * 4) = floor(12 / 4) = 3 ASCII floor(( 0 + (10 + 6 - 1 - 1)) / (6 - 1)) + * = floor(14 / 5) = 2 The reason this works is because the number of + * bits needed to represent a value is proportional to + * (UTF_CONTINUATION_BYTE_INFO_BITS - 1). The -1 is because each new + * continuation byte removes one bit of information from the start byte. * * This is a step function (we need to allocate a full extra byte if we * overflow by just a single bit) * - * The caller is responsible for making sure 'pos' is at least 8 (occupies 9 - * bits), as it breaks down at the lower edge. At the high end, if it returns - * 8 or more, Perl instead anomalously uses MAX_BYTES, so this would be wrong. - * */ -#define UNISKIP_BY_MSB_(pos) \ - ( ( -ONE_IF_EBCDIC_ZERO_IF_NOT /* platform break pos's are off-by-one */ \ - + (pos) + ((UTF_CONTINUATION_BYTE_INFO_BITS - 1) - 1)) /* Step fcn */ \ - / (UTF_CONTINUATION_BYTE_INFO_BITS - 1)) /* take floor of */ - -/* Compute the number of UTF-8 bytes required for representing the input uv, - * which must be a Unicode, not native value. + * The caller is responsible for making sure 'pos' is at least 8 + * (occupies 9 bits), as it breaks down at the lower edge. At the high + * end, if it returns 8 or more, Perl instead anomalously uses MAX_BYTES, + * so this would be wrong. */ +#define UNISKIP_BY_MSB_(pos) \ + ( ( -ONE_IF_EBCDIC_ZERO_IF_NOT /* platform break pos's are off-by-one */ \ + + (pos) + ((UTF_CONTINUATION_BYTE_INFO_BITS - 1) - 1)) /* Step fcn */ \ + / (UTF_CONTINUATION_BYTE_INFO_BITS - 1)) /* take floor of */ + +/* Compute the number of UTF-8 bytes required for representing the + * input uv, which must be a Unicode, not native value. * - * This uses msbit_pos() which doesn't work on NUL, and UNISKIP_BY_MSB_ breaks - * down for small code points. So first check if the input is invariant to get - * around that, and use a helper for high code points to accommodate the fact - * that above 7 btyes, the value is anomalous. The helper is empty on - * platforms that don't go that high */ -#define OFFUNISKIP(uv) \ - ((OFFUNI_IS_INVARIANT(uv)) \ - ? 1 \ + * This uses msbit_pos() which doesn't work on NUL, and UNISKIP_BY_MSB_ + * breaks down for small code points. So first check if the input is + * invariant to get around that, and use a helper for high code points + * to accommodate the fact that above 7 btyes, the value is anomalous. + * The helper is empty on platforms that don't go that high */ +#define OFFUNISKIP(uv) \ + ((OFFUNI_IS_INVARIANT(uv)) \ + ? 1 \ : (OFFUNISKIP_helper_(uv) UNISKIP_BY_MSB_(msbit_pos(uv)))) -/* We need to go to MAX_BYTES when we can't represent 'uv' by the number of - * information bits in 6 continuation bytes (when we get to 6, the start byte - * has no information bits to add to the total). But on 32-bit ASCII - * platforms, that doesn't happen until 6*6 bits, so on those platforms, this - * will always be false */ +/* We need to go to MAX_BYTES when we can't represent 'uv' by the + * number of information bits in 6 continuation bytes (when we get + * to 6, the start byte has no information bits to add to the + * total). But on 32-bit ASCII platforms, that doesn't happen until + * 6*6 bits, so on those platforms, this will always be false */ #if UVSIZE * CHARBITS > (6 * UTF_CONTINUATION_BYTE_INFO_BITS) # define HAS_EXTRA_LONG_UTF8 -# define OFFUNISKIP_helper_(uv) \ - UNLIKELY(uv > nBIT_UMAX(6 * UTF_CONTINUATION_BYTE_INFO_BITS)) \ - ? UTF8_MAXBYTES : +# define OFFUNISKIP_helper_(uv) \ + UNLIKELY(uv > nBIT_UMAX(6 * UTF_CONTINUATION_BYTE_INFO_BITS)) \ + ? UTF8_MAXBYTES : #else # define OFFUNISKIP_helper_(uv) #endif @@ -550,117 +537,118 @@ regen/charset_translations.pl. */ /* =for apidoc Am|STRLEN|UVCHR_SKIP|UV cp -returns the number of bytes required to represent the code point C when -encoded as UTF-8. C is a native (ASCII or EBCDIC) code point if less than -255; a Unicode code point otherwise. +returns the number of bytes required to represent the code point +C when encoded as UTF-8. C is a native (ASCII or EBCDIC) +code point if less than 255; a Unicode code point otherwise. =cut - */ -#define UVCHR_SKIP(uv) OFFUNISKIP(NATIVE_TO_UNI(uv)) +*/ +#define UVCHR_SKIP(uv) OFFUNISKIP(NATIVE_TO_UNI(uv)) -#define NATIVE_SKIP(uv) UVCHR_SKIP(uv) /* Old terminology */ +#define NATIVE_SKIP(uv) UVCHR_SKIP(uv) /* Old terminology + */ -/* Most code which says UNISKIP is really thinking in terms of native code - * points (0-255) plus all those beyond. This is an imprecise term, but having - * it means existing code continues to work. For precision, use UVCHR_SKIP, - * NATIVE_SKIP, or OFFUNISKIP */ -#define UNISKIP(uv) UVCHR_SKIP(uv) +/* Most code which says UNISKIP is really thinking in terms of native + * code points (0-255) plus all those beyond. This is an imprecise + * term, but having it means existing code continues to work. For + * precision, use UVCHR_SKIP, NATIVE_SKIP, or OFFUNISKIP */ +#define UNISKIP(uv) UVCHR_SKIP(uv) /* Compute the start byte for a given code point. This requires the log2 of - * the code point, which is hard to compute at compile time, which this macro - * wants to be. (Perhaps deBruijn sequences could be used.) So a parameter - * for the number of bits the value occupies is passed in, which the programmer - * has had to figure out to get compile-time effect. And asserts are used to - * make sure the value is correct. + * the code point, which is hard to compute at compile time, which this + * macro wants to be. (Perhaps deBruijn sequences could be used.) So a + * parameter for the number of bits the value occupies is passed in, which + * the programmer has had to figure out to get compile-time effect. And + * asserts are used to make sure the value is correct. * * Since we are interested only in the start byte, we ignore the lower bits * accounted for by the continuation bytes. Each continuation byte eats up * UTF_CONTINUATION_BYTE_INFO_BITS bits, so the number of continuation bytes - * needed is floor(bits / UTF_CONTINUATION_BYTE_INFO_BITS). That number is fed - * to UTF_START_MARK() to get the upper part of the start byte. The left over - * bits form the lower part which is OR'd with the mark + * needed is floor(bits / UTF_CONTINUATION_BYTE_INFO_BITS). That number is + * fed to UTF_START_MARK() to get the upper part of the start byte. The + * left over bits form the lower part which is OR'd with the mark * * Note that on EBCDIC platforms, this is actually the I8 */ -#define UTF_START_BYTE(uv, bits) \ - (__ASSERT_((uv) >> ((bits) - 1)) /* At least 'bits' */ \ - __ASSERT_(((uv) & ~nBIT_MASK(bits)) == 0) /* No extra bits */ \ - UTF_START_MARK(UNISKIP_BY_MSB_((bits) - 1)) \ - | ((uv) >> (((bits) / UTF_CONTINUATION_BYTE_INFO_BITS) \ - * UTF_CONTINUATION_BYTE_INFO_BITS))) +#define UTF_START_BYTE(uv, bits) \ + (__ASSERT_((uv) >> ((bits) - 1)) /* At least 'bits' */ \ + __ASSERT_(((uv) & ~nBIT_MASK(bits)) == 0) /* No extra bits */ \ + UTF_START_MARK(UNISKIP_BY_MSB_((bits) - 1)) \ + | ((uv) >> (((bits) / UTF_CONTINUATION_BYTE_INFO_BITS) \ + * UTF_CONTINUATION_BYTE_INFO_BITS))) /* Compute the first continuation byte for a given code point. This is mostly * for compile-time, so how many bits it occupies is also passed in). * * We are interested in the first continuation byte, so we ignore the lower * bits accounted for by the rest of the continuation bytes by right shifting - * out their info bit, and mask out the higher bits that will go into the start - * byte. + * out their info bit, and mask out the higher bits that will go into the + * start byte. * * Note that on EBCDIC platforms, this is actually the I8 */ -#define UTF_FIRST_CONT_BYTE(uv, bits) \ - (__ASSERT_((uv) >> ((bits) - 1)) /* At least 'bits' */ \ - __ASSERT_(((uv) & ~nBIT_MASK(bits)) == 0) /* No extra bits */ \ - UTF_CONTINUATION_MARK \ - | ( UTF_CONTINUATION_MASK \ - & ((uv) >> ((((bits) / UTF_CONTINUATION_BYTE_INFO_BITS) - 1) \ - * UTF_CONTINUATION_BYTE_INFO_BITS)))) - -#define UTF_MIN_START_BYTE UTF_START_BYTE(UTF_MIN_CONTINUATION_BYTE, 8) - -/* Is the byte 'c' the first byte of a multi-byte UTF8-8 encoded sequence? - * This excludes invariants (they are single-byte). It also excludes the - * illegal overlong sequences that begin with C0 and C1 on ASCII platforms, and - * C0-C4 I8 start bytes on EBCDIC ones. On EBCDIC E0 can't start a - * non-overlong sequence, so we define a base macro and for those platforms, - * extend it to also exclude E0 */ -#define UTF8_IS_START_base(c) (__ASSERT_(FITS_IN_8_BITS(c)) \ +#define UTF_FIRST_CONT_BYTE(uv, bits) \ + (__ASSERT_((uv) >> ((bits) - 1)) /* At least 'bits' */ \ + __ASSERT_(((uv) & ~nBIT_MASK(bits)) == 0) /* No extra bits */ \ + UTF_CONTINUATION_MARK \ + | ( UTF_CONTINUATION_MASK \ + & ((uv) >> ((((bits) / UTF_CONTINUATION_BYTE_INFO_BITS) - 1) \ + * UTF_CONTINUATION_BYTE_INFO_BITS)))) + +#define UTF_MIN_START_BYTE UTF_START_BYTE(UTF_MIN_CONTINUATION_BYTE, 8) + +/* Is the byte 'c' the first byte of a multi-byte UTF8-8 encoded + * sequence? This excludes invariants (they are single-byte). It also + * excludes the illegal overlong sequences that begin with C0 and C1 on + * ASCII platforms, and C0-C4 I8 start bytes on EBCDIC ones. On EBCDIC + * E0 can't start a non-overlong sequence, so we define a base macro + * and for those platforms, extend it to also exclude E0 */ +#define UTF8_IS_START_base(c) \ + (__ASSERT_(FITS_IN_8_BITS(c)) \ (NATIVE_UTF8_TO_I8(c) >= UTF_MIN_START_BYTE)) #ifdef EBCDIC -# define UTF8_IS_START(c) \ - (UTF8_IS_START_base(c) && (c) != I8_TO_NATIVE_UTF8(0xE0)) +# define UTF8_IS_START(c) \ + (UTF8_IS_START_base(c) && (c) != I8_TO_NATIVE_UTF8(0xE0)) #else -# define UTF8_IS_START(c) UTF8_IS_START_base(c) +# define UTF8_IS_START(c) UTF8_IS_START_base(c) #endif -#define UTF_MIN_ABOVE_LATIN1_BYTE UTF_START_BYTE(0x100, 9) +#define UTF_MIN_ABOVE_LATIN1_BYTE UTF_START_BYTE(0x100, 9) -/* Is the UTF8-encoded byte 'c' the first byte of a sequence of bytes that - * represent a code point > 255? */ -#define UTF8_IS_ABOVE_LATIN1(c) (__ASSERT_(FITS_IN_8_BITS(c)) \ +/* Is the UTF8-encoded byte 'c' the first byte of a sequence + * of bytes that represent a code point > 255? */ +#define UTF8_IS_ABOVE_LATIN1(c) \ + (__ASSERT_(FITS_IN_8_BITS(c)) \ (NATIVE_UTF8_TO_I8(c) >= UTF_MIN_ABOVE_LATIN1_BYTE)) -/* Is the UTF8-encoded byte 'c' the first byte of a two byte sequence? Use - * UTF8_IS_NEXT_CHAR_DOWNGRADEABLE() instead if the input isn't known to - * be well-formed. */ -#define UTF8_IS_DOWNGRADEABLE_START(c) (__ASSERT_(FITS_IN_8_BITS(c)) \ - inRANGE_helper_(U8, NATIVE_UTF8_TO_I8(c), \ +/* Is the UTF8-encoded byte 'c' the first byte of a two byte + * sequence? Use UTF8_IS_NEXT_CHAR_DOWNGRADEABLE() instead + * if the input isn't known to be well-formed. */ +#define UTF8_IS_DOWNGRADEABLE_START(c) \ + (__ASSERT_(FITS_IN_8_BITS(c)) \ + inRANGE_helper_(U8, NATIVE_UTF8_TO_I8(c), \ UTF_MIN_START_BYTE, UTF_MIN_ABOVE_LATIN1_BYTE - 1)) /* The largest code point representable by two UTF-8 bytes on this platform. - * The binary for that code point is: - * 1101_1111 10xx_xxxx in UTF-8, and - * 1101_1111 101y_yyyy in UTF-EBCDIC I8. - * where both x and y are 1, and shown this way to indicate there is one more x - * than there is y. The number of x and y bits are their platform's respective - * UTF_CONTINUATION_BYTE_INFO_BITS. Squeezing out the bits that don't - * contribute to the value, these evaluate to: - * 1_1111 xx_xxxx in UTF-8, and - * 1_1111 y_yyyy in UTF-EBCDIC I8. - * or, the maximum value of an unsigned with (5 + info_bit_count) bits */ -#define MAX_UTF8_TWO_BYTE nBIT_UMAX(5 + UTF_CONTINUATION_BYTE_INFO_BITS) - -/* The largest code point representable by two UTF-8 bytes on any platform that - * Perl runs on. */ -#define MAX_PORTABLE_UTF8_TWO_BYTE \ - nBIT_UMAX(5 + MIN( UTF_CONTINUATION_BYTE_INFO_BITS, \ - UTF_EBCDIC_CONTINUATION_BYTE_INFO_BITS)) + * The binary for that code point is: 1101_1111 10xx_xxxx in UTF-8, and + * 1101_1111 101y_yyyy in UTF-EBCDIC I8. where both x and y are 1, and shown + * this way to indicate there is one more x than there is y. The number of x + * and y bits are their platform's respective UTF_CONTINUATION_BYTE_INFO_BITS. + * Squeezing out the bits that don't contribute to the value, these evaluate + * to: 1_1111 xx_xxxx in UTF-8, and 1_1111 y_yyyy in UTF-EBCDIC I8. or, the + * maximum value of an unsigned with (5 + info_bit_count) bits */ +#define MAX_UTF8_TWO_BYTE nBIT_UMAX(5 + UTF_CONTINUATION_BYTE_INFO_BITS) + +/* The largest code point representable by two UTF-8 + * bytes on any platform that Perl runs on. */ +#define MAX_PORTABLE_UTF8_TWO_BYTE \ + nBIT_UMAX(5 + MIN( UTF_CONTINUATION_BYTE_INFO_BITS, \ + UTF_EBCDIC_CONTINUATION_BYTE_INFO_BITS)) /* =for apidoc AmnU|STRLEN|UTF8_MAXBYTES_CASE -The maximum number of UTF-8 bytes a single Unicode character can -uppercase/lowercase/titlecase/fold into. +The maximum number of UTF-8 bytes a single Unicode character +can uppercase/lowercase/titlecase/fold into. =cut @@ -673,82 +661,82 @@ uppercase/lowercase/titlecase/fold into. * =cut */ -#define UTF8_MAXBYTES_CASE \ - MAX(UTF8_MAXBYTES, UTF8_MAX_FOLD_CHAR_EXPAND * UNISKIP_BY_MSB_(20)) +#define UTF8_MAXBYTES_CASE \ + MAX(UTF8_MAXBYTES, UTF8_MAX_FOLD_CHAR_EXPAND * UNISKIP_BY_MSB_(20)) -/* Rest of these are attributes of Unicode and perl's internals rather than the - * encoding, or happen to be the same in both ASCII and EBCDIC (at least at - * this level; the macros that some of these call may have different - * definitions in the two encodings */ +/* Rest of these are attributes of Unicode and perl's internals + * rather than the encoding, or happen to be the same in both ASCII + * and EBCDIC (at least at this level; the macros that some of these + * call may have different definitions in the two encodings */ -/* In domain restricted to ASCII, these may make more sense to the reader than - * the ones with Latin1 in the name */ -#define NATIVE_TO_ASCII(ch) NATIVE_TO_LATIN1(ch) -#define ASCII_TO_NATIVE(ch) LATIN1_TO_NATIVE(ch) +/* In domain restricted to ASCII, these may make more sense + * to the reader than the ones with Latin1 in the name */ +#define NATIVE_TO_ASCII(ch) NATIVE_TO_LATIN1(ch) +#define ASCII_TO_NATIVE(ch) LATIN1_TO_NATIVE(ch) /* More or less misleadingly-named defines, retained for back compat */ -#define NATIVE_TO_UTF(ch) NATIVE_UTF8_TO_I8(ch) -#define NATIVE_TO_I8(ch) NATIVE_UTF8_TO_I8(ch) -#define UTF_TO_NATIVE(ch) I8_TO_NATIVE_UTF8(ch) -#define I8_TO_NATIVE(ch) I8_TO_NATIVE_UTF8(ch) -#define NATIVE8_TO_UNI(ch) NATIVE_TO_LATIN1(ch) +#define NATIVE_TO_UTF(ch) NATIVE_UTF8_TO_I8(ch) +#define NATIVE_TO_I8(ch) NATIVE_UTF8_TO_I8(ch) +#define UTF_TO_NATIVE(ch) I8_TO_NATIVE_UTF8(ch) +#define I8_TO_NATIVE(ch) I8_TO_NATIVE_UTF8(ch) +#define NATIVE8_TO_UNI(ch) NATIVE_TO_LATIN1(ch) /* Adds a UTF8 continuation byte 'new' of information to a running total code * point 'old' of all the continuation bytes so far. This is designed to be * used in a loop to convert from UTF-8 to the code point represented. Note - * that this is asymmetric on EBCDIC platforms, in that the 'new' parameter is - * the UTF-EBCDIC byte, whereas the 'old' parameter is a Unicode (not EBCDIC) - * code point in process of being generated */ -#define UTF8_ACCUMULATE(old, new) (__ASSERT_(FITS_IN_8_BITS(new)) \ - ((old) << UTF_ACCUMULATION_SHIFT) \ - | ((NATIVE_UTF8_TO_I8(new)) \ - & UTF_CONTINUATION_MASK)) + * that this is asymmetric on EBCDIC platforms, in that the 'new' parameter + * is the UTF-EBCDIC byte, whereas the 'old' parameter is a Unicode (not + * EBCDIC) code point in process of being generated */ +#define UTF8_ACCUMULATE(old, new) \ + (__ASSERT_(FITS_IN_8_BITS(new)) \ + ((old) << UTF_ACCUMULATION_SHIFT) \ + | ((NATIVE_UTF8_TO_I8(new)) \ + & UTF_CONTINUATION_MASK)) /* This works in the face of malformed UTF-8. */ -#define UTF8_IS_NEXT_CHAR_DOWNGRADEABLE(s, e) \ - ( ( (e) - (s) > 1) \ - && UTF8_IS_DOWNGRADEABLE_START(*(s)) \ - && UTF8_IS_CONTINUATION(*((s)+1))) +#define UTF8_IS_NEXT_CHAR_DOWNGRADEABLE(s, e) \ + ( ( (e) - (s) > 1) \ + && UTF8_IS_DOWNGRADEABLE_START(*(s)) \ + && UTF8_IS_CONTINUATION(*((s)+1))) /* Longer, but more accurate name */ -#define UTF8_IS_ABOVE_LATIN1_START(c) UTF8_IS_ABOVE_LATIN1(c) - -/* Convert a UTF-8 variant Latin1 character to a native code point value. - * Needs just one iteration of accumulate. Should be used only if it is known - * that the code point is < 256, and is not UTF-8 invariant. Use the slower - * but more general TWO_BYTE_UTF8_TO_NATIVE() which handles any code point - * representable by two bytes (which turns out to be up through - * MAX_PORTABLE_UTF8_TWO_BYTE). The two parameters are: - * HI: a downgradable start byte; - * LO: continuation. - * */ -#define EIGHT_BIT_UTF8_TO_NATIVE(HI, LO) \ - ( __ASSERT_(UTF8_IS_DOWNGRADEABLE_START(HI)) \ - __ASSERT_(UTF8_IS_CONTINUATION(LO)) \ - LATIN1_TO_NATIVE(UTF8_ACCUMULATE(( \ +#define UTF8_IS_ABOVE_LATIN1_START(c) UTF8_IS_ABOVE_LATIN1(c) + +/* Convert a UTF-8 variant Latin1 character to a native code point + * value. Needs just one iteration of accumulate. Should be used only + * if it is known that the code point is < 256, and is not UTF-8 + * invariant. Use the slower but more general TWO_BYTE_UTF8_TO_NATIVE() + * which handles any code point representable by two bytes (which turns + * out to be up through MAX_PORTABLE_UTF8_TWO_BYTE). The two parameters + * are: HI: a downgradable start byte; LO: continuation. */ +#define EIGHT_BIT_UTF8_TO_NATIVE(HI, LO) \ + ( __ASSERT_(UTF8_IS_DOWNGRADEABLE_START(HI)) \ + __ASSERT_(UTF8_IS_CONTINUATION(LO)) \ + LATIN1_TO_NATIVE(UTF8_ACCUMULATE(( \ NATIVE_UTF8_TO_I8(HI) & UTF_START_MASK(2)), (LO)))) -/* Convert a two (not one) byte utf8 character to a native code point value. - * Needs just one iteration of accumulate. Should not be used unless it is - * known that the two bytes are legal: 1) two-byte start, and 2) continuation. - * Note that the result can be larger than 255 if the input character is not - * downgradable */ -#define TWO_BYTE_UTF8_TO_NATIVE(HI, LO) \ +/* Convert a two (not one) byte utf8 character to a native code point + * value. Needs just one iteration of accumulate. Should not be + * used unless it is known that the two bytes are legal: 1) two-byte + * start, and 2) continuation. Note that the result can be larger + * than 255 if the input character is not downgradable */ +#define TWO_BYTE_UTF8_TO_NATIVE(HI, LO) \ (__ASSERT_(FITS_IN_8_BITS(HI)) \ __ASSERT_(FITS_IN_8_BITS(LO)) \ - __ASSERT_(PL_utf8skip[(U8) HI] == 2) \ + __ASSERT_(PL_utf8skip[(U8) HI] == 2) \ __ASSERT_(UTF8_IS_CONTINUATION(LO)) \ UNI_TO_NATIVE(UTF8_ACCUMULATE((NATIVE_UTF8_TO_I8(HI) & UTF_START_MASK(2)), \ (LO)))) /* Should never be used, and be deprecated */ -#define TWO_BYTE_UTF8_TO_UNI(HI, LO) NATIVE_TO_UNI(TWO_BYTE_UTF8_TO_NATIVE(HI, LO)) +#define TWO_BYTE_UTF8_TO_UNI(HI, LO) \ + NATIVE_TO_UNI(TWO_BYTE_UTF8_TO_NATIVE(HI, LO)) /* =for apidoc Am|STRLEN|UTF8SKIP|char* s -returns the number of bytes a non-malformed UTF-8 encoded character whose first -(perhaps only) byte is pointed to by C. +returns the number of bytes a non-malformed UTF-8 encoded character +whose first (perhaps only) byte is pointed to by C. If there is a possibility of malformed input, use instead: @@ -761,14 +749,14 @@ buffer pointed to by C; or =back -It is better to restructure your code so the end pointer is passed down so that -you know what it actually is at the point of this call, but if that isn't -possible, C> can minimize the chance of accessing beyond the end -of the input buffer. +It is better to restructure your code so the end pointer is passed +down so that you know what it actually is at the point of this +call, but if that isn't possible, C> can minimize +the chance of accessing beyond the end of the input buffer. =cut - */ -#define UTF8SKIP(s) PL_utf8skip[*(const U8*)(ASSERT_IS_PTR(s))] +*/ +#define UTF8SKIP(s) PL_utf8skip[*(const U8*)(ASSERT_IS_PTR(s))] /* =for apidoc Am|STRLEN|UTF8_SKIP|char* s @@ -777,7 +765,7 @@ This is a synonym for C> =cut */ -#define UTF8_SKIP(s) UTF8SKIP(s) +#define UTF8_SKIP(s) UTF8SKIP(s) /* =for apidoc Am|STRLEN|UTF8_CHK_SKIP|char* s @@ -799,36 +787,37 @@ C>, for example when interfacing with a C library. =cut */ -#define UTF8_CHK_SKIP(s) \ - (UNLIKELY(s[0] == '\0') ? 1 : MIN(UTF8SKIP(s), \ - my_strnlen((char *) (s), UTF8SKIP(s)))) +#define UTF8_CHK_SKIP(s) \ + (UNLIKELY(s[0] == '\0') ? 1 : MIN(UTF8SKIP(s), \ + my_strnlen((char *) (s), UTF8SKIP(s)))) /* =for apidoc Am|STRLEN|UTF8_SAFE_SKIP|char* s|char* e returns 0 if S= e>>; otherwise returns the number of bytes in the -UTF-8 encoded character whose first byte is pointed to by C. But it never +UTF-8 encoded character whose first byte is pointed to by C. But it never returns beyond C. On DEBUGGING builds, it asserts that S= e>>. =cut - */ -#define UTF8_SAFE_SKIP(s, e) (__ASSERT_((e) >= (s)) \ - UNLIKELY(((e) - (s)) <= 0) \ - ? 0 \ - : MIN(((e) - (s)), UTF8_SKIP(s))) +*/ +#define UTF8_SAFE_SKIP(s, e) \ + (__ASSERT_((e) >= (s)) \ + UNLIKELY(((e) - (s)) <= 0) \ + ? 0 \ + : MIN(((e) - (s)), UTF8_SKIP(s))) -/* Most code that says 'UNI_' really means the native value for code points up - * through 255 */ -#define UNI_IS_INVARIANT(cp) UVCHR_IS_INVARIANT(cp) +/* Most code that says 'UNI_' really means the native + * value for code points up through 255 */ +#define UNI_IS_INVARIANT(cp) UVCHR_IS_INVARIANT(cp) /* =for apidoc Am|bool|UTF8_IS_INVARIANT|char c -Evaluates to 1 if the byte C represents the same character when encoded in -UTF-8 as when not; otherwise evaluates to 0. UTF-8 invariant characters can be -copied as-is when converting to/from UTF-8, saving time. +Evaluates to 1 if the byte C represents the same character when encoded +in UTF-8 as when not; otherwise evaluates to 0. UTF-8 invariant characters +can be copied as-is when converting to/from UTF-8, saving time. -In spite of the name, this macro gives the correct result if the input string -from which C comes is not encoded in UTF-8. +In spite of the name, this macro gives the correct result if the input +string from which C comes is not encoded in UTF-8. See C> for checking if a UV is invariant. @@ -836,92 +825,95 @@ See C> for checking if a UV is invariant. The reason it works on both UTF-8 encoded strings and non-UTF-8 encoded, is that it returns TRUE in each for the exact same set of bit patterns. It is -valid on a subset of what UVCHR_IS_INVARIANT is valid on, so can just use that; -and the compiler should optimize out anything extraneous given the +valid on a subset of what UVCHR_IS_INVARIANT is valid on, so can just use +that; and the compiler should optimize out anything extraneous given the implementation of the latter. */ -#define UTF8_IS_INVARIANT(c) UVCHR_IS_INVARIANT(ASSERT_NOT_PTR(c)) +#define UTF8_IS_INVARIANT(c) UVCHR_IS_INVARIANT(ASSERT_NOT_PTR(c)) -/* Like the above, but its name implies a non-UTF8 input, which as the comments - * above show, doesn't matter as to its implementation */ -#define NATIVE_BYTE_IS_INVARIANT(c) UVCHR_IS_INVARIANT(c) +/* Like the above, but its name implies a non-UTF8 input, which as the + * comments above show, doesn't matter as to its implementation */ +#define NATIVE_BYTE_IS_INVARIANT(c) UVCHR_IS_INVARIANT(c) -/* Misleadingly named: is the UTF8-encoded byte 'c' part of a variant sequence - * in UTF-8? This is the inverse of UTF8_IS_INVARIANT. */ -#define UTF8_IS_CONTINUED(c) (__ASSERT_(FITS_IN_8_BITS(c)) \ - (! UTF8_IS_INVARIANT(c))) +/* Misleadingly named: is the UTF8-encoded byte 'c' part of a variant + * sequence in UTF-8? This is the inverse of UTF8_IS_INVARIANT. */ +#define UTF8_IS_CONTINUED(c) \ + (__ASSERT_(FITS_IN_8_BITS(c)) \ + (! UTF8_IS_INVARIANT(c))) /* The macros in the next 4 sets are used to generate the two utf8 or utfebcdic * bytes from an ordinal that is known to fit into exactly two (not one) bytes; * it must be less than 0x3FF to work across both encodings. */ -/* These two are helper macros for the other three sets, and should not be used - * directly anywhere else. 'translate_function' is either NATIVE_TO_LATIN1 - * (which works for code points up through 0xFF) or NATIVE_TO_UNI which works - * for any code point */ -#define __BASE_TWO_BYTE_HI(c, translate_function) \ - (__ASSERT_(! UVCHR_IS_INVARIANT(c)) \ - I8_TO_NATIVE_UTF8((translate_function(c) >> UTF_ACCUMULATION_SHIFT) \ - | UTF_START_MARK(2))) -#define __BASE_TWO_BYTE_LO(c, translate_function) \ - (__ASSERT_(! UVCHR_IS_INVARIANT(c)) \ - I8_TO_NATIVE_UTF8((translate_function(c) & UTF_CONTINUATION_MASK) \ - | UTF_CONTINUATION_MARK)) - -/* The next two macros should not be used. They were designed to be usable as - * the case label of a switch statement, but this doesn't work for EBCDIC. Use - * regen/unicode_constants.pl instead */ +/* These two are helper macros for the other three sets, and should + * not be used directly anywhere else. 'translate_function' is + * either NATIVE_TO_LATIN1 (which works for code points up through + * 0xFF) or NATIVE_TO_UNI which works for any code point */ +#define __BASE_TWO_BYTE_HI(c, translate_function) \ + (__ASSERT_(! UVCHR_IS_INVARIANT(c)) \ + I8_TO_NATIVE_UTF8((translate_function(c) >> UTF_ACCUMULATION_SHIFT) \ + | UTF_START_MARK(2))) +#define __BASE_TWO_BYTE_LO(c, translate_function) \ + (__ASSERT_(! UVCHR_IS_INVARIANT(c)) \ + I8_TO_NATIVE_UTF8((translate_function(c) & UTF_CONTINUATION_MASK) \ + | UTF_CONTINUATION_MARK)) + +/* The next two macros should not be used. They were designed to be + * usable as the case label of a switch statement, but this doesn't + * work for EBCDIC. Use regen/unicode_constants.pl instead */ #define UTF8_TWO_BYTE_HI_nocast(c) __BASE_TWO_BYTE_HI(c, NATIVE_TO_UNI) #define UTF8_TWO_BYTE_LO_nocast(c) __BASE_TWO_BYTE_LO(c, NATIVE_TO_UNI) -/* The next two macros are used when the source should be a single byte - * character; checked for under DEBUGGING */ -#define UTF8_EIGHT_BIT_HI(c) (__ASSERT_(FITS_IN_8_BITS(c)) \ - ( __BASE_TWO_BYTE_HI(c, NATIVE_TO_LATIN1))) -#define UTF8_EIGHT_BIT_LO(c) (__ASSERT_(FITS_IN_8_BITS(c)) \ - (__BASE_TWO_BYTE_LO(c, NATIVE_TO_LATIN1))) - -/* These final two macros in the series are used when the source can be any - * code point whose UTF-8 is known to occupy 2 bytes; they are less efficient - * than the EIGHT_BIT versions on EBCDIC platforms. We use the logical '~' - * operator instead of "<=" to avoid getting compiler warnings. - * MAX_UTF8_TWO_BYTE should be exactly all one bits in the lower few - * places, so the ~ works */ -#define UTF8_TWO_BYTE_HI(c) \ - (__ASSERT_((sizeof(c) == 1) \ - || !(((WIDEST_UTYPE)(c)) & ~MAX_UTF8_TWO_BYTE)) \ - (__BASE_TWO_BYTE_HI(c, NATIVE_TO_UNI))) -#define UTF8_TWO_BYTE_LO(c) \ - (__ASSERT_((sizeof(c) == 1) \ - || !(((WIDEST_UTYPE)(c)) & ~MAX_UTF8_TWO_BYTE)) \ - (__BASE_TWO_BYTE_LO(c, NATIVE_TO_UNI))) - -/* This is illegal in any well-formed UTF-8 in both EBCDIC and ASCII - * as it is only in overlongs. */ -#define ILLEGAL_UTF8_BYTE I8_TO_NATIVE_UTF8(0xC1) +/* The next two macros are used when the source should be a + * single byte character; checked for under DEBUGGING */ +#define UTF8_EIGHT_BIT_HI(c) \ + (__ASSERT_(FITS_IN_8_BITS(c)) \ + ( __BASE_TWO_BYTE_HI(c, NATIVE_TO_LATIN1))) +#define UTF8_EIGHT_BIT_LO(c) \ + (__ASSERT_(FITS_IN_8_BITS(c)) \ + (__BASE_TWO_BYTE_LO(c, NATIVE_TO_LATIN1))) + +/* These final two macros in the series are used when the source can + * be any code point whose UTF-8 is known to occupy 2 bytes; they + * are less efficient than the EIGHT_BIT versions on EBCDIC + * platforms. We use the logical '~' operator instead of "<=" to + * avoid getting compiler warnings. MAX_UTF8_TWO_BYTE should be + * exactly all one bits in the lower few places, so the ~ works */ +#define UTF8_TWO_BYTE_HI(c) \ + (__ASSERT_((sizeof(c) == 1) \ + || !(((WIDEST_UTYPE)(c)) & ~MAX_UTF8_TWO_BYTE)) \ + (__BASE_TWO_BYTE_HI(c, NATIVE_TO_UNI))) +#define UTF8_TWO_BYTE_LO(c) \ + (__ASSERT_((sizeof(c) == 1) \ + || !(((WIDEST_UTYPE)(c)) & ~MAX_UTF8_TWO_BYTE)) \ + (__BASE_TWO_BYTE_LO(c, NATIVE_TO_UNI))) + +/* This is illegal in any well-formed UTF-8 in both EBCDIC + * and ASCII as it is only in overlongs. */ +#define ILLEGAL_UTF8_BYTE I8_TO_NATIVE_UTF8(0xC1) /* - * 'UTF' is whether or not p is encoded in UTF8. The names 'foo_lazy_if' stem - * from an earlier version of these macros in which they didn't call the - * foo_utf8() macros (i.e. were 'lazy') unless they decided that *p is the - * beginning of a utf8 character. Now that foo_utf8() determines that itself, - * no need to do it again here - */ -#define isIDFIRST_lazy_if_safe(p, e, UTF) \ - ((IN_BYTES || !UTF) \ - ? isIDFIRST(*(p)) \ - : isIDFIRST_utf8_safe(p, e)) -#define isWORDCHAR_lazy_if_safe(p, e, UTF) \ - ((IN_BYTES || !UTF) \ - ? isWORDCHAR(*(p)) \ - : isWORDCHAR_utf8_safe((U8 *) p, (U8 *) e)) + * 'UTF' is whether or not p is encoded in UTF8. The names 'foo_lazy_if' + * stem from an earlier version of these macros in which they didn't call + * the foo_utf8() macros (i.e. were 'lazy') unless they decided that *p + * is the beginning of a utf8 character. Now that foo_utf8() determines + * that itself, no need to do it again here +*/ +#define isIDFIRST_lazy_if_safe(p, e, UTF) \ + ((IN_BYTES || !UTF) \ + ? isIDFIRST(*(p)) \ + : isIDFIRST_utf8_safe(p, e)) +#define isWORDCHAR_lazy_if_safe(p, e, UTF) \ + ((IN_BYTES || !UTF) \ + ? isWORDCHAR(*(p)) \ + : isWORDCHAR_utf8_safe((U8 *) p, (U8 *) e)) #define isALNUM_lazy_if_safe(p, e, UTF) isWORDCHAR_lazy_if_safe(p, e, UTF) -#define UTF8_MAXLEN UTF8_MAXBYTES +#define UTF8_MAXLEN UTF8_MAXBYTES /* A Unicode character can fold to up to 3 characters */ -#define UTF8_MAX_FOLD_CHAR_EXPAND 3 +#define UTF8_MAX_FOLD_CHAR_EXPAND 3 -#define IN_BYTES UNLIKELY(CopHINTS_get(PL_curcop) & HINT_BYTES) +#define IN_BYTES UNLIKELY(CopHINTS_get(PL_curcop) & HINT_BYTES) /* @@ -934,42 +926,43 @@ case any call to string overloading updates the internal UTF-8 encoding flag. =cut */ -#define DO_UTF8(sv) (SvUTF8(sv) && !IN_BYTES) - -/* Should all strings be treated as Unicode, and not just UTF-8 encoded ones? - * Is so within 'feature unicode_strings' or 'locale :not_characters', and not - * within 'use bytes'. UTF-8 locales are not tested for here, but perhaps - * could be */ -#define IN_UNI_8_BIT \ - (( ( (CopHINTS_get(PL_curcop) & HINT_UNI_8_BIT)) \ - || ( CopHINTS_get(PL_curcop) & HINT_LOCALE_PARTIAL \ - /* -1 below is for :not_characters */ \ - && _is_in_locale_category(FALSE, -1))) \ - && (! IN_BYTES)) - -#define UNICODE_SURROGATE_FIRST 0xD800 -#define UNICODE_SURROGATE_LAST 0xDFFF +#define DO_UTF8(sv) (SvUTF8(sv) && !IN_BYTES) + +/* Should all strings be treated as Unicode, and not just UTF-8 + * encoded ones? Is so within 'feature unicode_strings' or + * 'locale :not_characters', and not within 'use bytes'. UTF-8 + * locales are not tested for here, but perhaps could be */ +#define IN_UNI_8_BIT \ + (( ( (CopHINTS_get(PL_curcop) & HINT_UNI_8_BIT)) \ + || ( CopHINTS_get(PL_curcop) & HINT_LOCALE_PARTIAL \ + /* -1 below is for :not_characters */ \ + && _is_in_locale_category(FALSE, -1))) \ + && (! IN_BYTES)) + +#define UNICODE_SURROGATE_FIRST 0xD800 +#define UNICODE_SURROGATE_LAST 0xDFFF /* =for apidoc Am|bool|UNICODE_IS_SURROGATE|const UV uv -Returns a boolean as to whether or not C is one of the Unicode surrogate -code points +Returns a boolean as to whether or not C is one of the Unicode +surrogate code points =for apidoc Am|bool|UTF8_IS_SURROGATE|const U8 *s|const U8 *e -Evaluates to non-zero if the first few bytes of the string starting at C and -looking no further than S> are well-formed UTF-8 that represents one -of the Unicode surrogate code points; otherwise it evaluates to 0. If -non-zero, the value gives how many bytes starting at C comprise the code -point's representation. +Evaluates to non-zero if the first few bytes of the string starting +at C and looking no further than S> are well-formed +UTF-8 that represents one of the Unicode surrogate code points; +otherwise it evaluates to 0. If non-zero, the value gives how many +bytes starting at C comprise the code point's representation. =cut - */ +*/ -#define UNICODE_IS_SURROGATE(uv) UNLIKELY(inRANGE(uv, UNICODE_SURROGATE_FIRST, \ - UNICODE_SURROGATE_LAST)) -#define UTF8_IS_SURROGATE(s, e) is_SURROGATE_utf8_safe(s, e) +#define UNICODE_IS_SURROGATE(uv) \ + UNLIKELY(inRANGE(uv, UNICODE_SURROGATE_FIRST, \ + UNICODE_SURROGATE_LAST)) +#define UTF8_IS_SURROGATE(s, e) is_SURROGATE_utf8_safe(s, e) /* @@ -984,67 +977,67 @@ CHARACTER =for apidoc Am|bool|UTF8_IS_REPLACEMENT|const U8 *s|const U8 *e -Evaluates to non-zero if the first few bytes of the string starting at C and -looking no further than S> are well-formed UTF-8 that represents the -Unicode REPLACEMENT CHARACTER; otherwise it evaluates to 0. If non-zero, the -value gives how many bytes starting at C comprise the code point's -representation. +Evaluates to non-zero if the first few bytes of the string starting at +C and looking no further than S> are well-formed UTF-8 that +represents the Unicode REPLACEMENT CHARACTER; otherwise it evaluates to +0. If non-zero, the value gives how many bytes starting at C +comprise the code point's representation. =cut - */ -#define UNICODE_REPLACEMENT 0xFFFD +*/ +#define UNICODE_REPLACEMENT 0xFFFD #define UNICODE_IS_REPLACEMENT(uv) UNLIKELY((UV) (uv) == UNICODE_REPLACEMENT) -#define UTF8_IS_REPLACEMENT(s, send) \ - UNLIKELY( \ - ((send) - (s)) >= ((SSize_t)(sizeof(REPLACEMENT_CHARACTER_UTF8) - 1))\ - && memEQ((s), REPLACEMENT_CHARACTER_UTF8, \ +#define UTF8_IS_REPLACEMENT(s, send) \ + UNLIKELY( \ + ((send) - (s)) >= ((SSize_t)(sizeof(REPLACEMENT_CHARACTER_UTF8) - 1)) \ + && memEQ((s), REPLACEMENT_CHARACTER_UTF8, \ sizeof(REPLACEMENT_CHARACTER_UTF8) - 1)) /* Max legal code point according to Unicode */ -#define PERL_UNICODE_MAX 0x10FFFF +#define PERL_UNICODE_MAX 0x10FFFF /* =for apidoc Am|bool|UNICODE_IS_SUPER|const UV uv -Returns a boolean as to whether or not C is above the maximum legal Unicode -code point of U+10FFFF. +Returns a boolean as to whether or not C is above +the maximum legal Unicode code point of U+10FFFF. =cut */ -#define UNICODE_IS_SUPER(uv) UNLIKELY((UV) (uv) > PERL_UNICODE_MAX) +#define UNICODE_IS_SUPER(uv) UNLIKELY((UV) (uv) > PERL_UNICODE_MAX) /* =for apidoc Am|bool|UTF8_IS_SUPER|const U8 *s|const U8 *e -Recall that Perl recognizes an extension to UTF-8 that can encode code -points larger than the ones defined by Unicode, which are 0..0x10FFFF. +Recall that Perl recognizes an extension to UTF-8 that can encode code points +larger than the ones defined by Unicode, which are 0..0x10FFFF. -This macro evaluates to non-zero if the first few bytes of the string starting -at C and looking no further than S> are from this UTF-8 extension; -otherwise it evaluates to 0. If non-zero, the return is how many bytes -starting at C comprise the code point's representation. +This macro evaluates to non-zero if the first few bytes of the string +starting at C and looking no further than S> are from this UTF-8 +extension; otherwise it evaluates to 0. If non-zero, the return is how many +bytes starting at C comprise the code point's representation. 0 is returned if the bytes are not well-formed extended UTF-8, or if they -represent a code point that cannot fit in a UV on the current platform. Hence -this macro can give different results when run on a 64-bit word machine than on -one with a 32-bit word size. +represent a code point that cannot fit in a UV on the current platform. +Hence this macro can give different results when run on a 64-bit word machine +than on one with a 32-bit word size. -Note that it is illegal in Perl to have code points that are larger than what can -fit in an IV on the current machine; and illegal in Unicode to have any that -this macro matches +Note that it is illegal in Perl to have code points that are larger than what +can fit in an IV on the current machine; and illegal in Unicode to have any +that this macro matches =cut - * ASCII EBCDIC I8 - * U+10FFFF: \xF4\x8F\xBF\xBF \xF9\xA1\xBF\xBF\xBF max legal Unicode - * U+110000: \xF4\x90\x80\x80 \xF9\xA2\xA0\xA0\xA0 - * U+110001: \xF4\x90\x80\x81 \xF9\xA2\xA0\xA0\xA1 - */ + * ASCII EBCDIC I8 + * U+10FFFF: \xF4\x8F\xBF\xBF \xF9\xA1\xBF\xBF\xBF max legal Unicode + * U+110000: \xF4\x90\x80\x80 \xF9\xA2\xA0\xA0\xA0 + * U+110001: \xF4\x90\x80\x81 \xF9\xA2\xA0\xA0\xA1 +*/ #define UTF_START_BYTE_110000_ UTF_START_BYTE(PERL_UNICODE_MAX + 1, 21) -#define UTF_FIRST_CONT_BYTE_110000_ \ - UTF_FIRST_CONT_BYTE(PERL_UNICODE_MAX + 1, 21) +#define UTF_FIRST_CONT_BYTE_110000_ \ + UTF_FIRST_CONT_BYTE(PERL_UNICODE_MAX + 1, 21) #define UTF8_IS_SUPER(s, e) \ ( ((e) - (s)) >= UNISKIP_BY_MSB_(20) \ && ( NATIVE_UTF8_TO_I8(s[0]) >= UTF_START_BYTE_110000_ \ @@ -1056,263 +1049,269 @@ this macro matches /* =for apidoc Am|bool|UNICODE_IS_NONCHAR|const UV uv -Returns a boolean as to whether or not C is one of the Unicode -non-character code points +Returns a boolean as to whether or not C is +one of the Unicode non-character code points =cut */ /* Is 'uv' one of the 32 contiguous-range noncharacters? */ -#define UNICODE_IS_32_CONTIGUOUS_NONCHARS(uv) \ - UNLIKELY(inRANGE(uv, 0xFDD0, 0xFDEF)) +#define UNICODE_IS_32_CONTIGUOUS_NONCHARS(uv) \ + UNLIKELY(inRANGE(uv, 0xFDD0, 0xFDEF)) /* Is 'uv' one of the 34 plane-ending noncharacters 0xFFFE, 0xFFFF, 0x1FFFE, * 0x1FFFF, ... 0x10FFFE, 0x10FFFF, given that we know that 'uv' is not above * the Unicode legal max */ -#define UNICODE_IS_END_PLANE_NONCHAR_GIVEN_NOT_SUPER(uv) \ - UNLIKELY(((UV) (uv) & 0xFFFE) == 0xFFFE) +#define UNICODE_IS_END_PLANE_NONCHAR_GIVEN_NOT_SUPER(uv) \ + UNLIKELY(((UV) (uv) & 0xFFFE) == 0xFFFE) -#define UNICODE_IS_NONCHAR(uv) \ - ( UNLIKELY(UNICODE_IS_32_CONTIGUOUS_NONCHARS(uv)) \ - || ( UNLIKELY(UNICODE_IS_END_PLANE_NONCHAR_GIVEN_NOT_SUPER(uv)) \ +#define UNICODE_IS_NONCHAR(uv) \ + ( UNLIKELY(UNICODE_IS_32_CONTIGUOUS_NONCHARS(uv)) \ + || ( UNLIKELY(UNICODE_IS_END_PLANE_NONCHAR_GIVEN_NOT_SUPER(uv)) \ && LIKELY(! UNICODE_IS_SUPER(uv)))) /* =for apidoc Am|bool|UTF8_IS_NONCHAR|const U8 *s|const U8 *e -Evaluates to non-zero if the first few bytes of the string starting at C and -looking no further than S> are well-formed UTF-8 that represents one -of the Unicode non-character code points; otherwise it evaluates to 0. If -non-zero, the value gives how many bytes starting at C comprise the code -point's representation. +Evaluates to non-zero if the first few bytes of the string starting +at C and looking no further than S> are well-formed +UTF-8 that represents one of the Unicode non-character code points; +otherwise it evaluates to 0. If non-zero, the value gives how many +bytes starting at C comprise the code point's representation. =cut */ -#define UTF8_IS_NONCHAR(s, e) is_NONCHAR_utf8_safe(s,e) +#define UTF8_IS_NONCHAR(s, e) is_NONCHAR_utf8_safe(s,e) -/* This is now machine generated, and the 'given' clause is no longer - * applicable */ -#define UTF8_IS_NONCHAR_GIVEN_THAT_NON_SUPER_AND_GE_PROBLEMATIC(s, e) \ - UTF8_IS_NONCHAR(s, e) +/* This is now machine generated, and the 'given' + * clause is no longer applicable */ +#define UTF8_IS_NONCHAR_GIVEN_THAT_NON_SUPER_AND_GE_PROBLEMATIC(s, e) \ + UTF8_IS_NONCHAR(s, e) -/* Surrogates, non-character code points and above-Unicode code points are - * problematic in some contexts. These macros allow code that needs to check - * for those to quickly exclude the vast majority of code points it will - * encounter. +/* Surrogates, non-character code points and above-Unicode code + * points are problematic in some contexts. These macros allow code + * that needs to check for those to quickly exclude the vast + * majority of code points it will encounter. * - * The lowest such code point is the smallest surrogate, U+D800. We calculate - * the start byte of that. 0xD800 occupies 16 bits. */ + * The lowest such code point is the smallest surrogate, U+D800. We + * calculate the start byte of that. 0xD800 occupies 16 bits. */ #define isUNICODE_POSSIBLY_PROBLEMATIC(uv) ((uv) >= UNICODE_SURROGATE_FIRST) -#define isUTF8_POSSIBLY_PROBLEMATIC(c) \ +#define isUTF8_POSSIBLY_PROBLEMATIC(c) \ (NATIVE_UTF8_TO_I8(c) >= UTF_START_BYTE(UNICODE_SURROGATE_FIRST, 16)) -/* Perl extends Unicode so that it is possible to encode (as extended UTF-8 or - * UTF-EBCDIC) any 64-bit value. No standard known to khw ever encoded higher - * than a 31 bit value. On ASCII platforms this just meant arbitrarily saying - * nothing could be higher than this. On these the start byte FD gets you to - * 31 bits, and FE and FF are forbidden as start bytes. On EBCDIC platforms, - * FD gets you only to 26 bits; adding FE to mean 7 total bytes gets you to 30 - * bits. To get to 31 bits, they treated an initial FF byte idiosyncratically. - * It was considered to be the start byte FE meaning it had 7 total bytes, and - * the final 1 was treated as an information bit, getting you to 31 bits. +/* Perl extends Unicode so that it is possible to encode (as extended + * UTF-8 or UTF-EBCDIC) any 64-bit value. No standard known to khw ever + * encoded higher than a 31 bit value. On ASCII platforms this just meant + * arbitrarily saying nothing could be higher than this. On these the + * start byte FD gets you to 31 bits, and FE and FF are forbidden as start + * bytes. On EBCDIC platforms, FD gets you only to 26 bits; adding FE to + * mean 7 total bytes gets you to 30 bits. To get to 31 bits, they + * treated an initial FF byte idiosyncratically. It was considered to be + * the start byte FE meaning it had 7 total bytes, and the final 1 was + * treated as an information bit, getting you to 31 bits. * - * Perl used to accept this idiosyncratic interpretation of FF, but now rejects - * it in order to get to being able to encode 64 bits. The bottom line is that - * it is a Perl extension to use the start bytes FE and FF on ASCII platforms, - * and the start byte FF on EBCDIC ones. That translates into that it is a - * Perl extension to represent anything occupying more than 31 bits on ASCII - * platforms; 30 bits on EBCDIC. */ -#define UNICODE_IS_PERL_EXTENDED(uv) \ - UNLIKELY((UV) (uv) > nBIT_UMAX(31 - ONE_IF_EBCDIC_ZERO_IF_NOT)) -#define UTF8_IS_PERL_EXTENDED(s) \ - (UTF8SKIP(s) > 6 + ONE_IF_EBCDIC_ZERO_IF_NOT) + * Perl used to accept this idiosyncratic interpretation of FF, but now + * rejects it in order to get to being able to encode 64 bits. The bottom + * line is that it is a Perl extension to use the start bytes FE and FF on + * ASCII platforms, and the start byte FF on EBCDIC ones. That translates + * into that it is a Perl extension to represent anything occupying more + * than 31 bits on ASCII platforms; 30 bits on EBCDIC. */ +#define UNICODE_IS_PERL_EXTENDED(uv) \ + UNLIKELY((UV) (uv) > nBIT_UMAX(31 - ONE_IF_EBCDIC_ZERO_IF_NOT)) +#define UTF8_IS_PERL_EXTENDED(s) \ + (UTF8SKIP(s) > 6 + ONE_IF_EBCDIC_ZERO_IF_NOT) /* Largest code point we accept from external sources */ -#define MAX_LEGAL_CP ((UV)IV_MAX) +#define MAX_LEGAL_CP ((UV)IV_MAX) -#define UTF8_ALLOW_EMPTY 0x0001 /* Allow a zero length string */ -#define UTF8_GOT_EMPTY UTF8_ALLOW_EMPTY +#define UTF8_ALLOW_EMPTY 0x0001 /* Allow a zero length string */ +#define UTF8_GOT_EMPTY UTF8_ALLOW_EMPTY /* Allow first byte to be a continuation byte */ -#define UTF8_ALLOW_CONTINUATION 0x0002 -#define UTF8_GOT_CONTINUATION UTF8_ALLOW_CONTINUATION +#define UTF8_ALLOW_CONTINUATION 0x0002 +#define UTF8_GOT_CONTINUATION UTF8_ALLOW_CONTINUATION /* Unexpected non-continuation byte */ -#define UTF8_ALLOW_NON_CONTINUATION 0x0004 -#define UTF8_GOT_NON_CONTINUATION UTF8_ALLOW_NON_CONTINUATION +#define UTF8_ALLOW_NON_CONTINUATION 0x0004 +#define UTF8_GOT_NON_CONTINUATION UTF8_ALLOW_NON_CONTINUATION /* expecting more bytes than were available in the string */ -#define UTF8_ALLOW_SHORT 0x0008 -#define UTF8_GOT_SHORT UTF8_ALLOW_SHORT +#define UTF8_ALLOW_SHORT 0x0008 +#define UTF8_GOT_SHORT UTF8_ALLOW_SHORT -/* Overlong sequence; i.e., the code point can be specified in fewer bytes. - * First one will convert the overlong to the REPLACEMENT CHARACTER; second - * will return what the overlong evaluates to */ -#define UTF8_ALLOW_LONG 0x0010 -#define UTF8_ALLOW_LONG_AND_ITS_VALUE (UTF8_ALLOW_LONG|0x0020) -#define UTF8_GOT_LONG UTF8_ALLOW_LONG +/* Overlong sequence; i.e., the code point can be specified in fewer + * bytes. First one will convert the overlong to the REPLACEMENT + * CHARACTER; second will return what the overlong evaluates to */ +#define UTF8_ALLOW_LONG 0x0010 +#define UTF8_ALLOW_LONG_AND_ITS_VALUE (UTF8_ALLOW_LONG|0x0020) +#define UTF8_GOT_LONG UTF8_ALLOW_LONG -#define UTF8_ALLOW_OVERFLOW 0x0080 -#define UTF8_GOT_OVERFLOW UTF8_ALLOW_OVERFLOW +#define UTF8_ALLOW_OVERFLOW 0x0080 +#define UTF8_GOT_OVERFLOW UTF8_ALLOW_OVERFLOW -#define UTF8_DISALLOW_SURROGATE 0x0100 /* Unicode surrogates */ -#define UTF8_GOT_SURROGATE UTF8_DISALLOW_SURROGATE -#define UTF8_WARN_SURROGATE 0x0200 +#define UTF8_DISALLOW_SURROGATE 0x0100 /* Unicode surrogates */ +#define UTF8_GOT_SURROGATE UTF8_DISALLOW_SURROGATE +#define UTF8_WARN_SURROGATE 0x0200 -/* Unicode non-character code points */ -#define UTF8_DISALLOW_NONCHAR 0x0400 -#define UTF8_GOT_NONCHAR UTF8_DISALLOW_NONCHAR -#define UTF8_WARN_NONCHAR 0x0800 +/* Unicode non-character code points */ +#define UTF8_DISALLOW_NONCHAR 0x0400 +#define UTF8_GOT_NONCHAR UTF8_DISALLOW_NONCHAR +#define UTF8_WARN_NONCHAR 0x0800 /* Super-set of Unicode: code points above the legal max */ -#define UTF8_DISALLOW_SUPER 0x1000 -#define UTF8_GOT_SUPER UTF8_DISALLOW_SUPER -#define UTF8_WARN_SUPER 0x2000 - -/* The original UTF-8 standard did not define UTF-8 with start bytes of 0xFE or - * 0xFF, though UTF-EBCDIC did. This allowed both versions to represent code - * points up to 2 ** 31 - 1. Perl extends UTF-8 so that 0xFE and 0xFF are - * usable on ASCII platforms, and 0xFF means something different than - * UTF-EBCDIC defines. These changes allow code points of 64 bits (actually - * somewhat more) to be represented on both platforms. But these are Perl - * extensions, and not likely to be interchangeable with other languages. Note - * that on ASCII platforms, FE overflows a signed 32-bit word, and FF an - * unsigned one. */ -#define UTF8_DISALLOW_PERL_EXTENDED 0x4000 -#define UTF8_GOT_PERL_EXTENDED UTF8_DISALLOW_PERL_EXTENDED -#define UTF8_WARN_PERL_EXTENDED 0x8000 - -/* For back compat, these old names are misleading for overlongs and - * UTF_EBCDIC. */ -#define UTF8_DISALLOW_ABOVE_31_BIT UTF8_DISALLOW_PERL_EXTENDED -#define UTF8_GOT_ABOVE_31_BIT UTF8_GOT_PERL_EXTENDED -#define UTF8_WARN_ABOVE_31_BIT UTF8_WARN_PERL_EXTENDED -#define UTF8_DISALLOW_FE_FF UTF8_DISALLOW_PERL_EXTENDED -#define UTF8_WARN_FE_FF UTF8_WARN_PERL_EXTENDED - -#define UTF8_CHECK_ONLY 0x10000 -#define _UTF8_NO_CONFIDENCE_IN_CURLEN 0x20000 /* Internal core use only */ - -/* For backwards source compatibility. They do nothing, as the default now - * includes what they used to mean. The first one's meaning was to allow the - * just the single non-character 0xFFFF */ -#define UTF8_ALLOW_FFFF 0 -#define UTF8_ALLOW_FE_FF 0 -#define UTF8_ALLOW_SURROGATE 0 +#define UTF8_DISALLOW_SUPER 0x1000 +#define UTF8_GOT_SUPER UTF8_DISALLOW_SUPER +#define UTF8_WARN_SUPER 0x2000 + +/* The original UTF-8 standard did not define UTF-8 with start bytes of + * 0xFE or 0xFF, though UTF-EBCDIC did. This allowed both versions to + * represent code points up to 2 ** 31 - 1. Perl extends UTF-8 so that + * 0xFE and 0xFF are usable on ASCII platforms, and 0xFF means + * something different than UTF-EBCDIC defines. These changes allow + * code points of 64 bits (actually somewhat more) to be represented on + * both platforms. But these are Perl extensions, and not likely to be + * interchangeable with other languages. Note that on ASCII platforms, + * FE overflows a signed 32-bit word, and FF an unsigned one. */ +#define UTF8_DISALLOW_PERL_EXTENDED 0x4000 +#define UTF8_GOT_PERL_EXTENDED UTF8_DISALLOW_PERL_EXTENDED +#define UTF8_WARN_PERL_EXTENDED 0x8000 + +/* For back compat, these old names are misleading + * for overlongs and UTF_EBCDIC. */ +#define UTF8_DISALLOW_ABOVE_31_BIT UTF8_DISALLOW_PERL_EXTENDED +#define UTF8_GOT_ABOVE_31_BIT UTF8_GOT_PERL_EXTENDED +#define UTF8_WARN_ABOVE_31_BIT UTF8_WARN_PERL_EXTENDED +#define UTF8_DISALLOW_FE_FF UTF8_DISALLOW_PERL_EXTENDED +#define UTF8_WARN_FE_FF UTF8_WARN_PERL_EXTENDED + +#define UTF8_CHECK_ONLY 0x10000 +#define _UTF8_NO_CONFIDENCE_IN_CURLEN 0x20000 /* Internal core use only */ + +/* For backwards source compatibility. They do nothing, as the default + * now includes what they used to mean. The first one's meaning was to + * allow the just the single non-character 0xFFFF */ +#define UTF8_ALLOW_FFFF 0 +#define UTF8_ALLOW_FE_FF 0 +#define UTF8_ALLOW_SURROGATE 0 /* C9 refers to Unicode Corrigendum #9: allows but discourages non-chars */ -#define UTF8_DISALLOW_ILLEGAL_C9_INTERCHANGE \ - (UTF8_DISALLOW_SUPER|UTF8_DISALLOW_SURROGATE) -#define UTF8_WARN_ILLEGAL_C9_INTERCHANGE (UTF8_WARN_SUPER|UTF8_WARN_SURROGATE) - -#define UTF8_DISALLOW_ILLEGAL_INTERCHANGE \ - (UTF8_DISALLOW_ILLEGAL_C9_INTERCHANGE|UTF8_DISALLOW_NONCHAR) -#define UTF8_WARN_ILLEGAL_INTERCHANGE \ - (UTF8_WARN_ILLEGAL_C9_INTERCHANGE|UTF8_WARN_NONCHAR) - -/* This is typically used for code that processes UTF-8 input and doesn't want - * to have to deal with any malformations that might be present. All such will - * be safely replaced by the REPLACEMENT CHARACTER, unless other flags - * overriding this are also present. */ -#define UTF8_ALLOW_ANY ( UTF8_ALLOW_CONTINUATION \ - |UTF8_ALLOW_NON_CONTINUATION \ - |UTF8_ALLOW_SHORT \ - |UTF8_ALLOW_LONG \ - |UTF8_ALLOW_OVERFLOW) - -/* Accept any Perl-extended UTF-8 that evaluates to any UV on the platform, but - * not any malformed. This is the default. */ -#define UTF8_ALLOW_ANYUV 0 -#define UTF8_ALLOW_DEFAULT UTF8_ALLOW_ANYUV - -#define UNICODE_WARN_SURROGATE 0x0001 /* UTF-16 surrogates */ -#define UNICODE_WARN_NONCHAR 0x0002 /* Non-char code points */ -#define UNICODE_WARN_SUPER 0x0004 /* Above 0x10FFFF */ -#define UNICODE_WARN_PERL_EXTENDED 0x0008 /* Above 0x7FFF_FFFF */ -#define UNICODE_WARN_ABOVE_31_BIT UNICODE_WARN_PERL_EXTENDED -#define UNICODE_DISALLOW_SURROGATE 0x0010 -#define UNICODE_DISALLOW_NONCHAR 0x0020 -#define UNICODE_DISALLOW_SUPER 0x0040 +#define UTF8_DISALLOW_ILLEGAL_C9_INTERCHANGE \ + (UTF8_DISALLOW_SUPER|UTF8_DISALLOW_SURROGATE) +#define UTF8_WARN_ILLEGAL_C9_INTERCHANGE (UTF8_WARN_SUPER|UTF8_WARN_SURROGATE) + +#define UTF8_DISALLOW_ILLEGAL_INTERCHANGE \ + (UTF8_DISALLOW_ILLEGAL_C9_INTERCHANGE|UTF8_DISALLOW_NONCHAR) +#define UTF8_WARN_ILLEGAL_INTERCHANGE \ + (UTF8_WARN_ILLEGAL_C9_INTERCHANGE|UTF8_WARN_NONCHAR) + +/* This is typically used for code that processes UTF-8 input and doesn't + * want to have to deal with any malformations that might be present. + * All such will be safely replaced by the REPLACEMENT CHARACTER, unless + * other flags overriding this are also present. */ +#define UTF8_ALLOW_ANY \ + ( UTF8_ALLOW_CONTINUATION \ + |UTF8_ALLOW_NON_CONTINUATION \ + |UTF8_ALLOW_SHORT \ + |UTF8_ALLOW_LONG \ + |UTF8_ALLOW_OVERFLOW) + +/* Accept any Perl-extended UTF-8 that evaluates to any UV on the + * platform, but not any malformed. This is the default. */ +#define UTF8_ALLOW_ANYUV 0 +#define UTF8_ALLOW_DEFAULT UTF8_ALLOW_ANYUV + +#define UNICODE_WARN_SURROGATE 0x0001 /* UTF-16 surrogates */ +#define UNICODE_WARN_NONCHAR 0x0002 /* Non-char code points */ +#define UNICODE_WARN_SUPER 0x0004 /* Above 0x10FFFF */ +#define UNICODE_WARN_PERL_EXTENDED 0x0008 /* Above 0x7FFF_FFFF */ +#define UNICODE_WARN_ABOVE_31_BIT UNICODE_WARN_PERL_EXTENDED +#define UNICODE_DISALLOW_SURROGATE 0x0010 +#define UNICODE_DISALLOW_NONCHAR 0x0020 +#define UNICODE_DISALLOW_SUPER 0x0040 #define UNICODE_DISALLOW_PERL_EXTENDED 0x0080 #ifdef PERL_CORE -# define UNICODE_ALLOW_ABOVE_IV_MAX 0x0100 +# define UNICODE_ALLOW_ABOVE_IV_MAX 0x0100 #endif -#define UNICODE_DISALLOW_ABOVE_31_BIT UNICODE_DISALLOW_PERL_EXTENDED +#define UNICODE_DISALLOW_ABOVE_31_BIT UNICODE_DISALLOW_PERL_EXTENDED #define UNICODE_GOT_SURROGATE UNICODE_DISALLOW_SURROGATE #define UNICODE_GOT_NONCHAR UNICODE_DISALLOW_NONCHAR #define UNICODE_GOT_SUPER UNICODE_DISALLOW_SUPER #define UNICODE_GOT_PERL_EXTENDED UNICODE_DISALLOW_PERL_EXTENDED -#define UNICODE_WARN_ILLEGAL_C9_INTERCHANGE \ - (UNICODE_WARN_SURROGATE|UNICODE_WARN_SUPER) -#define UNICODE_WARN_ILLEGAL_INTERCHANGE \ - (UNICODE_WARN_ILLEGAL_C9_INTERCHANGE|UNICODE_WARN_NONCHAR) -#define UNICODE_DISALLOW_ILLEGAL_C9_INTERCHANGE \ - (UNICODE_DISALLOW_SURROGATE|UNICODE_DISALLOW_SUPER) -#define UNICODE_DISALLOW_ILLEGAL_INTERCHANGE \ - (UNICODE_DISALLOW_ILLEGAL_C9_INTERCHANGE|UNICODE_DISALLOW_NONCHAR) +#define UNICODE_WARN_ILLEGAL_C9_INTERCHANGE \ + (UNICODE_WARN_SURROGATE|UNICODE_WARN_SUPER) +#define UNICODE_WARN_ILLEGAL_INTERCHANGE \ + (UNICODE_WARN_ILLEGAL_C9_INTERCHANGE|UNICODE_WARN_NONCHAR) +#define UNICODE_DISALLOW_ILLEGAL_C9_INTERCHANGE \ + (UNICODE_DISALLOW_SURROGATE|UNICODE_DISALLOW_SUPER) +#define UNICODE_DISALLOW_ILLEGAL_INTERCHANGE \ + (UNICODE_DISALLOW_ILLEGAL_C9_INTERCHANGE|UNICODE_DISALLOW_NONCHAR) /* For backward source compatibility, as are now the default */ -#define UNICODE_ALLOW_SURROGATE 0 -#define UNICODE_ALLOW_SUPER 0 -#define UNICODE_ALLOW_ANY 0 - -#define UNICODE_BYTE_ORDER_MARK 0xFEFF -#define UNICODE_IS_BYTE_ORDER_MARK(uv) UNLIKELY((UV) (uv) \ - == UNICODE_BYTE_ORDER_MARK) - -#define LATIN_SMALL_LETTER_SHARP_S LATIN_SMALL_LETTER_SHARP_S_NATIVE -#define LATIN_SMALL_LETTER_Y_WITH_DIAERESIS \ - LATIN_SMALL_LETTER_Y_WITH_DIAERESIS_NATIVE +#define UNICODE_ALLOW_SURROGATE 0 +#define UNICODE_ALLOW_SUPER 0 +#define UNICODE_ALLOW_ANY 0 + +#define UNICODE_BYTE_ORDER_MARK 0xFEFF +#define UNICODE_IS_BYTE_ORDER_MARK(uv) \ + UNLIKELY((UV) (uv) \ + == UNICODE_BYTE_ORDER_MARK) + +#define LATIN_SMALL_LETTER_SHARP_S LATIN_SMALL_LETTER_SHARP_S_NATIVE +#define LATIN_SMALL_LETTER_Y_WITH_DIAERESIS \ + LATIN_SMALL_LETTER_Y_WITH_DIAERESIS_NATIVE #define MICRO_SIGN MICRO_SIGN_NATIVE -#define LATIN_CAPITAL_LETTER_A_WITH_RING_ABOVE \ - LATIN_CAPITAL_LETTER_A_WITH_RING_ABOVE_NATIVE -#define LATIN_SMALL_LETTER_A_WITH_RING_ABOVE \ - LATIN_SMALL_LETTER_A_WITH_RING_ABOVE_NATIVE -#define UNICODE_GREEK_CAPITAL_LETTER_SIGMA 0x03A3 -#define UNICODE_GREEK_SMALL_LETTER_FINAL_SIGMA 0x03C2 -#define UNICODE_GREEK_SMALL_LETTER_SIGMA 0x03C3 +#define LATIN_CAPITAL_LETTER_A_WITH_RING_ABOVE \ + LATIN_CAPITAL_LETTER_A_WITH_RING_ABOVE_NATIVE +#define LATIN_SMALL_LETTER_A_WITH_RING_ABOVE \ + LATIN_SMALL_LETTER_A_WITH_RING_ABOVE_NATIVE +#define UNICODE_GREEK_CAPITAL_LETTER_SIGMA 0x03A3 +#define UNICODE_GREEK_SMALL_LETTER_FINAL_SIGMA 0x03C2 +#define UNICODE_GREEK_SMALL_LETTER_SIGMA 0x03C3 #define GREEK_SMALL_LETTER_MU 0x03BC -#define GREEK_CAPITAL_LETTER_MU 0x039C /* Upper and title case +#define GREEK_CAPITAL_LETTER_MU 0x039C /* Upper and title case of MICRON */ -#define LATIN_CAPITAL_LETTER_Y_WITH_DIAERESIS 0x0178 /* Also is title case */ +#define LATIN_CAPITAL_LETTER_Y_WITH_DIAERESIS 0x0178 /* Also is title + case */ #ifdef LATIN_CAPITAL_LETTER_SHARP_S_UTF8 -# define LATIN_CAPITAL_LETTER_SHARP_S 0x1E9E +# define LATIN_CAPITAL_LETTER_SHARP_S 0x1E9E #endif -#define LATIN_CAPITAL_LETTER_I_WITH_DOT_ABOVE 0x130 -#define LATIN_SMALL_LETTER_DOTLESS_I 0x131 +#define LATIN_CAPITAL_LETTER_I_WITH_DOT_ABOVE 0x130 +#define LATIN_SMALL_LETTER_DOTLESS_I 0x131 #define LATIN_SMALL_LETTER_LONG_S 0x017F #define LATIN_SMALL_LIGATURE_LONG_S_T 0xFB05 #define LATIN_SMALL_LIGATURE_ST 0xFB06 #define KELVIN_SIGN 0x212A #define ANGSTROM_SIGN 0x212B -#define UNI_DISPLAY_ISPRINT 0x0001 -#define UNI_DISPLAY_BACKSLASH 0x0002 -#define UNI_DISPLAY_BACKSPACE 0x0004 /* Allow \b when also - UNI_DISPLAY_BACKSLASH */ -#define UNI_DISPLAY_QQ (UNI_DISPLAY_ISPRINT \ - |UNI_DISPLAY_BACKSLASH \ - |UNI_DISPLAY_BACKSPACE) +#define UNI_DISPLAY_ISPRINT 0x0001 +#define UNI_DISPLAY_BACKSLASH 0x0002 +#define UNI_DISPLAY_BACKSPACE 0x0004 /* Allow \b when also + UNI_DISPLAY_BACKSLASH + */ +#define UNI_DISPLAY_QQ \ + (UNI_DISPLAY_ISPRINT \ + |UNI_DISPLAY_BACKSLASH \ + |UNI_DISPLAY_BACKSPACE) /* Character classes could also allow \b, but not patterns in general */ -#define UNI_DISPLAY_REGEX (UNI_DISPLAY_ISPRINT|UNI_DISPLAY_BACKSLASH) +#define UNI_DISPLAY_REGEX (UNI_DISPLAY_ISPRINT|UNI_DISPLAY_BACKSLASH) /* Should be removed; maybe deprecated, but not used in CPAN */ -#define SHARP_S_SKIP 2 +#define SHARP_S_SKIP 2 #define is_utf8_char_buf(buf, buf_end) isUTF8_CHAR(buf, buf_end) -#define bytes_from_utf8(s, lenp, is_utf8p) \ - bytes_from_utf8_loc(s, lenp, is_utf8p, 0) +#define bytes_from_utf8(s, lenp, is_utf8p) \ + bytes_from_utf8_loc(s, lenp, is_utf8p, 0) -/* Do not use; should be deprecated. Use isUTF8_CHAR() instead; this is - * retained solely for backwards compatibility */ -#define IS_UTF8_CHAR(p, n) (isUTF8_CHAR(p, (p) + (n)) == n) +/* Do not use; should be deprecated. Use isUTF8_CHAR() instead; + * this is retained solely for backwards compatibility */ +#define IS_UTF8_CHAR(p, n) (isUTF8_CHAR(p, (p) + (n)) == n) #endif /* PERL_UTF8_H_ */ /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/utfebcdic.h b/utfebcdic.h index 347a7b121fc4..b86a4d82f2fe 100644 --- a/utfebcdic.h +++ b/utfebcdic.h @@ -1,127 +1,123 @@ /* utfebcdic.h * - * Copyright (C) 2001, 2002, 2003, 2005, 2006, 2007, 2009, - * 2010, 2011 by Larry Wall, Nick Ing-Simmons, and others + * Copyright (C) 2001, 2002, 2003, 2005, 2006, 2007, 2009, 2010, 2011, 2012, + * 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021, 2022 by Larry Wall, + * Nick Ing-Simmons, and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * - * Macros to implement UTF-EBCDIC as perl's internal encoding - * Adapted from version 7.1 of Unicode Technical Report #16: - * http://www.unicode.org/reports/tr16 + * Macros to implement UTF-EBCDIC as perl's internal encoding Adapted from + * version 7.1 of Unicode Technical Report #16: + * http://www.unicode.org/reports/tr16 * - * To summarize, the way it works is: - * To convert an EBCDIC code point to UTF-EBCDIC: - * 1) convert to Unicode. No conversion is necessary for code points above - * 255, as Unicode and EBCDIC are identical in this range. For smaller - * code points, the conversion is done by lookup in the PL_e2a table (with - * inverse PL_a2e) in the generated file 'ebcdic_tables.h'. The 'a' - * stands for ASCII platform, meaning 0-255 Unicode. Use - * NATIVE_TO_LATIN1() and LATIN1_TO_NATIVE(), respectively to perform this - * lookup. NATIVE_TO_UNI() and UNI_TO_NATIVE() are similarly used for any - * input, and know to avoid the lookup for inputs above 255. - * 2) convert that to a utf8-like string called I8 ('I' stands for - * intermediate) with variant characters occupying multiple bytes. This - * step is similar to the utf8-creating step from Unicode, but the details - * are different. This transformation is called UTF8-Mod. There is a - * chart about the bit patterns in a comment later in this file. But - * essentially here are the differences: - * UTF8 I8 - * invariant byte starts with 0 starts with 0 or 100 - * continuation byte starts with 10 starts with 101 - * start byte same in both: if the code point requires N bytes, - * then the leading N bits are 1, followed by a 0. If - * all 8 bits in the first byte are 1, the code point - * will occupy 14 bytes (compared to 13 in Perl's - * extended UTF-8). This is incompatible with what - * tr16 implies should be the representation of code - * points 2**30 and above, but allows Perl to be able - * to represent all code points that fit in a 64-bit - * word in either our extended UTF-EBCDIC or UTF-8. - * 3) Use the algorithm in tr16 to convert each byte from step 2 into - * final UTF-EBCDIC. This is done by table lookup from a table - * constructed from the algorithm, reproduced in ebcdic_tables.h as - * PL_utf2e, with its inverse being PL_e2utf. They are constructed so that - * all EBCDIC invariants remain invariant, but no others do, and the first - * byte of a variant will always have its upper bit set. But note that - * the upper bit of some invariants is also 1. The table also is designed - * so that lexically comparing two UTF-EBCDIC-variant characters yields - * the Unicode code point order. (To get native code point order, one has - * to convert the latin1-range characters to their native code point - * value.) The macros NATIVE_UTF8_TO_I8() and I8_TO_NATIVE_UTF8() do the - * table lookups. + * To summarize, the way it works is: To convert an EBCDIC code point to + * UTF-EBCDIC: 1) convert to Unicode. No conversion is necessary for code + * points above 255, as Unicode and EBCDIC are identical in this range. For + * smaller code points, the conversion is done by lookup in the PL_e2a table + * (with inverse PL_a2e) in the generated file 'ebcdic_tables.h'. The 'a' + * stands for ASCII platform, meaning 0-255 Unicode. Use NATIVE_TO_LATIN1() + * and LATIN1_TO_NATIVE(), respectively to perform this lookup. + * NATIVE_TO_UNI() and UNI_TO_NATIVE() are similarly used for any input, and + * know to avoid the lookup for inputs above 255. 2) convert that to a + * utf8-like string called I8 ('I' stands for intermediate) with variant + * characters occupying multiple bytes. This step is similar to the + * utf8-creating step from Unicode, but the details are different. This + * transformation is called UTF8-Mod. There is a chart about the bit + * patterns in a comment later in this file. But essentially here are the + * differences: UTF8 I8 invariant byte starts with 0 starts with 0 or 100 + * continuation byte starts with 10 starts with 101 start byte same in both: + * if the code point requires N bytes, then the leading N bits are 1, + * followed by a 0. If all 8 bits in the first byte are 1, the code point + * will occupy 14 bytes (compared to 13 in Perl's extended UTF-8). This is + * incompatible with what tr16 implies should be the representation of code + * points 2**30 and above, but allows Perl to be able to represent all code + * points that fit in a 64-bit word in either our extended UTF-EBCDIC or + * UTF-8. 3) Use the algorithm in tr16 to convert each byte from step 2 + * into final UTF-EBCDIC. This is done by table lookup from a table + * constructed from the algorithm, reproduced in ebcdic_tables.h as + * PL_utf2e, with its inverse being PL_e2utf. They are constructed so that + * all EBCDIC invariants remain invariant, but no others do, and the first + * byte of a variant will always have its upper bit set. But note that the + * upper bit of some invariants is also 1. The table also is designed so + * that lexically comparing two UTF-EBCDIC-variant characters yields the + * Unicode code point order. (To get native code point order, one has to + * convert the latin1-range characters to their native code point value.) + * The macros NATIVE_UTF8_TO_I8() and I8_TO_NATIVE_UTF8() do the table + * lookups. * - * For example, the ordinal value of 'A' is 193 in EBCDIC, and also is 193 in - * UTF-EBCDIC. Step 1) converts it to 65, Step 2 leaves it at 65, and Step 3 - * converts it back to 193. As an example of how a variant character works, - * take LATIN SMALL LETTER Y WITH DIAERESIS, which is typically 0xDF in - * EBCDIC. Step 1 converts it to the Unicode value, 0xFF. Step 2 converts - * that to two bytes = 11000111 10111111 = C7 BF, and Step 3 converts those to - * 0x8B 0x73. + * For example, the ordinal value of 'A' is 193 in EBCDIC, and also is 193 in + * UTF-EBCDIC. Step 1) converts it to 65, Step 2 leaves it at 65, and Step 3 + * converts it back to 193. As an example of how a variant character works, + * take LATIN SMALL LETTER Y WITH DIAERESIS, which is typically 0xDF in + * EBCDIC. Step 1 converts it to the Unicode value, 0xFF. Step 2 converts + * that to two bytes = 11000111 10111111 = C7 BF, and Step 3 converts those to + * 0x8B 0x73. * - * If you're starting from Unicode, skip step 1. For UTF-EBCDIC to straight - * EBCDIC, reverse the steps. + * If you're starting from Unicode, skip step 1. For UTF-EBCDIC to straight + * EBCDIC, reverse the steps. * - * The EBCDIC invariants have been chosen to be those characters whose Unicode - * equivalents have ordinal numbers less than 160, that is the same characters - * that are expressible in ASCII, plus the C1 controls. So there are 160 - * invariants instead of the 128 in UTF-8. + * The EBCDIC invariants have been chosen to be those characters whose + * Unicode equivalents have ordinal numbers less than 160, that is the same + * characters that are expressible in ASCII, plus the C1 controls. So there + * are 160 invariants instead of the 128 in UTF-8. * - * The purpose of Step 3 is to make the encoding be invariant for the chosen - * characters. This messes up the convenient patterns found in step 2, so - * generally, one has to undo step 3 into a temporary to use them, using the - * macro NATIVE_TO_I8(). However, one "shadow", or parallel table, - * PL_utf8skip, has been constructed that doesn't require undoing things. It - * is such that for each byte, it says how long the sequence is if that - * (UTF-EBCDIC) byte were to begin it. + * The purpose of Step 3 is to make the encoding be invariant for the chosen + * characters. This messes up the convenient patterns found in step 2, so + * generally, one has to undo step 3 into a temporary to use them, using the + * macro NATIVE_TO_I8(). However, one "shadow", or parallel table, + * PL_utf8skip, has been constructed that doesn't require undoing things. + * It is such that for each byte, it says how long the sequence is if that + * (UTF-EBCDIC) byte were to begin it. * - * There are actually 3 slightly different UTF-EBCDIC encodings in - * ebcdic_tables.h, one for each of the code pages recognized by Perl. That - * means that there are actually three different sets of tables, one for each - * code page. (If Perl is compiled on platforms using another EBCDIC code - * page, it may not compile, or Perl may silently mistake it for one of the - * three.) + * There are actually 3 slightly different UTF-EBCDIC encodings in + * ebcdic_tables.h, one for each of the code pages recognized by Perl. + * That means that there are actually three different sets of tables, one + * for each code page. (If Perl is compiled on platforms using another + * EBCDIC code page, it may not compile, or Perl may silently mistake it for + * one of the three.) * - * Note that tr16 actually only specifies one version of UTF-EBCDIC, based on - * the 1047 encoding, and which is supposed to be used for all code pages. - * But this doesn't work. To illustrate the problem, consider the '^' character. - * On a 037 code page it is the single byte 176, whereas under 1047 UTF-EBCDIC - * it is the single byte 95. If Perl implemented tr16 exactly, it would mean - * that changing a string containing '^' to UTF-EBCDIC would change that '^' - * from 176 to 95 (and vice-versa), violating the rule that ASCII-range - * characters are the same in UTF-8 or not. Much code in Perl assumes this - * rule. See for example - * http://grokbase.com/t/perl/mvs/025xf0yhmn/utf-ebcdic-for-posix-bc-malformed-utf-8-character - * What Perl does is create a version of UTF-EBCDIC suited to each code page; - * the one for the 1047 code page is identical to what's specified in tr16. - * This complicates interchanging files between computers using different code - * pages. Best is to convert to I8 before sending them, as the I8 - * representation is the same no matter what the underlying code page is. + * Note that tr16 actually only specifies one version of UTF-EBCDIC, based + * on the 1047 encoding, and which is supposed to be used for all code + * pages. But this doesn't work. To illustrate the problem, consider the + * '^' character. On a 037 code page it is the single byte 176, whereas + * under 1047 UTF-EBCDIC it is the single byte 95. If Perl implemented tr16 + * exactly, it would mean that changing a string containing '^' to + * UTF-EBCDIC would change that '^' from 176 to 95 (and vice-versa), + * violating the rule that ASCII-range characters are the same in UTF-8 or + * not. Much code in Perl assumes this rule. See for example + * http://grokbase.com/t/perl/mvs/025xf0yhmn/utf-ebcdic-for-posix-bc-malformed-utf-8-character + * What Perl does is create a version of UTF-EBCDIC suited to each code + * page; the one for the 1047 code page is identical to what's specified in + * tr16. This complicates interchanging files between computers using + * different code pages. Best is to convert to I8 before sending them, as + * the I8 representation is the same no matter what the underlying code page + * is. * - * Because of the way UTF-EBCDIC is constructed, the lowest 32 code points that - * aren't equivalent to ASCII characters nor C1 controls form the set of - * continuation bytes; the remaining 64 non-ASCII, non-control code points form - * the potential start bytes, in order. (However, the first 5 of these lead to - * malformed overlongs, so there really are only 59 start bytes, and the first - * three of the 59 are the start bytes for the Latin1 range.) Hence the - * UTF-EBCDIC for the smallest variant code point, 0x160, will have likely 0x41 - * as its continuation byte, provided 0x41 isn't an ASCII or C1 equivalent. - * And its start byte will be the code point that is 37 (32+5) non-ASCII, - * non-control code points past it. (0 - 3F are controls, and 40 is SPACE, - * leaving 41 as the first potentially available one.) In contrast, on ASCII - * platforms, the first 64 (not 32) non-ASCII code points are the continuation - * bytes. And the first 2 (not 5) potential start bytes form overlong - * malformed sequences. + * Because of the way UTF-EBCDIC is constructed, the lowest 32 code points + * that aren't equivalent to ASCII characters nor C1 controls form the set + * of continuation bytes; the remaining 64 non-ASCII, non-control code + * points form the potential start bytes, in order. (However, the first 5 + * of these lead to malformed overlongs, so there really are only 59 start + * bytes, and the first three of the 59 are the start bytes for the Latin1 + * range.) Hence the UTF-EBCDIC for the smallest variant code point, 0x160, + * will have likely 0x41 as its continuation byte, provided 0x41 isn't an + * ASCII or C1 equivalent. And its start byte will be the code point that + * is 37 (32+5) non-ASCII, non-control code points past it. (0 - 3F are + * controls, and 40 is SPACE, leaving 41 as the first potentially available + * one.) In contrast, on ASCII platforms, the first 64 (not 32) non-ASCII + * code points are the continuation bytes. And the first 2 (not 5) + * potential start bytes form overlong malformed sequences. * - * EBCDIC characters above 0xFF are the same as Unicode in Perl's - * implementation of all 3 encodings, so for those Step 1 is trivial. + * EBCDIC characters above 0xFF are the same as Unicode in Perl's + * implementation of all 3 encodings, so for those Step 1 is trivial. * - * (Note that the entries for invariant characters are necessarily the same in - * PL_e2a and PL_e2utf; likewise for their inverses.) + * (Note that the entries for invariant characters are necessarily the same + * in PL_e2a and PL_e2utf; likewise for their inverses.) * - * UTF-EBCDIC strings are the same length or longer than UTF-8 representations - * of the same string. The maximum code point representable as 2 bytes in - * UTF-EBCDIC is 0x3FFF, instead of 0x7FFF in UTF-8. + * UTF-EBCDIC strings are the same length or longer than UTF-8 + * representations of the same string. The maximum code point representable + * as 2 bytes in UTF-EBCDIC is 0x3FFF, instead of 0x7FFF in UTF-8. */ START_EXTERN_C @@ -133,18 +129,22 @@ END_EXTERN_C /* EBCDIC-happy ways of converting native code to UTF-8 */ /* Use these when ch is known to be < 256 */ -#define NATIVE_TO_LATIN1(ch) (__ASSERT_(FITS_IN_8_BITS(ch)) PL_e2a[(U8)(ch)]) -#define LATIN1_TO_NATIVE(ch) (__ASSERT_(FITS_IN_8_BITS(ch)) PL_a2e[(U8)(ch)]) +#define NATIVE_TO_LATIN1(ch) \ + (__ASSERT_(FITS_IN_8_BITS(ch)) PL_e2a[(U8)(ch)]) +#define LATIN1_TO_NATIVE(ch) \ + (__ASSERT_(FITS_IN_8_BITS(ch)) PL_a2e[(U8)(ch)]) /* Use these on bytes */ -#define NATIVE_UTF8_TO_I8(b) (__ASSERT_(FITS_IN_8_BITS(b)) PL_e2utf[(U8)(b)]) -#define I8_TO_NATIVE_UTF8(b) (__ASSERT_(FITS_IN_8_BITS(b)) PL_utf2e[(U8)(b)]) +#define NATIVE_UTF8_TO_I8(b) \ + (__ASSERT_(FITS_IN_8_BITS(b)) PL_e2utf[(U8)(b)]) +#define I8_TO_NATIVE_UTF8(b) \ + (__ASSERT_(FITS_IN_8_BITS(b)) PL_utf2e[(U8)(b)]) /* Transforms in wide UV chars */ -#define NATIVE_TO_UNI(ch) \ - (FITS_IN_8_BITS(ch) ? NATIVE_TO_LATIN1(ch) : (UV) (ch)) -#define UNI_TO_NATIVE(ch) \ - (FITS_IN_8_BITS(ch) ? LATIN1_TO_NATIVE(ch) : (UV) (ch)) +#define NATIVE_TO_UNI(ch) \ + (FITS_IN_8_BITS(ch) ? NATIVE_TO_LATIN1(ch) : (UV) (ch)) +#define UNI_TO_NATIVE(ch) \ + (FITS_IN_8_BITS(ch) ? LATIN1_TO_NATIVE(ch) : (UV) (ch)) /* The following table is adapted from tr16, it shows the I8 encoding of Unicode code points. @@ -180,14 +180,14 @@ above what a 64 bit word can hold U+8000..U+D7FF F1 A0..B5 A0..BF A0..BF U+D800..U+DFFF F1 B6..B7 A0..BF A0..BF (surrogates) U+E000..U+FFFF F1 B8..BF A0..BF A0..BF - U+10000..U+3FFFF F2..F7 A0..BF A0..BF A0..BF - U+40000..U+FFFFF F8 * A8..BF A0..BF A0..BF A0..BF - U+100000..U+10FFFF F9 A0..A1 A0..BF A0..BF A0..BF + U+10000..U+3FFFF F2..F7 A0..BF A0..BF A0..BF + U+40000..U+FFFFF F8 * A8..BF A0..BF A0..BF A0..BF + U+100000..U+10FFFF F9 A0..A1 A0..BF A0..BF A0..BF Below are above-Unicode code points - U+110000..U+1FFFFF F9 A2..BF A0..BF A0..BF A0..BF - U+200000..U+3FFFFF FA..FB A0..BF A0..BF A0..BF A0..BF - U+400000..U+1FFFFFF FC * A4..BF A0..BF A0..BF A0..BF A0..BF -U+2000000..U+3FFFFFF FD A0..BF A0..BF A0..BF A0..BF A0..BF + U+110000..U+1FFFFF F9 A2..BF A0..BF A0..BF A0..BF + U+200000..U+3FFFFF FA..FB A0..BF A0..BF A0..BF A0..BF + U+400000..U+1FFFFFF FC * A4..BF A0..BF A0..BF A0..BF A0..BF +U+2000000..U+3FFFFFF FD A0..BF A0..BF A0..BF A0..BF A0..BF U+4000000..U+3FFFFFFF FE * A2..BF A0..BF A0..BF A0..BF A0..BF A0..BF U+40000000.. FF A0..BF A0..BF A0..BF A0..BF A0..BF A0..BF * A1..BF A0..BF @@ -197,12 +197,12 @@ possible to UTF-8-encode a single code point in different ways, but that is explicitly forbidden, and the shortest possible encoding should always be used (and that is what Perl does). */ -#define UTF_CONTINUATION_BYTE_INFO_BITS UTF_EBCDIC_CONTINUATION_BYTE_INFO_BITS +#define UTF_CONTINUATION_BYTE_INFO_BITS UTF_EBCDIC_CONTINUATION_BYTE_INFO_BITS -/* ^? is defined to be APC on EBCDIC systems, as specified in Unicode Technical - * Report #16. See the definition of toCTRL() for more */ -#define QUESTION_MARK_CTRL LATIN1_TO_NATIVE(0x9F) +/* ^? is defined to be APC on EBCDIC systems, as specified in Unicode + * Technical Report #16. See the definition of toCTRL() for more */ +#define QUESTION_MARK_CTRL LATIN1_TO_NATIVE(0x9F) /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/util.h b/util.h index d9b61611e484..3c0b62d5d6b4 100644 --- a/util.h +++ b/util.h @@ -1,11 +1,11 @@ /* util.h * * Copyright (C) 1991, 1992, 1993, 1999, 2001, 2002, 2003, 2004, 2005, - * 2007, by Larry Wall and others + * 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, + * 2018, 2019, 2020, 2021, 2022 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. - * */ #ifndef PERL_UTIL_H_ @@ -13,22 +13,21 @@ #ifdef VMS -# define PERL_FILE_IS_ABSOLUTE(f) \ - (*(f) == '/' \ - || (strchr(f,':') \ - || ((*(f) == '[' || *(f) == '<') \ - && (isWORDCHAR((f)[1]) || memCHRs("$-_]>",(f)[1]))))) +# define PERL_FILE_IS_ABSOLUTE(f) \ + (*(f) == '/' \ + || (strchr(f,':') \ + || ((*(f) == '[' || *(f) == '<') \ + && (isWORDCHAR((f)[1]) || memCHRs("$-_]>",(f)[1]))))) #elif defined(WIN32) || defined(__CYGWIN__) -# define PERL_FILE_IS_ABSOLUTE(f) \ - (*(f) == '/' || *(f) == '\\' /* UNC/rooted path */ \ - || ((f)[0] && (f)[1] == ':')) /* drive name */ +# define PERL_FILE_IS_ABSOLUTE(f) \ + (*(f) == '/' || *(f) == '\\' /* UNC/rooted path */ \ + || ((f)[0] && (f)[1] == ':')) /* drive name */ #elif defined(DOSISH) -# define PERL_FILE_IS_ABSOLUTE(f) \ - (*(f) == '/' \ - || ((f)[0] && (f)[1] == ':')) /* drive name */ -#else /* NOT DOSISH */ -# define PERL_FILE_IS_ABSOLUTE(f) (*(f) == '/') +# define PERL_FILE_IS_ABSOLUTE(f) \ + (*(f) == '/' || ((f)[0] && (f)[1] == ':')) /* drive name */ +#else /* NOT DOSISH */ +# define PERL_FILE_IS_ABSOLUTE(f) (*(f) == '/') #endif /* @@ -48,14 +47,14 @@ This is a synonym for S> =cut */ -#define ibcmp(s1, s2, len) cBOOL(! foldEQ(s1, s2, len)) -#define ibcmp_locale(s1, s2, len) cBOOL(! foldEQ_locale(s1, s2, len)) -#define ibcmp_utf8(s1, pe1, l1, u1, s2, pe2, l2, u2) \ - cBOOL(! foldEQ_utf8(s1, pe1, l1, u1, s2, pe2, l2, u2)) - -/* outside the core, perl.h undefs HAS_QUAD if IV isn't 64-bit - We can't swap this to HAS_QUAD, because the logic here affects the type of - perl_drand48_t below, and that is visible outside of the core. */ +#define ibcmp(s1, s2, len) cBOOL(! foldEQ(s1, s2, len)) +#define ibcmp_locale(s1, s2, len) cBOOL(! foldEQ_locale(s1, s2, len)) +#define ibcmp_utf8(s1, pe1, l1, u1, s2, pe2, l2, u2) \ + cBOOL(! foldEQ_utf8(s1, pe1, l1, u1, s2, pe2, l2, u2)) + +/* outside the core, perl.h undefs HAS_QUAD if IV isn't 64-bit We can't + swap this to HAS_QUAD, because the logic here affects the type of + perl_drand48_t below, and that is visible outside of the core. */ #if defined(U64TYPE) /* use a faster implementation when quads are available */ # define PERL_DRAND48_QUAD @@ -78,15 +77,15 @@ typedef struct PERL_DRAND48_T perl_drand48_t; #endif -#define PL_RANDOM_STATE_TYPE perl_drand48_t +#define PL_RANDOM_STATE_TYPE perl_drand48_t -#define Perl_drand48_init(seed) (Perl_drand48_init_r(&PL_random_state, (seed))) -#define Perl_drand48() (Perl_drand48_r(&PL_random_state)) +#define Perl_drand48_init(seed) (Perl_drand48_init_r(&PL_random_state, (seed))) +#define Perl_drand48() (Perl_drand48_r(&PL_random_state)) #ifdef PERL_CORE -/* uses a different source of randomness to avoid interfering with the results - * of rand() */ -#define Perl_internal_drand48() (Perl_drand48_r(&PL_internal_random_state)) +/* uses a different source of randomness to avoid + * interfering with the results of rand() */ +#define Perl_internal_drand48() (Perl_drand48_r(&PL_internal_random_state)) #endif #ifdef USE_C_BACKTRACE @@ -94,16 +93,16 @@ typedef struct PERL_DRAND48_T perl_drand48_t; typedef struct { /* The number of frames returned. */ UV frame_count; - /* The total size of the Perl_c_backtrace, including this header, - * the frames, and the name strings. */ + /* The total size of the Perl_c_backtrace, including this + * header, the frames, and the name strings. */ UV total_bytes; } Perl_c_backtrace_header; typedef struct { void* addr; /* the program counter at this frame */ - /* We could use Dl_info (as used by dladdr()) for many of these but - * that would be naughty towards non-dlfcn systems (hi there, Win32). */ + /* We could use Dl_info (as used by dladdr()) for many of these but that + * would be naughty towards non-dlfcn systems (hi there, Win32). */ void* symbol_addr; /* symbol address (hint: try symbol_addr - addr) */ void* object_base_addr; /* base address of the shared object */ @@ -118,23 +117,21 @@ typedef struct { STRLEN source_name_size; /* length of the source code file name */ STRLEN source_line_number; /* source code line number */ - /* OS X notes: atos(1) (more recently, "xcrun atos"), but the C - * API atos() uses is unknown (private "Symbolicator" framework, - * might require Objective-C even if the API would be known). - * Currently we open read pipe to "xcrun atos" and parse the - * output - quite disgusting. And that won't work if the - * Developer Tools isn't installed. */ + /* OS X notes: atos(1) (more recently, "xcrun atos"), but the C API atos() + * uses is unknown (private "Symbolicator" framework, might require + * Objective-C even if the API would be known). Currently we open read + * pipe to "xcrun atos" and parse the output - quite disgusting. And that + * won't work if the Developer Tools isn't installed. */ - /* FreeBSD notes: execinfo.h exists, but probably would need also - * the library -lexecinfo. BFD exists if the pkg devel/binutils - * has been installed, but there seems to be a known problem that - * the "bfd.h" getting installed refers to "ansidecl.h", which - * doesn't get installed. */ + /* FreeBSD notes: execinfo.h exists, but probably would need + * also the library -lexecinfo. BFD exists if the pkg + * devel/binutils has been installed, but there seems to be a + * known problem that the "bfd.h" getting installed refers + * to "ansidecl.h", which doesn't get installed. */ - /* Win32 notes: as moral equivalents of backtrace() + dladdr(), - * one could possibly first use GetCurrentProcess() + - * SymInitialize(), and then CaptureStackBackTrace() + - * SymFromAddr(). */ + /* Win32 notes: as moral equivalents of backtrace() + dladdr(), one + * could possibly first use GetCurrentProcess() + SymInitialize(), + * and then CaptureStackBackTrace() + SymFromAddr(). */ /* Note that using the compiler optimizer easily leads into much * of this information, like the symbol names (think inlining), @@ -143,94 +140,101 @@ typedef struct { * * Note that for example with gcc you can do both -O and -g. * - * Note, however, that on some platforms (e.g. OSX + clang (cc)) - * backtrace() + dladdr() works fine without -g. */ + * Note, however, that on some platforms (e.g. OSX + clang + * (cc)) backtrace() + dladdr() works fine without -g. */ - /* For example: the mere presence of is no guarantee: e.g. - * OS X has that, but BFD does not seem to work on the OSX executables. + /* For example: the mere presence of is no guarantee: e.g. OS + * X has that, but BFD does not seem to work on the OSX executables. * - * Another niceness would be to able to see something about - * the function arguments, however gdb/lldb manage to do that. */ + * Another niceness would be to able to see something about the function + * arguments, however gdb/lldb manage to do that. */ } Perl_c_backtrace_frame; typedef struct { Perl_c_backtrace_header header; Perl_c_backtrace_frame frame_info[1]; - /* After the header come: - * (1) header.frame_count frames - * (2) frame_count times the \0-terminated strings (object_name - * and so forth). The frames contain the pointers to the starts - * of these strings, and the lengths of these strings. */ + /* After the header come: (1) header.frame_count frames (2) + * frame_count times the \0-terminated strings (object_name and + * so forth). The frames contain the pointers to the starts of + * these strings, and the lengths of these strings. */ } Perl_c_backtrace; -#define Perl_free_c_backtrace(bt) Safefree(bt) +#define Perl_free_c_backtrace(bt) Safefree(bt) #endif /* USE_C_BACKTRACE */ -/* Use a packed 32 bit constant "key" to start the handshake. The key defines +/* Use a packed 32 bit constant "key" to start the handshake. The key defines ABI compatibility, and how to process the vararg list. - Note, some bits may be taken from INTRPSIZE (but then a simple x86 AX register - can't be used to read it) and 4 bits from API version len can also be taken, - since v00.00.00 is 9 bytes long. XS version length should not have any bits - taken since XS_VERSION lengths can get quite long since they are user - selectable. These spare bits allow for additional features for the varargs - stuff or ABI compat test flags in the future. -*/ -#define HSm_APIVERLEN 0x0000001F /* perl version string won't be more than 31 chars */ -#define HS_APIVERLEN_MAX HSm_APIVERLEN -#define HSm_XSVERLEN 0x0000FF00 /* if 0, not present, dont check, die if over 255*/ -#define HS_XSVERLEN_MAX 0xFF + Note, some bits may be taken from INTRPSIZE (but then a simple x86 AX + register can't be used to read it) and 4 bits from API version len can also + be taken, since v00.00.00 is 9 bytes long. XS version length should not + have any bits taken since XS_VERSION lengths can get quite long since they + are user selectable. These spare bits allow for additional features for + the varargs stuff or ABI compat test flags in the future. + */ +#define HSm_APIVERLEN 0x0000001F /* perl version string won't + be more than 31 chars */ +#define HS_APIVERLEN_MAX HSm_APIVERLEN +#define HSm_XSVERLEN 0x0000FF00 /* if 0, not present, dont check, + die if over 255 */ +#define HS_XSVERLEN_MAX 0xFF /* uses var file to set default filename for newXS_deffile to use for CvFILE */ -#define HSf_SETXSUBFN 0x00000020 -#define HSf_POPMARK 0x00000040 /* popmark mode or you must supply ax and items */ -#define HSf_IMP_CXT 0x00000080 /* ABI, threaded, MULTIPLICITY, pTHX_ present */ -#define HSm_INTRPSIZE 0xFFFF0000 /* ABI, interp struct size */ -/* A mask of bits in the key which must always match between a XS mod and interp. - Also if all ABI bits in a key are true, skip all ABI checks, it is very - the unlikely interp size will all 1 bits */ -/* Maybe HSm_APIVERLEN one day if Perl_xs_apiversion_bootcheck is changed to a memcmp */ -#define HSm_KEY_MATCH (HSm_INTRPSIZE|HSf_IMP_CXT) -#define HSf_NOCHK HSm_KEY_MATCH /* if all ABI bits are 1 in the key, dont chk */ - - -#define HS_GETINTERPSIZE(key) ((key) >> 16) -/* if in the future "" and NULL must be separated, XSVERLEN would be 0 -means arg not present, 1 is empty string/null byte */ +#define HSf_SETXSUBFN 0x00000020 +#define HSf_POPMARK 0x00000040 /* popmark mode or you must + supply ax and items */ +#define HSf_IMP_CXT 0x00000080 /* ABI, threaded, MULTIPLICITY, + pTHX_ present */ +#define HSm_INTRPSIZE 0xFFFF0000 /* ABI, interp struct size */ +/* A mask of bits in the key which must always match between a XS mod + and interp. Also if all ABI bits in a key are true, skip all ABI + checks, it is very the unlikely interp size will all 1 bits */ +/* Maybe HSm_APIVERLEN one day if Perl_xs_apiversion_bootcheck + is changed to a memcmp */ +#define HSm_KEY_MATCH (HSm_INTRPSIZE|HSf_IMP_CXT) +#define HSf_NOCHK HSm_KEY_MATCH /* if all ABI bits + are 1 in the key, + dont chk */ + + +#define HS_GETINTERPSIZE(key) ((key) >> 16) +/* if in the future "" and NULL must be separated, XSVERLEN would + be 0 means arg not present, 1 is empty string/null byte */ /* (((key) & 0x0000FF00) >> 8) is less efficient on Visual C */ -#define HS_GETXSVERLEN(key) ((U8) ((key) >> 8)) -#define HS_GETAPIVERLEN(key) ((key) & HSm_APIVERLEN) - -/* internal to util.h macro to create a packed handshake key, all args must be constants */ -/* U32 return = (U16 interpsize, bool cxt, bool setxsubfn, bool popmark, - U5 (FIVE!) apiverlen, U8 xsverlen) */ -#define HS_KEYp(interpsize, cxt, setxsubfn, popmark, apiverlen, xsverlen) \ - (((interpsize) << 16) \ - | ((xsverlen) > HS_XSVERLEN_MAX \ - ? (Perl_croak_nocontext("panic: handshake overflow"), HS_XSVERLEN_MAX) \ - : (xsverlen) << 8) \ - | (cBOOL(setxsubfn) ? HSf_SETXSUBFN : 0) \ - | (cBOOL(cxt) ? HSf_IMP_CXT : 0) \ - | (cBOOL(popmark) ? HSf_POPMARK : 0) \ - | ((apiverlen) > HS_APIVERLEN_MAX \ +#define HS_GETXSVERLEN(key) ((U8) ((key) >> 8)) +#define HS_GETAPIVERLEN(key) ((key) & HSm_APIVERLEN) + +/* internal to util.h macro to create a packed handshake + key, all args must be constants */ +/* U32 return = (U16 interpsize, bool cxt, bool setxsubfn, + bool popmark, U5 (FIVE!) apiverlen, U8 xsverlen) */ +#define HS_KEYp(interpsize, cxt, setxsubfn, popmark, apiverlen, xsverlen) \ + (((interpsize) << 16) \ + | ((xsverlen) > HS_XSVERLEN_MAX \ + ? (Perl_croak_nocontext("panic: handshake overflow"), HS_XSVERLEN_MAX) \ + : (xsverlen) << 8) \ + | (cBOOL(setxsubfn) ? HSf_SETXSUBFN : 0) \ + | (cBOOL(cxt) ? HSf_IMP_CXT : 0) \ + | (cBOOL(popmark) ? HSf_POPMARK : 0) \ + | ((apiverlen) > HS_APIVERLEN_MAX \ ? (Perl_croak_nocontext("panic: handshake overflow"), HS_APIVERLEN_MAX) \ : (apiverlen))) /* overflows above will optimize away unless they will execute */ -/* public macro for core usage to create a packed handshake key but this is - not public API. This more friendly version already collected all ABI info */ +/* public macro for core usage to create a packed handshake key but this is not + public API. This more friendly version already collected all ABI info */ /* U32 return = (bool setxsubfn, bool popmark, "litteral_string_api_ver", "litteral_string_xs_ver") */ #ifdef MULTIPLICITY -# define HS_KEY(setxsubfn, popmark, apiver, xsver) \ - HS_KEYp(sizeof(PerlInterpreter), TRUE, setxsubfn, popmark, \ - sizeof("" apiver "")-1, sizeof("" xsver "")-1) -# define HS_CXT aTHX +# define HS_KEY(setxsubfn, popmark, apiver, xsver) \ + HS_KEYp(sizeof(PerlInterpreter), TRUE, setxsubfn, popmark, \ + sizeof("" apiver "")-1, sizeof("" xsver "")-1) +# define HS_CXT aTHX #else -# define HS_KEY(setxsubfn, popmark, apiver, xsver) \ - HS_KEYp(sizeof(struct PerlHandShakeInterpreter), FALSE, setxsubfn, popmark, \ - sizeof("" apiver "")-1, sizeof("" xsver "")-1) -# define HS_CXT cv +# define HS_KEY(setxsubfn, popmark, apiver, xsver) \ + HS_KEYp(sizeof(struct PerlHandShakeInterpreter), FALSE, setxsubfn, popmark, \ + sizeof("" apiver "")-1, sizeof("" xsver "")-1) +# define HS_CXT cv #endif /* @@ -246,13 +250,13 @@ returning NULL if not found. The terminating NUL bytes are not compared. #define instr(haystack, needle) strstr((char *) haystack, (char *) needle) #ifdef HAS_MEMMEM -# define ninstr(big, bigend, little, lend) \ - (__ASSERT_(bigend >= big) \ - __ASSERT_(lend >= little) \ - (char *) memmem((big), (bigend) - (big), \ - (little), (lend) - (little))) +# define ninstr(big, bigend, little, lend) \ + (__ASSERT_(bigend >= big) \ + __ASSERT_(lend >= little) \ + (char *) memmem((big), (bigend) - (big), \ + (little), (lend) - (little))) #else -# define ninstr(a,b,c,d) Perl_ninstr(a,b,c,d) +# define ninstr(a,b,c,d) Perl_ninstr(a,b,c,d) #endif #ifdef __Lynx__ @@ -263,23 +267,23 @@ int mkstemp(char*); #ifdef PERL_CORE # if defined(VMS) /* only useful for calls to our mkostemp() emulation */ -# define O_VMS_DELETEONCLOSE 0x40000000 +# define O_VMS_DELETEONCLOSE 0x40000000 # ifdef HAS_MKOSTEMP # error 134221 will need a new solution for VMS # endif # else -# define O_VMS_DELETEONCLOSE 0 +# define O_VMS_DELETEONCLOSE 0 # endif #endif #if defined(HAS_MKOSTEMP) && defined(PERL_CORE) # define Perl_my_mkostemp(templte, flags) mkostemp(templte, flags) #endif #if defined(HAS_MKSTEMP) && defined(PERL_CORE) -# define Perl_my_mkstemp(templte) mkstemp(templte) +# define Perl_my_mkstemp(templte) mkstemp(templte) #endif #endif /* PERL_UTIL_H_ */ /* * ex: set ts=8 sts=4 sw=4 et: - */ +*/ diff --git a/vutil.h b/vutil.h index 9484e2548389..d534991991b4 100644 --- a/vutil.h +++ b/vutil.h @@ -1,5 +1,5 @@ -/* This file is part of the "version" CPAN distribution. Please avoid - editing it in the perl core. */ +/* This file is part of the "version" CPAN distribution. + Please avoid editing it in the perl core. */ /* The MUTABLE_*() macros cast pointers to the types shown, in such a way * (compiler permitting) that casting away const-ness will give a warning; @@ -11,14 +11,15 @@ */ #if PERL_VERSION_LT(5,15,4) -# define ISA_VERSION_OBJ(v) (sv_isobject(v) && sv_derived_from(v,"version")) +# define ISA_VERSION_OBJ(v) (sv_isobject(v) && sv_derived_from(v,"version")) #else -# define ISA_VERSION_OBJ(v) (sv_isobject(v) && sv_derived_from_pvn(v,"version",7,0)) +# define ISA_VERSION_OBJ(v) \ + (sv_isobject(v) && sv_derived_from_pvn(v,"version",7,0)) #endif #if PERL_VERSION_GE(5,9,0) && !defined(PERL_CORE) -# define VUTIL_REPLACE_CORE 1 +# define VUTIL_REPLACE_CORE 1 static const char * Perl_scan_version2(pTHX_ const char *s, SV *rv, bool qv); static SV * Perl_new_version2(pTHX_ SV *ver); @@ -31,21 +32,22 @@ static SV * Perl_vstringify2(pTHX_ SV *vs); static int Perl_vcmp2(pTHX_ SV *lsv, SV *rsv); static const char * Perl_prescan_version2(pTHX_ const char *s, bool strict, const char** errstr, bool *sqv, int *ssaw_decimal, int *swidth, bool *salpha); -# define SCAN_VERSION(a,b,c) Perl_scan_version2(aTHX_ a,b,c) -# define NEW_VERSION(a) Perl_new_version2(aTHX_ a) -# define UPG_VERSION(a,b) Perl_upg_version2(aTHX_ a, b) -# define VSTRINGIFY(a) Perl_vstringify2(aTHX_ a) -# define VVERIFY(a) Perl_vverify2(aTHX_ a) -# define VNUMIFY(a) Perl_vnumify2(aTHX_ a) -# define VNORMAL(a) Perl_vnormal2(aTHX_ a) -# define VCMP(a,b) Perl_vcmp2(aTHX_ a,b) -# define PRESCAN_VERSION(a,b,c,d,e,f,g) Perl_prescan_version2(aTHX_ a,b,c,d,e,f,g) +# define SCAN_VERSION(a,b,c) Perl_scan_version2(aTHX_ a,b,c) +# define NEW_VERSION(a) Perl_new_version2(aTHX_ a) +# define UPG_VERSION(a,b) Perl_upg_version2(aTHX_ a, b) +# define VSTRINGIFY(a) Perl_vstringify2(aTHX_ a) +# define VVERIFY(a) Perl_vverify2(aTHX_ a) +# define VNUMIFY(a) Perl_vnumify2(aTHX_ a) +# define VNORMAL(a) Perl_vnormal2(aTHX_ a) +# define VCMP(a,b) Perl_vcmp2(aTHX_ a,b) +# define PRESCAN_VERSION(a,b,c,d,e,f,g) \ + Perl_prescan_version2(aTHX_ a,b,c,d,e,f,g) # undef is_LAX_VERSION -# define is_LAX_VERSION(a,b) \ - (a != Perl_prescan_version2(aTHX_ a, FALSE, b, NULL, NULL, NULL, NULL)) +# define is_LAX_VERSION(a,b) \ + (a != Perl_prescan_version2(aTHX_ a, FALSE, b, NULL, NULL, NULL, NULL)) # undef is_STRICT_VERSION -# define is_STRICT_VERSION(a,b) \ - (a != Perl_prescan_version2(aTHX_ a, TRUE, b, NULL, NULL, NULL, NULL)) +# define is_STRICT_VERSION(a,b) \ + (a != Perl_prescan_version2(aTHX_ a, TRUE, b, NULL, NULL, NULL, NULL)) #else @@ -59,56 +61,57 @@ SV * Perl_vstringify(pTHX_ SV *vs); int Perl_vcmp(pTHX_ SV *lsv, SV *rsv); const char * Perl_prescan_version(pTHX_ const char *s, bool strict, const char** errstr, bool *sqv, int *ssaw_decimal, int *swidth, bool *salpha); -# define SCAN_VERSION(a,b,c) Perl_scan_version(aTHX_ a,b,c) -# define NEW_VERSION(a) Perl_new_version(aTHX_ a) -# define UPG_VERSION(a,b) Perl_upg_version(aTHX_ a, b) -# define VSTRINGIFY(a) Perl_vstringify(aTHX_ a) -# define VVERIFY(a) Perl_vverify(aTHX_ a) -# define VNUMIFY(a) Perl_vnumify(aTHX_ a) -# define VNORMAL(a) Perl_vnormal(aTHX_ a) -# define VCMP(a,b) Perl_vcmp(aTHX_ a,b) +# define SCAN_VERSION(a,b,c) Perl_scan_version(aTHX_ a,b,c) +# define NEW_VERSION(a) Perl_new_version(aTHX_ a) +# define UPG_VERSION(a,b) Perl_upg_version(aTHX_ a, b) +# define VSTRINGIFY(a) Perl_vstringify(aTHX_ a) +# define VVERIFY(a) Perl_vverify(aTHX_ a) +# define VNUMIFY(a) Perl_vnumify(aTHX_ a) +# define VNORMAL(a) Perl_vnormal(aTHX_ a) +# define VCMP(a,b) Perl_vcmp(aTHX_ a,b) -# define PRESCAN_VERSION(a,b,c,d,e,f,g) Perl_prescan_version(aTHX_ a,b,c,d,e,f,g) +# define PRESCAN_VERSION(a,b,c,d,e,f,g) \ + Perl_prescan_version(aTHX_ a,b,c,d,e,f,g) # ifndef is_LAX_VERSION # define is_LAX_VERSION(a,b) \ - (a != Perl_prescan_version(aTHX_ a, FALSE, b, NULL, NULL, NULL, NULL)) + (a != Perl_prescan_version(aTHX_ a, FALSE, b, NULL, NULL, NULL, NULL)) # endif # ifndef is_STRICT_VERSION -# define is_STRICT_VERSION(a,b) \ - (a != Perl_prescan_version(aTHX_ a, TRUE, b, NULL, NULL, NULL, NULL)) +# define is_STRICT_VERSION(a,b) \ + (a != Perl_prescan_version(aTHX_ a, TRUE, b, NULL, NULL, NULL, NULL)) # endif #endif #if PERL_VERSION_LT(5,11,4) # define BADVERSION(a,b,c) \ - if (b) { \ - *b = c; \ - } \ - return a; + if (b) { \ + *b = c; \ + } \ + return a; -# define PERL_ARGS_ASSERT_PRESCAN_VERSION \ - assert(s); assert(sqv); assert(ssaw_decimal);\ - assert(swidth); assert(salpha); +# define PERL_ARGS_ASSERT_PRESCAN_VERSION \ + assert(s); assert(sqv); assert(ssaw_decimal); \ + assert(swidth); assert(salpha); -# define PERL_ARGS_ASSERT_SCAN_VERSION \ - assert(s); assert(rv) -# define PERL_ARGS_ASSERT_NEW_VERSION \ - assert(ver) -# define PERL_ARGS_ASSERT_UPG_VERSION \ - assert(ver) -# define PERL_ARGS_ASSERT_VVERIFY \ - assert(vs) -# define PERL_ARGS_ASSERT_VNUMIFY \ - assert(vs) -# define PERL_ARGS_ASSERT_VNORMAL \ - assert(vs) -# define PERL_ARGS_ASSERT_VSTRINGIFY \ - assert(vs) -# define PERL_ARGS_ASSERT_VCMP \ - assert(lhv); assert(rhv) -# define PERL_ARGS_ASSERT_CK_WARNER \ - assert(pat) +# define PERL_ARGS_ASSERT_SCAN_VERSION \ + assert(s); assert(rv) +# define PERL_ARGS_ASSERT_NEW_VERSION \ + assert(ver) +# define PERL_ARGS_ASSERT_UPG_VERSION \ + assert(ver) +# define PERL_ARGS_ASSERT_VVERIFY \ + assert(vs) +# define PERL_ARGS_ASSERT_VNUMIFY \ + assert(vs) +# define PERL_ARGS_ASSERT_VNORMAL \ + assert(vs) +# define PERL_ARGS_ASSERT_VSTRINGIFY \ + assert(vs) +# define PERL_ARGS_ASSERT_VCMP \ + assert(lhv); assert(rhv) +# define PERL_ARGS_ASSERT_CK_WARNER \ + assert(pat) #endif /* ex: set ro: */ diff --git a/zaphod32_hash.h b/zaphod32_hash.h index 834d8cb3fd84..6d71c550754f 100644 --- a/zaphod32_hash.h +++ b/zaphod32_hash.h @@ -1,21 +1,22 @@ #ifndef DEBUG_ZAPHOD32_HASH -#define DEBUG_ZAPHOD32_HASH 0 +#define DEBUG_ZAPHOD32_HASH 0 #if DEBUG_ZAPHOD32_HASH == 1 #include -#define ZAPHOD32_WARN6(pat,v0,v1,v2,v3,v4,v5) printf(pat, v0, v1, v2, v3, v4, v5) -#define ZAPHOD32_WARN5(pat,v0,v1,v2,v3,v4) printf(pat, v0, v1, v2, v3, v4) -#define ZAPHOD32_WARN4(pat,v0,v1,v2,v3) printf(pat, v0, v1, v2, v3) -#define ZAPHOD32_WARN3(pat,v0,v1,v2) printf(pat, v0, v1, v2) -#define ZAPHOD32_WARN2(pat,v0,v1) printf(pat, v0, v1) -#define NOTE3(pat,v0,v1,v2) printf(pat, v0, v1, v2) +#define ZAPHOD32_WARN6(pat,v0,v1,v2,v3,v4,v5) \ + printf(pat, v0, v1, v2, v3, v4, v5) +#define ZAPHOD32_WARN5(pat,v0,v1,v2,v3,v4) printf(pat, v0, v1, v2, v3, v4) +#define ZAPHOD32_WARN4(pat,v0,v1,v2,v3) printf(pat, v0, v1, v2, v3) +#define ZAPHOD32_WARN3(pat,v0,v1,v2) printf(pat, v0, v1, v2) +#define ZAPHOD32_WARN2(pat,v0,v1) printf(pat, v0, v1) +#define NOTE3(pat,v0,v1,v2) printf(pat, v0, v1, v2) #elif DEBUG_ZAPHOD32_HASH == 2 #define ZAPHOD32_WARN6(pat,v0,v1,v2,v3,v4,v5) #define ZAPHOD32_WARN5(pat,v0,v1,v2,v3,v4) #define ZAPHOD32_WARN4(pat,v0,v1,v2,v3) #define ZAPHOD32_WARN3(pat,v0,v1,v2) #define ZAPHOD32_WARN2(pat,v0,v1) -#define NOTE3(pat,v0,v1,v2) printf(pat, v0, v1, v2) +#define NOTE3(pat,v0,v1,v2) printf(pat, v0, v1, v2) #else #define ZAPHOD32_WARN6(pat,v0,v1,v2,v3,v4,v5) #define ZAPHOD32_WARN5(pat,v0,v1,v2,v3,v4) @@ -29,100 +30,104 @@ #ifndef ROTL32 #if defined(_MSC_VER) #include /* Microsoft put _rotl declaration in here */ -#define ROTL32(x,r) _rotl(x,r) -#define ROTR32(x,r) _rotr(x,r) +#define ROTL32(x,r) _rotl(x,r) +#define ROTR32(x,r) _rotr(x,r) #else -/* gcc recognises this code and generates a rotate instruction for CPUs with one */ -#define ROTL32(x,r) (((U32)(x) << (r)) | ((U32)(x) >> (32 - (r)))) -#define ROTR32(x,r) (((U32)(x) << (32 - (r))) | ((U32)(x) >> (r))) +/* gcc recognises this code and generates a + rotate instruction for CPUs with one */ +#define ROTL32(x,r) (((U32)(x) << (r)) | ((U32)(x) >> (32 - (r)))) +#define ROTR32(x,r) (((U32)(x) << (32 - (r))) | ((U32)(x) >> (r))) #endif #endif #ifndef PERL_SEEN_HV_FUNC_H_ #if !defined(U64) #include -#define U64 uint64_t +#define U64 uint64_t #endif #if !defined(U32) -#define U32 uint32_t +#define U32 uint32_t #endif #if !defined(U8) -#define U8 unsigned char +#define U8 unsigned char #endif #if !defined(U16) -#define U16 uint16_t +#define U16 uint16_t #endif #ifndef STRLEN -#define STRLEN int +#define STRLEN int #endif #endif #ifndef ZAPHOD32_STATIC_INLINE #ifdef PERL_STATIC_INLINE -#define ZAPHOD32_STATIC_INLINE PERL_STATIC_INLINE +#define ZAPHOD32_STATIC_INLINE PERL_STATIC_INLINE #else -#define ZAPHOD32_STATIC_INLINE static inline +#define ZAPHOD32_STATIC_INLINE static inline #endif #endif #ifndef STMT_START -#define STMT_START do -#define STMT_END while(0) +#define STMT_START do +#define STMT_END while(0) #endif /* This is two marsaglia xor-shift permutes, with a prime-multiple - * sandwiched inside. The end result of doing this twice with different - * primes is a completely avalanched v. */ -#define ZAPHOD32_SCRAMBLE32(v,prime) STMT_START { \ - v ^= (v>>9); \ - v ^= (v<<21); \ - v ^= (v>>16); \ - v *= prime; \ - v ^= (v>>17); \ - v ^= (v<<15); \ - v ^= (v>>23); \ -} STMT_END + * sandwiched inside. The end result of doing this twice with + * different primes is a completely avalanched v. */ +#define ZAPHOD32_SCRAMBLE32(v,prime) \ + STMT_START { \ + v ^= (v>>9); \ + v ^= (v<<21); \ + v ^= (v>>16); \ + v *= prime; \ + v ^= (v>>17); \ + v ^= (v<<15); \ + v ^= (v>>23); \ + } STMT_END -#define ZAPHOD32_FINALIZE(v0,v1,v2) STMT_START { \ - ZAPHOD32_WARN3("v0=%08x v1=%08x v2=%08x - ZAPHOD32 FINALIZE\n", \ - (unsigned int)v0, (unsigned int)v1, (unsigned int)v2); \ - v2 += v0; \ - v1 -= v2; \ - v1 = ROTL32(v1, 6); \ - v2 ^= v1; \ - v2 = ROTL32(v2, 28); \ - v1 ^= v2; \ - v0 += v1; \ - v1 = ROTL32(v1, 24); \ - v2 += v1; \ - v2 = ROTL32(v2, 18) + v1; \ - v0 ^= v2; \ - v0 = ROTL32(v0, 20); \ - v2 += v0; \ - v1 ^= v2; \ - v0 += v1; \ - v0 = ROTL32(v0, 5); \ - v2 += v0; \ - v2 = ROTL32(v2, 22); \ - v0 -= v1; \ - v1 -= v2; \ - v1 = ROTL32(v1, 17); \ -} STMT_END +#define ZAPHOD32_FINALIZE(v0,v1,v2) \ + STMT_START { \ + ZAPHOD32_WARN3("v0=%08x v1=%08x v2=%08x - ZAPHOD32 FINALIZE\n", \ + (unsigned int)v0, (unsigned int)v1, (unsigned int)v2); \ + v2 += v0; \ + v1 -= v2; \ + v1 = ROTL32(v1, 6); \ + v2 ^= v1; \ + v2 = ROTL32(v2, 28); \ + v1 ^= v2; \ + v0 += v1; \ + v1 = ROTL32(v1, 24); \ + v2 += v1; \ + v2 = ROTL32(v2, 18) + v1; \ + v0 ^= v2; \ + v0 = ROTL32(v0, 20); \ + v2 += v0; \ + v1 ^= v2; \ + v0 += v1; \ + v0 = ROTL32(v0, 5); \ + v2 += v0; \ + v2 = ROTL32(v2, 22); \ + v0 -= v1; \ + v1 -= v2; \ + v1 = ROTL32(v1, 17); \ + } STMT_END -#define ZAPHOD32_MIX(v0,v1,v2,text) STMT_START { \ - ZAPHOD32_WARN4("v0=%08x v1=%08x v2=%08x - ZAPHOD32 %s MIX\n", \ - (unsigned int)v0,(unsigned int)v1,(unsigned int)v2, text ); \ - v0 = ROTL32(v0,16) - v2; \ - v1 = ROTR32(v1,13) ^ v2; \ - v2 = ROTL32(v2,17) + v1; \ - v0 = ROTR32(v0, 2) + v1; \ - v1 = ROTR32(v1,17) - v0; \ - v2 = ROTR32(v2, 7) ^ v0; \ -} STMT_END +#define ZAPHOD32_MIX(v0,v1,v2,text) \ + STMT_START { \ + ZAPHOD32_WARN4("v0=%08x v1=%08x v2=%08x - ZAPHOD32 %s MIX\n", \ + (unsigned int)v0,(unsigned int)v1,(unsigned int)v2, text ); \ + v0 = ROTL32(v0,16) - v2; \ + v1 = ROTR32(v1,13) ^ v2; \ + v2 = ROTL32(v2,17) + v1; \ + v0 = ROTR32(v0, 2) + v1; \ + v1 = ROTR32(v1,17) - v0; \ + v2 = ROTR32(v2, 7) ^ v0; \ + } STMT_END ZAPHOD32_STATIC_INLINE @@ -132,7 +137,7 @@ void zaphod32_seed_state ( ) { const U32 *seed= (const U32 *)seed_ch; U32 *state= (U32 *)state_ch; - + /* hex expansion of PI, skipping first two digits. PI= 3.2[43f6...] * * PI value in hex from here: @@ -150,14 +155,14 @@ void zaphod32_seed_state ( if (!state[0]) state[0] = 1; if (!state[1]) state[1] = 2; if (!state[2]) state[2] = 4; - /* these are pseudo-randomly selected primes between 2**31 and 2**32 - * (I generated a big list and then randomly chose some from the list) */ + /* these are pseudo-randomly selected primes between 2**31 and 2**32 (I + * generated a big list and then randomly chose some from the list) */ ZAPHOD32_SCRAMBLE32(state[0],0x9fade23b); ZAPHOD32_SCRAMBLE32(state[1],0xaa6f908d); ZAPHOD32_SCRAMBLE32(state[2],0xcdf6b72d); - /* now that we have scrambled we do some mixing to avalanche the - * state bits to gether */ + /* now that we have scrambled we do some mixing + * to avalanche the state bits to gether */ ZAPHOD32_MIX(state[0],state[1],state[2],"ZAPHOD32 SEED-STATE A 1/4"); ZAPHOD32_MIX(state[0],state[1],state[2],"ZAPHOD32 SEED-STATE A 2/4"); ZAPHOD32_MIX(state[0],state[1],state[2],"ZAPHOD32 SEED-STATE A 3/4"); @@ -239,7 +244,7 @@ U32 zaphod32_hash_with_state( return v0 ^ v2; } -/* if (len >= 8) */ /* this block is only reached by a goto above, so this condition +/* if (len >= 8) */ /* this block is only reached by a goto above, so this condition is commented out, but if the above block is removed it would be necessary to use this. */ {