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