dump.c

   1 /* $RCSfile: dump.c,v $$Revision: 4.1 $$Date: 92/08/07 17:20:03 $
   2  *
   3  *    Copyright (c) 1991, Larry Wall
   4  *
   5  *    You may distribute under the terms of either the GNU General Public
   6  *    License or the Artistic License, as specified in the README file.
   7  *
   8  * $Log:        dump.c,v $
   9  * Revision 4.1  92/08/07  17:20:03  lwall
  10  * Stage 6 Snapshot
  11  *
  12  * Revision 4.0.1.2  92/06/08  13:14:22  lwall
  13  * patch20: removed implicit int declarations on funcions
  14  * patch20: fixed confusion between a *var's real name and its effective name
  15  *
  16  * Revision 4.0.1.1  91/06/07  10:58:44  lwall
  17  * patch4: new copyright notice
  18  *
  19  * Revision 4.0  91/03/20  01:08:25  lwall
  20  * 4.0 baseline.
  21  *
  22  */
  23
  24 #include "EXTERN.h"
  25 #include "perl.h"
  26
  27 #ifdef DEBUGGING
  28
  29 static void dump();
  30
  31 void
  32 dump_all()
  33 {
  34     setlinebuf(stderr);
  35     if (main_root)
  36         dump_op(main_root);
  37     dump_packsubs(defstash);
  38 }
  39
  40 void
  41 dump_packsubs(stash)
  42 HV* stash;
  43 {
  44     U32 i;
  45     HE  *entry;
  46
  47     if (!HvARRAY(stash))
  48         return;
  49     for (i = 0; i <= HvMAX(stash); i++) {
  50         for (entry = HvARRAY(stash)[i]; entry; entry = entry->hent_next) {
  51             GV *gv = (GV*)entry->hent_val;
  52             HV *hv;
  53             if (GvCV(gv))
  54                 dump_sub(gv);
  55             if (*entry->hent_key == '_' && (hv = GvHV(gv)) && HvNAME(hv) &&
  56               hv != defstash)
  57                 dump_packsubs(hv);              /* nested package */
  58         }
  59     }
  60 }
  61
  62 void
  63 dump_sub(gv)
  64 GV* gv;
  65 {
  66     SV *sv = sv_newmortal();
  67     if (GvCV(gv)) {
  68         gv_fullname(sv,gv);
  69         dump("\nSUB %s = ", SvPVX(sv));
  70         if (CvUSERSUB(GvCV(gv)))
  71             dump("(xsub 0x%x %d)\n",
  72                 (long)CvUSERSUB(GvCV(gv)),
  73                 CvUSERINDEX(GvCV(gv)));
  74         else if (CvROOT(GvCV(gv)))
  75             dump_op(CvROOT(GvCV(gv)));
  76         else
  77             dump("<undef>\n");
  78     }
  79 }
  80
  81 void
  82 dump_eval()
  83 {
  84     register I32 i;
  85     register GV *gv;
  86     register HE *entry;
  87
  88     dump_op(eval_root);
  89 }
  90
  91 void
  92 dump_op(op)
  93 register OP *op;
  94 {
  95     SV *tmpsv;
  96
  97     dump("{\n");
  98     if (op->op_seq)
  99         fprintf(stderr, "%-4d", op->op_seq);
 100     else
 101         fprintf(stderr, "    ");
 102     dump("TYPE = %s  ===> ", op_name[op->op_type]);
 103     if (op->op_next) {
 104         if (op->op_seq)
 105             fprintf(stderr, "%d\n", op->op_next->op_seq);
 106         else
 107             fprintf(stderr, "(%d)\n", op->op_next->op_seq);
 108     }
 109     else
 110         fprintf(stderr, "DONE\n");
 111     dumplvl++;
 112     if (op->op_targ) {
 113         if (op->op_type == OP_NULL)
 114             dump("  (was %s)\n", op_name[op->op_targ]);
 115         else
 116             dump("TARG = %d\n", op->op_targ);
 117     }
 118 #ifdef NOTDEF
 119     dump("ADDR = 0x%lx => 0x%lx\n",op, op->op_next);
 120 #endif
 121     if (op->op_flags) {
 122         *buf = '\0';
 123         if (op->op_flags & OPf_KNOW) {
 124             if (op->op_flags & OPf_LIST)
 125                 (void)strcat(buf,"LIST,");
 126             else
 127                 (void)strcat(buf,"SCALAR,");
 128         }
 129         else
 130             (void)strcat(buf,"UNKNOWN,");
 131         if (op->op_flags & OPf_KIDS)
 132             (void)strcat(buf,"KIDS,");
 133         if (op->op_flags & OPf_PARENS)
 134             (void)strcat(buf,"PARENS,");
 135         if (op->op_flags & OPf_STACKED)
 136             (void)strcat(buf,"STACKED,");
 137         if (op->op_flags & OPf_LVAL)
 138             (void)strcat(buf,"LVAL,");
 139         if (op->op_flags & OPf_INTRO)
 140             (void)strcat(buf,"INTRO,");
 141         if (op->op_flags & OPf_SPECIAL)
 142             (void)strcat(buf,"SPECIAL,");
 143         if (*buf)
 144             buf[strlen(buf)-1] = '\0';
 145         dump("FLAGS = (%s)\n",buf);
 146     }
 147     if (op->op_private) {
 148         *buf = '\0';
 149         if (op->op_type == OP_AASSIGN) {
 150             if (op->op_private & OPpASSIGN_COMMON)
 151                 (void)strcat(buf,"COMMON,");
 152         }
 153         else if (op->op_type == OP_TRANS) {
 154             if (op->op_private & OPpTRANS_SQUASH)
 155                 (void)strcat(buf,"SQUASH,");
 156             if (op->op_private & OPpTRANS_DELETE)
 157                 (void)strcat(buf,"DELETE,");
 158             if (op->op_private & OPpTRANS_COMPLEMENT)
 159                 (void)strcat(buf,"COMPLEMENT,");
 160         }
 161         else if (op->op_type == OP_REPEAT) {
 162             if (op->op_private & OPpREPEAT_DOLIST)
 163                 (void)strcat(buf,"DOLIST,");
 164         }
 165         else if (op->op_type == OP_ENTERSUBR) {
 166             if (op->op_private & OPpSUBR_DB)
 167                 (void)strcat(buf,"DB,");
 168         }
 169         else if (op->op_type == OP_CONST) {
 170             if (op->op_private & OPpCONST_BARE)
 171                 (void)strcat(buf,"BARE,");
 172         }
 173         else if (op->op_type == OP_FLIP) {
 174             if (op->op_private & OPpFLIP_LINENUM)
 175                 (void)strcat(buf,"LINENUM,");
 176         }
 177         else if (op->op_type == OP_FLOP) {
 178             if (op->op_private & OPpFLIP_LINENUM)
 179                 (void)strcat(buf,"LINENUM,");
 180         }
 181         if (*buf) {
 182             buf[strlen(buf)-1] = '\0';
 183             dump("PRIVATE = (%s)\n",buf);
 184         }
 185     }
 186
 187     switch (op->op_type) {
 188     case OP_GVSV:
 189     case OP_GV:
 190         if (cGVOP->op_gv) {
 191             ENTER;
 192             tmpsv = NEWSV(0,0);
 193             SAVEFREESV(tmpsv);
 194             gv_fullname(tmpsv,cGVOP->op_gv);
 195             dump("GV = %s\n", SvPV(tmpsv, na));
 196             LEAVE;
 197         }
 198         else
 199             dump("GV = NULL\n");
 200         break;
 201     case OP_CONST:
 202         dump("SV = %s\n", SvPEEK(cSVOP->op_sv));
 203         break;
 204     case OP_NEXTSTATE:
 205     case OP_DBSTATE:
 206         if (cCOP->cop_line)
 207             dump("LINE = %d\n",cCOP->cop_line);
 208         if (cCOP->cop_label)
 209             dump("LABEL = \"%s\"\n",cCOP->cop_label);
 210         break;
 211     case OP_ENTERLOOP:
 212         dump("REDO ===> ");
 213         if (cLOOP->op_redoop)
 214             fprintf(stderr, "%d\n", cLOOP->op_redoop->op_seq);
 215         else
 216             fprintf(stderr, "DONE\n");
 217         dump("NEXT ===> ");
 218         if (cLOOP->op_nextop)
 219             fprintf(stderr, "%d\n", cLOOP->op_nextop->op_seq);
 220         else
 221             fprintf(stderr, "DONE\n");
 222         dump("LAST ===> ");
 223         if (cLOOP->op_lastop)
 224             fprintf(stderr, "%d\n", cLOOP->op_lastop->op_seq);
 225         else
 226             fprintf(stderr, "DONE\n");
 227         break;
 228     case OP_COND_EXPR:
 229         dump("TRUE ===> ");
 230         if (cCONDOP->op_true)
 231             fprintf(stderr, "%d\n", cCONDOP->op_true->op_seq);
 232         else
 233             fprintf(stderr, "DONE\n");
 234         dump("FALSE ===> ");
 235         if (cCONDOP->op_false)
 236             fprintf(stderr, "%d\n", cCONDOP->op_false->op_seq);
 237         else
 238             fprintf(stderr, "DONE\n");
 239         break;
 240     case OP_GREPWHILE:
 241     case OP_OR:
 242     case OP_AND:
 243     case OP_METHOD:
 244         dump("OTHER ===> ");
 245         if (cLOGOP->op_other)
 246             fprintf(stderr, "%d\n", cLOGOP->op_other->op_seq);
 247         else
 248             fprintf(stderr, "DONE\n");
 249         break;
 250     case OP_PUSHRE:
 251     case OP_MATCH:
 252     case OP_SUBST:
 253         dump_pm((PMOP*)op);
 254         break;
 255     }
 256     if (op->op_flags & OPf_KIDS) {
 257         OP *kid;
 258         for (kid = cUNOP->op_first; kid; kid = kid->op_sibling)
 259             dump_op(kid);
 260     }
 261     dumplvl--;
 262     dump("}\n");
 263 }
 264
 265 void
 266 dump_gv(gv)
 267 register GV *gv;
 268 {
 269     SV *sv;
 270
 271     if (!gv) {
 272         fprintf(stderr,"{}\n");
 273         return;
 274     }
 275     sv = sv_newmortal();
 276     dumplvl++;
 277     fprintf(stderr,"{\n");
 278     gv_fullname(sv,gv);
 279     dump("GV_NAME = %s", SvPVX(sv));
 280     if (gv != GvEGV(gv)) {
 281         gv_efullname(sv,GvEGV(gv));
 282         dump("-> %s", SvPVX(sv));
 283     }
 284     dump("\n");
 285     dumplvl--;
 286     dump("}\n");
 287 }
 288
 289 void
 290 dump_pm(pm)
 291 register PMOP *pm;
 292 {
 293     char ch;
 294
 295     if (!pm) {
 296         dump("{}\n");
 297         return;
 298     }
 299     dump("{\n");
 300     dumplvl++;
 301     if (pm->op_pmflags & PMf_ONCE)
 302         ch = '?';
 303     else
 304         ch = '/';
 305     if (pm->op_pmregexp)
 306         dump("PMf_PRE %c%s%c\n",ch,pm->op_pmregexp->precomp,ch);
 307     if (pm->op_type != OP_PUSHRE && pm->op_pmreplroot) {
 308         dump("PMf_REPL = ");
 309         dump_op(pm->op_pmreplroot);
 310     }
 311     if (pm->op_pmshort) {
 312         dump("PMf_SHORT = %s\n",SvPEEK(pm->op_pmshort));
 313     }
 314     if (pm->op_pmflags) {
 315         *buf = '\0';
 316         if (pm->op_pmflags & PMf_USED)
 317             (void)strcat(buf,"USED,");
 318         if (pm->op_pmflags & PMf_ONCE)
 319             (void)strcat(buf,"ONCE,");
 320         if (pm->op_pmflags & PMf_SCANFIRST)
 321             (void)strcat(buf,"SCANFIRST,");
 322         if (pm->op_pmflags & PMf_ALL)
 323             (void)strcat(buf,"ALL,");
 324         if (pm->op_pmflags & PMf_SKIPWHITE)
 325             (void)strcat(buf,"SKIPWHITE,");
 326         if (pm->op_pmflags & PMf_FOLD)
 327             (void)strcat(buf,"FOLD,");
 328         if (pm->op_pmflags & PMf_CONST)
 329             (void)strcat(buf,"CONST,");
 330         if (pm->op_pmflags & PMf_KEEP)
 331             (void)strcat(buf,"KEEP,");
 332         if (pm->op_pmflags & PMf_GLOBAL)
 333             (void)strcat(buf,"GLOBAL,");
 334         if (pm->op_pmflags & PMf_RUNTIME)
 335             (void)strcat(buf,"RUNTIME,");
 336         if (pm->op_pmflags & PMf_EVAL)
 337             (void)strcat(buf,"EVAL,");
 338         if (*buf)
 339             buf[strlen(buf)-1] = '\0';
 340         dump("PMFLAGS = (%s)\n",buf);
 341     }
 342
 343     dumplvl--;
 344     dump("}\n");
 345 }
 346
 347 /* VARARGS1 */
 348 static void dump(arg1,arg2,arg3,arg4,arg5)
 349 char *arg1;
 350 long arg2, arg3, arg4, arg5;
 351 {
 352     I32 i;
 353
 354     for (i = dumplvl*4; i; i--)
 355         (void)putc(' ',stderr);
 356     fprintf(stderr,arg1, arg2, arg3, arg4, arg5);
 357 }
 358 #endif