Initial 3-way merge from (5.001m, thr1m, 5.003) plus fixups.
[perl.git] / 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