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