Escapes at most the first "count" chars of pv and puts the results into
dsv such that the size of the escaped string will not exceed "max" chars
-and will not contain any incomplete escape sequences. The number of bytes
+and will not contain any incomplete escape sequences. The number of bytes
escaped will be returned in the STRLEN *escaped parameter if it is not null.
When the dsv parameter is null no escaping actually occurs, but the number
of bytes that would be escaped were it not null will be calculated.
Normally the SV will be cleared before the escaped string is prepared,
but when PERL_PV_ESCAPE_NOCLEAR is set this will not occur.
-If PERL_PV_ESCAPE_UNI is set then the input string is treated as Unicode,
+If PERL_PV_ESCAPE_UNI is set then the input string is treated as UTF-8
if PERL_PV_ESCAPE_UNI_DETECT is set then the input string is scanned
-using C<is_utf8_string()> to determine if it is Unicode.
+using C<is_utf8_string()> to determine if it is UTF-8.
If PERL_PV_ESCAPE_ALL is set then all input chars will be output
using C<\x01F1> style escapes, otherwise if PERL_PV_ESCAPE_NONASCII is set, only
STRLEN wrote = 0; /* chars written so far */
STRLEN chsize = 0; /* size of data to be written */
STRLEN readsize = 1; /* size of data just read */
- bool isuni= flags & PERL_PV_ESCAPE_UNI ? 1 : 0; /* is this Unicode */
+ bool isuni= flags & PERL_PV_ESCAPE_UNI ? 1 : 0; /* is this UTF-8 */
const char *pv = str;
const char * const end = pv + count; /* end of string */
octbuf[0] = esc;
const STRLEN max, char const * const start_color, char const * const end_color,
const U32 flags )
{
- const U8 *quotes = (flags & PERL_PV_PRETTY_QUOTE) ? "\"\"" :
- (flags & PERL_PV_PRETTY_LTGT) ? "<>" : NULL;
+ const U8 *quotes = (U8*)((flags & PERL_PV_PRETTY_QUOTE) ? "\"\"" :
+ (flags & PERL_PV_PRETTY_LTGT) ? "<>" : NULL);
STRLEN escaped;
STRLEN max_adjust= 0;
STRLEN orig_cur;
}
}
else if (SvNOKp(sv)) {
- STORE_NUMERIC_LOCAL_SET_STANDARD();
+ STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD();
Perl_sv_catpvf(aTHX_ t, "(%"NVgf")",SvNVX(sv));
- RESTORE_NUMERIC_LOCAL();
+ RESTORE_LC_NUMERIC_UNDERLYING();
}
else if (SvIOKp(sv)) {
if (SvIsUV(sv))
for (i = 0; i <= (I32) HvMAX(stash); i++) {
const HE *entry;
for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
- const GV * const gv = (const GV *)HeVAL(entry);
+ GV * gv = (GV *)HeVAL(entry);
+ if (SvROK(gv) && SvTYPE(SvRV(gv)) == SVt_PVCV)
+ /* unfake a fake GV */
+ (void)CvGV(SvRV(gv));
if (SvTYPE(gv) != SVt_PVGV || !GvGP(gv))
continue;
if (GvCVu(gv))
if (o->op_targ) {
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 (CopLINE(cCOPo))
- Perl_dump_indent(aTHX_ level, file, "LINE = %"UVuf"\n",
- (UV)CopLINE(cCOPo));
- if (CopSTASHPV(cCOPo)) {
- SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
- HV *stash = CopSTASH(cCOPo);
- const char * const hvname = HvNAME_get(stash);
-
- Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
- generic_pv_escape( tmpsv, hvname, HvNAMELEN(stash), HvNAMEUTF8(stash)));
- }
- if (CopLABEL(cCOPo)) {
- SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
- STRLEN label_len;
- U32 label_flags;
- const char *label = CopLABEL_len_flags(cCOPo,
- &label_len,
- &label_flags);
- Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
- generic_pv_escape( tmpsv, label, label_len,(label_flags & SVf_UTF8)));
- }
-
- }
}
else
Perl_dump_indent(aTHX_ level, file, "TARG = %ld\n", (long)o->op_targ);
if (o->op_savefree) sv_catpvs(tmpsv, ",SAVEFREE");
if (o->op_static) sv_catpvs(tmpsv, ",STATIC");
if (o->op_folded) sv_catpvs(tmpsv, ",FOLDED");
- if (o->op_lastsib) sv_catpvs(tmpsv, ",LASTSIB");
+ if (o->op_moresib) sv_catpvs(tmpsv, ",MORESIB");
Perl_dump_indent(aTHX_ level, file, "FLAGS = (%s)\n",
SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
}
sv_catpv(tmpsv, &PL_op_private_labels[label]);
sv_catpv(tmpsv, "=");
}
- sv_catpv(tmpsv, &PL_op_private_labels[enum_label]);
+ if (enum_label == -1)
+ Perl_sv_catpvf(aTHX_ tmpsv, "0x%"UVxf, (UV)val);
+ else
+ sv_catpv(tmpsv, &PL_op_private_labels[enum_label]);
}
else {
}
#endif
break;
+
+ case OP_MULTIDEREF:
+ {
+ UNOP_AUX_item *items = cUNOP_AUXo->op_aux;
+ UV i, count = items[-1].uv;
+
+ Perl_dump_indent(aTHX_ level, file, "ARGS = \n");
+ for (i=0; i < count; i++)
+ Perl_dump_indent(aTHX_ level+1, file, "%"UVuf" => 0x%"UVxf"\n",
+ i, items[i].uv);
+ }
+
case OP_CONST:
case OP_HINTSEVAL:
case OP_METHOD_NAMED:
+ case OP_METHOD_SUPER:
+ case OP_METHOD_REDIR:
+ case OP_METHOD_REDIR_SUPER:
#ifndef USE_ITHREADS
/* with ITHREADS, consts are stored in the pad, and the right pad
* may not be active here, so skip */
Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cMETHOPx_meth(o)));
#endif
break;
+ case OP_NULL:
+ if (o->op_targ != OP_NEXTSTATE && o->op_targ != OP_DBSTATE)
+ break;
+ /* FALLTHROUGH */
case OP_NEXTSTATE:
case OP_DBSTATE:
if (CopLINE(cCOPo))
generic_pv_escape( tmpsv, label, label_len,
(label_flags & SVf_UTF8)));
}
+ Perl_dump_indent(aTHX_ level, file, "SEQ = %u\n",
+ (unsigned int)cCOPo->cop_seq);
break;
case OP_ENTERLOOP:
Perl_dump_indent(aTHX_ level, file, "REDO ===> ");
}
if (o->op_flags & OPf_KIDS) {
OP *kid;
- for (kid = cUNOPo->op_first; kid; kid = OP_SIBLING(kid))
+ for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid))
do_op_dump(level, file, kid);
}
Perl_dump_indent(aTHX_ level-1, file, "}\n");
const char* name;
SV *sv, *tmp = newSVpvs_flags("", SVs_TEMP);
-
- PERL_ARGS_ASSERT_GV_DUMP;
-
if (!gv) {
PerlIO_printf(Perl_debug_log, "{}\n");
return;
Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s",
generic_pv_escape( tmp, name, len, SvUTF8(sv) ));
}
- PerlIO_putc(Perl_debug_log, '\n');
+ (void)PerlIO_putc(Perl_debug_log, '\n');
Perl_dump_indent(aTHX_ 0, Perl_debug_log, "}\n");
}
*/
static const struct { const char type; const char *name; } magic_names[] = {
-#include "mg_names.c"
+#include "mg_names.inc"
/* this null string terminates the list */
{ 0, NULL },
};
" ???? - " __FILE__
" does not know how to handle this MG_LEN"
);
- PerlIO_putc(file, '\n');
+ (void)PerlIO_putc(file, '\n');
}
if (mg->mg_type == PERL_MAGIC_utf8) {
const STRLEN * const cache = (STRLEN *) mg->mg_ptr;
HvNAMELEN(sv), HvNAMEUTF8(sv)));
}
else
- PerlIO_putc(file, '\n');
+ (void)PerlIO_putc(file, '\n');
}
void
generic_pv_escape( tmpsv, GvNAME(sv), GvNAMELEN(sv), GvNAMEUTF8(sv) ));
}
else
- PerlIO_putc(file, '\n');
+ (void)PerlIO_putc(file, '\n');
}
void
generic_pv_escape( tmp, GvNAME(sv), GvNAMELEN(sv), GvNAMEUTF8(sv)));
}
else
- PerlIO_putc(file, '\n');
+ (void)PerlIO_putc(file, '\n');
}
const struct flag_to_name first_sv_flags_names[] = {
{RXf_PMf_EXTENDED, "PMf_EXTENDED,"},
{RXf_PMf_EXTENDED_MORE, "PMf_EXTENDED_MORE,"},
{RXf_PMf_KEEPCOPY, "PMf_KEEPCOPY,"},
+ {RXf_PMf_NOCAPTURE, "PMf_NOCAPURE,"},
{RXf_IS_ANCHORED, "IS_ANCHORED,"},
{RXf_NO_INPLACE_SUBST, "NO_INPLACE_SUBST,"},
{RXf_EVAL_SEEN, "EVAL_SEEN,"},
{PREGf_CUTGROUP_SEEN, "CUTGROUP_SEEN,"},
{PREGf_USE_RE_EVAL, "USE_RE_EVAL,"},
{PREGf_NOSCAN, "NOSCAN,"},
- {PREGf_CANY_SEEN, "CANY_SEEN,"},
{PREGf_GPOS_SEEN, "GPOS_SEEN,"},
{PREGf_GPOS_FLOAT, "GPOS_FLOAT,"},
{PREGf_ANCH_MBOL, "ANCH_MBOL,"},
(int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv),
(int)(PL_dumpindent*level), "");
- if (!((flags & SVpad_NAME) == SVpad_NAME
- && (type == SVt_PVMG || type == SVt_PVNV))) {
- if ((flags & SVs_PADSTALE))
+ if ((flags & SVs_PADSTALE))
sv_catpv(d, "PADSTALE,");
- }
- if (!((flags & SVpad_NAME) == SVpad_NAME && type == SVt_PVMG)) {
- if ((flags & SVs_PADTMP))
+ if ((flags & SVs_PADTMP))
sv_catpv(d, "PADTMP,");
- }
append_flags(d, flags, first_sv_flags_names);
if (flags & SVf_ROK) {
sv_catpv(d, "ROK,");
case SVt_PVMG:
if (SvTAIL(sv)) sv_catpv(d, "TAIL,");
if (SvVALID(sv)) sv_catpv(d, "VALID,");
- if (SvPAD_TYPED(sv)) sv_catpv(d, "TYPED,");
- if (SvPAD_OUR(sv)) sv_catpv(d, "OUR,");
/* FALLTHROUGH */
- case SVt_PVNV:
- if (SvPAD_STATE(sv)) sv_catpv(d, "STATE,");
goto evaled_or_uv;
case SVt_PVAV:
- if (AvPAD_NAMELIST(sv)) sv_catpvs(d, "NAMELIST,");
break;
}
/* SVphv_SHAREKEYS is also 0x20000000 */
&& type != SVt_REGEXP && !isGV_with_GP(sv) && !SvVALID(sv))
|| (type == SVt_IV && !SvROK(sv))) {
if (SvIsUV(sv)
-#ifdef PERL_OLD_COPY_ON_WRITE
- || SvIsCOW(sv)
-#endif
)
Perl_dump_indent(aTHX_ level, file, " UV = %"UVuf, (UV)SvUVX(sv));
else
Perl_dump_indent(aTHX_ level, file, " IV = %"IVdf, (IV)SvIVX(sv));
-#ifdef PERL_OLD_COPY_ON_WRITE
- if (SvIsCOW_shared_hash(sv))
- PerlIO_printf(file, " (HASH)");
- else if (SvIsCOW_normal(sv))
- PerlIO_printf(file, " (COW from 0x%"UVxf")", (UV)SvUVX(sv));
-#endif
- PerlIO_putc(file, '\n');
+ (void)PerlIO_putc(file, '\n');
}
- if ((type == SVt_PVNV || type == SVt_PVMG)
- && (SvFLAGS(sv) & SVpad_NAME) == SVpad_NAME) {
- Perl_dump_indent(aTHX_ level, file, " COP_LOW = %"UVuf"\n",
- (UV) COP_SEQ_RANGE_LOW(sv));
- Perl_dump_indent(aTHX_ level, file, " COP_HIGH = %"UVuf"\n",
- (UV) COP_SEQ_RANGE_HIGH(sv));
- } else if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
+ if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
&& type != SVt_PVCV && type != SVt_PVFM && type != SVt_REGEXP
&& type != SVt_PVIO && !isGV_with_GP(sv) && !SvVALID(sv))
|| type == SVt_NV) {
- STORE_NUMERIC_LOCAL_SET_STANDARD();
+ STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD();
Perl_dump_indent(aTHX_ level, file, " NV = %.*" NVgf "\n", NV_DIG, SvNVX(sv));
- RESTORE_NUMERIC_LOCAL();
+ RESTORE_LC_NUMERIC_UNDERLYING();
}
if (SvROK(sv)) {
if (!re)
Perl_dump_indent(aTHX_ level, file, " LEN = %"IVdf"\n",
(IV)SvLEN(sv));
-#ifdef PERL_NEW_COPY_ON_WRITE
+#ifdef PERL_COPY_ON_WRITE
if (SvIsCOW(sv) && SvLEN(sv))
Perl_dump_indent(aTHX_ level, file, " COW_REFCNT = %d\n",
CowREFCNT(sv));
}
if (type >= SVt_PVMG) {
- if (type == SVt_PVMG && SvPAD_OUR(sv)) {
- HV * const ost = SvOURSTASH(sv);
- if (ost)
- do_hv_dump(level, file, " OURSTASH", ost);
- } else if (SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)) {
- Perl_dump_indent(aTHX_ level, file, " MAXNAMED = %"UVuf"\n",
- (UV)PadnamelistMAXNAMED(sv));
- } else {
- if (SvMAGIC(sv))
+ if (SvMAGIC(sv))
do_magic_dump(level, file, SvMAGIC(sv), nest+1, maxnest, dumpops, pvlim);
- }
if (SvSTASH(sv))
do_hv_dump(level, file, " STASH", SvSTASH(sv));
Perl_dump_indent(aTHX_ level, file, " ALLOC = 0x%"UVxf"\n", PTR2UV(AvALLOC(sv)));
}
else
- PerlIO_putc(file, '\n');
+ (void)PerlIO_putc(file, '\n');
Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)AvFILLp(sv));
Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)AvMAX(sv));
- /* arylen is stored in magic, and padnamelists use SvMAGIC for
- something else. */
- if (!AvPAD_NAMELIST(sv))
- Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%"UVxf"\n",
+ Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%"UVxf"\n",
SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 0);
sv_setpvs(d, "");
if (AvREAL(sv)) sv_catpv(d, ",REAL");
PerlIO_printf(file, ", ");
}
}
- PerlIO_putc(file, ')');
+ (void)PerlIO_putc(file, ')');
/* The "quality" of a hash is defined as the total number of
comparisons needed to access every element once, relative
to the expected number needed for a random hash.
pow2 = pow2 << 1;
theoret = usedkeys;
theoret += theoret * (theoret-1)/pow2;
- PerlIO_putc(file, '\n');
+ (void)PerlIO_putc(file, '\n');
Perl_dump_indent(aTHX_ level, file, " hash quality = %.1"NVff"%%", theoret/sum*100);
}
- PerlIO_putc(file, '\n');
+ (void)PerlIO_putc(file, '\n');
Perl_dump_indent(aTHX_ level, file, " KEYS = %"IVdf"\n", (IV)usedkeys);
{
STRLEN count = 0;
PerlIO_printf(file, " (LAST = 0x%"UVxf")", (UV)HvLASTRAND_get(sv));
}
#endif
- PerlIO_putc(file, '\n');
+ (void)PerlIO_putc(file, '\n');
}
{
MAGIC * const mg = mg_find(sv, PERL_MAGIC_symtab);
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));
- 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);
+ if (!CvISXSUB(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);
+ }
}
+ else
+ Perl_dump_indent(aTHX_ level, file, " HSCXT = 0x%p\n", CvHSCXT(sv));
{
const CV * const outside = CvOUTSIDE(sv);
Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%"UVxf" (%s)\n",
GvNAMEUTF8(CvGV(outside)))
: "UNDEFINED"));
}
- if (nest < maxnest && (CvCLONE(sv) || CvCLONED(sv)))
+ if (CvOUTSIDE(sv)
+ && (nest < maxnest && (CvCLONE(sv) || CvCLONED(sv))))
do_sv_dump(level+1, file, MUTABLE_SV(CvOUTSIDE(sv)), nest+1, maxnest, dumpops, pvlim);
break;
return 0;
}
+
+/* print the names of the n lexical vars starting at pad offset off */
+
+void
+S_deb_padvar(pTHX_ PADOFFSET off, int n, bool paren)
+{
+ PADNAME *sv;
+ CV * const cv = deb_curcv(cxstack_ix);
+ PADNAMELIST *comppad = NULL;
+ int i;
+
+ if (cv) {
+ PADLIST * const padlist = CvPADLIST(cv);
+ comppad = PadlistNAMES(padlist);
+ }
+ if (paren)
+ PerlIO_printf(Perl_debug_log, "(");
+ for (i = 0; i < n; i++) {
+ if (comppad && (sv = padnamelist_fetch(comppad, off + i)))
+ PerlIO_printf(Perl_debug_log, "%"PNf, PNfARG(sv));
+ else
+ PerlIO_printf(Perl_debug_log, "[%"UVuf"]",
+ (UV)(off+i));
+ if (i < n - 1)
+ PerlIO_printf(Perl_debug_log, ",");
+ }
+ if (paren)
+ PerlIO_printf(Perl_debug_log, ")");
+}
+
+
+/* append to the out SV, the name of the lexical at offset off in the CV
+ * cv */
+
+static void
+S_append_padvar(pTHX_ PADOFFSET off, CV *cv, SV *out, int n,
+ bool paren, bool is_scalar)
+{
+ PADNAME *sv;
+ PADNAMELIST *namepad = NULL;
+ int i;
+
+ if (cv) {
+ PADLIST * const padlist = CvPADLIST(cv);
+ namepad = PadlistNAMES(padlist);
+ }
+
+ if (paren)
+ sv_catpvs_nomg(out, "(");
+ for (i = 0; i < n; i++) {
+ if (namepad && (sv = padnamelist_fetch(namepad, off + i)))
+ {
+ STRLEN cur = SvCUR(out);
+ Perl_sv_catpvf(aTHX_ out, "[%"UTF8f,
+ UTF8fARG(1, PadnameLEN(sv) - 1,
+ PadnamePV(sv) + 1));
+ if (is_scalar)
+ SvPVX(out)[cur] = '$';
+ }
+ else
+ Perl_sv_catpvf(aTHX_ out, "[%"UVuf"]", (UV)(off+i));
+ if (i < n - 1)
+ sv_catpvs_nomg(out, ",");
+ }
+ if (paren)
+ sv_catpvs_nomg(out, "(");
+}
+
+
+static void
+S_append_gv_name(pTHX_ GV *gv, SV *out)
+{
+ SV *sv;
+ if (!gv) {
+ sv_catpvs_nomg(out, "<NULLGV>");
+ return;
+ }
+ sv = newSV(0);
+ gv_fullname4(sv, gv, NULL, FALSE);
+ Perl_sv_catpvf(aTHX_ out, "$%"SVf, SVfARG(sv));
+ SvREFCNT_dec_NN(sv);
+}
+
+#ifdef USE_ITHREADS
+# define ITEM_SV(item) (comppad ? \
+ *av_fetch(comppad, (item)->pad_offset, FALSE) : NULL);
+#else
+# define ITEM_SV(item) UNOP_AUX_item_sv(item)
+#endif
+
+
+/* return a temporary SV containing a stringified representation of
+ * the op_aux field of a MULTIDEREF op, associated with CV cv
+ */
+
+SV*
+Perl_multideref_stringify(pTHX_ const OP *o, CV *cv)
+{
+ UNOP_AUX_item *items = cUNOP_AUXo->op_aux;
+ UV actions = items->uv;
+ SV *sv;
+ bool last = 0;
+ bool is_hash = FALSE;
+ int derefs = 0;
+ SV *out = newSVpvn_flags("",0,SVs_TEMP);
+#ifdef USE_ITHREADS
+ PAD *comppad;
+
+ if (cv) {
+ PADLIST *padlist = CvPADLIST(cv);
+ comppad = PadlistARRAY(padlist)[1];
+ }
+ else
+ comppad = NULL;
+#endif
+
+ PERL_ARGS_ASSERT_MULTIDEREF_STRINGIFY;
+
+ while (!last) {
+ switch (actions & MDEREF_ACTION_MASK) {
+
+ case MDEREF_reload:
+ actions = (++items)->uv;
+ continue;
+ NOT_REACHED; /* NOTREACHED */
+
+ case MDEREF_HV_padhv_helem:
+ is_hash = TRUE;
+ /* FALLTHROUGH */
+ case MDEREF_AV_padav_aelem:
+ derefs = 1;
+ S_append_padvar(aTHX_ (++items)->pad_offset, cv, out, 1, 0, 1);
+ goto do_elem;
+ NOT_REACHED; /* NOTREACHED */
+
+ case MDEREF_HV_gvhv_helem:
+ is_hash = TRUE;
+ /* FALLTHROUGH */
+ case MDEREF_AV_gvav_aelem:
+ derefs = 1;
+ items++;
+ sv = ITEM_SV(items);
+ S_append_gv_name(aTHX_ (GV*)sv, out);
+ goto do_elem;
+ NOT_REACHED; /* NOTREACHED */
+
+ case MDEREF_HV_gvsv_vivify_rv2hv_helem:
+ is_hash = TRUE;
+ /* FALLTHROUGH */
+ case MDEREF_AV_gvsv_vivify_rv2av_aelem:
+ items++;
+ sv = ITEM_SV(items);
+ S_append_gv_name(aTHX_ (GV*)sv, out);
+ goto do_vivify_rv2xv_elem;
+ NOT_REACHED; /* NOTREACHED */
+
+ case MDEREF_HV_padsv_vivify_rv2hv_helem:
+ is_hash = TRUE;
+ /* FALLTHROUGH */
+ case MDEREF_AV_padsv_vivify_rv2av_aelem:
+ S_append_padvar(aTHX_ (++items)->pad_offset, cv, out, 1, 0, 1);
+ goto do_vivify_rv2xv_elem;
+ NOT_REACHED; /* NOTREACHED */
+
+ case MDEREF_HV_pop_rv2hv_helem:
+ case MDEREF_HV_vivify_rv2hv_helem:
+ is_hash = TRUE;
+ /* FALLTHROUGH */
+ do_vivify_rv2xv_elem:
+ case MDEREF_AV_pop_rv2av_aelem:
+ case MDEREF_AV_vivify_rv2av_aelem:
+ if (!derefs++)
+ sv_catpvs_nomg(out, "->");
+ do_elem:
+ if ((actions & MDEREF_INDEX_MASK)== MDEREF_INDEX_none) {
+ sv_catpvs_nomg(out, "->");
+ last = 1;
+ break;
+ }
+
+ sv_catpvn_nomg(out, (is_hash ? "{" : "["), 1);
+ switch (actions & MDEREF_INDEX_MASK) {
+ case MDEREF_INDEX_const:
+ if (is_hash) {
+ items++;
+ sv = ITEM_SV(items);
+ if (!sv)
+ sv_catpvs_nomg(out, "???");
+ else {
+ STRLEN cur;
+ char *s;
+ s = SvPV(sv, cur);
+ pv_pretty(out, s, cur, 30,
+ NULL, NULL,
+ (PERL_PV_PRETTY_NOCLEAR
+ |PERL_PV_PRETTY_QUOTE
+ |PERL_PV_PRETTY_ELLIPSES));
+ }
+ }
+ else
+ Perl_sv_catpvf(aTHX_ out, "%"IVdf, (++items)->iv);
+ break;
+ case MDEREF_INDEX_padsv:
+ S_append_padvar(aTHX_ (++items)->pad_offset, cv, out, 1, 0, 1);
+ break;
+ case MDEREF_INDEX_gvsv:
+ items++;
+ sv = ITEM_SV(items);
+ S_append_gv_name(aTHX_ (GV*)sv, out);
+ break;
+ }
+ sv_catpvn_nomg(out, (is_hash ? "}" : "]"), 1);
+
+ if (actions & MDEREF_FLAG_last)
+ last = 1;
+ is_hash = FALSE;
+
+ break;
+
+ default:
+ PerlIO_printf(Perl_debug_log, "UNKNOWN(%d)",
+ (int)(actions & MDEREF_ACTION_MASK));
+ last = 1;
+ break;
+
+ } /* switch */
+
+ actions >>= MDEREF_SHIFT;
+ } /* while */
+ return out;
+}
+
+
I32
Perl_debop(pTHX_ const OP *o)
{
- int count;
-
PERL_ARGS_ASSERT_DEBOP;
if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
case OP_PADSV:
case OP_PADAV:
case OP_PADHV:
- count = 1;
- goto dump_padop;
+ S_deb_padvar(aTHX_ o->op_targ, 1, 1);
+ break;
+
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;
- 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, ")");
- }
+ S_deb_padvar(aTHX_ o->op_targ,
+ o->op_private & OPpPADRANGE_COUNTMASK, 1);
+ break;
+
+ case OP_MULTIDEREF:
+ PerlIO_printf(Perl_debug_log, "(%"SVf")",
+ SVfARG(multideref_stringify(o, deb_curcv(cxstack_ix))));
break;
default:
}
STATIC CV*
-S_deb_curcv(pTHX_ const I32 ix)
+S_deb_curcv(pTHX_ I32 ix)
{
- const PERL_CONTEXT * const cx = &cxstack[ix];
- if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT)
- return cx->blk_sub.cv;
- else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
- return cx->blk_eval.cv;
- else if (ix == 0 && PL_curstackinfo->si_type == PERLSI_MAIN)
- return PL_main_cv;
- else if (ix <= 0)
- return NULL;
- else
- return deb_curcv(ix - 1);
+ PERL_SI *si = PL_curstackinfo;
+ for (; ix >=0; ix--) {
+ const PERL_CONTEXT * const cx = &(si->si_cxstack)[ix];
+
+ if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT)
+ return cx->blk_sub.cv;
+ else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
+ return cx->blk_eval.cv;
+ else if (ix == 0 && si->si_type == PERLSI_MAIN)
+ return PL_main_cv;
+ else if (ix == 0 && CxTYPE(cx) == CXt_NULL
+ && si->si_type == PERLSI_SORT)
+ {
+ /* fake sort sub; use CV of caller */
+ si = si->si_prev;
+ ix = si->si_cxix + 1;
+ }
+ }
+ return NULL;
}
void
/*
- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: nil
- * End:
- *
* ex: set ts=8 sts=4 sw=4 et:
*/
https://perl5.git.perl.org / perl5.git / blobdiff