Add MAD changes to pad code (new function Perl_pad_peg)

p4raw-id: //depot/perl@27419

diff --git a/embed.fnc b/embed.fnc
index 4778e16..2b41862 100644 (file)
--- 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 2a759e6..694bfb7 100644 (file)
--- 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 241365d..4d9abf1 100644 (file)
--- 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 10c82c5..4a24216 100644 (file)
--- 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 acfb58e..022a7de 100644 (file)
--- 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 c836e4a..a6acf13 100644 (file)
--- 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
 /*