Commit | Line | Data |
---|---|---|
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 |
28 | void | |
29 | dump_all() | |
30 | { | |
31 | } | |
32 | #else /* Rest of file is for DEBUGGING */ | |
8d063cd8 | 33 | |
8adcabd8 LW |
34 | static void dump(); |
35 | ||
36 | void | |
93a17b20 | 37 | dump_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 | ||
49 | void | |
50 | dump_packsubs(stash) | |
51 | HV* 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 | ||
73 | void | |
93a17b20 LW |
74 | dump_sub(gv) |
75 | GV* 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 | ||
91 | void | |
92 | dump_form(gv) | |
93 | GV* 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 | 105 | void |
79072805 | 106 | dump_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 | ||
115 | void | |
116 | dump_op(op) | |
117 | register 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 | 302 | void |
79072805 LW |
303 | dump_gv(gv) |
304 | register 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 | 326 | void |
79072805 LW |
327 | dump_pm(pm) |
328 | register 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 | 385 | static void dump(arg1,arg2,arg3,arg4,arg5) |
378cc40b LW |
386 | char *arg1; |
387 | long 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 |