From: Nicholas Clark <nick@ccl4.org>
Date: Wed, 8 Mar 2006 13:40:48 +0000 (+0000)
Subject: Add MAD changes to pad code (new function Perl_pad_peg)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1dba731d9f7b0a03b8cecb69b9d80500a283425e;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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
 /*