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(sv,len);
- sv_setpvn(name, str, len);
+ sv_setpv(name, SvPV_nolen_const(sv));
}
if (subscript_type == FUV_SUBSCRIPT_HASH) {
sv_insert(varname, 0, 0, " ", 1);
}
Perl_warner(aTHX_ packWARN(WARN_UNINITIALIZED), PL_warn_uninit,
- varname ? SvPV_nolen(varname) : "",
+ varname ? SvPV_nolen_const(varname) : "",
" in ", OP_DESC(PL_op));
}
else
=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;
}
/*
sv_unref(sv);
if (SvTYPE(sv) < SVt_PV) {
sv_upgrade(sv, SVt_PV);
- s = SvPVX(sv);
+ s = SvPVX_mutable(sv);
}
else if (SvOOK(sv)) { /* pv is offset? */
sv_backoff(sv);
- s = SvPVX(sv);
+ s = SvPVX_mutable(sv);
if (newlen > SvLEN(sv))
newlen += 10 * (newlen - SvCUR(sv)); /* avoid copy each time */
#ifdef HAS_64K_LIMIT
newlen = PERL_STRLEN_ROUNDUP(newlen);
if (SvLEN(sv) && s) {
#ifdef MYMALLOC
- const STRLEN l = malloced_size((void*)SvPVX(sv));
+ const STRLEN l = malloced_size((void*)SvPVX_const(sv));
if (newlen <= l) {
SvLEN_set(sv, l);
return s;
register const char *typestr;
if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,string)) &&
(!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
- char *pv = lp ? SvPV(tmpstr, *lp) : SvPV_nolen(tmpstr);
+ /* Unwrap this: */
+ /* char *pv = lp ? SvPV(tmpstr, *lp) : SvPV_nolen(tmpstr); */
+
+ char *pv;
+ if ((SvFLAGS(tmpstr) & (SVf_POK)) == SVf_POK) {
+ if (flags & SV_CONST_RETURN) {
+ pv = (char *) SvPVX_const(tmpstr);
+ } else {
+ pv = (flags & SV_MUTABLE_RETURN)
+ ? SvPVX_mutable(tmpstr) : SvPVX(tmpstr);
+ }
+ if (lp)
+ *lp = SvCUR(tmpstr);
+ } else {
+ pv = sv_2pv_flags(tmpstr, lp, flags);
+ }
if (SvUTF8(tmpstr))
SvUTF8_on(sv);
else
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);
}
/*
* had a FLAG in SVs to signal if there are any hibit
* chars in the PV. Given that there isn't such a flag
* make the loop as fast as possible. */
- U8 *s = (U8 *) SvPVX(sv);
- U8 *e = (U8 *) SvEND(sv);
- U8 *t = s;
+ const U8 *s = (U8 *) SvPVX_const(sv);
+ const U8 *e = (U8 *) SvEND(sv);
+ const U8 *t = s;
int hibit = 0;
while (t < e) {
}
if (hibit) {
STRLEN len = SvCUR(sv) + 1; /* Plus the \0 */
- s = 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, (char*)s);
+ SvPV_set(sv, (char*)recoded);
SvCUR_set(sv, len - 1);
SvLEN_set(sv, len); /* No longer know the real size. */
}
Perl_sv_utf8_decode(pTHX_ register SV *sv)
{
if (SvPOKp(sv)) {
- U8 *c;
- U8 *e;
+ const U8 *c;
+ const U8 *e;
/* The octets may have got themselves encoded - get them back as
* bytes
/* it is actually just a matter of turning the utf8 flag on, but
* we want to make sure everything inside is valid utf8 first.
*/
- c = (U8 *) SvPVX(sv);
+ c = (const U8 *) SvPVX_const(sv);
if (!is_utf8_string(c, SvCUR(sv)+1))
return FALSE;
- e = (U8 *) SvEND(sv);
+ e = (const U8 *) SvEND(sv);
while (c < e) {
U8 ch = *c++;
if (!UTF8_IS_INVARIANT(ch)) {
}
if (!intro)
cv_ckproto(cv, (GV*)dstr,
- SvPOK(sref) ? SvPVX(sref) : Nullch);
+ SvPOK(sref)
+ ? SvPVX_const(sref) : Nullch);
}
GvCV(dstr) = (CV*)sref;
GvCVGEN(dstr) = 0; /* Switch off cacheness. */
#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_PVIV);
+ assert (SvTYPE(dstr) >= SVt_PV);
SvPV_set(dstr,
- sharepvn(SvPVX_const(sstr),
- (sflags & SVf_UTF8?-cur:cur), hash));
- SvUV_set(dstr, hash);
- }
+ HEK_KEY(share_hek_hek(SvSHARED_HEK_FROM_PV(SvPVX_const(sstr)))));
+ }
SvLEN_set(dstr, len);
SvCUR_set(dstr, cur);
SvREADONLY_on(dstr);
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"));
- SvUV_set(dstr, hash);
- 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));
(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, const char *pvx, STRLEN cur, STRLEN len,
- U32 hash, SV *after)
+S_sv_release_COW(pTHX_ register SV *sv, const char *pvx, STRLEN len, SV *after)
{
if (len) { /* this SV was SvIsCOW_normal(sv) */
/* we need to find the SV pointing to us. */
SV_COW_NEXT_SV_SET(current, after);
}
} else {
- unsharepvn(pvx, SvUTF8(sv) ? -(I32)cur : cur, hash);
+ unshare_hek(SvSHARED_HEK_FROM_PV(pvx));
}
}
const char *pvx = SvPVX_const(sv);
const STRLEN len = SvLEN(sv);
const STRLEN cur = SvCUR(sv);
- const U32 hash = SvSHARED_HASH(sv);
SV * const next = SV_COW_NEXT_SV(sv); /* next COW sv in the loop. */
if (DEBUG_C_TEST) {
PerlIO_printf(Perl_debug_log,
SvCUR_set(sv, cur);
*SvEND(sv) = '\0';
}
- sv_release_COW(sv, pvx, cur, len, hash, next);
+ sv_release_COW(sv, pvx, len, next);
if (DEBUG_C_TEST) {
sv_dump(sv);
}
if (SvREADONLY(sv)) {
if (SvFAKE(sv)) {
const char *pvx = SvPVX_const(sv);
- const int is_utf8 = SvUTF8(sv);
const STRLEN len = SvCUR(sv);
- const U32 hash = SvSHARED_HASH(sv);
SvFAKE_off(sv);
SvREADONLY_off(sv);
SvPV_set(sv, Nullch);
SvGROW(sv, len + 1);
Move(pvx,SvPVX_const(sv),len,char);
*SvEND(sv) = '\0';
- unsharepvn(pvx, is_utf8 ? -(I32)len : len, hash);
+ unshare_hek(SvSHARED_HEK_FROM_PV(pvx));
}
else if (IN_PERL_RUNTIME)
Perl_croak(aTHX_ PL_no_modify);
SV* csv = sv_2mortal(newSVpvn(spv, slen));
sv_utf8_upgrade(csv);
- spv = SvPV(csv, slen);
+ spv = SvPV_const(csv, slen);
}
else
sv_utf8_upgrade_nomg(dsv);
(void)SvPOK_only_UTF8(bigstr);
if (offset + len > curlen) {
SvGROW(bigstr, offset+len+1);
- Zero(SvPVX_const(bigstr)+curlen, offset+len-curlen, char);
+ Zero(SvPVX(bigstr)+curlen, offset+len-curlen, char);
SvCUR_set(bigstr, offset+len);
}
freescalar:
/* Don't bother with SvOOK_off(sv); as we're only going to free it. */
if (SvOOK(sv)) {
- SvPV_set(sv, SvPVX(sv) - SvIVX(sv));
+ SvPV_set(sv, SvPVX_mutable(sv) - SvIVX(sv));
/* Don't even bother with turning off the OOK flag. */
}
/* FALL THROUGH */
PerlIO_printf(Perl_debug_log, "Copy on write: clear\n");
sv_dump(sv);
}
- sv_release_COW(sv, SvPVX_const(sv), SvCUR(sv), SvLEN(sv),
- SvUVX(sv), SV_COW_NEXT_SV(sv));
+ sv_release_COW(sv, SvPVX_const(sv), SvLEN(sv),
+ SV_COW_NEXT_SV(sv));
/* And drop it here. */
SvFAKE_off(sv);
} else if (SvLEN(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));
+ unshare_hek(SvSHARED_HEK_FROM_PV(SvPVX_const(sv)));
SvFAKE_off(sv);
}
#endif
if (SvUTF8(sv1)) {
svrecode = newSVpvn(pv2, cur2);
sv_recode_to_utf8(svrecode, PL_encoding);
- pv2 = SvPV(svrecode, cur2);
+ pv2 = SvPV_const(svrecode, cur2);
}
else {
svrecode = newSVpvn(pv1, cur1);
sv_recode_to_utf8(svrecode, PL_encoding);
- pv1 = SvPV(svrecode, cur1);
+ pv1 = SvPV_const(svrecode, cur1);
}
/* Now both are in UTF-8. */
if (cur1 != cur2) {
if (PL_encoding) {
svrecode = newSVpvn(pv2, cur2);
sv_recode_to_utf8(svrecode, PL_encoding);
- pv2 = SvPV(svrecode, cur2);
+ pv2 = SvPV_const(svrecode, cur2);
}
else {
pv2 = tpv = (char*)bytes_to_utf8((const U8*)pv2, &cur2);
if (PL_encoding) {
svrecode = newSVpvn(pv1, cur1);
sv_recode_to_utf8(svrecode, PL_encoding);
- pv1 = SvPV(svrecode, cur1);
+ pv1 = SvPV_const(svrecode, cur1);
}
else {
pv1 = tpv = (char*)bytes_to_utf8((const U8*)pv1, &cur1);
mg = SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_collxfrm) : (MAGIC *) NULL;
if (!mg || !mg->mg_ptr || *(U32*)mg->mg_ptr != PL_collation_ix) {
- char *s, *xf;
+ const char *s;
+ char *xf;
STRLEN len, xlen;
if (mg)
Safefree(mg->mg_ptr);
- s = SvPV(sv, len);
+ s = SvPV_const(sv, len);
if ((xf = mem_collxfrm(s, len, &xlen))) {
if (SvREADONLY(sv)) {
SAVEFREEPV(xf);
Perl_croak(aTHX_ "Wide character in $/");
}
}
- rsptr = SvPV(PL_rs, rslen);
+ rsptr = SvPV_const(PL_rs, rslen);
}
}
if (!hash)
PERL_HASH(hash, src, len);
new_SV(sv);
- sv_upgrade(sv, SVt_PVIV);
+ sv_upgrade(sv, SVt_PV);
SvPV_set(sv, sharepvn(src, is_utf8?-len:len, hash));
SvCUR_set(sv, len);
- SvUV_set(sv, hash);
SvLEN_set(sv, 0);
SvREADONLY_on(sv);
SvFAKE_on(sv);
char *
Perl_sv_pv(pTHX_ SV *sv)
{
- STRLEN n_a;
-
if (SvPOK(sv))
return SvPVX(sv);
- return sv_2pv(sv, &n_a);
+ return sv_2pv(sv, 0);
}
/*
else {
SV *nsv = sv_2mortal(newSVpvn(eptr, elen));
sv_utf8_upgrade(nsv);
- eptr = SvPVX(nsv);
+ eptr = SvPVX_const(nsv);
elen = SvCUR(nsv);
}
SvGROW(sv, SvCUR(sv) + elen + 1);
}
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 */
-
- SvPV_set(dstr, sharepvn(SvPVX_const(sstr), SvCUR(sstr),
- SvUVX(sstr)));
- SvUV_set(dstr, 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
if (SvPOK(sv) && !SvUTF8(sv) && !IN_BYTES && SvROK(encoding)) {
SV *uni;
STRLEN len;
- char *s;
+ const char *s;
dSP;
ENTER;
SAVETMPS;
SPAGAIN;
uni = POPs;
PUTBACK;
- s = SvPV(uni, len);
+ s = SvPV_const(uni, len);
if (s != SvPVX_const(sv)) {
SvGROW(sv, len + 1);
- Move(s, SvPVX_const(sv), len, char);
+ Move(s, SvPVX(sv), len + 1, char);
SvCUR_set(sv, len);
- SvPVX(sv)[len] = 0;
}
FREETMPS;
LEAVE;
projects / p5sagit/p5-mst-13.2.git / blobdiff