FPTR2DPTR/DPTR2FPTR
[p5sagit/p5-mst-13.2.git] / op.c
diff --git a/op.c b/op.c
index c8eff92..b062678 100644 (file)
--- a/op.c
+++ b/op.c
@@ -158,13 +158,12 @@ Perl_Slab_Free(pTHX_ void *op)
 
 #define RETURN_UNLIMITED_NUMBER (PERL_INT_MAX / 2)
 
-STATIC char*
+STATIC const char*
 S_gv_ename(pTHX_ GV *gv)
 {
-    STRLEN n_a;
     SV* tmpsv = sv_newmortal();
     gv_efullname3(tmpsv, gv, Nullch);
-    return SvPV(tmpsv,n_a);
+    return SvPV_nolen_const(tmpsv);
 }
 
 STATIC OP *
@@ -785,9 +784,9 @@ Perl_scalarvoid(pTHX_ OP *o)
                      built upon these three nroff macros being used in
                      void context. The pink camel has the details in
                      the script wrapman near page 319. */
-                   if (strnEQ(SvPVX(sv), "di", 2) ||
-                       strnEQ(SvPVX(sv), "ds", 2) ||
-                       strnEQ(SvPVX(sv), "ig", 2))
+                   if (strnEQ(SvPVX_const(sv), "di", 2) ||
+                       strnEQ(SvPVX_const(sv), "ds", 2) ||
+                       strnEQ(SvPVX_const(sv), "ig", 2))
                            useless = 0;
                }
            }
@@ -1379,12 +1378,12 @@ S_scalar_mod_type(pTHX_ const OP *o, I32 type)
 }
 
 STATIC bool
-S_is_handle_constructor(pTHX_ const OP *o, I32 argnum)
+S_is_handle_constructor(pTHX_ const OP *o, I32 numargs)
 {
     switch (o->op_type) {
     case OP_PIPE_OP:
     case OP_SOCKPAIR:
-       if (argnum == 2)
+       if (numargs == 2)
            return TRUE;
        /* FALL THROUGH */
     case OP_SYSOPEN:
@@ -1393,7 +1392,7 @@ S_is_handle_constructor(pTHX_ const OP *o, I32 argnum)
     case OP_SOCKET:
     case OP_OPEN_DIR:
     case OP_ACCEPT:
-       if (argnum == 1)
+       if (numargs == 1)
            return TRUE;
        /* FALL THROUGH */
     default:
@@ -1534,18 +1533,14 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my)
     /* fake up C<use attributes $pkg,$rv,@attrs> */
     ENTER;             /* need to protect against side-effects of 'use' */
     SAVEINT(PL_expect);
-    if (stash)
-       stashsv = newSVpv(HvNAME(stash), 0);
-    else
-       stashsv = &PL_sv_no;
+    stashsv = stash ? newSVhek(HvNAME_HEK(stash)) : &PL_sv_no;
 
 #define ATTRSMODULE "attributes"
 #define ATTRSMODULE_PM "attributes.pm"
 
     if (for_my) {
-       SV **svp;
        /* Don't force the C<use> if we don't need it. */
-       svp = hv_fetch(GvHVn(PL_incgv), ATTRSMODULE_PM,
+       SV **svp = hv_fetch(GvHVn(PL_incgv), ATTRSMODULE_PM,
                       sizeof(ATTRSMODULE_PM)-1, 0);
        if (svp && *svp != &PL_sv_undef)
            ;           /* already in %INC */
@@ -1588,10 +1583,8 @@ S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp)
     pack = newSVOP(OP_CONST, 0, newSVpvn(ATTRSMODULE, sizeof(ATTRSMODULE)-1));
 
     /* Build up the real arg-list. */
-    if (stash)
-       stashsv = newSVpv(HvNAME(stash), 0);
-    else
-       stashsv = &PL_sv_no;
+    stashsv = stash ? newSVhek(HvNAME_HEK(stash)) : &PL_sv_no;
+
     arg = newOP(OP_PADSV, 0);
     arg->op_targ = target->op_targ;
     arg = prepend_elem(OP_LIST,
@@ -1602,14 +1595,7 @@ S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp)
                                    dup_attrlist(attrs)));
 
     /* Fake up a method call to import */
