summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--embed.fnc3
-rw-r--r--embed.h10
-rw-r--r--makedef.pl1
-rw-r--r--pad.c10
-rw-r--r--pad.h6
-rw-r--r--proto.h5
6 files changed, 34 insertions, 1 deletions
diff --git a/embed.fnc b/embed.fnc
index 4778e16651..2b41862c66 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1646,6 +1646,9 @@ px |void |my_clearenv
Apo |void* |my_cxt_init |NN int *index|size_t size
#endif
+#ifdef PERL_MAD
+Mnp |void |pad_peg |NN const char* s
+#endif
END_EXTERN_C
/*
diff --git a/embed.h b/embed.h
index 2a759e6321..694bfb7f66 100644
--- a/embed.h
+++ b/embed.h
@@ -1721,6 +1721,11 @@
#endif
#ifdef PERL_IMPLICIT_CONTEXT
#endif
+#ifdef PERL_MAD
+#ifdef PERL_CORE
+#define pad_peg Perl_pad_peg
+#endif
+#endif
#define ck_anoncode Perl_ck_anoncode
#define ck_bitop Perl_ck_bitop
#define ck_chdir Perl_ck_chdir
@@ -3796,6 +3801,11 @@
#endif
#ifdef PERL_IMPLICIT_CONTEXT
#endif
+#ifdef PERL_MAD
+#ifdef PERL_CORE
+#define pad_peg Perl_pad_peg
+#endif
+#endif
#define ck_anoncode(a) Perl_ck_anoncode(aTHX_ a)
#define ck_bitop(a) Perl_ck_bitop(aTHX_ a)
#define ck_chdir(a) Perl_ck_chdir(aTHX_ a)
diff --git a/makedef.pl b/makedef.pl
index 241365db8d..4d9abf115b 100644
--- a/makedef.pl
+++ b/makedef.pl
@@ -841,6 +841,7 @@ unless ($define{'PERL_MAD'}) {
skip_symbols [qw(
PL_madskills
PL_xmlfp
+ Perl_pad_peg
)];
}
diff --git a/pad.c b/pad.c
index 10c82c5dc0..4a24216d4c 100644
--- a/pad.c
+++ b/pad.c
@@ -113,7 +113,12 @@ to be generated in evals, such as
#define PAD_MAX 999999999
-
+#ifdef PERL_MAD
+void pad_peg(const char* s) {
+ static int pegcnt;
+ pegcnt++;
+}
+#endif
/*
=for apidoc pad_new
@@ -233,6 +238,7 @@ Perl_pad_undef(pTHX_ CV* cv)
I32 ix;
const PADLIST * const padlist = CvPADLIST(cv);
+ pad_peg("pad_undef");
if (!padlist)
return;
if (SvIS_FREED(padlist)) /* may be during global destruction */
@@ -468,6 +474,7 @@ Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
dVAR;
PADOFFSET ix;
SV* const name = newSV(0);
+ pad_peg("add_anon");
sv_upgrade(name, SVt_PVNV);
sv_setpvn(name, "&", 1);
SvIV_set(name, -1);
@@ -584,6 +591,7 @@ Perl_pad_findmy(pTHX_ const char *name)
const AV *nameav;
SV **name_svp;
+ pad_peg("pad_findmy");
offset = pad_findlex(name, PL_compcv, PL_cop_seqmax, 1,
NULL, &out_sv, &out_flags);
if (offset != NOT_IN_PAD)
diff --git a/pad.h b/pad.h
index acfb58e47d..022a7de582 100644
--- a/pad.h
+++ b/pad.h
@@ -50,14 +50,20 @@ typedef enum {
* whether PL_comppad and PL_curpad are consistent and whether they have
* active values */
+#ifndef PERL_MAD
+# define pad_peg(label)
+#endif
+
#ifdef DEBUGGING
# define ASSERT_CURPAD_LEGAL(label) \
+ pad_peg(label); \
if (PL_comppad ? (AvARRAY(PL_comppad) != PL_curpad) : (PL_curpad != 0)) \
Perl_croak(aTHX_ "panic: illegal pad in %s: 0x%"UVxf"[0x%"UVxf"]",\
label, PTR2UV(PL_comppad), PTR2UV(PL_curpad));
# define ASSERT_CURPAD_ACTIVE(label) \
+ pad_peg(label); \
if (!PL_comppad || (AvARRAY(PL_comppad) != PL_curpad)) \
Perl_croak(aTHX_ "panic: invalid pad in %s: 0x%"UVxf"[0x%"UVxf"]",\
label, PTR2UV(PL_comppad), PTR2UV(PL_curpad));
diff --git a/proto.h b/proto.h
index c836e4a643..a6acf13618 100644
--- a/proto.h
+++ b/proto.h
@@ -4268,6 +4268,11 @@ PERL_CALLCONV void* Perl_my_cxt_init(pTHX_ int *index, size_t size)
#endif
+#ifdef PERL_MAD
+PERL_CALLCONV void Perl_pad_peg(const char* s)
+ __attribute__nonnull__(1);
+
+#endif
END_EXTERN_C
/*