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