[win32] integrate mainline
[p5sagit/p5-mst-13.2.git] / dump.c
CommitLineData
a0d0e21e 1/* dump.c
a687059c 2 *
9607fc9c 3 * Copyright (c) 1991-1997, 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 *
a0d0e21e 8 */
9
10/*
11 * "'You have talked long in your sleep, Frodo,' said Gandalf gently, 'and
12 * it has not been hard for me to read your mind and memory.'"
8d063cd8 13 */
14
8d063cd8 15#include "EXTERN.h"
8d063cd8 16#include "perl.h"
17
2304df62 18#ifndef DEBUGGING
19void
8ac85365 20dump_all(void)
2304df62 21{
22}
23#else /* Rest of file is for DEBUGGING */
8d063cd8 24
4db58590 25#ifdef I_STDARG
26static void dump(char *pat, ...);
27#else
8adcabd8 28static void dump();
4db58590 29#endif
8adcabd8 30
31void
8ac85365 32dump_all(void)
79072805 33{
11343788 34 dTHR;
760ac839 35 PerlIO_setlinebuf(Perl_debug_log);
93a17b20 36 if (main_root)
37 dump_op(main_root);
463ee0b2 38 dump_packsubs(defstash);
39}
40
41void
8ac85365 42dump_packsubs(HV *stash)
463ee0b2 43{
11343788 44 dTHR;
a0d0e21e 45 I32 i;
463ee0b2 46 HE *entry;
47
8990e307 48 if (!HvARRAY(stash))
49 return;
a0d0e21e 50 for (i = 0; i <= (I32) HvMAX(stash); i++) {
4db58590 51 for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
52 GV *gv = (GV*)HeVAL(entry);
463ee0b2 53 HV *hv;
8ebc5c01 54 if (GvCVu(gv))
463ee0b2 55 dump_sub(gv);
85e6fe83 56 if (GvFORM(gv))
57 dump_form(gv);
4db58590 58 if (HeKEY(entry)[HeKLEN(entry)-1] == ':' &&
a0d0e21e 59 (hv = GvHV(gv)) && HvNAME(hv) && hv != defstash)
463ee0b2 60 dump_packsubs(hv); /* nested package */
61 }
79072805 62 }
63}
64
65void
8ac85365 66dump_sub(GV *gv)
a687059c 67{
8990e307 68 SV *sv = sv_newmortal();
85e6fe83 69
f6aff53a 70 gv_fullname3(sv, gv, Nullch);
85e6fe83 71 dump("\nSUB %s = ", SvPVX(sv));
a0d0e21e 72 if (CvXSUB(GvCV(gv)))
85e6fe83 73 dump("(xsub 0x%x %d)\n",
a0d0e21e 74 (long)CvXSUB(GvCV(gv)),
75 CvXSUBANY(GvCV(gv)).any_i32);
85e6fe83 76 else if (CvROOT(GvCV(gv)))
77 dump_op(CvROOT(GvCV(gv)));
78 else
79 dump("<undef>\n");
80}
81
82void
8ac85365 83dump_form(GV *gv)
85e6fe83 84{
85 SV *sv = sv_newmortal();
86
f6aff53a 87 gv_fullname3(sv, gv, Nullch);
85e6fe83 88 dump("\nFORMAT %s = ", SvPVX(sv));
89 if (CvROOT(GvFORM(gv)))
90 dump_op(CvROOT(GvFORM(gv)));
91 else
92 dump("<undef>\n");
a687059c 93}
94
8adcabd8 95void
8ac85365 96dump_eval(void)
8d063cd8 97{
79072805 98 dump_op(eval_root);
99}
100
101void
8ac85365 102dump_op(OP *o)
79072805 103{
79072805 104 dump("{\n");
11343788 105 if (o->op_seq)
5dc0d613 106 PerlIO_printf(Perl_debug_log, "%-4d", o->op_seq);
93a17b20 107 else
760ac839 108 PerlIO_printf(Perl_debug_log, " ");
11343788 109 dump("TYPE = %s ===> ", op_name[o->op_type]);
110 if (o->op_next) {
111 if (o->op_seq)
5dc0d613 112 PerlIO_printf(Perl_debug_log, "%d\n", o->op_next->op_seq);
93a17b20 113 else
5dc0d613 114 PerlIO_printf(Perl_debug_log, "(%d)\n", o->op_next->op_seq);
93a17b20 115 }
79072805 116 else
760ac839 117 PerlIO_printf(Perl_debug_log, "DONE\n");
79072805 118 dumplvl++;
11343788 119 if (o->op_targ) {
120 if (o->op_type == OP_NULL)
121 dump(" (was %s)\n", op_name[o->op_targ]);
8990e307 122 else
11343788 123 dump("TARG = %d\n", o->op_targ);
8990e307 124 }
748a9306 125#ifdef DUMPADDR
11343788 126 dump("ADDR = 0x%lx => 0x%lx\n",o, o->op_next);
79072805 127#endif
11343788 128 if (o->op_flags) {
46fc3d4c 129 SV *tmpsv = newSVpv("", 0);
5dc0d613 130 switch (o->op_flags & OPf_WANT) {
54310121 131 case OPf_WANT_VOID:
46fc3d4c 132 sv_catpv(tmpsv, ",VOID");
54310121 133 break;
134 case OPf_WANT_SCALAR:
46fc3d4c 135 sv_catpv(tmpsv, ",SCALAR");
54310121 136 break;
137 case OPf_WANT_LIST:
46fc3d4c 138 sv_catpv(tmpsv, ",LIST");
54310121 139 break;
140 default:
46fc3d4c 141 sv_catpv(tmpsv, ",UNKNOWN");
54310121 142 break;
143 }
11343788 144 if (o->op_flags & OPf_KIDS)
46fc3d4c 145 sv_catpv(tmpsv, ",KIDS");
11343788 146 if (o->op_flags & OPf_PARENS)
46fc3d4c 147 sv_catpv(tmpsv, ",PARENS");
11343788 148 if (o->op_flags & OPf_STACKED)
46fc3d4c 149 sv_catpv(tmpsv, ",STACKED");
11343788 150 if (o->op_flags & OPf_REF)
46fc3d4c 151 sv_catpv(tmpsv, ",REF");
11343788 152 if (o->op_flags & OPf_MOD)
46fc3d4c 153 sv_catpv(tmpsv, ",MOD");
11343788 154 if (o->op_flags & OPf_SPECIAL)
46fc3d4c 155 sv_catpv(tmpsv, ",SPECIAL");
156 dump("FLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
157 SvREFCNT_dec(tmpsv);
79072805 158 }
11343788 159 if (o->op_private) {
46fc3d4c 160 SV *tmpsv = newSVpv("", 0);
11343788 161 if (o->op_type == OP_AASSIGN) {
162 if (o->op_private & OPpASSIGN_COMMON)
46fc3d4c 163 sv_catpv(tmpsv, ",COMMON");
8d063cd8 164 }
11343788 165 else if (o->op_type == OP_SASSIGN) {
166 if (o->op_private & OPpASSIGN_BACKWARDS)
46fc3d4c 167 sv_catpv(tmpsv, ",BACKWARDS");
a0d0e21e 168 }
11343788 169 else if (o->op_type == OP_TRANS) {
170 if (o->op_private & OPpTRANS_SQUASH)
46fc3d4c 171 sv_catpv(tmpsv, ",SQUASH");
11343788 172 if (o->op_private & OPpTRANS_DELETE)
46fc3d4c 173 sv_catpv(tmpsv, ",DELETE");
11343788 174 if (o->op_private & OPpTRANS_COMPLEMENT)
46fc3d4c 175 sv_catpv(tmpsv, ",COMPLEMENT");
8d063cd8 176 }
11343788 177 else if (o->op_type == OP_REPEAT) {
178 if (o->op_private & OPpREPEAT_DOLIST)
46fc3d4c 179 sv_catpv(tmpsv, ",DOLIST");
8d063cd8 180 }
11343788 181 else if (o->op_type == OP_ENTERSUB ||
182 o->op_type == OP_RV2SV ||
183 o->op_type == OP_RV2AV ||
184 o->op_type == OP_RV2HV ||
185 o->op_type == OP_RV2GV ||
186 o->op_type == OP_AELEM ||
187 o->op_type == OP_HELEM )
85e6fe83 188 {
5dc0d613 189 if (o->op_type == OP_ENTERSUB) {
190 if (o->op_private & OPpENTERSUB_AMPER)
46fc3d4c 191 sv_catpv(tmpsv, ",AMPER");
5dc0d613 192 if (o->op_private & OPpENTERSUB_DB)
46fc3d4c 193 sv_catpv(tmpsv, ",DB");
68dc0745 194 }
5dc0d613 195 switch (o->op_private & OPpDEREF) {
5f05dabc 196 case OPpDEREF_SV:
46fc3d4c 197 sv_catpv(tmpsv, ",SV");
5f05dabc 198 break;
199 case OPpDEREF_AV:
46fc3d4c 200 sv_catpv(tmpsv, ",AV");
5f05dabc 201 break;
202 case OPpDEREF_HV:
46fc3d4c 203 sv_catpv(tmpsv, ",HV");
5f05dabc 204 break;
205 }
5dc0d613 206 if (o->op_type == OP_AELEM || o->op_type == OP_HELEM) {
207 if (o->op_private & OPpLVAL_DEFER)
46fc3d4c 208 sv_catpv(tmpsv, ",LVAL_DEFER");
68dc0745 209 }
210 else {
5dc0d613 211 if (o->op_private & HINT_STRICT_REFS)
46fc3d4c 212 sv_catpv(tmpsv, ",STRICT_REFS");
68dc0745 213 }
8d063cd8 214 }
11343788 215 else if (o->op_type == OP_CONST) {
216 if (o->op_private & OPpCONST_BARE)
46fc3d4c 217 sv_catpv(tmpsv, ",BARE");
79072805 218 }
11343788 219 else if (o->op_type == OP_FLIP) {
220 if (o->op_private & OPpFLIP_LINENUM)
46fc3d4c 221 sv_catpv(tmpsv, ",LINENUM");
79072805 222 }
11343788 223 else if (o->op_type == OP_FLOP) {
224 if (o->op_private & OPpFLIP_LINENUM)
46fc3d4c 225 sv_catpv(tmpsv, ",LINENUM");
79072805 226 }
11343788 227 if (o->op_flags & OPf_MOD && o->op_private & OPpLVAL_INTRO)
46fc3d4c 228 sv_catpv(tmpsv, ",INTRO");
229 if (SvCUR(tmpsv))
230 dump("PRIVATE = (%s)\n", SvPVX(tmpsv) + 1);
231 SvREFCNT_dec(tmpsv);
8d063cd8 232 }
8d063cd8 233
11343788 234 switch (o->op_type) {
93a17b20 235 case OP_GVSV:
79072805 236 case OP_GV:
11343788 237 if (cGVOPo->op_gv) {
46fc3d4c 238 SV *tmpsv = NEWSV(0,0);
8990e307 239 ENTER;
8990e307 240 SAVEFREESV(tmpsv);
5dc0d613 241 gv_fullname3(tmpsv, cGVOPo->op_gv, Nullch);
463ee0b2 242 dump("GV = %s\n", SvPV(tmpsv, na));
8990e307 243 LEAVE;
378cc40b 244 }
79072805 245 else
246 dump("GV = NULL\n");
247 break;
248 case OP_CONST:
11343788 249 dump("SV = %s\n", SvPEEK(cSVOPo->op_sv));
79072805 250 break;
93a17b20 251 case OP_NEXTSTATE:
252 case OP_DBSTATE:
11343788 253 if (cCOPo->cop_line)
254 dump("LINE = %d\n",cCOPo->cop_line);
255 if (cCOPo->cop_label)
256 dump("LABEL = \"%s\"\n",cCOPo->cop_label);
79072805 257 break;
258 case OP_ENTERLOOP:
259 dump("REDO ===> ");
11343788 260 if (cLOOPo->op_redoop)
5dc0d613 261 PerlIO_printf(Perl_debug_log, "%d\n", cLOOPo->op_redoop->op_seq);
79072805 262 else
760ac839 263 PerlIO_printf(Perl_debug_log, "DONE\n");
79072805 264 dump("NEXT ===> ");
11343788 265 if (cLOOPo->op_nextop)
5dc0d613 266 PerlIO_printf(Perl_debug_log, "%d\n", cLOOPo->op_nextop->op_seq);
79072805 267 else
760ac839 268 PerlIO_printf(Perl_debug_log, "DONE\n");
79072805 269 dump("LAST ===> ");
11343788 270 if (cLOOPo->op_lastop)
5dc0d613 271 PerlIO_printf(Perl_debug_log, "%d\n", cLOOPo->op_lastop->op_seq);
79072805 272 else
760ac839 273 PerlIO_printf(Perl_debug_log, "DONE\n");
79072805 274 break;
275 case OP_COND_EXPR:
276 dump("TRUE ===> ");
11343788 277 if (cCONDOPo->op_true)
5dc0d613 278 PerlIO_printf(Perl_debug_log, "%d\n", cCONDOPo->op_true->op_seq);
79072805 279 else
760ac839 280 PerlIO_printf(Perl_debug_log, "DONE\n");
79072805 281 dump("FALSE ===> ");
11343788 282 if (cCONDOPo->op_false)
5dc0d613 283 PerlIO_printf(Perl_debug_log, "%d\n", cCONDOPo->op_false->op_seq);
79072805 284 else
760ac839 285 PerlIO_printf(Perl_debug_log, "DONE\n");
79072805 286 break;
a0d0e21e 287 case OP_MAPWHILE:
79072805 288 case OP_GREPWHILE:
289 case OP_OR:
290 case OP_AND:
79072805 291 dump("OTHER ===> ");
11343788 292 if (cLOGOPo->op_other)
5dc0d613 293 PerlIO_printf(Perl_debug_log, "%d\n", cLOGOPo->op_other->op_seq);
79072805 294 else
760ac839 295 PerlIO_printf(Perl_debug_log, "DONE\n");
79072805 296 break;
297 case OP_PUSHRE:
298 case OP_MATCH:
299 case OP_SUBST:
11343788 300 dump_pm(cPMOPo);
79072805 301 break;
a0d0e21e 302 default:
303 break;
79072805 304 }
11343788 305 if (o->op_flags & OPf_KIDS) {
79072805 306 OP *kid;
11343788 307 for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
79072805 308 dump_op(kid);
8d063cd8 309 }
310 dumplvl--;
311 dump("}\n");
312}
313
8adcabd8 314void
8ac85365 315dump_gv(GV *gv)
378cc40b 316{
79072805 317 SV *sv;
378cc40b 318
79072805 319 if (!gv) {
760ac839 320 PerlIO_printf(Perl_debug_log, "{}\n");
378cc40b 321 return;
322 }
8990e307 323 sv = sv_newmortal();
8d063cd8 324 dumplvl++;
760ac839 325 PerlIO_printf(Perl_debug_log, "{\n");
f6aff53a 326 gv_fullname3(sv, gv, Nullch);
463ee0b2 327 dump("GV_NAME = %s", SvPVX(sv));
79072805 328 if (gv != GvEGV(gv)) {
f6aff53a 329 gv_efullname3(sv, GvEGV(gv), Nullch);
463ee0b2 330 dump("-> %s", SvPVX(sv));
8adcabd8 331 }
332 dump("\n");
8d063cd8 333 dumplvl--;
334 dump("}\n");
335}
336
8adcabd8 337void
8ac85365 338dump_pm(PMOP *pm)
8d063cd8 339{
340 char ch;
341
79072805 342 if (!pm) {
343 dump("{}\n");
378cc40b 344 return;
345 }
79072805 346 dump("{\n");
8d063cd8 347 dumplvl++;
79072805 348 if (pm->op_pmflags & PMf_ONCE)
349 ch = '?';
350 else
351 ch = '/';
352 if (pm->op_pmregexp)
c90c0ff4 353 dump("PMf_PRE %c%s%c%s\n",
354 ch, pm->op_pmregexp->precomp, ch,
355 (pm->op_private & OPpRUNTIME) ? " (RUNTIME)" : "");
356 else
357 dump("PMf_PRE (RUNTIME)\n");
79072805 358 if (pm->op_type != OP_PUSHRE && pm->op_pmreplroot) {
359 dump("PMf_REPL = ");
360 dump_op(pm->op_pmreplroot);
8d063cd8 361 }
c277df42 362 if (pm->op_pmflags || (pm->op_pmregexp && pm->op_pmregexp->check_substr)) {
46fc3d4c 363 SV *tmpsv = newSVpv("", 0);
79072805 364 if (pm->op_pmflags & PMf_USED)
46fc3d4c 365 sv_catpv(tmpsv, ",USED");
79072805 366 if (pm->op_pmflags & PMf_ONCE)
46fc3d4c 367 sv_catpv(tmpsv, ",ONCE");
c277df42 368 if (pm->op_pmregexp && pm->op_pmregexp->check_substr
369 && !(pm->op_pmregexp->reganch & ROPT_NOSCAN))
46fc3d4c 370 sv_catpv(tmpsv, ",SCANFIRST");
c277df42 371 if (pm->op_pmregexp && pm->op_pmregexp->check_substr
372 && pm->op_pmregexp->reganch & ROPT_CHECK_ALL)
46fc3d4c 373 sv_catpv(tmpsv, ",ALL");
79072805 374 if (pm->op_pmflags & PMf_SKIPWHITE)
46fc3d4c 375 sv_catpv(tmpsv, ",SKIPWHITE");
79072805 376 if (pm->op_pmflags & PMf_CONST)
46fc3d4c 377 sv_catpv(tmpsv, ",CONST");
79072805 378 if (pm->op_pmflags & PMf_KEEP)
46fc3d4c 379 sv_catpv(tmpsv, ",KEEP");
79072805 380 if (pm->op_pmflags & PMf_GLOBAL)
46fc3d4c 381 sv_catpv(tmpsv, ",GLOBAL");
c90c0ff4 382 if (pm->op_pmflags & PMf_CONTINUE)
383 sv_catpv(tmpsv, ",CONTINUE");
79072805 384 if (pm->op_pmflags & PMf_EVAL)
46fc3d4c 385 sv_catpv(tmpsv, ",EVAL");
386 dump("PMFLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
387 SvREFCNT_dec(tmpsv);
378cc40b 388 }
79072805 389
8d063cd8 390 dumplvl--;
391 dump("}\n");
392}
393
4db58590 394
395#if !defined(I_STDARG) && !defined(I_VARARGS)
378cc40b 396/* VARARGS1 */
8adcabd8 397static void dump(arg1,arg2,arg3,arg4,arg5)
378cc40b 398char *arg1;
399long arg2, arg3, arg4, arg5;
8d063cd8 400{
79072805 401 I32 i;
8d063cd8 402
403 for (i = dumplvl*4; i; i--)
760ac839 404 (void)PerlIO_putc(Perl_debug_log,' ');
405 PerlIO_printf(Perl_debug_log, arg1, arg2, arg3, arg4, arg5);
4db58590 406}
407
408#else
409
410#ifdef I_STDARG
411static void
412dump(char *pat,...)
413#else
414/*VARARGS0*/
415static void
416dump(pat,va_alist)
417 char *pat;
418 va_dcl
419#endif
420{
421 I32 i;
422 va_list args;
4db58590 423
424#ifdef I_STDARG
425 va_start(args, pat);
426#else
427 va_start(args);
428#endif
429 for (i = dumplvl*4; i; i--)
760ac839 430 (void)PerlIO_putc(Perl_debug_log,' ');
431 PerlIO_vprintf(Perl_debug_log,pat,args);
4db58590 432 va_end(args);
8d063cd8 433}
434#endif
4db58590 435
436#endif