/* visit(): call the named function for each non-free SV in the arenas
* whose flags field matches the flags/mask args. */
-STATIC I32
+STATIC SSize_t
S_visit(pTHX_ SVFUNC_t f, const U32 flags, const U32 mask)
{
SV* sva;
=cut
*/
-I32
+SSize_t
Perl_sv_clean_all(pTHX)
{
- I32 cleaned;
+ SSize_t cleaned;
PL_in_clean_all = TRUE;
cleaned = visit(do_clean_all, 0,0);
return cleaned;
}
+
+#ifdef DEBUGGING
+
+/* Called by sv_mark_arenas() for each live SV: set SVf_BREAK */
+
+static void
+S_do_sv_mark_arenas(pTHX_ SV *const sv)
+{
+ sv->sv_flags |= SVf_BREAK;
+}
+
+/* sv_mark_arenas(): for leak debugging: mark all live SVs with SVf_BREAK.
+ * Then later, use sv_sweep_arenas() to list any SVs not so marked.
+ */
+
+void
+Perl_sv_mark_arenas(pTHX)
+{
+ visit(S_do_sv_mark_arenas, 0, 0);
+}
+
+/* Called by sv_sweep_arenas() for each live SV, to list any SVs without
+ * SVf_BREAK set */
+
+static void
+S_do_sv_sweep_arenas(pTHX_ SV *const sv)
+{
+ if (sv->sv_flags & SVf_BREAK) {
+ sv->sv_flags &= ~SVf_BREAK;
+ return;
+ }
+ PerlIO_printf(Perl_debug_log, "Unmarked SV: 0x%p: %s\n",
+ sv, SvPEEK(sv));
+}
+
+
+/* sv_sweep_arenas(): for debugging: list all live SVs that don't have
+ * SVf_BREAK set, then turn off all SVf_BREAK flags. Typically used some
+ * time after sv_mark_arenas(), to find SVs which have been created since
+ * the marking but not yet freed (they may have leaked, or been stored in
+ * an array, or whatever).
+ */
+
+void
+Perl_sv_sweep_arenas(pTHX)
+{
+ visit(S_do_sv_sweep_arenas, 0, 0);
+}
+
+#endif
+
+
/*
ARENASETS: a meta-arena implementation which separates arena-info
into struct arena_set, which contains an array of struct
SvANY(sv) = new_body;
switch(new_type) {
case SVt_PVAV:
- *((XPVAV*) SvANY(sv)) = (XPVAV) {
- .xmg_stash = NULL, .xmg_u = {.xmg_magic = NULL},
- .xav_fill = -1, .xav_max = -1, .xav_alloc = 0
+ {
+ XPVAV pvav = {
+ .xmg_stash = NULL,
+ .xmg_u = {.xmg_magic = NULL},
+ .xav_fill = -1, .xav_max = -1, .xav_alloc = 0
};
+ *((XPVAV*) SvANY(sv)) = pvav;
+ }
AvREAL_only(sv);
break;
case SVt_PVHV:
- *((XPVHV*) SvANY(sv)) = (XPVHV) {
- .xmg_stash = NULL, .xmg_u = {.xmg_magic = NULL},
- .xhv_keys = 0,
- /* start with PERL_HASH_DEFAULT_HvMAX+1 buckets: */
- .xhv_max = PERL_HASH_DEFAULT_HvMAX
+ {
+ XPVHV pvhv = {
+ .xmg_stash = NULL,
+ .xmg_u = {.xmg_magic = NULL},
+ .xhv_keys = 0,
+ /* start with PERL_HASH_DEFAULT_HvMAX+1 buckets: */
+ .xhv_max = PERL_HASH_DEFAULT_HvMAX
};
+ *((XPVHV*) SvANY(sv)) = pvhv;
+ }
assert(!SvOK(sv));
SvOK_off(sv);
#endif
break;
case SVt_PVOBJ:
- *((XPVOBJ*) SvANY(sv)) = (XPVOBJ) {
- .xmg_stash = NULL, .xmg_u = {.xmg_magic = NULL},
- .xobject_maxfield = -1,
- .xobject_iter_sv_at = 0,
- .xobject_fields = NULL,
- };
+ {
+ XPVOBJ pvo = {
+ .xmg_stash = NULL, .xmg_u = {.xmg_magic = NULL},
+ .xobject_maxfield = -1,
+ .xobject_iter_sv_at = 0,
+ .xobject_fields = NULL,
+ };
+ *((XPVOBJ*) SvANY(sv)) = pvo;
+ }
break;
default:
NOT_REACHED;
/* adjust pos to the start of a UTF8 char sequence */
MAGIC * mg = mg_find(sv, PERL_MAGIC_regex_global);
if (mg) {
- I32 pos = mg->mg_len;
+ SSize_t pos = mg->mg_len;
if (pos > 0) {
for (c = start + pos; c > start; c--) {
if (UTF8_IS_START(*c))
svp = (SV**)Perl_hv_backreferences_p(aTHX_ MUTABLE_HV(tsv));
}
else if (SvIS_FREED(tsv) && PL_phase == PERL_PHASE_DESTRUCT) {
- /* It's possible for the the last (strong) reference to tsv to have
+ /* It's possible for the last (strong) reference to tsv to have
become freed *before* the last thing holding a weak reference.
If both survive longer than the backreferences array, then when
the referent's reference count drops to 0 and it is freed, it's
}
/*
-=for apidoc sv_insert
-
-Inserts and/or replaces a string at the specified offset/length within the SV.
-Similar to the Perl C<substr()> function, with C<littlelen> bytes starting at
-C<little> replacing C<len> bytes of the string in C<bigstr> starting at
-C<offset>. Handles get magic.
+=for apidoc sv_insert
+=for apidoc_item sv_insert_flags
-=for apidoc sv_insert_flags
+These insert and/or replace a string at the specified offset/length within the
+SV. Similar to the Perl C<substr()> function, with C<littlelen> bytes starting
+at C<little> replacing C<len> bytes of the string in C<bigstr> starting at
+C<offset>. They handle get magic.
-Same as C<sv_insert>, but the extra C<flags> are passed to the
-C<SvPV_force_flags> that applies to C<bigstr>.
+C<sv_insert_flags> is identical to plain C<sv_insert>, but the extra C<flags>
+are passed to the C<SvPV_force_flags> operation that is internally applied to
+C<bigstr>.
=cut
*/
PERL_ARGS_ASSERT_SV_POS_U2B_MIDWAY;
if (uoffset < 2 * backw) {
- /* The assumption is that going forwards is twice the speed of going
- forward (that's where the 2 * backw comes from).
- (The real figure of course depends on the UTF-8 data.) */
+ /* The assumption is that the average size of a character is 2 bytes,
+ * so going forwards is twice the speed of going backwards (that's
+ * where the 2 * backw comes from). (The real figure of course depends
+ * on the UTF-8 data.) */
const U8 *s = start;
- while (s < send && uoffset--)
- s += UTF8SKIP(s);
+ s = utf8_hop_forward(s, uoffset, send);
assert (s <= send);
if (s > send)
s = send;
return s - start;
}
- while (backw--) {
- send--;
- while (UTF8_IS_CONTINUATION(*send))
- send--;
- }
+ send = utf8_hop_back(send, -backw, start);
return send - start;
}
}
while (end > target) {
- end--;
- while (UTF8_IS_CONTINUATION(*end)) {
- end--;
- }
+ end = utf8_hop_back(end, -1, target);
endu--;
}
return endu;
}
/*
-=for apidoc sv_eq
+=for apidoc sv_eq
+=for apidoc_item sv_eq_flags
-Returns a boolean indicating whether the strings in the two SVs are
-identical. Is UTF-8 and S<C<'use bytes'>> aware, handles get magic, and will
-coerce its args to strings if necessary.
+These each return a boolean indicating whether or not the strings in the two
+SVs are equal. If S<C<'use bytes'>> is in effect, the comparison is
+byte-by-byte; otherwise character-by-character. Each will coerce its args to
+strings if necessary.
-This function does not handle operator overloading. For a version that does,
-see instead C<sv_streq>.
+They differ only in that C<sv_eq> always processes get magic, while
+C<sv_eq_flags> processes get magic only when the C<flags> parameter has the
+C<SV_GMAGIC> bit set.
-=for apidoc sv_eq_flags
-
-Returns a boolean indicating whether the strings in the two SVs are
-identical. Is UTF-8 and S<C<'use bytes'>> aware and coerces its args to strings
-if necessary. If the flags has the C<SV_GMAGIC> bit set, it handles get-magic, too.
-
-This function does not handle operator overloading. For a version that does,
-see instead C<sv_streq_flags>.
+These functions do not handle operator overloading. For versions that do,
+see instead C<L</sv_streq>> or C<L</sv_streq_flags>>.
=cut
*/
* at the beginning of a character. But neither or both are
* (or else earlier bytes would have been different). And
* if we are in the middle of a character, the two
- * characters are comprised of the same number of bytes
+ * characters have the same number of bytes
* (because in this case the start bytes are the same, and
* the start bytes encode the character's length). */
if (UTF8_IS_INVARIANT(*pv1))
sv = GvSV(gv);
if (sv && !SvREADONLY(sv)) {
SV_CHECK_THINKFIRST_COW_DROP(sv);
- if (!isGV(sv)) SvOK_off(sv);
+ if (!isGV(sv)) {
+ SvOK_off(sv);
+ SvSETMAGIC(sv);
+ }
}
if (GvAV(gv)) {
av_clear(GvAV(gv));
nsi->si_prev = si_dup(si->si_prev, param);
nsi->si_next = si_dup(si->si_next, param);
nsi->si_markoff = si->si_markoff;
+#ifdef PERL_RC_STACK
+ nsi->si_stack_nonrc_base = si->si_stack_nonrc_base;
+#endif
#if defined DEBUGGING && !defined DEBUGGING_RE_ONLY
nsi->si_stack_hwm = 0;
#endif
PL_numeric_underlying = true;
PL_numeric_underlying_is_standard = true;
-# if defined(USE_POSIX_2008_LOCALE)
- PL_underlying_numeric_obj = NULL;
-# endif
#endif /* !USE_LOCALE_NUMERIC */
#if defined(USE_POSIX_2008_LOCALE)
PL_scratch_locale_obj = NULL;
PL_setlocale_buf = NULL;
PL_setlocale_bufsize = 0;
- PL_stdize_locale_buf = NULL;
- PL_stdize_locale_bufsize = 0;
+#if defined(USE_LOCALE_THREADS) && ! defined(USE_THREAD_SAFE_LOCALE)
+ PL_less_dicey_locale_buf = NULL;
+ PL_less_dicey_locale_bufsize = 0;
+#endif
/* Unicode inversion lists */
/* next PUSHMARK() sets *(PL_markstack_ptr+1) */
i = proto_perl->Imarkstack_max - proto_perl->Imarkstack;
- Newx(PL_markstack, i, I32);
+ Newx(PL_markstack, i, Stack_off_t);
PL_markstack_max = PL_markstack + (proto_perl->Imarkstack_max
- proto_perl->Imarkstack);
PL_markstack_ptr = PL_markstack + (proto_perl->Imarkstack_ptr
- proto_perl->Imarkstack);
Copy(proto_perl->Imarkstack, PL_markstack,
- PL_markstack_ptr - PL_markstack + 1, I32);
+ PL_markstack_ptr - PL_markstack + 1, Stack_off_t);
/* next push_scope()/ENTER sets PL_scopestack[PL_scopestack_ix]
* NOTE: unlike the others! */
HV* const stash = MUTABLE_HV(av_shift(param->stashes));
GV* const cloner = gv_fetchmethod_autoload(stash, "CLONE", 0);
if (cloner && GvCV(cloner)) {
- dSP;
ENTER;
SAVETMPS;
- PUSHMARK(SP);
- mXPUSHs(newSVhek(HvNAME_HEK(stash)));
- PUTBACK;
+ PUSHMARK(PL_stack_sp);
+ rpp_extend(1);
+ SV *newsv = newSVhek(HvNAME_HEK(stash));
+ *++PL_stack_sp = newsv;
+ if (!rpp_stack_is_rc())
+ sv_2mortal(newsv);
call_sv(MUTABLE_SV(GvCV(cloner)), G_DISCARD);
FREETMPS;
LEAVE;