-    meth = newSVpvn("import", 6);
-    (void)SvUPGRADE(meth, SVt_PVIV);
-    (void)SvIOK_on(meth);
-    {
-       U32 hash;
-       PERL_HASH(hash, SvPVX(meth), SvCUR(meth));
-       SvUV_set(meth, hash);
-    }
+    meth = newSVpvn_share("import", 6, 0);
     imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL|OPf_WANT_VOID,
                   append_elem(OP_LIST,
                               prepend_elem(OP_LIST, pack, list(arg)),
@@ -2390,8 +2376,8 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
     SV *rstr = ((SVOP*)repl)->op_sv;
     STRLEN tlen;
     STRLEN rlen;
-    U8 *t = (U8*)SvPV(tstr, tlen);
-    U8 *r = (U8*)SvPV(rstr, rlen);
+    const U8 *t = (U8*)SvPV_const(tstr, tlen);
+    const U8 *r = (U8*)SvPV_const(rstr, rlen);
     register I32 i;
     register I32 j;
     I32 del;
@@ -2414,8 +2400,8 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
     if (o->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)) {
        SV* listsv = newSVpvn("# comment\n",10);
        SV* transv = 0;
-       U8* tend = t + tlen;
-       U8* rend = r + rlen;
+       const U8* tend = t + tlen;
+       const U8* rend = r + rlen;
        STRLEN ulen;
        UV tfirst = 1;
        UV tlast = 0;
@@ -2436,12 +2422,12 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 
        if (!from_utf) {
            STRLEN len = tlen;
-           tsave = t = bytes_to_utf8(t, &len);
+           t = tsave = bytes_to_utf8(t, &len);
            tend = t + len;
        }
        if (!to_utf && rlen) {
            STRLEN len = rlen;
-           rsave = r = bytes_to_utf8(r, &len);
+           r = rsave = bytes_to_utf8(r, &len);
            rend = r + len;
        }
 
@@ -2498,7 +2484,7 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
            t = uvuni_to_utf8_flags(tmpbuf, 0x7fffffff,
                                    UNICODE_ALLOW_SUPER);
            sv_catpvn(transv, (char*)tmpbuf, t - tmpbuf);
-           t = (U8*)SvPVX(transv);
+           t = (const U8*)SvPVX_const(transv);
            tlen = SvCUR(transv);
            tend = t + tlen;
            Safefree(cp);
@@ -2798,15 +2784,31 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
     if (expr->op_type == OP_CONST) {
        STRLEN plen;
        SV *pat = ((SVOP*)expr)->op_sv;
-       char *p = SvPV(pat, plen);
+       const char *p = SvPV_const(pat, plen);
        if ((o->op_flags & OPf_SPECIAL) && (*p == ' ' && p[1] == '\0')) {
+           U32 was_readonly = SvREADONLY(pat);
+
+           if (was_readonly) {
+               if (SvFAKE(pat)) {
+                   sv_force_normal_flags(pat, 0);
+                   assert(!SvREADONLY(pat));
+                   was_readonly = 0;
+               } else {
+                   SvREADONLY_off(pat);
+               }
+           }   
+
            sv_setpvn(pat, "\\s+", 3);
-           p = SvPV(pat, plen);
+
+           SvFLAGS(pat) |= was_readonly;
+
+           p = SvPV_const(pat, plen);
            pm->op_pmflags |= PMf_SKIPWHITE;
        }
         if (DO_UTF8(pat))
            pm->op_pmdynflags |= PMdf_UTF8;
-       PM_SETRE(pm, CALLREGCOMP(aTHX_ p, p + plen, pm));
+       /* FIXME - can we make this function take const char * args?  */
+       PM_SETRE(pm, CALLREGCOMP(aTHX_ (char*)p, (char*)p + plen, pm));
        if (strEQ("\\s+", PM_GETRE(pm)->precomp))
            pm->op_pmflags |= PMf_WHITE;
        op_free(expr);
@@ -3002,7 +3004,7 @@ Perl_package(pTHX_ OP *o)
     save_hptr(&PL_curstash);
     save_item(PL_curstname);
 
-    name = SvPV(cSVOPo->op_sv, len);
+    name = SvPV_const(cSVOPo->op_sv, len);
     PL_curstash = gv_stashpvn(name, len, TRUE);
     sv_setpvn(PL_curstname, name, len);
     op_free(o);
@@ -3041,14 +3043,7 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg)
            pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)idop)->op_sv));
 
            /* Fake up a method call to VERSION */
