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