This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Devel-Peek: use hv_fetchs() when the key is a constant string
[perl5.git] / ext / Devel-Peek / Peek.xs
index b8a18d6..2d9895b 100644 (file)
@@ -31,7 +31,7 @@ DeadCode(pTHX)
        for (sv = sva + 1; sv < svend; ++sv) {
            if (SvTYPE(sv) == SVt_PVCV) {
                CV *cv = (CV*)sv;
-               PADLIST* padlist = CvPADLIST(cv);
+               PADLIST* padlist;
                 AV *argav;
                SV** svp;
                SV** pad;
@@ -54,6 +54,7 @@ DeadCode(pTHX)
                    PerlIO_printf(Perl_debug_log, "  busy\n");
                    continue;
                }
+               padlist = CvPADLIST(cv);
                svp = (SV**) PadlistARRAY(padlist);
                while (++i <= PadlistMAX(padlist)) { /* Depth. */
                    SV **args;
@@ -180,46 +181,46 @@ _mstats_to_hv(HV *hv, const struct mstats_buffer *b, int level)
     SV **svp;
     int type;
 
-    svp = hv_fetch(hv, "topbucket", 9, 1);
+    svp = hv_fetchs(hv, "topbucket", 1);
     sv_setiv(*svp, b->buffer.topbucket);
 
-    svp = hv_fetch(hv, "topbucket_ev", 12, 1);
+    svp = hv_fetchs(hv, "topbucket_ev", 1);
     sv_setiv(*svp, b->buffer.topbucket_ev);
 
-    svp = hv_fetch(hv, "topbucket_odd", 13, 1);
+    svp = hv_fetchs(hv, "topbucket_odd", 1);
     sv_setiv(*svp, b->buffer.topbucket_odd);
 
-    svp = hv_fetch(hv, "totfree", 7, 1);
+    svp = hv_fetchs(hv, "totfree", 1);
     sv_setiv(*svp, b->buffer.totfree);
 
-    svp = hv_fetch(hv, "total", 5, 1);
+    svp = hv_fetchs(hv, "total", 1);
     sv_setiv(*svp, b->buffer.total);
 
-    svp = hv_fetch(hv, "total_chain", 11, 1);
+    svp = hv_fetchs(hv, "total_chain", 1);
     sv_setiv(*svp, b->buffer.total_chain);
 
-    svp = hv_fetch(hv, "total_sbrk", 10, 1);
+    svp = hv_fetchs(hv, "total_sbrk", 1);
     sv_setiv(*svp, b->buffer.total_sbrk);
 
-    svp = hv_fetch(hv, "sbrks", 5, 1);
+    svp = hv_fetchs(hv, "sbrks", 1);
     sv_setiv(*svp, b->buffer.sbrks);
 
-    svp = hv_fetch(hv, "sbrk_good", 9, 1);
+    svp = hv_fetchs(hv, "sbrk_good", 1);
     sv_setiv(*svp, b->buffer.sbrk_good);
 
-    svp = hv_fetch(hv, "sbrk_slack", 10, 1);
+    svp = hv_fetchs(hv, "sbrk_slack", 1);
     sv_setiv(*svp, b->buffer.sbrk_slack);
 
-    svp = hv_fetch(hv, "start_slack", 11, 1);
+    svp = hv_fetchs(hv, "start_slack", 1);
     sv_setiv(*svp, b->buffer.start_slack);
 
-    svp = hv_fetch(hv, "sbrked_remains", 14, 1);
+    svp = hv_fetchs(hv, "sbrked_remains", 1);
     sv_setiv(*svp, b->buffer.sbrked_remains);
     
-    svp = hv_fetch(hv, "minbucket", 9, 1);
+    svp = hv_fetchs(hv, "minbucket", 1);
     sv_setiv(*svp, b->buffer.minbucket);
     
-    svp = hv_fetch(hv, "nbuckets", 8, 1);
+    svp = hv_fetchs(hv, "nbuckets", 1);
     sv_setiv(*svp, b->buffer.nbuckets);
 
     if (_NBUCKETS < b->buffer.nbuckets) 
@@ -361,12 +362,12 @@ S_ck_dump(pTHX_ OP *entersubop, GV *namegv, SV *cv)
 
     parent = entersubop;
     pm = cUNOPx(entersubop)->op_first;
-    if (!OP_HAS_SIBLING(pm)) {
+    if (!OpHAS_SIBLING(pm)) {
         parent = pm;
        pm = cUNOPx(pm)->op_first;
     }
-    first = OP_SIBLING(pm);
-    second = OP_SIBLING(first);
+    first = OpSIBLING(pm);
+    second = OpSIBLING(first);
     if (!second) {
        /* It doesn’t really matter what we return here, as this only
           occurs after yyerror.  */
@@ -375,7 +376,7 @@ S_ck_dump(pTHX_ OP *entersubop, GV *namegv, SV *cv)
     /* we either have Dump($x):   [pushmark]->[first]->[ex-cvop]
      * or             Dump($x,1); [pushmark]->[first]->[second]->[ex-cvop]
      */
-    if (!OP_HAS_SIBLING(second))
+    if (!OpHAS_SIBLING(second))
         second = NULL;
 
     if (first->op_type == OP_RV2AV ||
@@ -398,15 +399,20 @@ S_ck_dump(pTHX_ OP *entersubop, GV *namegv, SV *cv)
     NewOp(1234, newop, 1, BINOP);
     newop->op_type   = OP_CUSTOM;
     newop->op_ppaddr = S_pp_dump;
-    newop->op_first  = first;
-    newop->op_last   = second;
     newop->op_private= second ? 2 : 1;
     newop->op_flags  = OPf_KIDS|OPf_WANT_SCALAR;
+    op_sibling_splice((OP*)newop, NULL, 0, first);
 
     return (OP *)newop;
 }
 
-static XOP my_xop;
+static const XOP my_xop = {
+    XOPf_xop_name|XOPf_xop_desc|XOPf_xop_class,                /* xop_flags */
+    "Devel_Peek_Dump",                                 /* xop_name */
+    "Dump",                                            /* xop_desc */
+    OA_BINOP,                                          /* xop_class */
+    NULL                                               /* xop_peep */
+};
 
 MODULE = Devel::Peek           PACKAGE = Devel::Peek
 
@@ -439,10 +445,6 @@ BOOT:
     CV * const cv = get_cvn_flags("Devel::Peek::Dump", 17, 0);
     assert(cv);
     cv_set_call_checker(cv, S_ck_dump, (SV *)cv);
-
-    XopENTRY_set(&my_xop, xop_name, "Dump");
-    XopENTRY_set(&my_xop, xop_desc, "Dump");
-    XopENTRY_set(&my_xop, xop_class, OA_BINOP);
     Perl_custom_op_register(aTHX_ S_pp_dump, &my_xop);
 }