Allocate GV bodies from arenas

[p5sagit/p5-mst-13.2.git] / pp_hot.c

diff --git a/pp_hot.c b/pp_hot.c
index 1a23c90..1d1a792 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -145,12 +145,11 @@ PP(pp_concat)
   dSP; dATARGET; tryAMAGICbin(concat,opASSIGN);
   {
     dPOPTOPssrl;
-    STRLEN llen;
-    char* lpv;
     bool lbyte;
     STRLEN rlen;
-    char* rpv = SvPV(right, rlen);     /* mg_get(right) happens here */
-    bool rbyte = !DO_UTF8(right), rcopied = FALSE;
+    const char *rpv = SvPV(right, rlen);       /* mg_get(right) happens here */
+    const bool rbyte = !DO_UTF8(right);
+    bool rcopied = FALSE;
 
     if (TARG == right && right != left) {
        right = sv_2mortal(newSVpvn(rpv, rlen));
@@ -159,7 +158,8 @@ PP(pp_concat)
     }
 
     if (TARG != left) {
-       lpv = SvPV(left, llen);         /* mg_get(left) may happen here */
+        STRLEN llen;
+        const char* const lpv = SvPV(left, llen);      /* mg_get(left) may happen here */
        lbyte = !DO_UTF8(left);
        sv_setpvn(TARG, lpv, llen);
        if (!lbyte)
@@ -168,11 +168,12 @@ PP(pp_concat)
            SvUTF8_off(TARG);
     }
     else { /* TARG == left */
+        STRLEN llen;
        if (SvGMAGICAL(left))
            mg_get(left);               /* or mg_get(left) may happen here */
        if (!SvOK(TARG))
-           sv_setpv(left, "");
-       lpv = SvPV_nomg(left, llen);
+           sv_setpvn(left, "", 0);
+       (void)SvPV_nomg(left, llen);    /* Needed to set UTF8 flag */
        lbyte = !DO_UTF8(left);
        if (IN_BYTES)
            SvUTF8_off(TARG);
@@ -570,7 +571,7 @@ PP(pp_pushre)
 
 PP(pp_print)
 {
-    dSP; dMARK; dORIGMARK;
+    dVAR; dSP; dMARK; dORIGMARK;
     GV *gv;
     IO *io;
     register PerlIO *fp;
@@ -942,7 +943,7 @@ S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem)
 
 PP(pp_aassign)
 {
-    dSP;
+    dVAR; dSP;
     SV **lastlelem = PL_stack_sp;
     SV **lastrelem = PL_stack_base + POPMARK;
     SV **firstrelem = PL_stack_base + POPMARK + 1;
@@ -1443,7 +1444,7 @@ ret_no:
 OP *
 Perl_do_readline(pTHX)
 {
-    dSP; dTARGETSTACKED;
+    dVAR; dSP; dTARGETSTACKED;
     register SV *sv;
     STRLEN tmplen = 0;
     STRLEN offset;
@@ -1599,7 +1600,7 @@ Perl_do_readline(pTHX)
                tmps = SvEND(sv) - 1;
                if (*tmps == *SvPVX(PL_rs)) {
                    *tmps = '\0';
-                   SvCUR(sv)--;
+                   SvCUR_set(sv, SvCUR(sv) - 1);
                }
            }
            for (tmps = SvPVX(sv); *tmps; tmps++)
@@ -1624,8 +1625,7 @@ Perl_do_readline(pTHX)
        }
        if (gimme == G_ARRAY) {
            if (SvLEN(sv) - SvCUR(sv) > 20) {
-               SvLEN_set(sv, SvCUR(sv)+1);
-               Renew(SvPVX(sv), SvLEN(sv), char);
+               SvPV_shrink_to_cur(sv);
            }
            sv = sv_2mortal(NEWSV(58, 80));
            continue;
@@ -1634,8 +1634,7 @@ Perl_do_readline(pTHX)
            /* try to reclaim a bit of scalar space (only on 1st alloc) */
            const STRLEN new_len
                = SvCUR(sv) < 60 ? 80 : SvCUR(sv)+40; /* allow some slop */
-           SvLEN_set(sv, new_len);
-           Renew(SvPVX(sv), SvLEN(sv), char);
+           SvPV_renew(sv, new_len);
        }
        RETURN;
     }
@@ -1643,7 +1642,7 @@ Perl_do_readline(pTHX)
 
 PP(pp_enter)
 {
-    dSP;
+    dVAR; dSP;
     register PERL_CONTEXT *cx;
     I32 gimme = OP_GIMME(PL_op, -1);
 
@@ -1710,8 +1709,7 @@ PP(pp_helem)
            SV* lv;
            SV* key2;
            if (!defer) {
-               STRLEN n_a;
-               DIE(aTHX_ PL_no_helem, SvPV(keysv, n_a));
+               DIE(aTHX_ PL_no_helem_sv, keysv);
            }
            lv = sv_newmortal();
            sv_upgrade(lv, SVt_PVLV);
@@ -1753,7 +1751,7 @@ PP(pp_helem)
 
 PP(pp_leave)
 {
-    dSP;
+    dVAR; dSP;
     register PERL_CONTEXT *cx;
     register SV **mark;
     SV **newsp;
@@ -2252,9 +2250,7 @@ PP(pp_subst)
        } else
 #endif
        {
-           SvOOK_off(TARG);
-           if (SvLEN(TARG))
-               Safefree(SvPVX(TARG));
+           SvPV_free(TARG);
        }
        SvPV_set(TARG, SvPVX(dstr));
        SvCUR_set(TARG, SvCUR(dstr));
@@ -2288,7 +2284,7 @@ ret_no:
 
 PP(pp_grepwhile)
 {
-    dSP;
+    dVAR; dSP;
 
     if (SvTRUEx(POPs))
        PL_stack_base[PL_markstack_ptr[-1]++] = PL_stack_base[*PL_markstack_ptr];
@@ -2339,7 +2335,7 @@ PP(pp_grepwhile)
 
 PP(pp_leavesub)
 {
-    dSP;
+    dVAR; dSP;
     SV **mark;
     SV **newsp;
     PMOP *newpm;
@@ -2399,7 +2395,7 @@ PP(pp_leavesub)
  * get any slower by more conditions */
 PP(pp_leavesublv)
 {
-    dSP;
+    dVAR; dSP;
     SV **mark;
     SV **newsp;
     PMOP *newpm;
@@ -2579,7 +2575,7 @@ S_get_db_sub(pTHX_ SV **svp, CV *cv)
        }
     }
     else {
-       int type = SvTYPE(dbsv);
+       const int type = SvTYPE(dbsv);
        if (type < SVt_PVIV && type != SVt_IV)
            sv_upgrade(dbsv, SVt_PVIV);
        (void)SvIOK_on(dbsv);
@@ -2594,13 +2590,13 @@ S_get_db_sub(pTHX_ SV **svp, CV *cv)
 
 PP(pp_entersub)
 {
-    dSP; dPOPss;
+    dVAR; dSP; dPOPss;
     GV *gv;
     HV *stash;
     register CV *cv;
     register PERL_CONTEXT *cx;
     I32 gimme;
-    bool hasargs = (PL_op->op_flags & OPf_STACKED) != 0;
+    const bool hasargs = (PL_op->op_flags & OPf_STACKED) != 0;
 
     if (!sv)
        DIE(aTHX_ "Not a CODE reference");
@@ -2617,9 +2613,7 @@ PP(pp_entersub)
        break;
     default:
        if (!SvROK(sv)) {
-           char *sym;
-           STRLEN n_a;
-
+           const char *sym;
            if (sv == &PL_sv_yes) {             /* unfound import, ignore */
                if (hasargs)
                    SP = PL_stack_base + POPMARK;
@@ -2631,8 +2625,10 @@ PP(pp_entersub)
                    goto got_rv;
                sym = SvPOKp(sv) ? SvPVX(sv) : Nullch;
            }
-           else
+           else {
+                STRLEN n_a;
                sym = SvPV(sv, n_a);
+            }
            if (!sym)
                DIE(aTHX_ PL_no_usym, "a subroutine");
            if (PL_op->op_private & HINT_STRICT_REFS)
@@ -2890,7 +2886,7 @@ PP(pp_aelem)
         static const char oom_array_extend[] =
              "Out of memory during array extend"; /* Duplicated in av.c */
         if (SvUOK(elemsv)) {
-             UV uv = SvUV(elemsv);
+             const UV uv = SvUV(elemsv);
              elem = uv > IV_MAX ? IV_MAX : uv;
         }
         else if (SvNOK(elemsv))
@@ -2935,19 +2931,19 @@ Perl_vivify_ref(pTHX_ SV *sv, U32 to_what)
        if (SvTYPE(sv) < SVt_RV)
            sv_upgrade(sv, SVt_RV);
        else if (SvTYPE(sv) >= SVt_PV) {
-           SvOOK_off(sv);
-           Safefree(SvPVX(sv));
-           SvLEN(sv) = SvCUR(sv) = 0;
+           SvPV_free(sv);
+            SvLEN_set(sv, 0);
+           SvCUR_set(sv, 0);
        }
        switch (to_what) {
        case OPpDEREF_SV:
-           SvRV(sv) = NEWSV(355,0);
+           SvRV_set(sv, NEWSV(355,0));
            break;
        case OPpDEREF_AV:
-           SvRV(sv) = (SV*)newAV();
+           SvRV_set(sv, (SV*)newAV());
            break;
        case OPpDEREF_HV:
-           SvRV(sv) = (SV*)newHV();
+           SvRV_set(sv, (SV*)newHV());
            break;
        }
        SvROK_on(sv);
@@ -2989,13 +2985,12 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
     SV* ob;
     GV* gv;
     HV* stash;
-    char* name;
     STRLEN namelen;
-    char* packname = 0;
+    const char* packname = 0;
     SV *packsv = Nullsv;
     STRLEN packlen;
+    const char *name = SvPV(meth, namelen);
 
-    name = SvPV(meth, namelen);
     sv = *(PL_stack_base + TOPMARK + 1);
 
     if (!sv)
@@ -3086,9 +3081,9 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
           cause UNIVERSAL->can("NoSuchPackage::foo") to croak, and we
           don't want that.
        */
-       char* leaf = name;
-       char* sep = Nullch;
-       char* p;
+       const char* leaf = name;
+       const char* sep = Nullch;
+       const char* p;
 
        for (p = name; *p; p++) {
            if (*p == '\'')
@@ -3135,5 +3130,5 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
  * indent-tabs-mode: t
  * End:
  *
- * vim: shiftwidth=4:
-*/
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */