finish:
while (unref--)
sv_catpv(t, ")");
- if (PL_tainting && SvTAINTED(sv))
+ if (TAINTING_get && SvTAINTED(sv))
sv_catpv(t, " [tainted]");
return SvPV_nolen(t);
}
Perl_dump_indent(aTHX_ level, file, "PMf_REPL = ");
op_dump(pm->op_pmreplrootu.op_pmreplroot);
}
+ if (pm->op_code_list) {
+ if (pm->op_pmflags & PMf_CODELIST_PRIVATE) {
+ Perl_dump_indent(aTHX_ level, file, "CODE_LIST =\n");
+ do_op_dump(level, file, pm->op_code_list);
+ }
+ else
+ Perl_dump_indent(aTHX_ level, file, "CODE_LIST = 0x%"UVxf"\n",
+ PTR2UV(pm->op_code_list));
+ }
if (pm->op_pmflags || (PM_GETRE(pm) && RX_CHECK_SUBSTR(PM_GETRE(pm)))) {
SV * const tmpsv = pm_description(pm);
Perl_dump_indent(aTHX_ level, file, "PMFLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
{PMf_RETAINT, ",RETAINT"},
{PMf_EVAL, ",EVAL"},
{PMf_NONDESTRUCT, ",NONDESTRUCT"},
+ {PMf_HAS_CV, ",HAS_CV"},
+ {PMf_CODELIST_PRIVATE, ",CODELIST_PRIVATE"},
+ {PMf_IS_QR, ",IS_QR"}
};
static SV *
#endif
if (regex) {
- if (RX_EXTFLAGS(regex) & RXf_TAINTED)
+ if (RX_ISTAINTED(regex))
sv_catpv(desc, ",TAINTED");
if (RX_CHECK_SUBSTR(regex)) {
if (!(RX_EXTFLAGS(regex) & RXf_NOSCAN))
if (RX_EXTFLAGS(regex) & RXf_CHECK_ALL)
sv_catpv(desc, ",ALL");
}
- if (RX_EXTFLAGS(regex) & RXf_SKIPWHITE)
- sv_catpv(desc, ",SKIPWHITE");
}
append_flags(desc, pmflags, pmflags_flags_names);
{OPpCONST_SHORTCIRCUIT, ",SHORTCIRCUIT"},
{OPpCONST_STRICT, ",STRICT"},
{OPpCONST_ENTERED, ",ENTERED"},
+ {OPpCONST_FOLDED, ",FOLDED"},
{OPpCONST_BARE, ",BARE"}
};
{OPpHUSH_VMSISH, ",HUSH_VMSISH"}
};
+const struct flag_to_name op_sassign_names[] = {
+ {OPpASSIGN_BACKWARDS, ",BACKWARDS"},
+ {OPpASSIGN_CV_TO_GV, ",CV2GV"}
+};
+
#define OP_PRIVATE_ONCE(op, flag, name) \
const struct flag_to_name CAT2(op, _names)[] = { \
{(flag), (name)} \
OP_PRIVATE_ONCE(op_aassign, OPpASSIGN_COMMON, ",COMMON");
OP_PRIVATE_ONCE(op_leavesub, OPpREFCOUNTED, ",REFCOUNTED");
-OP_PRIVATE_ONCE(op_sassign, OPpASSIGN_BACKWARDS, ",BACKWARDS");
OP_PRIVATE_ONCE(op_repeat, OPpREPEAT_DOLIST, ",DOLIST");
OP_PRIVATE_ONCE(op_reverse, OPpREVERSE_INPLACE, ",INPLACE");
OP_PRIVATE_ONCE(op_rv2cv, OPpLVAL_INTRO, ",INTRO");
return FALSE;
}
+#define DUMP_OP_FLAGS(o,xml,level,file) \
+ if (o->op_flags || o->op_slabbed || o->op_savefree || o->op_static) { \
+ SV * const tmpsv = newSVpvs(""); \
+ switch (o->op_flags & OPf_WANT) { \
+ case OPf_WANT_VOID: \
+ sv_catpv(tmpsv, ",VOID"); \
+ break; \
+ case OPf_WANT_SCALAR: \
+ sv_catpv(tmpsv, ",SCALAR"); \
+ break; \
+ case OPf_WANT_LIST: \
+ sv_catpv(tmpsv, ",LIST"); \
+ break; \
+ default: \
+ sv_catpv(tmpsv, ",UNKNOWN"); \
+ break; \
+ } \
+ append_flags(tmpsv, o->op_flags, op_flags_names); \
+ if (o->op_slabbed) sv_catpvs(tmpsv, ",SLABBED"); \
+ if (o->op_savefree) sv_catpvs(tmpsv, ",SAVEFREE"); \
+ if (o->op_static) sv_catpvs(tmpsv, ",STATIC"); \
+ if (!xml) \
+ Perl_dump_indent(aTHX_ level, file, "FLAGS = (%s)\n", \
+ SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");\
+ else \
+ PerlIO_printf(file, " flags=\"%s\"", \
+ SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : ""); \
+ SvREFCNT_dec(tmpsv); \
+ }
+
+#if !defined(PERL_MAD)
+# define xmldump_attr1(level, file, pat, arg)
+#else
+# define xmldump_attr1(level, file, pat, arg) \
+ S_xmldump_attr(aTHX_ level, file, pat, arg)
+#endif
+
+#define DUMP_OP_PRIVATE(o,xml,level,file) \
+ if (o->op_private) { \
+ U32 optype = o->op_type; \
+ U32 oppriv = o->op_private; \
+ SV * const tmpsv = newSVpvs(""); \
+ if (PL_opargs[optype] & OA_TARGLEX) { \
+ if (oppriv & OPpTARGET_MY) \
+ sv_catpv(tmpsv, ",TARGET_MY"); \
+ } \
+ 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 (optype == OP_ENTERSUB) { \
+ append_flags(tmpsv, oppriv, op_entersub_names); \
+ } \
+ else { \
+ switch (oppriv & OPpDEREF) { \
+ case OPpDEREF_SV: \
+ sv_catpv(tmpsv, ",SV"); \
+ break; \
+ case OPpDEREF_AV: \
+ sv_catpv(tmpsv, ",AV"); \
+ break; \
+ case OPpDEREF_HV: \
+ sv_catpv(tmpsv, ",HV"); \
+ break; \
+ } \
+ if (oppriv & OPpMAYBE_LVSUB) \
+ sv_catpv(tmpsv, ",MAYBE_LVSUB"); \
+ } \
+ if (optype == OP_AELEM || optype == OP_HELEM) { \
+ if (oppriv & OPpLVAL_DEFER) \
+ sv_catpv(tmpsv, ",LVAL_DEFER"); \
+ } \
+ else if (optype == OP_RV2HV || optype == OP_PADHV) { \
+ if (oppriv & OPpMAYBE_TRUEBOOL) \
+ sv_catpvs(tmpsv, ",OPpMAYBE_TRUEBOOL"); \
+ if (oppriv & OPpTRUEBOOL) \
+ sv_catpvs(tmpsv, ",OPpTRUEBOOL"); \
+ } \
+ else { \
+ if (oppriv & HINT_STRICT_REFS) \
+ sv_catpv(tmpsv, ",STRICT_REFS"); \
+ if (oppriv & OPpOUR_INTRO) \
+ sv_catpv(tmpsv, ",OUR_INTRO"); \
+ } \
+ } \
+ else if (S_op_private_to_names(aTHX_ tmpsv, optype, oppriv)) { \
+ } \
+ else if (OP_IS_FILETEST(o->op_type)) { \
+ if (oppriv & OPpFT_ACCESS) \
+ sv_catpv(tmpsv, ",FT_ACCESS"); \
+ if (oppriv & OPpFT_STACKED) \
+ sv_catpv(tmpsv, ",FT_STACKED"); \
+ if (oppriv & OPpFT_STACKING) \
+ sv_catpv(tmpsv, ",FT_STACKING"); \
+ if (oppriv & OPpFT_AFTER_t) \
+ sv_catpv(tmpsv, ",AFTER_t"); \
+ } \
+ if (o->op_flags & OPf_MOD && oppriv & OPpLVAL_INTRO) \
+ sv_catpv(tmpsv, ",INTRO"); \
+ if (o->op_type == OP_PADRANGE) \
+ Perl_sv_catpvf(aTHX_ tmpsv, ",COUNT=%"UVuf, \
+ (UV)(oppriv & OPpPADRANGE_COUNTMASK)); \
+ if (SvCUR(tmpsv)) { \
+ if (xml) \
+ xmldump_attr1(level+1, file, "private=\"%s\"", SvPVX(tmpsv)+1); \
+ else \
+ Perl_dump_indent(aTHX_ level, file, "PRIVATE = (%s)\n", SvPVX_const(tmpsv) + 1); \
+ } else if (!xml) \
+ Perl_dump_indent(aTHX_ level, file, "PRIVATE = (0x%"UVxf")\n", \
+ (UV)oppriv); \
+ SvREFCNT_dec(tmpsv); \
+ }
+
+
void
Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
{
#ifdef DUMPADDR
Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%"UVxf" => 0x%"UVxf"\n", (UV)o, (UV)o->op_next);
#endif
- if (o->op_flags || o->op_latefree || o->op_latefreed || o->op_attached) {
- SV * const tmpsv = newSVpvs("");
- switch (o->op_flags & OPf_WANT) {
- case OPf_WANT_VOID:
- sv_catpv(tmpsv, ",VOID");
- break;
- case OPf_WANT_SCALAR:
- sv_catpv(tmpsv, ",SCALAR");
- break;
- case OPf_WANT_LIST:
- sv_catpv(tmpsv, ",LIST");
- break;
- default:
- sv_catpv(tmpsv, ",UNKNOWN");
- break;
- }
- append_flags(tmpsv, o->op_flags, op_flags_names);
- if (o->op_latefree)
- sv_catpv(tmpsv, ",LATEFREE");
- if (o->op_latefreed)
- sv_catpv(tmpsv, ",LATEFREED");
- if (o->op_attached)
- sv_catpv(tmpsv, ",ATTACHED");
- Perl_dump_indent(aTHX_ level, file, "FLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
- SvREFCNT_dec(tmpsv);
- }
- if (o->op_private) {
- SV * const tmpsv = newSVpvs("");
- if (PL_opargs[optype] & OA_TARGLEX) {
- if (o->op_private & OPpTARGET_MY)
- sv_catpv(tmpsv, ",TARGET_MY");
- }
- 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 (optype == OP_ENTERSUB) {
- append_flags(tmpsv, o->op_private, op_entersub_names);
- }
- else {
- switch (o->op_private & OPpDEREF) {
- case OPpDEREF_SV:
- sv_catpv(tmpsv, ",SV");
- break;
- case OPpDEREF_AV:
- sv_catpv(tmpsv, ",AV");
- break;
- case OPpDEREF_HV:
- sv_catpv(tmpsv, ",HV");
- break;
- }
- if (o->op_private & OPpMAYBE_LVSUB)
- sv_catpv(tmpsv, ",MAYBE_LVSUB");
- }
- if (optype == OP_AELEM || optype == OP_HELEM) {
- if (o->op_private & OPpLVAL_DEFER)
- sv_catpv(tmpsv, ",LVAL_DEFER");
- }
- else {
- if (o->op_private & HINT_STRICT_REFS)
- sv_catpv(tmpsv, ",STRICT_REFS");
- if (o->op_private & OPpOUR_INTRO)
- sv_catpv(tmpsv, ",OUR_INTRO");
- }
- }
- else if (S_op_private_to_names(aTHX_ tmpsv, optype, o->op_private)) {
- }
- else if (PL_check[optype] != Perl_ck_ftst) {
- if (OP_IS_FILETEST_ACCESS(o->op_type) && o->op_private & OPpFT_ACCESS)
- sv_catpv(tmpsv, ",FT_ACCESS");
- if (o->op_private & OPpFT_STACKED)
- sv_catpv(tmpsv, ",FT_STACKED");
- }
- if (o->op_flags & OPf_MOD && o->op_private & OPpLVAL_INTRO)
- sv_catpv(tmpsv, ",INTRO");
- if (SvCUR(tmpsv))
- Perl_dump_indent(aTHX_ level, file, "PRIVATE = (%s)\n", SvPVX_const(tmpsv) + 1);
- SvREFCNT_dec(tmpsv);
- }
+ DUMP_OP_FLAGS(o,0,level,file);
+ DUMP_OP_PRIVATE(o,0,level,file);
#ifdef PERL_MAD
if (PL_madskills && o->op_madprop) {
{SVf_OOK, "OOK,"},
{SVf_FAKE, "FAKE,"},
{SVf_READONLY, "READONLY,"},
+ {SVf_IsCOW, "IsCOW,"},
{SVf_BREAK, "BREAK,"},
{SVf_AMAGIC, "OVERLOAD,"},
{SVp_IOK, "pIOK,"},
{CVf_CVGV_RC, "CVGV_RC,"},
{CVf_DYNFILE, "DYNFILE,"},
{CVf_AUTOLOAD, "AUTOLOAD,"},
+ {CVf_HASEVAL, "HASEVAL"},
+ {CVf_SLABBED, "SLABBED,"},
{CVf_ISXSUB, "ISXSUB,"}
};
{SVphv_SHAREKEYS, "SHAREKEYS,"},
{SVphv_LAZYDEL, "LAZYDEL,"},
{SVphv_HASKFLAGS, "HASKFLAGS,"},
- {SVphv_REHASH, "REHASH,"},
{SVphv_CLONEABLE, "CLONEABLE,"}
};
{RXf_USE_INTUIT_NOML, "USE_INTUIT_NOML,"},
{RXf_USE_INTUIT_ML, "USE_INTUIT_ML,"},
{RXf_INTUIT_TAIL, "INTUIT_TAIL,"},
- {RXf_SPLIT, "SPLIT,"},
{RXf_COPY_DONE, "COPY_DONE,"},
{RXf_TAINTED_SEEN, "TAINTED_SEEN,"},
{RXf_TAINTED, "TAINTED,"},
{RXf_START_ONLY, "START_ONLY,"},
- {RXf_SKIPWHITE, "SKIPWHITE,"},
{RXf_WHITE, "WHITE,"},
{RXf_NULL, "NULL,"},
};
return;
}
- if ((type <= SVt_PVLV && !isGV_with_GP(sv)) || type == SVt_PVFM) {
- if (SvPVX_const(sv)) {
+ if (type <= SVt_PVLV && !isGV_with_GP(sv)) {
+ const bool re = isREGEXP(sv);
+ const char * const ptr =
+ re ? RX_WRAPPED((REGEXP*)sv) : SvPVX_const(sv);
+ if (ptr) {
STRLEN delta;
if (SvOOK(sv)) {
SvOOK_offset(sv, delta);
} else {
delta = 0;
}
- Perl_dump_indent(aTHX_ level, file," PV = 0x%"UVxf" ", PTR2UV(SvPVX_const(sv)));
+ Perl_dump_indent(aTHX_ level, file," PV = 0x%"UVxf" ", PTR2UV(ptr));
if (SvOOK(sv)) {
PerlIO_printf(file, "( %s . ) ",
- pv_display(d, SvPVX_const(sv) - delta, delta, 0,
+ pv_display(d, ptr - delta, delta, 0,
pvlim));
}
- PerlIO_printf(file, "%s", pv_display(d, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), pvlim));
+ PerlIO_printf(file, "%s", pv_display(d, ptr, SvCUR(sv),
+ re ? 0 : SvLEN(sv),
+ pvlim));
if (SvUTF8(sv)) /* the 6? \x{....} */
PerlIO_printf(file, " [UTF8 \"%s\"]", sv_uni_display(d, sv, 6 * SvCUR(sv), UNI_DISPLAY_QQ));
PerlIO_printf(file, "\n");
Perl_dump_indent(aTHX_ level, file, " CUR = %"IVdf"\n", (IV)SvCUR(sv));
- Perl_dump_indent(aTHX_ level, file, " LEN = %"IVdf"\n", (IV)SvLEN(sv));
+ if (!re)
+ Perl_dump_indent(aTHX_ level, file, " LEN = %"IVdf"\n",
+ (IV)SvLEN(sv));
+#ifdef PERL_NEW_COPY_ON_WRITE
+ if (SvIsCOW(sv) && SvLEN(sv))
+ Perl_dump_indent(aTHX_ level, file, " COW_REFCNT = %d\n",
+ CowREFCNT(sv));
+#endif
}
else
Perl_dump_indent(aTHX_ level, file, " PV = 0\n");
SV * keysv;
const char * keypv;
SV * elt;
- STRLEN len;
+ STRLEN len;
if (count-- <= 0) goto DONEHV;
keypv = SvPV_const(keysv, len);
elt = HeVAL(he);
- Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim));
- if (SvUTF8(keysv))
- PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 6 * SvCUR(keysv), UNI_DISPLAY_QQ));
+ Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim));
+ if (SvUTF8(keysv))
+ PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 6 * SvCUR(keysv), UNI_DISPLAY_QQ));
if (HvEITER_get(hv) == he)
PerlIO_printf(file, "[CURRENT] ");
- if (HeKREHASH(he))
- PerlIO_printf(file, "[REHASH] ");
- PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV) hash);
- do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
- }
+ PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV) hash);
+ do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
+ }
}
DONEHV:;
}
(IV)CvXSUBANY(sv).any_i32);
}
}
- do_gvgv_dump(level, file, " GVGV::GV", CvGV(sv));
+ if (CvNAMED(sv))
+ Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n",
+ HEK_KEY(CvNAME_HEK((CV *)sv)));
+ else do_gvgv_dump(level, file, " GVGV::GV", CvGV(sv));
Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", CvFILE(sv));
- if (type == SVt_PVCV)
- Perl_dump_indent(aTHX_ level, file, " DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
+ Perl_dump_indent(aTHX_ level, file, " DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv));
Perl_dump_indent(aTHX_ level, file, " OUTSIDE_SEQ = %"UVuf"\n", (UV)CvOUTSIDE_SEQ(sv));
- if (type == SVt_PVFM)
- Perl_dump_indent(aTHX_ level, file, " LINES = %"IVdf"\n", (IV)FmLINES(sv));
Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv)));
if (nest < maxnest) {
do_dump_pad(level+1, file, CvPADLIST(sv), 0);
do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest,
dumpops, pvlim);
}
+ if (isREGEXP(sv)) goto dumpregexp;
if (!isGV_with_GP(sv))
break;
Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", GvNAME(sv));
Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)IoFLAGS(sv));
break;
case SVt_REGEXP:
+ dumpregexp:
{
- struct regexp * const r = (struct regexp *)SvANY(sv);
+ struct regexp * const r = ReANY((REGEXP*)sv);
flags = RX_EXTFLAGS((REGEXP*)sv);
sv_setpv(d,"");
append_flags(d, flags, regexp_flags_names);
(UV)(r->gofs));
Perl_dump_indent(aTHX_ level, file, " PRE_PREFIX = %"UVuf"\n",
(UV)(r->pre_prefix));
- Perl_dump_indent(aTHX_ level, file, " SEEN_EVALS = %"UVuf"\n",
- (UV)(r->seen_evals));
Perl_dump_indent(aTHX_ level, file, " SUBLEN = %"IVdf"\n",
(IV)(r->sublen));
+ Perl_dump_indent(aTHX_ level, file, " SUBOFFSET = %"IVdf"\n",
+ (IV)(r->suboffset));
+ Perl_dump_indent(aTHX_ level, file, " SUBCOFFSET = %"IVdf"\n",
+ (IV)(r->subcoffset));
if (r->subbeg)
Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x%"UVxf" %s\n",
PTR2UV(r->subbeg),
PTR2UV(r->pprivate));
Perl_dump_indent(aTHX_ level, file, " OFFS = 0x%"UVxf"\n",
PTR2UV(r->offs));
-#ifdef PERL_OLD_COPY_ON_WRITE
+ Perl_dump_indent(aTHX_ level, file, " QR_ANONCV = 0x%"UVxf"\n",
+ PTR2UV(r->qr_anoncv));
+#ifdef PERL_ANY_COW
Perl_dump_indent(aTHX_ level, file, " SAVED_COPY = 0x%"UVxf"\n",
PTR2UV(r->saved_copy));
#endif
if (DEBUG_t_TEST_) debop(PL_op);
if (DEBUG_P_TEST_) debprof(PL_op);
}
+
+ OP_ENTRY_PROBE(OP_NAME(PL_op));
} while ((PL_op = PL_op->op_ppaddr(aTHX)));
DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));
else
PerlIO_printf(Perl_debug_log, "(NULL)");
break;
+
+ {
+ int count;
+
case OP_PADSV:
case OP_PADAV:
case OP_PADHV:
- {
+ count = 1;
+ goto dump_padop;
+ case OP_PADRANGE:
+ count = o->op_private & OPpPADRANGE_COUNTMASK;
+ dump_padop:
/* print the lexical's name */
- CV * const cv = deb_curcv(cxstack_ix);
- SV *sv;
- if (cv) {
- AV * const padlist = CvPADLIST(cv);
- AV * const comppad = MUTABLE_AV(*av_fetch(padlist, 0, FALSE));
- sv = *av_fetch(comppad, o->op_targ, FALSE);
- } else
- sv = NULL;
- if (sv)
- PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
- else
- PerlIO_printf(Perl_debug_log, "[%"UVuf"]", (UV)o->op_targ);
- }
+ {
+ CV * const cv = deb_curcv(cxstack_ix);
+ SV *sv;
+ PAD * comppad = NULL;
+ int i;
+
+ if (cv) {
+ PADLIST * const padlist = CvPADLIST(cv);
+ comppad = *PadlistARRAY(padlist);
+ }
+ PerlIO_printf(Perl_debug_log, "(");
+ for (i = 0; i < count; i++) {
+ if (comppad &&
+ (sv = *av_fetch(comppad, o->op_targ + i, FALSE)))
+ PerlIO_printf(Perl_debug_log, "%s", SvPV_nolen_const(sv));
+ else
+ PerlIO_printf(Perl_debug_log, "[%"UVuf"]",
+ (UV)o->op_targ+i);
+ if (i < count-1)
+ PerlIO_printf(Perl_debug_log, ",");
+ }
+ PerlIO_printf(Perl_debug_log, ")");
+ }
break;
+ }
+
default:
break;
}
{
UV seq;
int contents = 0;
+ const OPCODE optype = o->op_type;
PERL_ARGS_ASSERT_DO_OP_XMLDUMP;
PerlIO_printf(file, "DONE\"");
if (o->op_targ) {
- if (o->op_type == OP_NULL)
+ if (optype == OP_NULL)
{
PerlIO_printf(file, " was=\"%s\"", PL_op_name[o->op_targ]);
if (o->op_targ == OP_NEXTSTATE)
#ifdef DUMPADDR
PerlIO_printf(file, " addr=\"0x%"UVxf" => 0x%"UVxf"\"", (UV)o, (UV)o->op_next);
#endif
- if (o->op_flags) {
- SV * const tmpsv = newSVpvs("");
- switch (o->op_flags & OPf_WANT) {
- case OPf_WANT_VOID:
- sv_catpv(tmpsv, ",VOID");
- break;
- case OPf_WANT_SCALAR:
- sv_catpv(tmpsv, ",SCALAR");
- break;
- case OPf_WANT_LIST:
- sv_catpv(tmpsv, ",LIST");
- break;
- default:
- sv_catpv(tmpsv, ",UNKNOWN");
- break;
- }
- if (o->op_flags & OPf_KIDS)
- sv_catpv(tmpsv, ",KIDS");
- if (o->op_flags & OPf_PARENS)
- sv_catpv(tmpsv, ",PARENS");
- if (o->op_flags & OPf_STACKED)
- sv_catpv(tmpsv, ",STACKED");
- if (o->op_flags & OPf_REF)
- sv_catpv(tmpsv, ",REF");
- if (o->op_flags & OPf_MOD)
- sv_catpv(tmpsv, ",MOD");
- if (o->op_flags & OPf_SPECIAL)
- sv_catpv(tmpsv, ",SPECIAL");
- PerlIO_printf(file, " flags=\"%s\"", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
- SvREFCNT_dec(tmpsv);
- }
- if (o->op_private) {
- SV * const tmpsv = newSVpvs("");
- if (PL_opargs[o->op_type] & 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) {
- if (o->op_private & OPpREFCOUNTED)
- sv_catpv(tmpsv, ",REFCOUNTED");
- }
- else if (o->op_type == OP_AASSIGN) {
- if (o->op_private & OPpASSIGN_COMMON)
- sv_catpv(tmpsv, ",COMMON");
- }
- else if (o->op_type == OP_SASSIGN) {
- if (o->op_private & OPpASSIGN_BACKWARDS)
- sv_catpv(tmpsv, ",BACKWARDS");
- }
- else if (o->op_type == OP_TRANS) {
- if (o->op_private & OPpTRANS_SQUASH)
- sv_catpv(tmpsv, ",SQUASH");
- if (o->op_private & OPpTRANS_DELETE)
- sv_catpv(tmpsv, ",DELETE");
- if (o->op_private & OPpTRANS_COMPLEMENT)
- sv_catpv(tmpsv, ",COMPLEMENT");
- if (o->op_private & OPpTRANS_IDENTICAL)
- sv_catpv(tmpsv, ",IDENTICAL");
- if (o->op_private & OPpTRANS_GROWS)
- sv_catpv(tmpsv, ",GROWS");
- }
- else if (o->op_type == 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 )
- {
- if (o->op_type == OP_ENTERSUB) {
- if (o->op_private & OPpENTERSUB_AMPER)
- sv_catpv(tmpsv, ",AMPER");
- if (o->op_private & OPpENTERSUB_DB)
- sv_catpv(tmpsv, ",DB");
- if (o->op_private & OPpENTERSUB_HASTARG)
- sv_catpv(tmpsv, ",HASTARG");
- if (o->op_private & OPpENTERSUB_NOPAREN)
- sv_catpv(tmpsv, ",NOPAREN");
- if (o->op_private & OPpENTERSUB_INARGS)
- sv_catpv(tmpsv, ",INARGS");
- }
- else {
- switch (o->op_private & OPpDEREF) {
- case OPpDEREF_SV:
- sv_catpv(tmpsv, ",SV");
- break;
- case OPpDEREF_AV:
- sv_catpv(tmpsv, ",AV");
- break;
- case OPpDEREF_HV:
- sv_catpv(tmpsv, ",HV");
- break;
- }
- if (o->op_private & OPpMAYBE_LVSUB)
- sv_catpv(tmpsv, ",MAYBE_LVSUB");
- }
- if (o->op_type == OP_AELEM || o->op_type == OP_HELEM) {
- if (o->op_private & OPpLVAL_DEFER)
- sv_catpv(tmpsv, ",LVAL_DEFER");
- }
- else {
- if (o->op_private & HINT_STRICT_REFS)
- sv_catpv(tmpsv, ",STRICT_REFS");
- if (o->op_private & OPpOUR_INTRO)
- sv_catpv(tmpsv, ",OUR_INTRO");
- }
- }
- else if (o->op_type == OP_CONST) {
- if (o->op_private & OPpCONST_BARE)
- sv_catpv(tmpsv, ",BARE");
- if (o->op_private & OPpCONST_STRICT)
- sv_catpv(tmpsv, ",STRICT");
- if (o->op_private & OPpCONST_ENTERED)
- sv_catpv(tmpsv, ",ENTERED");
- }
- else if (o->op_type == OP_FLIP) {
- if (o->op_private & OPpFLIP_LINENUM)
- sv_catpv(tmpsv, ",LINENUM");
- }
- else if (o->op_type == OP_FLOP) {
- if (o->op_private & OPpFLIP_LINENUM)
- sv_catpv(tmpsv, ",LINENUM");
- }
- else if (o->op_type == OP_RV2CV) {
- if (o->op_private & OPpLVAL_INTRO)
- sv_catpv(tmpsv, ",INTRO");
- }
- else if (o->op_type == OP_GV) {
- if (o->op_private & OPpEARLY_CV)
- sv_catpv(tmpsv, ",EARLY_CV");
- }
- else if (o->op_type == OP_LIST) {
- if (o->op_private & OPpLIST_GUESSED)
- sv_catpv(tmpsv, ",GUESSED");
- }
- else if (o->op_type == OP_DELETE) {
- if (o->op_private & OPpSLICE)
- sv_catpv(tmpsv, ",SLICE");
- }
- else if (o->op_type == OP_EXISTS) {
- if (o->op_private & OPpEXISTS_SUB)
- sv_catpv(tmpsv, ",EXISTS_SUB");
- }
- else if (o->op_type == OP_SORT) {
- if (o->op_private & OPpSORT_NUMERIC)
- sv_catpv(tmpsv, ",NUMERIC");
- if (o->op_private & OPpSORT_INTEGER)
- sv_catpv(tmpsv, ",INTEGER");
- if (o->op_private & OPpSORT_REVERSE)
- sv_catpv(tmpsv, ",REVERSE");
- }
- else if (o->op_type == OP_OPEN || o->op_type == OP_BACKTICK) {
- if (o->op_private & OPpOPEN_IN_RAW)
- sv_catpv(tmpsv, ",IN_RAW");
- if (o->op_private & OPpOPEN_IN_CRLF)
- sv_catpv(tmpsv, ",IN_CRLF");
- if (o->op_private & OPpOPEN_OUT_RAW)
- sv_catpv(tmpsv, ",OUT_RAW");
- if (o->op_private & OPpOPEN_OUT_CRLF)
- sv_catpv(tmpsv, ",OUT_CRLF");
- }
- else if (o->op_type == 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) {
- if (o->op_private & OPpHUSH_VMSISH)
- sv_catpv(tmpsv, ",HUSH_VMSISH");
- }
- else if (PL_check[o->op_type] != Perl_ck_ftst) {
- if (OP_IS_FILETEST_ACCESS(o->op_type) && o->op_private & OPpFT_ACCESS)
- sv_catpv(tmpsv, ",FT_ACCESS");
- if (o->op_private & OPpFT_STACKED)
- sv_catpv(tmpsv, ",FT_STACKED");
- }
- if (o->op_flags & OPf_MOD && o->op_private & OPpLVAL_INTRO)
- sv_catpv(tmpsv, ",INTRO");
- if (SvCUR(tmpsv))
- S_xmldump_attr(aTHX_ level, file, "private=\"%s\"", SvPVX(tmpsv) + 1);
- SvREFCNT_dec(tmpsv);
- }
- switch (o->op_type) {
+ DUMP_OP_FLAGS(o,1,0,file);
+ DUMP_OP_PRIVATE(o,1,0,file);
+
+ switch (optype) {
case OP_AELEMFAST:
if (o->op_flags & OPf_SPECIAL) {
break;
SvREFCNT_dec(tmpsv);
}
- switch (o->op_type) {
+ switch (optype) {
case OP_PUSHRE:
case OP_MATCH:
case OP_QR:
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
- * indent-tabs-mode: t
+ * indent-tabs-mode: nil
* End:
*
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:
*/
https://perl5.git.perl.org / perl5.git / blobdiff