This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
add dVAR's for PERL_GLOBAL_STRUCT_PRIVATE builds
authorDavid Mitchell <davem@iabyn.com>
Wed, 26 Dec 2018 10:45:22 +0000 (10:45 +0000)
committerDavid Mitchell <davem@iabyn.com>
Tue, 19 Feb 2019 13:28:11 +0000 (13:28 +0000)
The perl build option -DPERL_GLOBAL_STRUCT_PRIVATE had bit-rotted
due to lack of smoking. The main fix is to just add 'dVAR;' to any
functions which have a pTHX arg. It's a NOOP on normal builds.

dump.c
locale.c
op.c
pp.c
regcomp.c
regexec.c
sv.c
toke.c
utf8.c
util.c
win32/win32.c

diff --git a/dump.c b/dump.c
index 98a307e..9de1941 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -1699,6 +1699,7 @@ const struct flag_to_name regexp_core_intflags_names[] = {
 void
 Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
 {
+    dVAR;
     SV *d;
     const char *s;
     U32 flags;
index e7348e1..a249f80 100644 (file)
--- a/locale.c
+++ b/locale.c
@@ -3162,6 +3162,8 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
      * values for our db, instead of trying to change them.
      * */
 
+    dVAR;
+
     int ok = 1;
 
 #ifndef USE_LOCALE
diff --git a/op.c b/op.c
index 5774044..8e7123d 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2650,6 +2650,7 @@ S_sprintf_is_multiconcatable(pTHX_ OP *o,struct sprintf_ismc_info *info)
 STATIC void
 S_maybe_multiconcat(pTHX_ OP *o)
 {
+    dVAR;
     OP *lastkidop;   /* the right-most of any kids unshifted onto o */
     OP *topop;       /* the top-most op in the concat tree (often equals o,
                         unless there are assign/stringify ops above it */
@@ -7822,6 +7823,7 @@ S_assignment_type(pTHX_ const OP *o)
 static OP *
 S_newONCEOP(pTHX_ OP *initop, OP *padop)
 {
+    dVAR;
     const PADOFFSET target = padop->op_targ;
     OP *const other = newOP(OP_PADSV,
                            padop->op_flags
diff --git a/pp.c b/pp.c
index 4cdf832..5965f1a 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -4034,6 +4034,7 @@ PP(pp_ucfirst)
 
 PP(pp_uc)
 {
+    dVAR;
     dSP;
     SV *source = TOPs;
     STRLEN len;
index 5949b88..f79e157 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -1560,6 +1560,7 @@ S_get_ANYOF_cp_list_for_ssc(pTHX_ const RExC_state_t *pRExC_state,
      * returned list must, and will, contain every code point that is a
      * possibility. */
 
+    dVAR;
     SV* invlist = NULL;
     SV* only_utf8_locale_invlist = NULL;
     unsigned int i;
@@ -4428,6 +4429,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
                        /* recursed: which subroutines have we recursed into */
                        /* and_withp: Valid if flags & SCF_DO_STCLASS_OR */
 {
+    dVAR;
     /* There must be at least this number of characters to match */
     SSize_t min = 0;
     I32 pars = 0, code;
@@ -7301,6 +7303,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
                    OP *expr, const regexp_engine* eng, REGEXP *old_re,
                     bool *is_bare_re, const U32 orig_rx_flags, const U32 pm_flags)
 {
+    dVAR;
     REGEXP *Rx;         /* Capital 'R' means points to a REGEXP */
     STRLEN plen;
     char *exp;
@@ -10528,6 +10531,7 @@ Perl__invlistEQ(pTHX_ SV* const a, SV* const b, const bool complement_b)
 STATIC SV*
 S__make_exactf_invlist(pTHX_ RExC_state_t *pRExC_state, regnode *node)
 {
+    dVAR;
     const U8 * s = (U8*)STRING(node);
     SSize_t bytelen = STR_LEN(node);
     UV uc;
@@ -13078,6 +13082,7 @@ S_backref_value(char *p, char *e)
 STATIC regnode_offset
 S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
 {
+    dVAR;
     regnode_offset ret = 0;
     I32 flags = 0;
     char *parse_start;
@@ -14576,6 +14581,8 @@ S_populate_ANYOF_from_invlist(pTHX_ regnode *node, SV** invlist_ptr)
      * sets up the bitmap and any flags, removing those code points from the
      * inversion list, setting it to NULL should it become completely empty */
 
+    dVAR;
+
     PERL_ARGS_ASSERT_POPULATE_ANYOF_FROM_INVLIST;
     assert(PL_regkind[OP(node)] == ANYOF);
 
@@ -16471,6 +16478,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
      * UTF-8
      */
 
+    dVAR;
     UV prevvalue = OOB_UNICODE, save_prevvalue = OOB_UNICODE;
     IV range = 0;
     UV value = OOB_UNICODE, save_value = OOB_UNICODE;
@@ -19897,6 +19905,7 @@ void
 Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_info *reginfo, const RExC_state_t *pRExC_state)
 {
 #ifdef DEBUGGING
+    dVAR;
     int k;
     RXi_GET_DECL(prog, progi);
     GET_RE_DEBUG_FLAGS_DECL;
@@ -21189,6 +21198,7 @@ S_put_charclass_bitmap_innards_common(pTHX_
      * output would have been only the inversion indicator '^', NULL is instead
      * returned. */
 
+    dVAR;
     SV * output;
 
     PERL_ARGS_ASSERT_PUT_CHARCLASS_BITMAP_INNARDS_COMMON;
@@ -21292,6 +21302,8 @@ S_put_charclass_bitmap_innards(pTHX_ SV *sv,
      * whether the class itself is to be inverted.  However,  there are some
      * cases where it can't try inverting, as what actually matches isn't known
      * until runtime, and hence the inversion isn't either. */
+
+    dVAR;
     bool inverting_allowed = ! force_as_is_display;
 
     int i;
@@ -21686,6 +21698,8 @@ S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node,
 void
 Perl_init_uniprops(pTHX)
 {
+    dVAR;
+
     PL_user_def_props = newHV();
 
 #ifdef USE_ITHREADS
@@ -22120,6 +22134,7 @@ S_delete_recursion_entry(pTHX_ void *key)
      * properties.  This is a function so it can be set up to be called even if
      * the program unexpectedly quits */
 
+    dVAR;
     SV ** current_entry;
     const STRLEN key_len = strlen((const char *) key);
     DECLARATION_FOR_GLOBAL_CONTEXT;
@@ -22176,6 +22191,7 @@ Perl_parse_uniprop_string(pTHX_
                                    this */
    const STRLEN level)          /* Recursion level of this call */
 {
+    dVAR;
     char* lookup_name;          /* normalized name for lookup in our tables */
     unsigned lookup_len;        /* Its length */
     bool stricter = FALSE;      /* Some properties have stricter name
index b612f04..e00583a 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -506,6 +506,8 @@ S_isFOO_utf8_lc(pTHX_ const U8 classnum, const U8* character, const U8* e)
      * rules, ignoring any locale.  So use the Unicode function if this class
      * requires an inversion list, and use the Unicode macro otherwise. */
 
+    dVAR;
+
     PERL_ARGS_ASSERT_ISFOO_UTF8_LC;
 
     if (UTF8_IS_INVARIANT(*character)) {
@@ -4680,6 +4682,7 @@ S_isGCB(pTHX_ const GCB_enum before, const GCB_enum after, const U8 * const strb
 STATIC GCB_enum
 S_backup_one_GCB(pTHX_ const U8 * const strbeg, U8 ** curpos, const bool utf8_target)
 {
+    dVAR;
     GCB_enum gcb;
 
     PERL_ARGS_ASSERT_BACKUP_ONE_GCB;
@@ -4957,6 +4960,8 @@ S_isLB(pTHX_ LB_enum before,
 STATIC LB_enum
 S_advance_one_LB(pTHX_ U8 ** curpos, const U8 * const strend, const bool utf8_target)
 {
+    dVAR;
+
     LB_enum lb;
 
     PERL_ARGS_ASSERT_ADVANCE_ONE_LB;
@@ -4986,6 +4991,7 @@ S_advance_one_LB(pTHX_ U8 ** curpos, const U8 * const strend, const bool utf8_ta
 STATIC LB_enum
 S_backup_one_LB(pTHX_ const U8 * const strbeg, U8 ** curpos, const bool utf8_target)
 {
+    dVAR;
     LB_enum lb;
 
     PERL_ARGS_ASSERT_BACKUP_ONE_LB;
@@ -5222,6 +5228,7 @@ S_isSB(pTHX_ SB_enum before,
 STATIC SB_enum
 S_advance_one_SB(pTHX_ U8 ** curpos, const U8 * const strend, const bool utf8_target)
 {
+    dVAR;
     SB_enum sb;
 
     PERL_ARGS_ASSERT_ADVANCE_ONE_SB;
@@ -5255,6 +5262,7 @@ S_advance_one_SB(pTHX_ U8 ** curpos, const U8 * const strend, const bool utf8_ta
 STATIC SB_enum
 S_backup_one_SB(pTHX_ const U8 * const strbeg, U8 ** curpos, const bool utf8_target)
 {
+    dVAR;
     SB_enum sb;
 
     PERL_ARGS_ASSERT_BACKUP_ONE_SB;
@@ -5491,6 +5499,7 @@ S_advance_one_WB(pTHX_ U8 ** curpos,
                        const bool utf8_target,
                        const bool skip_Extend_Format)
 {
+    dVAR;
     WB_enum wb;
 
     PERL_ARGS_ASSERT_ADVANCE_ONE_WB;
@@ -5528,6 +5537,7 @@ S_advance_one_WB(pTHX_ U8 ** curpos,
 STATIC WB_enum
 S_backup_one_WB(pTHX_ WB_enum * previous, const U8 * const strbeg, U8 ** curpos, const bool utf8_target)
 {
+    dVAR;
     WB_enum wb;
 
     PERL_ARGS_ASSERT_BACKUP_ONE_WB;
@@ -9073,6 +9083,7 @@ STATIC I32
 S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p,
             regmatch_info *const reginfo, I32 max _pDEPTH)
 {
+    dVAR;
     char *scan;     /* Pointer to current position in target string */
     I32 c;
     char *loceol = reginfo->strend;   /* local version */
@@ -10171,6 +10182,8 @@ Perl__is_grapheme(pTHX_ const U8 * strbeg, const U8 * s, const U8 * strend, cons
      * so code using it would then break), and there has to be a GCB break
      * before and after the character. */
 
+    dVAR;
+
     GCB_enum cp_gcb_val, prev_cp_gcb_val, next_cp_gcb_val;
     const U8 * prev_cp_start;
 
@@ -10289,6 +10302,7 @@ Perl_isSCRIPT_RUN(pTHX_ const U8 * s, const U8 * send, const bool utf8_target)
      * characters for at least one language in the Unicode Common Locale Data
      * Repository [CLDR]. */
 
+    dVAR;
 
     /* Things that match /\d/u */
     SV * decimals_invlist = PL_XPosix_ptrs[_CC_DIGIT];
diff --git a/sv.c b/sv.c
index 0a4a2e5..d7315b2 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -15896,6 +15896,8 @@ Perl_clone_params_new(PerlInterpreter *const from, PerlInterpreter *const to)
 void
 Perl_init_constants(pTHX)
 {
+    dVAR;
+
     SvREFCNT(&PL_sv_undef)     = SvREFCNT_IMMORTAL;
     SvFLAGS(&PL_sv_undef)      = SVf_READONLY|SVf_PROTECT|SVt_NULL;
     SvANY(&PL_sv_undef)                = NULL;
diff --git a/toke.c b/toke.c
index 5a3fe78..0bf86ad 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -2596,6 +2596,7 @@ S_get_and_check_backslash_N_name(pTHX_ const char* s, const char* const e)
      * interior, hence to the "}".  Finds what the name resolves to, returning
      * an SV* containing it; NULL if no valid one found */
 
+    dVAR;
     SV* res = newSVpvn_flags(s, e - s, UTF ? SVf_UTF8 : 0);
 
     HV * table;
diff --git a/utf8.c b/utf8.c
index ff5d4ad..7115952 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -2778,6 +2778,7 @@ Perl_utf16_to_utf8_reversed(pTHX_ U8* p, U8* d, I32 bytelen, I32 *newlen)
 bool
 Perl__is_uni_FOO(pTHX_ const U8 classnum, const UV c)
 {
+    dVAR;
     return _invlist_contains_cp(PL_XPosix_ptrs[classnum], c);
 }
 
@@ -2787,6 +2788,8 @@ Perl__is_uni_FOO(pTHX_ const U8 classnum, const UV c)
 bool
 Perl__is_utf8_idstart(pTHX_ const U8 *p)
 {
+    dVAR;
+
     PERL_ARGS_ASSERT__IS_UTF8_IDSTART;
 
     if (*p == '_')
@@ -2797,12 +2800,14 @@ Perl__is_utf8_idstart(pTHX_ const U8 *p)
 bool
 Perl__is_uni_perl_idcont(pTHX_ UV c)
 {
+    dVAR;
     return _invlist_contains_cp(PL_utf8_perl_idcont, c);
 }
 
 bool
 Perl__is_uni_perl_idstart(pTHX_ UV c)
 {
+    dVAR;
     return _invlist_contains_cp(PL_utf8_perl_idstart, c);
 }
 
@@ -2942,6 +2947,7 @@ Perl_to_uni_upper(pTHX_ UV c, U8* p, STRLEN *lenp)
      * The ordinal of the first character of the changed version is returned
      * (but note, as explained above, that there may be more.) */
 
+    dVAR;
     PERL_ARGS_ASSERT_TO_UNI_UPPER;
 
     if (c < 256) {
@@ -2954,6 +2960,7 @@ Perl_to_uni_upper(pTHX_ UV c, U8* p, STRLEN *lenp)
 UV
 Perl_to_uni_title(pTHX_ UV c, U8* p, STRLEN *lenp)
 {
+    dVAR;
     PERL_ARGS_ASSERT_TO_UNI_TITLE;
 
     if (c < 256) {
@@ -2993,6 +3000,7 @@ S_to_lower_latin1(const U8 c, U8* p, STRLEN *lenp, const char dummy)
 UV
 Perl_to_uni_lower(pTHX_ UV c, U8* p, STRLEN *lenp)
 {
+    dVAR;
     PERL_ARGS_ASSERT_TO_UNI_LOWER;
 
     if (c < 256) {
@@ -3074,6 +3082,7 @@ Perl__to_uni_fold_flags(pTHX_ UV c, U8* p, STRLEN *lenp, U8 flags)
      *     FOLD_FLAGS_NOMIX_ASCII iff non-ASCII to ASCII folds are prohibited
      */
 
+    dVAR;
     PERL_ARGS_ASSERT__TO_UNI_FOLD_FLAGS;
 
     if (flags & FOLD_FLAGS_LOCALE) {
@@ -3210,6 +3219,7 @@ Perl__is_utf8_FOO(pTHX_       U8   classnum,
                         const char * const file,
                         const unsigned line)
 {
+    dVAR;
     PERL_ARGS_ASSERT__IS_UTF8_FOO;
 
     warn_on_first_deprecated_use(name, alternative, use_locale, file, line);
@@ -3282,6 +3292,7 @@ bool
 Perl__is_utf8_FOO_with_len(pTHX_ const U8 classnum, const U8 *p,
                                                             const U8 * const e)
 {
+    dVAR;
     PERL_ARGS_ASSERT__IS_UTF8_FOO_WITH_LEN;
 
     return is_utf8_common_with_len(p, e, PL_XPosix_ptrs[classnum]);
@@ -3290,6 +3301,7 @@ Perl__is_utf8_FOO_with_len(pTHX_ const U8 classnum, const U8 *p,
 bool
 Perl__is_utf8_perl_idstart_with_len(pTHX_ const U8 *p, const U8 * const e)
 {
+    dVAR;
     PERL_ARGS_ASSERT__IS_UTF8_PERL_IDSTART_WITH_LEN;
 
     return is_utf8_common_with_len(p, e, PL_utf8_perl_idstart);
@@ -3298,6 +3310,7 @@ Perl__is_utf8_perl_idstart_with_len(pTHX_ const U8 *p, const U8 * const e)
 bool
 Perl__is_utf8_xidstart(pTHX_ const U8 *p)
 {
+    dVAR;
     PERL_ARGS_ASSERT__IS_UTF8_XIDSTART;
 
     if (*p == '_')
@@ -3308,6 +3321,7 @@ Perl__is_utf8_xidstart(pTHX_ const U8 *p)
 bool
 Perl__is_utf8_perl_idcont_with_len(pTHX_ const U8 *p, const U8 * const e)
 {
+    dVAR;
     PERL_ARGS_ASSERT__IS_UTF8_PERL_IDCONT_WITH_LEN;
 
     return is_utf8_common_with_len(p, e, PL_utf8_perl_idcont);
@@ -3316,6 +3330,7 @@ Perl__is_utf8_perl_idcont_with_len(pTHX_ const U8 *p, const U8 * const e)
 bool
 Perl__is_utf8_idcont(pTHX_ const U8 *p)
 {
+    dVAR;
     PERL_ARGS_ASSERT__IS_UTF8_IDCONT;
 
     return is_utf8_common(p, PL_utf8_idcont);
@@ -3324,6 +3339,7 @@ Perl__is_utf8_idcont(pTHX_ const U8 *p)
 bool
 Perl__is_utf8_xidcont(pTHX_ const U8 *p)
 {
+    dVAR;
     PERL_ARGS_ASSERT__IS_UTF8_XIDCONT;
 
     return is_utf8_common(p, PL_utf8_xidcont);
@@ -3332,6 +3348,7 @@ Perl__is_utf8_xidcont(pTHX_ const U8 *p)
 bool
 Perl__is_utf8_mark(pTHX_ const U8 *p)
 {
+    dVAR;
     PERL_ARGS_ASSERT__IS_UTF8_MARK;
 
     return is_utf8_common(p, PL_utf8_mark);
@@ -3535,6 +3552,7 @@ Perl__inverse_folds(pTHX_ const UV cp, unsigned int * first_folds_to,
      * the return can point to them, but single code points aren't, so would
      * need to be constructed if we didn't employ something like this API */
 
+    dVAR;
     /* 'index' is guaranteed to be non-negative, as this is an inversion map
      * that covers all possible inputs.  See [perl #133365] */
     SSize_t index = _invlist_search(PL_utf8_foldclosures, cp);
@@ -3761,6 +3779,7 @@ S_turkic_lc(pTHX_ const U8 * const p0, const U8 * const e,
      * sequence, and the entire sequence will be stored in *ustrp.  ustrp will
      * contain *lenp bytes */
 
+    dVAR;
     PERL_ARGS_ASSERT_TURKIC_LC;
     assert(e > p0);
 
@@ -3944,6 +3963,7 @@ Perl__to_utf8_upper_flags(pTHX_ const U8 *p,
                                 const char * const file,
                                 const int line)
 {
+    dVAR;
     UV result;
     const U32 utf8n_flags = check_and_deprecate(p, &e, DEPRECATE_TO_UPPER,
                                                 cBOOL(flags), file, line);
@@ -3979,6 +3999,7 @@ Perl__to_utf8_title_flags(pTHX_ const U8 *p,
                                 const char * const file,
                                 const int line)
 {
+    dVAR;
     UV result;
     const U32 utf8n_flags = check_and_deprecate(p, &e, DEPRECATE_TO_TITLE,
                                                 cBOOL(flags), file, line);
@@ -4012,6 +4033,7 @@ Perl__to_utf8_lower_flags(pTHX_ const U8 *p,
                                 const char * const file,
                                 const int line)
 {
+    dVAR;
     UV result;
     const U32 utf8n_flags = check_and_deprecate(p, &e, DEPRECATE_TO_LOWER,
                                                 cBOOL(flags), file, line);
@@ -4049,6 +4071,7 @@ Perl__to_utf8_fold_flags(pTHX_ const U8 *p,
                                const char * const file,
                                const int line)
 {
+    dVAR;
     UV result;
     const U32 utf8n_flags = check_and_deprecate(p, &e, DEPRECATE_TO_FOLD,
                                                 cBOOL(flags), file, line);
diff --git a/util.c b/util.c
index 8c9909e..5b6f4bf 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1527,6 +1527,7 @@ S_with_queued_errors(pTHX_ SV *ex)
 STATIC bool
 S_invoke_exception_hook(pTHX_ SV *ex, bool warn)
 {
+    dVAR;
     HV *stash;
     GV *gv;
     CV *cv;
index 8b2808c..8104d86 100644 (file)
@@ -1684,6 +1684,8 @@ win32_longpath(char *path)
 static void
 out_of_memory(void)
 {
+    dVAR;
+
     if (PL_curinterp)
        croak_no_mem();
     exit(1);
@@ -4711,6 +4713,7 @@ win32_csighandler(int sig)
 void
 Perl_sys_intern_init(pTHX)
 {
+    dVAR;
     int i;
 
     w32_perlshell_tokens       = NULL;
@@ -4760,6 +4763,8 @@ Perl_sys_intern_init(pTHX)
 void
 Perl_sys_intern_clear(pTHX)
 {
+    dVAR;
+
     Safefree(w32_perlshell_tokens);
     Safefree(w32_perlshell_vec);
     /* NOTE: w32_fdpid is freed by sv_clean_all() */