refactor Perl_cv_undef_flags
authorDaniel Dragan <bulk88@hotmail.com>
Wed, 29 Oct 2014 06:56:16 +0000 (02:56 -0400)
committerFather Chrysostomos <sprout@cpan.org>
Wed, 29 Oct 2014 21:04:00 +0000 (14:04 -0700)
On VC 2003 32bits size of this function decreased from 0x321 bytes of
machine code to 0x2d8.

cv.h:
- partially reorder Cv* macros to match XPVCV member order
- create CvDEPTHunsafe which never uses SV head except for SvANY ptr since
  Perl_cv_undef_flags uses a fake SV head

pad.c
- remove var slabbed, frees a C auto/non-vol register, there are only 2
  uses, on CvSTART branch, CvFLAGS is reused frm CvISXSUB test by optimizer
- use a CV struct to fake a CV, to avoid rereading SvANY ptr after each
  func call, CVs can't be upgraded or have their bodies realloced
- dont write NULL to CvFILE if CvFILE is NULL, also move NULL assignment
  so CPU address generation can be reused by compiler
- refactor CvROOT/CvSTART/CvXSUB freeing conditionals to simplify code and
  dont check CvISXSUB twice
- CvDEPTH requires a real CV*/CV*, since it checks the SV head with an
  assert, use CvDEPTHunsafe instead, and inline the assert using the real
  CV*. Also move runtime, non-debug "SvTYPE(cv) == SVt_PVCV" check to
  debug  builds per ML post
  "about FC commit "CV-based slab allocation for ops""
- Perl_croak->Perl_croak_nocontext, remove push arg my_perl instruction
- refactor CvPADLIST freeing for provision for future XSUB sub usage of
  CvPADLIST in a union
- in CvOUTSIDE freeing, move NULL assignment so CPU address generation can
  be reused by compiler

cv.h
pad.c

diff --git a/cv.h b/cv.h
index 7f6dea2..2068ca0 100644 (file)
--- a/cv.h
+++ b/cv.h
@@ -62,10 +62,13 @@ See L<perlguts/Autoloading with XSUBs>.
 #endif
 #define CvFILEGV(sv)   (gv_fetchfile(CvFILE(sv)))
 #define CvDEPTH(sv)    (*S_CvDEPTHp((const CV *)sv))
-#define CvPADLIST(sv)  ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_padlist
-#define CvOUTSIDE(sv)  ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_outside
-#define CvFLAGS(sv)    ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_flags
+/* For use when you only have a XPVCV*, not a real CV*.
+   Must be assert protected as in S_CvDEPTHp before use. */
+#define CvDEPTHunsafe(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_depth
+#define CvPADLIST(sv)    ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_padlist
+#define CvOUTSIDE(sv)    ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_outside
 #define CvOUTSIDE_SEQ(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_outside_seq
+#define CvFLAGS(sv)      ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_flags
 
 /* These two are sometimes called on non-CVs */
 #define CvPROTO(sv)                               \
diff --git a/pad.c b/pad.c
index 3981ac1..309418c 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -326,8 +326,10 @@ Perl_cv_undef(pTHX_ CV *cv)
 void
 Perl_cv_undef_flags(pTHX_ CV *cv, U32 flags)
 {
-    const PADLIST *padlist = CvPADLIST(cv);
-    bool const slabbed = !!CvSLABBED(cv);
+    CV cvbody;/*CV body will never be realloced inside this func,
+               so dont read it more than once, use fake CV so existing macros
+               will work, the indirection and CV head struct optimized away*/
+    SvANY(&cvbody) = SvANY(cv);
 
     PERL_ARGS_ASSERT_CV_UNDEF_FLAGS;
 
@@ -336,46 +338,59 @@ Perl_cv_undef_flags(pTHX_ CV *cv, U32 flags)
            PTR2UV(cv), PTR2UV(PL_comppad))
     );
 
