7839ed7828b1e0d79b4ab9e99eeaa709f998e40f
[perl.git] / 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