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 e235d80..2d9895b 100644 (file)
@@ -181,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) 
@@ -362,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.  */
@@ -376,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 ||
@@ -406,7 +406,13 @@ S_ck_dump(pTHX_ OP *entersubop, GV *namegv, SV *cv)
     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);
 }