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