perl 5.003_01: dump.c

Use varargs prototype for dump()
Use configurable destination for "error" output
Incorporate shared hash key support

diff --git a/dump.c b/dump.c
index 19300e1..e461d69 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -22,15 +22,27 @@ dump_all()
 }
 #else  /* Rest of file is for DEBUGGING */
 
+#ifdef I_STDARG
+static void dump(char *pat, ...);
+#else
+#  if defined(I_VARARGS)
+/*VARARGS0*/
+static void
+dump(pat, va_alist)
+    char *pat;
+    va_dcl
+#  else
 static void dump();
+#  endif
+#endif
 
 void
 dump_all()
 {
 #ifdef HAS_SETLINEBUF
-    setlinebuf(stderr);
+    setlinebuf(Perl_debug_log);
 #else
-    setvbuf(stderr, Nullch, _IOLBF, 0);
+    setvbuf(Perl_debug_log, Nullch, _IOLBF, 0);
 #endif
     if (main_root)
        dump_op(main_root);
@@ -47,14 +59,14 @@ HV* stash;
     if (!HvARRAY(stash))
        return;
     for (i = 0; i <= (I32) HvMAX(stash); i++) {
-       for (entry = HvARRAY(stash)[i]; entry; entry = entry->hent_next) {
-           GV *gv = (GV*)entry->hent_val;
+       for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
+           GV *gv = (GV*)HeVAL(entry);
            HV *hv;
            if (GvCV(gv))
                dump_sub(gv);
            if (GvFORM(gv))
                dump_form(gv);
-           if (entry->hent_key[entry->hent_klen-1] == ':' &&
+           if (HeKEY(entry)[HeKLEN(entry)-1] == ':' &&
              (hv = GvHV(gv)) && HvNAME(hv) && hv != defstash)
                dump_packsubs(hv);              /* nested package */
        }
@@ -107,18 +119,18 @@ register OP *op;
 
     dump("{\n");
     if (op->op_seq)
-       fprintf(stderr, "%-4d", op->op_seq);
+       fprintf(Perl_debug_log, "%-4d", op->op_seq);
     else
-       fprintf(stderr, "    ");
+       fprintf(Perl_debug_log, "    ");
     dump("TYPE = %s  ===> ", op_name[op->op_type]);
     if (op->op_next) {
        if (op->op_seq)
-           fprintf(stderr, "%d\n", op->op_next->op_seq);
+           fprintf(Perl_debug_log, "%d\n", op->op_next->op_seq);
        else
-           fprintf(stderr, "(%d)\n", op->op_next->op_seq);
+           fprintf(Perl_debug_log, "(%d)\n", op->op_next->op_seq);
     }
     else
-       fprintf(stderr, "DONE\n");
+       fprintf(Perl_debug_log, "DONE\n");
     dumplvl++;
     if (op->op_targ) {
        if (op->op_type == OP_NULL)
@@ -243,31 +255,31 @@ register OP *op;
     case OP_ENTERLOOP:
        dump("REDO ===> ");
        if (cLOOP->op_redoop)
-           fprintf(stderr, "%d\n", cLOOP->op_redoop->op_seq);
+           fprintf(Perl_debug_log, "%d\n", cLOOP->op_redoop->op_seq);
        else
-           fprintf(stderr, "DONE\n");
+           fprintf(Perl_debug_log, "DONE\n");
        dump("NEXT ===> ");
        if (cLOOP->op_nextop)
-           fprintf(stderr, "%d\n", cLOOP->op_nextop->op_seq);
+           fprintf(Perl_debug_log, "%d\n", cLOOP->op_nextop->op_seq);
        else
-           fprintf(stderr, "DONE\n");
+           fprintf(Perl_debug_log, "DONE\n");
        dump("LAST ===> ");
        if (cLOOP->op_lastop)
-           fprintf(stderr, "%d\n", cLOOP->op_lastop->op_seq);
+           fprintf(Perl_debug_log, "%d\n", cLOOP->op_lastop->op_seq);
        else
-           fprintf(stderr, "DONE\n");
+           fprintf(Perl_debug_log, "DONE\n");
        break;
     case OP_COND_EXPR:
        dump("TRUE ===> ");
        if (cCONDOP->op_true)
-           fprintf(stderr, "%d\n", cCONDOP->op_true->op_seq);
+           fprintf(Perl_debug_log, "%d\n", cCONDOP->op_true->op_seq);
        else
-           fprintf(stderr, "DONE\n");
+           fprintf(Perl_debug_log, "DONE\n");
        dump("FALSE ===> ");
        if (cCONDOP->op_false)
-           fprintf(stderr, "%d\n", cCONDOP->op_false->op_seq);
+           fprintf(Perl_debug_log, "%d\n", cCONDOP->op_false->op_seq);
        else
-           fprintf(stderr, "DONE\n");
+           fprintf(Perl_debug_log, "DONE\n");
        break;
     case OP_MAPWHILE:
     case OP_GREPWHILE:
@@ -275,9 +287,9 @@ register OP *op;
     case OP_AND:
        dump("OTHER ===> ");
        if (cLOGOP->op_other)
-           fprintf(stderr, "%d\n", cLOGOP->op_other->op_seq);
+           fprintf(Perl_debug_log, "%d\n", cLOGOP->op_other->op_seq);
        else
-           fprintf(stderr, "DONE\n");
+           fprintf(Perl_debug_log, "DONE\n");
        break;
     case OP_PUSHRE:
     case OP_MATCH:
@@ -303,12 +315,12 @@ register GV *gv;
     SV *sv;
 
     if (!gv) {
-       fprintf(stderr,"{}\n");
+       fprintf(Perl_debug_log,"{}\n");
        return;
     }
     sv = sv_newmortal();
     dumplvl++;
-    fprintf(stderr,"{\n");
+    fprintf(Perl_debug_log,"{\n");
     gv_fullname(sv,gv);
     dump("GV_NAME = %s", SvPVX(sv));
     if (gv != GvEGV(gv)) {
@@ -378,6 +390,8 @@ register PMOP *pm;
     dump("}\n");
 }
 
+
+#if !defined(I_STDARG) && !defined(I_VARARGS)
 /* VARARGS1 */
 static void dump(arg1,arg2,arg3,arg4,arg5)
 char *arg1;
@@ -386,7 +400,39 @@ long arg2, arg3, arg4, arg5;
     I32 i;
 
     for (i = dumplvl*4; i; i--)
+       (void)putc(' ',Perl_debug_log);
+    fprintf(Perl_debug_log,arg1, arg2, arg3, arg4, arg5);
+}
+
+#else
+
+#ifdef I_STDARG
+static void
+dump(char *pat,...)
+#else
+/*VARARGS0*/
+static void
+dump(pat,va_alist)
+    char *pat;
+    va_dcl
+#endif
+{
+    I32 i;
+    va_list args;
+#ifndef HAS_VPRINTF
+    int vfprintf();
+#endif
+
+#ifdef I_STDARG
+    va_start(args, pat);
+#else
+    va_start(args);
+#endif
+    for (i = dumplvl*4; i; i--)
        (void)putc(' ',stderr);
-    fprintf(stderr,arg1, arg2, arg3, arg4, arg5);
+    vfprintf(Perl_debug_log,pat,args);
+    va_end(args);
 }
 #endif
+
+#endif