dump.c

   1 /*    dump.c
   2  *
   3  *    Copyright (c) 1991-1994, 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  */
   9
  10 /*
  11  * "'You have talked long in your sleep, Frodo,' said Gandalf gently, 'and
  12  * it has not been hard for me to read your mind and memory.'"
  13  */
  14
  15 #include "EXTERN.h"
  16 #include "perl.h"
  17
  18 #ifndef DEBUGGING
  19 void
  20 dump_all()
  21 {
  22 }
  23 #else  /* Rest of file is for DEBUGGING */
  24
  25 static void dump();
  26
  27 void
  28 dump_all()
  29 {
  30     dTHR;
  31 #ifdef HAS_SETLINEBUF
  32     setlinebuf(stderr);
  33 #else
  34     setvbuf(stderr, Nullch, _IOLBF, 0);
  35 #endif
  36     if (main_root)
  37         dump_op(main_root);
  38     dump_packsubs(defstash);
  39 }
  40
  41 void
  42 dump_packsubs(stash)
  43 HV* stash;
  44 {
  45     dTHR;
  46     I32 i;
  47     HE  *entry;
  48
  49     if (!HvARRAY(stash))
  50         return;
  51     for (i = 0; i <= (I32) HvMAX(stash); i++) {
  52         for (entry = HvARRAY(stash)[i]; entry; entry = entry->hent_next) {
  53             GV *gv = (GV*)entry->hent_val;
  54             HV *hv;
  55             if (GvCV(gv))
  56                 dump_sub(gv);
  57             if (GvFORM(gv))
  58                 dump_form(gv);
  59             if (entry->hent_key[entry->hent_klen-1] == ':' &&
  60               (hv = GvHV(gv)) && HvNAME(hv) && hv != defstash)
  61                 dump_packsubs(hv);              /* nested package */
  62         }
  63     }
  64 }
  65
  66 void
  67 dump_sub(gv)
  68 GV* gv;
  69 {
  70     SV *sv = sv_newmortal();
  71
  72     gv_fullname(sv,gv);
  73     dump("\nSUB %s = ", SvPVX(sv));
  74     if (CvXSUB(GvCV(gv)))
  75         dump("(xsub 0x%x %d)\n",
  76             (long)CvXSUB(GvCV(gv)),
  77             CvXSUBANY(GvCV(gv)).any_i32);
  78     else if (CvROOT(GvCV(gv)))
  79         dump_op(CvROOT(GvCV(gv)));
  80     else
  81         dump("<undef>\n");
  82 }
  83
  84 void
  85 dump_form(gv)
  86 GV* gv;
  87 {
  88     SV *sv = sv_newmortal();
  89
  90     gv_fullname(sv,gv);
  91     dump("\nFORMAT %s = ", SvPVX(sv));
  92     if (CvROOT(GvFORM(gv)))
  93         dump_op(CvROOT(GvFORM(gv)));
  94     else
  95         dump("<undef>\n");
  96 }
  97
  98 void
  99 dump_eval()
 100 {
 101     dump_op(eval_root);
 102 }
 103
 104 void
 105 dump_op(o)
 106 register OP *o;
 107 {
 108     SV *tmpsv;
 109
 110     dump("{\n");
 111     if (o->op_seq)
 112         fprintf(stderr, "%-4d", o->op_seq);
 113     else
 114         fprintf(stderr, "    ");
 115     dump("TYPE = %s  ===> ", op_name[o->op_type]);
 116     if (o->op_next) {
 117         if (o->op_seq)
 118             fprintf(stderr, "%d\n", o->op_next->op_seq);
 119         else
 120             fprintf(stderr, "(%d)\n", o->op_next->op_seq);
 121     }
 122     else
 123         fprintf(stderr, "DONE\n");
 124     dumplvl++;
 125     if (o->op_targ) {
 126         if (o->op_type == OP_NULL)
 127             dump("  (was %s)\n", op_name[o->op_targ]);
 128         else
 129             dump("TARG = %d\n", o->op_targ);
 130     }
 131 #ifdef DUMPADDR
 132     dump("ADDR = 0x%lx => 0x%lx\n",o, o->op_next);
 133 #endif
 134     if (o->op_flags) {
 135         *buf = '\0';
 136         if (o->op_flags & OPf_KNOW) {
 137             if (o->op_flags & OPf_LIST)
 138                 (void)strcat(buf,"LIST,");
 139             else
 140                 (void)strcat(buf,"SCALAR,");
 141         }
 142         else
 143             (void)strcat(buf,"UNKNOWN,");
 144         if (o->op_flags & OPf_KIDS)
 145             (void)strcat(buf,"KIDS,");
 146         if (o->op_flags & OPf_PARENS)
 147             (void)strcat(buf,"PARENS,");
 148         if (o->op_flags & OPf_STACKED)
 149             (void)strcat(buf,"STACKED,");
 150         if (o->op_flags & OPf_REF)
 151             (void)strcat(buf,"REF,");
 152         if (o->op_flags & OPf_MOD)
 153             (void)strcat(buf,"MOD,");
 154         if (o->op_flags & OPf_SPECIAL)
 155             (void)strcat(buf,"SPECIAL,");
 156         if (*buf)
 157             buf[strlen(buf)-1] = '\0';
 158         dump("FLAGS = (%s)\n",buf);
 159     }
 160     if (o->op_private) {
 161         *buf = '\0';
 162         if (o->op_type == OP_AASSIGN) {
 163             if (o->op_private & OPpASSIGN_COMMON)
 164                 (void)strcat(buf,"COMMON,");
 165         }
 166         else if (o->op_type == OP_SASSIGN) {
 167             if (o->op_private & OPpASSIGN_BACKWARDS)
 168                 (void)strcat(buf,"BACKWARDS,");
 169         }
 170         else if (o->op_type == OP_TRANS) {
 171             if (o->op_private & OPpTRANS_SQUASH)
 172                 (void)strcat(buf,"SQUASH,");
 173             if (o->op_private & OPpTRANS_DELETE)
 174                 (void)strcat(buf,"DELETE,");
 175             if (o->op_private & OPpTRANS_COMPLEMENT)
 176                 (void)strcat(buf,"COMPLEMENT,");
 177         }
 178         else if (o->op_type == OP_REPEAT) {
 179             if (o->op_private & OPpREPEAT_DOLIST)
 180                 (void)strcat(buf,"DOLIST,");
 181         }
 182         else if (o->op_type == OP_ENTERSUB ||
 183                  o->op_type == OP_RV2SV ||
 184                  o->op_type == OP_RV2AV ||
 185                  o->op_type == OP_RV2HV ||
 186                  o->op_type == OP_RV2GV ||
 187                  o->op_type == OP_AELEM ||
 188                  o->op_type == OP_HELEM )
 189         {
 190             if (o->op_private & OPpENTERSUB_AMPER)
 191                 (void)strcat(buf,"AMPER,");
 192             if (o->op_private & OPpENTERSUB_DB)
 193                 (void)strcat(buf,"DB,");
 194             if (o->op_private & OPpDEREF_AV)
 195                 (void)strcat(buf,"AV,");
 196             if (o->op_private & OPpDEREF_HV)
 197                 (void)strcat(buf,"HV,");
 198             if (o->op_private & HINT_STRICT_REFS)
 199                 (void)strcat(buf,"STRICT_REFS,");
 200         }
 201         else if (o->op_type == OP_CONST) {
 202             if (o->op_private & OPpCONST_BARE)
 203                 (void)strcat(buf,"BARE,");
 204         }
 205         else if (o->op_type == OP_FLIP) {
 206             if (o->op_private & OPpFLIP_LINENUM)
 207                 (void)strcat(buf,"LINENUM,");
 208         }
 209         else if (o->op_type == OP_FLOP) {
 210             if (o->op_private & OPpFLIP_LINENUM)
 211                 (void)strcat(buf,"LINENUM,");
 212         }
 213         if (o->op_flags & OPf_MOD && o->op_private & OPpLVAL_INTRO)
 214             (void)strcat(buf,"INTRO,");
 215         if (*buf) {
 216             buf[strlen(buf)-1] = '\0';
 217             dump("PRIVATE = (%s)\n",buf);
 218         }
 219     }
 220
 221     switch (o->op_type) {
 222     case OP_GVSV:
 223     case OP_GV:
 224         if (cGVOPo->op_gv) {
 225             ENTER;
 226             tmpsv = NEWSV(0,0);
 227             SAVEFREESV(tmpsv);
 228             gv_fullname(tmpsv,cGVOPo->op_gv);
 229             dump("GV = %s\n", SvPV(tmpsv, na));
 230             LEAVE;
 231         }
 232         else
 233             dump("GV = NULL\n");
 234         break;
 235     case OP_CONST:
 236         dump("SV = %s\n", SvPEEK(cSVOPo->op_sv));
 237         break;
 238     case OP_NEXTSTATE:
 239     case OP_DBSTATE:
 240         if (cCOPo->cop_line)
 241             dump("LINE = %d\n",cCOPo->cop_line);
 242         if (cCOPo->cop_label)
 243             dump("LABEL = \"%s\"\n",cCOPo->cop_label);
 244         break;
 245     case OP_ENTERLOOP:
 246         dump("REDO ===> ");
 247         if (cLOOPo->op_redoop)
 248             fprintf(stderr, "%d\n", cLOOPo->op_redoop->op_seq);
 249         else
 250             fprintf(stderr, "DONE\n");
 251         dump("NEXT ===> ");
 252         if (cLOOPo->op_nextop)
 253             fprintf(stderr, "%d\n", cLOOPo->op_nextop->op_seq);
 254         else
 255             fprintf(stderr, "DONE\n");
 256         dump("LAST ===> ");
 257         if (cLOOPo->op_lastop)
 258             fprintf(stderr, "%d\n", cLOOPo->op_lastop->op_seq);
 259         else
 260             fprintf(stderr, "DONE\n");
 261         break;
 262     case OP_COND_EXPR:
 263         dump("TRUE ===> ");
 264         if (cCONDOPo->op_true)
 265             fprintf(stderr, "%d\n", cCONDOPo->op_true->op_seq);
 266         else
 267             fprintf(stderr, "DONE\n");
 268         dump("FALSE ===> ");
 269         if (cCONDOPo->op_false)
 270             fprintf(stderr, "%d\n", cCONDOPo->op_false->op_seq);
 271         else
 272             fprintf(stderr, "DONE\n");
 273         break;
 274     case OP_MAPWHILE:
 275     case OP_GREPWHILE:
 276     case OP_OR:
 277     case OP_AND:
 278         dump("OTHER ===> ");
 279         if (cLOGOPo->op_other)
 280             fprintf(stderr, "%d\n", cLOGOPo->op_other->op_seq);
 281         else
 282             fprintf(stderr, "DONE\n");
 283         break;
 284     case OP_PUSHRE:
 285     case OP_MATCH:
 286     case OP_SUBST:
 287         dump_pm(cPMOPo);
 288         break;
 289     default:
 290         break;
 291     }
 292     if (o->op_flags & OPf_KIDS) {
 293         OP *kid;
 294         for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
 295             dump_op(kid);
 296     }
 297     dumplvl--;
 298     dump("}\n");
 299 }
 300
 301 void
 302 dump_gv(gv)
 303 register GV *gv;
 304 {
 305     SV *sv;
 306
 307     if (!gv) {
 308         fprintf(stderr,"{}\n");
 309         return;
 310     }
 311     sv = sv_newmortal();
 312     dumplvl++;
 313     fprintf(stderr,"{\n");
 314     gv_fullname(sv,gv);
 315     dump("GV_NAME = %s", SvPVX(sv));
 316     if (gv != GvEGV(gv)) {
 317         gv_efullname(sv,GvEGV(gv));
 318         dump("-> %s", SvPVX(sv));
 319     }
 320     dump("\n");
 321     dumplvl--;
 322     dump("}\n");
 323 }
 324
 325 void
 326 dump_pm(pm)
 327 register PMOP *pm;
 328 {
 329     char ch;
 330
 331     if (!pm) {
 332         dump("{}\n");
 333         return;
 334     }
 335     dump("{\n");
 336     dumplvl++;
 337     if (pm->op_pmflags & PMf_ONCE)
 338         ch = '?';
 339     else
 340         ch = '/';
 341     if (pm->op_pmregexp)
 342         dump("PMf_PRE %c%s%c\n",ch,pm->op_pmregexp->precomp,ch);
 343     if (pm->op_type != OP_PUSHRE && pm->op_pmreplroot) {
 344         dump("PMf_REPL = ");
 345         dump_op(pm->op_pmreplroot);
 346     }
 347     if (pm->op_pmshort) {
 348         dump("PMf_SHORT = %s\n",SvPEEK(pm->op_pmshort));
 349     }
 350     if (pm->op_pmflags) {
 351         *buf = '\0';
 352         if (pm->op_pmflags & PMf_USED)
 353             (void)strcat(buf,"USED,");
 354         if (pm->op_pmflags & PMf_ONCE)
 355             (void)strcat(buf,"ONCE,");
 356         if (pm->op_pmflags & PMf_SCANFIRST)
 357             (void)strcat(buf,"SCANFIRST,");
 358         if (pm->op_pmflags & PMf_ALL)
 359             (void)strcat(buf,"ALL,");
 360         if (pm->op_pmflags & PMf_SKIPWHITE)
 361             (void)strcat(buf,"SKIPWHITE,");
 362         if (pm->op_pmflags & PMf_FOLD)
 363             (void)strcat(buf,"FOLD,");
 364         if (pm->op_pmflags & PMf_CONST)
 365             (void)strcat(buf,"CONST,");
 366         if (pm->op_pmflags & PMf_KEEP)
 367             (void)strcat(buf,"KEEP,");
 368         if (pm->op_pmflags & PMf_GLOBAL)
 369             (void)strcat(buf,"GLOBAL,");
 370         if (pm->op_pmflags & PMf_RUNTIME)
 371             (void)strcat(buf,"RUNTIME,");
 372         if (pm->op_pmflags & PMf_EVAL)
 373             (void)strcat(buf,"EVAL,");
 374         if (*buf)
 375             buf[strlen(buf)-1] = '\0';
 376         dump("PMFLAGS = (%s)\n",buf);
 377     }
 378
 379     dumplvl--;
 380     dump("}\n");
 381 }
 382
 383 /* VARARGS1 */
 384 static void dump(arg1,arg2,arg3,arg4,arg5)
 385 char *arg1;
 386 long arg2, arg3, arg4, arg5;
 387 {
 388     I32 i;
 389
 390     for (i = dumplvl*4; i; i--)
 391         (void)putc(' ',stderr);
 392     fprintf(stderr,arg1, arg2, arg3, arg4, arg5);
 393 }
 394 #endif