/* 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);
do_clean_all(pTHX_ SV *const sv)
{
dVAR;
+ if (sv == (SV*) PL_fdpid || sv == (SV *)PL_strtab) {
+ /* don't clean pid table and strtab */
+ return;
+ }
DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops: SV at 0x%"UVxf"\n", PTR2UV(sv)) ));
SvFLAGS(sv) |= SVf_BREAK;
SvREFCNT_dec(sv);
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 Perl_safesysmalloc_size
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);
=for apidoc sv_insert
Inserts a string at the specified offset/length within the SV. Similar to
-the Perl substr() function.
+the Perl substr() function. Handles get magic.
+
+=for apidoc sv_insert_flags
+
+Same as C<sv_insert>, but the extra C<flags> are passed the C<SvPV_force_flags> that applies to C<bigstr>.
=cut
*/
void
-Perl_sv_insert(pTHX_ SV *bigstr, STRLEN offset, STRLEN len, const char *little, STRLEN littlelen)
+Perl_sv_insert_flags(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN len, const char *const little, const STRLEN littlelen, const U32 flags)
{
dVAR;
register char *big;
register I32 i;
STRLEN curlen;
- PERL_ARGS_ASSERT_SV_INSERT;
+ PERL_ARGS_ASSERT_SV_INSERT_FLAGS;
if (!bigstr)
Perl_croak(aTHX_ "Can't modify non-existent substring");
- SvPV_force(bigstr, curlen);
+ SvPV_force_flags(bigstr, curlen, flags);
(void)SvPOK_only_UTF8(bigstr);
if (offset + len > curlen) {
SvGROW(bigstr, offset+len+1);
*/
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. */
boffset = real_boffset;
}
- S_utf8_mg_pos_cache_update(aTHX_ sv, mgp, boffset, uoffset, send - start);
+ if (PL_utf8cache)
+ utf8_mg_pos_cache_update(sv, mgp, boffset, uoffset, send - start);
return boffset;
}
*/
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;
}
*offsetp = len;
- S_utf8_mg_pos_cache_update(aTHX_ sv, &mg, byte, len, blen);
+ if (PL_utf8cache)
+ utf8_mg_pos_cache_update(sv, &mg, byte, len, blen);
}
/*
*/
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;
*/
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;
I32 bytesread;
char *buffer;
U32 recsize;
+#ifdef VMS
+ int fd;
+#endif
/* Grab the size of the record we're getting */
recsize = SvUV(SvRV(PL_rs)); /* RsRECORD() guarantees > 0. */
/* doing, but we've got no other real choice - except avoid stdio
as implementation - perhaps write a :vms layer ?
*/
- bytesread = PerlLIO_read(PerlIO_fileno(fp), buffer, recsize);
+ fd = PerlIO_fileno(fp);
+ if (fd == -1) { /* in-memory file from PerlIO::Scalar */
+ bytesread = PerlIO_read(fp, buffer, recsize);
+ }
+ else {
+ bytesread = PerlLIO_read(fd, buffer, recsize);
+ }
#else
bytesread = PerlIO_read(fp, buffer, recsize);
#endif
*/
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_newSVpvn_flags(pTHX_ const char *s, STRLEN len, U32 flags)
+Perl_newSVpvn_flags(pTHX_ const char *const s, const STRLEN len, const U32 flags)
{
dVAR;
register SV *sv;
*/
SV *
-Perl_sv_2mortal(pTHX_ register SV *sv)
+Perl_sv_2mortal(pTHX_ register SV *const sv)
{
dVAR;
if (!sv)
*/
SV *
-Perl_newSVpv(pTHX_ const char *s, STRLEN len)
+Perl_newSVpv(pTHX_ const char *const s, const STRLEN len)
{
dVAR;
register SV *sv;
*/
SV *
-Perl_newSVpvn(pTHX_ const char *s, STRLEN len)
+Perl_newSVpvn(pTHX_ const char *const s, const STRLEN len)
{
dVAR;
register SV *sv;
*/
SV *
-Perl_newSVhek(pTHX_ const HEK *hek)
+Perl_newSVhek(pTHX_ const HEK *const hek)
{
dVAR;
if (!hek) {
*/
SV *
-Perl_newSVpvf_nocontext(const char* pat, ...)
+Perl_newSVpvf_nocontext(const char *const pat, ...)
{
dTHX;
register SV *sv;
*/
SV *
-Perl_newSVpvf(pTHX_ const char* pat, ...)
+Perl_newSVpvf(pTHX_ const char *const pat, ...)
{
register SV *sv;
va_list args;
/* backend for newSVpvf() and newSVpvf_nocontext() */
SV *
-Perl_vnewSVpvf(pTHX_ const char* pat, va_list* args)
+Perl_vnewSVpvf(pTHX_ const char *const pat, va_list *const args)
{
dVAR;
register SV *sv;
*/
SV *
-Perl_newSVnv(pTHX_ NV n)
+Perl_newSVnv(pTHX_ const NV n)
{
dVAR;
register SV *sv;
*/
SV *
-Perl_newSViv(pTHX_ IV i)
+Perl_newSViv(pTHX_ const IV i)
{
dVAR;
register SV *sv;
*/
SV *
-Perl_newSVuv(pTHX_ UV u)
+Perl_newSVuv(pTHX_ const UV u)
{
dVAR;
register SV *sv;
*/
SV *
-Perl_newRV_noinc(pTHX_ SV *tmpRef)
+Perl_newRV_noinc(pTHX_ SV *const tmpRef)
{
dVAR;
register SV *sv = newSV_type(SVt_IV);
*/
SV *
-Perl_newRV(pTHX_ SV *sv)
+Perl_newRV(pTHX_ SV *const sv)
{
dVAR;
*/
SV *
-Perl_newSVsv(pTHX_ register SV *old)
+Perl_newSVsv(pTHX_ register SV *const old)
{
dVAR;
register SV *sv;
*/
void
-Perl_sv_reset(pTHX_ register const char *s, HV *stash)
+Perl_sv_reset(pTHX_ register const char *s, HV *const stash)
{
dVAR;
char todo[PERL_UCHAR_MAX+1];
*/
IO*
-Perl_sv_2io(pTHX_ SV *sv)
+Perl_sv_2io(pTHX_ SV *const sv)
{
IO* io;
GV* gv;
*/
CV *
-Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref)
+Perl_sv_2cv(pTHX_ SV *sv, HV **const st, GV **const gvp, const I32 lref)
{
dVAR;
GV *gv = NULL;
goto fix_gv;
default:
- SvGETMAGIC(sv);
if (SvROK(sv)) {
SV * const *sp = &sv; /* Used in tryAMAGICunDEREF macro. */
+ SvGETMAGIC(sv);
tryAMAGICunDEREF(to_cv);
sv = SvRV(sv);
else
Perl_croak(aTHX_ "Not a subroutine reference");
}
- else if (isGV(sv))
+ else if (isGV(sv)) {
+ SvGETMAGIC(sv);
gv = (GV*)sv;
+ }
else
- gv = gv_fetchsv(sv, lref, SVt_PVCV);
+ gv = gv_fetchsv(sv, lref, SVt_PVCV); /* Calls get magic */
*gvp = gv;
if (!gv) {
*st = NULL;
LEAVE;
if (!GvCVu(gv))
Perl_croak(aTHX_ "Unable to create sub named \"%"SVf"\"",
- SVfARG(sv));
+ SVfARG(SvOK(sv) ? sv : &PL_sv_no));
}
return GvCVu(gv);
}
*/
I32
-Perl_sv_true(pTHX_ register SV *sv)
+Perl_sv_true(pTHX_ register SV *const sv)
{
if (!sv)
return 0;
*/
char *
-Perl_sv_pvn_force_flags(pTHX_ SV *sv, STRLEN *lp, I32 flags)
+Perl_sv_pvn_force_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags)
{
dVAR;
*/
char *
-Perl_sv_pvbyten_force(pTHX_ SV *sv, STRLEN *lp)
+Perl_sv_pvbyten_force(pTHX_ SV *const sv, STRLEN *const lp)
{
PERL_ARGS_ASSERT_SV_PVBYTEN_FORCE;
*/
char *
-Perl_sv_pvutf8n_force(pTHX_ SV *sv, STRLEN *lp)
+Perl_sv_pvutf8n_force(pTHX_ SV *const sv, STRLEN *const lp)
{
PERL_ARGS_ASSERT_SV_PVUTF8N_FORCE;
*/
const char *
-Perl_sv_reftype(pTHX_ const SV *sv, int ob)
+Perl_sv_reftype(pTHX_ const SV *const sv, const int ob)
{
PERL_ARGS_ASSERT_SV_REFTYPE;
*/
int
-Perl_sv_isa(pTHX_ SV *sv, const char *name)
+Perl_sv_isa(pTHX_ SV *sv, const char *const name)
{
const char *hvname;
*/
SV*
-Perl_newSVrv(pTHX_ SV *rv, const char *classname)
+Perl_newSVrv(pTHX_ SV *const rv, const char *const classname)
{
dVAR;
SV *sv;
*/
SV*
-Perl_sv_setref_pv(pTHX_ SV *rv, const char *classname, void *pv)
+Perl_sv_setref_pv(pTHX_ SV *const rv, const char *const classname, void *const pv)
{
dVAR;
*/
SV*
-Perl_sv_setref_iv(pTHX_ SV *rv, const char *classname, IV iv)
+Perl_sv_setref_iv(pTHX_ SV *const rv, const char *const classname, const IV iv)
{
PERL_ARGS_ASSERT_SV_SETREF_IV;
*/
SV*
-Perl_sv_setref_uv(pTHX_ SV *rv, const char *classname, UV uv)
+Perl_sv_setref_uv(pTHX_ SV *const rv, const char *const classname, const UV uv)
{
PERL_ARGS_ASSERT_SV_SETREF_UV;
*/
SV*
-Perl_sv_setref_nv(pTHX_ SV *rv, const char *classname, NV nv)
+Perl_sv_setref_nv(pTHX_ SV *const rv, const char *const classname, const NV nv)
{
PERL_ARGS_ASSERT_SV_SETREF_NV;
*/
SV*
-Perl_sv_setref_pvn(pTHX_ SV *rv, const char *classname, const char *pv, STRLEN n)
+Perl_sv_setref_pvn(pTHX_ SV *const rv, const char *const classname,
+ const char *const pv, const STRLEN n)
{
PERL_ARGS_ASSERT_SV_SETREF_PVN;
*/
SV*
-Perl_sv_bless(pTHX_ SV *sv, HV *stash)
+Perl_sv_bless(pTHX_ SV *const sv, HV *const stash)
{
dVAR;
SV *tmpRef;
*/
STATIC void
-S_sv_unglob(pTHX_ SV *sv)
+S_sv_unglob(pTHX_ SV *const sv)
{
dVAR;
void *xpvmg;
*/
void
-Perl_sv_unref_flags(pTHX_ SV *ref, U32 flags)
+Perl_sv_unref_flags(pTHX_ SV *const ref, const U32 flags)
{
SV* const target = SvRV(ref);
*/
void
-Perl_sv_untaint(pTHX_ SV *sv)
+Perl_sv_untaint(pTHX_ SV *const sv)
{
PERL_ARGS_ASSERT_SV_UNTAINT;
*/
bool
-Perl_sv_tainted(pTHX_ SV *sv)
+Perl_sv_tainted(pTHX_ SV *const sv)
{
PERL_ARGS_ASSERT_SV_TAINTED;
*/
void
-Perl_sv_setpviv(pTHX_ SV *sv, IV iv)
+Perl_sv_setpviv(pTHX_ SV *const sv, const IV iv)
{
char buf[TYPE_CHARS(UV)];
char *ebuf;
*/
void
-Perl_sv_setpviv_mg(pTHX_ SV *sv, IV iv)
+Perl_sv_setpviv_mg(pTHX_ SV *const sv, const IV iv)
{
PERL_ARGS_ASSERT_SV_SETPVIV_MG;
*/
void
-Perl_sv_setpvf_nocontext(SV *sv, const char* pat, ...)
+Perl_sv_setpvf_nocontext(SV *const sv, const char *const pat, ...)
{
dTHX;
va_list args;
*/
void
-Perl_sv_setpvf_mg_nocontext(SV *sv, const char* pat, ...)
+Perl_sv_setpvf_mg_nocontext(SV *const sv, const char *const pat, ...)
{
dTHX;
va_list args;
*/
void
-Perl_sv_setpvf(pTHX_ SV *sv, const char* pat, ...)
+Perl_sv_setpvf(pTHX_ SV *const sv, const char *const pat, ...)
{
va_list args;
*/
void
-Perl_sv_vsetpvf(pTHX_ SV *sv, const char* pat, va_list* args)
+Perl_sv_vsetpvf(pTHX_ SV *const sv, const char *const pat, va_list *const args)
{
PERL_ARGS_ASSERT_SV_VSETPVF;
*/
void
-Perl_sv_setpvf_mg(pTHX_ SV *sv, const char* pat, ...)
+Perl_sv_setpvf_mg(pTHX_ SV *const sv, const char *const pat, ...)
{
va_list args;
*/
void
-Perl_sv_vsetpvf_mg(pTHX_ SV *sv, const char* pat, va_list* args)
+Perl_sv_vsetpvf_mg(pTHX_ SV *const sv, const char *const pat, va_list *const args)
{
PERL_ARGS_ASSERT_SV_VSETPVF_MG;
*/
void
-Perl_sv_catpvf_nocontext(SV *sv, const char* pat, ...)
+Perl_sv_catpvf_nocontext(SV *const sv, const char *const pat, ...)
{
dTHX;
va_list args;
*/
void
-Perl_sv_catpvf_mg_nocontext(SV *sv, const char* pat, ...)
+Perl_sv_catpvf_mg_nocontext(SV *const sv, const char *const pat, ...)
{
dTHX;
va_list args;
=cut */
void
-Perl_sv_catpvf(pTHX_ SV *sv, const char* pat, ...)
+Perl_sv_catpvf(pTHX_ SV *const sv, const char *const pat, ...)
{
va_list args;
*/
void
-Perl_sv_vcatpvf(pTHX_ SV *sv, const char* pat, va_list* args)
+Perl_sv_vcatpvf(pTHX_ SV *const sv, const char *const pat, va_list *const args)
{
PERL_ARGS_ASSERT_SV_VCATPVF;
*/
void
-Perl_sv_catpvf_mg(pTHX_ SV *sv, const char* pat, ...)
+Perl_sv_catpvf_mg(pTHX_ SV *const sv, const char *const pat, ...)
{
va_list args;
*/
void
-Perl_sv_vcatpvf_mg(pTHX_ SV *sv, const char* pat, va_list* args)
+Perl_sv_vcatpvf_mg(pTHX_ SV *const sv, const char *const pat, va_list *const args)
{
PERL_ARGS_ASSERT_SV_VCATPVF_MG;
*/
void
-Perl_sv_vsetpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs, I32 svmax, bool *maybe_tainted)
+Perl_sv_vsetpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
+ va_list *const args, SV **const svargs, const I32 svmax, bool *const maybe_tainted)
{
PERL_ARGS_ASSERT_SV_VSETPVFN;
}
STATIC I32
-S_expect_number(pTHX_ char** pattern)
+S_expect_number(pTHX_ char **const pattern)
{
dVAR;
I32 var = 0;
}
STATIC char *
-S_F0convert(NV nv, char *endbuf, STRLEN *len)
+S_F0convert(NV nv, char *const endbuf, STRLEN *const len)
{
const int neg = nv < 0;
UV uv;
/* XXX maybe_tainted is never assigned to, so the doc above is lying. */
void
-Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs, I32 svmax, bool *maybe_tainted)
+Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
+ va_list *const args, SV **const svargs, const I32 svmax, bool *const maybe_tainted)
{
dVAR;
char *p;
/* clone a parser */
yy_parser *
-Perl_parser_dup(pTHX_ const yy_parser *proto, CLONE_PARAMS* param)
+Perl_parser_dup(pTHX_ const yy_parser *const proto, CLONE_PARAMS *const param)
{
yy_parser *parser;
/* duplicate a file handle */
PerlIO *
-Perl_fp_dup(pTHX_ PerlIO *fp, char type, CLONE_PARAMS *param)
+Perl_fp_dup(pTHX_ PerlIO *const fp, const char type, CLONE_PARAMS *const param)
{
PerlIO *ret;
/* duplicate a directory handle */
DIR *
-Perl_dirp_dup(pTHX_ DIR *dp)
+Perl_dirp_dup(pTHX_ DIR *const dp)
{
PERL_UNUSED_CONTEXT;
if (!dp)
/* duplicate a typeglob */
GP *
-Perl_gp_dup(pTHX_ GP *gp, CLONE_PARAMS* param)
+Perl_gp_dup(pTHX_ GP *const gp, CLONE_PARAMS *const param)
{
GP *ret;
/* duplicate a chain of magic */
MAGIC *
-Perl_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS* param)
+Perl_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *const param)
{
MAGIC *mgprev = (MAGIC*)NULL;
MAGIC *mgret;
/* map an existing pointer using a table */
STATIC PTR_TBL_ENT_t *
-S_ptr_table_find(PTR_TBL_t *tbl, const void *sv)
+S_ptr_table_find(PTR_TBL_t *const tbl, const void *const sv)
{
PTR_TBL_ENT_t *tblent;
const UV hash = PTR_TABLE_HASH(sv);
}
void *
-Perl_ptr_table_fetch(pTHX_ PTR_TBL_t *tbl, const void *sv)
+Perl_ptr_table_fetch(pTHX_ PTR_TBL_t *const tbl, const void *const sv)
{
PTR_TBL_ENT_t const *const tblent = ptr_table_find(tbl, sv);
/* add a new entry to a pointer-mapping table */
void
-Perl_ptr_table_store(pTHX_ PTR_TBL_t *tbl, const void *oldsv, void *newsv)
+Perl_ptr_table_store(pTHX_ PTR_TBL_t *const tbl, const void *const oldsv, void *const newsv)
{
PTR_TBL_ENT_t *tblent = ptr_table_find(tbl, oldsv);
/* double the hash bucket size of an existing ptr table */
void
-Perl_ptr_table_split(pTHX_ PTR_TBL_t *tbl)
+Perl_ptr_table_split(pTHX_ PTR_TBL_t *const tbl)
{
PTR_TBL_ENT_t **ary = tbl->tbl_ary;
const UV oldsize = tbl->tbl_max + 1;
/* remove all the entries from a ptr table */
void
-Perl_ptr_table_clear(pTHX_ PTR_TBL_t *tbl)
+Perl_ptr_table_clear(pTHX_ PTR_TBL_t *const tbl)
{
if (tbl && tbl->tbl_items) {
register PTR_TBL_ENT_t * const * const array = tbl->tbl_ary;
/* clear and free a ptr table */
void
-Perl_ptr_table_free(pTHX_ PTR_TBL_t *tbl)
+Perl_ptr_table_free(pTHX_ PTR_TBL_t *const tbl)
{
if (!tbl) {
return;
#if defined(USE_ITHREADS)
void
-Perl_rvpv_dup(pTHX_ SV *dstr, const SV *sstr, CLONE_PARAMS* param)
+Perl_rvpv_dup(pTHX_ SV *const dstr, const SV *const sstr, CLONE_PARAMS *const param)
{
PERL_ARGS_ASSERT_RVPV_DUP;
/* duplicate an SV of any type (including AV, HV etc) */
SV *
-Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param)
+Perl_sv_dup(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
{
dVAR;
SV *dstr;
* 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) {
*SvPVX(name) = '$';
Perl_sv_catpvf(aTHX_ name, "[%"IVdf"]", (IV)aindex);
}
- else if (subscript_type == FUV_SUBSCRIPT_WITHIN)
- Perl_sv_insert(aTHX_ name, 0, 0, STR_WITH_LEN("within "));
+ else if (subscript_type == FUV_SUBSCRIPT_WITHIN) {
+ /* We know that name has no magic, so can use 0 instead of SV_GMAGIC */
+ Perl_sv_insert_flags(aTHX_ name, 0, 0, STR_WITH_LEN("within "), 0);
+ }
return name;
}
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 */
https://perl5.git.perl.org / perl5.git / blobdiff