/* called by sv_report_used() for each live SV */
static void
-do_report_used(pTHX_ SV *sv)
+do_report_used(pTHX_ SV *const sv)
{
if (SvTYPE(sv) != SVTYPEMASK) {
PerlIO_printf(Perl_debug_log, "****\n");
#ifndef DISABLE_DESTRUCTOR_KLUDGE
static void
-do_clean_named_objs(pTHX_ SV *sv)
+do_clean_named_objs(pTHX_ SV *const sv)
{
dVAR;
assert(SvTYPE(sv) == SVt_PVGV);
const size_t body_size = bdp->body_size;
char *start;
const char *end;
+ const size_t arena_size = Perl_malloc_good_size(bdp->arena_size);
#if defined(DEBUGGING) && !defined(PERL_GLOBAL_STRUCT_PRIVATE)
static bool done_sanity_check;
assert(bdp->arena_size);
- start = (char*) Perl_get_arena(aTHX_ bdp->arena_size, sv_type);
+ start = (char*) Perl_get_arena(aTHX_ arena_size, sv_type);
- end = start + bdp->arena_size - body_size;
+ end = start + arena_size - 2 * body_size;
/* computed count doesnt reflect the 1st slot reservation */
+#if defined(MYMALLOC) || defined(HAS_MALLOC_GOOD_SIZE)
+ DEBUG_m(PerlIO_printf(Perl_debug_log,
+ "arena %p end %p arena-size %d (from %d) type %d "
+ "size %d ct %d\n",
+ (void*)start, (void*)end, (int)arena_size,
+ (int)bdp->arena_size, sv_type, (int)body_size,
+ (int)arena_size / (int)body_size));
+#else
DEBUG_m(PerlIO_printf(Perl_debug_log,
"arena %p end %p arena-size %d type %d size %d ct %d\n",
(void*)start, (void*)end,
(int)bdp->arena_size, sv_type, (int)body_size,
(int)bdp->arena_size / (int)body_size));
-
+#endif
*root = (void *)start;
- while (start < end) {
+ while (start <= end) {
char * const next = start + body_size;
*(void**) start = (void *)next;
start = next;
s = SvPVX_mutable(sv);
if (newlen > SvLEN(sv)) { /* need more room? */
+#ifndef MYMALLOC
newlen = PERL_STRLEN_ROUNDUP(newlen);
- if (SvLEN(sv) && s) {
-#ifdef MYMALLOC
- const STRLEN l = malloced_size((void*)SvPVX_const(sv));
- if (newlen <= l) {
- SvLEN_set(sv, l);
- return s;
- } else
#endif
+ if (SvLEN(sv) && s) {
s = (char*)saferealloc(s, newlen);
}
else {
}
}
SvPV_set(sv, s);
+#ifdef Perl_safesysmalloc_size
+ /* Do this here, do it once, do it right, and then we will never get
+ called back into sv_grow() unless there really is some growing
+ needed. */
+ SvLEN_set(sv, Perl_safesysmalloc_size(s));
+#else
SvLEN_set(sv, newlen);
+#endif
}
return s;
}
*/
char *
-Perl_sv_2pvutf8(pTHX_ register SV *sv, STRLEN *lp)
+Perl_sv_2pvutf8(pTHX_ register SV *const sv, STRLEN *const lp)
{
PERL_ARGS_ASSERT_SV_2PVUTF8;
*/
bool
-Perl_sv_2bool(pTHX_ register SV *sv)
+Perl_sv_2bool(pTHX_ register SV *const sv)
{
dVAR;
*/
STRLEN
-Perl_sv_utf8_upgrade_flags(pTHX_ register SV *sv, I32 flags)
+Perl_sv_utf8_upgrade_flags(pTHX_ register SV *const sv, const I32 flags)
{
dVAR;
*/
bool
-Perl_sv_utf8_downgrade(pTHX_ register SV* sv, bool fail_ok)
+Perl_sv_utf8_downgrade(pTHX_ register SV *const sv, const bool fail_ok)
{
dVAR;
*/
void
-Perl_sv_utf8_encode(pTHX_ register SV *sv)
+Perl_sv_utf8_encode(pTHX_ register SV *const sv)
{
PERL_ARGS_ASSERT_SV_UTF8_ENCODE;
*/
bool
-Perl_sv_utf8_decode(pTHX_ register SV *sv)
+Perl_sv_utf8_decode(pTHX_ register SV *const sv)
{
PERL_ARGS_ASSERT_SV_UTF8_DECODE;
*/
static void
-S_glob_assign_glob(pTHX_ SV *dstr, SV *sstr, const int dtype)
+S_glob_assign_glob(pTHX_ SV *const dstr, SV *const sstr, const int dtype)
{
I32 mro_changes = 0; /* 1 = method, 2 = isa */
}
static void
-S_glob_assign_ref(pTHX_ SV *dstr, SV *sstr)
+S_glob_assign_ref(pTHX_ SV *const dstr, SV *const sstr)
{
SV * const sref = SvREFCNT_inc(SvRV(sstr));
SV *dref = NULL;
}
void
-Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
+Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
{
dVAR;
register U32 sflags;
*/
void
-Perl_sv_setsv_mg(pTHX_ SV *dstr, register SV *sstr)
+Perl_sv_setsv_mg(pTHX_ SV *const dstr, register SV *const sstr)
{
PERL_ARGS_ASSERT_SV_SETSV_MG;
*/
void
-Perl_sv_setpvn(pTHX_ register SV *sv, register const char *ptr, register STRLEN len)
+Perl_sv_setpvn(pTHX_ register SV *const sv, register const char *const ptr, register const STRLEN len)
{
dVAR;
register char *dptr;
*/
void
-Perl_sv_setpvn_mg(pTHX_ register SV *sv, register const char *ptr, register STRLEN len)
+Perl_sv_setpvn_mg(pTHX_ register SV *const sv, register const char *const ptr, register const STRLEN len)
{
PERL_ARGS_ASSERT_SV_SETPVN_MG;
*/
void
-Perl_sv_setpv(pTHX_ register SV *sv, register const char *ptr)
+Perl_sv_setpv(pTHX_ register SV *const sv, register const char *const ptr)
{
dVAR;
register STRLEN len;
*/
void
-Perl_sv_setpv_mg(pTHX_ register SV *sv, register const char *ptr)
+Perl_sv_setpv_mg(pTHX_ register SV *const sv, register const char *const ptr)
{
PERL_ARGS_ASSERT_SV_SETPV_MG;
*/
void
-Perl_sv_usepvn_flags(pTHX_ SV *sv, char *ptr, STRLEN len, U32 flags)
+Perl_sv_usepvn_flags(pTHX_ SV *const sv, char *ptr, const STRLEN len, const U32 flags)
{
dVAR;
STRLEN allocate;
#endif
allocate = (flags & SV_HAS_TRAILING_NUL)
- ? len + 1: PERL_STRLEN_ROUNDUP(len + 1);
+ ? len + 1 :
+#ifdef Perl_safesysmalloc_size
+ len + 1;
+#else
+ PERL_STRLEN_ROUNDUP(len + 1);
+#endif
if (flags & SV_HAS_TRAILING_NUL) {
/* It's long enough - do nothing.
Specfically Perl_newCONSTSUB is relying on this. */
ptr = (char*) saferealloc (ptr, allocate);
#endif
}
- SvPV_set(sv, ptr);
- SvCUR_set(sv, len);
+#ifdef Perl_safesysmalloc_size
+ SvLEN_set(sv, Perl_safesysmalloc_size(ptr));
+#else
SvLEN_set(sv, allocate);
+#endif
+ SvCUR_set(sv, len);
+ SvPV_set(sv, ptr);
if (!(flags & SV_HAS_TRAILING_NUL)) {
ptr[len] = '\0';
}
*/
void
-Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags)
+Perl_sv_force_normal_flags(pTHX_ register SV *const sv, const U32 flags)
{
dVAR;
*/
void
-Perl_sv_chop(pTHX_ register SV *sv, register const char *ptr)
+Perl_sv_chop(pTHX_ register SV *const sv, register const char *const ptr)
{
STRLEN delta;
STRLEN old_delta;
*/
void
-Perl_sv_catpvn_flags(pTHX_ register SV *dsv, register const char *sstr, register STRLEN slen, I32 flags)
+Perl_sv_catpvn_flags(pTHX_ register SV *const dsv, register const char *sstr, register const STRLEN slen, const I32 flags)
{
dVAR;
STRLEN dlen;
=cut */
void
-Perl_sv_catsv_flags(pTHX_ SV *dsv, register SV *ssv, I32 flags)
+Perl_sv_catsv_flags(pTHX_ SV *const dsv, register SV *const ssv, const I32 flags)
{
dVAR;
=cut */
void
-Perl_sv_catpv(pTHX_ register SV *sv, register const char *ptr)
+Perl_sv_catpv(pTHX_ register SV *const sv, register const char *ptr)
{
dVAR;
register STRLEN len;
*/
void
-Perl_sv_catpv_mg(pTHX_ register SV *sv, register const char *ptr)
+Perl_sv_catpv_mg(pTHX_ register SV *const sv, register const char *const ptr)
{
PERL_ARGS_ASSERT_SV_CATPV_MG;
*/
SV *
-Perl_newSV(pTHX_ STRLEN len)
+Perl_newSV(pTHX_ const STRLEN len)
{
dVAR;
register SV *sv;
=cut
*/
MAGIC *
-Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, const MGVTBL *vtable,
- const char* name, I32 namlen)
+Perl_sv_magicext(pTHX_ SV *const sv, SV *const obj, const int how,
+ const MGVTBL *const vtable, const char *const name, const I32 namlen)
{
dVAR;
MAGIC* mg;
*/
void
-Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 namlen)
+Perl_sv_magic(pTHX_ register SV *const sv, SV *const obj, const int how,
+ const char *const name, const I32 namlen)
{
dVAR;
const MGVTBL *vtable;
*/
int
-Perl_sv_unmagic(pTHX_ SV *sv, int type)
+Perl_sv_unmagic(pTHX_ SV *const sv, const int type)
{
MAGIC* mg;
MAGIC** mgp;
*/
SV *
-Perl_sv_rvweaken(pTHX_ SV *sv)
+Perl_sv_rvweaken(pTHX_ SV *const sv)
{
SV *tsv;
*/
void
-Perl_sv_add_backref(pTHX_ SV *tsv, SV *sv)
+Perl_sv_add_backref(pTHX_ SV *const tsv, SV *const sv)
{
dVAR;
AV *av;
*/
STATIC void
-S_sv_del_backref(pTHX_ SV *tsv, SV *sv)
+S_sv_del_backref(pTHX_ SV *const tsv, SV *const sv)
{
dVAR;
AV *av = NULL;
}
int
-Perl_sv_kill_backrefs(pTHX_ SV *sv, AV *av)
+Perl_sv_kill_backrefs(pTHX_ SV *const sv, AV *const av)
{
SV **svp = AvARRAY(av);
*/
void
-Perl_sv_insert(pTHX_ SV *bigstr, STRLEN offset, STRLEN len, const char *little, STRLEN littlelen)
+Perl_sv_insert(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN len,
+ const char *const little, const STRLEN littlelen)
{
dVAR;
register char *big;
*/
void
-Perl_sv_replace(pTHX_ register SV *sv, register SV *nsv)
+Perl_sv_replace(pTHX_ register SV *const sv, register SV *const nsv)
{
dVAR;
const U32 refcnt = SvREFCNT(sv);
*/
void
-Perl_sv_clear(pTHX_ register SV *sv)
+Perl_sv_clear(pTHX_ register SV *const sv)
{
dVAR;
const U32 type = SvTYPE(sv);
*/
SV *
-Perl_sv_newref(pTHX_ SV *sv)
+Perl_sv_newref(pTHX_ SV *const sv)
{
PERL_UNUSED_CONTEXT;
if (sv)
*/
void
-Perl_sv_free(pTHX_ SV *sv)
+Perl_sv_free(pTHX_ SV *const sv)
{
dVAR;
if (!sv)
}
void
-Perl_sv_free2(pTHX_ SV *sv)
+Perl_sv_free2(pTHX_ SV *const sv)
{
dVAR;
*/
STRLEN
-Perl_sv_len(pTHX_ register SV *sv)
+Perl_sv_len(pTHX_ register SV *const sv)
{
STRLEN len;
*/
STRLEN
-Perl_sv_len_utf8(pTHX_ register SV *sv)
+Perl_sv_len_utf8(pTHX_ register SV *const sv)
{
if (!sv)
return 0;
the passed in UTF-8 offset. */
static STRLEN
S_sv_pos_u2b_midway(const U8 *const start, const U8 *send,
- STRLEN uoffset, STRLEN uend)
+ const STRLEN uoffset, const STRLEN uend)
{
STRLEN backw = uend - uoffset;
will be used to reduce the amount of linear searching. The cache will be
created if necessary, and the found value offered to it for update. */
static STRLEN
-S_sv_pos_u2b_cached(pTHX_ SV *sv, MAGIC **mgp, const U8 *const start,
- const U8 *const send, STRLEN uoffset,
+S_sv_pos_u2b_cached(pTHX_ SV *const sv, MAGIC **const mgp, const U8 *const start,
+ const U8 *const send, const STRLEN uoffset,
STRLEN uoffset0, STRLEN boffset0)
{
STRLEN boffset = 0; /* Actually always set, but let's keep gcc happy. */
*/
void
-Perl_sv_pos_u2b(pTHX_ register SV *sv, I32* offsetp, I32* lenp)
+Perl_sv_pos_u2b(pTHX_ register SV *const sv, I32 *const offsetp, I32 *const lenp)
{
const U8 *start;
STRLEN len;
from.
*/
static void
-S_utf8_mg_pos_cache_update(pTHX_ SV *sv, MAGIC **mgp, STRLEN byte, STRLEN utf8,
- STRLEN blen)
+S_utf8_mg_pos_cache_update(pTHX_ SV *const sv, MAGIC **const mgp, const STRLEN byte,
+ const STRLEN utf8, const STRLEN blen)
{
STRLEN *cache;
assumption is made as in S_sv_pos_u2b_midway(), namely that walking
backward is half the speed of walking forward. */
static STRLEN
-S_sv_pos_b2u_midway(pTHX_ const U8 *s, const U8 *const target, const U8 *end,
- STRLEN endu)
+S_sv_pos_b2u_midway(pTHX_ const U8 *const s, const U8 *const target,
+ const U8 *end, STRLEN endu)
{
const STRLEN forw = target - s;
STRLEN backw = end - target;
*
*/
void
-Perl_sv_pos_b2u(pTHX_ register SV* sv, I32* offsetp)
+Perl_sv_pos_b2u(pTHX_ register SV *const sv, I32 *const offsetp)
{
const U8* s;
const STRLEN byte = *offsetp;
*/
I32
-Perl_sv_cmp(pTHX_ register SV *sv1, register SV *sv2)
+Perl_sv_cmp(pTHX_ register SV *const sv1, register SV *const sv2)
{
dVAR;
STRLEN cur1, cur2;
*/
I32
-Perl_sv_cmp_locale(pTHX_ register SV *sv1, register SV *sv2)
+Perl_sv_cmp_locale(pTHX_ register SV *const sv1, register SV *const sv2)
{
dVAR;
#ifdef USE_LOCALE_COLLATE
*/
char *
-Perl_sv_collxfrm(pTHX_ SV *sv, STRLEN *nxp)
+Perl_sv_collxfrm(pTHX_ SV *const sv, STRLEN *const nxp)
{
dVAR;
MAGIC *mg;
Safefree(mg->mg_ptr);
s = SvPV_const(sv, len);
if ((xf = mem_collxfrm(s, len, &xlen))) {
- if (SvREADONLY(sv)) {
- SAVEFREEPV(xf);
- *nxp = xlen;
- return xf + sizeof(PL_collation_ix);
- }
if (! mg) {
#ifdef PERL_OLD_COPY_ON_WRITE
if (SvIsCOW(sv))
*/
char *
-Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
+Perl_sv_gets(pTHX_ register SV *const sv, register PerlIO *const fp, I32 append)
{
dVAR;
const char *rsptr;
*/
void
-Perl_sv_inc(pTHX_ register SV *sv)
+Perl_sv_inc(pTHX_ register SV *const sv)
{
dVAR;
register char *d;
*/
void
-Perl_sv_dec(pTHX_ register SV *sv)
+Perl_sv_dec(pTHX_ register SV *const sv)
{
dVAR;
int flags;
* permanent location. */
SV *
-Perl_sv_mortalcopy(pTHX_ SV *oldstr)
+Perl_sv_mortalcopy(pTHX_ SV *const oldstr)
{
dVAR;
register SV *sv;
*/
SV *
-Perl_newSV_type(pTHX_ svtype type)
+Perl_newSV_type(pTHX_ const svtype type)
{
register SV *sv;
* so we know which stashes want their objects cloned */
static void
-do_mark_cloneable_stash(pTHX_ SV *sv)
+do_mark_cloneable_stash(pTHX_ SV *const sv)
{
const HEK * const hvname = HvNAME_HEK((HV*)sv);
if (hvname) {
goto do_op2;
+ case OP_ENTEREVAL: /* could be eval $undef or $x='$undef'; eval $x */
case OP_RV2SV:
case OP_CUSTOM:
match = 1; /* XS or custom code could trigger random warnings */