1 /* dump.c 2 * 3 * Copyright (c) 1991-2001, Larry Wall 4 * 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. 7 * 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.'" 13 */ 14 15 #include "EXTERN.h" 16 #define PERL_IN_DUMP_C 17 #include "perl.h" 18 #include "regcomp.h" 19 20 void 21 Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...) 22 { 23 va_list args; 24 va_start(args, pat); 25 dump_vindent(level, file, pat, &args); 26 va_end(args); 27 } 28 29 void 30 Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args) 31 { 32 PerlIO_printf(file, "%*s", (int)(level*PL_dumpindent), ""); 33 PerlIO_vprintf(file, pat, *args); 34 } 35 36 void 37 Perl_dump_all(pTHX) 38 { 39 PerlIO_setlinebuf(Perl_debug_log); 40 if (PL_main_root) 41 op_dump(PL_main_root); 42 dump_packsubs(PL_defstash); 43 } 44 45 void 46 Perl_dump_packsubs(pTHX_ HV *stash) 47 { 48 I32 i; 49 HE *entry; 50 51 if (!HvARRAY(stash)) 52 return; 53 for (i = 0; i <= (I32) HvMAX(stash); i++) { 54 for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) { 55 GV *gv = (GV*)HeVAL(entry); 56 HV *hv; 57 if (SvTYPE(gv) != SVt_PVGV || !GvGP(gv)) 58 continue; 59 if (GvCVu(gv)) 60 dump_sub(gv); 61 if (GvFORM(gv)) 62 dump_form(gv); 63 if (HeKEY(entry)[HeKLEN(entry)-1] == ':' && 64 (hv = GvHV(gv)) && HvNAME(hv) && hv != PL_defstash) 65 dump_packsubs(hv); /* nested package */ 66 } 67 } 68 } 69 70 void 71 Perl_dump_sub(pTHX_ GV *gv) 72 { 73 SV *sv = sv_newmortal(); 74 75 gv_fullname3(sv, gv, Nullch); 76 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ", SvPVX(sv)); 77 if (CvXSUB(GvCV(gv))) 78 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "(xsub 0x%lx %d)\n", 79 (long)CvXSUB(GvCV(gv)), 80 (int)CvXSUBANY(GvCV(gv)).any_i32); 81 else if (CvROOT(GvCV(gv))) 82 op_dump(CvROOT(GvCV(gv))); 83 else 84 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "<undef>\n"); 85 } 86 87 void 88 Perl_dump_form(pTHX_ GV *gv) 89 { 90 SV *sv = sv_newmortal(); 91 92 gv_fullname3(sv, gv, Nullch); 93 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nFORMAT %s = ", SvPVX(sv)); 94 if (CvROOT(GvFORM(gv))) 95 op_dump(CvROOT(GvFORM(gv))); 96 else 97 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "<undef>\n"); 98 } 99 100 void 101 Perl_dump_eval(pTHX) 102 { 103 op_dump(PL_eval_root); 104 } 105 106 char * 107 Perl_pv_display(pTHX_ SV *sv, char *pv, STRLEN cur, STRLEN len, STRLEN pvlim) 108 { 109 int truncated = 0; 110 int nul_terminated = len > cur && pv[cur] == '\0'; 111 112 sv_setpvn(sv, "\"", 1); 113 for (; cur--; pv++) { 114 if (pvlim && SvCUR(sv) >= pvlim) { 115 truncated++; 116 break; 117 } 118 if (isPRINT(*pv)) { 119 switch (*pv) { 120 case '\t': sv_catpvn(sv, "\\t", 2); break; 121 case '\n': sv_catpvn(sv, "\\n", 2); break; 122 case '\r': sv_catpvn(sv, "\\r", 2); break; 123 case '\f': sv_catpvn(sv, "\\f", 2); break; 124 case '"': sv_catpvn(sv, "\\\"", 2); break; 125 case '\\': sv_catpvn(sv, "\\\\", 2); break; 126 default: sv_catpvn(sv, pv, 1); break; 127 } 128 } 129 else { 130 if (cur && isDIGIT(*(pv+1))) 131 Perl_sv_catpvf(aTHX_ sv, "\\%03o", (U8)*pv); 132 else 133 Perl_sv_catpvf(aTHX_ sv, "\\%o", (U8)*pv); 134 } 135 } 136 sv_catpvn(sv, "\"", 1); 137 if (truncated) 138 sv_catpvn(sv, "...", 3); 139 if (nul_terminated) 140 sv_catpvn(sv, "\\0", 2); 141 142 return SvPVX(sv); 143 } 144 145 char * 146 Perl_sv_peek(pTHX_ SV *sv) 147 { 148 SV *t = sv_newmortal(); 149 STRLEN n_a; 150 int unref = 0; 151 152 sv_setpvn(t, "", 0); 153 retry: 154 if (!sv) { 155 sv_catpv(t, "VOID"); 156 goto finish; 157 } 158 else if (sv == (SV*)0x55555555 || SvTYPE(sv) == 'U') { 159 sv_catpv(t, "WILD"); 160 goto finish; 161 } 162 else if (sv == &PL_sv_undef || sv == &PL_sv_no || sv == &PL_sv_yes) { 163 if (sv == &PL_sv_undef) { 164 sv_catpv(t, "SV_UNDEF"); 165 if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT| 166 SVs_GMG|SVs_SMG|SVs_RMG)) && 167 SvREADONLY(sv)) 168 goto finish; 169 } 170 else if (sv == &PL_sv_no) { 171 sv_catpv(t, "SV_NO"); 172 if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT| 173 SVs_GMG|SVs_SMG|SVs_RMG)) && 174 !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY| 175 SVp_POK|SVp_NOK)) && 176 SvCUR(sv) == 0 && 177 SvNVX(sv) == 0.0) 178 goto finish; 179 } 180 else { 181 sv_catpv(t, "SV_YES"); 182 if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT| 183 SVs_GMG|SVs_SMG|SVs_RMG)) && 184 !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY| 185 SVp_POK|SVp_NOK)) && 186 SvCUR(sv) == 1 && 187 SvPVX(sv) && *SvPVX(sv) == '1' && 188 SvNVX(sv) == 1.0) 189 goto finish; 190 } 191 sv_catpv(t, ":"); 192 } 193 else if (SvREFCNT(sv) == 0) { 194 sv_catpv(t, "("); 195 unref++; 196 } 197 if (SvROK(sv)) { 198 sv_catpv(t, "\\"); 199 if (SvCUR(t) + unref > 10) { 200 SvCUR(t) = unref + 3; 201 *SvEND(t) = '\0'; 202 sv_catpv(t, "..."); 203 goto finish; 204 } 205 sv = (SV*)SvRV(sv); 206 goto retry; 207 } 208 switch (SvTYPE(sv)) { 209 default: 210 sv_catpv(t, "FREED"); 211 goto finish; 212 213 case SVt_NULL: 214 sv_catpv(t, "UNDEF"); 215 goto finish; 216 case SVt_IV: 217 sv_catpv(t, "IV"); 218 break; 219 case SVt_NV: 220 sv_catpv(t, "NV"); 221 break; 222 case SVt_RV: 223 sv_catpv(t, "RV"); 224 break; 225 case SVt_PV: 226 sv_catpv(t, "PV"); 227 break; 228 case SVt_PVIV: 229 sv_catpv(t, "PVIV"); 230 break; 231 case SVt_PVNV: 232 sv_catpv(t, "PVNV"); 233 break; 234 case SVt_PVMG: 235 sv_catpv(t, "PVMG"); 236 break; 237 case SVt_PVLV: 238 sv_catpv(t, "PVLV"); 239 break; 240 case SVt_PVAV: 241 sv_catpv(t, "AV"); 242 break; 243 case SVt_PVHV: 244 sv_catpv(t, "HV"); 245 break; 246 case SVt_PVCV: 247 if (CvGV(sv)) 248 Perl_sv_catpvf(aTHX_ t, "CV(%s)", GvNAME(CvGV(sv))); 249 else 250 sv_catpv(t, "CV()"); 251 goto finish; 252 case SVt_PVGV: 253 sv_catpv(t, "GV"); 254 break; 255 case SVt_PVBM: 256 sv_catpv(t, "BM"); 257 break; 258 case SVt_PVFM: 259 sv_catpv(t, "FM"); 260 break; 261 case SVt_PVIO: 262 sv_catpv(t, "IO"); 263 break; 264 } 265 266 if (SvPOKp(sv)) { 267 if (!SvPVX(sv)) 268 sv_catpv(t, "(null)"); 269 else { 270 SV *tmp = newSVpvn("", 0); 271 sv_catpv(t, "("); 272 if (SvOOK(sv)) 273 Perl_sv_catpvf(aTHX_ t, "[%s]", pv_display(tmp, SvPVX(sv)-SvIVX(sv), SvIVX(sv), 0, 127)); 274 Perl_sv_catpvf(aTHX_ t, "%s)", pv_display(tmp, SvPVX(sv), SvCUR(sv), SvLEN(sv), 127)); 275 SvREFCNT_dec(tmp); 276 } 277 } 278 else if (SvNOKp(sv)) { 279 STORE_NUMERIC_LOCAL_SET_STANDARD(); 280 Perl_sv_catpvf(aTHX_ t, "(%g)",SvNVX(sv)); 281 RESTORE_NUMERIC_LOCAL(); 282 } 283 else if (SvIOKp(sv)) { 284 if (SvIsUV(sv)) 285 Perl_sv_catpvf(aTHX_ t, "(%"UVuf")", (UV)SvUVX(sv)); 286 else 287 Perl_sv_catpvf(aTHX_ t, "(%"IVdf")", (IV)SvIVX(sv)); 288 } 289 else 290 sv_catpv(t, "()"); 291 292 finish: 293 if (unref) { 294 while (unref--) 295 sv_catpv(t, ")"); 296 } 297 return SvPV(t, n_a); 298 } 299 300 void 301 Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, PMOP *pm) 302 { 303 char ch; 304 305 if (!pm) { 306 Perl_dump_indent(aTHX_ level, file, "{}\n"); 307 return; 308 } 309 Perl_dump_indent(aTHX_ level, file, "{\n"); 310 level++; 311 if (pm->op_pmflags & PMf_ONCE) 312 ch = '?'; 313 else 314 ch = '/'; 315 if (pm->op_pmregexp) 316 Perl_dump_indent(aTHX_ level, file, "PMf_PRE %c%s%c%s\n", 317 ch, pm->op_pmregexp->precomp, ch, 318 (pm->op_private & OPpRUNTIME) ? " (RUNTIME)" : ""); 319 else 320 Perl_dump_indent(aTHX_ level, file, "PMf_PRE (RUNTIME)\n"); 321 if (pm->op_type != OP_PUSHRE && pm->op_pmreplroot) { 322 Perl_dump_indent(aTHX_ level, file, "PMf_REPL = "); 323 op_dump(pm->op_pmreplroot); 324 } 325 if (pm->op_pmflags || (pm->op_pmregexp && pm->op_pmregexp->check_substr)) { 326 SV *tmpsv = newSVpvn("", 0); 327 if (pm->op_pmdynflags & PMdf_USED) 328 sv_catpv(tmpsv, ",USED"); 329 if (pm->op_pmdynflags & PMdf_TAINTED) 330 sv_catpv(tmpsv, ",TAINTED"); 331 if (pm->op_pmflags & PMf_ONCE) 332 sv_catpv(tmpsv, ",ONCE"); 333 if (pm->op_pmregexp && pm->op_pmregexp->check_substr 334 && !(pm->op_pmregexp->reganch & ROPT_NOSCAN)) 335 sv_catpv(tmpsv, ",SCANFIRST"); 336 if (pm->op_pmregexp && pm->op_pmregexp->check_substr 337 && pm->op_pmregexp->reganch & ROPT_CHECK_ALL) 338 sv_catpv(tmpsv, ",ALL"); 339 if (pm->op_pmflags & PMf_SKIPWHITE) 340 sv_catpv(tmpsv, ",SKIPWHITE"); 341 if (pm->op_pmflags & PMf_CONST) 342 sv_catpv(tmpsv, ",CONST"); 343 if (pm->op_pmflags & PMf_KEEP) 344 sv_catpv(tmpsv, ",KEEP"); 345 if (pm->op_pmflags & PMf_GLOBAL) 346 sv_catpv(tmpsv, ",GLOBAL"); 347 if (pm->op_pmflags & PMf_CONTINUE) 348 sv_catpv(tmpsv, ",CONTINUE"); 349 if (pm->op_pmflags & PMf_RETAINT) 350 sv_catpv(tmpsv, ",RETAINT"); 351 if (pm->op_pmflags & PMf_EVAL) 352 sv_catpv(tmpsv, ",EVAL"); 353 Perl_dump_indent(aTHX_ level, file, "PMFLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : ""); 354 SvREFCNT_dec(tmpsv); 355 } 356 357 Perl_dump_indent(aTHX_ level-1, file, "}\n"); 358 } 359 360 void 361 Perl_pmop_dump(pTHX_ PMOP *pm) 362 { 363 do_pmop_dump(0, Perl_debug_log, pm); 364 } 365 366 void 367 Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) 368 { 369 Perl_dump_indent(aTHX_ level, file, "{\n"); 370 level++; 371 if (o->op_seq) 372 PerlIO_printf(file, "%-4d", o->op_seq); 373 else 374 PerlIO_printf(file, " "); 375 PerlIO_printf(file, 376 "%*sTYPE = %s ===> ", 377 (int)(PL_dumpindent*level-4), "", PL_op_name[o->op_type]); 378 if (o->op_next) { 379 if (o->op_seq) 380 PerlIO_printf(file, "%d\n", o->op_next->op_seq); 381 else 382 PerlIO_printf(file, "(%d)\n", o->op_next->op_seq); 383 } 384 else 385 PerlIO_printf(file, "DONE\n"); 386 if (o->op_targ) { 387 if (o->op_type == OP_NULL) 388 Perl_dump_indent(aTHX_ level, file, " (was %s)\n", PL_op_name[o->op_targ]); 389 else 390 Perl_dump_indent(aTHX_ level, file, "TARG = %ld\n", (long)o->op_targ); 391 } 392 #ifdef DUMPADDR 393 Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%"UVxf" => 0x%"UVxf"\n", (UV)o, (UV)o->op_next); 394 #endif 395 if (o->op_flags) { 396 SV *tmpsv = newSVpvn("", 0); 397 switch (o->op_flags & OPf_WANT) { 398 case OPf_WANT_VOID: 399 sv_catpv(tmpsv, ",VOID"); 400 break; 401 case OPf_WANT_SCALAR: 402 sv_catpv(tmpsv, ",SCALAR"); 403 break; 404 case OPf_WANT_LIST: 405 sv_catpv(tmpsv, ",LIST"); 406 break; 407 default: 408 sv_catpv(tmpsv, ",UNKNOWN"); 409 break; 410 } 411 if (o->op_flags & OPf_KIDS) 412 sv_catpv(tmpsv, ",KIDS"); 413 if (o->op_flags & OPf_PARENS) 414 sv_catpv(tmpsv, ",PARENS"); 415 if (o->op_flags & OPf_STACKED) 416 sv_catpv(tmpsv, ",STACKED"); 417 if (o->op_flags & OPf_REF) 418 sv_catpv(tmpsv, ",REF"); 419 if (o->op_flags & OPf_MOD) 420 sv_catpv(tmpsv, ",MOD"); 421 if (o->op_flags & OPf_SPECIAL) 422 sv_catpv(tmpsv, ",SPECIAL"); 423 Perl_dump_indent(aTHX_ level, file, "FLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : ""); 424 SvREFCNT_dec(tmpsv); 425 } 426 if (o->op_private) { 427 SV *tmpsv = newSVpvn("", 0); 428 if (PL_opargs[o->op_type] & OA_TARGLEX) { 429 if (o->op_private & OPpTARGET_MY) 430 sv_catpv(tmpsv, ",TARGET_MY"); 431 } 432 if (o->op_type == OP_AASSIGN) { 433 if (o->op_private & OPpASSIGN_COMMON) 434 sv_catpv(tmpsv, ",COMMON"); 435 if (o->op_private & OPpASSIGN_HASH) 436 sv_catpv(tmpsv, ",HASH"); 437 } 438 else if (o->op_type == OP_SASSIGN) { 439 if (o->op_private & OPpASSIGN_BACKWARDS) 440 sv_catpv(tmpsv, ",BACKWARDS"); 441 } 442 else if (o->op_type == OP_TRANS) { 443 if (o->op_private & OPpTRANS_SQUASH) 444 sv_catpv(tmpsv, ",SQUASH"); 445 if (o->op_private & OPpTRANS_DELETE) 446 sv_catpv(tmpsv, ",DELETE"); 447 if (o->op_private & OPpTRANS_COMPLEMENT) 448 sv_catpv(tmpsv, ",COMPLEMENT"); 449 } 450 else if (o->op_type == OP_REPEAT) { 451 if (o->op_private & OPpREPEAT_DOLIST) 452 sv_catpv(tmpsv, ",DOLIST"); 453 } 454 else if (o->op_type == OP_ENTERSUB || 455 o->op_type == OP_RV2SV || 456 o->op_type == OP_GVSV || 457 o->op_type == OP_RV2AV || 458 o->op_type == OP_RV2HV || 459 o->op_type == OP_RV2GV || 460 o->op_type == OP_AELEM || 461 o->op_type == OP_HELEM ) 462 { 463 if (o->op_type == OP_ENTERSUB) { 464 if (o->op_private & OPpENTERSUB_AMPER) 465 sv_catpv(tmpsv, ",AMPER"); 466 if (o->op_private & OPpENTERSUB_DB) 467 sv_catpv(tmpsv, ",DB"); 468 if (o->op_private & OPpENTERSUB_HASTARG) 469 sv_catpv(tmpsv, ",HASTARG"); 470 } 471 else 472 switch (o->op_private & OPpDEREF) { 473 case OPpDEREF_SV: 474 sv_catpv(tmpsv, ",SV"); 475 break; 476 case OPpDEREF_AV: 477 sv_catpv(tmpsv, ",AV"); 478 break; 479 case OPpDEREF_HV: 480 sv_catpv(tmpsv, ",HV"); 481 break; 482 } 483 if (o->op_type == OP_AELEM || o->op_type == OP_HELEM) { 484 if (o->op_private & OPpLVAL_DEFER) 485 sv_catpv(tmpsv, ",LVAL_DEFER"); 486 } 487 else { 488 if (o->op_private & HINT_STRICT_REFS) 489 sv_catpv(tmpsv, ",STRICT_REFS"); 490 if (o->op_private & OPpOUR_INTRO) 491 sv_catpv(tmpsv, ",OUR_INTRO"); 492 } 493 } 494 else if (o->op_type == OP_CONST) { 495 if (o->op_private & OPpCONST_BARE) 496 sv_catpv(tmpsv, ",BARE"); 497 if (o->op_private & OPpCONST_STRICT) 498 sv_catpv(tmpsv, ",STRICT"); 499 } 500 else if (o->op_type == OP_FLIP) { 501 if (o->op_private & OPpFLIP_LINENUM) 502 sv_catpv(tmpsv, ",LINENUM"); 503 } 504 else if (o->op_type == OP_FLOP) { 505 if (o->op_private & OPpFLIP_LINENUM) 506 sv_catpv(tmpsv, ",LINENUM"); 507 } else if (o->op_type == OP_RV2CV) { 508 if (o->op_private & OPpLVAL_INTRO) 509 sv_catpv(tmpsv, ",INTRO"); 510 } 511 if (o->op_flags & OPf_MOD && o->op_private & OPpLVAL_INTRO) 512 sv_catpv(tmpsv, ",INTRO"); 513 if (SvCUR(tmpsv)) 514 Perl_dump_indent(aTHX_ level, file, "PRIVATE = (%s)\n", SvPVX(tmpsv) + 1); 515 SvREFCNT_dec(tmpsv); 516 } 517 518 switch (o->op_type) { 519 case OP_AELEMFAST: 520 case OP_GVSV: 521 case OP_GV: 522 #ifdef USE_ITHREADS 523 Perl_dump_indent(aTHX_ level, file, "PADIX = %d\n", cPADOPo->op_padix); 524 #else 525 if (cSVOPo->op_sv) { 526 SV *tmpsv = NEWSV(0,0); 527 STRLEN n_a; 528 ENTER; 529 SAVEFREESV(tmpsv); 530 gv_fullname3(tmpsv, (GV*)cSVOPo->op_sv, Nullch); 531 Perl_dump_indent(aTHX_ level, file, "GV = %s\n", SvPV(tmpsv, n_a)); 532 LEAVE; 533 } 534 else 535 Perl_dump_indent(aTHX_ level, file, "GV = NULL\n"); 536 #endif 537 break; 538 case OP_CONST: 539 case OP_METHOD_NAMED: 540 Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cSVOPo->op_sv)); 541 break; 542 case OP_SETSTATE: 543 case OP_NEXTSTATE: 544 case OP_DBSTATE: 545 if (CopLINE(cCOPo)) 546 Perl_dump_indent(aTHX_ level, file, "LINE = %d\n",CopLINE(cCOPo)); 547 if (CopSTASHPV(cCOPo)) 548 Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n", 549 CopSTASHPV(cCOPo)); 550 if (cCOPo->cop_label) 551 Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n", 552 cCOPo->cop_label); 553 break; 554 case OP_ENTERLOOP: 555 Perl_dump_indent(aTHX_ level, file, "REDO ===> "); 556 if (cLOOPo->op_redoop) 557 PerlIO_printf(file, "%d\n", cLOOPo->op_redoop->op_seq); 558 else 559 PerlIO_printf(file, "DONE\n"); 560 Perl_dump_indent(aTHX_ level, file, "NEXT ===> "); 561 if (cLOOPo->op_nextop) 562 PerlIO_printf(file, "%d\n", cLOOPo->op_nextop->op_seq); 563 else 564 PerlIO_printf(file, "DONE\n"); 565 Perl_dump_indent(aTHX_ level, file, "LAST ===> "); 566 if (cLOOPo->op_lastop) 567 PerlIO_printf(file, "%d\n", cLOOPo->op_lastop->op_seq); 568 else 569 PerlIO_printf(file, "DONE\n"); 570 break; 571 case OP_COND_EXPR: 572 case OP_RANGE: 573 case OP_MAPWHILE: 574 case OP_GREPWHILE: 575 case OP_OR: 576 case OP_AND: 577 Perl_dump_indent(aTHX_ level, file, "OTHER ===> "); 578 if (cLOGOPo->op_other) 579 PerlIO_printf(file, "%d\n", cLOGOPo->op_other->op_seq); 580 else 581 PerlIO_printf(file, "DONE\n"); 582 break; 583 case OP_PUSHRE: 584 case OP_MATCH: 585 case OP_QR: 586 case OP_SUBST: 587 do_pmop_dump(level, file, cPMOPo); 588 break; 589 case OP_LEAVE: 590 case OP_LEAVEEVAL: 591 case OP_LEAVESUB: 592 case OP_LEAVESUBLV: 593 case OP_LEAVEWRITE: 594 case OP_SCOPE: 595 if (o->op_private & OPpREFCOUNTED) 596 Perl_dump_indent(aTHX_ level, file, "REFCNT = %"UVuf"\n", (UV)o->op_targ); 597 break; 598 default: 599 break; 600 } 601 if (o->op_flags & OPf_KIDS) { 602 OP *kid; 603 for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) 604 do_op_dump(level, file, kid); 605 } 606 Perl_dump_indent(aTHX_ level-1, file, "}\n"); 607 } 608 609 void 610 Perl_op_dump(pTHX_ OP *o) 611 { 612 do_op_dump(0, Perl_debug_log, o); 613 } 614 615 void 616 Perl_gv_dump(pTHX_ GV *gv) 617 { 618 SV *sv; 619 620 if (!gv) { 621 PerlIO_printf(Perl_debug_log, "{}\n"); 622 return; 623 } 624 sv = sv_newmortal(); 625 PerlIO_printf(Perl_debug_log, "{\n"); 626 gv_fullname3(sv, gv, Nullch); 627 Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %s", SvPVX(sv)); 628 if (gv != GvEGV(gv)) { 629 gv_efullname3(sv, GvEGV(gv), Nullch); 630 Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s", SvPVX(sv)); 631 } 632 PerlIO_putc(Perl_debug_log, '\n'); 633 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "}\n"); 634 } 635 636 void 637 Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, MAGIC *mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim) 638 { 639 for (; mg; mg = mg->mg_moremagic) { 640 Perl_dump_indent(aTHX_ level, file, 641 " MAGIC = 0x%"UVxf"\n", PTR2UV(mg)); 642 if (mg->mg_virtual) { 643 MGVTBL *v = mg->mg_virtual; 644 char *s = 0; 645 if (v == &PL_vtbl_sv) s = "sv"; 646 else if (v == &PL_vtbl_env) s = "env"; 647 else if (v == &PL_vtbl_envelem) s = "envelem"; 648 else if (v == &PL_vtbl_sig) s = "sig"; 649 else if (v == &PL_vtbl_sigelem) s = "sigelem"; 650 else if (v == &PL_vtbl_pack) s = "pack"; 651 else if (v == &PL_vtbl_packelem) s = "packelem"; 652 else if (v == &PL_vtbl_dbline) s = "dbline"; 653 else if (v == &PL_vtbl_isa) s = "isa"; 654 else if (v == &PL_vtbl_arylen) s = "arylen"; 655 else if (v == &PL_vtbl_glob) s = "glob"; 656 else if (v == &PL_vtbl_mglob) s = "mglob"; 657 else if (v == &PL_vtbl_nkeys) s = "nkeys"; 658 else if (v == &PL_vtbl_taint) s = "taint"; 659 else if (v == &PL_vtbl_substr) s = "substr"; 660 else if (v == &PL_vtbl_vec) s = "vec"; 661 else if (v == &PL_vtbl_pos) s = "pos"; 662 else if (v == &PL_vtbl_bm) s = "bm"; 663 else if (v == &PL_vtbl_fm) s = "fm"; 664 else if (v == &PL_vtbl_uvar) s = "uvar"; 665 else if (v == &PL_vtbl_defelem) s = "defelem"; 666 #ifdef USE_LOCALE_COLLATE 667 else if (v == &PL_vtbl_collxfrm) s = "collxfrm"; 668 #endif 669 else if (v == &PL_vtbl_amagic) s = "amagic"; 670 else if (v == &PL_vtbl_amagicelem) s = "amagicelem"; 671 else if (v == &PL_vtbl_backref) s = "backref"; 672 if (s) 673 Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = &PL_vtbl_%s\n", s); 674 else 675 Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0x%"UVxf"\n", PTR2UV(v)); 676 } 677 else 678 Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0\n"); 679 680 if (mg->mg_private) 681 Perl_dump_indent(aTHX_ level, file, " MG_PRIVATE = %d\n", mg->mg_private); 682 683 if (isPRINT(mg->mg_type)) 684 Perl_dump_indent(aTHX_ level, file, " MG_TYPE = '%c'\n", mg->mg_type); 685 else 686 Perl_dump_indent(aTHX_ level, file, " MG_TYPE = '\\%o'\n", mg->mg_type); 687 688 if (mg->mg_flags) { 689 Perl_dump_indent(aTHX_ level, file, " MG_FLAGS = 0x%02X\n", mg->mg_flags); 690 if (mg->mg_flags & MGf_TAINTEDDIR) 691 Perl_dump_indent(aTHX_ level, file, " TAINTEDDIR\n"); 692 if (mg->mg_flags & MGf_REFCOUNTED) 693 Perl_dump_indent(aTHX_ level, file, " REFCOUNTED\n"); 694 if (mg->mg_flags & MGf_GSKIP) 695 Perl_dump_indent(aTHX_ level, file, " GSKIP\n"); 696 if (mg->mg_flags & MGf_MINMATCH) 697 Perl_dump_indent(aTHX_ level, file, " MINMATCH\n"); 698 } 699 if (mg->mg_obj) { 700 Perl_dump_indent(aTHX_ level, file, " MG_OBJ = 0x%"UVxf"\n", PTR2UV(mg->mg_obj)); 701 if (mg->mg_flags & MGf_REFCOUNTED) 702 do_sv_dump(level+2, file, mg->mg_obj, nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */ 703 } 704 if (mg->mg_len) 705 Perl_dump_indent(aTHX_ level, file, " MG_LEN = %ld\n", (long)mg->mg_len); 706 if (mg->mg_ptr) { 707 Perl_dump_indent(aTHX_ level, file, " MG_PTR = 0x%"UVxf, PTR2UV(mg->mg_ptr)); 708 if (mg->mg_len >= 0) { 709 SV *sv = newSVpvn("", 0); 710 PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim)); 711 SvREFCNT_dec(sv); 712 } 713 else if (mg->mg_len == HEf_SVKEY) { 714 PerlIO_puts(file, " => HEf_SVKEY\n"); 715 do_sv_dump(level+2, file, (SV*)((mg)->mg_ptr), nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */ 716 continue; 717 } 718 else 719 PerlIO_puts(file, " ???? - please notify IZ"); 720 PerlIO_putc(file, '\n'); 721 } 722 } 723 } 724 725 void 726 Perl_magic_dump(pTHX_ MAGIC *mg) 727 { 728 do_magic_dump(0, Perl_debug_log, mg, 0, 0, 0, 0); 729 } 730 731 void 732 Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, char *name, HV *sv) 733 { 734 Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv)); 735 if (sv && HvNAME(sv)) 736 PerlIO_printf(file, "\t\"%s\"\n", HvNAME(sv)); 737 else 738 PerlIO_putc(file, '\n'); 739 } 740 741 void 742 Perl_do_gv_dump(pTHX_ I32 level, PerlIO *file, char *name, GV *sv) 743 { 744 Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv)); 745 if (sv && GvNAME(sv)) 746 PerlIO_printf(file, "\t\"%s\"\n", GvNAME(sv)); 747 else 748 PerlIO_putc(file, '\n'); 749 } 750 751 void 752 Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, char *name, GV *sv) 753 { 754 Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv)); 755 if (sv && GvNAME(sv)) { 756 PerlIO_printf(file, "\t\""); 757 if (GvSTASH(sv) && HvNAME(GvSTASH(sv))) 758 PerlIO_printf(file, "%s\" :: \"", HvNAME(GvSTASH(sv))); 759 PerlIO_printf(file, "%s\"\n", GvNAME(sv)); 760 } 761 else 762 PerlIO_putc(file, '\n'); 763 } 764 765 void 766 Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim) 767 { 768 SV *d; 769 char *s; 770 U32 flags; 771 U32 type; 772 STRLEN n_a; 773 774 if (!sv) { 775 Perl_dump_indent(aTHX_ level, file, "SV = 0\n"); 776 return; 777 } 778 779 flags = SvFLAGS(sv); 780 type = SvTYPE(sv); 781 782 d = Perl_newSVpvf(aTHX_ 783 "(0x%"UVxf") at 0x%"UVxf"\n%*s REFCNT = %"IVdf"\n%*s FLAGS = (", 784 PTR2UV(SvANY(sv)), PTR2UV(sv), 785 (int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv), 786 (int)(PL_dumpindent*level), ""); 787 788 if (flags & SVs_PADBUSY) sv_catpv(d, "PADBUSY,"); 789 if (flags & SVs_PADTMP) sv_catpv(d, "PADTMP,"); 790 if (flags & SVs_PADMY) sv_catpv(d, "PADMY,"); 791 if (flags & SVs_TEMP) sv_catpv(d, "TEMP,"); 792 if (flags & SVs_OBJECT) sv_catpv(d, "OBJECT,"); 793 if (flags & SVs_GMG) sv_catpv(d, "GMG,"); 794 if (flags & SVs_SMG) sv_catpv(d, "SMG,"); 795 if (flags & SVs_RMG) sv_catpv(d, "RMG,"); 796 797 if (flags & SVf_IOK) sv_catpv(d, "IOK,"); 798 if (flags & SVf_NOK) sv_catpv(d, "NOK,"); 799 if (flags & SVf_POK) sv_catpv(d, "POK,"); 800 if (flags & SVf_ROK) { 801 sv_catpv(d, "ROK,"); 802 if (SvWEAKREF(sv)) sv_catpv(d, "WEAKREF,"); 803 } 804 if (flags & SVf_OOK) sv_catpv(d, "OOK,"); 805 if (flags & SVf_FAKE) sv_catpv(d, "FAKE,"); 806 if (flags & SVf_READONLY) sv_catpv(d, "READONLY,"); 807 808 if (flags & SVf_AMAGIC) sv_catpv(d, "OVERLOAD,"); 809 if (flags & SVp_IOK) sv_catpv(d, "pIOK,"); 810 if (flags & SVp_NOK) sv_catpv(d, "pNOK,"); 811 if (flags & SVp_POK) sv_catpv(d, "pPOK,"); 812 if (flags & SVp_SCREAM) sv_catpv(d, "SCREAM,"); 813 814 switch (type) { 815 case SVt_PVCV: 816 case SVt_PVFM: 817 if (CvANON(sv)) sv_catpv(d, "ANON,"); 818 if (CvUNIQUE(sv)) sv_catpv(d, "UNIQUE,"); 819 if (CvCLONE(sv)) sv_catpv(d, "CLONE,"); 820 if (CvCLONED(sv)) sv_catpv(d, "CLONED,"); 821 if (CvNODEBUG(sv)) sv_catpv(d, "NODEBUG,"); 822 if (SvCOMPILED(sv)) sv_catpv(d, "COMPILED,"); 823 if (CvLVALUE(sv)) sv_catpv(d, "LVALUE,"); 824 if (CvMETHOD(sv)) sv_catpv(d, "METHOD,"); 825 break; 826 case SVt_PVHV: 827 if (HvSHAREKEYS(sv)) sv_catpv(d, "SHAREKEYS,"); 828 if (HvLAZYDEL(sv)) sv_catpv(d, "LAZYDEL,"); 829 break; 830 case SVt_PVGV: 831 if (GvINTRO(sv)) sv_catpv(d, "INTRO,"); 832 if (GvMULTI(sv)) sv_catpv(d, "MULTI,"); 833 if (GvASSUMECV(sv)) sv_catpv(d, "ASSUMECV,"); 834 if (GvIN_PAD(sv)) sv_catpv(d, "IN_PAD,"); 835 if (GvIMPORTED(sv)) { 836 sv_catpv(d, "IMPORT"); 837 if (GvIMPORTED(sv) == GVf_IMPORTED) 838 sv_catpv(d, "ALL,"); 839 else { 840 sv_catpv(d, "("); 841 if (GvIMPORTED_SV(sv)) sv_catpv(d, " SV"); 842 if (GvIMPORTED_AV(sv)) sv_catpv(d, " AV"); 843 if (GvIMPORTED_HV(sv)) sv_catpv(d, " HV"); 844 if (GvIMPORTED_CV(sv)) sv_catpv(d, " CV"); 845 sv_catpv(d, " ),"); 846 } 847 } 848 /* FALL THROGH */ 849 default: 850 if (SvEVALED(sv)) sv_catpv(d, "EVALED,"); 851 if (SvIsUV(sv)) sv_catpv(d, "IsUV,"); 852 if (SvUTF8(sv)) sv_catpv(d, "UTF8"); 853 break; 854 case SVt_PVBM: 855 if (SvTAIL(sv)) sv_catpv(d, "TAIL,"); 856 if (SvVALID(sv)) sv_catpv(d, "VALID,"); 857 break; 858 } 859 860 if (*(SvEND(d) - 1) == ',') 861 SvPVX(d)[--SvCUR(d)] = '\0'; 862 sv_catpv(d, ")"); 863 s = SvPVX(d); 864 865 Perl_dump_indent(aTHX_ level, file, "SV = "); 866 switch (type) { 867 case SVt_NULL: 868 PerlIO_printf(file, "NULL%s\n", s); 869 SvREFCNT_dec(d); 870 return; 871 case SVt_IV: 872 PerlIO_printf(file, "IV%s\n", s); 873 break; 874 case SVt_NV: 875 PerlIO_printf(file, "NV%s\n", s); 876 break; 877 case SVt_RV: 878 PerlIO_printf(file, "RV%s\n", s); 879 break; 880 case SVt_PV: 881 PerlIO_printf(file, "PV%s\n", s); 882 break; 883 case SVt_PVIV: 884 PerlIO_printf(file, "PVIV%s\n", s); 885 break; 886 case SVt_PVNV: 887 PerlIO_printf(file, "PVNV%s\n", s); 888 break; 889 case SVt_PVBM: 890 PerlIO_printf(file, "PVBM%s\n", s); 891 break; 892 case SVt_PVMG: 893 PerlIO_printf(file, "PVMG%s\n", s); 894 break; 895 case SVt_PVLV: 896 PerlIO_printf(file, "PVLV%s\n", s); 897 break; 898 case SVt_PVAV: 899 PerlIO_printf(file, "PVAV%s\n", s); 900 break; 901 case SVt_PVHV: 902 PerlIO_printf(file, "PVHV%s\n", s); 903 break; 904 case SVt_PVCV: 905 PerlIO_printf(file, "PVCV%s\n", s); 906 break; 907 case SVt_PVGV: 908 PerlIO_printf(file, "PVGV%s\n", s); 909 break; 910 case SVt_PVFM: 911 PerlIO_printf(file, "PVFM%s\n", s); 912 break; 913 case SVt_PVIO: 914 PerlIO_printf(file, "PVIO%s\n", s); 915 break; 916 default: 917 PerlIO_printf(file, "UNKNOWN(0x%"UVxf") %s\n", (UV)type, s); 918 SvREFCNT_dec(d); 919 return; 920 } 921 if (type >= SVt_PVIV || type == SVt_IV) { 922 if (SvIsUV(sv)) 923 Perl_dump_indent(aTHX_ level, file, " UV = %"UVuf, (UV)SvUVX(sv)); 924 else 925 Perl_dump_indent(aTHX_ level, file, " IV = %"IVdf, (IV)SvIVX(sv)); 926 if (SvOOK(sv)) 927 PerlIO_printf(file, " (OFFSET)"); 928 PerlIO_putc(file, '\n'); 929 } 930 if (type >= SVt_PVNV || type == SVt_NV) { 931 STORE_NUMERIC_LOCAL_SET_STANDARD(); 932 /* %Vg doesn't work? --jhi */ 933 #ifdef USE_LONG_DOUBLE 934 Perl_dump_indent(aTHX_ level, file, " NV = %.*" PERL_PRIgldbl "\n", LDBL_DIG, SvNVX(sv)); 935 #else 936 Perl_dump_indent(aTHX_ level, file, " NV = %.*g\n", DBL_DIG, SvNVX(sv)); 937 #endif 938 RESTORE_NUMERIC_LOCAL(); 939 } 940 if (SvROK(sv)) { 941 Perl_dump_indent(aTHX_ level, file, " RV = 0x%"UVxf"\n", PTR2UV(SvRV(sv))); 942 if (nest < maxnest) 943 do_sv_dump(level+1, file, SvRV(sv), nest+1, maxnest, dumpops, pvlim); 944 SvREFCNT_dec(d); 945 return; 946 } 947 if (type < SVt_PV) { 948 SvREFCNT_dec(d); 949 return; 950 } 951 if (type <= SVt_PVLV) { 952 if (SvPVX(sv)) { 953 Perl_dump_indent(aTHX_ level, file," PV = 0x%"UVxf" ", PTR2UV(SvPVX(sv))); 954 if (SvOOK(sv)) 955 PerlIO_printf(file, "( %s . ) ", pv_display(d, SvPVX(sv)-SvIVX(sv), SvIVX(sv), 0, pvlim)); 956 PerlIO_printf(file, "%s\n", pv_display(d, SvPVX(sv), SvCUR(sv), SvLEN(sv), pvlim)); 957 Perl_dump_indent(aTHX_ level, file, " CUR = %"IVdf"\n", (IV)SvCUR(sv)); 958 Perl_dump_indent(aTHX_ level, file, " LEN = %"IVdf"\n", (IV)SvLEN(sv)); 959 } 960 else 961 Perl_dump_indent(aTHX_ level, file, " PV = 0\n"); 962 } 963 if (type >= SVt_PVMG) { 964 if (SvMAGIC(sv)) 965 do_magic_dump(level, file, SvMAGIC(sv), nest, maxnest, dumpops, pvlim); 966 if (SvSTASH(sv)) 967 do_hv_dump(level, file, " STASH", SvSTASH(sv)); 968 } 969 switch (type) { 970 case SVt_PVLV: 971 Perl_dump_indent(aTHX_ level, file, " TYPE = %c\n", LvTYPE(sv)); 972 Perl_dump_indent(aTHX_ level, file, " TARGOFF = %"IVdf"\n", (IV)LvTARGOFF(sv)); 973 Perl_dump_indent(aTHX_ level, file, " TARGLEN = %"IVdf"\n", (IV)LvTARGLEN(sv)); 974 Perl_dump_indent(aTHX_ level, file, " TARG = 0x%"UVxf"\n", PTR2UV(LvTARG(sv))); 975 /* XXX level+1 ??? */ 976 do_sv_dump(level, file, LvTARG(sv), nest+1, maxnest, dumpops, pvlim); 977 break; 978 case SVt_PVAV: 979 Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(AvARRAY(sv))); 980 if (AvARRAY(sv) != AvALLOC(sv)) { 981 PerlIO_printf(file, " (offset=%"IVdf")\n", (IV)(AvARRAY(sv) - AvALLOC(sv))); 982 Perl_dump_indent(aTHX_ level, file, " ALLOC = 0x%"UVxf"\n", PTR2UV(AvALLOC(sv))); 983 } 984 else 985 PerlIO_putc(file, '\n'); 986 Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)AvFILLp(sv)); 987 Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)AvMAX(sv)); 988 Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%"UVxf"\n", PTR2UV(AvARYLEN(sv))); 989 flags = AvFLAGS(sv); 990 sv_setpv(d, ""); 991 if (flags & AVf_REAL) sv_catpv(d, ",REAL"); 992 if (flags & AVf_REIFY) sv_catpv(d, ",REIFY"); 993 if (flags & AVf_REUSED) sv_catpv(d, ",REUSED"); 994 Perl_dump_indent(aTHX_ level, file, " FLAGS = (%s)\n", SvCUR(d) ? SvPVX(d) + 1 : ""); 995 if (nest < maxnest && av_len((AV*)sv) >= 0) { 996 int count; 997 for (count = 0; count <= av_len((AV*)sv) && count < maxnest; count++) { 998 SV** elt = av_fetch((AV*)sv,count,0); 999 1000 Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %"IVdf"\n", (IV)count); 1001 if (elt) 1002 do_sv_dump(level+1, file, *elt, nest+1, maxnest, dumpops, pvlim); 1003 } 1004 } 1005 break; 1006 case SVt_PVHV: 1007 Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(HvARRAY(sv))); 1008 if (HvARRAY(sv) && HvKEYS(sv)) { 1009 /* Show distribution of HEs in the ARRAY */ 1010 int freq[200]; 1011 #define FREQ_MAX (sizeof freq / sizeof freq[0] - 1) 1012 int i; 1013 int max = 0; 1014 U32 pow2 = 2, keys = HvKEYS(sv); 1015 NV theoret, sum = 0; 1016 1017 PerlIO_printf(file, " ("); 1018 Zero(freq, FREQ_MAX + 1, int); 1019 for (i = 0; i <= HvMAX(sv); i++) { 1020 HE* h; int count = 0; 1021 for (h = HvARRAY(sv)[i]; h; h = HeNEXT(h)) 1022 count++; 1023 if (count > FREQ_MAX) 1024 count = FREQ_MAX; 1025 freq[count]++; 1026 if (max < count) 1027 max = count; 1028 } 1029 for (i = 0; i <= max; i++) { 1030 if (freq[i]) { 1031 PerlIO_printf(file, "%d%s:%d", i, 1032 (i == FREQ_MAX) ? "+" : "", 1033 freq[i]); 1034 if (i != max) 1035 PerlIO_printf(file, ", "); 1036 } 1037 } 1038 PerlIO_putc(file, ')'); 1039 /* Now calculate quality wrt theoretical value */ 1040 for (i = max; i > 0; i--) { /* Precision: count down. */ 1041 sum += freq[i] * i * i; 1042 } 1043 while ((keys = keys >> 1)) 1044 pow2 = pow2 << 1; 1045 /* Approximate by Poisson distribution */ 1046 theoret = HvKEYS(sv); 1047 theoret += theoret * theoret/pow2; 1048 PerlIO_putc(file, '\n'); 1049 Perl_dump_indent(aTHX_ level, file, " hash quality = %.1"NVff"%%", theoret/sum*100); 1050 } 1051 PerlIO_putc(file, '\n'); 1052 Perl_dump_indent(aTHX_ level, file, " KEYS = %"IVdf"\n", (IV)HvKEYS(sv)); 1053 Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)HvFILL(sv)); 1054 Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)HvMAX(sv)); 1055 Perl_dump_indent(aTHX_ level, file, " RITER = %"IVdf"\n", (IV)HvRITER(sv)); 1056 Perl_dump_indent(aTHX_ level, file, " EITER = 0x%"UVxf"\n", PTR2UV(HvEITER(sv))); 1057 if (HvPMROOT(sv)) 1058 Perl_dump_indent(aTHX_ level, file, " PMROOT = 0x%"UVxf"\n", PTR2UV(HvPMROOT(sv))); 1059 if (HvNAME(sv)) 1060 Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", HvNAME(sv)); 1061 if (nest < maxnest && !HvEITER(sv)) { /* Try to preserve iterator */ 1062 HE *he; 1063 HV *hv = (HV*)sv; 1064 int count = maxnest - nest; 1065 1066 hv_iterinit(hv); 1067 while ((he = hv_iternext(hv)) && count--) { 1068 SV *elt; 1069 char *key; 1070 I32 len; 1071 U32 hash = HeHASH(he); 1072 1073 key = hv_iterkey(he, &len); 1074 elt = hv_iterval(hv, he); 1075 Perl_dump_indent(aTHX_ level+1, file, "Elt %s HASH = 0x%"UVxf"\n", pv_display(d, key, len, 0, pvlim), (UV)hash); 1076 do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim); 1077 } 1078 hv_iterinit(hv); /* Return to status quo */ 1079 } 1080 break; 1081 case SVt_PVCV: 1082 if (SvPOK(sv)) 1083 Perl_dump_indent(aTHX_ level, file, " PROTOTYPE = \"%s\"\n", SvPV(sv,n_a)); 1084 /* FALL THROUGH */ 1085 case SVt_PVFM: 1086 do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv)); 1087 if (CvSTART(sv)) 1088 Perl_dump_indent(aTHX_ level, file, " START = 0x%"UVxf" ===> %"IVdf"\n", PTR2UV(CvSTART(sv)), (IV)CvSTART(sv)->op_seq); 1089 Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%"UVxf"\n", PTR2UV(CvROOT(sv))); 1090 if (CvROOT(sv) && dumpops) 1091 do_op_dump(level+1, file, CvROOT(sv)); 1092 Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv))); 1093 Perl_dump_indent(aTHX_ level, file, " XSUBANY = %"IVdf"\n", (IV)CvXSUBANY(sv).any_i32); 1094 do_gvgv_dump(level, file, " GVGV::GV", CvGV(sv)); 1095 Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", CvFILE(sv)); 1096 Perl_dump_indent(aTHX_ level, file, " DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv)); 1097 #ifdef USE_THREADS 1098 Perl_dump_indent(aTHX_ level, file, " MUTEXP = 0x%"UVxf"\n", PTR2UV(CvMUTEXP(sv))); 1099 Perl_dump_indent(aTHX_ level, file, " OWNER = 0x%"UVxf"\n", PTR2UV(CvOWNER(sv))); 1100 #endif /* USE_THREADS */ 1101 Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv)); 1102 if (type == SVt_PVFM) 1103 Perl_dump_indent(aTHX_ level, file, " LINES = %"IVdf"\n", (IV)FmLINES(sv)); 1104 Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv))); 1105 if (nest < maxnest && CvPADLIST(sv)) { 1106 AV* padlist = CvPADLIST(sv); 1107 AV* pad_name = (AV*)*av_fetch(padlist, 0, FALSE); 1108 AV* pad = (AV*)*av_fetch(padlist, 1, FALSE); 1109 SV** pname = AvARRAY(pad_name); 1110 SV** ppad = AvARRAY(pad); 1111 I32 ix; 1112 1113 for (ix = 1; ix <= AvFILL(pad_name); ix++) { 1114 if (SvPOK(pname[ix])) 1115 Perl_dump_indent(aTHX_ level, 1116 /* %5d below is enough whitespace. */ 1117 file, 1118 "%5d. 0x%"UVxf" (%s\"%s\" %"IVdf"-%"IVdf")\n", 1119 (int)ix, PTR2UV(ppad[ix]), 1120 SvFAKE(pname[ix]) ? "FAKE " : "", 1121 SvPVX(pname[ix]), 1122 (IV)SvNVX(pname[ix]), 1123 (IV)SvIVX(pname[ix])); 1124 } 1125 } 1126 { 1127 CV *outside = CvOUTSIDE(sv); 1128 Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%"UVxf" (%s)\n", 1129 PTR2UV(outside), 1130 (!outside ? "null" 1131 : CvANON(outside) ? "ANON" 1132 : (outside == PL_main_cv) ? "MAIN" 1133 : CvUNIQUE(outside) ? "UNIQUE" 1134 : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED")); 1135 } 1136 if (nest < maxnest && (CvCLONE(sv) || CvCLONED(sv))) 1137 do_sv_dump(level+1, file, (SV*)CvOUTSIDE(sv), nest+1, maxnest, dumpops, pvlim); 1138 break; 1139 case SVt_PVGV: 1140 Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", GvNAME(sv)); 1141 Perl_dump_indent(aTHX_ level, file, " NAMELEN = %"IVdf"\n", (IV)GvNAMELEN(sv)); 1142 do_hv_dump (level, file, " GvSTASH", GvSTASH(sv)); 1143 Perl_dump_indent(aTHX_ level, file, " GP = 0x%"UVxf"\n", PTR2UV(GvGP(sv))); 1144 if (!GvGP(sv)) 1145 break; 1146 Perl_dump_indent(aTHX_ level, file, " SV = 0x%"UVxf"\n", PTR2UV(GvSV(sv))); 1147 Perl_dump_indent(aTHX_ level, file, " REFCNT = %"IVdf"\n", (IV)GvREFCNT(sv)); 1148 Perl_dump_indent(aTHX_ level, file, " IO = 0x%"UVxf"\n", PTR2UV(GvIOp(sv))); 1149 Perl_dump_indent(aTHX_ level, file, " FORM = 0x%"UVxf" \n", PTR2UV(GvFORM(sv))); 1150 Perl_dump_indent(aTHX_ level, file, " AV = 0x%"UVxf"\n", PTR2UV(GvAV(sv))); 1151 Perl_dump_indent(aTHX_ level, file, " HV = 0x%"UVxf"\n", PTR2UV(GvHV(sv))); 1152 Perl_dump_indent(aTHX_ level, file, " CV = 0x%"UVxf"\n", PTR2UV(GvCV(sv))); 1153 Perl_dump_indent(aTHX_ level, file, " CVGEN = 0x%"UVxf"\n", (UV)GvCVGEN(sv)); 1154 Perl_dump_indent(aTHX_ level, file, " GPFLAGS = 0x%"UVxf"\n", (UV)GvGPFLAGS(sv)); 1155 Perl_dump_indent(aTHX_ level, file, " LINE = %"IVdf"\n", (IV)GvLINE(sv)); 1156 Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", GvFILE(sv)); 1157 Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)GvFLAGS(sv)); 1158 do_gv_dump (level, file, " EGV", GvEGV(sv)); 1159 break; 1160 case SVt_PVIO: 1161 Perl_dump_indent(aTHX_ level, file, " IFP = 0x%"UVxf"\n", PTR2UV(IoIFP(sv))); 1162 Perl_dump_indent(aTHX_ level, file, " OFP = 0x%"UVxf"\n", PTR2UV(IoOFP(sv))); 1163 Perl_dump_indent(aTHX_ level, file, " DIRP = 0x%"UVxf"\n", PTR2UV(IoDIRP(sv))); 1164 Perl_dump_indent(aTHX_ level, file, " LINES = %"IVdf"\n", (IV)IoLINES(sv)); 1165 Perl_dump_indent(aTHX_ level, file, " PAGE = %"IVdf"\n", (IV)IoPAGE(sv)); 1166 Perl_dump_indent(aTHX_ level, file, " PAGE_LEN = %"IVdf"\n", (IV)IoPAGE_LEN(sv)); 1167 Perl_dump_indent(aTHX_ level, file, " LINES_LEFT = %"IVdf"\n", (IV)IoLINES_LEFT(sv)); 1168 if (IoTOP_NAME(sv)) 1169 Perl_dump_indent(aTHX_ level, file, " TOP_NAME = \"%s\"\n", IoTOP_NAME(sv)); 1170 do_gv_dump (level, file, " TOP_GV", IoTOP_GV(sv)); 1171 if (IoFMT_NAME(sv)) 1172 Perl_dump_indent(aTHX_ level, file, " FMT_NAME = \"%s\"\n", IoFMT_NAME(sv)); 1173 do_gv_dump (level, file, " FMT_GV", IoFMT_GV(sv)); 1174 if (IoBOTTOM_NAME(sv)) 1175 Perl_dump_indent(aTHX_ level, file, " BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv)); 1176 do_gv_dump (level, file, " BOTTOM_GV", IoBOTTOM_GV(sv)); 1177 Perl_dump_indent(aTHX_ level, file, " SUBPROCESS = %"IVdf"\n", (IV)IoSUBPROCESS(sv)); 1178 if (isPRINT(IoTYPE(sv))) 1179 Perl_dump_indent(aTHX_ level, file, " TYPE = '%c'\n", IoTYPE(sv)); 1180 else 1181 Perl_dump_indent(aTHX_ level, file, " TYPE = '\\%o'\n", IoTYPE(sv)); 1182 Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)IoFLAGS(sv)); 1183 break; 1184 } 1185 SvREFCNT_dec(d); 1186 } 1187 1188 void 1189 Perl_sv_dump(pTHX_ SV *sv) 1190 { 1191 do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0); 1192 } 1193