1 /* dump.c 2 * 3 * Copyright (c) 1991-2002, 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)) && 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%"UVxf" %d)\n", 79 PTR2UV(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 *dsv, 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(dsv, "\"", 1); 113 for (; cur--; pv++) { 114 if (pvlim && SvCUR(dsv) >= pvlim) { 115 truncated++; 116 break; 117 } 118 if (isPRINT(*pv)) { 119 switch (*pv) { 120 case '\t': sv_catpvn(dsv, "\\t", 2); break; 121 case '\n': sv_catpvn(dsv, "\\n", 2); break; 122 case '\r': sv_catpvn(dsv, "\\r", 2); break; 123 case '\f': sv_catpvn(dsv, "\\f", 2); break; 124 case '"': sv_catpvn(dsv, "\\\"", 2); break; 125 case '\\': sv_catpvn(dsv, "\\\\", 2); break; 126 default: sv_catpvn(dsv, pv, 1); break; 127 } 128 } 129 else { 130 if (cur && isDIGIT(*(pv+1))) 131 Perl_sv_catpvf(aTHX_ dsv, "\\%03o", (U8)*pv); 132 else 133 Perl_sv_catpvf(aTHX_ dsv, "\\%o", (U8)*pv); 134 } 135 } 136 sv_catpvn(dsv, "\"", 1); 137 if (truncated) 138 sv_catpvn(dsv, "...", 3); 139 if (nul_terminated) 140 sv_catpvn(dsv, "\\0", 2); 141 142 return SvPVX(dsv); 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 else if (DEBUG_R_TEST_ && SvREFCNT(sv) > 1) { 198 Perl_sv_catpvf(aTHX_ t, "<%"UVuf">", (UV)SvREFCNT(sv)); 199 } 200 201 202 if (SvROK(sv)) { 203 sv_catpv(t, "\\"); 204 if (SvCUR(t) + unref > 10) { 205 SvCUR(t) = unref + 3; 206 *SvEND(t) = '\0'; 207 sv_catpv(t, "..."); 208 goto finish; 209 } 210 sv = (SV*)SvRV(sv); 211 goto retry; 212 } 213 switch (SvTYPE(sv)) { 214 default: 215 sv_catpv(t, "FREED"); 216 goto finish; 217 218 case SVt_NULL: 219 sv_catpv(t, "UNDEF"); 220 goto finish; 221 case SVt_IV: 222 sv_catpv(t, "IV"); 223 break; 224 case SVt_NV: 225 sv_catpv(t, "NV"); 226 break; 227 case SVt_RV: 228 sv_catpv(t, "RV"); 229 break; 230 case SVt_PV: 231 sv_catpv(t, "PV"); 232 break; 233 case SVt_PVIV: 234 sv_catpv(t, "PVIV"); 235 break; 236 case SVt_PVNV: 237 sv_catpv(t, "PVNV"); 238 break; 239 case SVt_PVMG: 240 sv_catpv(t, "PVMG"); 241 break; 242 case SVt_PVLV: 243 sv_catpv(t, "PVLV"); 244 break; 245 case SVt_PVAV: 246 sv_catpv(t, "AV"); 247 break; 248 case SVt_PVHV: 249 sv_catpv(t, "HV"); 250 break; 251 case SVt_PVCV: 252 if (CvGV(sv)) 253 Perl_sv_catpvf(aTHX_ t, "CV(%s)", GvNAME(CvGV(sv))); 254 else 255 sv_catpv(t, "CV()"); 256 goto finish; 257 case SVt_PVGV: 258 sv_catpv(t, "GV"); 259 break; 260 case SVt_PVBM: 261 sv_catpv(t, "BM"); 262 break; 263 case SVt_PVFM: 264 sv_catpv(t, "FM"); 265 break; 266 case SVt_PVIO: 267 sv_catpv(t, "IO"); 268 break; 269 } 270 271 if (SvPOKp(sv)) { 272 if (!SvPVX(sv)) 273 sv_catpv(t, "(null)"); 274 else { 275 SV *tmp = newSVpvn("", 0); 276 sv_catpv(t, "("); 277 if (SvOOK(sv)) 278 Perl_sv_catpvf(aTHX_ t, "[%s]", pv_display(tmp, SvPVX(sv)-SvIVX(sv), SvIVX(sv), 0, 127)); 279 Perl_sv_catpvf(aTHX_ t, "%s)", pv_display(tmp, SvPVX(sv), SvCUR(sv), SvLEN(sv), 127)); 280 if (SvUTF8(sv)) 281 Perl_sv_catpvf(aTHX_ t, " [UTF8 \"%s\"]", 282 sv_uni_display(tmp, sv, 8 * sv_len_utf8(sv), 283 UNI_DISPLAY_QQ)); 284 SvREFCNT_dec(tmp); 285 } 286 } 287 else if (SvNOKp(sv)) { 288 STORE_NUMERIC_LOCAL_SET_STANDARD(); 289 Perl_sv_catpvf(aTHX_ t, "(%"NVgf")",SvNVX(sv)); 290 RESTORE_NUMERIC_LOCAL(); 291 } 292 else if (SvIOKp(sv)) { 293 if (SvIsUV(sv)) 294 Perl_sv_catpvf(aTHX_ t, "(%"UVuf")", (UV)SvUVX(sv)); 295 else 296 Perl_sv_catpvf(aTHX_ t, "(%"IVdf")", (IV)SvIVX(sv)); 297 } 298 else 299 sv_catpv(t, "()"); 300 301 finish: 302 if (unref) { 303 while (unref--) 304 sv_catpv(t, ")"); 305 } 306 return SvPV(t, n_a); 307 } 308 309 void 310 Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, PMOP *pm) 311 { 312 char ch; 313 314 if (!pm) { 315 Perl_dump_indent(aTHX_ level, file, "{}\n"); 316 return; 317 } 318 Perl_dump_indent(aTHX_ level, file, "{\n"); 319 level++; 320 if (pm->op_pmflags & PMf_ONCE) 321 ch = '?'; 322 else 323 ch = '/'; 324 if (PM_GETRE(pm)) 325 Perl_dump_indent(aTHX_ level, file, "PMf_PRE %c%s%c%s\n", 326 ch, PM_GETRE(pm)->precomp, ch, 327 (pm->op_private & OPpRUNTIME) ? " (RUNTIME)" : ""); 328 else 329 Perl_dump_indent(aTHX_ level, file, "PMf_PRE (RUNTIME)\n"); 330 if (pm->op_type != OP_PUSHRE && pm->op_pmreplroot) { 331 Perl_dump_indent(aTHX_ level, file, "PMf_REPL = "); 332 op_dump(pm->op_pmreplroot); 333 } 334 if (pm->op_pmflags || (PM_GETRE(pm) && PM_GETRE(pm)->check_substr)) { 335 SV *tmpsv = newSVpvn("", 0); 336 if (pm->op_pmdynflags & PMdf_USED) 337 sv_catpv(tmpsv, ",USED"); 338 if (pm->op_pmdynflags & PMdf_TAINTED) 339 sv_catpv(tmpsv, ",TAINTED"); 340 if (pm->op_pmflags & PMf_ONCE) 341 sv_catpv(tmpsv, ",ONCE"); 342 if (PM_GETRE(pm) && PM_GETRE(pm)->check_substr 343 && !(PM_GETRE(pm)->reganch & ROPT_NOSCAN)) 344 sv_catpv(tmpsv, ",SCANFIRST"); 345 if (PM_GETRE(pm) && PM_GETRE(pm)->check_substr 346 && PM_GETRE(pm)->reganch & ROPT_CHECK_ALL) 347 sv_catpv(tmpsv, ",ALL"); 348 if (pm->op_pmflags & PMf_SKIPWHITE) 349 sv_catpv(tmpsv, ",SKIPWHITE"); 350 if (pm->op_pmflags & PMf_CONST) 351 sv_catpv(tmpsv, ",CONST"); 352 if (pm->op_pmflags & PMf_KEEP) 353 sv_catpv(tmpsv, ",KEEP"); 354 if (pm->op_pmflags & PMf_GLOBAL) 355 sv_catpv(tmpsv, ",GLOBAL"); 356 if (pm->op_pmflags & PMf_CONTINUE) 357 sv_catpv(tmpsv, ",CONTINUE"); 358 if (pm->op_pmflags & PMf_RETAINT) 359 sv_catpv(tmpsv, ",RETAINT"); 360 if (pm->op_pmflags & PMf_EVAL) 361 sv_catpv(tmpsv, ",EVAL"); 362 Perl_dump_indent(aTHX_ level, file, "PMFLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : ""); 363 SvREFCNT_dec(tmpsv); 364 } 365 366 Perl_dump_indent(aTHX_ level-1, file, "}\n"); 367 } 368 369 void 370 Perl_pmop_dump(pTHX_ PMOP *pm) 371 { 372 do_pmop_dump(0, Perl_debug_log, pm); 373 } 374 375 void 376 Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) 377 { 378 Perl_dump_indent(aTHX_ level, file, "{\n"); 379 level++; 380 if (o->op_seq) 381 PerlIO_printf(file, "%-4d", o->op_seq); 382 else 383 PerlIO_printf(file, " "); 384 PerlIO_printf(file, 385 "%*sTYPE = %s ===> ", 386 (int)(PL_dumpindent*level-4), "", OP_NAME(o)); 387 if (o->op_next) { 388 if (o->op_seq) 389 PerlIO_printf(file, "%d\n", o->op_next->op_seq); 390 else 391 PerlIO_printf(file, "(%d)\n", o->op_next->op_seq); 392 } 393 else 394 PerlIO_printf(file, "DONE\n"); 395 if (o->op_targ) { 396 if (o->op_type == OP_NULL) 397 { 398 Perl_dump_indent(aTHX_ level, file, " (was %s)\n", PL_op_name[o->op_targ]); 399 if (o->op_targ == OP_NEXTSTATE) 400 { 401 if (CopLINE(cCOPo)) 402 Perl_dump_indent(aTHX_ level, file, "LINE = %d\n",CopLINE(cCOPo)); 403 if (CopSTASHPV(cCOPo)) 404 Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n", 405 CopSTASHPV(cCOPo)); 406 if (cCOPo->cop_label) 407 Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n", 408 cCOPo->cop_label); 409 } 410 } 411 else 412 Perl_dump_indent(aTHX_ level, file, "TARG = %ld\n", (long)o->op_targ); 413 } 414 #ifdef DUMPADDR 415 Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%"UVxf" => 0x%"UVxf"\n", (UV)o, (UV)o->op_next); 416 #endif 417 if (o->op_flags) { 418 SV *tmpsv = newSVpvn("", 0); 419 switch (o->op_flags & OPf_WANT) { 420 case OPf_WANT_VOID: 421 sv_catpv(tmpsv, ",VOID"); 422 break; 423 case OPf_WANT_SCALAR: 424 sv_catpv(tmpsv, ",SCALAR"); 425 break; 426 case OPf_WANT_LIST: 427 sv_catpv(tmpsv, ",LIST"); 428 break; 429 default: 430 sv_catpv(tmpsv, ",UNKNOWN"); 431 break; 432 } 433 if (o->op_flags & OPf_KIDS) 434 sv_catpv(tmpsv, ",KIDS"); 435 if (o->op_flags & OPf_PARENS) 436 sv_catpv(tmpsv, ",PARENS"); 437 if (o->op_flags & OPf_STACKED) 438 sv_catpv(tmpsv, ",STACKED"); 439 if (o->op_flags & OPf_REF) 440 sv_catpv(tmpsv, ",REF"); 441 if (o->op_flags & OPf_MOD) 442 sv_catpv(tmpsv, ",MOD"); 443 if (o->op_flags & OPf_SPECIAL) 444 sv_catpv(tmpsv, ",SPECIAL"); 445 Perl_dump_indent(aTHX_ level, file, "FLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : ""); 446 SvREFCNT_dec(tmpsv); 447 } 448 if (o->op_private) { 449 SV *tmpsv = newSVpvn("", 0); 450 if (PL_opargs[o->op_type] & OA_TARGLEX) { 451 if (o->op_private & OPpTARGET_MY) 452 sv_catpv(tmpsv, ",TARGET_MY"); 453 } 454 else if (o->op_type == OP_LEAVESUB || 455 o->op_type == OP_LEAVE || 456 o->op_type == OP_LEAVESUBLV || 457 o->op_type == OP_LEAVEWRITE) { 458 if (o->op_private & OPpREFCOUNTED) 459 sv_catpv(tmpsv, ",REFCOUNTED"); 460 } 461 else if (o->op_type == OP_AASSIGN) { 462 if (o->op_private & OPpASSIGN_COMMON) 463 sv_catpv(tmpsv, ",COMMON"); 464 if (o->op_private & OPpASSIGN_HASH) 465 sv_catpv(tmpsv, ",HASH"); 466 } 467 else if (o->op_type == OP_SASSIGN) { 468 if (o->op_private & OPpASSIGN_BACKWARDS) 469 sv_catpv(tmpsv, ",BACKWARDS"); 470 } 471 else if (o->op_type == OP_TRANS) { 472 if (o->op_private & OPpTRANS_SQUASH) 473 sv_catpv(tmpsv, ",SQUASH"); 474 if (o->op_private & OPpTRANS_DELETE) 475 sv_catpv(tmpsv, ",DELETE"); 476 if (o->op_private & OPpTRANS_COMPLEMENT) 477 sv_catpv(tmpsv, ",COMPLEMENT"); 478 if (o->op_private & OPpTRANS_IDENTICAL) 479 sv_catpv(tmpsv, ",IDENTICAL"); 480 if (o->op_private & OPpTRANS_GROWS) 481 sv_catpv(tmpsv, ",GROWS"); 482 } 483 else if (o->op_type == OP_REPEAT) { 484 if (o->op_private & OPpREPEAT_DOLIST) 485 sv_catpv(tmpsv, ",DOLIST"); 486 } 487 else if (o->op_type == OP_ENTERSUB || 488 o->op_type == OP_RV2SV || 489 o->op_type == OP_GVSV || 490 o->op_type == OP_RV2AV || 491 o->op_type == OP_RV2HV || 492 o->op_type == OP_RV2GV || 493 o->op_type == OP_AELEM || 494 o->op_type == OP_HELEM ) 495 { 496 if (o->op_type == OP_ENTERSUB) { 497 if (o->op_private & OPpENTERSUB_AMPER) 498 sv_catpv(tmpsv, ",AMPER"); 499 if (o->op_private & OPpENTERSUB_DB) 500 sv_catpv(tmpsv, ",DB"); 501 if (o->op_private & OPpENTERSUB_HASTARG) 502 sv_catpv(tmpsv, ",HASTARG"); 503 if (o->op_private & OPpENTERSUB_NOPAREN) 504 sv_catpv(tmpsv, ",NOPAREN"); 505 if (o->op_private & OPpENTERSUB_INARGS) 506 sv_catpv(tmpsv, ",INARGS"); 507 if (o->op_private & OPpENTERSUB_NOMOD) 508 sv_catpv(tmpsv, ",NOMOD"); 509 } 510 else { 511 switch (o->op_private & OPpDEREF) { 512 case OPpDEREF_SV: 513 sv_catpv(tmpsv, ",SV"); 514 break; 515 case OPpDEREF_AV: 516 sv_catpv(tmpsv, ",AV"); 517 break; 518 case OPpDEREF_HV: 519 sv_catpv(tmpsv, ",HV"); 520 break; 521 } 522 if (o->op_private & OPpMAYBE_LVSUB) 523 sv_catpv(tmpsv, ",MAYBE_LVSUB"); 524 } 525 if (o->op_type == OP_AELEM || o->op_type == OP_HELEM) { 526 if (o->op_private & OPpLVAL_DEFER) 527 sv_catpv(tmpsv, ",LVAL_DEFER"); 528 } 529 else { 530 if (o->op_private & HINT_STRICT_REFS) 531 sv_catpv(tmpsv, ",STRICT_REFS"); 532 if (o->op_private & OPpOUR_INTRO) 533 sv_catpv(tmpsv, ",OUR_INTRO"); 534 } 535 } 536 else if (o->op_type == OP_CONST) { 537 if (o->op_private & OPpCONST_BARE) 538 sv_catpv(tmpsv, ",BARE"); 539 if (o->op_private & OPpCONST_STRICT) 540 sv_catpv(tmpsv, ",STRICT"); 541 if (o->op_private & OPpCONST_ARYBASE) 542 sv_catpv(tmpsv, ",ARYBASE"); 543 if (o->op_private & OPpCONST_WARNING) 544 sv_catpv(tmpsv, ",WARNING"); 545 if (o->op_private & OPpCONST_ENTERED) 546 sv_catpv(tmpsv, ",ENTERED"); 547 } 548 else if (o->op_type == OP_FLIP) { 549 if (o->op_private & OPpFLIP_LINENUM) 550 sv_catpv(tmpsv, ",LINENUM"); 551 } 552 else if (o->op_type == OP_FLOP) { 553 if (o->op_private & OPpFLIP_LINENUM) 554 sv_catpv(tmpsv, ",LINENUM"); 555 } 556 else if (o->op_type == OP_RV2CV) { 557 if (o->op_private & OPpLVAL_INTRO) 558 sv_catpv(tmpsv, ",INTRO"); 559 } 560 else if (o->op_type == OP_GV) { 561 if (o->op_private & OPpEARLY_CV) 562 sv_catpv(tmpsv, ",EARLY_CV"); 563 } 564 else if (o->op_type == OP_LIST) { 565 if (o->op_private & OPpLIST_GUESSED) 566 sv_catpv(tmpsv, ",GUESSED"); 567 } 568 else if (o->op_type == OP_DELETE) { 569 if (o->op_private & OPpSLICE) 570 sv_catpv(tmpsv, ",SLICE"); 571 } 572 else if (o->op_type == OP_EXISTS) { 573 if (o->op_private & OPpEXISTS_SUB) 574 sv_catpv(tmpsv, ",EXISTS_SUB"); 575 } 576 else if (o->op_type == OP_SORT) { 577 if (o->op_private & OPpSORT_NUMERIC) 578 sv_catpv(tmpsv, ",NUMERIC"); 579 if (o->op_private & OPpSORT_INTEGER) 580 sv_catpv(tmpsv, ",INTEGER"); 581 if (o->op_private & OPpSORT_REVERSE) 582 sv_catpv(tmpsv, ",REVERSE"); 583 } 584 else if (o->op_type == OP_THREADSV) { 585 if (o->op_private & OPpDONE_SVREF) 586 sv_catpv(tmpsv, ",SVREF"); 587 } 588 else if (o->op_type == OP_OPEN || o->op_type == OP_BACKTICK) { 589 if (o->op_private & OPpOPEN_IN_RAW) 590 sv_catpv(tmpsv, ",IN_RAW"); 591 if (o->op_private & OPpOPEN_IN_CRLF) 592 sv_catpv(tmpsv, ",IN_CRLF"); 593 if (o->op_private & OPpOPEN_OUT_RAW) 594 sv_catpv(tmpsv, ",OUT_RAW"); 595 if (o->op_private & OPpOPEN_OUT_CRLF) 596 sv_catpv(tmpsv, ",OUT_CRLF"); 597 } 598 else if (o->op_type == OP_EXIT) { 599 if (o->op_private & OPpEXIT_VMSISH) 600 sv_catpv(tmpsv, ",EXIT_VMSISH"); 601 if (o->op_private & OPpHUSH_VMSISH) 602 sv_catpv(tmpsv, ",HUSH_VMSISH"); 603 } 604 else if (o->op_type == OP_DIE) { 605 if (o->op_private & OPpHUSH_VMSISH) 606 sv_catpv(tmpsv, ",HUSH_VMSISH"); 607 } 608 if (o->op_flags & OPf_MOD && o->op_private & OPpLVAL_INTRO) 609 sv_catpv(tmpsv, ",INTRO"); 610 if (SvCUR(tmpsv)) 611 Perl_dump_indent(aTHX_ level, file, "PRIVATE = (%s)\n", SvPVX(tmpsv) + 1); 612 SvREFCNT_dec(tmpsv); 613 } 614 615 switch (o->op_type) { 616 case OP_AELEMFAST: 617 case OP_GVSV: 618 case OP_GV: 619 #ifdef USE_ITHREADS 620 Perl_dump_indent(aTHX_ level, file, "PADIX = %" IVdf "\n", (IV)cPADOPo->op_padix); 621 #else 622 if (cSVOPo->op_sv) { 623 SV *tmpsv = NEWSV(0,0); 624 STRLEN n_a; 625 ENTER; 626 SAVEFREESV(tmpsv); 627 gv_fullname3(tmpsv, (GV*)cSVOPo->op_sv, Nullch); 628 Perl_dump_indent(aTHX_ level, file, "GV = %s\n", SvPV(tmpsv, n_a)); 629 LEAVE; 630 } 631 else 632 Perl_dump_indent(aTHX_ level, file, "GV = NULL\n"); 633 #endif 634 break; 635 case OP_CONST: 636 case OP_METHOD_NAMED: 637 Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cSVOPo->op_sv)); 638 break; 639 case OP_SETSTATE: 640 case OP_NEXTSTATE: 641 case OP_DBSTATE: 642 if (CopLINE(cCOPo)) 643 Perl_dump_indent(aTHX_ level, file, "LINE = %d\n",CopLINE(cCOPo)); 644 if (CopSTASHPV(cCOPo)) 645 Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n", 646 CopSTASHPV(cCOPo)); 647 if (cCOPo->cop_label) 648 Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n", 649 cCOPo->cop_label); 650 break; 651 case OP_ENTERLOOP: 652 Perl_dump_indent(aTHX_ level, file, "REDO ===> "); 653 if (cLOOPo->op_redoop) 654 PerlIO_printf(file, "%d\n", cLOOPo->op_redoop->op_seq); 655 else 656 PerlIO_printf(file, "DONE\n"); 657 Perl_dump_indent(aTHX_ level, file, "NEXT ===> "); 658 if (cLOOPo->op_nextop) 659 PerlIO_printf(file, "%d\n", cLOOPo->op_nextop->op_seq); 660 else 661 PerlIO_printf(file, "DONE\n"); 662 Perl_dump_indent(aTHX_ level, file, "LAST ===> "); 663 if (cLOOPo->op_lastop) 664 PerlIO_printf(file, "%d\n", cLOOPo->op_lastop->op_seq); 665 else 666 PerlIO_printf(file, "DONE\n"); 667 break; 668 case OP_COND_EXPR: 669 case OP_RANGE: 670 case OP_MAPWHILE: 671 case OP_GREPWHILE: 672 case OP_OR: 673 case OP_AND: 674 Perl_dump_indent(aTHX_ level, file, "OTHER ===> "); 675 if (cLOGOPo->op_other) 676 PerlIO_printf(file, "%d\n", cLOGOPo->op_other->op_seq); 677 else 678 PerlIO_printf(file, "DONE\n"); 679 break; 680 case OP_PUSHRE: 681 case OP_MATCH: 682 case OP_QR: 683 case OP_SUBST: 684 do_pmop_dump(level, file, cPMOPo); 685 break; 686 case OP_LEAVE: 687 case OP_LEAVEEVAL: 688 case OP_LEAVESUB: 689 case OP_LEAVESUBLV: 690 case OP_LEAVEWRITE: 691 case OP_SCOPE: 692 if (o->op_private & OPpREFCOUNTED) 693 Perl_dump_indent(aTHX_ level, file, "REFCNT = %"UVuf"\n", (UV)o->op_targ); 694 break; 695 default: 696 break; 697 } 698 if (o->op_flags & OPf_KIDS) { 699 OP *kid; 700 for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) 701 do_op_dump(level, file, kid); 702 } 703 Perl_dump_indent(aTHX_ level-1, file, "}\n"); 704 } 705 706 void 707 Perl_op_dump(pTHX_ OP *o) 708 { 709 do_op_dump(0, Perl_debug_log, o); 710 } 711 712 void 713 Perl_gv_dump(pTHX_ GV *gv) 714 { 715 SV *sv; 716 717 if (!gv) { 718 PerlIO_printf(Perl_debug_log, "{}\n"); 719 return; 720 } 721 sv = sv_newmortal(); 722 PerlIO_printf(Perl_debug_log, "{\n"); 723 gv_fullname3(sv, gv, Nullch); 724 Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %s", SvPVX(sv)); 725 if (gv != GvEGV(gv)) { 726 gv_efullname3(sv, GvEGV(gv), Nullch); 727 Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s", SvPVX(sv)); 728 } 729 PerlIO_putc(Perl_debug_log, '\n'); 730 Perl_dump_indent(aTHX_ 0, Perl_debug_log, "}\n"); 731 } 732 733 734 /* map magic types to the symbolic names 735 * (with the PERL_MAGIC_ prefixed stripped) 736 */ 737 738 static struct { char type; char *name; } magic_names[] = { 739 { PERL_MAGIC_sv, "sv(\\0)" }, 740 { PERL_MAGIC_arylen, "arylen(#)" }, 741 { PERL_MAGIC_glob, "glob(*)" }, 742 { PERL_MAGIC_pos, "pos(.)" }, 743 { PERL_MAGIC_backref, "backref(<)" }, 744 { PERL_MAGIC_overload, "overload(A)" }, 745 { PERL_MAGIC_bm, "bm(B)" }, 746 { PERL_MAGIC_regdata, "regdata(D)" }, 747 { PERL_MAGIC_env, "env(E)" }, 748 { PERL_MAGIC_isa, "isa(I)" }, 749 { PERL_MAGIC_dbfile, "dbfile(L)" }, 750 { PERL_MAGIC_shared, "shared(N)" }, 751 { PERL_MAGIC_tied, "tied(P)" }, 752 { PERL_MAGIC_sig, "sig(S)" }, 753 { PERL_MAGIC_uvar, "uvar(U)" }, 754 { PERL_MAGIC_overload_elem, "overload_elem(a)" }, 755 { PERL_MAGIC_overload_table, "overload_table(c)" }, 756 { PERL_MAGIC_regdatum, "regdatum(d)" }, 757 { PERL_MAGIC_envelem, "envelem(e)" }, 758 { PERL_MAGIC_fm, "fm(f)" }, 759 { PERL_MAGIC_regex_global, "regex_global(g)" }, 760 { PERL_MAGIC_isaelem, "isaelem(i)" }, 761 { PERL_MAGIC_nkeys, "nkeys(k)" }, 762 { PERL_MAGIC_dbline, "dbline(l)" }, 763 { PERL_MAGIC_mutex, "mutex(m)" }, 764 { PERL_MAGIC_shared_scalar, "shared_scalar(n)" }, 765 { PERL_MAGIC_collxfrm, "collxfrm(o)" }, 766 { PERL_MAGIC_tiedelem, "tiedelem(p)" }, 767 { PERL_MAGIC_tiedscalar, "tiedscalar(q)" }, 768 { PERL_MAGIC_qr, "qr(r)" }, 769 { PERL_MAGIC_sigelem, "sigelem(s)" }, 770 { PERL_MAGIC_taint, "taint(t)" }, 771 { PERL_MAGIC_uvar_elem, "uvar_elem(v)" }, 772 { PERL_MAGIC_vec, "vec(v)" }, 773 { PERL_MAGIC_substr, "substr(x)" }, 774 { PERL_MAGIC_defelem, "defelem(y)" }, 775 { PERL_MAGIC_ext, "ext(~)" }, 776 /* this null string terminates the list */ 777 { 0, 0 }, 778 }; 779 780 void 781 Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, MAGIC *mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim) 782 { 783 for (; mg; mg = mg->mg_moremagic) { 784 Perl_dump_indent(aTHX_ level, file, 785 " MAGIC = 0x%"UVxf"\n", PTR2UV(mg)); 786 if (mg->mg_virtual) { 787 MGVTBL *v = mg->mg_virtual; 788 char *s = 0; 789 if (v == &PL_vtbl_sv) s = "sv"; 790 else if (v == &PL_vtbl_env) s = "env"; 791 else if (v == &PL_vtbl_envelem) s = "envelem"; 792 else if (v == &PL_vtbl_sig) s = "sig"; 793 else if (v == &PL_vtbl_sigelem) s = "sigelem"; 794 else if (v == &PL_vtbl_pack) s = "pack"; 795 else if (v == &PL_vtbl_packelem) s = "packelem"; 796 else if (v == &PL_vtbl_dbline) s = "dbline"; 797 else if (v == &PL_vtbl_isa) s = "isa"; 798 else if (v == &PL_vtbl_arylen) s = "arylen"; 799 else if (v == &PL_vtbl_glob) s = "glob"; 800 else if (v == &PL_vtbl_mglob) s = "mglob"; 801 else if (v == &PL_vtbl_nkeys) s = "nkeys"; 802 else if (v == &PL_vtbl_taint) s = "taint"; 803 else if (v == &PL_vtbl_substr) s = "substr"; 804 else if (v == &PL_vtbl_vec) s = "vec"; 805 else if (v == &PL_vtbl_pos) s = "pos"; 806 else if (v == &PL_vtbl_bm) s = "bm"; 807 else if (v == &PL_vtbl_fm) s = "fm"; 808 else if (v == &PL_vtbl_uvar) s = "uvar"; 809 else if (v == &PL_vtbl_defelem) s = "defelem"; 810 #ifdef USE_LOCALE_COLLATE 811 else if (v == &PL_vtbl_collxfrm) s = "collxfrm"; 812 #endif 813 else if (v == &PL_vtbl_amagic) s = "amagic"; 814 else if (v == &PL_vtbl_amagicelem) s = "amagicelem"; 815 else if (v == &PL_vtbl_backref) s = "backref"; 816 if (s) 817 Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = &PL_vtbl_%s\n", s); 818 else 819 Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0x%"UVxf"\n", PTR2UV(v)); 820 } 821 else 822 Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0\n"); 823 824 if (mg->mg_private) 825 Perl_dump_indent(aTHX_ level, file, " MG_PRIVATE = %d\n", mg->mg_private); 826 827 { 828 int n; 829 char *name = 0; 830 for (n=0; magic_names[n].name; n++) { 831 if (mg->mg_type == magic_names[n].type) { 832 name = magic_names[n].name; 833 break; 834 } 835 } 836 if (name) 837 Perl_dump_indent(aTHX_ level, file, 838 " MG_TYPE = PERL_MAGIC_%s\n", name); 839 else 840 Perl_dump_indent(aTHX_ level, file, 841 " MG_TYPE = UNKNOWN(\\%o)\n", mg->mg_type); 842 } 843 844 if (mg->mg_flags) { 845 Perl_dump_indent(aTHX_ level, file, " MG_FLAGS = 0x%02X\n", mg->mg_flags); 846 if (mg->mg_flags & MGf_TAINTEDDIR) 847 Perl_dump_indent(aTHX_ level, file, " TAINTEDDIR\n"); 848 if (mg->mg_flags & MGf_REFCOUNTED) 849 Perl_dump_indent(aTHX_ level, file, " REFCOUNTED\n"); 850 if (mg->mg_flags & MGf_GSKIP) 851 Perl_dump_indent(aTHX_ level, file, " GSKIP\n"); 852 if (mg->mg_flags & MGf_MINMATCH) 853 Perl_dump_indent(aTHX_ level, file, " MINMATCH\n"); 854 } 855 if (mg->mg_obj) { 856 Perl_dump_indent(aTHX_ level, file, " MG_OBJ = 0x%"UVxf"\n", PTR2UV(mg->mg_obj)); 857 if (mg->mg_flags & MGf_REFCOUNTED) 858 do_sv_dump(level+2, file, mg->mg_obj, nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */ 859 } 860 if (mg->mg_len) 861 Perl_dump_indent(aTHX_ level, file, " MG_LEN = %ld\n", (long)mg->mg_len); 862 if (mg->mg_ptr) { 863 Perl_dump_indent(aTHX_ level, file, " MG_PTR = 0x%"UVxf, PTR2UV(mg->mg_ptr)); 864 if (mg->mg_len >= 0) { 865 SV *sv = newSVpvn("", 0); 866 PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim)); 867 SvREFCNT_dec(sv); 868 } 869 else if (mg->mg_len == HEf_SVKEY) { 870 PerlIO_puts(file, " => HEf_SVKEY\n"); 871 do_sv_dump(level+2, file, (SV*)((mg)->mg_ptr), nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */ 872 continue; 873 } 874 else 875 PerlIO_puts(file, " ???? - please notify IZ"); 876 PerlIO_putc(file, '\n'); 877 } 878 } 879 } 880 881 void 882 Perl_magic_dump(pTHX_ MAGIC *mg) 883 { 884 do_magic_dump(0, Perl_debug_log, mg, 0, 0, 0, 0); 885 } 886 887 void 888 Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, char *name, HV *sv) 889 { 890 Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv)); 891 if (sv && HvNAME(sv)) 892 PerlIO_printf(file, "\t\"%s\"\n", HvNAME(sv)); 893 else 894 PerlIO_putc(file, '\n'); 895 } 896 897 void 898 Perl_do_gv_dump(pTHX_ I32 level, PerlIO *file, char *name, GV *sv) 899 { 900 Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv)); 901 if (sv && GvNAME(sv)) 902 PerlIO_printf(file, "\t\"%s\"\n", GvNAME(sv)); 903 else 904 PerlIO_putc(file, '\n'); 905 } 906 907 void 908 Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, char *name, GV *sv) 909 { 910 Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv)); 911 if (sv && GvNAME(sv)) { 912 PerlIO_printf(file, "\t\""); 913 if (GvSTASH(sv)) 914 PerlIO_printf(file, "%s\" :: \"", HvNAME(GvSTASH(sv))); 915 PerlIO_printf(file, "%s\"\n", GvNAME(sv)); 916 } 917 else 918 PerlIO_putc(file, '\n'); 919 } 920 921 void 922 Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim) 923 { 924 SV *d; 925 char *s; 926 U32 flags; 927 U32 type; 928 STRLEN n_a; 929 930 if (!sv) { 931 Perl_dump_indent(aTHX_ level, file, "SV = 0\n"); 932 return; 933 } 934 935 flags = SvFLAGS(sv); 936 type = SvTYPE(sv); 937 938 d = Perl_newSVpvf(aTHX_ 939 "(0x%"UVxf") at 0x%"UVxf"\n%*s REFCNT = %"IVdf"\n%*s FLAGS = (", 940 PTR2UV(SvANY(sv)), PTR2UV(sv), 941 (int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv), 942 (int)(PL_dumpindent*level), ""); 943 944 if (flags & SVs_PADBUSY) sv_catpv(d, "PADBUSY,"); 945 if (flags & SVs_PADTMP) sv_catpv(d, "PADTMP,"); 946 if (flags & SVs_PADMY) sv_catpv(d, "PADMY,"); 947 if (flags & SVs_TEMP) sv_catpv(d, "TEMP,"); 948 if (flags & SVs_OBJECT) sv_catpv(d, "OBJECT,"); 949 if (flags & SVs_GMG) sv_catpv(d, "GMG,"); 950 if (flags & SVs_SMG) sv_catpv(d, "SMG,"); 951 if (flags & SVs_RMG) sv_catpv(d, "RMG,"); 952 953 if (flags & SVf_IOK) sv_catpv(d, "IOK,"); 954 if (flags & SVf_NOK) sv_catpv(d, "NOK,"); 955 if (flags & SVf_POK) sv_catpv(d, "POK,"); 956 if (flags & SVf_ROK) { 957 sv_catpv(d, "ROK,"); 958 if (SvWEAKREF(sv)) sv_catpv(d, "WEAKREF,"); 959 } 960 if (flags & SVf_OOK) sv_catpv(d, "OOK,"); 961 if (flags & SVf_FAKE) sv_catpv(d, "FAKE,"); 962 if (flags & SVf_READONLY) sv_catpv(d, "READONLY,"); 963 964 if (flags & SVf_AMAGIC) sv_catpv(d, "OVERLOAD,"); 965 if (flags & SVp_IOK) sv_catpv(d, "pIOK,"); 966 if (flags & SVp_NOK) sv_catpv(d, "pNOK,"); 967 if (flags & SVp_POK) sv_catpv(d, "pPOK,"); 968 if (flags & SVp_SCREAM) sv_catpv(d, "SCREAM,"); 969 970 switch (type) { 971 case SVt_PVCV: 972 case SVt_PVFM: 973 if (CvANON(sv)) sv_catpv(d, "ANON,"); 974 if (CvUNIQUE(sv)) sv_catpv(d, "UNIQUE,"); 975 if (CvCLONE(sv)) sv_catpv(d, "CLONE,"); 976 if (CvCLONED(sv)) sv_catpv(d, "CLONED,"); 977 if (CvCONST(sv)) sv_catpv(d, "CONST,"); 978 if (CvNODEBUG(sv)) sv_catpv(d, "NODEBUG,"); 979 if (SvCOMPILED(sv)) sv_catpv(d, "COMPILED,"); 980 if (CvLVALUE(sv)) sv_catpv(d, "LVALUE,"); 981 if (CvMETHOD(sv)) sv_catpv(d, "METHOD,"); 982 if (CvLOCKED(sv)) sv_catpv(d, "LOCKED,"); 983 break; 984 case SVt_PVHV: 985 if (HvSHAREKEYS(sv)) sv_catpv(d, "SHAREKEYS,"); 986 if (HvLAZYDEL(sv)) sv_catpv(d, "LAZYDEL,"); 987 if (HvHASKFLAGS(sv)) sv_catpv(d, "HASKFLAGS,"); 988 break; 989 case SVt_PVGV: 990 if (GvINTRO(sv)) sv_catpv(d, "INTRO,"); 991 if (GvMULTI(sv)) sv_catpv(d, "MULTI,"); 992 if (GvUNIQUE(sv)) sv_catpv(d, "UNIQUE,"); 993 if (GvASSUMECV(sv)) sv_catpv(d, "ASSUMECV,"); 994 if (GvIN_PAD(sv)) sv_catpv(d, "IN_PAD,"); 995 if (flags & SVpad_OUR) sv_catpv(d, "OUR,"); 996 if (GvIMPORTED(sv)) { 997 sv_catpv(d, "IMPORT"); 998 if (GvIMPORTED(sv) == GVf_IMPORTED) 999 sv_catpv(d, "ALL,"); 1000 else { 1001 sv_catpv(d, "("); 1002 if (GvIMPORTED_SV(sv)) sv_catpv(d, " SV"); 1003 if (GvIMPORTED_AV(sv)) sv_catpv(d, " AV"); 1004 if (GvIMPORTED_HV(sv)) sv_catpv(d, " HV"); 1005 if (GvIMPORTED_CV(sv)) sv_catpv(d, " CV"); 1006 sv_catpv(d, " ),"); 1007 } 1008 } 1009 /* FALL THROUGH */ 1010 default: 1011 if (SvEVALED(sv)) sv_catpv(d, "EVALED,"); 1012 if (SvIsUV(sv)) sv_catpv(d, "IsUV,"); 1013 break; 1014 case SVt_PVBM: 1015 if (SvTAIL(sv)) sv_catpv(d, "TAIL,"); 1016 if (SvVALID(sv)) sv_catpv(d, "VALID,"); 1017 break; 1018 case SVt_PVMG: 1019 if (flags & SVpad_TYPED) 1020 sv_catpv(d, "TYPED,"); 1021 break; 1022 } 1023 if (SvPOK(sv) && SvUTF8(sv)) 1024 sv_catpv(d, "UTF8"); 1025 1026 if (*(SvEND(d) - 1) == ',') 1027 SvPVX(d)[--SvCUR(d)] = '\0'; 1028 sv_catpv(d, ")"); 1029 s = SvPVX(d); 1030 1031 Perl_dump_indent(aTHX_ level, file, "SV = "); 1032 switch (type) { 1033 case SVt_NULL: 1034 PerlIO_printf(file, "NULL%s\n", s); 1035 SvREFCNT_dec(d); 1036 return; 1037 case SVt_IV: 1038 PerlIO_printf(file, "IV%s\n", s); 1039 break; 1040 case SVt_NV: 1041 PerlIO_printf(file, "NV%s\n", s); 1042 break; 1043 case SVt_RV: 1044 PerlIO_printf(file, "RV%s\n", s); 1045 break; 1046 case SVt_PV: 1047 PerlIO_printf(file, "PV%s\n", s); 1048 break; 1049 case SVt_PVIV: 1050 PerlIO_printf(file, "PVIV%s\n", s); 1051 break; 1052 case SVt_PVNV: 1053 PerlIO_printf(file, "PVNV%s\n", s); 1054 break; 1055 case SVt_PVBM: 1056 PerlIO_printf(file, "PVBM%s\n", s); 1057 break; 1058 case SVt_PVMG: 1059 PerlIO_printf(file, "PVMG%s\n", s); 1060 break; 1061 case SVt_PVLV: 1062 PerlIO_printf(file, "PVLV%s\n", s); 1063 break; 1064 case SVt_PVAV: 1065 PerlIO_printf(file, "PVAV%s\n", s); 1066 break; 1067 case SVt_PVHV: 1068 PerlIO_printf(file, "PVHV%s\n", s); 1069 break; 1070 case SVt_PVCV: 1071 PerlIO_printf(file, "PVCV%s\n", s); 1072 break; 1073 case SVt_PVGV: 1074 PerlIO_printf(file, "PVGV%s\n", s); 1075 break; 1076 case SVt_PVFM: 1077 PerlIO_printf(file, "PVFM%s\n", s); 1078 break; 1079 case SVt_PVIO: 1080 PerlIO_printf(file, "PVIO%s\n", s); 1081 break; 1082 default: 1083 PerlIO_printf(file, "UNKNOWN(0x%"UVxf") %s\n", (UV)type, s); 1084 SvREFCNT_dec(d); 1085 return; 1086 } 1087 if (type >= SVt_PVIV || type == SVt_IV) { 1088 if (SvIsUV(sv)) 1089 Perl_dump_indent(aTHX_ level, file, " UV = %"UVuf, (UV)SvUVX(sv)); 1090 else 1091 Perl_dump_indent(aTHX_ level, file, " IV = %"IVdf, (IV)SvIVX(sv)); 1092 if (SvOOK(sv)) 1093 PerlIO_printf(file, " (OFFSET)"); 1094 PerlIO_putc(file, '\n'); 1095 } 1096 if (type >= SVt_PVNV || type == SVt_NV) { 1097 STORE_NUMERIC_LOCAL_SET_STANDARD(); 1098 /* %Vg doesn't work? --jhi */ 1099 #ifdef USE_LONG_DOUBLE 1100 Perl_dump_indent(aTHX_ level, file, " NV = %.*" PERL_PRIgldbl "\n", LDBL_DIG, SvNVX(sv)); 1101 #else 1102 Perl_dump_indent(aTHX_ level, file, " NV = %.*g\n", DBL_DIG, SvNVX(sv)); 1103 #endif 1104 RESTORE_NUMERIC_LOCAL(); 1105 } 1106 if (SvROK(sv)) { 1107 Perl_dump_indent(aTHX_ level, file, " RV = 0x%"UVxf"\n", PTR2UV(SvRV(sv))); 1108 if (nest < maxnest) 1109 do_sv_dump(level+1, file, SvRV(sv), nest+1, maxnest, dumpops, pvlim); 1110 SvREFCNT_dec(d); 1111 return; 1112 } 1113 if (type < SVt_PV) { 1114 SvREFCNT_dec(d); 1115 return; 1116 } 1117 if (type <= SVt_PVLV) { 1118 if (SvPVX(sv)) { 1119 Perl_dump_indent(aTHX_ level, file," PV = 0x%"UVxf" ", PTR2UV(SvPVX(sv))); 1120 if (SvOOK(sv)) 1121 PerlIO_printf(file, "( %s . ) ", pv_display(d, SvPVX(sv)-SvIVX(sv), SvIVX(sv), 0, pvlim)); 1122 PerlIO_printf(file, "%s", pv_display(d, SvPVX(sv), SvCUR(sv), SvLEN(sv), pvlim)); 1123 if (SvUTF8(sv)) /* the 8? \x{....} */ 1124 PerlIO_printf(file, " [UTF8 \"%s\"]", sv_uni_display(d, sv, 8 * sv_len_utf8(sv), UNI_DISPLAY_QQ)); 1125 PerlIO_printf(file, "\n"); 1126 Perl_dump_indent(aTHX_ level, file, " CUR = %"IVdf"\n", (IV)SvCUR(sv)); 1127 Perl_dump_indent(aTHX_ level, file, " LEN = %"IVdf"\n", (IV)SvLEN(sv)); 1128 } 1129 else 1130 Perl_dump_indent(aTHX_ level, file, " PV = 0\n"); 1131 } 1132 if (type >= SVt_PVMG) { 1133 if (SvMAGIC(sv)) 1134 do_magic_dump(level, file, SvMAGIC(sv), nest, maxnest, dumpops, pvlim); 1135 if (SvSTASH(sv)) 1136 do_hv_dump(level, file, " STASH", SvSTASH(sv)); 1137 } 1138 switch (type) { 1139 case SVt_PVLV: 1140 Perl_dump_indent(aTHX_ level, file, " TYPE = %c\n", LvTYPE(sv)); 1141 Perl_dump_indent(aTHX_ level, file, " TARGOFF = %"IVdf"\n", (IV)LvTARGOFF(sv)); 1142 Perl_dump_indent(aTHX_ level, file, " TARGLEN = %"IVdf"\n", (IV)LvTARGLEN(sv)); 1143 Perl_dump_indent(aTHX_ level, file, " TARG = 0x%"UVxf"\n", PTR2UV(LvTARG(sv))); 1144 /* XXX level+1 ??? */ 1145 do_sv_dump(level, file, LvTARG(sv), nest+1, maxnest, dumpops, pvlim); 1146 break; 1147 case SVt_PVAV: 1148 Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(AvARRAY(sv))); 1149 if (AvARRAY(sv) != AvALLOC(sv)) { 1150 PerlIO_printf(file, " (offset=%"IVdf")\n", (IV)(AvARRAY(sv) - AvALLOC(sv))); 1151 Perl_dump_indent(aTHX_ level, file, " ALLOC = 0x%"UVxf"\n", PTR2UV(AvALLOC(sv))); 1152 } 1153 else 1154 PerlIO_putc(file, '\n'); 1155 Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)AvFILLp(sv)); 1156 Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)AvMAX(sv)); 1157 Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%"UVxf"\n", PTR2UV(AvARYLEN(sv))); 1158 flags = AvFLAGS(sv); 1159 sv_setpv(d, ""); 1160 if (flags & AVf_REAL) sv_catpv(d, ",REAL"); 1161 if (flags & AVf_REIFY) sv_catpv(d, ",REIFY"); 1162 if (flags & AVf_REUSED) sv_catpv(d, ",REUSED"); 1163 Perl_dump_indent(aTHX_ level, file, " FLAGS = (%s)\n", SvCUR(d) ? SvPVX(d) + 1 : ""); 1164 if (nest < maxnest && av_len((AV*)sv) >= 0) { 1165 int count; 1166 for (count = 0; count <= av_len((AV*)sv) && count < maxnest; count++) { 1167 SV** elt = av_fetch((AV*)sv,count,0); 1168 1169 Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %"IVdf"\n", (IV)count); 1170 if (elt) 1171 do_sv_dump(level+1, file, *elt, nest+1, maxnest, dumpops, pvlim); 1172 } 1173 } 1174 break; 1175 case SVt_PVHV: 1176 Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(HvARRAY(sv))); 1177 if (HvARRAY(sv) && HvKEYS(sv)) { 1178 /* Show distribution of HEs in the ARRAY */ 1179 int freq[200]; 1180 #define FREQ_MAX (sizeof freq / sizeof freq[0] - 1) 1181 int i; 1182 int max = 0; 1183 U32 pow2 = 2, keys = HvKEYS(sv); 1184 NV theoret, sum = 0; 1185 1186 PerlIO_printf(file, " ("); 1187 Zero(freq, FREQ_MAX + 1, int); 1188 for (i = 0; (STRLEN)i <= HvMAX(sv); i++) { 1189 HE* h; int count = 0; 1190 for (h = HvARRAY(sv)[i]; h; h = HeNEXT(h)) 1191 count++; 1192 if (count > FREQ_MAX) 1193 count = FREQ_MAX; 1194 freq[count]++; 1195 if (max < count) 1196 max = count; 1197 } 1198 for (i = 0; i <= max; i++) { 1199 if (freq[i]) { 1200 PerlIO_printf(file, "%d%s:%d", i, 1201 (i == FREQ_MAX) ? "+" : "", 1202 freq[i]); 1203 if (i != max) 1204 PerlIO_printf(file, ", "); 1205 } 1206 } 1207 PerlIO_putc(file, ')'); 1208 /* The "quality" of a hash is defined as the total number of 1209 comparisons needed to access every element once, relative 1210 to the expected number needed for a random hash. 1211 1212 The total number of comparisons is equal to the sum of 1213 the squares of the number of entries in each bucket. 1214 For a random hash of n keys into k buckets, the expected 1215 value is 1216 n + n(n-1)/2k 1217 */ 1218 1219 for (i = max; i > 0; i--) { /* Precision: count down. */ 1220 sum += freq[i] * i * i; 1221 } 1222 while ((keys = keys >> 1)) 1223 pow2 = pow2 << 1; 1224 theoret = HvKEYS(sv); 1225 theoret += theoret * (theoret-1)/pow2; 1226 PerlIO_putc(file, '\n'); 1227 Perl_dump_indent(aTHX_ level, file, " hash quality = %.1"NVff"%%", theoret/sum*100); 1228 } 1229 PerlIO_putc(file, '\n'); 1230 Perl_dump_indent(aTHX_ level, file, " KEYS = %"IVdf"\n", (IV)HvKEYS(sv)); 1231 Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)HvFILL(sv)); 1232 Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)HvMAX(sv)); 1233 Perl_dump_indent(aTHX_ level, file, " RITER = %"IVdf"\n", (IV)HvRITER(sv)); 1234 Perl_dump_indent(aTHX_ level, file, " EITER = 0x%"UVxf"\n", PTR2UV(HvEITER(sv))); 1235 if (HvPMROOT(sv)) 1236 Perl_dump_indent(aTHX_ level, file, " PMROOT = 0x%"UVxf"\n", PTR2UV(HvPMROOT(sv))); 1237 if (HvNAME(sv)) 1238 Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", HvNAME(sv)); 1239 if (nest < maxnest && !HvEITER(sv)) { /* Try to preserve iterator */ 1240 HE *he; 1241 HV *hv = (HV*)sv; 1242 int count = maxnest - nest; 1243 1244 hv_iterinit(hv); 1245 while ((he = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS)) 1246 && count--) { 1247 SV *elt, *keysv; 1248 char *keypv; 1249 STRLEN len; 1250 U32 hash = HeHASH(he); 1251 1252 keysv = hv_iterkeysv(he); 1253 keypv = SvPV(keysv, len); 1254 elt = hv_iterval(hv, he); 1255 Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim)); 1256 if (SvUTF8(keysv)) 1257 PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 8 * sv_len_utf8(keysv), UNI_DISPLAY_QQ)); 1258 PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV)hash); 1259 do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim); 1260 } 1261 hv_iterinit(hv); /* Return to status quo */ 1262 } 1263 break; 1264 case SVt_PVCV: 1265 if (SvPOK(sv)) 1266 Perl_dump_indent(aTHX_ level, file, " PROTOTYPE = \"%s\"\n", SvPV(sv,n_a)); 1267 /* FALL THROUGH */ 1268 case SVt_PVFM: 1269 do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv)); 1270 if (CvSTART(sv)) 1271 Perl_dump_indent(aTHX_ level, file, " START = 0x%"UVxf" ===> %"IVdf"\n", PTR2UV(CvSTART(sv)), (IV)CvSTART(sv)->op_seq); 1272 Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%"UVxf"\n", PTR2UV(CvROOT(sv))); 1273 if (CvROOT(sv) && dumpops) 1274 do_op_dump(level+1, file, CvROOT(sv)); 1275 Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv))); 1276 Perl_dump_indent(aTHX_ level, file, " XSUBANY = %"IVdf"\n", (IV)CvXSUBANY(sv).any_i32); 1277 do_gvgv_dump(level, file, " GVGV::GV", CvGV(sv)); 1278 Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", CvFILE(sv)); 1279 Perl_dump_indent(aTHX_ level, file, " DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv)); 1280 #ifdef USE_5005THREADS 1281 Perl_dump_indent(aTHX_ level, file, " MUTEXP = 0x%"UVxf"\n", PTR2UV(CvMUTEXP(sv))); 1282 Perl_dump_indent(aTHX_ level, file, " OWNER = 0x%"UVxf"\n", PTR2UV(CvOWNER(sv))); 1283 #endif /* USE_5005THREADS */ 1284 Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv)); 1285 if (type == SVt_PVFM) 1286 Perl_dump_indent(aTHX_ level, file, " LINES = %"IVdf"\n", (IV)FmLINES(sv)); 1287 Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv))); 1288 if (nest < maxnest && CvPADLIST(sv)) { 1289 AV* padlist = CvPADLIST(sv); 1290 AV* pad_name = (AV*)*av_fetch(padlist, 0, FALSE); 1291 AV* pad = (AV*)*av_fetch(padlist, 1, FALSE); 1292 SV** pname = AvARRAY(pad_name); 1293 SV** ppad = AvARRAY(pad); 1294 I32 ix; 1295 1296 for (ix = 1; ix <= AvFILL(pad_name); ix++) { 1297 if (SvPOK(pname[ix])) 1298 Perl_dump_indent(aTHX_ level, 1299 /* %5d below is enough whitespace. */ 1300 file, 1301 "%5d. 0x%"UVxf" (%s\"%s\" %"IVdf"-%"IVdf")\n", 1302 (int)ix, PTR2UV(ppad[ix]), 1303 SvFAKE(pname[ix]) ? "FAKE " : "", 1304 SvPVX(pname[ix]), 1305 (IV)SvNVX(pname[ix]), 1306 (IV)SvIVX(pname[ix])); 1307 } 1308 } 1309 { 1310 CV *outside = CvOUTSIDE(sv); 1311 Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%"UVxf" (%s)\n", 1312 PTR2UV(outside), 1313 (!outside ? "null" 1314 : CvANON(outside) ? "ANON" 1315 : (outside == PL_main_cv) ? "MAIN" 1316 : CvUNIQUE(outside) ? "UNIQUE" 1317 : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED")); 1318 } 1319 if (nest < maxnest && (CvCLONE(sv) || CvCLONED(sv))) 1320 do_sv_dump(level+1, file, (SV*)CvOUTSIDE(sv), nest+1, maxnest, dumpops, pvlim); 1321 break; 1322 case SVt_PVGV: 1323 Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", GvNAME(sv)); 1324 Perl_dump_indent(aTHX_ level, file, " NAMELEN = %"IVdf"\n", (IV)GvNAMELEN(sv)); 1325 do_hv_dump (level, file, " GvSTASH", GvSTASH(sv)); 1326 Perl_dump_indent(aTHX_ level, file, " GP = 0x%"UVxf"\n", PTR2UV(GvGP(sv))); 1327 if (!GvGP(sv)) 1328 break; 1329 Perl_dump_indent(aTHX_ level, file, " SV = 0x%"UVxf"\n", PTR2UV(GvSV(sv))); 1330 Perl_dump_indent(aTHX_ level, file, " REFCNT = %"IVdf"\n", (IV)GvREFCNT(sv)); 1331 Perl_dump_indent(aTHX_ level, file, " IO = 0x%"UVxf"\n", PTR2UV(GvIOp(sv))); 1332 Perl_dump_indent(aTHX_ level, file, " FORM = 0x%"UVxf" \n", PTR2UV(GvFORM(sv))); 1333 Perl_dump_indent(aTHX_ level, file, " AV = 0x%"UVxf"\n", PTR2UV(GvAV(sv))); 1334 Perl_dump_indent(aTHX_ level, file, " HV = 0x%"UVxf"\n", PTR2UV(GvHV(sv))); 1335 Perl_dump_indent(aTHX_ level, file, " CV = 0x%"UVxf"\n", PTR2UV(GvCV(sv))); 1336 Perl_dump_indent(aTHX_ level, file, " CVGEN = 0x%"UVxf"\n", (UV)GvCVGEN(sv)); 1337 Perl_dump_indent(aTHX_ level, file, " GPFLAGS = 0x%"UVxf"\n", (UV)GvGPFLAGS(sv)); 1338 Perl_dump_indent(aTHX_ level, file, " LINE = %"IVdf"\n", (IV)GvLINE(sv)); 1339 Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", GvFILE(sv)); 1340 Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)GvFLAGS(sv)); 1341 do_gv_dump (level, file, " EGV", GvEGV(sv)); 1342 break; 1343 case SVt_PVIO: 1344 Perl_dump_indent(aTHX_ level, file, " IFP = 0x%"UVxf"\n", PTR2UV(IoIFP(sv))); 1345 Perl_dump_indent(aTHX_ level, file, " OFP = 0x%"UVxf"\n", PTR2UV(IoOFP(sv))); 1346 Perl_dump_indent(aTHX_ level, file, " DIRP = 0x%"UVxf"\n", PTR2UV(IoDIRP(sv))); 1347 Perl_dump_indent(aTHX_ level, file, " LINES = %"IVdf"\n", (IV)IoLINES(sv)); 1348 Perl_dump_indent(aTHX_ level, file, " PAGE = %"IVdf"\n", (IV)IoPAGE(sv)); 1349 Perl_dump_indent(aTHX_ level, file, " PAGE_LEN = %"IVdf"\n", (IV)IoPAGE_LEN(sv)); 1350 Perl_dump_indent(aTHX_ level, file, " LINES_LEFT = %"IVdf"\n", (IV)IoLINES_LEFT(sv)); 1351 if (IoTOP_NAME(sv)) 1352 Perl_dump_indent(aTHX_ level, file, " TOP_NAME = \"%s\"\n", IoTOP_NAME(sv)); 1353 do_gv_dump (level, file, " TOP_GV", IoTOP_GV(sv)); 1354 if (IoFMT_NAME(sv)) 1355 Perl_dump_indent(aTHX_ level, file, " FMT_NAME = \"%s\"\n", IoFMT_NAME(sv)); 1356 do_gv_dump (level, file, " FMT_GV", IoFMT_GV(sv)); 1357 if (IoBOTTOM_NAME(sv)) 1358 Perl_dump_indent(aTHX_ level, file, " BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv)); 1359 do_gv_dump (level, file, " BOTTOM_GV", IoBOTTOM_GV(sv)); 1360 Perl_dump_indent(aTHX_ level, file, " SUBPROCESS = %"IVdf"\n", (IV)IoSUBPROCESS(sv)); 1361 if (isPRINT(IoTYPE(sv))) 1362 Perl_dump_indent(aTHX_ level, file, " TYPE = '%c'\n", IoTYPE(sv)); 1363 else 1364 Perl_dump_indent(aTHX_ level, file, " TYPE = '\\%o'\n", IoTYPE(sv)); 1365 Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)IoFLAGS(sv)); 1366 break; 1367 } 1368 SvREFCNT_dec(d); 1369 } 1370 1371 void 1372 Perl_sv_dump(pTHX_ SV *sv) 1373 { 1374 do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0); 1375 } 1376 1377 int 1378 Perl_runops_debug(pTHX) 1379 { 1380 if (!PL_op) { 1381 if (ckWARN_d(WARN_DEBUGGING)) 1382 Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN"); 1383 return 0; 1384 } 1385 1386 do { 1387 PERL_ASYNC_CHECK(); 1388 if (PL_debug) { 1389 if (PL_watchaddr != 0 && *PL_watchaddr != PL_watchok) 1390 PerlIO_printf(Perl_debug_log, 1391 "WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n", 1392 PTR2UV(PL_watchaddr), PTR2UV(PL_watchok), 1393 PTR2UV(*PL_watchaddr)); 1394 if (DEBUG_s_TEST_) debstack(); 1395 if (DEBUG_t_TEST_) debop(PL_op); 1396 if (DEBUG_P_TEST_) debprof(PL_op); 1397 } 1398 } while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX))); 1399 1400 TAINT_NOT; 1401 return 0; 1402 } 1403 1404 I32 1405 Perl_debop(pTHX_ OP *o) 1406 { 1407 AV *padlist, *comppad; 1408 CV *cv; 1409 SV *sv; 1410 STRLEN n_a; 1411 1412 if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_) 1413 return 0; 1414 1415 Perl_deb(aTHX_ "%s", OP_NAME(o)); 1416 switch (o->op_type) { 1417 case OP_CONST: 1418 PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv)); 1419 break; 1420 case OP_GVSV: 1421 case OP_GV: 1422 if (cGVOPo_gv) { 1423 sv = NEWSV(0,0); 1424 gv_fullname3(sv, cGVOPo_gv, Nullch); 1425 PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, n_a)); 1426 SvREFCNT_dec(sv); 1427 } 1428 else 1429 PerlIO_printf(Perl_debug_log, "(NULL)"); 1430 break; 1431 case OP_PADSV: 1432 case OP_PADAV: 1433 case OP_PADHV: 1434 /* print the lexical's name */ 1435 cv = deb_curcv(cxstack_ix); 1436 if (cv) { 1437 padlist = CvPADLIST(cv); 1438 comppad = (AV*)(*av_fetch(padlist, 0, FALSE)); 1439 sv = *av_fetch(comppad, o->op_targ, FALSE); 1440 } else 1441 sv = Nullsv; 1442 if (sv) 1443 PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen(sv)); 1444 else 1445 PerlIO_printf(Perl_debug_log, "[%"UVuf"]", (UV)o->op_targ); 1446 break; 1447 default: 1448 break; 1449 } 1450 PerlIO_printf(Perl_debug_log, "\n"); 1451 return 0; 1452 } 1453 1454 STATIC CV* 1455 S_deb_curcv(pTHX_ I32 ix) 1456 { 1457 PERL_CONTEXT *cx = &cxstack[ix]; 1458 if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) 1459 return cx->blk_sub.cv; 1460 else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx)) 1461 return PL_compcv; 1462 else if (ix == 0 && PL_curstackinfo->si_type == PERLSI_MAIN) 1463 return PL_main_cv; 1464 else if (ix <= 0) 1465 return Nullcv; 1466 else 1467 return deb_curcv(ix - 1); 1468 } 1469 1470 void 1471 Perl_watch(pTHX_ char **addr) 1472 { 1473 PL_watchaddr = addr; 1474 PL_watchok = *addr; 1475 PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n", 1476 PTR2UV(PL_watchaddr), PTR2UV(PL_watchok)); 1477 } 1478 1479 STATIC void 1480 S_debprof(pTHX_ OP *o) 1481 { 1482 if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_) 1483 return; 1484 if (!PL_profiledata) 1485 Newz(000, PL_profiledata, MAXO, U32); 1486 ++PL_profiledata[o->op_type]; 1487 } 1488 1489 void 1490 Perl_debprofdump(pTHX) 1491 { 1492 unsigned i; 1493 if (!PL_profiledata) 1494 return; 1495 for (i = 0; i < MAXO; i++) { 1496 if (PL_profiledata[i]) 1497 PerlIO_printf(Perl_debug_log, 1498 "%5lu %s\n", (unsigned long)PL_profiledata[i], 1499 PL_op_name[i]); 1500 } 1501 } 1502