diff options
-rw-r--r-- | dump.c | 1 | ||||
-rw-r--r-- | locale.c | 2 | ||||
-rw-r--r-- | op.c | 2 | ||||
-rw-r--r-- | pp.c | 1 | ||||
-rw-r--r-- | regcomp.c | 16 | ||||
-rw-r--r-- | regexec.c | 14 | ||||
-rw-r--r-- | sv.c | 2 | ||||
-rw-r--r-- | toke.c | 1 | ||||
-rw-r--r-- | utf8.c | 23 | ||||
-rw-r--r-- | util.c | 1 | ||||
-rw-r--r-- | win32/win32.c | 5 |
11 files changed, 68 insertions, 0 deletions
@@ -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; @@ -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 @@ -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 @@ -4034,6 +4034,7 @@ PP(pp_ucfirst) PP(pp_uc) { + dVAR; dSP; SV *source = TOPs; STRLEN len; @@ -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 @@ -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]; @@ -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; @@ -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; @@ -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); @@ -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; diff --git a/win32/win32.c b/win32/win32.c index 8b2808c6d8..8104d864c2 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -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() */ |