op_dump(pm->op_pmreplroot);
}
if (pm->op_pmflags || (PM_GETRE(pm) && PM_GETRE(pm)->check_substr)) {
- SV * const tmpsv = newSVpvs("");
- if (pm->op_pmdynflags & PMdf_USED)
- sv_catpv(tmpsv, ",USED");
- if (pm->op_pmdynflags & PMdf_TAINTED)
- sv_catpv(tmpsv, ",TAINTED");
- if (pm->op_pmflags & PMf_ONCE)
- sv_catpv(tmpsv, ",ONCE");
- if (PM_GETRE(pm) && PM_GETRE(pm)->check_substr
- && !(PM_GETRE(pm)->reganch & ROPT_NOSCAN))
- sv_catpv(tmpsv, ",SCANFIRST");
- if (PM_GETRE(pm) && PM_GETRE(pm)->check_substr
- && PM_GETRE(pm)->reganch & ROPT_CHECK_ALL)
- sv_catpv(tmpsv, ",ALL");
- if (pm->op_pmflags & PMf_SKIPWHITE)
- sv_catpv(tmpsv, ",SKIPWHITE");
- if (pm->op_pmflags & PMf_CONST)
- sv_catpv(tmpsv, ",CONST");
- if (pm->op_pmflags & PMf_KEEP)
- sv_catpv(tmpsv, ",KEEP");
- if (pm->op_pmflags & PMf_GLOBAL)
- sv_catpv(tmpsv, ",GLOBAL");
- if (pm->op_pmflags & PMf_CONTINUE)
- sv_catpv(tmpsv, ",CONTINUE");
- if (pm->op_pmflags & PMf_RETAINT)
- sv_catpv(tmpsv, ",RETAINT");
- if (pm->op_pmflags & PMf_EVAL)
- sv_catpv(tmpsv, ",EVAL");
+ SV * const tmpsv = pm_description(pm);
Perl_dump_indent(aTHX_ level, file, "PMFLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
SvREFCNT_dec(tmpsv);
}
Perl_dump_indent(aTHX_ level-1, file, "}\n");
}
+static
+SV *
+S_pm_description(pTHX_ const PMOP *pm)
+{
+ SV * const desc = newSVpvs("");
+ const REGEXP * regex = PM_GETRE(pm);
+ const U32 pmflags = pm->op_pmflags;
+
+ if (pm->op_pmdynflags & PMdf_USED)
+ sv_catpv(desc, ",USED");
+ if (pm->op_pmdynflags & PMdf_TAINTED)
+ sv_catpv(desc, ",TAINTED");
+
+ if (pmflags & PMf_ONCE)
+ sv_catpv(desc, ",ONCE");
+ if (regex && regex->check_substr) {
+ if (!(regex->reganch & ROPT_NOSCAN))
+ sv_catpv(desc, ",SCANFIRST");
+ if (regex->reganch & ROPT_CHECK_ALL)
+ sv_catpv(desc, ",ALL");
+ }
+ if (pmflags & PMf_SKIPWHITE)
+ sv_catpv(desc, ",SKIPWHITE");
+ if (pmflags & PMf_CONST)
+ sv_catpv(desc, ",CONST");
+ if (pmflags & PMf_KEEP)
+ sv_catpv(desc, ",KEEP");
+ if (pmflags & PMf_GLOBAL)
+ sv_catpv(desc, ",GLOBAL");
+ if (pmflags & PMf_CONTINUE)
+ sv_catpv(desc, ",CONTINUE");
+ if (pmflags & PMf_RETAINT)
+ sv_catpv(desc, ",RETAINT");
+ if (pmflags & PMf_EVAL)
+ sv_catpv(desc, ",EVAL");
+ return desc;
+}
+
void
Perl_pmop_dump(pTHX_ PMOP *pm)
{
S_sequence(pTHX_ register const OP *o)
{
dVAR;
- SV *op;
- const char *key;
- STRLEN len;
const OP *oldop = NULL;
- OP *l;
if (!o)
return;
Sequence = newHV();
for (; o; o = o->op_next) {
- op = newSVuv(PTR2UV(o));
- key = SvPV_const(op, len);
+ STRLEN len;
+ SV * const op = newSVuv(PTR2UV(o));
+ const char * const key = SvPV_const(op, len);
+
if (hv_exists(Sequence, key, len))
break;
case OP_COND_EXPR:
case OP_RANGE:
hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
- for (l = cLOGOPo->op_other; l && l->op_type == OP_NULL; l = l->op_next)
- ;
- sequence(l);
+ sequence_tail(cLOGOPo->op_other);
break;
case OP_ENTERLOOP:
case OP_ENTERITER:
hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
- for (l = cLOOPo->op_redoop; l && l->op_type == OP_NULL; l = l->op_next)
- ;
- sequence(l);
- for (l = cLOOPo->op_nextop; l && l->op_type == OP_NULL; l = l->op_next)
- ;
- sequence(l);
- for (l = cLOOPo->op_lastop; l && l->op_type == OP_NULL; l = l->op_next)
- ;
- sequence(l);
+ sequence_tail(cLOOPo->op_redoop);
+ sequence_tail(cLOOPo->op_nextop);
+ sequence_tail(cLOOPo->op_lastop);
break;
case OP_QR:
case OP_MATCH:
case OP_SUBST:
hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
- for (l = cPMOPo->op_pmreplstart; l && l->op_type == OP_NULL; l = l->op_next)
- ;
- sequence(l);
+ sequence_tail(cPMOPo->op_pmreplstart);
break;
case OP_HELEM:
}
}
+static void
+S_sequence_tail(pTHX_ const OP *o)
+{
+ while (o && (o->op_type == OP_NULL))
+ o = o->op_next;
+ sequence(o);
+}
+
STATIC UV
S_sequence_num(pTHX_ const OP *o)
{
{
dVAR;
UV seq;
+ const OPCODE optype = o->op_type;
+
sequence(o);
Perl_dump_indent(aTHX_ level, file, "{\n");
level++;
else
PerlIO_printf(file, "DONE\n");
if (o->op_targ) {
- if (o->op_type == OP_NULL)
- {
+ if (optype == OP_NULL) {
Perl_dump_indent(aTHX_ level, file, " (was %s)\n", PL_op_name[o->op_targ]);
- if (o->op_targ == OP_NEXTSTATE)
- {
+ if (o->op_targ == OP_NEXTSTATE) {
if (CopLINE(cCOPo))
Perl_dump_indent(aTHX_ level, file, "LINE = %"UVf"\n",
(UV)CopLINE(cCOPo));
Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%"UVxf" => 0x%"UVxf"\n", (UV)o, (UV)o->op_next);
#endif
if (o->op_flags) {
- SV *tmpsv = newSVpvs("");
+ SV * const tmpsv = newSVpvs("");
switch (o->op_flags & OPf_WANT) {
case OPf_WANT_VOID:
sv_catpv(tmpsv, ",VOID");
SvREFCNT_dec(tmpsv);
}
if (o->op_private) {
- SV *tmpsv = newSVpvs("");
- if (PL_opargs[o->op_type] & OA_TARGLEX) {
+ SV * const tmpsv = newSVpvs("");
+ if (PL_opargs[optype] & OA_TARGLEX) {
if (o->op_private & OPpTARGET_MY)
sv_catpv(tmpsv, ",TARGET_MY");
}
- else if (o->op_type == OP_LEAVESUB ||
- o->op_type == OP_LEAVE ||
- o->op_type == OP_LEAVESUBLV ||
- o->op_type == OP_LEAVEWRITE) {
+ else if (optype == OP_LEAVESUB ||
+ optype == OP_LEAVE ||
+ optype == OP_LEAVESUBLV ||
+ optype == OP_LEAVEWRITE) {
if (o->op_private & OPpREFCOUNTED)
sv_catpv(tmpsv, ",REFCOUNTED");
}
- else if (o->op_type == OP_AASSIGN) {
+ else if (optype == OP_AASSIGN) {
if (o->op_private & OPpASSIGN_COMMON)
sv_catpv(tmpsv, ",COMMON");
}
- else if (o->op_type == OP_SASSIGN) {
+ else if (optype == OP_SASSIGN) {
if (o->op_private & OPpASSIGN_BACKWARDS)
sv_catpv(tmpsv, ",BACKWARDS");
}
- else if (o->op_type == OP_TRANS) {
+ else if (optype == OP_TRANS) {
if (o->op_private & OPpTRANS_SQUASH)
sv_catpv(tmpsv, ",SQUASH");
if (o->op_private & OPpTRANS_DELETE)
if (o->op_private & OPpTRANS_GROWS)
sv_catpv(tmpsv, ",GROWS");
}
- else if (o->op_type == OP_REPEAT) {
+ else if (optype == OP_REPEAT) {
if (o->op_private & OPpREPEAT_DOLIST)
sv_catpv(tmpsv, ",DOLIST");
}
- else if (o->op_type == OP_ENTERSUB ||
- o->op_type == OP_RV2SV ||
- o->op_type == OP_GVSV ||
- o->op_type == OP_RV2AV ||
- o->op_type == OP_RV2HV ||
- o->op_type == OP_RV2GV ||
- o->op_type == OP_AELEM ||
- o->op_type == OP_HELEM )
+ else if (optype == OP_ENTERSUB ||
+ optype == OP_RV2SV ||
+ optype == OP_GVSV ||
+ optype == OP_RV2AV ||
+ optype == OP_RV2HV ||
+ optype == OP_RV2GV ||
+ optype == OP_AELEM ||
+ optype == OP_HELEM )
{
- if (o->op_type == OP_ENTERSUB) {
+ if (optype == OP_ENTERSUB) {
if (o->op_private & OPpENTERSUB_AMPER)
sv_catpv(tmpsv, ",AMPER");
if (o->op_private & OPpENTERSUB_DB)
if (o->op_private & OPpMAYBE_LVSUB)
sv_catpv(tmpsv, ",MAYBE_LVSUB");
}
- if (o->op_type == OP_AELEM || o->op_type == OP_HELEM) {
+ if (optype == OP_AELEM || optype == OP_HELEM) {
if (o->op_private & OPpLVAL_DEFER)
sv_catpv(tmpsv, ",LVAL_DEFER");
}
sv_catpv(tmpsv, ",OUR_INTRO");
}
}
- else if (o->op_type == OP_CONST) {
+ else if (optype == OP_CONST) {
if (o->op_private & OPpCONST_BARE)
sv_catpv(tmpsv, ",BARE");
if (o->op_private & OPpCONST_STRICT)
if (o->op_private & OPpCONST_ENTERED)
sv_catpv(tmpsv, ",ENTERED");
}
- else if (o->op_type == OP_FLIP) {
+ else if (optype == OP_FLIP) {
if (o->op_private & OPpFLIP_LINENUM)
sv_catpv(tmpsv, ",LINENUM");
}
- else if (o->op_type == OP_FLOP) {
+ else if (optype == OP_FLOP) {
if (o->op_private & OPpFLIP_LINENUM)
sv_catpv(tmpsv, ",LINENUM");
}
- else if (o->op_type == OP_RV2CV) {
+ else if (optype == OP_RV2CV) {
if (o->op_private & OPpLVAL_INTRO)
sv_catpv(tmpsv, ",INTRO");
}
- else if (o->op_type == OP_GV) {
+ else if (optype == OP_GV) {
if (o->op_private & OPpEARLY_CV)
sv_catpv(tmpsv, ",EARLY_CV");
}
- else if (o->op_type == OP_LIST) {
+ else if (optype == OP_LIST) {
if (o->op_private & OPpLIST_GUESSED)
sv_catpv(tmpsv, ",GUESSED");
}
- else if (o->op_type == OP_DELETE) {
+ else if (optype == OP_DELETE) {
if (o->op_private & OPpSLICE)
sv_catpv(tmpsv, ",SLICE");
}
- else if (o->op_type == OP_EXISTS) {
+ else if (optype == OP_EXISTS) {
if (o->op_private & OPpEXISTS_SUB)
sv_catpv(tmpsv, ",EXISTS_SUB");
}
- else if (o->op_type == OP_SORT) {
+ else if (optype == OP_SORT) {
if (o->op_private & OPpSORT_NUMERIC)
sv_catpv(tmpsv, ",NUMERIC");
if (o->op_private & OPpSORT_INTEGER)
if (o->op_private & OPpSORT_REVERSE)
sv_catpv(tmpsv, ",REVERSE");
}
- else if (o->op_type == OP_THREADSV) {
+ else if (optype == OP_THREADSV) {
if (o->op_private & OPpDONE_SVREF)
sv_catpv(tmpsv, ",SVREF");
}
- else if (o->op_type == OP_OPEN || o->op_type == OP_BACKTICK) {
+ else if (optype == OP_OPEN || optype == OP_BACKTICK) {
if (o->op_private & OPpOPEN_IN_RAW)
sv_catpv(tmpsv, ",IN_RAW");
if (o->op_private & OPpOPEN_IN_CRLF)
if (o->op_private & OPpOPEN_OUT_CRLF)
sv_catpv(tmpsv, ",OUT_CRLF");
}
- else if (o->op_type == OP_EXIT) {
+ else if (optype == OP_EXIT) {
if (o->op_private & OPpEXIT_VMSISH)
sv_catpv(tmpsv, ",EXIT_VMSISH");
if (o->op_private & OPpHUSH_VMSISH)
sv_catpv(tmpsv, ",HUSH_VMSISH");
}
- else if (o->op_type == OP_DIE) {
+ else if (optype == OP_DIE) {
if (o->op_private & OPpHUSH_VMSISH)
sv_catpv(tmpsv, ",HUSH_VMSISH");
}
- else if (PL_check[o->op_type] != MEMBER_TO_FPTR(Perl_ck_ftst)) {
+ else if (PL_check[optype] != MEMBER_TO_FPTR(Perl_ck_ftst)) {
if (OP_IS_FILETEST_ACCESS(o) && o->op_private & OPpFT_ACCESS)
sv_catpv(tmpsv, ",FT_ACCESS");
if (o->op_private & OPpFT_STACKED)
}
#endif
- switch (o->op_type) {
+ switch (optype) {
case OP_AELEMFAST:
case OP_GVSV:
case OP_GV:
if (HvREHASH(sv)) sv_catpv(d, "REHASH,");
if (flags & SVphv_CLONEABLE) sv_catpv(d, "CLONEABLE,");
break;
- case SVt_PVGV: case SVt_PVLV:
- if (GvINTRO(sv)) sv_catpv(d, "INTRO,");
- if (GvMULTI(sv)) sv_catpv(d, "MULTI,");
- if (GvUNIQUE(sv)) sv_catpv(d, "UNIQUE,");
- if (GvASSUMECV(sv)) sv_catpv(d, "ASSUMECV,");
- if (GvIN_PAD(sv)) sv_catpv(d, "IN_PAD,");
+ case SVt_PVGV:
+ case SVt_PVLV:
+ if (isGV_with_GP(sv)) {
+ if (GvINTRO(sv)) sv_catpv(d, "INTRO,");
+ if (GvMULTI(sv)) sv_catpv(d, "MULTI,");
+ if (GvUNIQUE(sv)) sv_catpv(d, "UNIQUE,");
+ if (GvASSUMECV(sv)) sv_catpv(d, "ASSUMECV,");
+ if (GvIN_PAD(sv)) sv_catpv(d, "IN_PAD,");
+ }
if (SvPAD_OUR(sv)) sv_catpv(d, "OUR,");
+ if (SvPAD_STATE(sv)) sv_catpv(d, "STATE,");
if (SvPAD_TYPED(sv)) sv_catpv(d, "TYPED,");
- if (GvIMPORTED(sv)) {
+ if (isGV_with_GP(sv) && GvIMPORTED(sv)) {
sv_catpv(d, "IMPORT");
if (GvIMPORTED(sv) == GVf_IMPORTED)
sv_catpv(d, "ALL,");
if (HvARRAY(sv) && HvKEYS(sv)) {
/* Show distribution of HEs in the ARRAY */
int freq[200];
-#define FREQ_MAX (sizeof freq / sizeof freq[0] - 1)
+#define FREQ_MAX ((int)(sizeof freq / sizeof freq[0] - 1))
int i;
int max = 0;
U32 pow2 = 2, keys = HvKEYS(sv);
}
break;
case SVt_PVCV:
- if (SvPOK(sv))
- Perl_dump_indent(aTHX_ level, file, " PROTOTYPE = \"%s\"\n", SvPV_nolen_const(sv));
+ if (SvPOK(sv)) {
+ STRLEN len;
+ const char *const proto = SvPV_const(sv, len);
+ Perl_dump_indent(aTHX_ level, file, " PROTOTYPE = \"%.*s\"\n",
+ (int) len, proto);
+ }
/* FALL THROUGH */
case SVt_PVFM:
do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv));
if (nest < maxnest && (CvCLONE(sv) || CvCLONED(sv)))
do_sv_dump(level+1, file, (SV*)CvOUTSIDE(sv), nest+1, maxnest, dumpops, pvlim);
break;
- case SVt_PVGV: case SVt_PVLV:
+ case SVt_PVGV:
+ case SVt_PVLV:
if (type == SVt_PVLV) {
Perl_dump_indent(aTHX_ level, file, " TYPE = %c\n", LvTYPE(sv));
Perl_dump_indent(aTHX_ level, file, " TARGOFF = %"IVdf"\n", (IV)LvTARGOFF(sv));
do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest,
dumpops, pvlim);
}
+ if (!isGV_with_GP(sv))
+ break;
Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", GvNAME(sv));
Perl_dump_indent(aTHX_ level, file, " NAMELEN = %"IVdf"\n", (IV)GvNAMELEN(sv));
do_hv_dump (level, file, " GvSTASH", GvSTASH(sv));
- if (!isGV_with_GP(sv))
- break;
Perl_dump_indent(aTHX_ level, file, " GP = 0x%"UVxf"\n", PTR2UV(GvGP(sv)));
if (!GvGP(sv))
break;
else
Perl_xmldump_indent(aTHX_ level, file, "pre=\"\" when=\"RUN\"\n");
if (pm->op_pmflags || (PM_GETRE(pm) && PM_GETRE(pm)->check_substr)) {
- SV *tmpsv = newSVpvn("", 0);
- if (pm->op_pmdynflags & PMdf_USED)
- sv_catpv(tmpsv, ",USED");
- if (pm->op_pmdynflags & PMdf_TAINTED)
- sv_catpv(tmpsv, ",TAINTED");
- if (pm->op_pmflags & PMf_ONCE)
- sv_catpv(tmpsv, ",ONCE");
- if (PM_GETRE(pm) && PM_GETRE(pm)->check_substr
- && !(PM_GETRE(pm)->reganch & ROPT_NOSCAN))
- sv_catpv(tmpsv, ",SCANFIRST");
- if (PM_GETRE(pm) && PM_GETRE(pm)->check_substr
- && PM_GETRE(pm)->reganch & ROPT_CHECK_ALL)
- sv_catpv(tmpsv, ",ALL");
- if (pm->op_pmflags & PMf_SKIPWHITE)
- sv_catpv(tmpsv, ",SKIPWHITE");
- if (pm->op_pmflags & PMf_CONST)
- sv_catpv(tmpsv, ",CONST");
- if (pm->op_pmflags & PMf_KEEP)
- sv_catpv(tmpsv, ",KEEP");
- if (pm->op_pmflags & PMf_GLOBAL)
- sv_catpv(tmpsv, ",GLOBAL");
- if (pm->op_pmflags & PMf_CONTINUE)
- sv_catpv(tmpsv, ",CONTINUE");
- if (pm->op_pmflags & PMf_RETAINT)
- sv_catpv(tmpsv, ",RETAINT");
- if (pm->op_pmflags & PMf_EVAL)
- sv_catpv(tmpsv, ",EVAL");
+ SV * const tmpsv = pm_description(pm);
Perl_xmldump_indent(aTHX_ level, file, "pmflags=\"%s\"\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
SvREFCNT_dec(tmpsv);
}