-           meth = newSVpvn("VERSION",7);
-           sv_upgrade(meth, SVt_PVIV);
-           (void)SvIOK_on(meth);
-           {
-               U32 hash;
-               PERL_HASH(hash, SvPVX(meth), SvCUR(meth));
-               SvUV_set(meth, hash);
-           }
+           meth = newSVpvn_share("VERSION", 7, 0);
            veop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
                            append_elem(OP_LIST,
                                        prepend_elem(OP_LIST, pack, list(version)),
@@ -3069,14 +3064,8 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg)
        pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)idop)->op_sv));
 
        /* Fake up a method call to import/unimport */
-       meth = aver ? newSVpvn("import",6) : newSVpvn("unimport", 8);
-       (void)SvUPGRADE(meth, SVt_PVIV);
-       (void)SvIOK_on(meth);
-       {
-           U32 hash;
-           PERL_HASH(hash, SvPVX(meth), SvCUR(meth));
-           SvUV_set(meth, hash);
-       }
+       meth = aver
+           ? newSVpvn_share("import",6, 0) : newSVpvn_share("unimport", 8, 0);
        imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
                       append_elem(OP_LIST,
                                   prepend_elem(OP_LIST, pack, list(arg)),
@@ -3085,7 +3074,7 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg)
 
     /* Fake up the BEGIN {}, which does its thing immediately. */
     newATTRSUB(floor,
-       newSVOP(OP_CONST, 0, newSVpvn("BEGIN", 5)),
+       newSVOP(OP_CONST, 0, newSVpvn_share("BEGIN", 5, 0)),
        Nullop,
        Nullop,
        append_elem(OP_LINESEQ,
@@ -3226,7 +3215,7 @@ Perl_newSLICEOP(pTHX_ I32 flags, OP *subscript, OP *listval)
 }
 
 STATIC I32
-S_list_assignment(pTHX_ register const OP *o)
+S_is_list_assignment(pTHX_ register const OP *o)
 {
     if (!o)
        return TRUE;
@@ -3235,8 +3224,8 @@ S_list_assignment(pTHX_ register const OP *o)
        o = cUNOPo->op_first;
 
     if (o->op_type == OP_COND_EXPR) {
-        const I32 t = list_assignment(cLOGOPo->op_first->op_sibling);
-        const I32 f = list_assignment(cLOGOPo->op_first->op_sibling->op_sibling);
+        const I32 t = is_list_assignment(cLOGOPo->op_first->op_sibling);
+        const I32 f = is_list_assignment(cLOGOPo->op_first->op_sibling->op_sibling);
 
        if (t && f)
            return TRUE;
@@ -3281,18 +3270,19 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
        }
     }
 
-    if (list_assignment(left)) {
+    if (is_list_assignment(left)) {
        OP *curop;
 
        PL_modcount = 0;
-       PL_eval_start = right;  /* Grandfathering $[ assignment here.  Bletch.*/
+       /* Grandfathering $[ assignment here.  Bletch.*/
+       /* Only simple assignments like C<< ($[) = 1 >> are allowed */
+       PL_eval_start = (left->op_type == OP_CONST) ? right : 0;
        left = mod(left, OP_AASSIGN);
        if (PL_eval_start)
            PL_eval_start = 0;
-       else {
-           op_free(left);
-           op_free(right);
-           return Nullop;
+       else if (left->op_type == OP_CONST) {
+           /* Result of assignment is always 1 (or we'd be dead already) */
+           return newSVOP(OP_CONST, 0, newSViv(1));
        }
        /* optimise C<my @x = ()> to C<my @x>, and likewise for hashes */
        if ((left->op_type == OP_PADAV || left->op_type == OP_PADHV)
@@ -3429,8 +3419,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
        if (PL_eval_start)
            PL_eval_start = 0;
        else {
-           op_free(o);
-           return Nullop;
+           o = newSVOP(OP_CONST, 0, newSViv(PL_compiling.cop_arybase));
        }
     }
     return o;
@@ -3903,7 +3892,7 @@ whileline, OP *expr, OP *block, OP *cont, I32 has_my)
 }
 
 OP *
-Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont)
+Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP *block, OP *cont)
 {
     dVAR;
     LOOP *loop;
@@ -3958,8 +3947,8 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo
         */
        UNOP* flip = (UNOP*)((UNOP*)((BINOP*)expr)->op_first)->op_first;
        LOGOP* range = (LOGOP*) flip->op_first;
-       OP* left  = range->op_first;
-       OP* right = left->op_sibling;
+       OP* const left  = range->op_first;
+       OP* const right = left->op_sibling;
        LISTOP* listop;
 
        range->op_flags &= ~OPf_KIDS;
@@ -4007,7 +3996,6 @@ OP*
 Perl_newLOOPEX(pTHX_ I32 type, OP *label)
 {
     OP *o;
-    STRLEN n_a;
 
     if (type != OP_GOTO || label->op_type == OP_CONST) {
        /* "last()" means "last" */
@@ -4015,7 +4003,7 @@ Perl_newLOOPEX(pTHX_ I32 type, OP *label)
            o = newOP(type, OPf_SPECIAL);
        else {
            o = newPVOP(type, 0, savepv(label->op_type == OP_CONST
-                                       ? SvPVx(((SVOP*)label)->op_sv, n_a)
+                                       ? SvPVx_nolen_const(((SVOP*)label)->op_sv)
                                        : ""));
        }
        op_free(label);
@@ -4063,6 +4051,7 @@ Perl_cv_undef(pTHX_ CV *cv)
 
        op_free(CvROOT(cv));
        CvROOT(cv) = Nullop;
+       CvSTART(cv) = Nullop;
        LEAVE;
     }
     SvPOK_off((SV*)cv);                /* forget prototype */
@@ -4090,7 +4079,7 @@ Perl_cv_undef(pTHX_ CV *cv)
 void
 Perl_cv_ckproto(pTHX_ const CV *cv, const GV *gv, const char *p)
 {
-    if (((!p != !SvPOK(cv)) || (p && strNE(p, SvPVX(cv)))) && ckWARN_d(WARN_PROTOTYPE)) {
+    if (((!p != !SvPOK(cv)) || (p && strNE(p, SvPVX_const(cv)))) && ckWARN_d(WARN_PROTOTYPE)) {
        SV* msg = sv_newmortal();
        SV* name = Nullsv;
 
@@ -4237,19 +4226,19 @@ CV *
 Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 {
     dVAR;
-    STRLEN n_a;
     const char *aname;
     GV *gv;
-    char *ps;
+    const char *ps;
     STRLEN ps_len;
     register CV *cv=0;
     SV *const_sv;
+    I32 gv_fetch_flags;
 
-    const char * const name = o ? SvPVx(cSVOPo->op_sv, n_a) : Nullch;
+    const char * const name = o ? SvPVx_nolen_const(cSVOPo->op_sv) : Nullch;
 
     if (proto) {
        assert(proto->op_type == OP_CONST);
-       ps = SvPVx(((SVOP*)proto)->op_sv, ps_len);
+       ps = SvPVx_const(((SVOP*)proto)->op_sv, ps_len);
     }
     else
        ps = Nullch;
@@ -4259,17 +4248,17 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        Perl_sv_setpvf(aTHX_ sv, "%s[%s:%"IVdf"]",
                       PL_curstash ? "__ANON__" : "__ANON__::__ANON__",
                       CopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
-       aname = SvPVX(sv);
+       aname = SvPVX_const(sv);
     }
     else
        aname = Nullch;
-    gv = name ? gv_fetchsv(cSVOPo->op_sv,
-                          GV_ADDMULTI | ((block || attrs) ? 0 : GV_NOINIT),
-                          SVt_PVCV)
+
+    gv_fetch_flags = (block || attrs || (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS))
+       ? GV_ADDMULTI : GV_ADDMULTI | GV_NOINIT;
+    gv = name ? gv_fetchsv(cSVOPo->op_sv, gv_fetch_flags, SVt_PVCV)
        : gv_fetchpv(aname ? aname
                     : (PL_curstash ? "__ANON__" : "__ANON__::__ANON__"),
-                    GV_ADDMULTI | ((block || attrs) ? 0 : GV_NOINIT),
-                    SVt_PVCV);
+                    gv_fetch_flags, SVt_PVCV);
 
     if (o)
        SAVEFREEOP(o);
@@ -4306,7 +4295,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     }
 #endif
 
-    if (!block || !ps || *ps || attrs)
+    if (!block || !ps || *ps || attrs || (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS))
        const_sv = Nullsv;
     else
        const_sv = op_const_sv(block, Nullcv);
@@ -4509,9 +4498,9 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
                           CopFILE(PL_curcop),
                           (long)PL_subline, (long)CopLINE(PL_curcop));
            gv_efullname3(tmpstr, gv, Nullch);
-           hv_store(GvHV(PL_DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
+           hv_store(GvHV(PL_DBsub), SvPVX_const(tmpstr), SvCUR(tmpstr), sv, 0);
            hv = GvHVn(db_postponed);
-           if (HvFILL(hv) > 0 && hv_exists(hv, SvPVX(tmpstr), SvCUR(tmpstr))
+           if (HvFILL(hv) > 0 && hv_exists(hv, SvPVX_const(tmpstr), SvCUR(tmpstr))
                && (pcv = GvCV(db_postponed)))
            {
                dSP;
@@ -4649,23 +4638,32 @@ Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename)
        if (GvCVGEN(gv)) {
            /* just a cached method */
            SvREFCNT_dec(cv);
-           cv = 0;
+           cv = Nullcv;
        }
        else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
            /* already defined (or promised) */
-           if (ckWARN(WARN_REDEFINE) && !(CvGV(cv) && GvSTASH(CvGV(cv))
-                           && strEQ(HvNAME(GvSTASH(CvGV(cv))), "autouse"))) {
-               const line_t oldline = CopLINE(PL_curcop);
-               if (PL_copline != NOLINE)
-                   CopLINE_set(PL_curcop, PL_copline);
-               Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
-                           CvCONST(cv) ? "Constant subroutine %s redefined"
-                                       : "Subroutine %s redefined"
-                           ,name);
-               CopLINE_set(PL_curcop, oldline);
+           /* XXX It's possible for this HvNAME_get to return null, and get passed into strEQ */
+           if (ckWARN(WARN_REDEFINE)) {
+               GV * const gvcv = CvGV(cv);
+               if (gvcv) {
+                   HV * const stash = GvSTASH(gvcv);
+                   if (stash) {
+                       const char *name = HvNAME_get(stash);
+                       if ( strEQ(name,"autouse") ) {
+                           const line_t oldline = CopLINE(PL_curcop);
+                           if (PL_copline != NOLINE)
+                               CopLINE_set(PL_curcop, PL_copline);
+                           Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
+                                       CvCONST(cv) ? "Constant subroutine %s redefined"
+                                                   : "Subroutine %s redefined"
+                                       ,name);
+                           CopLINE_set(PL_curcop, oldline);
+                       }
+                   }
+               }
            }
            SvREFCNT_dec(cv);
-           cv = 0;
+           cv = Nullcv;
        }
     }
 
@@ -4960,8 +4958,8 @@ Perl_ck_bitop(pTHX_ OP *o)
             || o->op_type == OP_BIT_AND
             || o->op_type == OP_BIT_XOR))
     {
-       const OP * left = cBINOPo->op_first;
-       const OP * right = left->op_sibling;
+       const OP * const left = cBINOPo->op_first;
+       const OP * const right = left->op_sibling;
        if ((OP_IS_NUMCOMPARE(left->op_type) &&
                (left->op_flags & OPf_PARENS) == 0) ||
            (OP_IS_NUMCOMPARE(right->op_type) &&
@@ -5162,17 +5160,6 @@ Perl_ck_exists(pTHX_ OP *o)
     return o;
 }
 
-#if 0
-OP *
-Perl_ck_gvconst(pTHX_ register OP *o)
-{
-    o = fold_constants(o);
-    if (o->op_type == OP_CONST)
-       o->op_type = OP_GV;
-    return o;
-}
-#endif
-
 OP *
 Perl_ck_rvconst(pTHX_ register OP *o)
 {
@@ -5183,12 +5170,12 @@ Perl_ck_rvconst(pTHX_ register OP *o)
     if (kid->op_type == OP_CONST) {
        int iscv;
        GV *gv;
-       SV *kidsv = kid->op_sv;
+       SV * const kidsv = kid->op_sv;
 
        /* Is it a constant from cv_const_sv()? */
        if (SvROK(kidsv) && SvREADONLY(kidsv)) {
            SV *rsv = SvRV(kidsv);
-           int svtype = SvTYPE(rsv);
+           const int svtype = SvTYPE(rsv);
             const char *badtype = Nullch;
 
            switch (o->op_type) {
@@ -5501,7 +5488,7 @@ Perl_ck_fun(pTHX_ OP *o)
                                           
                                      }
                                      if (tmpstr) {
-                                          name = SvPV(tmpstr, len);
+                                          name = SvPV_const(tmpstr, len);
                                           sv_2mortal(tmpstr);
                                      }
                                 }
@@ -5515,7 +5502,7 @@ Perl_ck_fun(pTHX_ OP *o)
                                SV *namesv;
                                targ = pad_alloc(OP_RV2GV, SVs_PADTMP);
                                namesv = PAD_SVl(targ);
-                               (void)SvUPGRADE(namesv, SVt_PV);
+                               SvUPGRADE(namesv, SVt_PV);
                                if (*name != '$')
                                    sv_setpvn(namesv, "$", 1);
                                sv_catpvn(namesv, name, len);
@@ -5841,10 +5828,10 @@ Perl_ck_method(pTHX_ OP *o)
     OP *kid = cUNOPo->op_first;
     if (kid->op_type == OP_CONST) {
        SV* sv = kSVOP->op_sv;
-       if (!(strchr(SvPVX(sv), ':') || strchr(SvPVX(sv), '\''))) {
+       if (!(strchr(SvPVX_const(sv), ':') || strchr(SvPVX_const(sv), '\''))) {
            OP *cmop;
            if (!SvREADONLY(sv) || !SvFAKE(sv)) {
-               sv = newSVpvn_share(SvPVX(sv), SvCUR(sv), 0);
+               sv = newSVpvn_share(SvPVX_const(sv), SvCUR(sv), 0);
            }
            else {
                kSVOP->op_sv = Nullsv;
@@ -5896,7 +5883,7 @@ Perl_ck_open(pTHX_ OP *o)
         OP *first = cLISTOPx(o)->op_first; /* The pushmark. */
         OP *last  = cLISTOPx(o)->op_last;  /* The bareword. */
         OP *oa;
-        char *mode;
+        const char *mode;
 
         if ((last->op_type == OP_CONST) &&             /* The bareword. */
             (last->op_private & OPpCONST_BARE) &&
@@ -5904,7 +5891,7 @@ Perl_ck_open(pTHX_ OP *o)
             (oa = first->op_sibling) &&                /* The fh. */
             (oa = oa->op_sibling) &&                   /* The mode. */
             SvPOK(((SVOP*)oa)->op_sv) &&
-            (mode = SvPVX(((SVOP*)oa)->op_sv)) &&
+            (mode = SvPVX_const(((SVOP*)oa)->op_sv)) &&
             mode[0] == '>' && mode[1] == '&' &&        /* A dup open. */
             (last == oa->op_sibling))                  /* The bareword. */
              last->op_private &= ~OPpCONST_STRICT;
@@ -5933,21 +5920,29 @@ Perl_ck_require(pTHX_ OP *o)
        SVOP *kid = (SVOP*)cUNOPo->op_first;
 
        if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
+           SV *sv = kid->op_sv;
+           U32 was_readonly = SvREADONLY(sv);
            char *s;
-           for (s = SvPVX(kid->op_sv); *s; s++) {
+
+           if (was_readonly) {
+               if (SvFAKE(sv)) {
+                   sv_force_normal_flags(sv, 0);
+                   assert(!SvREADONLY(sv));
+                   was_readonly = 0;
+               } else {
+                   SvREADONLY_off(sv);
+               }
+           }   
+
+           for (s = SvPVX(sv); *s; s++) {
                if (*s == ':' && s[1] == ':') {
                    *s = '/';
                    Move(s+2, s+1, strlen(s+2)+1, char);
-                   SvCUR_set(kid->op_sv, SvCUR(kid->op_sv) - 1);
+                   SvCUR_set(sv, SvCUR(sv) - 1);
                }
            }
-           if (SvREADONLY(kid->op_sv)) {
-               SvREADONLY_off(kid->op_sv);
-               sv_catpvn(kid->op_sv, ".pm", 3);
-               SvREADONLY_on(kid->op_sv);
-           }
-           else
-               sv_catpvn(kid->op_sv, ".pm", 3);
+           sv_catpvn(sv, ".pm", 3);
+           SvFLAGS(sv) |= was_readonly;
        }
     }
 
@@ -6246,7 +6241,6 @@ Perl_ck_subr(pTHX_ OP *o)
     I32 arg = 0;
     I32 contextclass = 0;
     char *e = 0;
-    STRLEN n_a;
     bool delete_op = 0;
 
     o->op_private |= OPpENTERSUB_HASTARG;
@@ -6264,7 +6258,7 @@ Perl_ck_subr(pTHX_ OP *o)
            else {
                if (SvPOK(cv)) {
                    namegv = CvANON(cv) ? gv : CvGV(cv);
-                   proto = SvPV((SV*)cv, n_a);
+                   proto = SvPV_nolen((SV*)cv);
                }
                if (CvASSERTION(cv)) {
                    if (PL_hints & HINT_ASSERTING) {
@@ -6679,7 +6673,7 @@ Perl_peep(pTHX_ register OP *o)
            }
            else if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_PROTOTYPE)) {
                GV *gv = cGVOPo_gv;
-               if (SvTYPE(gv) == SVt_PVGV && GvCV(gv) && SvPVX(GvCV(gv))) {
+               if (SvTYPE(gv) == SVt_PVGV && GvCV(gv) && SvPVX_const(GvCV(gv))) {
                    /* XXX could check prototype here instead of just carping */
                    SV *sv = sv_newmortal();
                    gv_efullname3(sv, gv, Nullch);
@@ -6768,7 +6762,7 @@ Perl_peep(pTHX_ register OP *o)
             SV *lexname;
            GV **fields;
            SV **svp, *sv;
-           char *key = NULL;
+           const char *key = NULL;
            STRLEN keylen;
 
            o->op_opt = 1;
@@ -6779,7 +6773,7 @@ Perl_peep(pTHX_ register OP *o)
            /* Make the CONST have a shared SV */
            svp = cSVOPx_svp(((BINOP*)o)->op_last);
            if ((!SvFAKE(sv = *svp) || !SvREADONLY(sv)) && !IS_PADCONST(sv)) {
-               key = SvPV(sv, keylen);
+               key = SvPV_const(sv, keylen);
                lexname = newSVpvn_share(key,
                                         SvUTF8(sv) ? -(I32)keylen : keylen,
                                         0);
@@ -6799,13 +6793,13 @@ Perl_peep(pTHX_ register OP *o)
            fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE);
            if (!fields || !GvHV(*fields))
                break;
-           key = SvPV(*svp, keylen);
+           key = SvPV_const(*svp, keylen);
            if (!hv_fetch(GvHV(*fields), key,
                        SvUTF8(*svp) ? -(I32)keylen : keylen, FALSE))
            {
                Perl_croak(aTHX_ "No such class field \"%s\" " 
                           "in variable %s of type %s", 
-                     key, SvPV_nolen(lexname), HvNAME(SvSTASH(lexname)));
+                     key, SvPV_nolen_const(lexname), HvNAME_get(SvSTASH(lexname)));
            }
 
             break;
@@ -6816,7 +6810,7 @@ Perl_peep(pTHX_ register OP *o)
            SV *lexname;
            GV **fields;
            SV **svp;
-           char *key;
+           const char *key;
            STRLEN keylen;
            SVOP *first_key_op, *key_op;
 
@@ -6856,13 +6850,13 @@ Perl_peep(pTHX_ register OP *o)
                if (key_op->op_type != OP_CONST)
                    continue;
                svp = cSVOPx_svp(key_op);
-               key = SvPV(*svp, keylen);
+               key = SvPV_const(*svp, keylen);
                if (!hv_fetch(GvHV(*fields), key, 
                            SvUTF8(*svp) ? -(I32)keylen : keylen, FALSE))
                {
                    Perl_croak(aTHX_ "No such class field \"%s\" "
                               "in variable %s of type %s",
-                         key, SvPV_nolen(lexname), HvNAME(SvSTASH(lexname)));
+                         key, SvPV_nolen(lexname), HvNAME_get(SvSTASH(lexname)));
                }
            }
            break;
@@ -7134,7 +7128,7 @@ const_sv_xsub(pTHX_ CV* cv)
     if (items != 0) {
 #if 0
         Perl_croak(aTHX_ "usage: %s::%s()",
-                   HvNAME(GvSTASH(CvGV(cv))), GvNAME(CvGV(cv)));
+                   HvNAME_get(GvSTASH(CvGV(cv))), GvNAME(CvGV(cv)));
 #endif
     }
     EXTEND(sp, 1);