X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doop.c;h=ad626ca6d392ebe25a22dd3059045195d9586571;hb=ffb4593ce8673bf9b750cef7f50a426a002fff80;hp=e80fa489ce93f18691d6e29cb27d9ba6113ab7a4;hpb=533c011aecf9bca2c9ad025efccd7b74ad222cda;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/doop.c b/doop.c
index e80fa48..ad626ca 100644
--- a/doop.c
+++ b/doop.c
@@ -1,6 +1,6 @@
 /*    doop.c
  *
- *    Copyright (c) 1991-1997, Larry Wall
+ *    Copyright (c) 1991-1999, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -12,86 +12,625 @@
  */
 
 #include "EXTERN.h"
+#define PERL_IN_DOOP_C
 #include "perl.h"
 
 #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
 #include <signal.h>
 #endif
 
-I32
-do_trans(SV *sv, OP *arg)
+STATIC I32
+S_do_trans_CC_simple(pTHX_ SV *sv)
 {
     dTHR;
-    register short *tbl;
-    register U8 *s;
-    register U8 *send;
-    register U8 *d;
-    register I32 ch;
-    register I32 matches = 0;
-    register I32 squash = PL_op->op_private & OPpTRANS_SQUASH;
-    register U8 *p;
+    U8 *s;
+    U8 *send;
+    I32 matches = 0;
     STRLEN len;
+    short *tbl;
+    I32 ch;
 
-    if (SvREADONLY(sv) && !(PL_op->op_private & OPpTRANS_COUNTONLY))
-	croak(no_modify);
     tbl = (short*)cPVOP->op_pv;
+    if (!tbl)
+	Perl_croak(aTHX_ "panic: do_trans");
+
+    s = (U8*)SvPV(sv, len);
+    send = s + len;
+
+    while (s < send) {
+	if ((ch = tbl[*s]) >= 0) {
+	    matches++;
+	    *s = ch;
+	}
+	s++;
+    }
+    SvSETMAGIC(sv);
+
+    return matches;
+}
+
+STATIC I32
+S_do_trans_CC_count(pTHX_ SV *sv)
+{
+    dTHR;
+    U8 *s;
+    U8 *send;
+    I32 matches = 0;
+    STRLEN len;
+    short *tbl;
+
+    tbl = (short*)cPVOP->op_pv;
+    if (!tbl)
+	Perl_croak(aTHX_ "panic: do_trans");
+
     s = (U8*)SvPV(sv, len);
-    if (!len)
-	return 0;
-    if (!SvPOKp(sv))
-	s = (U8*)SvPV_force(sv, len);
-    (void)SvPOK_only(sv);
     send = s + len;
-    if (!tbl || !s)
-	croak("panic: do_trans");
-    DEBUG_t( deb("2.TBL\n"));
-    if (!PL_op->op_private) {
+
+    while (s < send) {
+	if (tbl[*s] >= 0)
+	    matches++;
+	s++;
+    }
+
+    return matches;
+}
+
+STATIC I32
+S_do_trans_CC_complex(pTHX_ SV *sv)
+{
+    dTHR;
+    U8 *s;
+    U8 *send;
+    U8 *d;
+    I32 matches = 0;
+    STRLEN len;
+    short *tbl;
+    I32 ch;
+
+    tbl = (short*)cPVOP->op_pv;
+    if (!tbl)
+	Perl_croak(aTHX_ "panic: do_trans");
+
+    s = (U8*)SvPV(sv, len);
+    send = s + len;
+
+    d = s;
+    if (PL_op->op_private & OPpTRANS_SQUASH) {
+	U8* p = send;
+
 	while (s < send) {
 	    if ((ch = tbl[*s]) >= 0) {
+		*d = ch;
 		matches++;
-		*s = ch;
+		if (p == d - 1 && *p == *d)
+		    matches--;
+		else
+		    p = d++;
 	    }
+	    else if (ch == -1)		/* -1 is unmapped character */
+		*d++ = *s;		/* -2 is delete character */
 	    s++;
 	}
-	SvSETMAGIC(sv);
     }
-    else if (PL_op->op_private & OPpTRANS_COUNTONLY) {
+    else {
 	while (s < send) {
-	    if (tbl[*s] >= 0)
+	    if ((ch = tbl[*s]) >= 0) {
+		*d = ch;
 		matches++;
+		d++;
+	    }
+	    else if (ch == -1)		/* -1 is unmapped character */
+		*d++ = *s;		/* -2 is delete character */
 	    s++;
 	}
     }
+    matches += send - d;	/* account for disappeared chars */
+    *d = '\0';
+    SvCUR_set(sv, d - (U8*)SvPVX(sv));
+    SvSETMAGIC(sv);
+
+    return matches;
+}
+
+STATIC I32
+S_do_trans_UU_simple(pTHX_ SV *sv)
+{
+    dTHR;
+    U8 *s;
+    U8 *send;
+    U8 *d;
+    I32 matches = 0;
+    STRLEN len;
+
+    SV* rv = (SV*)cSVOP->op_sv;
+    HV* hv = (HV*)SvRV(rv);
+    SV** svp = hv_fetch(hv, "NONE", 4, FALSE);
+    UV none = svp ? SvUV(*svp) : 0x7fffffff;
+    UV extra = none + 1;
+    UV final;
+    UV uv;
+
+    s = (U8*)SvPV(sv, len);
+    send = s + len;
+
+    svp = hv_fetch(hv, "FINAL", 5, FALSE);
+    if (svp)
+	final = SvUV(*svp);
+
+    d = s;
+    while (s < send) {
+	if ((uv = swash_fetch(rv, s)) < none) {
+	    s += UTF8SKIP(s);
+	    matches++;
+	    d = uv_to_utf8(d, uv);
+	}
+	else if (uv == none) {
+	    int i;
+	    for (i = UTF8SKIP(s); i; i--)
+		*d++ = *s++;
+	}
+	else if (uv == extra) {
+	    s += UTF8SKIP(s);
+	    matches++;
+	    d = uv_to_utf8(d, final);
+	}
+	else
+	    s += UTF8SKIP(s);
+    }
+    *d = '\0';
+    SvCUR_set(sv, d - (U8*)SvPVX(sv));
+    SvSETMAGIC(sv);
+
+    return matches;
+}
+
+STATIC I32
+S_do_trans_UU_count(pTHX_ SV *sv)
+{
+    dTHR;
+    U8 *s;
+    U8 *send;
+    I32 matches = 0;
+    STRLEN len;
+
+    SV* rv = (SV*)cSVOP->op_sv;
+    HV* hv = (HV*)SvRV(rv);
+    SV** svp = hv_fetch(hv, "NONE", 4, FALSE);
+    UV none = svp ? SvUV(*svp) : 0x7fffffff;
+    UV uv;
+
+    s = (U8*)SvPV(sv, len);
+    send = s + len;
+
+    while (s < send) {
+	if ((uv = swash_fetch(rv, s)) < none)
+	    matches++;
+	s += UTF8SKIP(s);
+    }
+
+    return matches;
+}
+
+STATIC I32
+S_do_trans_UC_simple(pTHX_ SV *sv)
+{
+    dTHR;
+    U8 *s;
+    U8 *send;
+    U8 *d;
+    I32 matches = 0;
+    STRLEN len;
+
+    SV* rv = (SV*)cSVOP->op_sv;
+    HV* hv = (HV*)SvRV(rv);
+    SV** svp = hv_fetch(hv, "NONE", 4, FALSE);
+    UV none = svp ? SvUV(*svp) : 0x7fffffff;
+    UV extra = none + 1;
+    UV final;
+    UV uv;
+
+    s = (U8*)SvPV(sv, len);
+    send = s + len;
+
+    svp = hv_fetch(hv, "FINAL", 5, FALSE);
+    if (svp)
+	final = SvUV(*svp);
+
+    d = s;
+    while (s < send) {
+	if ((uv = swash_fetch(rv, s)) < none) {
+	    s += UTF8SKIP(s);
+	    matches++;
+	    *d++ = (U8)uv;
+	}
+	else if (uv == none) {
+	    I32 ulen;
+	    uv = utf8_to_uv(s, &ulen);
+	    s += ulen;
+	    *d++ = (U8)uv;
+	}
+	else if (uv == extra) {
+	    s += UTF8SKIP(s);
+	    matches++;
+	    *d++ = (U8)final;
+	}
+	else
+	    s += UTF8SKIP(s);
+    }
+    *d = '\0';
+    SvCUR_set(sv, d - (U8*)SvPVX(sv));
+    SvSETMAGIC(sv);
+
+    return matches;
+}
+
+STATIC I32
+S_do_trans_CU_simple(pTHX_ SV *sv)
+{
+    dTHR;
+    U8 *s;
+    U8 *send;
+    U8 *d;
+    U8 *dst;
+    I32 matches = 0;
+    STRLEN len;
+
+    SV* rv = (SV*)cSVOP->op_sv;
+    HV* hv = (HV*)SvRV(rv);
+    SV** svp = hv_fetch(hv, "NONE", 4, FALSE);
+    UV none = svp ? SvUV(*svp) : 0x7fffffff;
+    UV extra = none + 1;
+    UV final;
+    UV uv;
+    U8 tmpbuf[10];
+    I32 bits = 16;
+
+    s = (U8*)SvPV(sv, len);
+    send = s + len;
+
+    svp = hv_fetch(hv, "BITS", 4, FALSE);
+    if (svp)
+	bits = (I32)SvIV(*svp);
+
+    svp = hv_fetch(hv, "FINAL", 5, FALSE);
+    if (svp)
+	final = SvUV(*svp);
+
+    Newz(801, d, len * (bits >> 3) + 1, U8);
+    dst = d;
+
+    while (s < send) {
+	uv = *s++;
+	if (uv < 0x80)
+	    tmpbuf[0] = uv;
+	else {
+	    tmpbuf[0] = (( uv >>  6)         | 0xc0);
+	    tmpbuf[1] = (( uv        & 0x3f) | 0x80);
+	}
+
+	if ((uv = swash_fetch(rv, tmpbuf)) < none) {
+	    matches++;
+	    d = uv_to_utf8(d, uv);
+	}
+	else if (uv == none)
+	    d = uv_to_utf8(d, s[-1]);
+	else if (uv == extra) {
+	    matches++;
+	    d = uv_to_utf8(d, final);
+	}
+    }
+    *d = '\0';
+    sv_usepvn_mg(sv, (char*)dst, d - dst);
+
+    return matches;
+}
+
+/* utf-8 to latin-1 */
+
+STATIC I32
+S_do_trans_UC_trivial(pTHX_ SV *sv)
+{
+    dTHR;
+    U8 *s;
+    U8 *send;
+    U8 *d;
+    STRLEN len;
+
+    s = (U8*)SvPV(sv, len);
+    send = s + len;
+
+    d = s;
+    while (s < send) {
+	if (*s < 0x80)
+	    *d++ = *s++;
+	else {
+	    I32 ulen;
+	    UV uv = utf8_to_uv(s, &ulen);
+	    s += ulen;
+	    *d++ = (U8)uv;
+	}
+    }
+    *d = '\0';
+    SvCUR_set(sv, d - (U8*)SvPVX(sv));
+    SvSETMAGIC(sv);
+
+    return SvCUR(sv);
+}
+
+/* latin-1 to utf-8 */
+
+STATIC I32
+S_do_trans_CU_trivial(pTHX_ SV *sv)
+{
+    dTHR;
+    U8 *s;
+    U8 *send;
+    U8 *d;
+    U8 *dst;
+    I32 matches;
+    STRLEN len;
+
+    s = (U8*)SvPV(sv, len);
+    send = s + len;
+
+    Newz(801, d, len * 2 + 1, U8);
+    dst = d;
+
+    matches = send - s;
+
+    while (s < send) {
+	if (*s < 0x80)
+	    *d++ = *s++;
+	else {
+	    UV uv = *s++;
+	    *d++ = (( uv >>  6)         | 0xc0);
+	    *d++ = (( uv        & 0x3f) | 0x80);
+	}
+    }
+    *d = '\0';
+    sv_usepvn_mg(sv, (char*)dst, d - dst);
+
+    return matches;
+}
+
+STATIC I32
+S_do_trans_UU_complex(pTHX_ SV *sv)
+{
+    dTHR;
+    U8 *s;
+    U8 *send;
+    U8 *d;
+    I32 matches = 0;
+    I32 squash   = PL_op->op_private & OPpTRANS_SQUASH;
+    I32 from_utf = PL_op->op_private & OPpTRANS_FROM_UTF;
+    I32 to_utf   = PL_op->op_private & OPpTRANS_TO_UTF;
+    I32 del      = PL_op->op_private & OPpTRANS_DELETE;
+    SV* rv = (SV*)cSVOP->op_sv;
+    HV* hv = (HV*)SvRV(rv);
+    SV** svp = hv_fetch(hv, "NONE", 4, FALSE);
+    UV none = svp ? SvUV(*svp) : 0x7fffffff;
+    UV extra = none + 1;
+    UV final;
+    UV uv;
+    STRLEN len;
+    U8 *dst;
+
+    s = (U8*)SvPV(sv, len);
+    send = s + len;
+
+    svp = hv_fetch(hv, "FINAL", 5, FALSE);
+    if (svp)
+	final = SvUV(*svp);
+
+    if (PL_op->op_private & OPpTRANS_GROWS) {
+	I32 bits = 16;
+
+	svp = hv_fetch(hv, "BITS", 4, FALSE);
+	if (svp)
+	    bits = (I32)SvIV(*svp);
+
+	Newz(801, d, len * (bits >> 3) + 1, U8);
+	dst = d;
+    }
     else {
 	d = s;
-	p = send;
+	dst = 0;
+    }
+
+    if (squash) {
+	UV puv = 0xfeedface;
 	while (s < send) {
-	    if ((ch = tbl[*s]) >= 0) {
-		*d = ch;
+	    if (from_utf) {
+		uv = swash_fetch(rv, s);
+	    }
+	    else {
+		U8 tmpbuf[2];
+		uv = *s++;
+		if (uv < 0x80)
+		    tmpbuf[0] = uv;
+		else {
+		    tmpbuf[0] = (( uv >>  6)         | 0xc0);
+		    tmpbuf[1] = (( uv        & 0x3f) | 0x80);
+		}
+		uv = swash_fetch(rv, tmpbuf);
+	    }
+	    if (uv < none) {
+		matches++;
+		if (uv != puv) {
+		    if (uv >= 0x80 && to_utf)
+			d = uv_to_utf8(d, uv);
+		    else
+			*d++ = (U8)uv;
+		    puv = uv;
+		}
+		if (from_utf)
+		    s += UTF8SKIP(s);
+		continue;
+	    }
+	    else if (uv == none) {	/* "none" is unmapped character */
+		if (from_utf) {
+		    if (*s < 0x80)
+			*d++ = *s++;
+		    else if (to_utf) {
+			int i;
+			for (i = UTF8SKIP(s); i; --i)
+			    *d++ = *s++;
+		    }
+		    else {
+			I32 ulen;
+			*d++ = (U8)utf8_to_uv(s, &ulen);
+			s += ulen;
+		    }
+		}
+		else {	/* must be to_utf only */
+		    d = uv_to_utf8(d, s[-1]);
+		}
+		puv = 0xfeedface;
+		continue;
+	    }
+	    else if (uv == extra && !del) {
 		matches++;
-		if (squash) {
-		    if (p == d - 1 && *p == *d)
-			matches--;
+		if (uv != puv) {
+		    if (final >= 0x80 && to_utf)
+			d = uv_to_utf8(d, final);
 		    else
-		        p = d++;
+			*d++ = (U8)final;
+		    puv = final;
+		}
+		if (from_utf)
+		    s += UTF8SKIP(s);
+		continue;
+	    }
+	    matches++;		/* "none+1" is delete character */
+	    if (from_utf)
+		s += UTF8SKIP(s);
+	}
+    }
+    else {
+	while (s < send) {
+	    if (from_utf) {
+		uv = swash_fetch(rv, s);
+	    }
+	    else {
+		U8 tmpbuf[2];
+		uv = *s++;
+		if (uv < 0x80)
+		    tmpbuf[0] = uv;
+		else {
+		    tmpbuf[0] = (( uv >>  6)         | 0xc0);
+		    tmpbuf[1] = (( uv        & 0x3f) | 0x80);
+		}
+		uv = swash_fetch(rv, tmpbuf);
+	    }
+	    if (uv < none) {
+		matches++;
+		if (uv >= 0x80 && to_utf)
+		    d = uv_to_utf8(d, uv);
+		else
+		    *d++ = (U8)uv;
+		if (from_utf)
+		    s += UTF8SKIP(s);
+		continue;
+	    }
+	    else if (uv == none) {	/* "none" is unmapped character */
+		if (from_utf) {
+		    if (*s < 0x80)
+			*d++ = *s++;
+		    else if (to_utf) {
+			int i;
+			for (i = UTF8SKIP(s); i; --i)
+			    *d++ = *s++;
+		    }
+		    else {
+			I32 ulen;
+			*d++ = (U8)utf8_to_uv(s, &ulen);
+			s += ulen;
+		    }
 		}
+		else {	/* must be to_utf only */
+		    d = uv_to_utf8(d, s[-1]);
+		}
+		continue;
+	    }
+	    else if (uv == extra && !del) {
+		matches++;
+		if (final >= 0x80 && to_utf)
+		    d = uv_to_utf8(d, final);
 		else
-		    d++;
+		    *d++ = (U8)final;
+		if (from_utf)
+		    s += UTF8SKIP(s);
+		continue;
 	    }
-	    else if (ch == -1)		/* -1 is unmapped character */
-		*d++ = *s;		/* -2 is delete character */
-	    s++;
+	    matches++;		/* "none+1" is delete character */
+	    if (from_utf)
+		s += UTF8SKIP(s);
 	}
-	matches += send - d;	/* account for disappeared chars */
+    }
+    if (dst)
+	sv_usepvn(sv, (char*)dst, d - dst);
+    else {
 	*d = '\0';
 	SvCUR_set(sv, d - (U8*)SvPVX(sv));
-	SvSETMAGIC(sv);
     }
+    SvSETMAGIC(sv);
+
     return matches;
 }
 
+I32
+Perl_do_trans(pTHX_ SV *sv)
+{
+    dTHR;
+    STRLEN len;
+
+    if (SvREADONLY(sv) && !(PL_op->op_private & OPpTRANS_IDENTICAL))
+	Perl_croak(aTHX_ PL_no_modify);
+
+    (void)SvPV(sv, len);
+    if (!len)
+	return 0;
+    if (!SvPOKp(sv))
+	(void)SvPV_force(sv, len);
+    (void)SvPOK_only(sv);
+
+    DEBUG_t( Perl_deb(aTHX_ "2.TBL\n"));
+
+    switch (PL_op->op_private & 63) {
+    case 0:
+	return do_trans_CC_simple(sv);
+
+    case OPpTRANS_FROM_UTF:
+	return do_trans_UC_simple(sv);
+
+    case OPpTRANS_TO_UTF:
+	return do_trans_CU_simple(sv);
+
+    case OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF:
+	return do_trans_UU_simple(sv);
+
+    case OPpTRANS_IDENTICAL:
+	return do_trans_CC_count(sv);
+
+    case OPpTRANS_FROM_UTF|OPpTRANS_IDENTICAL:
+	return do_trans_UC_trivial(sv);
+
+    case OPpTRANS_TO_UTF|OPpTRANS_IDENTICAL:
+	return do_trans_CU_trivial(sv);
+
+    case OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF|OPpTRANS_IDENTICAL:
+	return do_trans_UU_count(sv);
+
+    default:
+	if (PL_op->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF))
+	    return do_trans_UU_complex(sv); /* could be UC or CU too */
+	else
+	    return do_trans_CC_complex(sv);
+    }
+}
+
 void
-do_join(register SV *sv, SV *del, register SV **mark, register SV **sp)
+Perl_do_join(pTHX_ register SV *sv, SV *del, register SV **mark, register SV **sp)
 {
     SV **oldmark = mark;
     register I32 items = sp - mark;
@@ -102,8 +641,7 @@ do_join(register SV *sv, SV *del, register SV **mark, register SV **sp)
 
     mark++;
     len = (items > 0 ? (delimlen * (items - 1) ) : 0);
-    if (SvTYPE(sv) < SVt_PV)
-	sv_upgrade(sv, SVt_PV);
+    (void)SvUPGRADE(sv, SVt_PV);
     if (SvLEN(sv) < len + items) {	/* current length is way too short */
 	while (items-- > 0) {
 	    if (*mark && !SvGMAGICAL(*mark) && SvOK(*mark)) {
@@ -115,7 +653,7 @@ do_join(register SV *sv, SV *del, register SV **mark, register SV **sp)
 	SvGROW(sv, len + 1);		/* so try to pre-extend */
 
 	mark = oldmark;
-	items = sp - mark;;
+	items = sp - mark;
 	++mark;
     }
 
@@ -147,7 +685,7 @@ do_join(register SV *sv, SV *del, register SV **mark, register SV **sp)
 }
 
 void
-do_sprintf(SV *sv, I32 len, SV **sarg)
+Perl_do_sprintf(pTHX_ SV *sv, I32 len, SV **sarg)
 {
     STRLEN patlen;
     char *pat = SvPV(*sarg, patlen);
@@ -160,7 +698,7 @@ do_sprintf(SV *sv, I32 len, SV **sarg)
 }
 
 void
-do_vecset(SV *sv)
+Perl_do_vecset(pTHX_ SV *sv)
 {
     SV *targ = LvTARG(sv);
     register I32 offset;
@@ -208,13 +746,15 @@ do_vecset(SV *sv)
 	    s[offset+3] = lval & 255;
 	}
     }
+    SvSETMAGIC(targ);
 }
 
 void
-do_chop(register SV *astr, register SV *sv)
+Perl_do_chop(pTHX_ register SV *astr, register SV *sv)
 {
     STRLEN len;
     char *s;
+    dTHR;
     
     if (SvTYPE(sv) == SVt_PVAV) {
 	register I32 i;
@@ -228,7 +768,7 @@ do_chop(register SV *astr, register SV *sv)
 	}
         return;
     }
-    if (SvTYPE(sv) == SVt_PVHV) {
+    else if (SvTYPE(sv) == SVt_PVHV) {
         HV* hv = (HV*)sv;
 	HE* entry;
         (void)hv_iterinit(hv);
@@ -237,9 +777,29 @@ do_chop(register SV *astr, register SV *sv)
             do_chop(astr,hv_iterval(hv,entry));
         return;
     }
+    else if (SvREADONLY(sv))
+	Perl_croak(aTHX_ PL_no_modify);
     s = SvPV(sv, len);
     if (len && !SvPOK(sv))
 	s = SvPV_force(sv, len);
+    if (IN_UTF8) {
+	if (s && len) {
+	    char *send = s + len;
+	    char *start = s;
+	    s = send - 1;
+	    while ((*s & 0xc0) == 0x80)
+		--s;
+	    if (UTF8SKIP(s) != send - s && ckWARN_d(WARN_UTF8))
+		Perl_warner(aTHX_ WARN_UTF8, "Malformed UTF-8 character");
+	    sv_setpvn(astr, s, send - s);
+	    *s = '\0';
+	    SvCUR_set(sv, s - start);
+	    SvNIOK_off(sv);
+	}
+	else
+	    sv_setpvn(astr, "", 0);
+    }
+    else
     if (s && len) {
 	s += --len;
 	sv_setpvn(astr, s, 1);
@@ -253,7 +813,7 @@ do_chop(register SV *astr, register SV *sv)
 } 
 
 I32
-do_chomp(register SV *sv)
+Perl_do_chomp(pTHX_ register SV *sv)
 {
     dTHR;
     register I32 count;
@@ -262,6 +822,8 @@ do_chomp(register SV *sv)
 
     if (RsSNARF(PL_rs))
 	return 0;
+    if (RsRECORD(PL_rs))
+      return 0;
     count = 0;
     if (SvTYPE(sv) == SVt_PVAV) {
 	register I32 i;
@@ -275,7 +837,7 @@ do_chomp(register SV *sv)
 	}
         return count;
     }
-    if (SvTYPE(sv) == SVt_PVHV) {
+    else if (SvTYPE(sv) == SVt_PVHV) {
         HV* hv = (HV*)sv;
 	HE* entry;
         (void)hv_iterinit(hv);
@@ -284,6 +846,8 @@ do_chomp(register SV *sv)
             count += do_chomp(hv_iterval(hv,entry));
         return count;
     }
+    else if (SvREADONLY(sv))
+	Perl_croak(aTHX_ PL_no_modify);
     s = SvPV(sv, len);
     if (len && !SvPOKp(sv))
 	s = SvPV_force(sv, len);
@@ -327,7 +891,7 @@ do_chomp(register SV *sv)
 } 
 
 void
-do_vop(I32 optype, SV *sv, SV *left, SV *right)
+Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
 {
     dTHR;	/* just for taint */
 #ifdef LIBERAL
@@ -352,7 +916,8 @@ do_vop(I32 optype, SV *sv, SV *left, SV *right)
     len = leftlen < rightlen ? leftlen : rightlen;
     lensave = len;
     if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
-	dc = SvPV_force(sv, PL_na);
+	STRLEN n_a;
+	dc = SvPV_force(sv, n_a);
 	if (SvCUR(sv) < len) {
 	    dc = SvGROW(sv, len + 1);
 	    (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
@@ -441,7 +1006,7 @@ do_vop(I32 optype, SV *sv, SV *left, SV *right)
 }
 
 OP *
-do_kv(ARGSproto)
+Perl_do_kv(pTHX)
 {
     djSP;
     HV *hv = (HV*)POPs;
@@ -491,7 +1056,7 @@ do_kv(ARGSproto)
 	    RETURN;
 	}
 
-	if (!SvRMAGICAL(keys) || !mg_find((SV*)keys,'P'))
+	if (! SvTIED_mg((SV*)keys, 'P'))
 	    i = HvKEYS(keys);
 	else {
 	    i = 0;
@@ -510,11 +1075,10 @@ do_kv(ARGSproto)
 	if (dokeys)
 	    XPUSHs(hv_iterkeysv(entry));	/* won't clobber stack_sp */
 	if (dovalues) {
-	    tmpstr = sv_newmortal();
 	    PUTBACK;
-	    sv_setsv(tmpstr,realhv ?
-		     hv_iterval(hv,entry) : avhv_iterval((AV*)hv,entry));
-	    DEBUG_H(sv_setpvf(tmpstr, "%lu%%%d=%lu",
+	    tmpstr = realhv ?
+		     hv_iterval(hv,entry) : avhv_iterval((AV*)hv,entry);
+	    DEBUG_H(Perl_sv_setpvf(aTHX_ tmpstr, "%lu%%%d=%lu",
 			    (unsigned long)HeHASH(entry),
 			    HvMAX(keys)+1,
 			    (unsigned long)(HeHASH(entry) & HvMAX(keys))));