else {
U32 u;
CV *cv = find_runcv(&u);
- STRLEN len;
- const char *str;
if (!cv || !CvPADLIST(cv))
return Nullsv;;
av = (AV*)(*av_fetch(CvPADLIST(cv), 0, FALSE));
sv = *av_fetch(av, targ, FALSE);
/* SvLEN in a pad name is not to be trusted */
- str = SvPV_const(sv,len);
- sv_setpvn(name, str, len);
+ sv_setpv(name, SvPV_nolen_const(sv));
}
if (subscript_type == FUV_SUBSCRIPT_HASH) {
"", "", "");
}
-/* allocate another arena's worth of NV bodies */
-
STATIC void
-S_more_xnv(pTHX)
+S_more_bodies (pTHX_ void **arena_root, void **root, size_t size)
{
- NV* xnv;
- NV* xnvend;
- void *ptr;
- New(711, ptr, PERL_ARENA_SIZE/sizeof(NV), NV);
- *((void **) ptr) = (void *)PL_xnv_arenaroot;
- PL_xnv_arenaroot = ptr;
-
- xnv = (NV*) ptr;
- xnvend = &xnv[PERL_ARENA_SIZE / sizeof(NV) - 1];
- xnv += (sizeof(XPVIV) - 1) / sizeof(NV) + 1; /* fudge by sizeof XPVIV */
- PL_xnv_root = xnv;
- while (xnv < xnvend) {
- *(NV**)xnv = (NV*)(xnv + 1);
- xnv++;
- }
- *(NV**)xnv = 0;
-}
-
-/* allocate another arena's worth of struct xpv */
-
-STATIC void
-S_more_xpv(pTHX)
-{
- xpv_allocated* xpv;
- xpv_allocated* xpvend;
- New(713, xpv, PERL_ARENA_SIZE/sizeof(xpv_allocated), xpv_allocated);
- *((xpv_allocated**)xpv) = PL_xpv_arenaroot;
- PL_xpv_arenaroot = xpv;
-
- xpvend = &xpv[PERL_ARENA_SIZE / sizeof(xpv_allocated) - 1];
- PL_xpv_root = ++xpv;
- while (xpv < xpvend) {
- *((xpv_allocated**)xpv) = xpv + 1;
- xpv++;
- }
- *((xpv_allocated**)xpv) = 0;
-}
-
-/* allocate another arena's worth of struct xpviv */
-
-STATIC void
-S_more_xpviv(pTHX)
-{
- xpviv_allocated* xpviv;
- xpviv_allocated* xpvivend;
- New(713, xpviv, PERL_ARENA_SIZE/sizeof(xpviv_allocated), xpviv_allocated);
- *((xpviv_allocated**)xpviv) = PL_xpviv_arenaroot;
- PL_xpviv_arenaroot = xpviv;
-
- xpvivend = &xpviv[PERL_ARENA_SIZE / sizeof(xpviv_allocated) - 1];
- PL_xpviv_root = ++xpviv;
- while (xpviv < xpvivend) {
- *((xpviv_allocated**)xpviv) = xpviv + 1;
- xpviv++;
- }
- *((xpviv_allocated**)xpviv) = 0;
-}
+ char *start;
+ const char *end;
+ size_t count = PERL_ARENA_SIZE/size;
+ New(0, start, count*size, char);
+ *((void **) start) = *arena_root;
+ *arena_root = (void *)start;
-/* allocate another arena's worth of struct xpvnv */
+ end = start + (count-1) * size;
-STATIC void
-S_more_xpvnv(pTHX)
-{
- XPVNV* xpvnv;
- XPVNV* xpvnvend;
- New(715, xpvnv, PERL_ARENA_SIZE/sizeof(XPVNV), XPVNV);
- *((XPVNV**)xpvnv) = PL_xpvnv_arenaroot;
- PL_xpvnv_arenaroot = xpvnv;
+ /* The initial slot is used to link the arenas together, so it isn't to be
+ linked into the list of ready-to-use bodies. */
- xpvnvend = &xpvnv[PERL_ARENA_SIZE / sizeof(XPVNV) - 1];
- PL_xpvnv_root = ++xpvnv;
- while (xpvnv < xpvnvend) {
- *((XPVNV**)xpvnv) = xpvnv + 1;
- xpvnv++;
- }
- *((XPVNV**)xpvnv) = 0;
-}
+ start += size;
-/* allocate another arena's worth of struct xpvcv */
+ *root = (void *)start;
-STATIC void
-S_more_xpvcv(pTHX)
-{
- XPVCV* xpvcv;
- XPVCV* xpvcvend;
- New(716, xpvcv, PERL_ARENA_SIZE/sizeof(XPVCV), XPVCV);
- *((XPVCV**)xpvcv) = PL_xpvcv_arenaroot;
- PL_xpvcv_arenaroot = xpvcv;
-
- xpvcvend = &xpvcv[PERL_ARENA_SIZE / sizeof(XPVCV) - 1];
- PL_xpvcv_root = ++xpvcv;
- while (xpvcv < xpvcvend) {
- *((XPVCV**)xpvcv) = xpvcv + 1;
- xpvcv++;
+ while (start < end) {
+ char *next = start + size;
+ *(void**) start = (void *)next;
+ start = next;
}
- *((XPVCV**)xpvcv) = 0;
+ *(void **)start = 0;
}
-/* allocate another arena's worth of struct xpvav */
+#define more_thingy(TYPE,lctype) \
+ S_more_bodies(aTHX_ (void**)&PL_## lctype ## _arenaroot, \
+ (void**)&PL_ ## lctype ## _root, \
+ sizeof(TYPE))
-STATIC void
-S_more_xpvav(pTHX)
-{
- xpvav_allocated* xpvav;
- xpvav_allocated* xpvavend;
- New(717, xpvav, PERL_ARENA_SIZE/sizeof(xpvav_allocated),
- xpvav_allocated);
- *((xpvav_allocated**)xpvav) = PL_xpvav_arenaroot;
- PL_xpvav_arenaroot = xpvav;
-
- xpvavend = &xpvav[PERL_ARENA_SIZE / sizeof(xpvav_allocated) - 1];
- PL_xpvav_root = ++xpvav;
- while (xpvav < xpvavend) {
- *((xpvav_allocated**)xpvav) = xpvav + 1;
- xpvav++;
- }
- *((xpvav_allocated**)xpvav) = 0;
-}
+#define more_thingy_allocated(lctype) \
+ S_more_bodies(aTHX_ (void**)&PL_## lctype ## _arenaroot, \
+ (void**)&PL_ ## lctype ## _root, \
+ sizeof(lctype ## _allocated))
-/* allocate another arena's worth of struct xpvhv */
-STATIC void
-S_more_xpvhv(pTHX)
-{
- xpvhv_allocated* xpvhv;
- xpvhv_allocated* xpvhvend;
- New(718, xpvhv, PERL_ARENA_SIZE/sizeof(xpvhv_allocated),
- xpvhv_allocated);
- *((xpvhv_allocated**)xpvhv) = PL_xpvhv_arenaroot;
- PL_xpvhv_arenaroot = xpvhv;
+#define more_xnv() more_thingy(NV, xnv)
+#define more_xpv() more_thingy_allocated(xpv)
+#define more_xpviv() more_thingy_allocated(xpviv)
+#define more_xpvnv() more_thingy(XPVNV, xpvnv)
+#define more_xpvcv() more_thingy(XPVCV, xpvcv)
+#define more_xpvav() more_thingy_allocated(xpvav)
+#define more_xpvhv() more_thingy_allocated(xpvhv)
+#define more_xpvgv() more_thingy(XPVGV, xpvgv)
+#define more_xpvmg() more_thingy(XPVMG, xpvmg)
+#define more_xpvbm() more_thingy(XPVBM, xpvbm)
+#define more_xpvlv() more_thingy(XPVLV, xpvlv)
- xpvhvend = &xpvhv[PERL_ARENA_SIZE / sizeof(xpvhv_allocated) - 1];
- PL_xpvhv_root = ++xpvhv;
- while (xpvhv < xpvhvend) {
- *((xpvhv_allocated**)xpvhv) = xpvhv + 1;
- xpvhv++;
- }
- *((xpvhv_allocated**)xpvhv) = 0;
-}
-
-/* allocate another arena's worth of struct xpvmg */
-
-STATIC void
-S_more_xpvmg(pTHX)
-{
- XPVMG* xpvmg;
- XPVMG* xpvmgend;
- New(719, xpvmg, PERL_ARENA_SIZE/sizeof(XPVMG), XPVMG);
- *((XPVMG**)xpvmg) = PL_xpvmg_arenaroot;
- PL_xpvmg_arenaroot = xpvmg;
-
- xpvmgend = &xpvmg[PERL_ARENA_SIZE / sizeof(XPVMG) - 1];
- PL_xpvmg_root = ++xpvmg;
- while (xpvmg < xpvmgend) {
- *((XPVMG**)xpvmg) = xpvmg + 1;
- xpvmg++;
- }
- *((XPVMG**)xpvmg) = 0;
-}
-
-/* allocate another arena's worth of struct xpvgv */
-
-STATIC void
-S_more_xpvgv(pTHX)
-{
- XPVGV* xpvgv;
- XPVGV* xpvgvend;
- New(720, xpvgv, PERL_ARENA_SIZE/sizeof(XPVGV), XPVGV);
- *((XPVGV**)xpvgv) = PL_xpvgv_arenaroot;
- PL_xpvgv_arenaroot = xpvgv;
-
- xpvgvend = &xpvgv[PERL_ARENA_SIZE / sizeof(XPVGV) - 1];
- PL_xpvgv_root = ++xpvgv;
- while (xpvgv < xpvgvend) {
- *((XPVGV**)xpvgv) = xpvgv + 1;
- xpvgv++;
- }
- *((XPVGV**)xpvgv) = 0;
-}
-
-/* allocate another arena's worth of struct xpvlv */
-
-STATIC void
-S_more_xpvlv(pTHX)
-{
- XPVLV* xpvlv;
- XPVLV* xpvlvend;
- New(720, xpvlv, PERL_ARENA_SIZE/sizeof(XPVLV), XPVLV);
- *((XPVLV**)xpvlv) = PL_xpvlv_arenaroot;
- PL_xpvlv_arenaroot = xpvlv;
-
- xpvlvend = &xpvlv[PERL_ARENA_SIZE / sizeof(XPVLV) - 1];
- PL_xpvlv_root = ++xpvlv;
- while (xpvlv < xpvlvend) {
- *((XPVLV**)xpvlv) = xpvlv + 1;
- xpvlv++;
- }
- *((XPVLV**)xpvlv) = 0;
-}
-
-/* allocate another arena's worth of struct xpvbm */
-
-STATIC void
-S_more_xpvbm(pTHX)
-{
- XPVBM* xpvbm;
- XPVBM* xpvbmend;
- New(721, xpvbm, PERL_ARENA_SIZE/sizeof(XPVBM), XPVBM);
- *((XPVBM**)xpvbm) = PL_xpvbm_arenaroot;
- PL_xpvbm_arenaroot = xpvbm;
-
- xpvbmend = &xpvbm[PERL_ARENA_SIZE / sizeof(XPVBM) - 1];
- PL_xpvbm_root = ++xpvbm;
- while (xpvbm < xpvbmend) {
- *((XPVBM**)xpvbm) = xpvbm + 1;
- xpvbm++;
- }
- *((XPVBM**)xpvbm) = 0;
-}
/* grab a new NV body from the free list, allocating more if necessary */
NV* xnv;
LOCK_SV_MUTEX;
if (!PL_xnv_root)
- S_more_xnv(aTHX);
+ more_xnv();
xnv = PL_xnv_root;
PL_xnv_root = *(NV**)xnv;
UNLOCK_SV_MUTEX;
xpv_allocated* xpv;
LOCK_SV_MUTEX;
if (!PL_xpv_root)
- S_more_xpv(aTHX);
+ more_xpv();
xpv = PL_xpv_root;
PL_xpv_root = *(xpv_allocated**)xpv;
UNLOCK_SV_MUTEX;
xpviv_allocated* xpviv;
LOCK_SV_MUTEX;
if (!PL_xpviv_root)
- S_more_xpviv(aTHX);
+ more_xpviv();
xpviv = PL_xpviv_root;
PL_xpviv_root = *(xpviv_allocated**)xpviv;
UNLOCK_SV_MUTEX;
XPVNV* xpvnv;
LOCK_SV_MUTEX;
if (!PL_xpvnv_root)
- S_more_xpvnv(aTHX);
+ more_xpvnv();
xpvnv = PL_xpvnv_root;
PL_xpvnv_root = *(XPVNV**)xpvnv;
UNLOCK_SV_MUTEX;
XPVCV* xpvcv;
LOCK_SV_MUTEX;
if (!PL_xpvcv_root)
- S_more_xpvcv(aTHX);
+ more_xpvcv();
xpvcv = PL_xpvcv_root;
PL_xpvcv_root = *(XPVCV**)xpvcv;
UNLOCK_SV_MUTEX;
xpvav_allocated* xpvav;
LOCK_SV_MUTEX;
if (!PL_xpvav_root)
- S_more_xpvav(aTHX);
+ more_xpvav();
xpvav = PL_xpvav_root;
PL_xpvav_root = *(xpvav_allocated**)xpvav;
UNLOCK_SV_MUTEX;
xpvhv_allocated* xpvhv;
LOCK_SV_MUTEX;
if (!PL_xpvhv_root)
- S_more_xpvhv(aTHX);
+ more_xpvhv();
xpvhv = PL_xpvhv_root;
PL_xpvhv_root = *(xpvhv_allocated**)xpvhv;
UNLOCK_SV_MUTEX;
XPVMG* xpvmg;
LOCK_SV_MUTEX;
if (!PL_xpvmg_root)
- S_more_xpvmg(aTHX);
+ more_xpvmg();
xpvmg = PL_xpvmg_root;
PL_xpvmg_root = *(XPVMG**)xpvmg;
UNLOCK_SV_MUTEX;
XPVGV* xpvgv;
LOCK_SV_MUTEX;
if (!PL_xpvgv_root)
- S_more_xpvgv(aTHX);
+ more_xpvgv();
xpvgv = PL_xpvgv_root;
PL_xpvgv_root = *(XPVGV**)xpvgv;
UNLOCK_SV_MUTEX;
XPVLV* xpvlv;
LOCK_SV_MUTEX;
if (!PL_xpvlv_root)
- S_more_xpvlv(aTHX);
+ more_xpvlv();
xpvlv = PL_xpvlv_root;
PL_xpvlv_root = *(XPVLV**)xpvlv;
UNLOCK_SV_MUTEX;
XPVBM* xpvbm;
LOCK_SV_MUTEX;
if (!PL_xpvbm_root)
- S_more_xpvbm(aTHX);
+ more_xpvbm();
xpvbm = PL_xpvbm_root;
PL_xpvbm_root = *(XPVBM**)xpvbm;
UNLOCK_SV_MUTEX;
=cut
*/
-bool
+void
Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
{
}
if (SvTYPE(sv) == mt)
- return TRUE;
+ return;
pv = NULL;
cur = 0;
SvLEN_set(sv, len);
break;
}
- return TRUE;
}
/*
Perl_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
{
sv_utf8_downgrade(sv,0);
- return SvPV(sv,*lp);
+ return lp ? SvPV(sv,*lp) : SvPV_nolen(sv);
}
/*
}
if (hibit) {
STRLEN len = SvCUR(sv) + 1; /* Plus the \0 */
- char *recoded = bytes_to_utf8((U8*)s, &len);
+ U8 *recoded = bytes_to_utf8((U8*)s, &len);
SvPV_free(sv); /* No longer using what was there before. */
- SvPV_set(sv, recoded);
+ SvPV_set(sv, (char*)recoded);
SvCUR_set(sv, len - 1);
SvLEN_set(sv, len); /* No longer know the real size. */
}
#endif
{
/* SvIsCOW_shared_hash */
- UV hash = SvSHARED_HASH(sstr);
DEBUG_C(PerlIO_printf(Perl_debug_log,
"Copy on write: Sharing hash\n"));
assert (SvTYPE(dstr) >= SVt_PV);
- /* FIXME - would benefit from share_hek_hek */
SvPV_set(dstr,
- sharepvn(SvPVX_const(sstr),
- (sflags & SVf_UTF8?-cur:cur), hash));
+ HEK_KEY(share_hek_hek(SvSHARED_HEK_FROM_PV(SvPVX_const(sstr)))));
}
SvLEN_set(dstr, len);
SvCUR_set(dstr, cur);
}
if (sflags & SVf_UTF8)
SvUTF8_on(dstr);
- /*SUPPRESS 560*/
if (sflags & SVp_NOK) {
SvNOKp_on(dstr);
if (sflags & SVf_NOK)
if (SvLEN(sstr) == 0) {
/* source is a COW shared hash key. */
- UV hash = SvSHARED_HASH(sstr);
DEBUG_C(PerlIO_printf(Perl_debug_log,
"Fast copy on write: Sharing hash\n"));
- /* FIXME - would benefit from share_hek_hek */
- new_pv = sharepvn(SvPVX_const(sstr), (SvUTF8(sstr)?-cur:cur), hash);
+ new_pv = HEK_KEY(share_hek_hek(SvSHARED_HEK_FROM_PV(SvPVX_const(sstr))));
goto common_exit;
}
SV_COW_NEXT_SV_SET(dstr, SV_COW_NEXT_SV(sstr));
*mid = '\0';
SvCUR_set(bigstr, mid - big);
}
- /*SUPPRESS 560*/
else if ((i = mid - big)) { /* faster from front */
midend -= littlelen;
mid = midend;
}
else {
/* Special case - not normally malloced for some reason */
- if (SvREADONLY(sstr) && SvFAKE(sstr)) {
- /* A "shared" PV - clone it as unshared string */
- if(SvPADTMP(sstr)) {
- /* However, some of them live in the pad
- and they should not have these flags
- turned off */
-
- /* FIXME - would benefit from share_hek_hek */
- SvPV_set(dstr, sharepvn(SvPVX_const(sstr), SvCUR(sstr),
- SvUVX(sstr)));
- } else {
-
- SvPV_set(dstr, SAVEPVN(SvPVX_const(sstr), SvCUR(sstr)));
- SvFAKE_off(dstr);
- SvREADONLY_off(dstr);
- }
+ if ((SvREADONLY(sstr) && SvFAKE(sstr))) {
+ /* A "shared" PV - clone it as "shared" PV */
+ SvPV_set(dstr,
+ HEK_KEY(hek_dup(SvSHARED_HEK_FROM_PV(SvPVX_const(sstr)),
+ param)));
}
else {
/* Some other special case - random pointer */
/* create SV map for pointer relocation */
PL_ptr_table = ptr_table_new();
- /* and one for finding shared hash keys quickly */
- PL_shared_hek_table = ptr_table_new();
/* initialize these special pointers as early as possible */
SvANY(&PL_sv_undef) = NULL;
if (!(flags & CLONEf_KEEP_PTR_TABLE)) {
ptr_table_free(PL_ptr_table);
PL_ptr_table = NULL;
- ptr_table_free(PL_shared_hek_table);
- PL_shared_hek_table = NULL;
}
/* Call the ->CLONE method, if it exists, for each of the stashes
https://perl5.git.perl.org / perl5.git / blobdiff