-    if (CvFILE(cv) && CvDYNFILE(cv)) {
-       Safefree(CvFILE(cv));
+    if (CvFILE(&cvbody)) {
+       char * file = CvFILE(&cvbody);
+       CvFILE(&cvbody) = NULL;
+       if(CvDYNFILE(&cvbody))
+           Safefree(file);
     }
-    CvFILE(cv) = NULL;
 
-    CvSLABBED_off(cv);
-    if (!CvISXSUB(cv) && CvROOT(cv)) {
-       if (SvTYPE(cv) == SVt_PVCV && CvDEPTH(cv))
-           Perl_croak(aTHX_ "Can't undef active subroutine");
-       ENTER;
-
-       PAD_SAVE_SETNULLPAD();
-
-       if (slabbed) OpslabREFCNT_dec_padok(OpSLAB(CvROOT(cv)));
-       op_free(CvROOT(cv));
-       CvROOT(cv) = NULL;
-       CvSTART(cv) = NULL;
-       LEAVE;
-    }
-    else if (slabbed && CvSTART(cv)) {
-       ENTER;
-       PAD_SAVE_SETNULLPAD();
-
-       /* discard any leaked ops */
-       if (PL_parser)
-           parser_free_nexttoke_ops(PL_parser, (OPSLAB *)CvSTART(cv));
-       opslab_force_free((OPSLAB *)CvSTART(cv));
-       CvSTART(cv) = NULL;
-
-       LEAVE;
-    }
+    /* CvSLABBED_off(&cvbody); *//* turned off below */
+    /* release the sub's body */
+    if (!CvISXSUB(&cvbody)) {
+        if(CvROOT(&cvbody)) {
+            assert(SvTYPE(cv) == SVt_PVCV || SvTYPE(cv) == SVt_PVFM); /*unsafe is safe */
+            if (CvDEPTHunsafe(&cvbody)) {
+                assert(SvTYPE(cv) == SVt_PVCV);
+                Perl_croak_nocontext("Can't undef active subroutine");
+            }
+            ENTER;
+
+            PAD_SAVE_SETNULLPAD();
+
+            if (CvSLABBED(&cvbody)) OpslabREFCNT_dec_padok(OpSLAB(CvROOT(&cvbody)));
+            op_free(CvROOT(&cvbody));
+            CvROOT(&cvbody) = NULL;
+            CvSTART(&cvbody) = NULL;
+            LEAVE;
+        }
+       else if (CvSLABBED(&cvbody)) {
+            if( CvSTART(&cvbody)) {
+                ENTER;
+                PAD_SAVE_SETNULLPAD();
+
+                /* discard any leaked ops */
+                if (PL_parser)
+                    parser_free_nexttoke_ops(PL_parser, (OPSLAB *)CvSTART(&cvbody));
+                opslab_force_free((OPSLAB *)CvSTART(&cvbody));
+                CvSTART(&cvbody) = NULL;
+
+                LEAVE;
+            }
 #ifdef DEBUGGING
-    else if (slabbed) Perl_warn(aTHX_ "Slab leaked from cv %p", (void*)cv);
+            else Perl_warn(aTHX_ "Slab leaked from cv %p", (void*)cv);
 #endif
+        }
+    }
+    else { /* dont bother checking if CvXSUB(cv) is true, less branching */
+       CvXSUB(&cvbody) = NULL;
+    }
     SvPOK_off(MUTABLE_SV(cv));         /* forget prototype */
     sv_unmagic((SV *)cv, PERL_MAGIC_checkcall);
     if (!(flags & CV_UNDEF_KEEP_NAME)) {
-       if (CvNAMED(cv)) {
-           CvNAME_HEK_set(cv, NULL);
-           CvNAMED_off(cv);
+       if (CvNAMED(&cvbody)) {
+           CvNAME_HEK_set(&cvbody, NULL);
+           CvNAMED_off(&cvbody);
        }
        else CvGV_set(cv, NULL);
     }
@@ -383,8 +398,9 @@ Perl_cv_undef_flags(pTHX_ CV *cv, U32 flags)
     /* This statement and the subsequence if block was pad_undef().  */
     pad_peg("pad_undef");
 
-    if (padlist) {
+    if (!CvISXSUB(&cvbody)  && CvPADLIST(&cvbody)) {
        I32 ix;
+       const PADLIST *padlist = CvPADLIST(&cvbody);
 
        /* Free the padlist associated with a CV.
           If parts of it happen to be current, we null the relevant PL_*pad*
@@ -404,8 +420,8 @@ Perl_cv_undef_flags(pTHX_ CV *cv, U32 flags)
         * children, or integrate this loop with general cleanup */
 
        if (PL_phase != PERL_PHASE_DESTRUCT) { /* don't bother during global destruction */
-           CV * const outercv = CvOUTSIDE(cv);
-           const U32 seq = CvOUTSIDE_SEQ(cv);
+           CV * const outercv = CvOUTSIDE(&cvbody);
+           const U32 seq = CvOUTSIDE_SEQ(&cvbody);
            PAD * const comppad_name = PadlistARRAY(padlist)[0];
            SV ** const namepad = AvARRAY(comppad_name);
            PAD * const comppad = PadlistARRAY(padlist)[1];
@@ -463,27 +479,29 @@ Perl_cv_undef_flags(pTHX_ CV *cv, U32 flags)
        }
        if (PadlistARRAY(padlist)) Safefree(PadlistARRAY(padlist));
        Safefree(padlist);
-       CvPADLIST(cv) = NULL;
+       CvPADLIST(&cvbody) = NULL;
     }
+    else /* future union */
+       CvPADLIST(&cvbody) = NULL;
 
 
     /* remove CvOUTSIDE unless this is an undef rather than a free */
-    if (!SvREFCNT(cv) && CvOUTSIDE(cv)) {
-       if (!CvWEAKOUTSIDE(cv))
-           SvREFCNT_dec(CvOUTSIDE(cv));
-       CvOUTSIDE(cv) = NULL;
-    }
-    if (CvCONST(cv)) {
-       SvREFCNT_dec(MUTABLE_SV(CvXSUBANY(cv).any_ptr));
-       CvCONST_off(cv);
+    if (!SvREFCNT(cv)) {
+       CV * outside = CvOUTSIDE(&cvbody);
+       if(outside) {
+           CvOUTSIDE(&cvbody) = NULL;
+           if (!CvWEAKOUTSIDE(&cvbody))
+               SvREFCNT_dec_NN(outside);
+       }
     }
-    if (CvISXSUB(cv) && CvXSUB(cv)) {
-       CvXSUB(cv) = NULL;
+    if (CvCONST(&cvbody)) {
+       SvREFCNT_dec(MUTABLE_SV(CvXSUBANY(&cvbody).any_ptr));
+       /* CvCONST_off(cv); *//* turned off below */
     }
     /* delete all flags except WEAKOUTSIDE and CVGV_RC, which indicate the
      * ref status of CvOUTSIDE and CvGV, and ANON, NAMED and
      * LEXICAL, which are used to determine the sub's name.  */
-    CvFLAGS(cv) &= (CVf_WEAKOUTSIDE|CVf_CVGV_RC|CVf_ANON|CVf_LEXICAL
+    CvFLAGS(&cvbody) &= (CVf_WEAKOUTSIDE|CVf_CVGV_RC|CVf_ANON|CVf_LEXICAL
                   |CVf_NAMED);
 }