3 * Copyright (C) 2002, 2003, 2004, by Larry Wall and others
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.
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
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.
23 =head1 Pad Data Structures
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
30 =for apidoc m|AV *|CvPADLIST|CV *cv
31 CV's can have CvPADLIST(cv) set to point to an AV.
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
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
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:
46 0'th Entry of the CvPADLIST is an AV which represents the "names" or rather
47 the "static type information" for lexicals.
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.
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)).
59 During execution, C<PL_comppad> and C<PL_curpad> refer to the live
60 frame of the currently executing sub.
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()).
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.
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.
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
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.)
96 Note that formats are treated as anon subs, and are cloned each time
97 write is called (if necessary).
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
103 { my $x = 1; sub f { eval '$x'} } f();
110 #define PERL_IN_PAD_C
114 #define PAD_MAX 999999999
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:
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
133 Perl_pad_new(pTHX_ int flags)
135 AV *padlist, *padname, *pad, *a0;
137 ASSERT_CURPAD_LEGAL("pad_new");
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
145 /* save existing state, ... */
147 if (flags & padnew_SAVE) {
149 SAVESPTR(PL_comppad_name);
150 if (! (flags & padnew_CLONE)) {
152 SAVEI32(PL_comppad_name_fill);
153 SAVEI32(PL_min_intro_pending);
154 SAVEI32(PL_max_intro_pending);
155 SAVEI32(PL_cv_has_eval);
156 if (flags & padnew_SAVESUB) {
157 SAVEI32(PL_pad_reset_pending);
161 /* XXX DAPM interestingly, PL_comppad_name_floor never seems to be
162 * saved - check at some pt that this is okay */
164 /* ... create new pad ... */
170 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 ???
176 a0 = newAV(); /* will be @_ */
178 av_store(pad, 0, (SV*)a0);
179 AvFLAGS(a0) = AVf_REIFY;
182 av_store(pad, 0, Nullsv);
186 av_store(padlist, 0, (SV*)padname);
187 av_store(padlist, 1, (SV*)pad);
189 /* ... then update state variables */
191 PL_comppad_name = (AV*)(*av_fetch(padlist, 0, FALSE));
192 PL_comppad = (AV*)(*av_fetch(padlist, 1, FALSE));
193 PL_curpad = AvARRAY(PL_comppad);
195 if (! (flags & padnew_CLONE)) {
196 PL_comppad_name_fill = 0;
197 PL_min_intro_pending = 0;
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
210 return (PADLIST*)padlist;
214 =for apidoc pad_undef
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.
222 (This function should really be called pad_free, but the name was already
229 Perl_pad_undef(pTHX_ CV* cv)
232 PADLIST *padlist = CvPADLIST(cv);
236 if (!SvREFCNT(CvPADLIST(cv))) /* may be during global destruction */
239 DEBUG_X(PerlIO_printf(Perl_debug_log,
240 "Pad undef: cv=0x%"UVxf" padlist=0x%"UVxf"\n",
241 PTR2UV(cv), PTR2UV(padlist))
244 /* detach any '&' anon children in the pad; if afterwards they
245 * are still live, fix up their CvOUTSIDEs to point to our outside,
247 /* XXX DAPM for efficiency, we should only do this if we know we have
248 * children, or integrate this loop with general cleanup */
250 if (!PL_dirty) { /* don't bother during global destruction */
251 CV *outercv = CvOUTSIDE(cv);
252 U32 seq = CvOUTSIDE_SEQ(cv);
253 AV *comppad_name = (AV*)AvARRAY(padlist)[0];
254 SV **namepad = AvARRAY(comppad_name);
255 AV *comppad = (AV*)AvARRAY(padlist)[1];
256 SV **curpad = AvARRAY(comppad);
257 for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
258 SV *namesv = namepad[ix];
259 if (namesv && namesv != &PL_sv_undef
260 && *SvPVX(namesv) == '&')
262 CV *innercv = (CV*)curpad[ix];
263 namepad[ix] = Nullsv;
264 SvREFCNT_dec(namesv);
266 if (SvREFCNT(comppad) < 2) { /* allow for /(?{ sub{} })/ */
268 SvREFCNT_dec(innercv);
270 if (SvREFCNT(innercv) /* in use, not just a prototype */
271 && CvOUTSIDE(innercv) == cv)
273 assert(CvWEAKOUTSIDE(innercv));
274 /* don't relink to grandfather if he's being freed */
275 if (outercv && SvREFCNT(outercv)) {
276 CvWEAKOUTSIDE_off(innercv);
277 CvOUTSIDE(innercv) = outercv;
278 CvOUTSIDE_SEQ(innercv) = seq;
279 SvREFCNT_inc(outercv);
282 CvOUTSIDE(innercv) = Nullcv;
291 ix = AvFILLp(padlist);
293 SV* sv = AvARRAY(padlist)[ix--];
296 if (sv == (SV*)PL_comppad_name)
297 PL_comppad_name = Nullav;
298 else if (sv == (SV*)PL_comppad) {
299 PL_comppad = Null(PAD*);
300 PL_curpad = Null(SV**);
304 SvREFCNT_dec((SV*)CvPADLIST(cv));
305 CvPADLIST(cv) = Null(PADLIST*);
312 =for apidoc pad_add_name
314 Create a new name and associated PADMY SV in the current pad; return the
316 If C<typestash> is valid, the name is for a typed lexical; set the
317 name's stash to that value.
318 If C<ourstash> is valid, it's an our lexical, set the name's
319 GvSTASH to that value
321 If fake, it means we're cloning an existing entry
327 Perl_pad_add_name(pTHX_ char *name, HV* typestash, HV* ourstash, bool fake)
329 PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
330 SV* namesv = NEWSV(1102, 0);
332 ASSERT_CURPAD_ACTIVE("pad_add_name");
335 sv_upgrade(namesv, ourstash ? SVt_PVGV : typestash ? SVt_PVMG : SVt_PVNV);
336 sv_setpv(namesv, name);
339 SvFLAGS(namesv) |= SVpad_TYPED;
340 SvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*) typestash);
343 SvFLAGS(namesv) |= SVpad_OUR;
344 GvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*) ourstash);
347 av_store(PL_comppad_name, offset, namesv);
350 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
351 "Pad addname: %ld \"%s\" FAKE\n", (long)offset, name));
354 /* not yet introduced */
355 SvNVX(namesv) = (NV)PAD_MAX; /* min */
356 SvIVX(namesv) = 0; /* max */
358 if (!PL_min_intro_pending)
359 PL_min_intro_pending = offset;
360 PL_max_intro_pending = offset;
361 /* if it's not a simple scalar, replace with an AV or HV */
362 /* XXX DAPM since slot has been allocated, replace
363 * av_store with PL_curpad[offset] ? */
365 av_store(PL_comppad, offset, (SV*)newAV());
366 else if (*name == '%')
367 av_store(PL_comppad, offset, (SV*)newHV());
368 SvPADMY_on(PL_curpad[offset]);
369 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
370 "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
371 (long)offset, name, PTR2UV(PL_curpad[offset])));
381 =for apidoc pad_alloc
383 Allocate a new my or tmp pad entry. For a my, simply push a null SV onto
384 the end of PL_comppad, but for a tmp, scan the pad from PL_padix upwards
385 for a slot which has no name and and no active value.
390 /* XXX DAPM integrate alloc(), add_name() and add_anon(),
391 * or at least rationalise ??? */
395 Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
400 ASSERT_CURPAD_ACTIVE("pad_alloc");
402 if (AvARRAY(PL_comppad) != PL_curpad)
403 Perl_croak(aTHX_ "panic: pad_alloc");
404 if (PL_pad_reset_pending)
406 if (tmptype & SVs_PADMY) {
407 sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE);
408 retval = AvFILLp(PL_comppad);
411 SV **names = AvARRAY(PL_comppad_name);
412 SSize_t names_fill = AvFILLp(PL_comppad_name);
415 * "foreach" index vars temporarily become aliases to non-"my"
416 * values. Thus we must skip, not just pad values that are
417 * marked as current pad values, but also those with names.
419 /* HVDS why copy to sv here? we don't seem to use it */
420 if (++PL_padix <= names_fill &&
421 (sv = names[PL_padix]) && sv != &PL_sv_undef)
423 sv = *av_fetch(PL_comppad, PL_padix, TRUE);
424 if (!(SvFLAGS(sv) & (SVs_PADTMP | SVs_PADMY)) &&
425 !IS_PADGV(sv) && !IS_PADCONST(sv))
430 SvFLAGS(sv) |= tmptype;
431 PL_curpad = AvARRAY(PL_comppad);
433 DEBUG_X(PerlIO_printf(Perl_debug_log,
434 "Pad 0x%"UVxf"[0x%"UVxf"] alloc: %ld for %s\n",
435 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long) retval,
436 PL_op_name[optype]));
437 return (PADOFFSET)retval;
441 =for apidoc pad_add_anon
443 Add an anon code entry to the current compiling pad
449 Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
454 name = NEWSV(1106, 0);
455 sv_upgrade(name, SVt_PVNV);
456 sv_setpvn(name, "&", 1);
459 ix = pad_alloc(op_type, SVs_PADMY);
460 av_store(PL_comppad_name, ix, name);
461 /* XXX DAPM use PL_curpad[] ? */
462 av_store(PL_comppad, ix, sv);
465 /* to avoid ref loops, we never have parent + child referencing each
466 * other simultaneously */
467 if (CvOUTSIDE((CV*)sv)) {
468 assert(!CvWEAKOUTSIDE((CV*)sv));
469 CvWEAKOUTSIDE_on((CV*)sv);
470 SvREFCNT_dec(CvOUTSIDE((CV*)sv));
478 =for apidoc pad_check_dup
480 Check for duplicate declarations: report any of:
481 * a my in the current scope with the same name;
482 * an our (anywhere in the pad) with the same name and the same stash
484 C<is_our> indicates that the name to check is an 'our' declaration
489 /* XXX DAPM integrate this into pad_add_name ??? */
492 Perl_pad_check_dup(pTHX_ char *name, bool is_our, HV *ourstash)
497 ASSERT_CURPAD_ACTIVE("pad_check_dup");
498 if (!ckWARN(WARN_MISC) || AvFILLp(PL_comppad_name) < 0)
499 return; /* nothing to check */
501 svp = AvARRAY(PL_comppad_name);
502 top = AvFILLp(PL_comppad_name);
503 /* check the current scope */
504 /* XXX DAPM - why the (I32) cast - shouldn't we ensure they're the same
506 for (off = top; (I32)off > PL_comppad_name_floor; off--) {
508 && sv != &PL_sv_undef
510 && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
512 || ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash))
513 && strEQ(name, SvPVX(sv)))
515 Perl_warner(aTHX_ packWARN(WARN_MISC),
516 "\"%s\" variable %s masks earlier declaration in same %s",
517 (is_our ? "our" : "my"),
519 (SvIVX(sv) == PAD_MAX ? "scope" : "statement"));
524 /* check the rest of the pad */
528 && sv != &PL_sv_undef
530 && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
531 && ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash)
532 && strEQ(name, SvPVX(sv)))
534 Perl_warner(aTHX_ packWARN(WARN_MISC),
535 "\"our\" variable %s redeclared", name);
536 Perl_warner(aTHX_ packWARN(WARN_MISC),
537 "\t(Did you mean \"local\" instead of \"our\"?)\n");
540 } while ( off-- > 0 );
546 =for apidoc pad_findmy
548 Given a lexical name, try to find its offset, first in the current pad,
549 or failing that, in the pads of any lexically enclosing subs (including
550 the complications introduced by eval). If the name is found in an outer pad,
551 then a fake entry is added to the current pad.
552 Returns the offset in the current pad, or NOT_IN_PAD on failure.
558 Perl_pad_findmy(pTHX_ char *name)
566 offset = pad_findlex(name, PL_compcv, PL_cop_seqmax, 1,
567 Null(SV**), &out_sv, &out_flags);
568 if (offset != NOT_IN_PAD)
571 /* look for an our that's being introduced; this allows
572 * our $foo = 0 unless defined $foo;
573 * to not give a warning. (Yes, this is a hack) */
575 nameav = (AV*)AvARRAY(CvPADLIST(PL_compcv))[0];
576 name_svp = AvARRAY(nameav);
577 for (offset = AvFILLp(nameav); offset > 0; offset--) {
578 SV *namesv = name_svp[offset];
579 if (namesv && namesv != &PL_sv_undef
581 && (SvFLAGS(namesv) & SVpad_OUR)
582 && strEQ(SvPVX(namesv), name)
583 && U_32(SvNVX(namesv)) == PAD_MAX /* min */
591 * Returns the offset of a lexical $_, if there is one, at run time.
592 * Used by the UNDERBAR XS macro.
596 Perl_find_rundefsvoffset(pTHX)
600 return pad_findlex("$_", find_runcv(NULL), PL_curcop->cop_seq, 1,
601 Null(SV**), &out_sv, &out_flags);
605 =for apidoc pad_findlex
607 Find a named lexical anywhere in a chain of nested pads. Add fake entries
608 in the inner pads if it's found in an outer one.
610 Returns the offset in the bottom pad of the lex or the fake lex.
611 cv is the CV in which to start the search, and seq is the current cop_seq
612 to match against. If warn is true, print appropriate warnings. The out_*
613 vars return values, and so are pointers to where the returned values
614 should be stored. out_capture, if non-null, requests that the innermost
615 instance of the lexical is captured; out_name_sv is set to the innermost
616 matched namesv or fake namesv; out_flags returns the flags normally
617 associated with the IVX field of a fake namesv.
619 Note that pad_findlex() is recursive; it recurses up the chain of CVs,
620 then comes back down, adding fake entries as it goes. It has to be this way
621 because fake namesvs in anon protoypes have to store in NVX the index into
627 /* Flags set in the SvIVX field of FAKE namesvs */
629 #define PAD_FAKELEX_ANON 1 /* the lex is declared in an ANON, or ... */
630 #define PAD_FAKELEX_MULTI 2 /* the lex can be instantiated multiple times */
632 /* the CV has finished being compiled. This is not a sufficient test for
633 * all CVs (eg XSUBs), but suffices for the CVs found in a lexical chain */
634 #define CvCOMPILED(cv) CvROOT(cv)
636 /* the CV does late binding of its lexicals */
637 #define CvLATE(cv) (CvANON(cv) || SvTYPE(cv) == SVt_PVFM)
641 S_pad_findlex(pTHX_ char *name, CV* cv, U32 seq, int warn,
642 SV** out_capture, SV** out_name_sv, int *out_flags)
644 I32 offset, new_offset;
647 AV *padlist = CvPADLIST(cv);
651 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
652 "Pad findlex cv=0x%"UVxf" searching \"%s\" seq=%d%s\n",
653 PTR2UV(cv), name, (int)seq, out_capture ? " capturing" : "" ));
655 /* first, search this pad */
657 if (padlist) { /* not an undef CV */
659 AV *nameav = (AV*)AvARRAY(padlist)[0];
660 SV **name_svp = AvARRAY(nameav);
662 for (offset = AvFILLp(nameav); offset > 0; offset--) {
663 SV *namesv = name_svp[offset];
664 if (namesv && namesv != &PL_sv_undef
665 && strEQ(SvPVX(namesv), name))
668 fake_offset = offset; /* in case we don't find a real one */
669 else if ( seq > U_32(SvNVX(namesv)) /* min */
670 && seq <= (U32)SvIVX(namesv)) /* max */
675 if (offset > 0 || fake_offset > 0 ) { /* a match! */
676 if (offset > 0) { /* not fake */
678 *out_name_sv = name_svp[offset]; /* return the namesv */
680 /* set PAD_FAKELEX_MULTI if this lex can have multiple
681 * instances. For now, we just test !CvUNIQUE(cv), but
682 * ideally, we should detect my's declared within loops
683 * etc - this would allow a wider range of 'not stayed
684 * shared' warnings. We also treated alreadly-compiled
685 * lexes as not multi as viewed from evals. */
687 *out_flags = CvANON(cv) ?
689 (!CvUNIQUE(cv) && ! CvCOMPILED(cv))
690 ? PAD_FAKELEX_MULTI : 0;
692 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
693 "Pad findlex cv=0x%"UVxf" matched: offset=%ld (%ld,%ld)\n",
694 PTR2UV(cv), (long)offset, (long)U_32(SvNVX(*out_name_sv)),
695 (long)SvIVX(*out_name_sv)));
697 else { /* fake match */
698 offset = fake_offset;
699 *out_name_sv = name_svp[offset]; /* return the namesv */
700 *out_flags = SvIVX(*out_name_sv);
701 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
702 "Pad findlex cv=0x%"UVxf" matched: offset=%ld flags=0x%lx index=%lu\n",
703 PTR2UV(cv), (long)offset, (unsigned long)*out_flags,
704 (unsigned long)SvNVX(*out_name_sv)
708 /* return the lex? */
713 if ((SvFLAGS(*out_name_sv) & SVpad_OUR)) {
714 *out_capture = Nullsv;
718 /* trying to capture from an anon prototype? */
720 ? CvANON(cv) && CvCLONE(cv) && !CvCLONED(cv)
721 : *out_flags & PAD_FAKELEX_ANON)
723 if (warn && ckWARN(WARN_CLOSURE))
724 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
725 "Variable \"%s\" is not available", name);
726 *out_capture = Nullsv;
732 if (!CvCOMPILED(cv) && (*out_flags & PAD_FAKELEX_MULTI)
733 && warn && ckWARN(WARN_CLOSURE)) {
735 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
736 "Variable \"%s\" will not stay shared", name);
739 if (fake_offset && CvANON(cv)
740 && CvCLONE(cv) &&!CvCLONED(cv))
743 /* not yet caught - look further up */
744 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
745 "Pad findlex cv=0x%"UVxf" chasing lex in outer pad\n",
748 pad_findlex(name, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv),
749 newwarn, out_capture, out_name_sv, out_flags);
754 *out_capture = AvARRAY((AV*)AvARRAY(padlist)[
755 CvDEPTH(cv) ? CvDEPTH(cv) : 1])[offset];
756 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
757 "Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n",
758 PTR2UV(cv), PTR2UV(*out_capture)));
760 if (SvPADSTALE(*out_capture)) {
761 if (ckWARN(WARN_CLOSURE))
762 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
763 "Variable \"%s\" is not available", name);
764 *out_capture = Nullsv;
769 *out_capture = sv_2mortal((SV*)newAV());
770 else if (*name == '%')
771 *out_capture = sv_2mortal((SV*)newHV());
773 *out_capture = sv_newmortal();
781 /* it's not in this pad - try above */
786 /* out_capture non-null means caller wants us to capture lex; in
787 * addition we capture ourselves unless it's an ANON/format */
788 new_capturep = out_capture ? out_capture :
789 CvLATE(cv) ? Null(SV**) : &new_capture;
791 offset = pad_findlex(name, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1,
792 new_capturep, out_name_sv, out_flags);
793 if (offset == NOT_IN_PAD)
796 /* found in an outer CV. Add appropriate fake entry to this pad */
798 /* don't add new fake entries (via eval) to CVs that we have already
799 * finished compiling, or to undef CVs */
800 if (CvCOMPILED(cv) || !padlist)
801 return 0; /* this dummy (and invalid) value isnt used by the caller */
805 AV *ocomppad_name = PL_comppad_name;
806 PAD *ocomppad = PL_comppad;
807 PL_comppad_name = (AV*)AvARRAY(padlist)[0];
808 PL_comppad = (AV*)AvARRAY(padlist)[1];
809 PL_curpad = AvARRAY(PL_comppad);
811 new_offset = pad_add_name(
813 (SvFLAGS(*out_name_sv) & SVpad_TYPED)
814 ? SvSTASH(*out_name_sv) : Nullhv,
815 (SvFLAGS(*out_name_sv) & SVpad_OUR)
816 ? GvSTASH(*out_name_sv) : Nullhv,
820 new_namesv = AvARRAY(PL_comppad_name)[new_offset];
821 SvIVX(new_namesv) = *out_flags;
823 SvNVX(new_namesv) = (NV)0;
824 if (SvFLAGS(new_namesv) & SVpad_OUR) {
827 else if (CvLATE(cv)) {
828 /* delayed creation - just note the offset within parent pad */
829 SvNVX(new_namesv) = (NV)offset;
833 /* immediate creation - capture outer value right now */
834 av_store(PL_comppad, new_offset, SvREFCNT_inc(*new_capturep));
835 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
836 "Pad findlex cv=0x%"UVxf" saved captured sv 0x%"UVxf" at offset %ld\n",
837 PTR2UV(cv), PTR2UV(*new_capturep), (long)new_offset));
839 *out_name_sv = new_namesv;
840 *out_flags = SvIVX(new_namesv);
842 PL_comppad_name = ocomppad_name;
843 PL_comppad = ocomppad;
844 PL_curpad = ocomppad ? AvARRAY(ocomppad) : Null(SV **);
853 Get the value at offset po in the current pad.
854 Use macro PAD_SV instead of calling this function directly.
861 Perl_pad_sv(pTHX_ PADOFFSET po)
863 ASSERT_CURPAD_ACTIVE("pad_sv");
866 Perl_croak(aTHX_ "panic: pad_sv po");
867 DEBUG_X(PerlIO_printf(Perl_debug_log,
868 "Pad 0x%"UVxf"[0x%"UVxf"] sv: %ld sv=0x%"UVxf"\n",
869 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(PL_curpad[po]))
871 return PL_curpad[po];
876 =for apidoc pad_setsv
878 Set the entry at offset po in the current pad to sv.
879 Use the macro PAD_SETSV() rather than calling this function directly.
886 Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
888 ASSERT_CURPAD_ACTIVE("pad_setsv");
890 DEBUG_X(PerlIO_printf(Perl_debug_log,
891 "Pad 0x%"UVxf"[0x%"UVxf"] setsv: %ld sv=0x%"UVxf"\n",
892 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(sv))
901 =for apidoc pad_block_start
903 Update the pad compilation state variables on entry to a new block
909 * - integrate this in general state-saving routine ???
910 * - combine with the state-saving going on in pad_new ???
911 * - introduce a new SAVE type that does all this in one go ?
915 Perl_pad_block_start(pTHX_ int full)
917 ASSERT_CURPAD_ACTIVE("pad_block_start");
918 SAVEI32(PL_comppad_name_floor);
919 PL_comppad_name_floor = AvFILLp(PL_comppad_name);
921 PL_comppad_name_fill = PL_comppad_name_floor;
922 if (PL_comppad_name_floor < 0)
923 PL_comppad_name_floor = 0;
924 SAVEI32(PL_min_intro_pending);
925 SAVEI32(PL_max_intro_pending);
926 PL_min_intro_pending = 0;
927 SAVEI32(PL_comppad_name_fill);
928 SAVEI32(PL_padix_floor);
929 PL_padix_floor = PL_padix;
930 PL_pad_reset_pending = FALSE;
937 "Introduce" my variables to visible status.
949 ASSERT_CURPAD_ACTIVE("intro_my");
950 if (! PL_min_intro_pending)
951 return PL_cop_seqmax;
953 svp = AvARRAY(PL_comppad_name);
954 for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
955 if ((sv = svp[i]) && sv != &PL_sv_undef
956 && !SvFAKE(sv) && !SvIVX(sv))
958 SvIVX(sv) = PAD_MAX; /* Don't know scope end yet. */
959 SvNVX(sv) = (NV)PL_cop_seqmax;
960 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
961 "Pad intromy: %ld \"%s\", (%ld,%ld)\n",
963 (long)U_32(SvNVX(sv)), (long)SvIVX(sv))
967 PL_min_intro_pending = 0;
968 PL_comppad_name_fill = PL_max_intro_pending; /* Needn't search higher */
969 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
970 "Pad intromy: seq -> %ld\n", (long)(PL_cop_seqmax+1)));
972 return PL_cop_seqmax++;
976 =for apidoc pad_leavemy
978 Cleanup at end of scope during compilation: set the max seq number for
979 lexicals in this scope and warn of any lexicals that never got introduced.
985 Perl_pad_leavemy(pTHX)
988 SV **svp = AvARRAY(PL_comppad_name);
991 PL_pad_reset_pending = FALSE;
993 ASSERT_CURPAD_ACTIVE("pad_leavemy");
994 if (PL_min_intro_pending && PL_comppad_name_fill < PL_min_intro_pending) {
995 for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
996 if ((sv = svp[off]) && sv != &PL_sv_undef
997 && !SvFAKE(sv) && ckWARN_d(WARN_INTERNAL))
998 Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
999 "%"SVf" never introduced", sv);
1002 /* "Deintroduce" my variables that are leaving with this scope. */
1003 for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_fill; off--) {
1004 if ((sv = svp[off]) && sv != &PL_sv_undef
1005 && !SvFAKE(sv) && SvIVX(sv) == PAD_MAX)
1007 SvIVX(sv) = PL_cop_seqmax;
1008 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1009 "Pad leavemy: %ld \"%s\", (%ld,%ld)\n",
1010 (long)off, SvPVX(sv),
1011 (long)U_32(SvNVX(sv)), (long)SvIVX(sv))
1016 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1017 "Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax));
1022 =for apidoc pad_swipe
1024 Abandon the tmp in the current pad at offset po and replace with a
1031 Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
1033 ASSERT_CURPAD_LEGAL("pad_swipe");
1036 if (AvARRAY(PL_comppad) != PL_curpad)
1037 Perl_croak(aTHX_ "panic: pad_swipe curpad");
1039 Perl_croak(aTHX_ "panic: pad_swipe po");
1041 DEBUG_X(PerlIO_printf(Perl_debug_log,
1042 "Pad 0x%"UVxf"[0x%"UVxf"] swipe: %ld\n",
1043 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po));
1046 SvPADTMP_off(PL_curpad[po]);
1048 SvREFCNT_dec(PL_curpad[po]);
1050 PL_curpad[po] = NEWSV(1107,0);
1051 SvPADTMP_on(PL_curpad[po]);
1052 if ((I32)po < PL_padix)
1058 =for apidoc pad_reset
1060 Mark all the current temporaries for reuse
1065 /* XXX pad_reset() is currently disabled because it results in serious bugs.
1066 * It causes pad temp TARGs to be shared between OPs. Since TARGs are pushed
1067 * on the stack by OPs that use them, there are several ways to get an alias
1068 * to a shared TARG. Such an alias will change randomly and unpredictably.
1069 * We avoid doing this until we can think of a Better Way.
1072 Perl_pad_reset(pTHX)
1074 #ifdef USE_BROKEN_PAD_RESET
1077 if (AvARRAY(PL_comppad) != PL_curpad)
1078 Perl_croak(aTHX_ "panic: pad_reset curpad");
1080 DEBUG_X(PerlIO_printf(Perl_debug_log,
1081 "Pad 0x%"UVxf"[0x%"UVxf"] reset: padix %ld -> %ld",
1082 PTR2UV(PL_comppad), PTR2UV(PL_curpad),
1083 (long)PL_padix, (long)PL_padix_floor
1087 if (!PL_tainting) { /* Can't mix tainted and non-tainted temporaries. */
1088 for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
1089 if (PL_curpad[po] && !SvIMMORTAL(PL_curpad[po]))
1090 SvPADTMP_off(PL_curpad[po]);
1092 PL_padix = PL_padix_floor;
1095 PL_pad_reset_pending = FALSE;
1100 =for apidoc pad_tidy
1102 Tidy up a pad after we've finished compiling it:
1103 * remove most stuff from the pads of anonsub prototypes;
1105 * mark tmps as such.
1110 /* XXX DAPM surely most of this stuff should be done properly
1111 * at the right time beforehand, rather than going around afterwards
1112 * cleaning up our mistakes ???
1116 Perl_pad_tidy(pTHX_ padtidy_type type)
1121 ASSERT_CURPAD_ACTIVE("pad_tidy");
1123 /* If this CV has had any 'eval-capable' ops planted in it
1124 * (ie it contains eval '...', //ee, /$var/ or /(?{..})/), Then any
1125 * anon prototypes in the chain of CVs should be marked as cloneable,
1126 * so that for example the eval's CV in C<< sub { eval '$x' } >> gets
1127 * the right CvOUTSIDE.
1128 * If running with -d, *any* sub may potentially have an eval
1129 * excuted within it.
1132 if (PL_cv_has_eval || PL_perldb) {
1133 for (cv = PL_compcv ;cv; cv = CvOUTSIDE(cv)) {
1134 if (cv != PL_compcv && CvCOMPILED(cv))
1135 break; /* no need to mark already-compiled code */
1137 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1138 "Pad clone on cv=0x%"UVxf"\n", PTR2UV(cv)));
1144 /* extend curpad to match namepad */
1145 if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
1146 av_store(PL_comppad_name, AvFILLp(PL_comppad), Nullsv);
1148 if (type == padtidy_SUBCLONE) {
1149 SV **namep = AvARRAY(PL_comppad_name);
1151 for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1154 if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
1157 * The only things that a clonable function needs in its
1158 * pad are anonymous subs.
1159 * The rest are created anew during cloning.
1161 if (!((namesv = namep[ix]) != Nullsv &&
1162 namesv != &PL_sv_undef &&
1163 *SvPVX(namesv) == '&'))
1165 SvREFCNT_dec(PL_curpad[ix]);
1166 PL_curpad[ix] = Nullsv;
1170 else if (type == padtidy_SUB) {
1171 /* XXX DAPM this same bit of code keeps appearing !!! Rationalise? */
1172 AV *av = newAV(); /* Will be @_ */
1174 av_store(PL_comppad, 0, (SV*)av);
1175 AvFLAGS(av) = AVf_REIFY;
1178 /* XXX DAPM rationalise these two similar branches */
1180 if (type == padtidy_SUB) {
1181 for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1182 if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
1184 if (!SvPADMY(PL_curpad[ix]))
1185 SvPADTMP_on(PL_curpad[ix]);
1188 else if (type == padtidy_FORMAT) {
1189 for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1190 if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix]))
1191 SvPADTMP_on(PL_curpad[ix]);
1194 PL_curpad = AvARRAY(PL_comppad);
1199 =for apidoc pad_free
1201 Free the SV at offet po in the current pad.
1206 /* XXX DAPM integrate with pad_swipe ???? */
1208 Perl_pad_free(pTHX_ PADOFFSET po)
1210 ASSERT_CURPAD_LEGAL("pad_free");
1213 if (AvARRAY(PL_comppad) != PL_curpad)
1214 Perl_croak(aTHX_ "panic: pad_free curpad");
1216 Perl_croak(aTHX_ "panic: pad_free po");
1218 DEBUG_X(PerlIO_printf(Perl_debug_log,
1219 "Pad 0x%"UVxf"[0x%"UVxf"] free: %ld\n",
1220 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po)
1223 if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
1224 SvPADTMP_off(PL_curpad[po]);
1226 /* SV could be a shared hash key (eg bugid #19022) */
1228 #ifdef PERL_COPY_ON_WRITE
1229 !SvIsCOW(PL_curpad[po])
1231 !SvFAKE(PL_curpad[po])
1234 SvREADONLY_off(PL_curpad[po]); /* could be a freed constant */
1237 if ((I32)po < PL_padix)
1244 =for apidoc do_dump_pad
1246 Dump the contents of a padlist
1252 Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
1264 pad_name = (AV*)*av_fetch((AV*)padlist, 0, FALSE);
1265 pad = (AV*)*av_fetch((AV*)padlist, 1, FALSE);
1266 pname = AvARRAY(pad_name);
1267 ppad = AvARRAY(pad);
1268 Perl_dump_indent(aTHX_ level, file,
1269 "PADNAME = 0x%"UVxf"(0x%"UVxf") PAD = 0x%"UVxf"(0x%"UVxf")\n",
1270 PTR2UV(pad_name), PTR2UV(pname), PTR2UV(pad), PTR2UV(ppad)
1273 for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
1275 if (namesv && namesv == &PL_sv_undef) {
1280 Perl_dump_indent(aTHX_ level+1, file,
1281 "%2d. 0x%"UVxf"<%lu> FAKE \"%s\" flags=0x%lx index=%lu\n",
1284 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
1286 (unsigned long)SvIVX(namesv),
1287 (unsigned long)SvNVX(namesv)
1291 Perl_dump_indent(aTHX_ level+1, file,
1292 "%2d. 0x%"UVxf"<%lu> (%ld,%ld) \"%s\"\n",
1295 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
1296 (long)U_32(SvNVX(namesv)),
1297 (long)SvIVX(namesv),
1302 Perl_dump_indent(aTHX_ level+1, file,
1303 "%2d. 0x%"UVxf"<%lu>\n",
1306 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0)
1317 dump the contents of a CV
1324 S_cv_dump(pTHX_ CV *cv, char *title)
1326 CV *outside = CvOUTSIDE(cv);
1327 AV* padlist = CvPADLIST(cv);
1329 PerlIO_printf(Perl_debug_log,
1330 " %s: CV=0x%"UVxf" (%s), OUTSIDE=0x%"UVxf" (%s)\n",
1333 (CvANON(cv) ? "ANON"
1334 : (SvTYPE(cv) == SVt_PVFM) ? "FORMAT"
1335 : (cv == PL_main_cv) ? "MAIN"
1336 : CvUNIQUE(cv) ? "UNIQUE"
1337 : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
1340 : CvANON(outside) ? "ANON"
1341 : (outside == PL_main_cv) ? "MAIN"
1342 : CvUNIQUE(outside) ? "UNIQUE"
1343 : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
1345 PerlIO_printf(Perl_debug_log,
1346 " PADLIST = 0x%"UVxf"\n", PTR2UV(padlist));
1347 do_dump_pad(1, Perl_debug_log, padlist, 1);
1349 #endif /* DEBUGGING */
1356 =for apidoc cv_clone
1358 Clone a CV: make a new CV which points to the same code etc, but which
1359 has a newly-created pad built by copying the prototype pad and capturing
1366 Perl_cv_clone(pTHX_ CV *proto)
1369 AV* protopadlist = CvPADLIST(proto);
1370 AV* protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
1371 AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
1372 SV** pname = AvARRAY(protopad_name);
1373 SV** ppad = AvARRAY(protopad);
1374 I32 fname = AvFILLp(protopad_name);
1375 I32 fpad = AvFILLp(protopad);
1382 assert(!CvUNIQUE(proto));
1384 /* Since cloneable anon subs can be nested, CvOUTSIDE may point
1385 * to a prototype; we instead want the cloned parent who called us.
1386 * Note that in general for formats, CvOUTSIDE != find_runcv */
1388 outside = CvOUTSIDE(proto);
1389 if (outside && CvCLONE(outside) && ! CvCLONED(outside))
1390 outside = find_runcv(NULL);
1391 depth = CvDEPTH(outside);
1392 assert(depth || SvTYPE(proto) == SVt_PVFM);
1395 assert(CvPADLIST(outside));
1398 SAVESPTR(PL_compcv);
1400 cv = PL_compcv = (CV*)NEWSV(1104, 0);
1401 sv_upgrade((SV *)cv, SvTYPE(proto));
1402 CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE);
1406 CvFILE(cv) = CvXSUB(proto) ? CvFILE(proto)
1407 : savepv(CvFILE(proto));
1409 CvFILE(cv) = CvFILE(proto);
1411 CvGV(cv) = CvGV(proto);
1412 CvSTASH(cv) = CvSTASH(proto);
1414 CvROOT(cv) = OpREFCNT_inc(CvROOT(proto));
1416 CvSTART(cv) = CvSTART(proto);
1417 CvOUTSIDE(cv) = (CV*)SvREFCNT_inc(outside);
1418 CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
1421 sv_setpvn((SV*)cv, SvPVX(proto), SvCUR(proto));
1423 CvPADLIST(cv) = comppadlist = pad_new(padnew_CLONE|padnew_SAVE);
1425 av_fill(PL_comppad, fpad);
1426 for (ix = fname; ix >= 0; ix--)
1427 av_store(PL_comppad_name, ix, SvREFCNT_inc(pname[ix]));
1429 PL_curpad = AvARRAY(PL_comppad);
1431 outpad = AvARRAY(AvARRAY(CvPADLIST(outside))[depth]);
1433 for (ix = fpad; ix > 0; ix--) {
1434 SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
1436 if (namesv && namesv != &PL_sv_undef) { /* lexical */
1437 if (SvFAKE(namesv)) { /* lexical from outside? */
1438 sv = outpad[(I32)SvNVX(namesv)];
1440 /* formats may have an inactive parent */
1441 if (SvTYPE(proto) == SVt_PVFM && SvPADSTALE(sv)) {
1442 if (ckWARN(WARN_CLOSURE))
1443 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
1444 "Variable \"%s\" is not available", SvPVX(namesv));
1448 assert(!SvPADSTALE(sv));
1449 sv = SvREFCNT_inc(sv);
1453 char *name = SvPVX(namesv);
1455 sv = SvREFCNT_inc(ppad[ix]);
1456 else if (*name == '@')
1458 else if (*name == '%')
1465 else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) {
1466 sv = SvREFCNT_inc(ppad[ix]);
1476 PerlIO_printf(Perl_debug_log, "\nPad CV clone\n");
1477 cv_dump(outside, "Outside");
1478 cv_dump(proto, "Proto");
1485 /* Constant sub () { $x } closing over $x - see lib/constant.pm:
1486 * The prototype was marked as a candiate for const-ization,
1487 * so try to grab the current const value, and if successful,
1488 * turn into a const sub:
1490 SV* const_sv = op_const_sv(CvSTART(cv), cv);
1493 cv = newCONSTSUB(CvSTASH(proto), 0, const_sv);
1505 =for apidoc pad_fixup_inner_anons
1507 For any anon CVs in the pad, change CvOUTSIDE of that CV from
1508 old_cv to new_cv if necessary. Needed when a newly-compiled CV has to be
1509 moved to a pre-existing CV struct.
1515 Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
1518 AV *comppad_name = (AV*)AvARRAY(padlist)[0];
1519 AV *comppad = (AV*)AvARRAY(padlist)[1];
1520 SV **namepad = AvARRAY(comppad_name);
1521 SV **curpad = AvARRAY(comppad);
1522 for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
1523 SV *namesv = namepad[ix];
1524 if (namesv && namesv != &PL_sv_undef
1525 && *SvPVX(namesv) == '&')
1527 CV *innercv = (CV*)curpad[ix];
1528 assert(CvWEAKOUTSIDE(innercv));
1529 assert(CvOUTSIDE(innercv) == old_cv);
1530 CvOUTSIDE(innercv) = new_cv;
1537 =for apidoc pad_push
1539 Push a new pad frame onto the padlist, unless there's already a pad at
1540 this depth, in which case don't bother creating a new one.
1541 If has_args is true, give the new pad an @_ in slot zero.
1546 /* XXX pad_push is now always called with has_args == 1. Get rid of
1547 * this arg at some point */
1550 Perl_pad_push(pTHX_ PADLIST *padlist, int depth, int has_args)
1552 if (depth <= AvFILLp(padlist))
1556 SV** svp = AvARRAY(padlist);
1557 AV *newpad = newAV();
1558 SV **oldpad = AvARRAY(svp[depth-1]);
1559 I32 ix = AvFILLp((AV*)svp[1]);
1560 I32 names_fill = AvFILLp((AV*)svp[0]);
1561 SV** names = AvARRAY(svp[0]);
1563 for ( ;ix > 0; ix--) {
1564 if (names_fill >= ix && names[ix] != &PL_sv_undef) {
1565 char *name = SvPVX(names[ix]);
1566 if ((SvFLAGS(names[ix]) & SVf_FAKE) || *name == '&') {
1567 /* outer lexical or anon code */
1568 av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]));
1570 else { /* our own lexical */
1572 av_store(newpad, ix, sv = (SV*)newAV());
1573 else if (*name == '%')
1574 av_store(newpad, ix, sv = (SV*)newHV());
1576 av_store(newpad, ix, sv = NEWSV(0, 0));
1580 else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
1581 av_store(newpad, ix, sv = SvREFCNT_inc(oldpad[ix]));
1584 /* save temporaries on recursion? */
1585 av_store(newpad, ix, sv = NEWSV(0, 0));
1592 av_store(newpad, 0, (SV*)av);
1593 AvFLAGS(av) = AVf_REIFY;
1595 av_store(padlist, depth, (SV*)newpad);
1596 AvFILLp(padlist) = depth;