This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
constant.pm: Document fully-qualified constant names
[perl5.git] / dump.c
diff --git a/dump.c b/dump.c
index 9bbbe2d..75f0fb4 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -495,7 +495,6 @@ Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
 void
 Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args)
 {
-    dVAR;
     PERL_ARGS_ASSERT_DUMP_VINDENT;
     PerlIO_printf(file, "%*s", (int)(level*PL_dumpindent), "");
     PerlIO_vprintf(file, pat, *args);
@@ -520,8 +519,6 @@ Perl_dump_all(pTHX)
 void
 Perl_dump_all_perl(pTHX_ bool justperl)
 {
-
-    dVAR;
     PerlIO_setlinebuf(Perl_debug_log);
     if (PL_main_root)
        op_dump(PL_main_root);
@@ -546,7 +543,6 @@ Perl_dump_packsubs(pTHX_ const HV *stash)
 void
 Perl_dump_packsubs_perl(pTHX_ const HV *stash, bool justperl)
 {
-    dVAR;
     I32        i;
 
     PERL_ARGS_ASSERT_DUMP_PACKSUBS_PERL;
@@ -625,7 +621,6 @@ Perl_dump_form(pTHX_ const GV *gv)
 void
 Perl_dump_eval(pTHX)
 {
-    dVAR;
     op_dump(PL_eval_root);
 }
 
@@ -884,125 +879,10 @@ S_op_private_to_names(pTHX_ SV *tmpsv, U32 optype, U32 op_private) {
     return FALSE;
 }
 
-#define DUMP_OP_FLAGS(o,level,file)                                 \
-    if (o->op_flags || o->op_slabbed || o->op_savefree || o->op_static) { \
-        SV * const tmpsv = newSVpvs("");                                \
-        switch (o->op_flags & OPf_WANT) {                               \
-        case OPf_WANT_VOID:                                             \
-            sv_catpv(tmpsv, ",VOID");                                   \
-            break;                                                      \
-        case OPf_WANT_SCALAR:                                           \
-            sv_catpv(tmpsv, ",SCALAR");                                 \
-            break;                                                      \
-        case OPf_WANT_LIST:                                             \
-            sv_catpv(tmpsv, ",LIST");                                   \
-            break;                                                      \
-        default:                                                        \
-            sv_catpv(tmpsv, ",UNKNOWN");                                \
-            break;                                                      \
-        }                                                               \
-        append_flags(tmpsv, o->op_flags, op_flags_names);               \
-        if (o->op_slabbed)  sv_catpvs(tmpsv, ",SLABBED");               \
-        if (o->op_savefree) sv_catpvs(tmpsv, ",SAVEFREE");              \
-        if (o->op_static)   sv_catpvs(tmpsv, ",STATIC");                \
-        if (o->op_folded)   sv_catpvs(tmpsv, ",FOLDED");                \
-        Perl_dump_indent(aTHX_ level, file, "FLAGS = (%s)\n",           \
-                         SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");   \
-    }
-
-#define DUMP_OP_PRIVATE(o,level,file)                                   \
-    if (o->op_private) {                                                \
-        U32 optype = o->op_type;                                        \
-        U32 oppriv = o->op_private;                                     \
-        SV * const tmpsv = newSVpvs("");                                \
-       if (PL_opargs[optype] & OA_TARGLEX) {                           \
-           if (oppriv & OPpTARGET_MY)                                  \
-               sv_catpv(tmpsv, ",TARGET_MY");                          \
-       }                                                               \
-       else if (optype == OP_ENTERSUB ||                               \
-                 optype == OP_RV2SV ||                                  \
-                 optype == OP_GVSV ||                                   \
-                 optype == OP_RV2AV ||                                  \
-                 optype == OP_RV2HV ||                                  \
-                 optype == OP_RV2GV ||                                  \
-                 optype == OP_AELEM ||                                  \
-                 optype == OP_HELEM )                                   \
-        {                                                               \
-            if (optype == OP_ENTERSUB) {                                \
-                append_flags(tmpsv, oppriv, op_entersub_names);         \
-            }                                                           \
-            else {                                                      \
-                switch (oppriv & OPpDEREF) {                            \
-                case OPpDEREF_SV:                                       \
-                    sv_catpv(tmpsv, ",SV");                             \
-                    break;                                              \
-                case OPpDEREF_AV:                                       \
-                    sv_catpv(tmpsv, ",AV");                             \
-                    break;                                              \
-                case OPpDEREF_HV:                                       \
-                    sv_catpv(tmpsv, ",HV");                             \
-                    break;                                              \
-                }                                                       \
-                if (oppriv & OPpMAYBE_LVSUB)                            \
-                    sv_catpv(tmpsv, ",MAYBE_LVSUB");                    \
-            }                                                           \
-            if (optype == OP_AELEM || optype == OP_HELEM) {             \
-                if (oppriv & OPpLVAL_DEFER)                             \
-                    sv_catpv(tmpsv, ",LVAL_DEFER");                     \
-            }                                                           \
-            else if (optype == OP_RV2HV || optype == OP_PADHV) {        \
-                if (oppriv & OPpMAYBE_TRUEBOOL)                         \
-                    sv_catpvs(tmpsv, ",OPpMAYBE_TRUEBOOL");             \
-                if (oppriv & OPpTRUEBOOL)                               \
-                    sv_catpvs(tmpsv, ",OPpTRUEBOOL");                   \
-            }                                                           \
-            else {                                                      \
-                if (oppriv & HINT_STRICT_REFS)                          \
-                    sv_catpv(tmpsv, ",STRICT_REFS");                    \
-                if (oppriv & OPpOUR_INTRO)                              \
-                    sv_catpv(tmpsv, ",OUR_INTRO");                      \
-            }                                                           \
-        }                                                               \
-       else if (S_op_private_to_names(aTHX_ tmpsv, optype, oppriv)) {  \
-       }                                                               \
-       else if (OP_IS_FILETEST(o->op_type)) {                          \
-            if (oppriv & OPpFT_ACCESS)                                  \
-                sv_catpv(tmpsv, ",FT_ACCESS");                          \
-            if (oppriv & OPpFT_STACKED)                                 \
-                sv_catpv(tmpsv, ",FT_STACKED");                         \
-            if (oppriv & OPpFT_STACKING)                                \
-                sv_catpv(tmpsv, ",FT_STACKING");                        \
-            if (oppriv & OPpFT_AFTER_t)                                 \
-                sv_catpv(tmpsv, ",AFTER_t");                            \
-       }                                                               \
-       else if (o->op_type == OP_AASSIGN) {                            \
-           if (oppriv & OPpASSIGN_COMMON)                              \
-               sv_catpvs(tmpsv, ",COMMON");                            \
-           if (oppriv & OPpMAYBE_LVSUB)                                \
-               sv_catpvs(tmpsv, ",MAYBE_LVSUB");                       \
-       }                                                               \
-       if (o->op_flags & OPf_MOD && oppriv & OPpLVAL_INTRO)            \
-           sv_catpv(tmpsv, ",INTRO");                                  \
-       if (o->op_type == OP_PADRANGE)                                  \
-           Perl_sv_catpvf(aTHX_ tmpsv, ",COUNT=%"UVuf,                 \
-                           (UV)(oppriv & OPpPADRANGE_COUNTMASK));       \
-        if (  (o->op_type == OP_RV2HV || o->op_type == OP_RV2AV ||      \
-               o->op_type == OP_PADAV || o->op_type == OP_PADHV ||      \
-               o->op_type == OP_ASLICE || o->op_type == OP_HSLICE)      \
-           && oppriv & OPpSLICEWARNING  )                               \
-            sv_catpvs(tmpsv, ",SLICEWARNING");                          \
-       if (SvCUR(tmpsv)) {                                             \
-            Perl_dump_indent(aTHX_ level, file, "PRIVATE = (%s)\n", SvPVX_const(tmpsv) + 1); \
-       } else                                                          \
-            Perl_dump_indent(aTHX_ level, file, "PRIVATE = (0x%"UVxf")\n", \
-                             (UV)oppriv);                               \
-    }
-
 
 void
 Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
 {
-    dVAR;
     UV      seq;
     const OPCODE optype = o->op_type;
 
@@ -1059,8 +939,120 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
     Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%"UVxf" => 0x%"UVxf"\n", (UV)o, (UV)o->op_next);
 #endif
 
-    DUMP_OP_FLAGS(o,level,file);
-    DUMP_OP_PRIVATE(o,level,file);
+    if (o->op_flags || o->op_slabbed || o->op_savefree || o->op_static) {
+        SV * const tmpsv = newSVpvs("");
+        switch (o->op_flags & OPf_WANT) {
+        case OPf_WANT_VOID:
+            sv_catpv(tmpsv, ",VOID");
+            break;
+        case OPf_WANT_SCALAR:
+            sv_catpv(tmpsv, ",SCALAR");
+            break;
+        case OPf_WANT_LIST:
+            sv_catpv(tmpsv, ",LIST");
+            break;
+        default:
+            sv_catpv(tmpsv, ",UNKNOWN");
+            break;
+        }
+        append_flags(tmpsv, o->op_flags, op_flags_names);
+        if (o->op_slabbed)  sv_catpvs(tmpsv, ",SLABBED");
+        if (o->op_savefree) sv_catpvs(tmpsv, ",SAVEFREE");
+        if (o->op_static)   sv_catpvs(tmpsv, ",STATIC");
+        if (o->op_folded)   sv_catpvs(tmpsv, ",FOLDED");
+        if (o->op_lastsib)  sv_catpvs(tmpsv, ",LASTSIB");
+        Perl_dump_indent(aTHX_ level, file, "FLAGS = (%s)\n",
+                         SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
+    }
+
+    if (o->op_private) {
+        U32 optype = o->op_type;
+        U32 oppriv = o->op_private;
+        SV * const tmpsv = newSVpvs("");
+       if (PL_opargs[optype] & OA_TARGLEX) {
+           if (oppriv & OPpTARGET_MY)
+               sv_catpv(tmpsv, ",TARGET_MY");
+       }
+       else if (optype == OP_ENTERSUB ||
+                 optype == OP_RV2SV ||
+                 optype == OP_GVSV ||
+                 optype == OP_RV2AV ||
+                 optype == OP_RV2HV ||
+                 optype == OP_RV2GV ||
+                 optype == OP_AELEM ||
+                 optype == OP_HELEM )
+        {
+            if (optype == OP_ENTERSUB) {
+                append_flags(tmpsv, oppriv, op_entersub_names);
+            }
+            else {
+                switch (oppriv & OPpDEREF) {
+                case OPpDEREF_SV:
+                    sv_catpv(tmpsv, ",SV");
+                    break;
+                case OPpDEREF_AV:
+                    sv_catpv(tmpsv, ",AV");
+                    break;
+                case OPpDEREF_HV:
+                    sv_catpv(tmpsv, ",HV");
+                    break;
+                }
+                if (oppriv & OPpMAYBE_LVSUB)
+                    sv_catpv(tmpsv, ",MAYBE_LVSUB");
+            }
+            if (optype == OP_AELEM || optype == OP_HELEM) {
+                if (oppriv & OPpLVAL_DEFER)
+                    sv_catpv(tmpsv, ",LVAL_DEFER");
+            }
+            else if (optype == OP_RV2HV || optype == OP_PADHV) {
+                if (oppriv & OPpMAYBE_TRUEBOOL)
+                    sv_catpvs(tmpsv, ",OPpMAYBE_TRUEBOOL");
+                if (oppriv & OPpTRUEBOOL)
+                    sv_catpvs(tmpsv, ",OPpTRUEBOOL");
+            }
+            else {
+                if (oppriv & HINT_STRICT_REFS)
+                    sv_catpv(tmpsv, ",STRICT_REFS");
+                if (oppriv & OPpOUR_INTRO)
+                    sv_catpv(tmpsv, ",OUR_INTRO");
+            }
+        }
+       else if (S_op_private_to_names(aTHX_ tmpsv, optype, oppriv)) {
+       }
+       else if (OP_IS_FILETEST(o->op_type)) {
+            if (oppriv & OPpFT_ACCESS)
+                sv_catpv(tmpsv, ",FT_ACCESS");
+            if (oppriv & OPpFT_STACKED)
+                sv_catpv(tmpsv, ",FT_STACKED");
+            if (oppriv & OPpFT_STACKING)
+                sv_catpv(tmpsv, ",FT_STACKING");
+            if (oppriv & OPpFT_AFTER_t)
+                sv_catpv(tmpsv, ",AFTER_t");
+       }
+       else if (o->op_type == OP_AASSIGN) {
+           if (oppriv & OPpASSIGN_COMMON)
+               sv_catpvs(tmpsv, ",COMMON");
+           if (oppriv & OPpMAYBE_LVSUB)
+               sv_catpvs(tmpsv, ",MAYBE_LVSUB");
+       }
+       if (o->op_flags & OPf_MOD && oppriv & OPpLVAL_INTRO)
+           sv_catpv(tmpsv, ",INTRO");
+       if (o->op_type == OP_PADRANGE)
+           Perl_sv_catpvf(aTHX_ tmpsv, ",COUNT=%"UVuf,
+                           (UV)(oppriv & OPpPADRANGE_COUNTMASK));
+        if (  (o->op_type == OP_RV2HV || o->op_type == OP_RV2AV ||
+               o->op_type == OP_PADAV || o->op_type == OP_PADHV ||
+               o->op_type == OP_ASLICE || o->op_type == OP_HSLICE)
+           && oppriv & OPpSLICEWARNING  )
+            sv_catpvs(tmpsv, ",SLICEWARNING");
+       if (SvCUR(tmpsv)) {
+            Perl_dump_indent(aTHX_ level, file, "PRIVATE = (%s)\n", SvPVX_const(tmpsv) + 1);
+       } else
+            Perl_dump_indent(aTHX_ level, file, "PRIVATE = (0x%"UVxf")\n",
+                             (UV)oppriv);
+    }
+
+
 
 
     switch (optype) {
@@ -1169,7 +1161,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
     }
     if (o->op_flags & OPf_KIDS) {
        OP *kid;
-       for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
+       for (kid = cUNOPo->op_first; kid; kid = OP_SIBLING(kid))
            do_op_dump(level, file, kid);
     }
     Perl_dump_indent(aTHX_ level-1, file, "}\n");
@@ -1534,7 +1526,6 @@ const struct flag_to_name regexp_core_intflags_names[] = {
 void
 Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
 {
-    dVAR;
     SV *d;
     const char *s;
     U32 flags;
@@ -2148,7 +2139,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
            Perl_dump_indent(aTHX_ level, file, "  TARGLEN = %"IVdf"\n", (IV)LvTARGLEN(sv));
            Perl_dump_indent(aTHX_ level, file, "  TARG = 0x%"UVxf"\n", PTR2UV(LvTARG(sv)));
            Perl_dump_indent(aTHX_ level, file, "  FLAGS = %"IVdf"\n", (IV)LvFLAGS(sv));
-           if (LvTYPE(sv) != 't' && LvTYPE(sv) != 'T')
+           if (isALPHA_FOLD_NE(LvTYPE(sv), 't'))
                do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest,
                    dumpops, pvlim);
        }
@@ -2322,8 +2313,6 @@ For an example of its output, see L<Devel::Peek>.
 void
 Perl_sv_dump(pTHX_ SV *sv)
 {
-    dVAR;
-
     PERL_ARGS_ASSERT_SV_DUMP;
 
     if (SvROK(sv))
@@ -2335,7 +2324,6 @@ Perl_sv_dump(pTHX_ SV *sv)
 int
 Perl_runops_debug(pTHX)
 {
-    dVAR;
     if (!PL_op) {
        Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
        return 0;
@@ -2378,7 +2366,7 @@ Perl_runops_debug(pTHX)
 I32
 Perl_debop(pTHX_ const OP *o)
 {
-    dVAR;
+    int count;
 
     PERL_ARGS_ASSERT_DEBOP;
 
@@ -2410,9 +2398,6 @@ Perl_debop(pTHX_ const OP *o)
            PerlIO_printf(Perl_debug_log, "(NULL)");
        break;
 
-    {
-        int count;
-
     case OP_PADSV:
     case OP_PADAV:
     case OP_PADHV:
@@ -2446,7 +2431,6 @@ Perl_debop(pTHX_ const OP *o)
             PerlIO_printf(Perl_debug_log, ")");
         }
         break;
-    }
 
     default:
        break;
@@ -2458,7 +2442,6 @@ Perl_debop(pTHX_ const OP *o)
 STATIC CV*
 S_deb_curcv(pTHX_ const I32 ix)
 {
-    dVAR;
     const PERL_CONTEXT * const cx = &cxstack[ix];
     if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT)
         return cx->blk_sub.cv;
@@ -2475,8 +2458,6 @@ S_deb_curcv(pTHX_ const I32 ix)
 void
 Perl_watch(pTHX_ char **addr)
 {
-    dVAR;
-
     PERL_ARGS_ASSERT_WATCH;
 
     PL_watchaddr = addr;
@@ -2488,8 +2469,6 @@ Perl_watch(pTHX_ char **addr)
 STATIC void
 S_debprof(pTHX_ const OP *o)
 {
-    dVAR;
-
     PERL_ARGS_ASSERT_DEBPROF;
 
     if (!DEBUG_J_TEST_ && CopSTASH_eq(PL_curcop, PL_debstash))
@@ -2502,7 +2481,6 @@ S_debprof(pTHX_ const OP *o)
 void
 Perl_debprofdump(pTHX)
 {
-    dVAR;
     unsigned i;
     if (!PL_profiledata)
        return;
Unnamed repository; edit this file 'description' to name the repository.