#define PERL_IN_DUMP_C
#include "perl.h"
#include "regcomp.h"
-#include "proto.h"
static const char* const svtypenames[SVt_LAST] = {
"NULL",
- "BIND",
+ "DUMMY",
"IV",
"NV",
"PV",
static const char* const svshorttypenames[SVt_LAST] = {
"UNDEF",
- "BIND",
+ "DUMMY",
"IV",
"NV",
"PV",
sv_catpv(t, "VOID");
goto finish;
}
- else if (sv == (const SV *)0x55555555 || SvTYPE(sv) == 'U') {
+ else if (sv == (const SV *)0x55555555 || ((char)SvTYPE(sv)) == 'U') {
+ /* detect data corruption under memory poisoning */
sv_catpv(t, "WILD");
goto finish;
}
Perl_sv_catpvf(aTHX_ t, " [UTF8 \"%s\"]",
sv_uni_display(tmp, sv, 6 * SvCUR(sv),
UNI_DISPLAY_QQ));
- SvREFCNT_dec(tmp);
+ SvREFCNT_dec_NN(tmp);
}
}
else if (SvNOKp(sv)) {
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 : "");
- SvREFCNT_dec(tmpsv);
+ SvREFCNT_dec_NN(tmpsv);
}
Perl_dump_indent(aTHX_ level-1, file, "}\n");
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);
{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");
{OP_LEAVE, C_ARRAY_LENGTH(op_leavesub_names), op_leavesub_names },
{OP_LEAVESUBLV, C_ARRAY_LENGTH(op_leavesub_names), op_leavesub_names },
{OP_LEAVEWRITE, C_ARRAY_LENGTH(op_leavesub_names), op_leavesub_names },
- {OP_AASSIGN, C_ARRAY_LENGTH(op_aassign_names), op_aassign_names },
{OP_DIE, C_ARRAY_LENGTH(op_die_names), op_die_names },
{OP_DELETE, C_ARRAY_LENGTH(op_delete_names), op_delete_names },
{OP_EXISTS, C_ARRAY_LENGTH(op_exists_names), op_exists_names },
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_NN(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"); \
+ } \
+ else if (o->op_type == OP_AASSIGN) { \
+ if (oppriv & OPpASSIGN_COMMON) \
+ sv_catpvs(tmpsv, ",COMMON"); \
+ if (oppriv & OPpMAYBE_LVSUB) \
+ sv_catpvs(tmpsv, ",MAYBE_LVSUB"); \
+ } \
+ 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_NN(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_slabbed || o->op_savefree) {
- 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");
- 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 (optype == OP_RV2HV || optype == OP_PADHV) {
- if (o->op_private & OPpMAYBE_TRUEBOOL)
- sv_catpvs(tmpsv, ",OPpMAYBE_TRUEBOOL");
- if (o->op_private & OPpTRUEBOOL)
- sv_catpvs(tmpsv, ",OPpTRUEBOOL");
- }
- 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 (o->op_type == OP_PADRANGE)
- Perl_sv_catpvf(aTHX_ tmpsv, ",COUNT=%"UVuf,
- (UV)(o->op_private & OPpPADRANGE_COUNTMASK));
-
- if (SvCUR(tmpsv))
- Perl_dump_indent(aTHX_ level, file, "PRIVATE = (%s)\n", SvPVX_const(tmpsv) + 1);
- else
- Perl_dump_indent(aTHX_ level, file, "PRIVATE = (0x%"UVxf")\n",
- (UV)o->op_private);
- 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) {
level--;
Perl_dump_indent(aTHX_ level, file, "}\n");
- SvREFCNT_dec(tmpsv);
+ SvREFCNT_dec_NN(tmpsv);
}
#endif
if (mg->mg_type != PERL_MAGIC_utf8) {
SV * const sv = newSVpvs("");
PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim));
- SvREFCNT_dec(sv);
+ SvREFCNT_dec_NN(sv);
}
}
else if (mg->mg_len == HEf_SVKEY) {
{SVf_OOK, "OOK,"},
{SVf_FAKE, "FAKE,"},
{SVf_READONLY, "READONLY,"},
+ {SVf_IsCOW, "IsCOW,"},
{SVf_BREAK, "BREAK,"},
{SVf_AMAGIC, "OVERLOAD,"},
{SVp_IOK, "pIOK,"},
{SVphv_SHAREKEYS, "SHAREKEYS,"},
{SVphv_LAZYDEL, "LAZYDEL,"},
{SVphv_HASKFLAGS, "HASKFLAGS,"},
- {SVphv_REHASH, "REHASH,"},
{SVphv_CLONEABLE, "CLONEABLE,"}
};
{RXf_ANCH_GPOS, "ANCH_GPOS,"},
{RXf_GPOS_SEEN, "GPOS_SEEN,"},
{RXf_GPOS_FLOAT, "GPOS_FLOAT,"},
- {RXf_LOOKBEHIND_SEEN, "LOOKBEHIND_SEEN,"},
+ {RXf_NO_INPLACE_SUBST, "NO_INPLACE_SUBST,"},
{RXf_EVAL_SEEN, "EVAL_SEEN,"},
{RXf_CANY_SEEN, "CANY_SEEN,"},
{RXf_NOSCAN, "NOSCAN,"},
{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,"},
};
PerlIO_printf(file, "%s%s\n", svtypenames[type], s);
if (type == SVt_NULL) {
- SvREFCNT_dec(d);
+ SvREFCNT_dec_NN(d);
return;
}
} else {
PerlIO_printf(file, "UNKNOWN(0x%"UVxf") %s\n", (UV)type, s);
- SvREFCNT_dec(d);
+ SvREFCNT_dec_NN(d);
return;
}
}
if (type < SVt_PV) {
- SvREFCNT_dec(d);
+ SvREFCNT_dec_NN(d);
return;
}
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");
}
PerlIO_putc(file, '\n');
Perl_dump_indent(aTHX_ level, file, " KEYS = %"IVdf"\n", (IV)HvUSEDKEYS(sv));
- Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)HvFILL(sv));
+ {
+ STRLEN count = 0;
+ HE **ents = HvARRAY(sv);
+
+ if (ents) {
+ HE *const *const last = ents + HvMAX(sv);
+ count = last + 1 - ents;
+
+ do {
+ if (!*ents)
+ --count;
+ } while (++ents <= last);
+ }
+
+ if (SvOOK(sv)) {
+ struct xpvhv_aux *const aux = HvAUX(sv);
+ Perl_dump_indent(aTHX_ level, file, " FILL = %"UVuf
+ " (cached = %"UVuf")\n",
+ (UV)count, (UV)aux->xhv_fill_lazy);
+ } else {
+ Perl_dump_indent(aTHX_ level, file, " FILL = %"UVuf"\n",
+ (UV)count);
+ }
+ }
Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)HvMAX(sv));
- Perl_dump_indent(aTHX_ level, file, " RITER = %"IVdf"\n", (IV)HvRITER_get(sv));
- Perl_dump_indent(aTHX_ level, file, " EITER = 0x%"UVxf"\n", PTR2UV(HvEITER_get(sv)));
+ if (SvOOK(sv)) {
+ Perl_dump_indent(aTHX_ level, file, " RITER = %"IVdf"\n", (IV)HvRITER_get(sv));
+ Perl_dump_indent(aTHX_ level, file, " EITER = 0x%"UVxf"\n", PTR2UV(HvEITER_get(sv)));
+#ifdef PERL_HASH_RANDOMIZE_KEYS
+ Perl_dump_indent(aTHX_ level, file, " RAND = 0x%"UVxf, (UV)HvRAND_get(sv));
+ if (HvRAND_get(sv) != HvLASTRAND_get(sv) && HvRITER_get(sv) != -1 ) {
+ PerlIO_printf(file, " (LAST = 0x%"UVxf")", (UV)HvLASTRAND_get(sv));
+ }
+#endif
+ PerlIO_putc(file, '\n');
+ }
{
MAGIC * const mg = mg_find(sv, PERL_MAGIC_symtab);
if (mg && mg->mg_obj) {
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:;
}
dumpregexp:
{
struct regexp * const r = ReANY((REGEXP*)sv);
- flags = RX_EXTFLAGS((REGEXP*)sv);
- sv_setpv(d,"");
- append_flags(d, flags, regexp_flags_names);
- if (*(SvEND(d) - 1) == ',') {
- SvCUR_set(d, SvCUR(d) - 1);
- SvPVX(d)[SvCUR(d)] = '\0';
- }
+#define SV_SET_STRINGIFY_REGEXP_FLAGS(d,flags) STMT_START { \
+ sv_setpv(d,""); \
+ append_flags(d, flags, regexp_flags_names); \
+ if (SvCUR(d) > 0 && *(SvEND(d) - 1) == ',') { \
+ SvCUR_set(d, SvCUR(d) - 1); \
+ SvPVX(d)[SvCUR(d)] = '\0'; \
+ } \
+} STMT_END
+ SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->compflags);
+ Perl_dump_indent(aTHX_ level, file, " COMPFLAGS = 0x%"UVxf" (%s)\n",
+ (UV)(r->compflags), SvPVX_const(d));
+
+ SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->extflags);
Perl_dump_indent(aTHX_ level, file, " EXTFLAGS = 0x%"UVxf" (%s)\n",
- (UV)flags, SvPVX_const(d));
+ (UV)(r->extflags), SvPVX_const(d));
+#undef SV_SET_STRINGIFY_REGEXP_FLAGS
+
Perl_dump_indent(aTHX_ level, file, " INTFLAGS = 0x%"UVxf"\n",
(UV)(r->intflags));
Perl_dump_indent(aTHX_ level, file, " NPARENS = %"UVuf"\n",
PTR2UV(r->offs));
Perl_dump_indent(aTHX_ level, file, " QR_ANONCV = 0x%"UVxf"\n",
PTR2UV(r->qr_anoncv));
-#ifdef PERL_OLD_COPY_ON_WRITE
+#ifdef PERL_ANY_COW
Perl_dump_indent(aTHX_ level, file, " SAVED_COPY = 0x%"UVxf"\n",
PTR2UV(r->saved_copy));
#endif
}
break;
}
- SvREFCNT_dec(d);
+ SvREFCNT_dec_NN(d);
}
void
OP_ENTRY_PROBE(OP_NAME(PL_op));
} while ((PL_op = PL_op->op_ppaddr(aTHX)));
DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));
+ PERL_ASYNC_CHECK();
TAINT_NOT;
return 0;
#endif
gv_fullname3(sv, cGVOPo_gv, NULL);
PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
- SvREFCNT_dec(sv);
+ SvREFCNT_dec_NN(sv);
}
else
PerlIO_printf(Perl_debug_log, "(NULL)");
sv_catpv(t, "VOID=\"\"");
goto finish;
}
- else if (sv == (const SV *)0x55555555 || SvTYPE(sv) == 'U') {
+ else if (sv == (const SV *)0x55555555 || ((char)SvTYPE(sv)) == 'U') {
sv_catpv(t, "WILD=\"\"");
goto finish;
}
case SVt_PVGV:
sv_catpv(t, " GV=\"");
break;
- case SVt_BIND:
- sv_catpv(t, " BIND=\"");
+ case SVt_DUMMY:
+ sv_catpv(t, " DUMMY=\"");
break;
case SVt_REGEXP:
sv_catpv(t, " REGEXP=\"");
sv_catxmlsv(tmpsv, MUTABLE_SV(r));
Perl_xmldump_indent(aTHX_ level, file, "pre=\"%s\"\n",
SvPVX(tmpsv));
- SvREFCNT_dec(tmpsv);
+ SvREFCNT_dec_NN(tmpsv);
Perl_xmldump_indent(aTHX_ level, file, "when=\"%s\"\n",
(pm->op_private & OPpRUNTIME) ? "RUN" : "COMP");
}
if (pm->op_pmflags || (PM_GETRE(pm) && RX_CHECK_SUBSTR(PM_GETRE(pm)))) {
SV * const tmpsv = pm_description(pm);
Perl_xmldump_indent(aTHX_ level, file, "pmflags=\"%s\"\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
- SvREFCNT_dec(tmpsv);
+ SvREFCNT_dec_NN(tmpsv);
}
level--;
{
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");
- if (o->op_private & OPpCONST_FOLDED)
- sv_catpv(tmpsv, ",FOLDED");
- }
- 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;
level--;
Perl_xmldump_indent(aTHX_ level, file, "</madprops>\n");
- SvREFCNT_dec(tmpsv);
+ SvREFCNT_dec_NN(tmpsv);
}
- switch (o->op_type) {
+ switch (optype) {
case OP_PUSHRE:
case OP_MATCH:
case OP_QR: