Re-implement the SvOOK() hack to store the offset as a BER encoded

number in the part of the PVX that is being released. (It will always
fit, as chopping off 1 byte gives just enough space for recording a
delta of up to 127). This allows SvOOK() to co-exist with SvIOK_on(),
which means all the calls to SvOOK_off() [with the possibility of a
call to sv_backoff()] in SvIOK_on() can be removed. This ought to make
a lot of straight line code a little bit simpler.
OOK()d scalars can now be SVt_PV, as the IVX isn't needed.

p4raw-id: //depot/perl@32836

1 files changed, 86 insertions, 37 deletions

diff --git a/sv.c b/sv.c
index b514753564..883b97f20c 100644
--- a/sv.c
+++ b/sv.c
@@ -1397,27 +1397,16 @@ wrapper instead.
 int
 Perl_sv_backoff(pTHX_ register SV *sv)
 {
+    UV delta = sv_read_offset(sv);
+    const char * const s = SvPVX_const(sv);
     PERL_UNUSED_CONTEXT;
     assert(SvOOK(sv));
     assert(SvTYPE(sv) != SVt_PVHV);
     assert(SvTYPE(sv) != SVt_PVAV);
-    if (SvIVX(sv)) {
-	const char * const s = SvPVX_const(sv);
-#ifdef DEBUGGING
-	/* Validate the preceding buffer's sentinels to verify that no-one is
-	   using it.  */
-	const U8 *p = (const U8*) s;
-	const U8 *const real_start = p - SvIVX(sv);
-	while (p > real_start) {
-	    --p;
-	    assert (*p == (U8)PTR2UV(p));
-	}
-#endif
-	SvLEN_set(sv, SvLEN(sv) + SvIVX(sv));
-	SvPV_set(sv, SvPVX(sv) - SvIVX(sv));
-	SvIV_set(sv, 0);
-	Move(s, SvPVX(sv), SvCUR(sv)+1, char);
-    }
+
+    SvLEN_set(sv, SvLEN(sv) + delta);
+    SvPV_set(sv, SvPVX(sv) - delta);
+    Move(s, SvPVX(sv), SvCUR(sv)+1, char);
     SvFLAGS(sv) &= ~SVf_OOK;
     return 0;
 }
@@ -3779,7 +3768,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
 	    SvNV_set(dstr, SvNVX(sstr));
 	}
 	if (sflags & SVp_IOK) {
-	    SvOOK_off(dstr);
 	    SvIV_set(dstr, SvIVX(sstr));
 	    /* Must do this otherwise some other overloaded use of 0x80000000
 	       gets confused. I guess SVpbm_VALID */
@@ -4202,6 +4190,43 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags)
 	sv_unglob(sv);
 }
 
+UV
+Perl_sv_read_offset(pTHX_ const SV *const sv) {
+    U8 *p;
+    UV delta = 0;
+    U8 c;
+
+    if (!SvOOK(sv))
+	return 0;
+    p = (U8*)SvPVX_const(sv);
+    if (!p)
+	return 0;
+
+    c = *--p;
+    delta = c & 0x7F;
+    while ((c & 0x80)) {
+	UV const last_delta = delta;
+	delta <<= 7;
+	if (delta < last_delta)
+	    Perl_croak(aTHX_ "panic: overflow in sv_read_offset from %"UVuf
+		       " to %"UVuf, last_delta, delta);
+	c = *--p;
+	delta |= c & 0x7F;
+    }
+#ifdef DEBUGGING
+    {
+	/* Validate the preceding buffer's sentinels to verify that no-one is
+	   using it.  */
+	const U8 *const real_start = (U8 *) SvPVX_const(sv) - delta;
+	while (p > real_start) {
+	    --p;
+	    assert (*p == (U8)PTR2UV(p));
+	}
+    }
+#endif
+    return delta;
+}
+
 /*
 =for apidoc sv_chop
 
@@ -4219,6 +4244,12 @@ void
 Perl_sv_chop(pTHX_ register SV *sv, register const char *ptr)
 {
     register STRLEN delta;
+    UV old_delta;
+    U8 *p;
+#ifdef DEBUGGING
+    const U8 *real_start;
+#endif
+
     if (!ptr || !SvPOKp(sv))
 	return;
     delta = ptr - SvPVX_const(sv);
@@ -4228,8 +4259,6 @@ Perl_sv_chop(pTHX_ register SV *sv, register const char *ptr)
     }
     assert(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 */
@@ -4239,27 +4268,47 @@ Perl_sv_chop(pTHX_ register SV *sv, register const char *ptr)
 	    Move(pvx,SvPVX(sv),len,char);
 	    *SvEND(sv) = '\0';
 	}
-	SvIV_set(sv, 0);
-	/* Same SvOOK_on but SvOOK_on does a SvIOK_off
-	   and we do that anyway inside the SvNIOK_off
-	*/
 	SvFLAGS(sv) |= SVf_OOK;
+	old_delta = 0;
+    } else {
+	old_delta = sv_read_offset(sv);
     }
-    SvNIOK_off(sv);
     SvLEN_set(sv, SvLEN(sv) - delta);
     SvCUR_set(sv, SvCUR(sv) - delta);
     SvPV_set(sv, SvPVX(sv) + delta);
-    SvIV_set(sv, SvIVX(sv) + delta);
+
+    p = (U8 *)SvPVX_const(sv);
+
+    delta += old_delta;
+
 #ifdef DEBUGGING
-    {
-	/* Fill the preceding buffer with sentinals to verify that no-one is
-	   using it.  */
-	U8 *p = (U8*) SvPVX(sv);
-	const U8 *const real_start = p - SvIVX(sv);
-	while (p > real_start) {
-	    --p;
-	    *p = (U8)PTR2UV(p);
-	}
+    real_start = p - delta;
+#endif
+
+    if (delta < 0x80) {
+	*--p = (U8) delta;
+    } else {
+	/* Code lovingly ripped from pp_pack.c:  */
+	U8   buf[(sizeof(UV)*CHAR_BIT)/7+1];
+	U8  *in = buf;
+	STRLEN len;
+	do {
+	    *in++ = (U8)((delta & 0x7f) | 0x80);
+	    delta >>= 7;
+	} while (delta);
+	buf[0] &= 0x7f; /* clear continue bit */
+
+	len = in - buf;
+	p -= len;
+	Copy(buf, p, len, U8);
+    }
+
+#ifdef DEBUGGING
+    /* Fill the preceding buffer with sentinals to verify that no-one is
+       using it.  */
+    while (p > real_start) {
+	--p;
+	*p = (U8)PTR2UV(p);
     }
 #endif
 }
@@ -5278,13 +5327,13 @@ Perl_sv_clear(pTHX_ register SV *sv)
     case SVt_PVMG:
     case SVt_PVNV:
     case SVt_PVIV:
+    case SVt_PV:
       freescalar:
 	/* Don't bother with SvOOK_off(sv); as we're only going to free it.  */
 	if (SvOOK(sv)) {
-	    SvPV_set(sv, SvPVX_mutable(sv) - SvIVX(sv));
+	    SvPV_set(sv, SvPVX_mutable(sv) - sv_read_offset(sv));
 	    /* Don't even bother with turning off the OOK flag.  */
 	}
-    case SVt_PV:
 	if (SvROK(sv)) {
 	    SV * const target = SvRV(sv);
 	    if (SvWEAKREF(sv))