1			/*    pad.c
     2			 *
     3			 *    Copyright (C) 2002, 2003, 2004, 2005 by Larry Wall and others
     4			 *
     5			 *    You may distribute under the terms of either the GNU General Public
     6			 *    License or the Artistic License, as specified in the README file.
     7			 *
     8			 *  "Anyway: there was this Mr Frodo left an orphan and stranded, as you
     9			 *  might say, among those queer Bucklanders, being brought up anyhow in
    10			 *  Brandy Hall. A regular warren, by all accounts. Old Master Gorbadoc
    11			 *  never had fewer than a couple of hundred relations in the place. Mr
    12			 *  Bilbo never did a kinder deed than when he brought the lad back to
    13			 *  live among decent folk." --the Gaffer
    14			 */
    15			
    16			/* XXX DAPM
    17			 * As of Sept 2002, this file is new and may be in a state of flux for
    18			 * a while. I've marked things I intent to come back and look at further
    19			 * with an 'XXX DAPM' comment.
    20			 */
    21			
    22			/*
    23			=head1 Pad Data Structures
    24			
    25			This file contains the functions that create and manipulate scratchpads,
    26			which are array-of-array data structures attached to a CV (ie a sub)
    27			and which store lexical variables and opcode temporary and per-thread
    28			values.
    29			
    30			=for apidoc m|AV *|CvPADLIST|CV *cv
    31			CV's can have CvPADLIST(cv) set to point to an AV.
    32			
    33			For these purposes "forms" are a kind-of CV, eval""s are too (except they're
    34			not callable at will and are always thrown away after the eval"" is done
    35			executing). Require'd files are simply evals without any outer lexical
    36			scope.
    37			
    38			XSUBs don't have CvPADLIST set - dXSTARG fetches values from PL_curpad,
    39			but that is really the callers pad (a slot of which is allocated by
    40			every entersub).
    41			
    42			The CvPADLIST AV has does not have AvREAL set, so REFCNT of component items
    43			is managed "manual" (mostly in pad.c) rather than normal av.c rules.
    44			The items in the AV are not SVs as for a normal AV, but other AVs:
    45			
    46			0'th Entry of the CvPADLIST is an AV which represents the "names" or rather
    47			the "static type information" for lexicals.
    48			
    49			The CvDEPTH'th entry of CvPADLIST AV is an AV which is the stack frame at that
    50			depth of recursion into the CV.
    51			The 0'th slot of a frame AV is an AV which is @_.
    52			other entries are storage for variables and op targets.
    53			
    54			During compilation:
    55			C<PL_comppad_name> is set to the names AV.
    56			C<PL_comppad> is set to the frame AV for the frame CvDEPTH == 1.
    57			C<PL_curpad> is set to the body of the frame AV (i.e. AvARRAY(PL_comppad)).
    58			
    59			During execution, C<PL_comppad> and C<PL_curpad> refer to the live
    60			frame of the currently executing sub.
    61			
    62			Iterating over the names AV iterates over all possible pad
    63			items. Pad slots that are SVs_PADTMP (targets/GVs/constants) end up having
    64			&PL_sv_undef "names" (see pad_alloc()).
    65			
    66			Only my/our variable (SVs_PADMY/SVs_PADOUR) slots get valid names.
    67			The rest are op targets/GVs/constants which are statically allocated
    68			or resolved at compile time.  These don't have names by which they
    69			can be looked up from Perl code at run time through eval"" like
    70			my/our variables can be.  Since they can't be looked up by "name"
    71			but only by their index allocated at compile time (which is usually
    72			in PL_op->op_targ), wasting a name SV for them doesn't make sense.
    73			
    74			The SVs in the names AV have their PV being the name of the variable.
    75			NV+1..IV inclusive is a range of cop_seq numbers for which the name is
    76			valid.  For typed lexicals name SV is SVt_PVMG and SvSTASH points at the
    77			type.  For C<our> lexicals, the type is SVt_PVGV, and GvSTASH points at the
    78			stash of the associated global (so that duplicate C<our> delarations in the
    79			same package can be detected).  SvCUR is sometimes hijacked to
    80			store the generation number during compilation.
    81			
    82			If SvFAKE is set on the name SV, then that slot in the frame AV is
    83			a REFCNT'ed reference to a lexical from "outside". In this case,
    84			the name SV does not use NVX and IVX to store a cop_seq range, since it is
    85			in scope throughout. Instead IVX stores some flags containing info about
    86			the real lexical (is it declared in an anon, and is it capable of being
    87			instantiated multiple times?), and for fake ANONs, NVX contains the index
    88			within the parent's pad where the lexical's value is stored, to make
    89			cloning quicker.
    90			
    91			If the 'name' is '&' the corresponding entry in frame AV
    92			is a CV representing a possible closure.
    93			(SvFAKE and name of '&' is not a meaningful combination currently but could
    94			become so if C<my sub foo {}> is implemented.)
    95			
    96			Note that formats are treated as anon subs, and are cloned each time
    97			write is called (if necessary).
    98			
    99			The flag SVf_PADSTALE is cleared on lexicals each time the my() is executed,
   100			and set on scope exit. This allows the 'Variable $x is not available' warning
   101			to be generated in evals, such as 
   102			
   103			    { my $x = 1; sub f { eval '$x'} } f();
   104			
   105			=cut
   106			*/
   107			
   108			
   109			#include "EXTERN.h"
   110			#define PERL_IN_PAD_C
   111			#include "perl.h"
   112			
   113			
   114			#define PAD_MAX 999999999
   115			
   116			
   117			
   118			/*
   119			=for apidoc pad_new
   120			
   121			Create a new compiling padlist, saving and updating the various global
   122			vars at the same time as creating the pad itself. The following flags
   123			can be OR'ed together:
   124			
   125			    padnew_CLONE	this pad is for a cloned CV
   126			    padnew_SAVE		save old globals
   127			    padnew_SAVESUB	also save extra stuff for start of sub
   128			
   129			=cut
   130			*/
   131			
   132			PADLIST *
   133			Perl_pad_new(pTHX_ int flags)
   134	      527346    {
   135	      527346        AV *padlist, *padname, *pad;
   136			
   137	      527346        ASSERT_CURPAD_LEGAL("pad_new");
   138			
   139			    /* XXX DAPM really need a new SAVEt_PAD which restores all or most
   140			     * vars (based on flags) rather than storing vals + addresses for
   141			     * each individually. Also see pad_block_start.
   142			     * XXX DAPM Try to see whether all these conditionals are required
   143			     */
   144			
   145			    /* save existing state, ... */
   146			
   147	      527346        if (flags & padnew_SAVE) {
   148	      522846    	SAVECOMPPAD();
   149	      522846    	SAVESPTR(PL_comppad_name);
   150	      522846    	if (! (flags & padnew_CLONE)) {
   151	      507419    	    SAVEI32(PL_padix);
   152	      507419    	    SAVEI32(PL_comppad_name_fill);
   153	      507419    	    SAVEI32(PL_min_intro_pending);
   154	      507419    	    SAVEI32(PL_max_intro_pending);
   155	      507419    	    SAVEI32(PL_cv_has_eval);
   156	      507419    	    if (flags & padnew_SAVESUB) {
   157	      405652    		SAVEI32(PL_pad_reset_pending);
   158				    }
   159				}
   160			    }
   161			    /* XXX DAPM interestingly, PL_comppad_name_floor never seems to be
   162			     * saved - check at some pt that this is okay */
   163			
   164			    /* ... create new pad ... */
   165			
   166	      527346        padlist	= newAV();
   167	      527346        padname	= newAV();
   168	      527346        pad		= newAV();
   169			
   170	      527346        if (flags & padnew_CLONE) {
   171				/* XXX DAPM  I dont know why cv_clone needs it
   172				 * doing differently yet - perhaps this separate branch can be
   173				 * dispensed with eventually ???
   174				 */
   175			
   176	       15427            AV * const a0 = newAV();			/* will be @_ */
   177	       15427    	av_extend(a0, 0);
   178	       15427    	av_store(pad, 0, (SV*)a0);
   179	       15427    	AvREIFY_only(a0);
   180			    }
   181			    else {
   182	      511919    	av_store(pad, 0, Nullsv);
   183			    }
   184			
   185	      527346        AvREAL_off(padlist);
   186	      527346        av_store(padlist, 0, (SV*)padname);
   187	      527346        av_store(padlist, 1, (SV*)pad);
   188			
   189			    /* ... then update state variables */
   190			
   191	      527346        PL_comppad_name	= (AV*)(*av_fetch(padlist, 0, FALSE));
   192	      527346        PL_comppad		= (AV*)(*av_fetch(padlist, 1, FALSE));
   193	      527346        PL_curpad		= AvARRAY(PL_comppad);
   194			
   195	      527346        if (! (flags & padnew_CLONE)) {
   196	      511919    	PL_comppad_name_fill = 0;
   197	      511919    	PL_min_intro_pending = 0;
   198	      511919    	PL_padix	     = 0;
   199	      511919    	PL_cv_has_eval	     = 0;
   200			    }
   201			
   202			    DEBUG_X(PerlIO_printf(Perl_debug_log,
   203				  "Pad 0x%"UVxf"[0x%"UVxf"] new:       compcv=0x%"UVxf
   204				      " name=0x%"UVxf" flags=0x%"UVxf"\n",
   205				  PTR2UV(PL_comppad), PTR2UV(PL_curpad), PTR2UV(PL_compcv),
   206				      PTR2UV(padname), (UV)flags
   207				)
   208	      527346        );
   209			
   210	      527346        return (PADLIST*)padlist;
   211			}
   212			
   213			/*
   214			=for apidoc pad_undef
   215			
   216			Free the padlist associated with a CV.
   217			If parts of it happen to be current, we null the relevant
   218			PL_*pad* global vars so that we don't have any dangling references left.
   219			We also repoint the CvOUTSIDE of any about-to-be-orphaned
   220			inner subs to the outer of this cv.
   221			
   222			(This function should really be called pad_free, but the name was already
   223			taken)
   224			
   225			=cut
   226			*/
   227			
   228			void
   229			Perl_pad_undef(pTHX_ CV* cv)
   230	      803172    {
   231	      803172        I32 ix;
   232	      803172        const PADLIST *padlist = CvPADLIST(cv);
   233			
   234	      803172        if (!padlist)
   235	      272564    	return;
   236	      530608        if (!SvREFCNT(CvPADLIST(cv))) /* may be during global destruction */
   237	       42565    	return;
   238			
   239			    DEBUG_X(PerlIO_printf(Perl_debug_log,
   240				  "Pad undef: cv=0x%"UVxf" padlist=0x%"UVxf"\n",
   241				    PTR2UV(cv), PTR2UV(padlist))
   242	      488043        );
   243			
   244			    /* detach any '&' anon children in the pad; if afterwards they
   245			     * are still live, fix up their CvOUTSIDEs to point to our outside,
   246			     * bypassing us. */
   247			    /* XXX DAPM for efficiency, we should only do this if we know we have
   248			     * children, or integrate this loop with general cleanup */
   249			
   250	      488043        if (!PL_dirty) { /* don't bother during global destruction */
   251	      214732    	CV * const outercv = CvOUTSIDE(cv);
   252	      214732            const U32 seq = CvOUTSIDE_SEQ(cv);
   253	      214732    	AV *  const comppad_name = (AV*)AvARRAY(padlist)[0];
   254	      214732    	SV ** const namepad = AvARRAY(comppad_name);
   255	      214732    	AV *  const comppad = (AV*)AvARRAY(padlist)[1];
   256	      214732    	SV ** const curpad = AvARRAY(comppad);
   257	      490966    	for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
   258	      276234    	    SV * const namesv = namepad[ix];
   259	      276234    	    if (namesv && namesv != &PL_sv_undef
   260					&& *SvPVX_const(namesv) == '&')
   261				    {
   262	        2526    		CV * const innercv = (CV*)curpad[ix];
   263	        2526    		U32 inner_rc = SvREFCNT(innercv);
   264	        2526    		assert(inner_rc);
   265	        2526    		namepad[ix] = Nullsv;
   266	        2526    		SvREFCNT_dec(namesv);
   267			
   268	        2526    		if (SvREFCNT(comppad) < 2) { /* allow for /(?{ sub{} })/  */
   269	        2526    		    curpad[ix] = Nullsv;
   270	        2526    		    SvREFCNT_dec(innercv);
   271	        2526    		    inner_rc--;
   272					}
   273	        2526    		if (inner_rc /* in use, not just a prototype */
   274					    && CvOUTSIDE(innercv) == cv)
   275					{
   276	        1511    		    assert(CvWEAKOUTSIDE(innercv));
   277					    /* don't relink to grandfather if he's being freed */
   278	        1511    		    if (outercv && SvREFCNT(outercv)) {
   279	        1488    			CvWEAKOUTSIDE_off(innercv);
   280	        1488    			CvOUTSIDE(innercv) = outercv;
   281	        1488    			CvOUTSIDE_SEQ(innercv) = seq;
   282	        1488    			(void)SvREFCNT_inc(outercv);
   283					    }
   284					    else {
   285	          23    			CvOUTSIDE(innercv) = Nullcv;
   286					    }
   287			
   288					}
   289			
   290				    }
   291				}
   292			    }
   293			
   294	      488043        ix = AvFILLp(padlist);
   295	     1533542        while (ix >= 0) {
   296	     1045499    	SV* const sv = AvARRAY(padlist)[ix--];
   297	     1045499    	if (!sv)
   298	      ######    	    continue;
   299	     1045499    	if (sv == (SV*)PL_comppad_name)
   300	      119997    	    PL_comppad_name = Nullav;
   301	      925502    	else if (sv == (SV*)PL_comppad) {
   302	      120047    	    PL_comppad = Null(PAD*);
   303	      120047    	    PL_curpad = Null(SV**);
   304				}
   305	     1045499    	SvREFCNT_dec(sv);
   306			    }
   307	      488043        SvREFCNT_dec((SV*)CvPADLIST(cv));
   308	      488043        CvPADLIST(cv) = Null(PADLIST*);
   309			}
   310			
   311			
   312			
   313			
   314			/*
   315			=for apidoc pad_add_name
   316			
   317			Create a new name and associated PADMY SV in the current pad; return the
   318			offset.
   319			If C<typestash> is valid, the name is for a typed lexical; set the
   320			name's stash to that value.
   321			If C<ourstash> is valid, it's an our lexical, set the name's
   322			GvSTASH to that value
   323			
   324			If fake, it means we're cloning an existing entry
   325			
   326			=cut
   327			*/
   328			
   329			PADOFFSET
   330			Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake)
   331	     1048830    {
   332	     1048830        const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
   333	     1048830        SV* const namesv = NEWSV(1102, 0);
   334			
   335	     1048830        ASSERT_CURPAD_ACTIVE("pad_add_name");
   336			
   337			
   338	     1048830        sv_upgrade(namesv, ourstash ? SVt_PVGV : typestash ? SVt_PVMG : SVt_PVNV);
   339	     1048830        sv_setpv(namesv, name);
   340			
   341	     1048830        if (typestash) {
   342	          30    	SvFLAGS(namesv) |= SVpad_TYPED;
   343	          30    	SvSTASH_set(namesv, (HV*)SvREFCNT_inc((SV*) typestash));
   344			    }
   345	     1048830        if (ourstash) {
   346	      130186    	SvFLAGS(namesv) |= SVpad_OUR;
   347	      130186    	GvSTASH(namesv) = ourstash;
   348	      130186    	Perl_sv_add_backref(aTHX_ (SV*)ourstash, namesv);
   349			    }
   350			
   351	     1048830        av_store(PL_comppad_name, offset, namesv);
   352	     1048830        if (fake) {
   353	      199175    	SvFAKE_on(namesv);
   354				DEBUG_Xv(PerlIO_printf(Perl_debug_log,
   355	      199175    	    "Pad addname: %ld \"%s\" FAKE\n", (long)offset, name));
   356			    }
   357			    else {
   358				/* not yet introduced */
   359	      849655    	SvNV_set(namesv, (NV)PAD_MAX);	/* min */
   360	      849655    	SvIV_set(namesv, 0);		/* max */
   361			
   362	      849655    	if (!PL_min_intro_pending)
   363	      640387    	    PL_min_intro_pending = offset;
   364	      849655    	PL_max_intro_pending = offset;
   365				/* if it's not a simple scalar, replace with an AV or HV */
   366				/* XXX DAPM since slot has been allocated, replace
   367				 * av_store with PL_curpad[offset] ? */
   368	      849655    	if (*name == '@')
   369	       72607    	    av_store(PL_comppad, offset, (SV*)newAV());
   370	      777048    	else if (*name == '%')
   371	       38516    	    av_store(PL_comppad, offset, (SV*)newHV());
   372	      849655    	SvPADMY_on(PL_curpad[offset]);
   373				DEBUG_Xv(PerlIO_printf(Perl_debug_log,
   374				    "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
   375	      849655    	    (long)offset, name, PTR2UV(PL_curpad[offset])));
   376			    }
   377			
   378	     1048830        return offset;
   379			}
   380			
   381			
   382			
   383			
   384			/*
   385			=for apidoc pad_alloc
   386			
   387			Allocate a new my or tmp pad entry. For a my, simply push a null SV onto
   388			the end of PL_comppad, but for a tmp, scan the pad from PL_padix upwards
   389			for a slot which has no name and and no active value.
   390			
   391			=cut
   392			*/
   393			
   394			/* XXX DAPM integrate alloc(), add_name() and add_anon(),
   395			 * or at least rationalise ??? */
   396			
   397			
   398			PADOFFSET
   399			Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
   400	     5011833    {
   401	     5011833        SV *sv;
   402	     5011833        I32 retval;
   403			
   404	     5011833        ASSERT_CURPAD_ACTIVE("pad_alloc");
   405			
   406	     5011833        if (AvARRAY(PL_comppad) != PL_curpad)
   407	      ######    	Perl_croak(aTHX_ "panic: pad_alloc");
   408	     5011833        if (PL_pad_reset_pending)
   409	     1172390    	pad_reset();
   410	     5011833        if (tmptype & SVs_PADMY) {
   411	     1095769    	sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE);
   412	     1095769    	retval = AvFILLp(PL_comppad);
   413			    }
   414			    else {
   415	     3916064    	SV ** const names = AvARRAY(PL_comppad_name);
   416	     3916064            const SSize_t names_fill = AvFILLp(PL_comppad_name);
   417	     8915728    	for (;;) {
   418				    /*
   419				     * "foreach" index vars temporarily become aliases to non-"my"
   420				     * values.  Thus we must skip, not just pad values that are
   421				     * marked as current pad values, but also those with names.
   422				     */
   423				    /* HVDS why copy to sv here? we don't seem to use it */
   424	     4999664    	    if (++PL_padix <= names_fill &&
   425					   (sv = names[PL_padix]) && sv != &PL_sv_undef)
   426	      996272    		continue;
   427	     4003392    	    sv = *av_fetch(PL_comppad, PL_padix, TRUE);
   428	     4003392    	    if (!(SvFLAGS(sv) & (SVs_PADTMP | SVs_PADMY)) &&
   429					!IS_PADGV(sv) && !IS_PADCONST(sv))
   430	     3916064    		break;
   431				}
   432	     3916064    	retval = PL_padix;
   433			    }
   434	     5011833        SvFLAGS(sv) |= tmptype;
   435	     5011833        PL_curpad = AvARRAY(PL_comppad);
   436			
   437			    DEBUG_X(PerlIO_printf(Perl_debug_log,
   438				  "Pad 0x%"UVxf"[0x%"UVxf"] alloc:   %ld for %s\n",
   439				  PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long) retval,
   440	     5011833    	  PL_op_name[optype]));
   441			#ifdef DEBUG_LEAKING_SCALARS
   442			    sv->sv_debug_optype = optype;
   443			    sv->sv_debug_inpad = 1;
   444			#endif
   445	     5011833        return (PADOFFSET)retval;
   446			}
   447			
   448			/*
   449			=for apidoc pad_add_anon
   450			
   451			Add an anon code entry to the current compiling pad
   452			
   453			=cut
   454			*/
   455			
   456			PADOFFSET
   457			Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
   458	       18877    {
   459	       18877        PADOFFSET ix;
   460	       18877        SV* name;
   461			
   462	       18877        name = NEWSV(1106, 0);
   463	       18877        sv_upgrade(name, SVt_PVNV);
   464	       18877        sv_setpvn(name, "&", 1);
   465	       18877        SvIV_set(name, -1);
   466	       18877        SvNV_set(name, 1);
   467	       18877        ix = pad_alloc(op_type, SVs_PADMY);
   468	       18877        av_store(PL_comppad_name, ix, name);
   469			    /* XXX DAPM use PL_curpad[] ? */
   470	       18877        av_store(PL_comppad, ix, sv);
   471	       18877        SvPADMY_on(sv);
   472			
   473			    /* to avoid ref loops, we never have parent + child referencing each
   474			     * other simultaneously */
   475	       18877        if (CvOUTSIDE((CV*)sv)) {
   476	       18843    	assert(!CvWEAKOUTSIDE((CV*)sv));
   477	       18843    	CvWEAKOUTSIDE_on((CV*)sv);
   478	       18843    	SvREFCNT_dec(CvOUTSIDE((CV*)sv));
   479			    }
   480	       18877        return ix;
   481			}
   482			
   483			
   484			
   485			/*
   486			=for apidoc pad_check_dup
   487			
   488			Check for duplicate declarations: report any of:
   489			     * a my in the current scope with the same name;
   490			     * an our (anywhere in the pad) with the same name and the same stash
   491			       as C<ourstash>
   492			C<is_our> indicates that the name to check is an 'our' declaration
   493			
   494			=cut
   495			*/
   496			
   497			/* XXX DAPM integrate this into pad_add_name ??? */
   498			
   499			void
   500			Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash)
   501	      849655    {
   502	      849655        SV		**svp;
   503	      849655        PADOFFSET	top, off;
   504			
   505	      849655        ASSERT_CURPAD_ACTIVE("pad_check_dup");
   506	      849655        if (!ckWARN(WARN_MISC) || AvFILLp(PL_comppad_name) < 0)
   507	      263158    	return; /* nothing to check */
   508			
   509	      263158        svp = AvARRAY(PL_comppad_name);
   510	      263158        top = AvFILLp(PL_comppad_name);
   511			    /* check the current scope */
   512			    /* XXX DAPM - why the (I32) cast - shouldn't we ensure they're the same
   513			     * type ? */
   514	     2854513        for (off = top; (I32)off > PL_comppad_name_floor; off--) {
   515	     2591362    	SV * const sv = svp[off];
   516	     2591362    	if (sv
   517				    && sv != &PL_sv_undef
   518				    && !SvFAKE(sv)
   519				    && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
   520				    && (!is_our
   521					|| ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash))
   522				    && strEQ(name, SvPVX_const(sv)))
   523				{
   524	           7    	    Perl_warner(aTHX_ packWARN(WARN_MISC),
   525					"\"%s\" variable %s masks earlier declaration in same %s",
   526					(is_our ? "our" : "my"),
   527					name,
   528					(SvIVX(sv) == PAD_MAX ? "scope" : "statement"));
   529	           7    	    --off;
   530	           7    	    break;
   531				}
   532			    }
   533			    /* check the rest of the pad */
   534	      263158        if (is_our) {
   535	       21423    	do {
   536	       21423    	    SV * const sv = svp[off];
   537	       21423    	    if (sv
   538					&& sv != &PL_sv_undef
   539					&& !SvFAKE(sv)
   540					&& (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
   541					&& ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash)
   542					&& strEQ(name, SvPVX_const(sv)))
   543				    {
   544	           2    		Perl_warner(aTHX_ packWARN(WARN_MISC),
   545					    "\"our\" variable %s redeclared", name);
   546	           2    		Perl_warner(aTHX_ packWARN(WARN_MISC),
   547					    "\t(Did you mean \"local\" instead of \"our\"?)\n");
   548	           2    		break;
   549				    }
   550	       21421    	} while ( off-- > 0 );
   551			    }
   552			}
   553			
   554			
   555			/*
   556			=for apidoc pad_findmy
   557			
   558			Given a lexical name, try to find its offset, first in the current pad,
   559			or failing that, in the pads of any lexically enclosing subs (including
   560			the complications introduced by eval). If the name is found in an outer pad,
   561			then a fake entry is added to the current pad.
   562			Returns the offset in the current pad, or NOT_IN_PAD on failure.
   563			
   564			=cut
   565			*/
   566			
   567			PADOFFSET
   568			Perl_pad_findmy(pTHX_ const char *name)
   569	     4491711    {
   570	     4491711        SV *out_sv;
   571	     4491711        int out_flags;
   572	     4491711        I32 offset;
   573	     4491711        const AV *nameav;
   574	     4491711        SV **name_svp;
   575			
   576	     4491711        offset =  pad_findlex(name, PL_compcv, PL_cop_seqmax, 1,
   577					Null(SV**), &out_sv, &out_flags);
   578	     4491711        if (offset != NOT_IN_PAD) 
   579	     3167678    	return offset;
   580			
   581			    /* look for an our that's being introduced; this allows
   582			     *    our $foo = 0 unless defined $foo;
   583			     * to not give a warning. (Yes, this is a hack) */
   584			
   585	     1324033        nameav = (AV*)AvARRAY(CvPADLIST(PL_compcv))[0];
   586	     1324033        name_svp = AvARRAY(nameav);
   587	    38436929        for (offset = AvFILLp(nameav); offset > 0; offset--) {
   588	    37112899            const SV *namesv = name_svp[offset];
   589	    37112899    	if (namesv && namesv != &PL_sv_undef
   590				    && !SvFAKE(namesv)
   591				    && (SvFLAGS(namesv) & SVpad_OUR)
   592				    && strEQ(SvPVX_const(namesv), name)
   593				    && U_32(SvNVX(namesv)) == PAD_MAX /* min */
   594				)
   595	           3    	    return offset;
   596			    }
   597	     1324030        return NOT_IN_PAD;
   598			}
   599			
   600			/*
   601			 * Returns the offset of a lexical $_, if there is one, at run time.
   602			 * Used by the UNDERBAR XS macro.
   603			 */
   604			
   605			PADOFFSET
   606			Perl_find_rundefsvoffset(pTHX)
   607	           5    {
   608	           5        SV *out_sv;
   609	           5        int out_flags;
   610	           5        return pad_findlex("$_", find_runcv(NULL), PL_curcop->cop_seq, 1,
   611				    Null(SV**), &out_sv, &out_flags);
   612			}
   613			
   614			/*
   615			=for apidoc pad_findlex
   616			
   617			Find a named lexical anywhere in a chain of nested pads. Add fake entries
   618			in the inner pads if it's found in an outer one.
   619			
   620			Returns the offset in the bottom pad of the lex or the fake lex.
   621			cv is the CV in which to start the search, and seq is the current cop_seq
   622			to match against. If warn is true, print appropriate warnings.  The out_*
   623			vars return values, and so are pointers to where the returned values
   624			should be stored. out_capture, if non-null, requests that the innermost
   625			instance of the lexical is captured; out_name_sv is set to the innermost
   626			matched namesv or fake namesv; out_flags returns the flags normally
   627			associated with the IVX field of a fake namesv.
   628			
   629			Note that pad_findlex() is recursive; it recurses up the chain of CVs,
   630			then comes back down, adding fake entries as it goes. It has to be this way
   631			because fake namesvs in anon protoypes have to store in NVX the index into
   632			the parent pad.
   633			
   634			=cut
   635			*/
   636			
   637			/* Flags set in the SvIVX field of FAKE namesvs */
   638			
   639			#define PAD_FAKELEX_ANON   1 /* the lex is declared in an ANON, or ... */
   640			#define PAD_FAKELEX_MULTI  2 /* the lex can be instantiated multiple times */
   641			
   642			/* the CV has finished being compiled. This is not a sufficient test for
   643			 * all CVs (eg XSUBs), but suffices for the CVs found in a lexical chain */
   644			#define CvCOMPILED(cv)	CvROOT(cv)
   645			
   646			/* the CV does late binding of its lexicals */
   647			#define CvLATE(cv) (CvANON(cv) || SvTYPE(cv) == SVt_PVFM)
   648			
   649			
   650			STATIC PADOFFSET
   651			S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
   652				SV** out_capture, SV** out_name_sv, int *out_flags)
   653	     5921490    {
   654	     5921490        I32 offset, new_offset;
   655	     5921490        SV *new_capture;
   656	     5921490        SV **new_capturep;
   657	     5921490        const AV *padlist = CvPADLIST(cv);
   658			
   659	     5921490        *out_flags = 0;
   660			
   661			    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
   662				"Pad findlex cv=0x%"UVxf" searching \"%s\" seq=%d%s\n",
   663	     5921490    	PTR2UV(cv), name, (int)seq, out_capture ? " capturing" : "" ));
   664			
   665			    /* first, search this pad */
   666			
   667	     5921490        if (padlist) { /* not an undef CV */
   668	     5921489    	I32 fake_offset = 0;
   669	     5921489            const AV *nameav = (AV*)AvARRAY(padlist)[0];
   670	     5921489    	SV **name_svp = AvARRAY(nameav);
   671			
   672	   154116807    	for (offset = AvFILLp(nameav); offset > 0; offset--) {
   673	   151224450                const SV *namesv = name_svp[offset];
   674	   151224450    	    if (namesv && namesv != &PL_sv_undef
   675					    && strEQ(SvPVX_const(namesv), name))
   676				    {
   677	     3192797    		if (SvFAKE(namesv))
   678	      138549    		    fake_offset = offset; /* in case we don't find a real one */
   679	     3054248    		else if (  seq >  U_32(SvNVX(namesv))	/* min */
   680						&& seq <= (U32)SvIVX(namesv))	/* max */
   681	     3029132    		    break;
   682				    }
   683				}
   684			
   685	     5921489    	if (offset > 0 || fake_offset > 0 ) { /* a match! */
   686	     3167681    	    if (offset > 0) { /* not fake */
   687	     3029132    		fake_offset = 0;
   688	     3029132    		*out_name_sv = name_svp[offset]; /* return the namesv */
   689			
   690					/* set PAD_FAKELEX_MULTI if this lex can have multiple
   691					 * instances. For now, we just test !CvUNIQUE(cv), but
   692					 * ideally, we should detect my's declared within loops
   693					 * etc - this would allow a wider range of 'not stayed
   694					 * shared' warnings. We also treated alreadly-compiled
   695					 * lexes as not multi as viewed from evals. */
   696			
   697	     3029132    		*out_flags = CvANON(cv) ?
   698						PAD_FAKELEX_ANON :
   699						    (!CvUNIQUE(cv) && ! CvCOMPILED(cv))
   700							? PAD_FAKELEX_MULTI : 0;
   701			
   702					DEBUG_Xv(PerlIO_printf(Perl_debug_log,
   703					    "Pad findlex cv=0x%"UVxf" matched: offset=%ld (%ld,%ld)\n",
   704					    PTR2UV(cv), (long)offset, (long)U_32(SvNVX(*out_name_sv)),
   705	     3029132    		    (long)SvIVX(*out_name_sv)));
   706				    }
   707				    else { /* fake match */
   708	      138549    		offset = fake_offset;
   709	      138549    		*out_name_sv = name_svp[offset]; /* return the namesv */
   710	      138549    		*out_flags = SvIVX(*out_name_sv);
   711					DEBUG_Xv(PerlIO_printf(Perl_debug_log,
   712					    "Pad findlex cv=0x%"UVxf" matched: offset=%ld flags=0x%lx index=%lu\n",
   713					    PTR2UV(cv), (long)offset, (unsigned long)*out_flags,
   714						(unsigned long)SvNVX(*out_name_sv) 
   715	      138549    		));
   716				    }
   717			
   718				    /* return the lex? */
   719			
   720	     3167681    	    if (out_capture) {
   721			
   722					/* our ? */
   723	      191381    		if ((SvFLAGS(*out_name_sv) & SVpad_OUR)) {
   724	       61291    		    *out_capture = Nullsv;
   725	       61291    		    return offset;
   726					}
   727			
   728					/* trying to capture from an anon prototype? */
   729	      130090    		if (CvCOMPILED(cv)
   730						? CvANON(cv) && CvCLONE(cv) && !CvCLONED(cv)
   731						: *out_flags & PAD_FAKELEX_ANON)
   732					{
   733	          15    		    if (warn && ckWARN(WARN_CLOSURE))
   734	          15    			Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
   735						    "Variable \"%s\" is not available", name);
   736	          15    		    *out_capture = Nullsv;
   737					}
   738			
   739					/* real value */
   740					else {
   741	      130075    		    int newwarn = warn;
   742	      130075    		    if (!CvCOMPILED(cv) && (*out_flags & PAD_FAKELEX_MULTI)
   743						 && warn && ckWARN(WARN_CLOSURE)) {
   744	          16    			newwarn = 0;
   745	          16    			Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
   746						    "Variable \"%s\" will not stay shared", name);
   747					    }
   748			
   749	      130075    		    if (fake_offset && CvANON(cv)
   750						    && CvCLONE(cv) &&!CvCLONED(cv))
   751					    {
   752	           2    			SV *n;
   753						/* not yet caught - look further up */
   754						DEBUG_Xv(PerlIO_printf(Perl_debug_log,
   755						    "Pad findlex cv=0x%"UVxf" chasing lex in outer pad\n",
   756	           2    			    PTR2UV(cv)));
   757	           2    			n = *out_name_sv;
   758	           2    			pad_findlex(name, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv),
   759						    newwarn, out_capture, out_name_sv, out_flags);
   760	           2    			*out_name_sv = n;
   761	           2    			return offset;
   762					    }
   763			
   764	      130073    		    *out_capture = AvARRAY((AV*)AvARRAY(padlist)[
   765							    CvDEPTH(cv) ? CvDEPTH(cv) : 1])[offset];
   766					    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
   767						"Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n",
   768	      130073    			PTR2UV(cv), PTR2UV(*out_capture)));
   769			
   770	      130073    		    if (SvPADSTALE(*out_capture)) {
   771	           3    			if (ckWARN(WARN_CLOSURE))
   772	           3    			    Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
   773							"Variable \"%s\" is not available", name);
   774	           3    			*out_capture = Nullsv;
   775					    }
   776					}
   777	      130088    		if (!*out_capture) {
   778	          18    		    if (*name == '@')
   779	           4    			*out_capture = sv_2mortal((SV*)newAV());
   780	          14    		    else if (*name == '%')
   781	           4    			*out_capture = sv_2mortal((SV*)newHV());
   782					    else
   783	          10    			*out_capture = sv_newmortal();
   784					}
   785				    }
   786			
   787	     3106388    	    return offset;
   788				}
   789			    }
   790			
   791			    /* it's not in this pad - try above */
   792			
   793	     2753809        if (!CvOUTSIDE(cv))
   794	     1324037    	return NOT_IN_PAD;
   795			    
   796			    /* out_capture non-null means caller wants us to capture lex; in
   797			     * addition we capture ourselves unless it's an ANON/format */
   798	     1429772        new_capturep = out_capture ? out_capture :
   799					CvLATE(cv) ? Null(SV**) : &new_capture;
   800			
   801	     1429772        offset = pad_findlex(name, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1,
   802					new_capturep, out_name_sv, out_flags);
   803	     1429772        if (offset == NOT_IN_PAD)
   804	     1230460    	return NOT_IN_PAD;
   805			    
   806			    /* found in an outer CV. Add appropriate fake entry to this pad */
   807			
   808			    /* don't add new fake entries (via eval) to CVs that we have already
   809			     * finished compiling, or to undef CVs */
   810	      199312        if (CvCOMPILED(cv) || !padlist)
   811	         137    	return 0; /* this dummy (and invalid) value isnt used by the caller */
   812			
   813			    {
   814	      199175    	SV *new_namesv;
   815	      199175    	AV *  const ocomppad_name = PL_comppad_name;
   816	      199175    	PAD * const ocomppad = PL_comppad;
   817	      199175    	PL_comppad_name = (AV*)AvARRAY(padlist)[0];
   818	      199175    	PL_comppad = (AV*)AvARRAY(padlist)[1];
   819	      199175    	PL_curpad = AvARRAY(PL_comppad);
   820			
   821	      199175    	new_offset = pad_add_name(
   822				    SvPVX_const(*out_name_sv),
   823				    (SvFLAGS(*out_name_sv) & SVpad_TYPED)
   824					    ? SvSTASH(*out_name_sv) : Nullhv,
   825				    (SvFLAGS(*out_name_sv) & SVpad_OUR)
   826					    ? GvSTASH(*out_name_sv) : Nullhv,
   827				    1  /* fake */
   828				);
   829			
   830	      199175    	new_namesv = AvARRAY(PL_comppad_name)[new_offset];
   831	      199175    	SvIV_set(new_namesv, *out_flags);
   832			
   833	      199175    	SvNV_set(new_namesv, (NV)0);
   834	      199175    	if (SvFLAGS(new_namesv) & SVpad_OUR) {
   835				   /* do nothing */
   836				}
   837	      137810    	else if (CvLATE(cv)) {
   838				    /* delayed creation - just note the offset within parent pad */
   839	        7076    	    SvNV_set(new_namesv, (NV)offset);
   840	        7076    	    CvCLONE_on(cv);
   841				}
   842				else {
   843				    /* immediate creation - capture outer value right now */
   844	      130734    	    av_store(PL_comppad, new_offset, SvREFCNT_inc(*new_capturep));
   845				    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
   846					"Pad findlex cv=0x%"UVxf" saved captured sv 0x%"UVxf" at offset %ld\n",
   847	      130734    		PTR2UV(cv), PTR2UV(*new_capturep), (long)new_offset));
   848				}
   849	      199175    	*out_name_sv = new_namesv;
   850	      199175    	*out_flags = SvIVX(new_namesv);
   851			
   852	      199175    	PL_comppad_name = ocomppad_name;
   853	      199175    	PL_comppad = ocomppad;
   854	      199175    	PL_curpad = ocomppad ? AvARRAY(ocomppad) : Null(SV **);
   855			    }
   856	      199175        return new_offset;
   857			}
   858			
   859					
   860			/*
   861			=for apidoc pad_sv
   862			
   863			Get the value at offset po in the current pad.
   864			Use macro PAD_SV instead of calling this function directly.
   865			
   866			=cut
   867			*/
   868			
   869			
   870			SV *
   871			Perl_pad_sv(pTHX_ PADOFFSET po)
   872	   283162255    {
   873	   283162255        ASSERT_CURPAD_ACTIVE("pad_sv");
   874			
   875	   283162255        if (!po)
   876	      ######    	Perl_croak(aTHX_ "panic: pad_sv po");
   877			    DEBUG_X(PerlIO_printf(Perl_debug_log,
   878				"Pad 0x%"UVxf"[0x%"UVxf"] sv:      %ld sv=0x%"UVxf"\n",
   879				PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(PL_curpad[po]))
   880	   283162255        );
   881	   283162255        return PL_curpad[po];
   882			}
   883			
   884			
   885			/*
   886			=for apidoc pad_setsv
   887			
   888			Set the entry at offset po in the current pad to sv.
   889			Use the macro PAD_SETSV() rather than calling this function directly.
   890			
   891			=cut
   892			*/
   893			
   894			#ifdef DEBUGGING
   895			void
   896			Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
   897	      ######    {
   898	      ######        ASSERT_CURPAD_ACTIVE("pad_setsv");
   899			
   900			    DEBUG_X(PerlIO_printf(Perl_debug_log,
   901				"Pad 0x%"UVxf"[0x%"UVxf"] setsv:   %ld sv=0x%"UVxf"\n",
   902				PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(sv))
   903	      ######        );
   904	      ######        PL_curpad[po] = sv;
   905			}
   906			#endif
   907			
   908			
   909			
   910			/*
   911			=for apidoc pad_block_start
   912			
   913			Update the pad compilation state variables on entry to a new block
   914			
   915			=cut
   916			*/
   917			
   918			/* XXX DAPM perhaps:
   919			 * 	- integrate this in general state-saving routine ???
   920			 * 	- combine with the state-saving going on in pad_new ???
   921			 * 	- introduce a new SAVE type that does all this in one go ?
   922			 */
   923			
   924			void
   925			Perl_pad_block_start(pTHX_ int full)
   926	     1456170    {
   927	     1456170        ASSERT_CURPAD_ACTIVE("pad_block_start");
   928	     1456170        SAVEI32(PL_comppad_name_floor);
   929	     1456170        PL_comppad_name_floor = AvFILLp(PL_comppad_name);
   930	     1456170        if (full)
   931	      919170    	PL_comppad_name_fill = PL_comppad_name_floor;
   932	     1456170        if (PL_comppad_name_floor < 0)
   933	      440092    	PL_comppad_name_floor = 0;
   934	     1456170        SAVEI32(PL_min_intro_pending);
   935	     1456170        SAVEI32(PL_max_intro_pending);
   936	     1456170        PL_min_intro_pending = 0;
   937	     1456170        SAVEI32(PL_comppad_name_fill);
   938	     1456170        SAVEI32(PL_padix_floor);
   939	     1456170        PL_padix_floor = PL_padix;
   940	     1456170        PL_pad_reset_pending = FALSE;
   941			}
   942			
   943			
   944			/*
   945			=for apidoc intro_my
   946			
   947			"Introduce" my variables to visible status.
   948			
   949			=cut
   950			*/
   951			
   952			U32
   953			Perl_intro_my(pTHX)
   954	     3656323    {
   955	     3656323        SV **svp;
   956	     3656323        I32 i;
   957			
   958	     3656323        ASSERT_CURPAD_ACTIVE("intro_my");
   959	     3656323        if (! PL_min_intro_pending)
   960	     3015941    	return PL_cop_seqmax;
   961			
   962	      640382        svp = AvARRAY(PL_comppad_name);
   963	     1497506        for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
   964	      857124    	SV * const sv = svp[i];
   965			
   966	      857124    	if (sv && sv != &PL_sv_undef && !SvFAKE(sv) && !SvIVX(sv)) {
   967	      849650    	    SvIV_set(sv, PAD_MAX);	/* Don't know scope end yet. */
   968	      849650    	    SvNV_set(sv, (NV)PL_cop_seqmax);
   969				    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
   970					"Pad intromy: %ld \"%s\", (%ld,%ld)\n",
   971					(long)i, SvPVX_const(sv),
   972					(long)U_32(SvNVX(sv)), (long)SvIVX(sv))
   973	      849650    	    );
   974				}
   975			    }
   976	      640382        PL_min_intro_pending = 0;
   977	      640382        PL_comppad_name_fill = PL_max_intro_pending; /* Needn't search higher */
   978			    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
   979	      640382    		"Pad intromy: seq -> %ld\n", (long)(PL_cop_seqmax+1)));
   980			
   981	      640382        return PL_cop_seqmax++;
   982			}
   983			
   984			/*
   985			=for apidoc pad_leavemy
   986			
   987			Cleanup at end of scope during compilation: set the max seq number for
   988			lexicals in this scope and warn of any lexicals that never got introduced.
   989			
   990			=cut
   991			*/
   992			
   993			void
   994			Perl_pad_leavemy(pTHX)
   995	     1455353    {
   996	     1455353        I32 off;
   997	     1455353        SV ** const svp = AvARRAY(PL_comppad_name);
   998			
   999	     1455353        PL_pad_reset_pending = FALSE;
  1000			
  1001	     1455353        ASSERT_CURPAD_ACTIVE("pad_leavemy");
  1002	     1455353        if (PL_min_intro_pending && PL_comppad_name_fill < PL_min_intro_pending) {
  1003	      ######    	for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
  1004	      ######    	    const SV * const sv = svp[off];
  1005	      ######    	    if (sv && sv != &PL_sv_undef
  1006					    && !SvFAKE(sv) && ckWARN_d(WARN_INTERNAL))
  1007	      ######    		Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
  1008								"%"SVf" never introduced", sv);
  1009				}
  1010			    }
  1011			    /* "Deintroduce" my variables that are leaving with this scope. */
  1012	     9050192        for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_fill; off--) {
  1013	     7594839    	const SV * const sv = svp[off];
  1014	     7594839    	if (sv && sv != &PL_sv_undef && !SvFAKE(sv) && SvIVX(sv) == PAD_MAX) {
  1015	      849339    	    SvIV_set(sv, PL_cop_seqmax);
  1016				    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
  1017					"Pad leavemy: %ld \"%s\", (%ld,%ld)\n",
  1018					(long)off, SvPVX_const(sv),
  1019					(long)U_32(SvNVX(sv)), (long)SvIVX(sv))
  1020	      849339    	    );
  1021				}
  1022			    }
  1023	     1455353        PL_cop_seqmax++;
  1024			    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
  1025	     1455353    	    "Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax));
  1026			}
  1027			
  1028			
  1029			/*
  1030			=for apidoc pad_swipe
  1031			
  1032			Abandon the tmp in the current pad at offset po and replace with a
  1033			new one.
  1034			
  1035			=cut
  1036			*/
  1037			
  1038			void
  1039			Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
  1040	      319881    {
  1041	      319881        ASSERT_CURPAD_LEGAL("pad_swipe");
  1042	      319881        if (!PL_curpad)
  1043	      ######    	return;
  1044	      319881        if (AvARRAY(PL_comppad) != PL_curpad)
  1045	      ######    	Perl_croak(aTHX_ "panic: pad_swipe curpad");
  1046	      319881        if (!po)
  1047	      ######    	Perl_croak(aTHX_ "panic: pad_swipe po");
  1048			
  1049			    DEBUG_X(PerlIO_printf(Perl_debug_log,
  1050					"Pad 0x%"UVxf"[0x%"UVxf"] swipe:   %ld\n",
  1051	      319881    		PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po));
  1052			
  1053	      319881        if (PL_curpad[po])
  1054	      319881    	SvPADTMP_off(PL_curpad[po]);
  1055	      319881        if (refadjust)
  1056	      ######    	SvREFCNT_dec(PL_curpad[po]);
  1057			
  1058			
  1059			    /* if pad tmps aren't shared between ops, then there's no need to
  1060			     * create a new tmp when an existing op is freed */
  1061			#ifdef USE_BROKEN_PAD_RESET
  1062			    PL_curpad[po] = NEWSV(1107,0);
  1063			    SvPADTMP_on(PL_curpad[po]);
  1064			#else
  1065	      319881        PL_curpad[po] = &PL_sv_undef;
  1066			#endif
  1067	      319881        if ((I32)po < PL_padix)
  1068	      ######    	PL_padix = po - 1;
  1069			}
  1070			
  1071			
  1072			/*
  1073			=for apidoc pad_reset
  1074			
  1075			Mark all the current temporaries for reuse
  1076			
  1077			=cut
  1078			*/
  1079			
  1080			/* XXX pad_reset() is currently disabled because it results in serious bugs.
  1081			 * It causes pad temp TARGs to be shared between OPs. Since TARGs are pushed
  1082			 * on the stack by OPs that use them, there are several ways to get an alias
  1083			 * to  a shared TARG.  Such an alias will change randomly and unpredictably.
  1084			 * We avoid doing this until we can think of a Better Way.
  1085			 * GSAR 97-10-29 */
  1086			void
  1087			Perl_pad_reset(pTHX)
  1088	     1172390    {
  1089			#ifdef USE_BROKEN_PAD_RESET
  1090			    if (AvARRAY(PL_comppad) != PL_curpad)
  1091				Perl_croak(aTHX_ "panic: pad_reset curpad");
  1092			
  1093			    DEBUG_X(PerlIO_printf(Perl_debug_log,
  1094				    "Pad 0x%"UVxf"[0x%"UVxf"] reset:     padix %ld -> %ld",
  1095				    PTR2UV(PL_comppad), PTR2UV(PL_curpad),
  1096					(long)PL_padix, (long)PL_padix_floor
  1097				    )
  1098			    );
  1099			
  1100			    if (!PL_tainting) {	/* Can't mix tainted and non-tainted temporaries. */
  1101			        register I32 po;
  1102				for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
  1103				    if (PL_curpad[po] && !SvIMMORTAL(PL_curpad[po]))
  1104					SvPADTMP_off(PL_curpad[po]);
  1105				}
  1106				PL_padix = PL_padix_floor;
  1107			    }
  1108			#endif
  1109	     1172390        PL_pad_reset_pending = FALSE;
  1110			}
  1111			
  1112			
  1113			/*
  1114			=for apidoc pad_tidy
  1115			
  1116			Tidy up a pad after we've finished compiling it:
  1117			    * remove most stuff from the pads of anonsub prototypes;
  1118			    * give it a @_;
  1119			    * mark tmps as such.
  1120			
  1121			=cut
  1122			*/
  1123			
  1124			/* XXX DAPM surely most of this stuff should be done properly
  1125			 * at the right time beforehand, rather than going around afterwards
  1126			 * cleaning up our mistakes ???
  1127			 */
  1128			
  1129			void
  1130			Perl_pad_tidy(pTHX_ padtidy_type type)
  1131	      347552    {
  1132			    dVAR;
  1133			
  1134	      347552        ASSERT_CURPAD_ACTIVE("pad_tidy");
  1135			
  1136			    /* If this CV has had any 'eval-capable' ops planted in it
  1137			     * (ie it contains eval '...', //ee, /$var/ or /(?{..})/), Then any
  1138			     * anon prototypes in the chain of CVs should be marked as cloneable,
  1139			     * so that for example the eval's CV in C<< sub { eval '$x' } >> gets
  1140			     * the right CvOUTSIDE.
  1141			     * If running with -d, *any* sub may potentially have an eval
  1142			     * excuted within it.
  1143			     */
  1144			
  1145	      347552        if (PL_cv_has_eval || PL_perldb) {
  1146	       16240            const CV *cv;
  1147	       49110    	for (cv = PL_compcv ;cv; cv = CvOUTSIDE(cv)) {
  1148	       33221    	    if (cv != PL_compcv && CvCOMPILED(cv))
  1149	         351    		break; /* no need to mark already-compiled code */
  1150	       32870    	    if (CvANON(cv)) {
  1151					DEBUG_Xv(PerlIO_printf(Perl_debug_log,
  1152	         687    		    "Pad clone on cv=0x%"UVxf"\n", PTR2UV(cv)));
  1153	         687    		CvCLONE_on(cv);
  1154				    }
  1155				}
  1156			    }
  1157			
  1158			    /* extend curpad to match namepad */
  1159	      347552        if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
  1160	      340324    	av_store(PL_comppad_name, AvFILLp(PL_comppad), Nullsv);
  1161			
  1162	      347552        if (type == padtidy_SUBCLONE) {
  1163	        5016    	SV ** const namep = AvARRAY(PL_comppad_name);
  1164	        5016    	PADOFFSET ix;
  1165			
  1166	       47350    	for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
  1167	       42334    	    SV *namesv;
  1168			
  1169	       42334    	    if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
  1170	       40897    		continue;
  1171				    /*
  1172				     * The only things that a clonable function needs in its
  1173				     * pad are anonymous subs.
  1174				     * The rest are created anew during cloning.
  1175				     */
  1176	       40897    	    if (!((namesv = namep[ix]) != Nullsv &&
  1177					  namesv != &PL_sv_undef &&
  1178					   *SvPVX_const(namesv) == '&'))
  1179				    {
  1180	       40818    		SvREFCNT_dec(PL_curpad[ix]);
  1181	       40818    		PL_curpad[ix] = Nullsv;
  1182				    }
  1183				}
  1184			    }
  1185	      342536        else if (type == padtidy_SUB) {
  1186				/* XXX DAPM this same bit of code keeps appearing !!! Rationalise? */
  1187	      342448    	AV * const av = newAV();			/* Will be @_ */
  1188	      342448    	av_extend(av, 0);
  1189	      342448    	av_store(PL_comppad, 0, (SV*)av);
  1190	      342448    	AvREIFY_only(av);
  1191			    }
  1192			
  1193			    /* XXX DAPM rationalise these two similar branches */
  1194			
  1195	      347552        if (type == padtidy_SUB) {
  1196	      342448    	PADOFFSET ix;
  1197	     4471549    	for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
  1198	     4129101    	    if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
  1199	     4056783    		continue;
  1200	     4056783    	    if (!SvPADMY(PL_curpad[ix]))
  1201	     3172096    		SvPADTMP_on(PL_curpad[ix]);
  1202				}
  1203			    }
  1204	        5104        else if (type == padtidy_FORMAT) {
  1205	          88    	PADOFFSET ix;
  1206	         175    	for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
  1207	          87    	    if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix]))
  1208	          52    		SvPADTMP_on(PL_curpad[ix]);
  1209				}
  1210			    }
  1211	      347552        PL_curpad = AvARRAY(PL_comppad);
  1212			}
  1213			
  1214			
  1215			/*
  1216			=for apidoc pad_free
  1217			
  1218			Free the SV at offet po in the current pad.
  1219			
  1220			=cut
  1221			*/
  1222			
  1223			/* XXX DAPM integrate with pad_swipe ???? */
  1224			void
  1225			Perl_pad_free(pTHX_ PADOFFSET po)
  1226	     7762006    {
  1227	     7762006        ASSERT_CURPAD_LEGAL("pad_free");
  1228	     7762006        if (!PL_curpad)
  1229	     6571445    	return;
  1230	     1190561        if (AvARRAY(PL_comppad) != PL_curpad)
  1231	      ######    	Perl_croak(aTHX_ "panic: pad_free curpad");
  1232	     1190561        if (!po)
  1233	      ######    	Perl_croak(aTHX_ "panic: pad_free po");
  1234			
  1235			    DEBUG_X(PerlIO_printf(Perl_debug_log,
  1236				    "Pad 0x%"UVxf"[0x%"UVxf"] free:    %ld\n",
  1237				    PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po)
  1238	     1190561        );
  1239			
  1240	     1190561        if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
  1241	      870680    	SvPADTMP_off(PL_curpad[po]);
  1242			#ifdef USE_ITHREADS
  1243				/* SV could be a shared hash key (eg bugid #19022) */
  1244				if (
  1245			#ifdef PERL_OLD_COPY_ON_WRITE
  1246				    !SvIsCOW(PL_curpad[po])
  1247			#else
  1248				    !SvFAKE(PL_curpad[po])
  1249			#endif
  1250				    )
  1251				    SvREADONLY_off(PL_curpad[po]);	/* could be a freed constant */
  1252			#endif
  1253			    }
  1254	     1190561        if ((I32)po < PL_padix)
  1255	      134599    	PL_padix = po - 1;
  1256			}
  1257			
  1258			
  1259			
  1260			/*
  1261			=for apidoc do_dump_pad
  1262			
  1263			Dump the contents of a padlist
  1264			
  1265			=cut
  1266			*/
  1267			
  1268			void
  1269			Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
  1270	           2    {
  1271	           2        const AV *pad_name;
  1272	           2        const AV *pad;
  1273	           2        SV **pname;
  1274	           2        SV **ppad;
  1275	           2        I32 ix;
  1276			
  1277	           2        if (!padlist) {
  1278	      ######    	return;
  1279			    }
  1280	           2        pad_name = (AV*)*av_fetch((AV*)padlist, 0, FALSE);
  1281	           2        pad = (AV*)*av_fetch((AV*)padlist, 1, FALSE);
  1282	           2        pname = AvARRAY(pad_name);
  1283	           2        ppad = AvARRAY(pad);
  1284	           2        Perl_dump_indent(aTHX_ level, file,
  1285				    "PADNAME = 0x%"UVxf"(0x%"UVxf") PAD = 0x%"UVxf"(0x%"UVxf")\n",
  1286				    PTR2UV(pad_name), PTR2UV(pname), PTR2UV(pad), PTR2UV(ppad)
  1287			    );
  1288			
  1289	          50        for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
  1290	          48            const SV *namesv = pname[ix];
  1291	          48    	if (namesv && namesv == &PL_sv_undef) {
  1292	          45    	    namesv = Nullsv;
  1293				}
  1294	          48    	if (namesv) {
  1295	           3    	    if (SvFAKE(namesv))
  1296	           1    		Perl_dump_indent(aTHX_ level+1, file,
  1297					    "%2d. 0x%"UVxf"<%lu> FAKE \"%s\" flags=0x%lx index=%lu\n",
  1298					    (int) ix,
  1299					    PTR2UV(ppad[ix]),
  1300					    (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
  1301					    SvPVX_const(namesv),
  1302					    (unsigned long)SvIVX(namesv),
  1303					    (unsigned long)SvNVX(namesv)
  1304			
  1305					);
  1306				    else
  1307	           2    		Perl_dump_indent(aTHX_ level+1, file,
  1308					    "%2d. 0x%"UVxf"<%lu> (%ld,%ld) \"%s\"\n",
  1309					    (int) ix,
  1310					    PTR2UV(ppad[ix]),
  1311					    (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
  1312					    (long)U_32(SvNVX(namesv)),
  1313					    (long)SvIVX(namesv),
  1314					    SvPVX_const(namesv)
  1315					);
  1316				}
  1317	          45    	else if (full) {
  1318	      ######    	    Perl_dump_indent(aTHX_ level+1, file,
  1319					"%2d. 0x%"UVxf"<%lu>\n",
  1320					(int) ix,
  1321					PTR2UV(ppad[ix]),
  1322					(unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0)
  1323				    );
  1324				}
  1325			    }
  1326			}
  1327			
  1328			
  1329			
  1330			/*
  1331			=for apidoc cv_dump
  1332			
  1333			dump the contents of a CV
  1334			
  1335			=cut
  1336			*/
  1337			
  1338			#ifdef DEBUGGING
  1339			STATIC void
  1340			S_cv_dump(pTHX_ const CV *cv, const char *title)
  1341	      ######    {
  1342	      ######        const CV * const outside = CvOUTSIDE(cv);
  1343	      ######        AV* const padlist = CvPADLIST(cv);
  1344			
  1345	      ######        PerlIO_printf(Perl_debug_log,
  1346					  "  %s: CV=0x%"UVxf" (%s), OUTSIDE=0x%"UVxf" (%s)\n",
  1347					  title,
  1348					  PTR2UV(cv),
  1349					  (CvANON(cv) ? "ANON"
  1350					   : (SvTYPE(cv) == SVt_PVFM) ? "FORMAT"
  1351					   : (cv == PL_main_cv) ? "MAIN"
  1352					   : CvUNIQUE(cv) ? "UNIQUE"
  1353					   : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
  1354					  PTR2UV(outside),
  1355					  (!outside ? "null"
  1356					   : CvANON(outside) ? "ANON"
  1357					   : (outside == PL_main_cv) ? "MAIN"
  1358					   : CvUNIQUE(outside) ? "UNIQUE"
  1359					   : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
  1360			
  1361	      ######        PerlIO_printf(Perl_debug_log,
  1362					    "    PADLIST = 0x%"UVxf"\n", PTR2UV(padlist));
  1363	      ######        do_dump_pad(1, Perl_debug_log, padlist, 1);
  1364			}
  1365			#endif /* DEBUGGING */
  1366			
  1367			
  1368			
  1369			
  1370			
  1371			/*
  1372			=for apidoc cv_clone
  1373			
  1374			Clone a CV: make a new CV which points to the same code etc, but which
  1375			has a newly-created pad built by copying the prototype pad and capturing
  1376			any outer lexicals.
  1377			
  1378			=cut
  1379			*/
  1380			
  1381			CV *
  1382			Perl_cv_clone(pTHX_ CV *proto)
  1383	       15427    {
  1384			    dVAR;
  1385	       15427        I32 ix;
  1386	       15427        AV* const protopadlist = CvPADLIST(proto);
  1387	       15427        const AV* const protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
  1388	       15427        const AV* const protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
  1389	       15427        SV** const pname = AvARRAY(protopad_name);
  1390	       15427        SV** const ppad = AvARRAY(protopad);
  1391	       15427        const I32 fname = AvFILLp(protopad_name);
  1392	       15427        const I32 fpad = AvFILLp(protopad);
  1393	       15427        CV* cv;
  1394	       15427        SV** outpad;
  1395	       15427        CV* outside;
  1396	       15427        long depth;
  1397			
  1398	       15427        assert(!CvUNIQUE(proto));
  1399			
  1400			    /* Since cloneable anon subs can be nested, CvOUTSIDE may point
  1401			     * to a prototype; we instead want the cloned parent who called us.
  1402			     * Note that in general for formats, CvOUTSIDE != find_runcv */
  1403			
  1404	       15427        outside = CvOUTSIDE(proto);
  1405	       15427        if (outside && CvCLONE(outside) && ! CvCLONED(outside))
  1406	          47    	outside = find_runcv(NULL);
  1407	       15427        depth = CvDEPTH(outside);
  1408	       15427        assert(depth || SvTYPE(proto) == SVt_PVFM);
  1409	       15427        if (!depth)
  1410	           2    	depth = 1;
  1411	       15427        assert(CvPADLIST(outside));
  1412			
  1413	       15427        ENTER;
  1414	       15427        SAVESPTR(PL_compcv);
  1415			
  1416	       15427        cv = PL_compcv = (CV*)NEWSV(1104, 0);
  1417	       15427        sv_upgrade((SV *)cv, SvTYPE(proto));
  1418	       15427        CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE);
  1419	       15427        CvCLONED_on(cv);
  1420			
  1421			#ifdef USE_ITHREADS
  1422			    CvFILE(cv)		= CvXSUB(proto) ? CvFILE(proto)
  1423								: savepv(CvFILE(proto));
  1424			#else
  1425	       15427        CvFILE(cv)		= CvFILE(proto);
  1426			#endif
  1427	       15427        CvGV(cv)		= CvGV(proto);
  1428	       15427        CvSTASH(cv)		= CvSTASH(proto);
  1429	       15427        OP_REFCNT_LOCK;
  1430	       15427        CvROOT(cv)		= OpREFCNT_inc(CvROOT(proto));
  1431	       15427        OP_REFCNT_UNLOCK;
  1432	       15427        CvSTART(cv)		= CvSTART(proto);
  1433	       15427        CvOUTSIDE(cv)	= (CV*)SvREFCNT_inc(outside);
  1434	       15427        CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
  1435			
  1436	       15427        if (SvPOK(proto))
  1437	        2682    	sv_setpvn((SV*)cv, SvPVX_const(proto), SvCUR(proto));
  1438			
  1439	       15427        CvPADLIST(cv) = pad_new(padnew_CLONE|padnew_SAVE);
  1440			
  1441	       15427        av_fill(PL_comppad, fpad);
  1442	      127924        for (ix = fname; ix >= 0; ix--)
  1443	      112497    	av_store(PL_comppad_name, ix, SvREFCNT_inc(pname[ix]));
  1444			
  1445	       15427        PL_curpad = AvARRAY(PL_comppad);
  1446			
  1447	       15427        outpad = AvARRAY(AvARRAY(CvPADLIST(outside))[depth]);
  1448			
  1449	      112497        for (ix = fpad; ix > 0; ix--) {
  1450	       97070    	SV* const namesv = (ix <= fname) ? pname[ix] : Nullsv;
  1451	       97070    	SV *sv = Nullsv;
  1452	       97070    	if (namesv && namesv != &PL_sv_undef) { /* lexical */
  1453	       25486    	    if (SvFAKE(namesv)) {   /* lexical from outside? */
  1454	       19690    		sv = outpad[(I32)SvNVX(namesv)];
  1455	       19690    		assert(sv);
  1456					/* formats may have an inactive parent */
  1457	       19690    		if (SvTYPE(proto) == SVt_PVFM && SvPADSTALE(sv)) {
  1458	      ######    		    if (ckWARN(WARN_CLOSURE))
  1459	      ######    			Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
  1460						    "Variable \"%s\" is not available", SvPVX_const(namesv));
  1461	      ######    		    sv = Nullsv;
  1462					}
  1463					else {
  1464	       19690    		    assert(!SvPADSTALE(sv));
  1465	       19690    		    sv = SvREFCNT_inc(sv);
  1466					}
  1467				    }
  1468	       25486    	    if (!sv) {
  1469	        5796                    const char sigil = SvPVX_const(namesv)[0];
  1470	        5796                    if (sigil == '&')
  1471	         370    		    sv = SvREFCNT_inc(ppad[ix]);
  1472	        5426                    else if (sigil == '@')
  1473	         951    		    sv = (SV*)newAV();
  1474	        4475                    else if (sigil == '%')
  1475	           6    		    sv = (SV*)newHV();
  1476					else
  1477	        4469    		    sv = NEWSV(0, 0);
  1478	        5796    		SvPADMY_on(sv);
  1479				    }
  1480				}
  1481	       71584    	else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) {
  1482	       71584    	    sv = SvREFCNT_inc(ppad[ix]);
  1483				}
  1484				else {
  1485	       71584    	    sv = NEWSV(0, 0);
  1486	       71584    	    SvPADTMP_on(sv);
  1487				}
  1488	       97070    	PL_curpad[ix] = sv;
  1489			    }
  1490			
  1491			    DEBUG_Xv(
  1492				PerlIO_printf(Perl_debug_log, "\nPad CV clone\n");
  1493				cv_dump(outside, "Outside");
  1494				cv_dump(proto,	 "Proto");
  1495				cv_dump(cv,	 "To");
  1496	       15427        );
  1497			
  1498	       15427        LEAVE;
  1499			
  1500	       15427        if (CvCONST(cv)) {
  1501				/* Constant sub () { $x } closing over $x - see lib/constant.pm:
  1502				 * The prototype was marked as a candiate for const-ization,
  1503				 * so try to grab the current const value, and if successful,
  1504				 * turn into a const sub:
  1505				 */
  1506	        2641    	SV* const_sv = op_const_sv(CvSTART(cv), cv);
  1507	        2641    	if (const_sv) {
  1508	        2640    	    SvREFCNT_dec(cv);
  1509	        2640    	    cv = newCONSTSUB(CvSTASH(proto), 0, const_sv);
  1510				}
  1511				else {
  1512	           1    	    CvCONST_off(cv);
  1513				}
  1514			    }
  1515			
  1516	       15427        return cv;
  1517			}
  1518			
  1519			
  1520			/*
  1521			=for apidoc pad_fixup_inner_anons
  1522			
  1523			For any anon CVs in the pad, change CvOUTSIDE of that CV from
  1524			old_cv to new_cv if necessary. Needed when a newly-compiled CV has to be
  1525			moved to a pre-existing CV struct.
  1526			
  1527			=cut
  1528			*/
  1529			
  1530			void
  1531			Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
  1532	        5541    {
  1533	        5541        I32 ix;
  1534	        5541        AV * const comppad_name = (AV*)AvARRAY(padlist)[0];
  1535	        5541        AV * const comppad = (AV*)AvARRAY(padlist)[1];
  1536	        5541        SV ** const namepad = AvARRAY(comppad_name);
  1537	        5541        SV ** const curpad = AvARRAY(comppad);
  1538	      180916        for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
  1539	      175375            const SV *namesv = namepad[ix];
  1540	      175375    	if (namesv && namesv != &PL_sv_undef
  1541				    && *SvPVX_const(namesv) == '&')
  1542				{
  1543	           1    	    CV *innercv = (CV*)curpad[ix];
  1544	           1    	    assert(CvWEAKOUTSIDE(innercv));
  1545	           1    	    assert(CvOUTSIDE(innercv) == old_cv);
  1546	           1    	    CvOUTSIDE(innercv) = new_cv;
  1547				}
  1548			    }
  1549			}
  1550			
  1551			
  1552			/*
  1553			=for apidoc pad_push
  1554			
  1555			Push a new pad frame onto the padlist, unless there's already a pad at
  1556			this depth, in which case don't bother creating a new one.  Then give
  1557			the new pad an @_ in slot zero.
  1558			
  1559			=cut
  1560			*/
  1561			
  1562			void
  1563			Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
  1564	    10943929    {
  1565	    10943929        if (depth <= AvFILLp(padlist))
  1566	    10873586    	return;
  1567			
  1568			    {
  1569	       70343    	SV** svp = AvARRAY(padlist);
  1570	       70343    	AV *newpad = newAV();
  1571	       70343    	SV **oldpad = AvARRAY(svp[depth-1]);
  1572	       70343    	I32 ix = AvFILLp((AV*)svp[1]);
  1573	       70343            const I32 names_fill = AvFILLp((AV*)svp[0]);
  1574	       70343    	SV** names = AvARRAY(svp[0]);
  1575	      350817    	AV *av;
  1576			
  1577	      631291    	for ( ;ix > 0; ix--) {
  1578	      280474    	    if (names_fill >= ix && names[ix] != &PL_sv_undef) {
  1579	       16512    		const char sigil = SvPVX_const(names[ix])[0];
  1580	       16512    		if ((SvFLAGS(names[ix]) & SVf_FAKE) || sigil == '&') {
  1581					    /* outer lexical or anon code */
  1582	        2094    		    av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]));
  1583					}
  1584					else {		/* our own lexical */
  1585	       14418    		    SV *sv; 
  1586	       14418    		    if (sigil == '@')
  1587	         701    			sv = (SV*)newAV();
  1588	       13717    		    else if (sigil == '%')
  1589	         175    			sv = (SV*)newHV();
  1590					    else
  1591	       13542    			sv = NEWSV(0, 0);
  1592	       14418    		    av_store(newpad, ix, sv);
  1593	       14418    		    SvPADMY_on(sv);
  1594					}
  1595				    }
  1596	      263962    	    else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
  1597	      263962    		av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]));
  1598				    }
  1599				    else {
  1600					/* save temporaries on recursion? */
  1601	      263962    		SV *sv = NEWSV(0, 0);
  1602	      263962    		av_store(newpad, ix, sv);
  1603	      263962    		SvPADTMP_on(sv);
  1604				    }
  1605				}
  1606	       70343    	av = newAV();
  1607	       70343    	av_extend(av, 0);
  1608	       70343    	av_store(newpad, 0, (SV*)av);
  1609	       70343    	AvREIFY_only(av);
  1610			
  1611	       70343    	av_store(padlist, depth, (SV*)newpad);
  1612	       70343    	AvFILLp(padlist) = depth;
  1613			    }
  1614			}
  1615			
  1616			
  1617			HV *
  1618			Perl_pad_compname_type(pTHX_ const PADOFFSET po)
  1619	          44    {
  1620	          44        SV** const av = av_fetch(PL_comppad_name, po, FALSE);
  1621	          44        if ( SvFLAGS(*av) & SVpad_TYPED ) {
  1622	           7            return SvSTASH(*av);
  1623			    }
  1624	          37        return Nullhv;
  1625			}
  1626			
  1627			/*
  1628			 * Local variables:
  1629			 * c-indentation-style: bsd
  1630			 * c-basic-offset: 4
  1631			 * indent-tabs-mode: t
  1632			 * End:
  1633			 *
  1634			 * ex: set ts=8 sts=4 sw=4 noet:
  1635			 */