{
SV* sva;
SV* svanext;
- XPV *arena, *arenanext;
+ void *arena, *arenanext;
/* Free arenas here, but be careful about fake ones. (We assume
contiguity of the fake ones with the corresponding real ones.) */
svanext = (SV*) SvANY(svanext);
if (!SvFAKE(sva))
- Safefree((void *)sva);
+ Safefree(sva);
}
- for (arena = PL_xiv_arenaroot; arena; arena = arenanext) {
- arenanext = (XPV*)arena->xpv_pv;
- Safefree(arena);
- }
- PL_xiv_arenaroot = 0;
- PL_xiv_root = 0;
-
for (arena = PL_xnv_arenaroot; arena; arena = arenanext) {
- arenanext = (XPV*)arena->xpv_pv;
+ arenanext = *(void **)arena;
Safefree(arena);
}
PL_xnv_arenaroot = 0;
PL_xnv_root = 0;
- for (arena = PL_xrv_arenaroot; arena; arena = arenanext) {
- arenanext = (XPV*)arena->xpv_pv;
- Safefree(arena);
- }
- PL_xrv_arenaroot = 0;
- PL_xrv_root = 0;
-
for (arena = PL_xpv_arenaroot; arena; arena = arenanext) {
- arenanext = (XPV*)arena->xpv_pv;
+ arenanext = *(void **)arena;
Safefree(arena);
}
PL_xpv_arenaroot = 0;
PL_xpv_root = 0;
- for (arena = (XPV*)PL_xpviv_arenaroot; arena; arena = arenanext) {
- arenanext = (XPV*)arena->xpv_pv;
+ for (arena = PL_xpviv_arenaroot; arena; arena = arenanext) {
+ arenanext = *(void **)arena;
Safefree(arena);
}
PL_xpviv_arenaroot = 0;
PL_xpviv_root = 0;
- for (arena = (XPV*)PL_xpvnv_arenaroot; arena; arena = arenanext) {
- arenanext = (XPV*)arena->xpv_pv;
+ for (arena = PL_xpvnv_arenaroot; arena; arena = arenanext) {
+ arenanext = *(void **)arena;
Safefree(arena);
}
PL_xpvnv_arenaroot = 0;
PL_xpvnv_root = 0;
- for (arena = (XPV*)PL_xpvcv_arenaroot; arena; arena = arenanext) {
- arenanext = (XPV*)arena->xpv_pv;
+ for (arena = PL_xpvcv_arenaroot; arena; arena = arenanext) {
+ arenanext = *(void **)arena;
Safefree(arena);
}
PL_xpvcv_arenaroot = 0;
PL_xpvcv_root = 0;
- for (arena = (XPV*)PL_xpvav_arenaroot; arena; arena = arenanext) {
- arenanext = (XPV*)arena->xpv_pv;
+ for (arena = PL_xpvav_arenaroot; arena; arena = arenanext) {
+ arenanext = *(void **)arena;
Safefree(arena);
}
PL_xpvav_arenaroot = 0;
PL_xpvav_root = 0;
- for (arena = (XPV*)PL_xpvhv_arenaroot; arena; arena = arenanext) {
- arenanext = (XPV*)arena->xpv_pv;
+ for (arena = PL_xpvhv_arenaroot; arena; arena = arenanext) {
+ arenanext = *(void **)arena;
Safefree(arena);
}
PL_xpvhv_arenaroot = 0;
PL_xpvhv_root = 0;
- for (arena = (XPV*)PL_xpvmg_arenaroot; arena; arena = arenanext) {
- arenanext = (XPV*)arena->xpv_pv;
+ for (arena = PL_xpvmg_arenaroot; arena; arena = arenanext) {
+ arenanext = *(void **)arena;
Safefree(arena);
}
PL_xpvmg_arenaroot = 0;
PL_xpvmg_root = 0;
- for (arena = (XPV*)PL_xpvgv_arenaroot; arena; arena = arenanext) {
- arenanext = (XPV*)arena->xpv_pv;
+ for (arena = PL_xpvgv_arenaroot; arena; arena = arenanext) {
+ arenanext = *(void **)arena;
Safefree(arena);
}
PL_xpvgv_arenaroot = 0;
PL_xpvgv_root = 0;
- for (arena = (XPV*)PL_xpvlv_arenaroot; arena; arena = arenanext) {
- arenanext = (XPV*)arena->xpv_pv;
+ for (arena = PL_xpvlv_arenaroot; arena; arena = arenanext) {
+ arenanext = *(void **)arena;
Safefree(arena);
}
PL_xpvlv_arenaroot = 0;
PL_xpvlv_root = 0;
- for (arena = (XPV*)PL_xpvbm_arenaroot; arena; arena = arenanext) {
- arenanext = (XPV*)arena->xpv_pv;
+ for (arena = PL_xpvbm_arenaroot; arena; arena = arenanext) {
+ arenanext = *(void **)arena;
Safefree(arena);
}
PL_xpvbm_arenaroot = 0;
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 */
- sv_setpv(name, SvPV_nolen(sv));
+ str = SvPV(sv,len);
+ sv_setpvn(name, str, len);
}
if (subscript_type == FUV_SUBSCRIPT_HASH) {
*SvPVX(name) = '$';
sv = NEWSV(0,0);
Perl_sv_catpvf(aTHX_ name, "{%s}",
- pv_display(sv,SvPVX(keyname), SvCUR(keyname), 0, 32));
+ pv_display(sv,SvPVX_const(keyname), SvCUR(keyname), 0, 32));
SvREFCNT_dec(sv);
}
else if (subscript_type == FUV_SUBSCRIPT_ARRAY) {
: DEFSV))
{
sv = sv_newmortal();
- sv_setpv(sv, "$_");
+ sv_setpvn(sv, "$_", 2);
return sv;
}
}
"", "", "");
}
-
-/* allocate another arena's worth of struct xrv */
-
-STATIC void
-S_more_xrv(pTHX)
-{
- XRV* xrv;
- XRV* xrvend;
- XPV *ptr;
- New(712, ptr, PERL_ARENA_SIZE/sizeof(XPV), XPV);
- ptr->xpv_pv = (char*)PL_xrv_arenaroot;
- PL_xrv_arenaroot = ptr;
-
- xrv = (XRV*) ptr;
- xrvend = &xrv[PERL_ARENA_SIZE / sizeof(XRV) - 1];
- xrv += (sizeof(XPV) - 1) / sizeof(XRV) + 1;
- PL_xrv_root = xrv;
- while (xrv < xrvend) {
- xrv->xrv_rv = (SV*)(xrv + 1);
- xrv++;
- }
- xrv->xrv_rv = 0;
-}
-
-/* allocate another arena's worth of IV bodies */
-
-STATIC void
-S_more_xiv(pTHX)
-{
- IV* xiv;
- IV* xivend;
- XPV* ptr;
- New(705, ptr, PERL_ARENA_SIZE/sizeof(XPV), XPV);
- ptr->xpv_pv = (char*)PL_xiv_arenaroot; /* linked list of xiv arenas */
- PL_xiv_arenaroot = ptr; /* to keep Purify happy */
-
- xiv = (IV*) ptr;
- xivend = &xiv[PERL_ARENA_SIZE / sizeof(IV) - 1];
- xiv += (sizeof(XPV) - 1) / sizeof(IV) + 1; /* fudge by size of XPV */
- PL_xiv_root = xiv;
- while (xiv < xivend) {
- *(IV**)xiv = (IV *)(xiv + 1);
- xiv++;
- }
- *(IV**)xiv = 0;
-}
-
/* allocate another arena's worth of NV bodies */
STATIC void
{
NV* xnv;
NV* xnvend;
- XPV *ptr;
- New(711, ptr, PERL_ARENA_SIZE/sizeof(XPV), XPV);
- ptr->xpv_pv = (char*)PL_xnv_arenaroot;
+ void *ptr;
+ New(711, ptr, PERL_ARENA_SIZE/sizeof(NV), NV);
+ *((void **) ptr) = (void *)PL_xnv_arenaroot;
PL_xnv_arenaroot = ptr;
xnv = (NV*) ptr;
STATIC void
S_more_xpv(pTHX)
{
- XPV* xpv;
- XPV* xpvend;
- New(713, xpv, PERL_ARENA_SIZE/sizeof(XPV), XPV);
- xpv->xpv_pv = (char*)PL_xpv_arenaroot;
+ 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) - 1];
+ xpvend = &xpv[PERL_ARENA_SIZE / sizeof(xpv_allocated) - 1];
PL_xpv_root = ++xpv;
while (xpv < xpvend) {
- xpv->xpv_pv = (char*)(xpv + 1);
+ *((xpv_allocated**)xpv) = xpv + 1;
xpv++;
}
- xpv->xpv_pv = 0;
+ *((xpv_allocated**)xpv) = 0;
}
/* allocate another arena's worth of struct xpviv */
STATIC void
S_more_xpviv(pTHX)
{
- XPVIV* xpviv;
- XPVIV* xpvivend;
- New(714, xpviv, PERL_ARENA_SIZE/sizeof(XPVIV), XPVIV);
- xpviv->xpv_pv = (char*)PL_xpviv_arenaroot;
+ 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) - 1];
+ xpvivend = &xpviv[PERL_ARENA_SIZE / sizeof(xpviv_allocated) - 1];
PL_xpviv_root = ++xpviv;
while (xpviv < xpvivend) {
- xpviv->xpv_pv = (char*)(xpviv + 1);
+ *((xpviv_allocated**)xpviv) = xpviv + 1;
xpviv++;
}
- xpviv->xpv_pv = 0;
+ *((xpviv_allocated**)xpviv) = 0;
}
/* allocate another arena's worth of struct xpvnv */
XPVNV* xpvnv;
XPVNV* xpvnvend;
New(715, xpvnv, PERL_ARENA_SIZE/sizeof(XPVNV), XPVNV);
- xpvnv->xpv_pv = (char*)PL_xpvnv_arenaroot;
+ *((XPVNV**)xpvnv) = PL_xpvnv_arenaroot;
PL_xpvnv_arenaroot = xpvnv;
xpvnvend = &xpvnv[PERL_ARENA_SIZE / sizeof(XPVNV) - 1];
PL_xpvnv_root = ++xpvnv;
while (xpvnv < xpvnvend) {
- xpvnv->xpv_pv = (char*)(xpvnv + 1);
+ *((XPVNV**)xpvnv) = xpvnv + 1;
xpvnv++;
}
- xpvnv->xpv_pv = 0;
+ *((XPVNV**)xpvnv) = 0;
}
/* allocate another arena's worth of struct xpvcv */
XPVCV* xpvcv;
XPVCV* xpvcvend;
New(716, xpvcv, PERL_ARENA_SIZE/sizeof(XPVCV), XPVCV);
- xpvcv->xpv_pv = (char*)PL_xpvcv_arenaroot;
+ *((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->xpv_pv = (char*)(xpvcv + 1);
+ *((XPVCV**)xpvcv) = xpvcv + 1;
xpvcv++;
}
- xpvcv->xpv_pv = 0;
+ *((XPVCV**)xpvcv) = 0;
}
/* allocate another arena's worth of struct xpvav */
STATIC void
S_more_xpvav(pTHX)
{
- XPVAV* xpvav;
- XPVAV* xpvavend;
- New(717, xpvav, PERL_ARENA_SIZE/sizeof(XPVAV), XPVAV);
- xpvav->xav_array = (char*)PL_xpvav_arenaroot;
+ 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) - 1];
+ xpvavend = &xpvav[PERL_ARENA_SIZE / sizeof(xpvav_allocated) - 1];
PL_xpvav_root = ++xpvav;
while (xpvav < xpvavend) {
- xpvav->xav_array = (char*)(xpvav + 1);
+ *((xpvav_allocated**)xpvav) = xpvav + 1;
xpvav++;
}
- xpvav->xav_array = 0;
+ *((xpvav_allocated**)xpvav) = 0;
}
/* allocate another arena's worth of struct xpvhv */
STATIC void
S_more_xpvhv(pTHX)
{
- XPVHV* xpvhv;
- XPVHV* xpvhvend;
- New(718, xpvhv, PERL_ARENA_SIZE/sizeof(XPVHV), XPVHV);
- xpvhv->xhv_array = (char*)PL_xpvhv_arenaroot;
+ 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;
- xpvhvend = &xpvhv[PERL_ARENA_SIZE / sizeof(XPVHV) - 1];
+ xpvhvend = &xpvhv[PERL_ARENA_SIZE / sizeof(xpvhv_allocated) - 1];
PL_xpvhv_root = ++xpvhv;
while (xpvhv < xpvhvend) {
- xpvhv->xhv_array = (char*)(xpvhv + 1);
+ *((xpvhv_allocated**)xpvhv) = xpvhv + 1;
xpvhv++;
}
- xpvhv->xhv_array = 0;
+ *((xpvhv_allocated**)xpvhv) = 0;
}
/* allocate another arena's worth of struct xpvmg */
XPVMG* xpvmg;
XPVMG* xpvmgend;
New(719, xpvmg, PERL_ARENA_SIZE/sizeof(XPVMG), XPVMG);
- xpvmg->xpv_pv = (char*)PL_xpvmg_arenaroot;
+ *((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->xpv_pv = (char*)(xpvmg + 1);
+ *((XPVMG**)xpvmg) = xpvmg + 1;
xpvmg++;
}
- xpvmg->xpv_pv = 0;
+ *((XPVMG**)xpvmg) = 0;
}
/* allocate another arena's worth of struct xpvgv */
XPVGV* xpvgv;
XPVGV* xpvgvend;
New(720, xpvgv, PERL_ARENA_SIZE/sizeof(XPVGV), XPVGV);
- xpvgv->xpv_pv = (char*)PL_xpvgv_arenaroot;
+ *((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->xpv_pv = (char*)(xpvgv + 1);
+ *((XPVGV**)xpvgv) = xpvgv + 1;
xpvgv++;
}
- xpvgv->xpv_pv = 0;
+ *((XPVGV**)xpvgv) = 0;
}
/* allocate another arena's worth of struct xpvlv */
XPVLV* xpvlv;
XPVLV* xpvlvend;
New(720, xpvlv, PERL_ARENA_SIZE/sizeof(XPVLV), XPVLV);
- xpvlv->xpv_pv = (char*)PL_xpvlv_arenaroot;
+ *((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->xpv_pv = (char*)(xpvlv + 1);
+ *((XPVLV**)xpvlv) = xpvlv + 1;
xpvlv++;
}
- xpvlv->xpv_pv = 0;
+ *((XPVLV**)xpvlv) = 0;
}
/* allocate another arena's worth of struct xpvbm */
XPVBM* xpvbm;
XPVBM* xpvbmend;
New(721, xpvbm, PERL_ARENA_SIZE/sizeof(XPVBM), XPVBM);
- xpvbm->xpv_pv = (char*)PL_xpvbm_arenaroot;
+ *((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->xpv_pv = (char*)(xpvbm + 1);
+ *((XPVBM**)xpvbm) = xpvbm + 1;
xpvbm++;
}
- xpvbm->xpv_pv = 0;
-}
-
-/* grab a new struct xrv from the free list, allocating more if necessary */
-
-STATIC XRV*
-S_new_xrv(pTHX)
-{
- XRV* xrv;
- LOCK_SV_MUTEX;
- if (!PL_xrv_root)
- S_more_xrv(aTHX);
- xrv = PL_xrv_root;
- PL_xrv_root = (XRV*)xrv->xrv_rv;
- UNLOCK_SV_MUTEX;
- return xrv;
-}
-
-/* return a struct xrv to the free list */
-
-STATIC void
-S_del_xrv(pTHX_ XRV *p)
-{
- LOCK_SV_MUTEX;
- p->xrv_rv = (SV*)PL_xrv_root;
- PL_xrv_root = p;
- UNLOCK_SV_MUTEX;
-}
-
-/* grab a new IV body from the free list, allocating more if necessary */
-
-STATIC XPVIV*
-S_new_xiv(pTHX)
-{
- IV* xiv;
- LOCK_SV_MUTEX;
- if (!PL_xiv_root)
- S_more_xiv(aTHX);
- xiv = PL_xiv_root;
- /*
- * See comment in more_xiv() -- RAM.
- */
- PL_xiv_root = *(IV**)xiv;
- UNLOCK_SV_MUTEX;
- return (XPVIV*)((char*)xiv - STRUCT_OFFSET(XPVIV, xiv_iv));
-}
-
-/* return an IV body to the free list */
-
-STATIC void
-S_del_xiv(pTHX_ XPVIV *p)
-{
- IV* xiv = (IV*)((char*)(p) + STRUCT_OFFSET(XPVIV, xiv_iv));
- LOCK_SV_MUTEX;
- *(IV**)xiv = PL_xiv_root;
- PL_xiv_root = xiv;
- UNLOCK_SV_MUTEX;
+ *((XPVBM**)xpvbm) = 0;
}
/* grab a new NV body from the free list, allocating more if necessary */
STATIC XPV*
S_new_xpv(pTHX)
{
- XPV* xpv;
+ xpv_allocated* xpv;
LOCK_SV_MUTEX;
if (!PL_xpv_root)
S_more_xpv(aTHX);
xpv = PL_xpv_root;
- PL_xpv_root = (XPV*)xpv->xpv_pv;
+ PL_xpv_root = *(xpv_allocated**)xpv;
UNLOCK_SV_MUTEX;
- return xpv;
+ /* If xpv_allocated is the same structure as XPV then the two OFFSETs
+ sum to zero, and the pointer is unchanged. If the allocated structure
+ is smaller (no initial IV actually allocated) then the net effect is
+ to subtract the size of the IV from the pointer, to return a new pointer
+ as if an initial IV were actually allocated. */
+ return (XPV*)((char*)xpv - STRUCT_OFFSET(XPV, xpv_cur)
+ + STRUCT_OFFSET(xpv_allocated, xpv_cur));
}
/* return a struct xpv to the free list */
STATIC void
S_del_xpv(pTHX_ XPV *p)
{
+ xpv_allocated* xpv
+ = (xpv_allocated*)((char*)(p) + STRUCT_OFFSET(XPV, xpv_cur)
+ - STRUCT_OFFSET(xpv_allocated, xpv_cur));
LOCK_SV_MUTEX;
- p->xpv_pv = (char*)PL_xpv_root;
- PL_xpv_root = p;
+ *(xpv_allocated**)xpv = PL_xpv_root;
+ PL_xpv_root = xpv;
UNLOCK_SV_MUTEX;
}
STATIC XPVIV*
S_new_xpviv(pTHX)
{
- XPVIV* xpviv;
+ xpviv_allocated* xpviv;
LOCK_SV_MUTEX;
if (!PL_xpviv_root)
S_more_xpviv(aTHX);
xpviv = PL_xpviv_root;
- PL_xpviv_root = (XPVIV*)xpviv->xpv_pv;
+ PL_xpviv_root = *(xpviv_allocated**)xpviv;
UNLOCK_SV_MUTEX;
- return xpviv;
+ /* If xpviv_allocated is the same structure as XPVIV then the two OFFSETs
+ sum to zero, and the pointer is unchanged. If the allocated structure
+ is smaller (no initial IV actually allocated) then the net effect is
+ to subtract the size of the IV from the pointer, to return a new pointer
+ as if an initial IV were actually allocated. */
+ return (XPVIV*)((char*)xpviv - STRUCT_OFFSET(XPVIV, xpv_cur)
+ + STRUCT_OFFSET(xpviv_allocated, xpv_cur));
}
/* return a struct xpviv to the free list */
STATIC void
S_del_xpviv(pTHX_ XPVIV *p)
{
+ xpviv_allocated* xpviv
+ = (xpviv_allocated*)((char*)(p) + STRUCT_OFFSET(XPVIV, xpv_cur)
+ - STRUCT_OFFSET(xpviv_allocated, xpv_cur));
LOCK_SV_MUTEX;
- p->xpv_pv = (char*)PL_xpviv_root;
- PL_xpviv_root = p;
+ *(xpviv_allocated**)xpviv = PL_xpviv_root;
+ PL_xpviv_root = xpviv;
UNLOCK_SV_MUTEX;
}
if (!PL_xpvnv_root)
S_more_xpvnv(aTHX);
xpvnv = PL_xpvnv_root;
- PL_xpvnv_root = (XPVNV*)xpvnv->xpv_pv;
+ PL_xpvnv_root = *(XPVNV**)xpvnv;
UNLOCK_SV_MUTEX;
return xpvnv;
}
S_del_xpvnv(pTHX_ XPVNV *p)
{
LOCK_SV_MUTEX;
- p->xpv_pv = (char*)PL_xpvnv_root;
+ *(XPVNV**)p = PL_xpvnv_root;
PL_xpvnv_root = p;
UNLOCK_SV_MUTEX;
}
if (!PL_xpvcv_root)
S_more_xpvcv(aTHX);
xpvcv = PL_xpvcv_root;
- PL_xpvcv_root = (XPVCV*)xpvcv->xpv_pv;
+ PL_xpvcv_root = *(XPVCV**)xpvcv;
UNLOCK_SV_MUTEX;
return xpvcv;
}
S_del_xpvcv(pTHX_ XPVCV *p)
{
LOCK_SV_MUTEX;
- p->xpv_pv = (char*)PL_xpvcv_root;
+ *(XPVCV**)p = PL_xpvcv_root;
PL_xpvcv_root = p;
UNLOCK_SV_MUTEX;
}
STATIC XPVAV*
S_new_xpvav(pTHX)
{
- XPVAV* xpvav;
+ xpvav_allocated* xpvav;
LOCK_SV_MUTEX;
if (!PL_xpvav_root)
S_more_xpvav(aTHX);
xpvav = PL_xpvav_root;
- PL_xpvav_root = (XPVAV*)xpvav->xav_array;
+ PL_xpvav_root = *(xpvav_allocated**)xpvav;
UNLOCK_SV_MUTEX;
- return xpvav;
+ return (XPVAV*)((char*)xpvav - STRUCT_OFFSET(XPVAV, xav_fill)
+ + STRUCT_OFFSET(xpvav_allocated, xav_fill));
}
/* return a struct xpvav to the free list */
STATIC void
S_del_xpvav(pTHX_ XPVAV *p)
{
+ xpvav_allocated* xpvav
+ = (xpvav_allocated*)((char*)(p) + STRUCT_OFFSET(XPVAV, xav_fill)
+ - STRUCT_OFFSET(xpvav_allocated, xav_fill));
LOCK_SV_MUTEX;
- p->xav_array = (char*)PL_xpvav_root;
- PL_xpvav_root = p;
+ *(xpvav_allocated**)xpvav = PL_xpvav_root;
+ PL_xpvav_root = xpvav;
UNLOCK_SV_MUTEX;
}
STATIC XPVHV*
S_new_xpvhv(pTHX)
{
- XPVHV* xpvhv;
+ xpvhv_allocated* xpvhv;
LOCK_SV_MUTEX;
if (!PL_xpvhv_root)
S_more_xpvhv(aTHX);
xpvhv = PL_xpvhv_root;
- PL_xpvhv_root = (XPVHV*)xpvhv->xhv_array;
+ PL_xpvhv_root = *(xpvhv_allocated**)xpvhv;
UNLOCK_SV_MUTEX;
- return xpvhv;
+ return (XPVHV*)((char*)xpvhv - STRUCT_OFFSET(XPVHV, xhv_fill)
+ + STRUCT_OFFSET(xpvhv_allocated, xhv_fill));
}
/* return a struct xpvhv to the free list */
STATIC void
S_del_xpvhv(pTHX_ XPVHV *p)
{
+ xpvhv_allocated* xpvhv
+ = (xpvhv_allocated*)((char*)(p) + STRUCT_OFFSET(XPVHV, xhv_fill)
+ - STRUCT_OFFSET(xpvhv_allocated, xhv_fill));
LOCK_SV_MUTEX;
- p->xhv_array = (char*)PL_xpvhv_root;
- PL_xpvhv_root = p;
+ *(xpvhv_allocated**)xpvhv = PL_xpvhv_root;
+ PL_xpvhv_root = xpvhv;
UNLOCK_SV_MUTEX;
}
if (!PL_xpvmg_root)
S_more_xpvmg(aTHX);
xpvmg = PL_xpvmg_root;
- PL_xpvmg_root = (XPVMG*)xpvmg->xpv_pv;
+ PL_xpvmg_root = *(XPVMG**)xpvmg;
UNLOCK_SV_MUTEX;
return xpvmg;
}
S_del_xpvmg(pTHX_ XPVMG *p)
{
LOCK_SV_MUTEX;
- p->xpv_pv = (char*)PL_xpvmg_root;
+ *(XPVMG**)p = PL_xpvmg_root;
PL_xpvmg_root = p;
UNLOCK_SV_MUTEX;
}
if (!PL_xpvgv_root)
S_more_xpvgv(aTHX);
xpvgv = PL_xpvgv_root;
- PL_xpvgv_root = (XPVGV*)xpvgv->xpv_pv;
+ PL_xpvgv_root = *(XPVGV**)xpvgv;
UNLOCK_SV_MUTEX;
return xpvgv;
}
S_del_xpvgv(pTHX_ XPVGV *p)
{
LOCK_SV_MUTEX;
- p->xpv_pv = (char*)PL_xpvgv_root;
+ *(XPVGV**)p = PL_xpvgv_root;
PL_xpvgv_root = p;
UNLOCK_SV_MUTEX;
}
if (!PL_xpvlv_root)
S_more_xpvlv(aTHX);
xpvlv = PL_xpvlv_root;
- PL_xpvlv_root = (XPVLV*)xpvlv->xpv_pv;
+ PL_xpvlv_root = *(XPVLV**)xpvlv;
UNLOCK_SV_MUTEX;
return xpvlv;
}
S_del_xpvlv(pTHX_ XPVLV *p)
{
LOCK_SV_MUTEX;
- p->xpv_pv = (char*)PL_xpvlv_root;
+ *(XPVLV**)p = PL_xpvlv_root;
PL_xpvlv_root = p;
UNLOCK_SV_MUTEX;
}
if (!PL_xpvbm_root)
S_more_xpvbm(aTHX);
xpvbm = PL_xpvbm_root;
- PL_xpvbm_root = (XPVBM*)xpvbm->xpv_pv;
+ PL_xpvbm_root = *(XPVBM**)xpvbm;
UNLOCK_SV_MUTEX;
return xpvbm;
}
S_del_xpvbm(pTHX_ XPVBM *p)
{
LOCK_SV_MUTEX;
- p->xpv_pv = (char*)PL_xpvbm_root;
+ *(XPVBM**)p = PL_xpvbm_root;
PL_xpvbm_root = p;
UNLOCK_SV_MUTEX;
}
#ifdef PURIFY
-#define new_XIV() my_safemalloc(sizeof(XPVIV))
-#define del_XIV(p) my_safefree(p)
-
#define new_XNV() my_safemalloc(sizeof(XPVNV))
#define del_XNV(p) my_safefree(p)
-#define new_XRV() my_safemalloc(sizeof(XRV))
-#define del_XRV(p) my_safefree(p)
-
#define new_XPV() my_safemalloc(sizeof(XPV))
#define del_XPV(p) my_safefree(p)
#else /* !PURIFY */
-#define new_XIV() (void*)new_xiv()
-#define del_XIV(p) del_xiv((XPVIV*) p)
-
#define new_XNV() (void*)new_xnv()
#define del_XNV(p) del_xnv((XPVNV*) p)
-#define new_XRV() (void*)new_xrv()
-#define del_XRV(p) del_xrv((XRV*) p)
-
#define new_XPV() (void*)new_xpv()
#define del_XPV(p) del_xpv((XPV *)p)
break;
case SVt_IV:
iv = SvIVX(sv);
- del_XIV(SvANY(sv));
if (mt == SVt_NV)
mt = SVt_PVNV;
else if (mt < SVt_PVIV)
break;
case SVt_RV:
pv = (char*)SvRV(sv);
- del_XRV(SvANY(sv));
break;
case SVt_PV:
pv = SvPVX(sv);
case SVt_NULL:
Perl_croak(aTHX_ "Can't upgrade to undef");
case SVt_IV:
- SvANY(sv) = new_XIV();
+ SvANY(sv) = (XPVIV*)((char*)&(sv->sv_u.svu_iv) - STRUCT_OFFSET(XPVIV, xiv_iv));
SvIV_set(sv, iv);
break;
case SVt_NV:
SvNV_set(sv, nv);
break;
case SVt_RV:
- SvANY(sv) = new_XRV();
+ SvANY(sv) = &sv->sv_u.svu_rv;
SvRV_set(sv, (SV*)pv);
break;
case SVt_PVHV:
SvANY(sv) = new_XPVHV();
- ((XPVHV*) SvANY(sv))->xhv_aux = 0;
HvFILL(sv) = 0;
HvMAX(sv) = 0;
HvTOTALKEYS(sv) = 0;
AvMAX(sv) = -1;
AvFILLp(sv) = -1;
AvALLOC(sv) = 0;
- AvARYLEN(sv)= 0;
AvREAL_only(sv);
- SvIV_set(sv, 0);
- SvNV_set(sv, 0.0);
}
/* to here. */
/* XXX? Only SVt_NULL is ever upgraded to AV or HV? */
Perl_sv_backoff(pTHX_ register SV *sv)
{
assert(SvOOK(sv));
+ assert(SvTYPE(sv) != SVt_PVHV);
+ assert(SvTYPE(sv) != SVt_PVAV);
if (SvIVX(sv)) {
- char *s = SvPVX(sv);
+ const char *s = SvPVX_const(sv);
SvLEN_set(sv, SvLEN(sv) + SvIVX(sv));
SvPV_set(sv, SvPVX(sv) - SvIVX(sv));
SvIV_set(sv, 0);
s = SvPVX(sv);
if (newlen > SvLEN(sv)) { /* need more room? */
+ newlen = PERL_STRLEN_ROUNDUP(newlen);
if (SvLEN(sv) && s) {
#ifdef MYMALLOC
const STRLEN l = malloced_size((void*)SvPVX(sv));
return s;
} else
#endif
- Renew(s,newlen,char);
+ s = saferealloc(s, newlen);
}
else {
- New(703, s, newlen, char);
- if (SvPVX(sv) && SvCUR(sv)) {
- Move(SvPVX(sv), s, (newlen < SvCUR(sv)) ? newlen : SvCUR(sv), char);
+ s = safemalloc(newlen);
+ if (SvPVX_const(sv) && SvCUR(sv)) {
+ Move(SvPVX_const(sv), s, (newlen < SvCUR(sv)) ? newlen : SvCUR(sv), char);
}
}
SvPV_set(sv, s);
STRLEN len;
if (SvPOK(sv)) {
- sbegin = SvPVX(sv);
+ sbegin = SvPVX_const(sv);
len = SvCUR(sv);
}
else if (SvPOKp(sv))
STATIC int
S_sv_2iuv_non_preserve(pTHX_ register SV *sv, I32 numtype)
{
- DEBUG_c(PerlIO_printf(Perl_debug_log,"sv_2iuv_non '%s', IV=0x%"UVxf" NV=%"NVgf" inttype=%"UVXf"\n", SvPVX(sv), SvIVX(sv), SvNVX(sv), (UV)numtype));
+ DEBUG_c(PerlIO_printf(Perl_debug_log,"sv_2iuv_non '%s', IV=0x%"UVxf" NV=%"NVgf" inttype=%"UVXf"\n", SvPVX_const(sv), SvIVX(sv), SvNVX(sv), (UV)numtype));
if (SvNVX(sv) < (NV)IV_MIN) {
(void)SvIOKp_on(sv);
(void)SvNOK_on(sv);
}
else if (SvPOKp(sv) && SvLEN(sv)) {
UV value;
- const int numtype = grok_number(SvPVX(sv), SvCUR(sv), &value);
+ const int numtype = grok_number(SvPVX_const(sv), SvCUR(sv), &value);
/* We want to avoid a possible problem when we cache an IV which
may be later translated to an NV, and the resulting NV is not
the same as the direct translation of the initial string
if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
!= IS_NUMBER_IN_UV) {
/* It wasn't an (integer that doesn't overflow the UV). */
- SvNV_set(sv, Atof(SvPVX(sv)));
+ SvNV_set(sv, Atof(SvPVX_const(sv)));
if (! numtype && ckWARN(WARN_NUMERIC))
not_a_number(sv);
}
else if (SvPOKp(sv) && SvLEN(sv)) {
UV value;
- const int numtype = grok_number(SvPVX(sv), SvCUR(sv), &value);
+ const int numtype = grok_number(SvPVX_const(sv), SvCUR(sv), &value);
/* We want to avoid a possible problem when we cache a UV which
may be later translated to an NV, and the resulting NV is not
if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
!= IS_NUMBER_IN_UV) {
/* It wasn't an integer, or it overflowed the UV. */
- SvNV_set(sv, Atof(SvPVX(sv)));
+ SvNV_set(sv, Atof(SvPVX_const(sv)));
if (! numtype && ckWARN(WARN_NUMERIC))
not_a_number(sv);
return SvNVX(sv);
if (SvPOKp(sv) && SvLEN(sv)) {
if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) &&
- !grok_number(SvPVX(sv), SvCUR(sv), NULL))
+ !grok_number(SvPVX_const(sv), SvCUR(sv), NULL))
not_a_number(sv);
- return Atof(SvPVX(sv));
+ return Atof(SvPVX_const(sv));
}
if (SvIOKp(sv)) {
if (SvIsUV(sv))
}
else if (SvPOKp(sv) && SvLEN(sv)) {
UV value;
- const int numtype = grok_number(SvPVX(sv), SvCUR(sv), &value);
+ const int numtype = grok_number(SvPVX_const(sv), SvCUR(sv), &value);
if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) && !numtype)
not_a_number(sv);
#ifdef NV_PRESERVES_UV
/* It's definitely an integer */
SvNV_set(sv, (numtype & IS_NUMBER_NEG) ? -(NV)value : (NV)value);
} else
- SvNV_set(sv, Atof(SvPVX(sv)));
+ SvNV_set(sv, Atof(SvPVX_const(sv)));
SvNOK_on(sv);
#else
- SvNV_set(sv, Atof(SvPVX(sv)));
+ SvNV_set(sv, Atof(SvPVX_const(sv)));
/* Only set the public NV OK flag if this NV preserves the value in
the PV at least as well as an IV/UV would.
Not sure how to do this 100% reliably. */
S_asIV(pTHX_ SV *sv)
{
UV value;
- int numtype = grok_number(SvPVX(sv), SvCUR(sv), &value);
+ int numtype = grok_number(SvPVX_const(sv), SvCUR(sv), &value);
if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
== IS_NUMBER_IN_UV) {
if (ckWARN(WARN_NUMERIC))
not_a_number(sv);
}
- return I_V(Atof(SvPVX(sv)));
+ return I_V(Atof(SvPVX_const(sv)));
}
/* asUV(): extract an unsigned integer from the string value of an SV
S_asUV(pTHX_ SV *sv)
{
UV value;
- int numtype = grok_number(SvPVX(sv), SvCUR(sv), &value);
+ const int numtype = grok_number(SvPVX_const(sv), SvCUR(sv), &value);
if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
== IS_NUMBER_IN_UV) {
if (ckWARN(WARN_NUMERIC))
not_a_number(sv);
}
- return U_V(Atof(SvPVX(sv)));
+ return U_V(Atof(SvPVX_const(sv)));
}
/*
sv_upgrade(sv, SVt_PV);
return (char *)"";
}
- *lp = s - SvPVX(sv);
+ *lp = s - SvPVX_const(sv);
SvCUR_set(sv, *lp);
SvPOK_on(sv);
DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2pv(%s)\n",
- PTR2UV(sv),SvPVX(sv)));
+ PTR2UV(sv),SvPVX_const(sv)));
return SvPVX(sv);
tokensave:
if (tsv) {
sv_2mortal(tsv);
- t = SvPVX(tsv);
+ t = SvPVX_const(tsv);
len = SvCUR(tsv);
}
else {
if (SvPOKp(sv)) {
register XPV* Xpvtmp;
if ((Xpvtmp = (XPV*)SvANY(sv)) &&
- (*Xpvtmp->xpv_pv > '0' ||
+ (*sv->sv_u.svu_pv > '0' ||
Xpvtmp->xpv_cur > 1 ||
- (Xpvtmp->xpv_cur && *Xpvtmp->xpv_pv != '0')))
+ (Xpvtmp->xpv_cur && *sv->sv_u.svu_pv != '0')))
return 1;
else
return 0;
SvTAINT(dstr);
return;
}
- if (SvPVX(dstr)) {
+ if (SvPVX_const(dstr)) {
SvPV_free(dstr);
SvLEN_set(dstr, 0);
SvCUR_set(dstr, 0);
/*
* Check to see if we can just swipe the string. If so, it's a
* possible small lose on short strings, but a big win on long ones.
- * It might even be a win on short strings if SvPVX(dstr)
- * has to be allocated and SvPVX(sstr) has to be freed.
+ * It might even be a win on short strings if SvPVX_const(dstr)
+ * has to be allocated and SvPVX_const(sstr) has to be freed.
*/
/* Whichever path we take through the next code, we want this true,
(void)SvPOK_only(dstr);
if (
-#ifdef PERL_COPY_ON_WRITE
(sflags & (SVf_FAKE | SVf_READONLY)) != (SVf_FAKE | SVf_READONLY)
&&
-#endif
!(isSwipe =
(sflags & SVs_TEMP) && /* slated for free anyway? */
!(sflags & SVf_OOK) && /* and not involved in OOK hack? */
Have to copy the string. */
STRLEN len = SvCUR(sstr);
SvGROW(dstr, len + 1); /* inlined from sv_setpvn */
- Move(SvPVX(sstr),SvPVX(dstr),len,char);
+ Move(SvPVX_const(sstr),SvPVX(dstr),len,char);
SvCUR_set(dstr, len);
*SvEND(dstr) = '\0';
} else {
/* If PERL_COPY_ON_WRITE is not defined, then isSwipe will always
be true in here. */
-#ifdef PERL_COPY_ON_WRITE
/* Either it's a shared hash key, or it's suitable for
copy-on-write or we can swipe the string. */
if (DEBUG_C_TEST) {
sv_dump(sstr);
sv_dump(dstr);
}
+#ifdef PERL_COPY_ON_WRITE
if (!isSwipe) {
/* I believe I should acquire a global SV mutex if
it's a COW sv (not a shared hash key) to stop
}
#endif
/* Initial code is common. */
- if (SvPVX(dstr)) { /* we know that dtype >= SVt_PV */
+ if (SvPVX_const(dstr)) { /* we know that dtype >= SVt_PV */
if (SvOOK(dstr)) {
SvFLAGS(dstr) &= ~SVf_OOK;
- Safefree(SvPVX(dstr) - SvIVX(dstr));
+ Safefree(SvPVX_const(dstr) - SvIVX(dstr));
}
else if (SvLEN(dstr))
- Safefree(SvPVX(dstr));
+ Safefree(SvPVX_const(dstr));
}
-#ifdef PERL_COPY_ON_WRITE
if (!isSwipe) {
/* making another shared SV. */
STRLEN cur = SvCUR(sstr);
STRLEN len = SvLEN(sstr);
assert (SvTYPE(dstr) >= SVt_PVIV);
+#ifdef PERL_COPY_ON_WRITE
if (len) {
/* SvIsCOW_normal */
/* splice us in between source and next-after-source. */
SV_COW_NEXT_SV_SET(dstr, SV_COW_NEXT_SV(sstr));
SV_COW_NEXT_SV_SET(sstr, dstr);
SvPV_set(dstr, SvPVX(sstr));
- } else {
+ } else
+#endif
+ {
/* SvIsCOW_shared_hash */
UV hash = SvUVX(sstr);
DEBUG_C(PerlIO_printf(Perl_debug_log,
"Copy on write: Sharing hash\n"));
SvPV_set(dstr,
- sharepvn(SvPVX(sstr),
+ sharepvn(SvPVX_const(sstr),
(sflags & SVf_UTF8?-cur:cur), hash));
SvUV_set(dstr, hash);
}
/* Relesase a global SV mutex. */
}
else
-#endif
{ /* Passes the swipe test. */
SvPV_set(dstr, SvPVX(sstr));
SvLEN_set(dstr, SvLEN(sstr));
if (dstr) {
if (SvTHINKFIRST(dstr))
sv_force_normal_flags(dstr, SV_COW_DROP_PV);
- else if (SvPVX(dstr))
- Safefree(SvPVX(dstr));
+ else if (SvPVX_const(dstr))
+ Safefree(SvPVX_const(dstr));
}
else
new_SV(dstr);
DEBUG_C(PerlIO_printf(Perl_debug_log,
"Fast copy on write: Sharing hash\n"));
SvUV_set(dstr, hash);
- new_pv = sharepvn(SvPVX(sstr), (SvUTF8(sstr)?-cur:cur), hash);
+ new_pv = sharepvn(SvPVX_const(sstr), (SvUTF8(sstr)?-cur:cur), hash);
goto common_exit;
}
SV_COW_NEXT_SV_SET(dstr, SV_COW_NEXT_SV(sstr));
void
Perl_sv_usepvn(pTHX_ register SV *sv, register char *ptr, register STRLEN len)
{
+ STRLEN allocate;
SV_CHECK_THINKFIRST_COW_DROP(sv);
(void)SvUPGRADE(sv, SVt_PV);
if (!ptr) {
(void)SvOK_off(sv);
return;
}
- if (SvPVX(sv))
+ if (SvPVX_const(sv))
SvPV_free(sv);
- Renew(ptr, len+1, char);
+
+ allocate = PERL_STRLEN_ROUNDUP(len + 1);
+ ptr = saferealloc (ptr, allocate);
SvPV_set(sv, ptr);
SvCUR_set(sv, len);
- SvLEN_set(sv, len+1);
+ SvLEN_set(sv, allocate);
*SvEND(sv) = '\0';
(void)SvPOK_only_UTF8(sv); /* validate pointer */
SvTAINT(sv);
(which it can do by means other than releasing copy-on-write Svs)
or by changing the other copy-on-write SVs in the loop. */
STATIC void
-S_sv_release_COW(pTHX_ register SV *sv, char *pvx, STRLEN cur, STRLEN len,
+S_sv_release_COW(pTHX_ register SV *sv, const char *pvx, STRLEN cur, STRLEN len,
U32 hash, SV *after)
{
if (len) { /* this SV was SvIsCOW_normal(sv) */
/* don't loop forever if the structure is bust, and we have
a pointer into a closed loop. */
assert (current != after);
- assert (SvPVX(current) == pvx);
+ assert (SvPVX_const(current) == pvx);
}
/* Make the SV before us point to the SV after us. */
SV_COW_NEXT_SV_SET(current, after);
if (SvREADONLY(sv)) {
/* At this point I believe I should acquire a global SV mutex. */
if (SvFAKE(sv)) {
- char *pvx = SvPVX(sv);
+ const char *pvx = SvPVX_const(sv);
STRLEN len = SvLEN(sv);
STRLEN cur = SvCUR(sv);
U32 hash = SvUVX(sv);
#else
if (SvREADONLY(sv)) {
if (SvFAKE(sv)) {
- char *pvx = SvPVX(sv);
- int is_utf8 = SvUTF8(sv);
+ const char *pvx = SvPVX_const(sv);
+ const int is_utf8 = SvUTF8(sv);
STRLEN len = SvCUR(sv);
U32 hash = SvUVX(sv);
SvFAKE_off(sv);
SvPV_set(sv, (char*)0);
SvLEN_set(sv, 0);
SvGROW(sv, len + 1);
- Move(pvx,SvPVX(sv),len,char);
+ Move(pvx,SvPVX_const(sv),len,char);
*SvEND(sv) = '\0';
unsharepvn(pvx, is_utf8 ? -(I32)len : len, hash);
}
SvPOK(sv) must be true and the C<ptr> must be a pointer to somewhere inside
the string buffer. The C<ptr> becomes the first character of the adjusted
string. Uses the "OOK hack".
-Beware: after this function returns, C<ptr> and SvPVX(sv) may no longer
+Beware: after this function returns, C<ptr> and SvPVX_const(sv) may no longer
refer to the same chunk of data.
=cut
register STRLEN delta;
if (!ptr || !SvPOKp(sv))
return;
- delta = ptr - SvPVX(sv);
+ delta = ptr - SvPVX_const(sv);
SV_CHECK_THINKFIRST(sv);
if (SvTYPE(sv) < SVt_PVIV)
sv_upgrade(sv,SVt_PVIV);
if (!SvOOK(sv)) {
if (!SvLEN(sv)) { /* make copy of shared string */
- const char *pvx = SvPVX(sv);
+ const char *pvx = SvPVX_const(sv);
STRLEN len = SvCUR(sv);
SvGROW(sv, len + 1);
- Move(pvx,SvPVX(sv),len,char);
+ Move(pvx,SvPVX_const(sv),len,char);
*SvEND(sv) = '\0';
}
SvIV_set(sv, 0);
SvGROW(dsv, dlen + slen + 1);
if (sstr == dstr)
- sstr = SvPVX(dsv);
+ sstr = SvPVX_const(dsv);
Move(sstr, SvPVX(dsv) + dlen, slen, char);
SvCUR_set(dsv, SvCUR(dsv) + slen);
*SvEND(dsv) = '\0';
dsv->sv_flags doesn't have that bit set.
Andy Dougherty 12 Oct 2001
*/
- I32 sutf8 = DO_UTF8(ssv);
+ const I32 sutf8 = DO_UTF8(ssv);
I32 dutf8;
if (SvGMAGICAL(dsv) && (flags & SV_GMAGIC))
len = strlen(ptr);
SvGROW(sv, tlen + len + 1);
if (ptr == junk)
- ptr = SvPVX(sv);
+ ptr = SvPVX_const(sv);
Move(ptr,SvPVX(sv)+tlen,len+1,char);
SvCUR_set(sv, SvCUR(sv) + len);
(void)SvPOK_only_UTF8(sv); /* validate pointer */
case PERL_MAGIC_vec:
vtable = &PL_vtbl_vec;
break;
+ case PERL_MAGIC_arylen_p:
case PERL_MAGIC_rhash:
case PERL_MAGIC_symtab:
case PERL_MAGIC_vstring:
(void)SvPOK_only_UTF8(bigstr);
if (offset + len > curlen) {
SvGROW(bigstr, offset+len+1);
- Zero(SvPVX(bigstr)+curlen, offset+len-curlen, char);
+ Zero(SvPVX_const(bigstr)+curlen, offset+len-curlen, char);
SvCUR_set(bigstr, offset+len);
}
#else
StructCopy(nsv,sv,SV);
#endif
+ /* Currently could join these into one piece of pointer arithmetic, but
+ it would be unclear. */
+ if(SvTYPE(sv) == SVt_IV)
+ SvANY(sv)
+ = (XPVIV*)((char*)&(sv->sv_u.svu_iv) - STRUCT_OFFSET(XPVIV, xiv_iv));
+ else if (SvTYPE(sv) == SVt_RV) {
+ SvANY(sv) = &sv->sv_u.svu_rv;
+ }
+
#ifdef PERL_COPY_ON_WRITE
if (SvIsCOW_normal(nsv)) {
while ((next = SV_COW_NEXT_SV(current)) != nsv) {
assert(next);
current = next;
- assert(SvPVX(current) == SvPVX(nsv));
+ assert(SvPVX_const(current) == SvPVX_const(nsv));
}
/* Make the SV before us point to the SV after us. */
if (DEBUG_C_TEST) {
if (SvOBJECT(sv)) {
if (PL_defstash) { /* Still have a symbol table? */
dSP;
- CV* destructor;
-
-
-
do {
+ CV* destructor;
stash = SvSTASH(sv);
destructor = StashHANDLER(stash,DESTROY);
if (destructor) {
SvREFCNT_dec(SvRV(sv));
}
#ifdef PERL_COPY_ON_WRITE
- else if (SvPVX(sv)) {
+ else if (SvPVX_const(sv)) {
if (SvIsCOW(sv)) {
/* I believe I need to grab the global SV mutex here and
then recheck the COW status. */
PerlIO_printf(Perl_debug_log, "Copy on write: clear\n");
sv_dump(sv);
}
- sv_release_COW(sv, SvPVX(sv), SvCUR(sv), SvLEN(sv),
+ sv_release_COW(sv, SvPVX_const(sv), SvCUR(sv), SvLEN(sv),
SvUVX(sv), SV_COW_NEXT_SV(sv));
/* And drop it here. */
SvFAKE_off(sv);
} else if (SvLEN(sv)) {
- Safefree(SvPVX(sv));
+ Safefree(SvPVX_const(sv));
}
}
#else
- else if (SvPVX(sv) && SvLEN(sv))
- Safefree(SvPVX(sv));
- else if (SvPVX(sv) && SvREADONLY(sv) && SvFAKE(sv)) {
- unsharepvn(SvPVX(sv),
+ else if (SvPVX_const(sv) && SvLEN(sv))
+ Safefree(SvPVX_const(sv));
+ else if (SvPVX_const(sv) && SvREADONLY(sv) && SvFAKE(sv)) {
+ unsharepvn(SvPVX_const(sv),
SvUTF8(sv) ? -(I32)SvCUR(sv) : SvCUR(sv),
SvUVX(sv));
SvFAKE_off(sv);
case SVt_NULL:
break;
case SVt_IV:
- del_XIV(SvANY(sv));
break;
case SVt_NV:
del_XNV(SvANY(sv));
break;
case SVt_RV:
- del_XRV(SvANY(sv));
break;
case SVt_PV:
del_XPV(SvANY(sv));
Perl_sv_pos_u2b(pTHX_ register SV *sv, I32* offsetp, I32* lenp)
{
U8 *start;
- U8 *s;
STRLEN len;
- STRLEN *cache = 0;
- STRLEN boffset = 0;
if (!sv)
return;
- start = s = (U8*)SvPV(sv, len);
+ start = (U8*)SvPV(sv, len);
if (len) {
+ STRLEN boffset = 0;
+ STRLEN *cache = 0;
+ U8 *s = start;
I32 uoffset = *offsetp;
U8 *send = s + len;
MAGIC *mg = 0;
}
else
shortbuffered = 0;
- bp = (STDCHAR*)SvPVX(sv) + append; /* move these two too to registers */
+ bp = (STDCHAR*)SvPVX_const(sv) + append; /* move these two too to registers */
ptr = (STDCHAR*)PerlIO_get_ptr(fp);
DEBUG_P(PerlIO_printf(Perl_debug_log,
"Screamer: entering, ptr=%"UVuf", cnt=%ld\n",PTR2UV(ptr),(long)cnt));
if (shortbuffered) { /* oh well, must extend */
cnt = shortbuffered;
shortbuffered = 0;
- bpx = bp - (STDCHAR*)SvPVX(sv); /* box up before relocation */
+ bpx = bp - (STDCHAR*)SvPVX_const(sv); /* box up before relocation */
SvCUR_set(sv, bpx);
SvGROW(sv, SvLEN(sv) + append + cnt + 2);
- bp = (STDCHAR*)SvPVX(sv) + bpx; /* unbox after relocation */
+ bp = (STDCHAR*)SvPVX_const(sv) + bpx; /* unbox after relocation */
continue;
}
if (i == EOF) /* all done for ever? */
goto thats_really_all_folks;
- bpx = bp - (STDCHAR*)SvPVX(sv); /* box up before relocation */
+ bpx = bp - (STDCHAR*)SvPVX_const(sv); /* box up before relocation */
SvCUR_set(sv, bpx);
SvGROW(sv, bpx + cnt + 2);
- bp = (STDCHAR*)SvPVX(sv) + bpx; /* unbox after relocation */
+ bp = (STDCHAR*)SvPVX_const(sv) + bpx; /* unbox after relocation */
*bp++ = (STDCHAR)i; /* store character from PerlIO_getc */
}
thats_all_folks:
- if ((rslen > 1 && (STRLEN)(bp - (STDCHAR*)SvPVX(sv)) < rslen) ||
+ if ((rslen > 1 && (STRLEN)(bp - (STDCHAR*)SvPVX_const(sv)) < rslen) ||
memNE((char*)bp - rslen, rsptr, rslen))
goto screamer; /* go back to the fray */
thats_really_all_folks:
PTR2UV(PerlIO_get_ptr(fp)), (long)PerlIO_get_cnt(fp),
PTR2UV(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0)));
*bp = '\0';
- SvCUR_set(sv, bp - (STDCHAR*)SvPVX(sv)); /* set length */
+ SvCUR_set(sv, bp - (STDCHAR*)SvPVX_const(sv)); /* set length */
DEBUG_P(PerlIO_printf(Perl_debug_log,
"Screamer: done, len=%ld, string=|%.*s|\n",
- (long)SvCUR(sv),(int)SvCUR(sv),SvPVX(sv)));
+ (long)SvCUR(sv),(int)SvCUR(sv),SvPVX_const(sv)));
}
else
{
if (i != EOF && /* joy */
(!rslen ||
SvCUR(sv) < rslen ||
- memNE(SvPVX(sv) + SvCUR(sv) - rslen, rsptr, rslen)))
+ memNE(SvPVX_const(sv) + SvCUR(sv) - rslen, rsptr, rslen)))
{
append = -1;
/*
return;
}
- if (!(flags & SVp_POK) || !*SvPVX(sv)) {
+ if (!(flags & SVp_POK) || !*SvPVX_const(sv)) {
if ((flags & SVTYPEMASK) < SVt_PVIV)
sv_upgrade(sv, SVt_IV);
(void)SvIOK_only(sv);
/* Got to punt this as an integer if needs be, but we don't issue
warnings. Probably ought to make the sv_iv_please() that does
the conversion if possible, and silently. */
- int numtype = grok_number(SvPVX(sv), SvCUR(sv), NULL);
+ const int numtype = grok_number(SvPVX_const(sv), SvCUR(sv), NULL);
if (numtype && !(numtype & IS_NUMBER_INFINITY)) {
/* Need to try really hard to see if it's an integer.
9.22337203685478e+18 is an integer.
Fall through. */
#if defined(USE_LONG_DOUBLE)
DEBUG_c(PerlIO_printf(Perl_debug_log,"sv_inc punt failed to convert '%s' to IOK or NOKp, UV=0x%"UVxf" NV=%"PERL_PRIgldbl"\n",
- SvPVX(sv), SvIVX(sv), SvNVX(sv)));
+ SvPVX_const(sv), SvIVX(sv), SvNVX(sv)));
#else
DEBUG_c(PerlIO_printf(Perl_debug_log,"sv_inc punt failed to convert '%s' to IOK or NOKp, UV=0x%"UVxf" NV=%"NVgf"\n",
- SvPVX(sv), SvIVX(sv), SvNVX(sv)));
+ SvPVX_const(sv), SvIVX(sv), SvNVX(sv)));
#endif
}
#endif /* PERL_PRESERVE_IVUV */
- sv_setnv(sv,Atof(SvPVX(sv)) + 1.0);
+ sv_setnv(sv,Atof(SvPVX_const(sv)) + 1.0);
return;
}
d--;
- while (d >= SvPVX(sv)) {
+ while (d >= SvPVX_const(sv)) {
if (isDIGIT(*d)) {
if (++*d <= '9')
return;
/* oh,oh, the number grew */
SvGROW(sv, SvCUR(sv) + 2);
SvCUR_set(sv, SvCUR(sv) + 1);
- for (d = SvPVX(sv) + SvCUR(sv); d > SvPVX(sv); d--)
+ for (d = SvPVX(sv) + SvCUR(sv); d > SvPVX_const(sv); d--)
*d = d[-1];
if (isDIGIT(d[1]))
*d = '1';
}
#ifdef PERL_PRESERVE_IVUV
{
- int numtype = grok_number(SvPVX(sv), SvCUR(sv), NULL);
+ const int numtype = grok_number(SvPVX_const(sv), SvCUR(sv), NULL);
if (numtype && !(numtype & IS_NUMBER_INFINITY)) {
/* Need to try really hard to see if it's an integer.
9.22337203685478e+18 is an integer.
Fall through. */
#if defined(USE_LONG_DOUBLE)
DEBUG_c(PerlIO_printf(Perl_debug_log,"sv_dec punt failed to convert '%s' to IOK or NOKp, UV=0x%"UVxf" NV=%"PERL_PRIgldbl"\n",
- SvPVX(sv), SvIVX(sv), SvNVX(sv)));
+ SvPVX_const(sv), SvIVX(sv), SvNVX(sv)));
#else
DEBUG_c(PerlIO_printf(Perl_debug_log,"sv_dec punt failed to convert '%s' to IOK or NOKp, UV=0x%"UVxf" NV=%"NVgf"\n",
- SvPVX(sv), SvIVX(sv), SvNVX(sv)));
+ SvPVX_const(sv), SvIVX(sv), SvNVX(sv)));
#endif
}
}
#endif /* PERL_PRESERVE_IVUV */
- sv_setnv(sv,Atof(SvPVX(sv)) - 1.0); /* punt */
+ sv_setnv(sv,Atof(SvPVX_const(sv)) - 1.0); /* punt */
}
/*
register SV *sv;
new_SV(sv);
- if (!len)
- len = strlen(s);
- sv_setpvn(sv,s,len);
+ sv_setpvn(sv,s,len ? len : strlen(s));
return sv;
}
return sv;
}
+
+/*
+=for apidoc newSVpv_hek
+
+Creates a new SV from the hash key structure. It will generate scalars that
+point to the shared string table where possible. Returns a new (undefined)
+SV if the hek is NULL.
+
+=cut
+*/
+
+SV *
+Perl_newSVhek(pTHX_ const HEK *hek)
+{
+ if (!hek) {
+ SV *sv;
+
+ new_SV(sv);
+ return sv;
+ }
+
+ if (HEK_LEN(hek) == HEf_SVKEY) {
+ return newSVsv(*(SV**)HEK_KEY(hek));
+ } else {
+ const int flags = HEK_FLAGS(hek);
+ if (flags & HVhek_WASUTF8) {
+ /* Trouble :-)
+ Andreas would like keys he put in as utf8 to come back as utf8
+ */
+ STRLEN utf8_len = HEK_LEN(hek);
+ U8 *as_utf8 = bytes_to_utf8 ((U8*)HEK_KEY(hek), &utf8_len);
+ SV *sv = newSVpvn ((char*)as_utf8, utf8_len);
+
+ SvUTF8_on (sv);
+ Safefree (as_utf8); /* bytes_to_utf8() allocates a new string */
+ return sv;
+ } else if (flags & HVhek_REHASH) {
+ /* We don't have a pointer to the hv, so we have to replicate the
+ flag into every HEK. This hv is using custom a hasing
+ algorithm. Hence we can't return a shared string scalar, as
+ that would contain the (wrong) hash value, and might get passed
+ into an hv routine with a regular hash */
+
+ SV *sv = newSVpvn (HEK_KEY(hek), HEK_LEN(hek));
+ if (HEK_UTF8(hek))
+ SvUTF8_on (sv);
+ return sv;
+ }
+ /* This will be overwhelminly the most common case. */
+ return newSVpvn_share(HEK_KEY(hek),
+ (HEK_UTF8(hek) ? -HEK_LEN(hek) : HEK_LEN(hek)),
+ HEK_HASH(hek));
+ }
+}
+
/*
=for apidoc newSVpvn_share
-Creates a new SV with its SvPVX pointing to a shared string in the string
+Creates a new SV with its SvPVX_const pointing to a shared string in the string
table. If the string does not already exist in the table, it is created
first. Turns on READONLY and FAKE. The string's hash is stored in the UV
slot of the SV; if the C<hash> parameter is non-zero, that value is used;
otherwise the hash is computed. The idea here is that as the string table
-is used for shared hash keys these strings will have SvPVX == HeKEY and
+is used for shared hash keys these strings will have SvPVX_const == HeKEY and
hash lookup will avoid string compare.
=cut
Perl_sv_reset(pTHX_ register const char *s, HV *stash)
{
dVAR;
- register HE *entry;
- register GV *gv;
- register SV *sv;
- register I32 i;
- register I32 max;
char todo[PERL_UCHAR_MAX+1];
if (!stash)
Zero(todo, 256, char);
while (*s) {
- i = (unsigned char)*s;
+ I32 max;
+ I32 i = (unsigned char)*s;
if (s[1] == '-') {
s += 2;
}
todo[i] = 1;
}
for (i = 0; i <= (I32) HvMAX(stash); i++) {
+ HE *entry;
for (entry = HvARRAY(stash)[i];
entry;
entry = HeNEXT(entry))
{
+ register GV *gv;
+ register SV *sv;
+
if (!todo[(U8)*HeKEY(entry)])
continue;
gv = (GV*)HeVAL(entry);
SvOK_off(sv);
if (SvTYPE(sv) >= SVt_PV) {
SvCUR_set(sv, 0);
- if (SvPVX(sv) != Nullch)
+ if (SvPVX_const(sv) != Nullch)
*SvPVX(sv) = '\0';
SvTAINT(sv);
}
const register XPV* tXpv;
if ((tXpv = (XPV*)SvANY(sv)) &&
(tXpv->xpv_cur > 1 ||
- (tXpv->xpv_cur && *tXpv->xpv_pv != '0')))
+ (tXpv->xpv_cur && *sv->sv_u.svu_pv != '0')))
return 1;
else
return 0;
}
else
s = sv_2pv_flags(sv, lp, flags);
- if (s != SvPVX(sv)) { /* Almost, but not quite, sv_setpvn() */
+ if (s != SvPVX_const(sv)) { /* Almost, but not quite, sv_setpvn() */
const STRLEN len = *lp;
if (SvROK(sv))
sv_unref(sv);
(void)SvUPGRADE(sv, SVt_PV); /* Never FALSE */
SvGROW(sv, len + 1);
- Move(s,SvPVX(sv),len,char);
+ Move(s,SvPVX_const(sv),len,char);
SvCUR_set(sv, len);
*SvEND(sv) = '\0';
}
SvPOK_on(sv); /* validate pointer */
SvTAINT(sv);
DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2pv(%s)\n",
- PTR2UV(sv),SvPVX(sv)));
+ PTR2UV(sv),SvPVX_const(sv)));
}
}
return SvPVX(sv);
{
const int neg = nv < 0;
UV uv;
- char *p = endbuf;
if (neg)
nv = -nv;
if (nv < UV_MAX) {
+ char *p = endbuf;
nv += 0.5;
uv = (UV)nv;
if (uv & 1 && uv == nv)
I32 svix = 0;
static const char nullstr[] = "(null)";
SV *argsv = Nullsv;
- bool has_utf8; /* has the result utf8? */
- bool pat_utf8; /* the pattern is in utf8? */
+ bool has_utf8 = DO_UTF8(sv); /* has the result utf8? */
+ const bool pat_utf8 = has_utf8; /* the pattern is in utf8? */
SV *nsv = Nullsv;
/* Times 4: a decimal digit takes more than 3 binary digits.
* NV_DIG: mantissa takes than many decimal digits.
/* large enough for "%#.#f" --chip */
/* what about long double NVs? --jhi */
- has_utf8 = pat_utf8 = DO_UTF8(sv);
-
/* no matter what, this is a string now */
(void)SvPV_force(sv, origlen);
vecstr = (U8*)SvPVx(vecsv,veclen);
vec_utf8 = DO_UTF8(vecsv);
/* if this is a version object, we need to return the
- * stringified representation (which the SvPVX has
+ * stringified representation (which the SvPVX_const has
* already done for us), but not vectorize the args
*/
if ( *q == 'd' && sv_derived_from(vecsv,"version") )
Copy(eptr, p, elen, char);
p += elen;
*p = '\0';
- SvCUR_set(sv, p - SvPVX(sv));
+ SvCUR_set(sv, p - SvPVX_const(sv));
svix = osvix;
continue; /* not "break" */
}
if (has_utf8)
SvUTF8_on(sv);
*p = '\0';
- SvCUR_set(sv, p - SvPVX(sv));
+ SvCUR_set(sv, p - SvPVX_const(sv));
if (vectorize) {
esignlen = 0;
goto vector;
: sv_dup_inc(SvRV(sstr), param));
}
- else if (SvPVX(sstr)) {
+ else if (SvPVX_const(sstr)) {
/* Has something there */
if (SvLEN(sstr)) {
/* Normal PV - clone whole allocated space */
- SvPV_set(dstr, SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1));
+ SvPV_set(dstr, SAVEPVN(SvPVX_const(sstr), SvLEN(sstr)-1));
if (SvREADONLY(sstr) && SvFAKE(sstr)) {
/* Not that normal - actually sstr is copy on write.
But we are a true, independant SV, so: */
and they should not have these flags
turned off */
- SvPV_set(dstr, sharepvn(SvPVX(sstr), SvCUR(sstr),
+ SvPV_set(dstr, sharepvn(SvPVX_const(sstr), SvCUR(sstr),
SvUVX(sstr)));
SvUV_set(dstr, SvUVX(sstr));
} else {
- SvPV_set(dstr, SAVEPVN(SvPVX(sstr), SvCUR(sstr)));
+ SvPV_set(dstr, SAVEPVN(SvPVX_const(sstr), SvCUR(sstr)));
SvFAKE_off(dstr);
SvREADONLY_off(dstr);
}
SvREFCNT(dstr) = 0; /* must be before any other dups! */
#ifdef DEBUGGING
- if (SvANY(sstr) && PL_watch_pvx && SvPVX(sstr) == PL_watch_pvx)
+ if (SvANY(sstr) && PL_watch_pvx && SvPVX_const(sstr) == PL_watch_pvx)
PerlIO_printf(Perl_debug_log, "watch at %p hit, found string \"%s\"\n",
- PL_watch_pvx, SvPVX(sstr));
+ PL_watch_pvx, SvPVX_const(sstr));
#endif
/* don't clone objects whose class has asked us not to */
SvANY(dstr) = NULL;
break;
case SVt_IV:
- SvANY(dstr) = new_XIV();
+ SvANY(dstr) = (XPVIV*)((char*)&(dstr->sv_u.svu_iv) - STRUCT_OFFSET(XPVIV, xiv_iv));
SvIV_set(dstr, SvIVX(sstr));
break;
case SVt_NV:
SvNV_set(dstr, SvNVX(sstr));
break;
case SVt_RV:
- SvANY(dstr) = new_XRV();
+ SvANY(dstr) = &(dstr->sv_u.svu_rv);
Perl_rvpv_dup(aTHX_ dstr, sstr, param);
break;
case SVt_PV:
SvANY(dstr) = new_XPVAV();
SvCUR_set(dstr, SvCUR(sstr));
SvLEN_set(dstr, SvLEN(sstr));
- SvIV_set(dstr, SvIVX(sstr));
- SvNV_set(dstr, SvNVX(sstr));
SvMAGIC_set(dstr, mg_dup(SvMAGIC(sstr), param));
SvSTASH_set(dstr, hv_dup_inc(SvSTASH(sstr), param));
- AvARYLEN((AV*)dstr) = sv_dup_inc(AvARYLEN((AV*)sstr), param);
if (AvARRAY((AV*)sstr)) {
SV **dst_ary, **src_ary;
SSize_t items = AvFILLp((AV*)sstr) + 1;
SvANY(dstr) = new_XPVHV();
SvCUR_set(dstr, SvCUR(sstr));
SvLEN_set(dstr, SvLEN(sstr));
- SvIV_set(dstr, SvIVX(sstr));
- SvNV_set(dstr, SvNVX(sstr));
+ HvTOTALKEYS(dstr) = HvTOTALKEYS(sstr);
SvMAGIC_set(dstr, mg_dup(SvMAGIC(sstr), param));
SvSTASH_set(dstr, hv_dup_inc(SvSTASH(sstr), param));
{
- const char *hvname = HvNAME_get((HV*)sstr);
- struct xpvhv_aux *aux = ((XPVHV *)SvANY(sstr))->xhv_aux;
-
- if (aux) {
- New(0, ((XPVHV *)SvANY(dstr))->xhv_aux, 1, struct xpvhv_aux);
- HvRITER_set((HV*)dstr, HvRITER_get((HV*)sstr));
- /* FIXME strlen HvNAME */
- Perl_hv_name_set(aTHX_ (HV*) dstr, hvname,
- hvname ? strlen(hvname) : 0,
- 0);
- } else {
- ((XPVHV *)SvANY(dstr))->xhv_aux = 0;
- }
+ HEK *hvname = 0;
+
if (HvARRAY((HV*)sstr)) {
STRLEN i = 0;
- XPVHV *dxhv = (XPVHV*)SvANY(dstr);
- XPVHV *sxhv = (XPVHV*)SvANY(sstr);
- Newz(0, dxhv->xhv_array,
- PERL_HV_ARRAY_ALLOC_BYTES(dxhv->xhv_max+1), char);
+ const bool sharekeys = !!HvSHAREKEYS(sstr);
+ XPVHV * const dxhv = (XPVHV*)SvANY(dstr);
+ XPVHV * const sxhv = (XPVHV*)SvANY(sstr);
+ char *darray;
+ New(0, darray,
+ PERL_HV_ARRAY_ALLOC_BYTES(dxhv->xhv_max+1)
+ + (SvOOK(sstr) ? sizeof(struct xpvhv_aux) : 0), char);
+ HvARRAY(dstr) = (HE**)darray;
while (i <= sxhv->xhv_max) {
- ((HE**)dxhv->xhv_array)[i]
- = he_dup(((HE**)sxhv->xhv_array)[i],
- (bool)!!HvSHAREKEYS(sstr), param);
+ HE *source = HvARRAY(sstr)[i];
+ HvARRAY(dstr)[i]
+ = source ? he_dup(source, sharekeys, param) : 0;
++i;
}
- HvEITER_set(dstr, he_dup(HvEITER_get(sstr),
- (bool)!!HvSHAREKEYS(sstr), param));
+ if (SvOOK(sstr)) {
+ struct xpvhv_aux *saux = HvAUX(sstr);
+ struct xpvhv_aux *daux = HvAUX(dstr);
+ /* This flag isn't copied. */
+ /* SvOOK_on(hv) attacks the IV flags. */
+ SvFLAGS(dstr) |= SVf_OOK;
+
+ hvname = saux->xhv_name;
+ daux->xhv_name = hvname ? hek_dup(hvname, param) : hvname;
+
+ daux->xhv_riter = saux->xhv_riter;
+ daux->xhv_eiter = saux->xhv_eiter
+ ? he_dup(saux->xhv_eiter, (bool)!!HvSHAREKEYS(sstr),
+ param) : 0;
+ }
}
else {
SvPV_set(dstr, Nullch);
- HvEITER_set((HV*)dstr, (HE*)NULL);
}
/* Record stashes for possible cloning in Perl_clone(). */
if(hvname)
long longval;
GP *gp;
IV iv;
- I32 i;
char *c = NULL;
void (*dptr) (void*);
void (*dxptr) (pTHX_ void*);
OP *o;
+ /* Unions for circumventing strict ANSI C89 casting rules. */
+ union { void *vptr; void (*dptr)(void*); } u1, u2;
+ union { void *vptr; void (*dxptr)(pTHX_ void*); } u3, u4;
Newz(54, nss, max, ANY);
while (ix > 0) {
- i = POPINT(ss,ix);
+ I32 i = POPINT(ss,ix);
TOPINT(nss,ix) = i;
switch (i) {
case SAVEt_ITEM: /* normal string */
ptr = POPPTR(ss,ix);
TOPPTR(nss,ix) = any_dup(ptr, proto_perl); /* XXX quite arbitrary */
dptr = POPDPTR(ss,ix);
- TOPDPTR(nss,ix) = (void (*)(void*))any_dup((void *)dptr, proto_perl);
+ u1.dptr = dptr;
+ u2.vptr = any_dup(u1.vptr, proto_perl);
+ TOPDPTR(nss,ix) = u2.dptr;
break;
case SAVEt_DESTRUCTOR_X:
ptr = POPPTR(ss,ix);
TOPPTR(nss,ix) = any_dup(ptr, proto_perl); /* XXX quite arbitrary */
dxptr = POPDXPTR(ss,ix);
- TOPDXPTR(nss,ix) = (void (*)(pTHX_ void*))any_dup((void *)dxptr, proto_perl);
+ u3.dxptr = dxptr;
+ u4.vptr = any_dup(u3.vptr, proto_perl);;
+ TOPDXPTR(nss,ix) = u4.dxptr;
break;
case SAVEt_REGCONTEXT:
case SAVEt_ALLOC:
static void
do_mark_cloneable_stash(pTHX_ SV *sv)
{
- const char *hvname = HvNAME_get((HV*)sv);
+ const HEK *hvname = HvNAME_HEK((HV*)sv);
if (hvname) {
GV* cloner = gv_fetchmethod_autoload((HV*)sv, "CLONE_SKIP", 0);
SvFLAGS(sv) |= SVphv_CLONEABLE; /* clone objects by default */
ENTER;
SAVETMPS;
PUSHMARK(SP);
- XPUSHs(sv_2mortal(newSVpv(hvname, 0)));
+ XPUSHs(sv_2mortal(newSVhek(hvname)));
PUTBACK;
call_sv((SV*)GvCV(cloner), G_SCALAR);
SPAGAIN;
param->proto_perl = proto_perl;
/* arena roots */
- PL_xiv_arenaroot = NULL;
- PL_xiv_root = NULL;
PL_xnv_arenaroot = NULL;
PL_xnv_root = NULL;
- PL_xrv_arenaroot = NULL;
- PL_xrv_root = NULL;
PL_xpv_arenaroot = NULL;
PL_xpv_root = NULL;
PL_xpviv_arenaroot = NULL;
PL_debug = proto_perl->Idebug;
+ PL_hash_seed = proto_perl->Ihash_seed;
+ PL_rehash_seed = proto_perl->Irehash_seed;
+
#ifdef USE_REENTRANT_API
/* XXX: things like -Dm will segfault here in perlio, but doing
* PERL_SET_CONTEXT(proto_perl);
/* 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;
/* create (a non-shared!) shared string table */
PL_strtab = newHV();
HvSHAREKEYS_off(PL_strtab);
- hv_ksplit(PL_strtab, 512);
+ hv_ksplit(PL_strtab, HvTOTALKEYS(proto_perl->Istrtab));
ptr_table_store(PL_ptr_table, proto_perl->Istrtab, PL_strtab);
PL_compiling = proto_perl->Icompiling;
{
const I32 len = av_len((AV*)proto_perl->Iregex_padav);
SV** regexen = AvARRAY((AV*)proto_perl->Iregex_padav);
+ IV i;
av_push(PL_regex_padav,
sv_dup_inc(regexen[0],param));
for(i = 1; i <= len; i++) {
*/
if (SvANY(proto_perl->Ilinestr)) {
PL_linestr = sv_dup_inc(proto_perl->Ilinestr, param);
- i = proto_perl->Ibufptr - SvPVX(proto_perl->Ilinestr);
+ i = proto_perl->Ibufptr - SvPVX_const(proto_perl->Ilinestr);
PL_bufptr = SvPVX(PL_linestr) + (i < 0 ? 0 : i);
- i = proto_perl->Ioldbufptr - SvPVX(proto_perl->Ilinestr);
+ i = proto_perl->Ioldbufptr - SvPVX_const(proto_perl->Ilinestr);
PL_oldbufptr = SvPVX(PL_linestr) + (i < 0 ? 0 : i);
- i = proto_perl->Ioldoldbufptr - SvPVX(proto_perl->Ilinestr);
+ i = proto_perl->Ioldoldbufptr - SvPVX_const(proto_perl->Ilinestr);
PL_oldoldbufptr = SvPVX(PL_linestr) + (i < 0 ? 0 : i);
- i = proto_perl->Ilinestart - SvPVX(proto_perl->Ilinestr);
+ i = proto_perl->Ilinestart - SvPVX_const(proto_perl->Ilinestr);
PL_linestart = SvPVX(PL_linestr) + (i < 0 ? 0 : i);
}
else {
/* XXX See comment on SvANY(proto_perl->Ilinestr) above */
if (SvANY(proto_perl->Ilinestr)) {
- i = proto_perl->Ilast_uni - SvPVX(proto_perl->Ilinestr);
+ i = proto_perl->Ilast_uni - SvPVX_const(proto_perl->Ilinestr);
PL_last_uni = SvPVX(PL_linestr) + (i < 0 ? 0 : i);
- i = proto_perl->Ilast_lop - SvPVX(proto_perl->Ilinestr);
+ i = proto_perl->Ilast_lop - SvPVX_const(proto_perl->Ilinestr);
PL_last_lop = SvPVX(PL_linestr) + (i < 0 ? 0 : i);
PL_last_lop_op = proto_perl->Ilast_lop_op;
}
PL_glob_index = proto_perl->Iglob_index;
PL_srand_called = proto_perl->Isrand_called;
- PL_hash_seed = proto_perl->Ihash_seed;
- PL_rehash_seed = proto_perl->Irehash_seed;
PL_uudmap['M'] = 0; /* reinits on demand */
PL_bitcount = Nullch; /* reinits on demand */
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
ENTER;
SAVETMPS;
PUSHMARK(SP);
- XPUSHs(sv_2mortal(newSVpv(HvNAME_get(stash), 0)));
+ XPUSHs(sv_2mortal(newSVhek(HvNAME_HEK(stash))));
PUTBACK;
call_sv((SV*)GvCV(cloner), G_DISCARD);
FREETMPS;
uni = POPs;
PUTBACK;
s = SvPV(uni, len);
- if (s != SvPVX(sv)) {
+ if (s != SvPVX_const(sv)) {
SvGROW(sv, len + 1);
- Move(s, SvPVX(sv), len, char);
+ Move(s, SvPVX_const(sv), len, char);
SvCUR_set(sv, len);
SvPVX(sv)[len] = 0;
}
https://perl5.git.perl.org / perl5.git / blobdiff