Add comment to top of reentr.c and fix typos in other files

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

diff --git a/dump.c b/dump.c
index 049f948..5f0bef2 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -1,7 +1,7 @@
 /*    dump.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -13,6 +13,13 @@
  * it has not been hard for me to read your mind and memory.'"
  */
 
+/* This file contains utility routines to dump the contents of SV and OP
+ * structures, as used by command-line options like -Dt and -Dx, and
+ * by Devel::Peek.
+ *
+ * It also holds the debugging version of the  runops function.
+ */
+
 #include "EXTERN.h"
 #define PERL_IN_DUMP_C
 #include "perl.h"
@@ -118,19 +125,17 @@ Perl_pv_display(pTHX_ SV *dsv, char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
             truncated++;
            break;
         }
-        if (isPRINT(*pv)) {
-            switch (*pv) {
-           case '\t': sv_catpvn(dsv, "\\t", 2);  break;
-           case '\n': sv_catpvn(dsv, "\\n", 2);  break;
-           case '\r': sv_catpvn(dsv, "\\r", 2);  break;
-           case '\f': sv_catpvn(dsv, "\\f", 2);  break;
-           case '"':  sv_catpvn(dsv, "\\\"", 2); break;
-           case '\\': sv_catpvn(dsv, "\\\\", 2); break;
-           default:   sv_catpvn(dsv, pv, 1);     break;
-            }
-        }
-       else {
-           if (cur && isDIGIT(*(pv+1)))
+       switch (*pv) {
+       case '\t': sv_catpvn(dsv, "\\t", 2);  break;
+       case '\n': sv_catpvn(dsv, "\\n", 2);  break;
+       case '\r': sv_catpvn(dsv, "\\r", 2);  break;
+       case '\f': sv_catpvn(dsv, "\\f", 2);  break;
+       case '"':  sv_catpvn(dsv, "\\\"", 2); break;
+       case '\\': sv_catpvn(dsv, "\\\\", 2); break;
+       default:
+           if (isPRINT(*pv))
+               sv_catpvn(dsv, pv, 1);
+           else if (cur && isDIGIT(*(pv+1)))
                Perl_sv_catpvf(aTHX_ dsv, "\\%03o", (U8)*pv);
            else
                Perl_sv_catpvf(aTHX_ dsv, "\\%o", (U8)*pv);
@@ -412,13 +417,13 @@ sequence(pTHX_ register OP *o)
     if (!o)
        return;
 
-    op = newSVuv((UV) o);
+    op = newSVuv(PTR2UV(o));
     key = SvPV(op, len);
     if (hv_exists(Sequence, key, len))
        return;
 
     for (; o; o = o->op_next) {
-       op = newSVuv((UV) o);
+       op = newSVuv(PTR2UV(o));
        key = SvPV(op, len);
        if (hv_exists(Sequence, key, len))
            break;
@@ -501,7 +506,7 @@ sequence_num(pTHX_ OP *o)
     char   *key;
     STRLEN  len;
     if (!o) return 0;
-    op = newSVuv((UV) o);
+    op = newSVuv(PTR2UV(o));
     key = SvPV(op, len);
     seq = hv_fetch(Sequence, key, len, 0);
     return seq ? SvUV(*seq): 0;
@@ -516,14 +521,15 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
     level++;
     seq = sequence_num(aTHX_ o);
     if (seq)
-       PerlIO_printf(file, "%-4d", seq);
+       PerlIO_printf(file, "%-4"UVf, seq);
     else
        PerlIO_printf(file, "    ");
     PerlIO_printf(file,
                  "%*sTYPE = %s  ===> ",
                  (int)(PL_dumpindent*level-4), "", OP_NAME(o));
     if (o->op_next)
-       PerlIO_printf(file, seq ? "%d\n" : "(%d)\n", sequence_num(aTHX_ o->op_next));
+       PerlIO_printf(file, seq ? "%"UVf"\n" : "(%"UVf")\n",
+                               sequence_num(aTHX_ o->op_next));
     else
        PerlIO_printf(file, "DONE\n");
     if (o->op_targ) {
@@ -758,17 +764,19 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
 #ifdef USE_ITHREADS
        Perl_dump_indent(aTHX_ level, file, "PADIX = %" IVdf "\n", (IV)cPADOPo->op_padix);
 #else
-       if (cSVOPo->op_sv) {
-           SV *tmpsv = NEWSV(0,0);
-           STRLEN n_a;
-           ENTER;
-           SAVEFREESV(tmpsv);
-           gv_fullname3(tmpsv, (GV*)cSVOPo->op_sv, Nullch);
-           Perl_dump_indent(aTHX_ level, file, "GV = %s\n", SvPV(tmpsv, n_a));
-           LEAVE;
+       if ( ! PL_op->op_flags & OPf_SPECIAL) { /* not lexical */
+           if (cSVOPo->op_sv) {
+               SV *tmpsv = NEWSV(0,0);
+               STRLEN n_a;
+               ENTER;
+               SAVEFREESV(tmpsv);
+               gv_fullname3(tmpsv, (GV*)cSVOPo->op_sv, Nullch);
+               Perl_dump_indent(aTHX_ level, file, "GV = %s\n", SvPV(tmpsv, n_a));
+               LEAVE;
+           }
+           else
+               Perl_dump_indent(aTHX_ level, file, "GV = NULL\n");
        }
-       else
-           Perl_dump_indent(aTHX_ level, file, "GV = NULL\n");
 #endif
        break;
     case OP_CONST:
@@ -795,17 +803,17 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
     case OP_ENTERLOOP:
        Perl_dump_indent(aTHX_ level, file, "REDO ===> ");
        if (cLOOPo->op_redoop)
-           PerlIO_printf(file, "%d\n", sequence_num(aTHX_ cLOOPo->op_redoop));
+           PerlIO_printf(file, "%"UVf"\n", sequence_num(aTHX_ cLOOPo->op_redoop));
        else
            PerlIO_printf(file, "DONE\n");
        Perl_dump_indent(aTHX_ level, file, "NEXT ===> ");
        if (cLOOPo->op_nextop)
-           PerlIO_printf(file, "%d\n", sequence_num(aTHX_ cLOOPo->op_nextop));
+           PerlIO_printf(file, "%"UVf"\n", sequence_num(aTHX_ cLOOPo->op_nextop));
        else
            PerlIO_printf(file, "DONE\n");
        Perl_dump_indent(aTHX_ level, file, "LAST ===> ");
        if (cLOOPo->op_lastop)
-           PerlIO_printf(file, "%d\n", sequence_num(aTHX_ cLOOPo->op_lastop));
+           PerlIO_printf(file, "%"UVf"\n", sequence_num(aTHX_ cLOOPo->op_lastop));
        else
            PerlIO_printf(file, "DONE\n");
        break;
@@ -817,7 +825,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
     case OP_AND:
        Perl_dump_indent(aTHX_ level, file, "OTHER ===> ");
        if (cLOGOPo->op_other)
-           PerlIO_printf(file, "%d\n", sequence_num(aTHX_ cLOGOPo->op_other));
+           PerlIO_printf(file, "%"UVf"\n", sequence_num(aTHX_ cLOGOPo->op_other));
        else
            PerlIO_printf(file, "DONE\n");
        break;
@@ -1539,6 +1547,7 @@ Perl_runops_debug(pTHX)
        return 0;
     }
 
+    DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level\n"));
     do {
        PERL_ASYNC_CHECK();
        if (PL_debug) {
@@ -1561,6 +1570,7 @@ Perl_runops_debug(pTHX)
            if (DEBUG_P_TEST_) debprof(PL_op);
        }
     } while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX)));
+    DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));
 
     TAINT_NOT;
     return 0;