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     for (i = 0; i <= HvMAX(stash); i++) {
  48         for (entry = HvARRAY(stash)[i]; entry; entry = entry->hent_next) {
  49             GV *gv = (GV*)entry->hent_val;
  50             HV *hv;
  51             if (GvCV(gv))
  52                 dump_sub(gv);
  53             if (*entry->hent_key == '_' && (hv = GvHV(gv)) && HvNAME(hv) &&
  54               hv != defstash)
  55                 dump_packsubs(hv);              /* nested package */
  56         }
  57     }
  58 }
  59
  60 void
  61 dump_sub(gv)
  62 GV* gv;
  63 {
  64     SV *sv = sv_mortalcopy(&sv_undef);
  65     if (GvCV(gv)) {
  66         gv_fullname(sv,gv);
  67         dump("\nSUB %s = ", SvPVX(sv));
  68         if (CvUSERSUB(GvCV(gv)))
  69             dump("(xsub 0x%x %d)\n",
  70                 (long)CvUSERSUB(GvCV(gv)),
  71                 CvUSERINDEX(GvCV(gv)));
  72         else if (CvROOT(GvCV(gv)))
  73             dump_op(CvROOT(GvCV(gv)));
  74         else
  75             dump("<undef>\n");
  76     }
  77 }
  78
  79 void
  80 dump_eval()
  81 {
  82     register I32 i;
  83     register GV *gv;
  84     register HE *entry;
  85
  86     dump_op(eval_root);
  87 }
  88
  89 void
  90 dump_op(op)
  91 register OP *op;
  92 {
  93     SV *tmpsv;
  94
  95     dump("{\n");
  96     if (op->op_seq)
  97         fprintf(stderr, "%-4d", op->op_seq);
  98     else
  99         fprintf(stderr, "    ");
 100     dump("TYPE = %s  ===> ", op_name[op->op_type]);
 101     if (op->op_next) {
 102         if (op->op_seq)
 103             fprintf(stderr, "%d\n", op->op_next->op_seq);
 104         else
 105             fprintf(stderr, "(%d)\n", op->op_next->op_seq);
 106     }
 107     else
 108         fprintf(stderr, "DONE\n");
 109     dumplvl++;
 110     if (op->op_targ)
 111         dump("TARG = %d\n", op->op_targ);
 112 #ifdef NOTDEF
 113     dump("ADDR = 0x%lx => 0x%lx\n",op, op->op_next);
 114 #endif
 115     if (op->op_flags) {
 116         *buf = '\0';
 117         if (op->op_flags & OPf_KNOW) {
 118             if (op->op_flags & OPf_LIST)
 119                 (void)strcat(buf,"LIST,");
 120             else
 121                 (void)strcat(buf,"SCALAR,");
 122         }
 123         else
 124             (void)strcat(buf,"UNKNOWN,");
 125         if (op->op_flags & OPf_KIDS)
 126             (void)strcat(buf,"KIDS,");
 127         if (op->op_flags & OPf_PARENS)
 128             (void)strcat(buf,"PARENS,");
 129         if (op->op_flags & OPf_STACKED)
 130             (void)strcat(buf,"STACKED,");
 131         if (op->op_flags & OPf_LVAL)
 132             (void)strcat(buf,"LVAL,");
 133         if (op->op_flags & OPf_INTRO)
 134             (void)strcat(buf,"INTRO,");
 135         if (op->op_flags & OPf_SPECIAL)
 136             (void)strcat(buf,"SPECIAL,");
 137         if (*buf)
 138             buf[strlen(buf)-1] = '\0';
 139         dump("FLAGS = (%s)\n",buf);
 140     }
 141     if (op->op_private) {
 142         *buf = '\0';
 143         if (op->op_type == OP_AASSIGN) {
 144             if (op->op_private & OPpASSIGN_COMMON)
 145                 (void)strcat(buf,"COMMON,");
 146         }
 147         else if (op->op_type == OP_TRANS) {
 148             if (op->op_private & OPpTRANS_SQUASH)
 149                 (void)strcat(buf,"SQUASH,");
 150             if (op->op_private & OPpTRANS_DELETE)
 151                 (void)strcat(buf,"DELETE,");
 152             if (op->op_private & OPpTRANS_COMPLEMENT)
 153                 (void)strcat(buf,"COMPLEMENT,");
 154         }
 155         else if (op->op_type == OP_REPEAT) {
 156             if (op->op_private & OPpREPEAT_DOLIST)
 157                 (void)strcat(buf,"DOLIST,");
 158         }
 159         else if (op->op_type == OP_ENTERSUBR) {
 160             if (op->op_private & OPpSUBR_DB)
 161                 (void)strcat(buf,"DB,");
 162         }
 163         else if (op->op_type == OP_CONST) {
 164             if (op->op_private & OPpCONST_BARE)
 165                 (void)strcat(buf,"BARE,");
 166         }
 167         else if (op->op_type == OP_FLIP) {
 168             if (op->op_private & OPpFLIP_LINENUM)
 169                 (void)strcat(buf,"LINENUM,");
 170         }
 171         else if (op->op_type == OP_FLOP) {
 172             if (op->op_private & OPpFLIP_LINENUM)
 173                 (void)strcat(buf,"LINENUM,");
 174         }
 175         if (*buf) {
 176             buf[strlen(buf)-1] = '\0';
 177             dump("PRIVATE = (%s)\n",buf);
 178         }
 179     }
 180
 181     switch (op->op_type) {
 182     case OP_GVSV:
 183     case OP_GV:
 184         if (cGVOP->op_gv) {
 185             tmpsv = NEWSV(0,0);
 186             gv_fullname(tmpsv,cGVOP->op_gv);
 187             dump("GV = %s\n", SvPV(tmpsv, na));
 188             sv_free(tmpsv);
 189         }
 190         else
 191             dump("GV = NULL\n");
 192         break;
 193     case OP_CONST:
 194         dump("SV = %s\n", SvPEEK(cSVOP->op_sv));
 195         break;
 196     case OP_NEXTSTATE:
 197     case OP_DBSTATE:
 198         if (cCOP->cop_line)
 199             dump("LINE = %d\n",cCOP->cop_line);
 200         if (cCOP->cop_label)
 201             dump("LABEL = \"%s\"\n",cCOP->cop_label);
 202         break;
 203     case OP_ENTERLOOP:
 204         dump("REDO ===> ");
 205         if (cLOOP->op_redoop)
 206             fprintf(stderr, "%d\n", cLOOP->op_redoop->op_seq);
 207         else
 208             fprintf(stderr, "DONE\n");
 209         dump("NEXT ===> ");
 210         if (cLOOP->op_nextop)
 211             fprintf(stderr, "%d\n", cLOOP->op_nextop->op_seq);
 212         else
 213             fprintf(stderr, "DONE\n");
 214         dump("LAST ===> ");
 215         if (cLOOP->op_lastop)
 216             fprintf(stderr, "%d\n", cLOOP->op_lastop->op_seq);
 217         else
 218             fprintf(stderr, "DONE\n");
 219         break;
 220     case OP_COND_EXPR:
 221         dump("TRUE ===> ");
 222         if (cCONDOP->op_true)
 223             fprintf(stderr, "%d\n", cCONDOP->op_true->op_seq);
 224         else
 225             fprintf(stderr, "DONE\n");
 226         dump("FALSE ===> ");
 227         if (cCONDOP->op_false)
 228             fprintf(stderr, "%d\n", cCONDOP->op_false->op_seq);
 229         else
 230             fprintf(stderr, "DONE\n");
 231         break;
 232     case OP_GREPWHILE:
 233     case OP_OR:
 234     case OP_AND:
 235     case OP_METHOD:
 236         dump("OTHER ===> ");
 237         if (cLOGOP->op_other)
 238             fprintf(stderr, "%d\n", cLOGOP->op_other->op_seq);
 239         else
 240             fprintf(stderr, "DONE\n");
 241         break;
 242     case OP_PUSHRE:
 243     case OP_MATCH:
 244     case OP_SUBST:
 245         dump_pm((PMOP*)op);
 246         break;
 247     }
 248     if (op->op_flags & OPf_KIDS) {
 249         OP *kid;
 250         for (kid = cUNOP->op_first; kid; kid = kid->op_sibling)
 251             dump_op(kid);
 252     }
 253     dumplvl--;
 254     dump("}\n");
 255 }
 256
 257 void
 258 dump_gv(gv)
 259 register GV *gv;
 260 {
 261     SV *sv;
 262
 263     if (!gv) {
 264         fprintf(stderr,"{}\n");
 265         return;
 266     }
 267     sv = sv_mortalcopy(&sv_undef);
 268     dumplvl++;
 269     fprintf(stderr,"{\n");
 270     gv_fullname(sv,gv);
 271     dump("GV_NAME = %s", SvPVX(sv));
 272     if (gv != GvEGV(gv)) {
 273         gv_efullname(sv,GvEGV(gv));
 274         dump("-> %s", SvPVX(sv));
 275     }
 276     dump("\n");
 277     dumplvl--;
 278     dump("}\n");
 279 }
 280
 281 void
 282 dump_pm(pm)
 283 register PMOP *pm;
 284 {
 285     char ch;
 286
 287     if (!pm) {
 288         dump("{}\n");
 289         return;
 290     }
 291     dump("{\n");
 292     dumplvl++;
 293     if (pm->op_pmflags & PMf_ONCE)
 294         ch = '?';
 295     else
 296         ch = '/';
 297     if (pm->op_pmregexp)
 298         dump("PMf_PRE %c%s%c\n",ch,pm->op_pmregexp->precomp,ch);
 299     if (pm->op_type != OP_PUSHRE && pm->op_pmreplroot) {
 300         dump("PMf_REPL = ");
 301         dump_op(pm->op_pmreplroot);
 302     }
 303     if (pm->op_pmshort) {
 304         dump("PMf_SHORT = %s\n",SvPEEK(pm->op_pmshort));
 305     }
 306     if (pm->op_pmflags) {
 307         *buf = '\0';
 308         if (pm->op_pmflags & PMf_USED)
 309             (void)strcat(buf,"USED,");
 310         if (pm->op_pmflags & PMf_ONCE)
 311             (void)strcat(buf,"ONCE,");
 312         if (pm->op_pmflags & PMf_SCANFIRST)
 313             (void)strcat(buf,"SCANFIRST,");
 314         if (pm->op_pmflags & PMf_ALL)
 315             (void)strcat(buf,"ALL,");
 316         if (pm->op_pmflags & PMf_SKIPWHITE)
 317             (void)strcat(buf,"SKIPWHITE,");
 318         if (pm->op_pmflags & PMf_FOLD)
 319             (void)strcat(buf,"FOLD,");
 320         if (pm->op_pmflags & PMf_CONST)
 321             (void)strcat(buf,"CONST,");
 322         if (pm->op_pmflags & PMf_KEEP)
 323             (void)strcat(buf,"KEEP,");
 324         if (pm->op_pmflags & PMf_GLOBAL)
 325             (void)strcat(buf,"GLOBAL,");
 326         if (pm->op_pmflags & PMf_RUNTIME)
 327             (void)strcat(buf,"RUNTIME,");
 328         if (pm->op_pmflags & PMf_EVAL)
 329             (void)strcat(buf,"EVAL,");
 330         if (*buf)
 331             buf[strlen(buf)-1] = '\0';
 332         dump("PMFLAGS = (%s)\n",buf);
 333     }
 334
 335     dumplvl--;
 336     dump("}\n");
 337 }
 338
 339 /* VARARGS1 */
 340 static void dump(arg1,arg2,arg3,arg4,arg5)
 341 char *arg1;
 342 long arg2, arg3, arg4, arg5;
 343 {
 344     I32 i;
 345
 346     for (i = dumplvl*4; i; i--)
 347         (void)putc(' ',stderr);
 348     fprintf(stderr,arg1, arg2, arg3, arg4, arg5);
 349 }
 350 #endif