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 =for apidoc m|AV *|CvPADLIST|CV *cv
26 CV's can have CvPADLIST(cv) set to point to an AV.
28 For these purposes "forms" are a kind-of CV, eval""s are too (except they're
29 not callable at will and are always thrown away after the eval"" is done
30 executing). Require'd files are simply evals without any outer lexical
33 XSUBs don't have CvPADLIST set - dXSTARG fetches values from PL_curpad,
34 but that is really the callers pad (a slot of which is allocated by
37 The CvPADLIST AV has does not have AvREAL set, so REFCNT of component items
38 is managed "manual" (mostly in pad.c) rather than normal av.c rules.
39 The items in the AV are not SVs as for a normal AV, but other AVs:
41 0'th Entry of the CvPADLIST is an AV which represents the "names" or rather
42 the "static type information" for lexicals.
44 The CvDEPTH'th entry of CvPADLIST AV is an AV which is the stack frame at that
45 depth of recursion into the CV.
46 The 0'th slot of a frame AV is an AV which is @_.
47 other entries are storage for variables and op targets.
50 C<PL_comppad_name> is set to the names AV.
51 C<PL_comppad> is set to the frame AV for the frame CvDEPTH == 1.
52 C<PL_curpad> is set to the body of the frame AV (i.e. AvARRAY(PL_comppad)).
54 During execution, C<PL_comppad> and C<PL_curpad> refer to the live
55 frame of the currently executing sub.
57 Iterating over the names AV iterates over all possible pad
58 items. Pad slots that are SVs_PADTMP (targets/GVs/constants) end up having
59 &PL_sv_undef "names" (see pad_alloc()).
61 Only my/our variable (SVs_PADMY/SVs_PADOUR) slots get valid names.
62 The rest are op targets/GVs/constants which are statically allocated
63 or resolved at compile time. These don't have names by which they
64 can be looked up from Perl code at run time through eval"" like
65 my/our variables can be. Since they can't be looked up by "name"
66 but only by their index allocated at compile time (which is usually
67 in PL_op->op_targ), wasting a name SV for them doesn't make sense.
69 The SVs in the names AV have their PV being the name of the variable.
70 NV+1..IV inclusive is a range of cop_seq numbers for which the name is
71 valid. For typed lexicals name SV is SVt_PVMG and SvSTASH points at the
72 type. For C<our> lexicals, the type is SVt_PVGV, and GvSTASH points at the
73 stash of the associated global (so that duplicate C<our> delarations in the
74 same package can be detected). SvCUR is sometimes hijacked to
75 store the generation number during compilation.
77 If SvFAKE is set on the name SV, then that slot in the frame AV is
78 a REFCNT'ed reference to a lexical from "outside". In this case,
79 the name SV does not use NVX and IVX to store a cop_seq range, since it is
80 in scope throughout. Instead IVX stores some flags containing info about
81 the real lexical (is it declared in an anon, and is it capable of being
82 instantiated multiple times?), and for fake ANONs, NVX contains the index
83 within the parent's pad where the lexical's value is stored, to make
86 If the 'name' is '&' the corresponding entry in frame AV
87 is a CV representing a possible closure.
88 (SvFAKE and name of '&' is not a meaningful combination currently but could
89 become so if C<my sub foo {}> is implemented.)
91 Note that formats are treated as anon subs, and are cloned each time
92 write is called (if necessary).
94 The flag SVf_PADSTALE is cleared on lexicals each time the my() is executed,
95 and set on scope exit. This allows the 'Variable $x is not available' warning
96 to be generated in evals, such as
98 { my $x = 1; sub f { eval '$x'} } f();
105 #define PERL_IN_PAD_C
109 #define PAD_MAX 999999999
116 Create a new compiling padlist, saving and updating the various global
117 vars at the same time as creating the pad itself. The following flags
118 can be OR'ed together:
120 padnew_CLONE this pad is for a cloned CV
121 padnew_SAVE save old globals
122 padnew_SAVESUB also save extra stuff for start of sub
128 Perl_pad_new(pTHX_ int flags)
130 AV *padlist, *padname, *pad, *a0;
132 ASSERT_CURPAD_LEGAL("pad_new");
134 /* XXX DAPM really need a new SAVEt_PAD which restores all or most
135 * vars (based on flags) rather than storing vals + addresses for
136 * each individually. Also see pad_block_start.
137 * XXX DAPM Try to see whether all these conditionals are required
140 /* save existing state, ... */
142 if (flags & padnew_SAVE) {
144 SAVESPTR(PL_comppad_name);
145 if (! (flags & padnew_CLONE)) {
147 SAVEI32(PL_comppad_name_fill);
148 SAVEI32(PL_min_intro_pending);
149 SAVEI32(PL_max_intro_pending);
150 SAVEI32(PL_cv_has_eval);
151 if (flags & padnew_SAVESUB) {
152 SAVEI32(PL_pad_reset_pending);
156 /* XXX DAPM interestingly, PL_comppad_name_floor never seems to be
157 * saved - check at some pt that this is okay */
159 /* ... create new pad ... */
165 if (flags & padnew_CLONE) {
166 /* XXX DAPM I dont know why cv_clone needs it
167 * doing differently yet - perhaps this separate branch can be
168 * dispensed with eventually ???
171 a0 = newAV(); /* will be @_ */
173 av_store(pad, 0, (SV*)a0);
174 AvFLAGS(a0) = AVf_REIFY;
177 av_store(pad, 0, Nullsv);
181 av_store(padlist, 0, (SV*)padname);
182 av_store(padlist, 1, (SV*)pad);
184 /* ... then update state variables */
186 PL_comppad_name = (AV*)(*av_fetch(padlist, 0, FALSE));
187 PL_comppad = (AV*)(*av_fetch(padlist, 1, FALSE));
188 PL_curpad = AvARRAY(PL_comppad);
190 if (! (flags & padnew_CLONE)) {
191 PL_comppad_name_fill = 0;
192 PL_min_intro_pending = 0;
197 DEBUG_X(PerlIO_printf(Perl_debug_log,
198 "Pad 0x%"UVxf"[0x%"UVxf"] new: compcv=0x%"UVxf
199 " name=0x%"UVxf" flags=0x%"UVxf"\n",
200 PTR2UV(PL_comppad), PTR2UV(PL_curpad), PTR2UV(PL_compcv),
201 PTR2UV(padname), (UV)flags
205 return (PADLIST*)padlist;
209 =for apidoc pad_undef
211 Free the padlist associated with a CV.
212 If parts of it happen to be current, we null the relevant
213 PL_*pad* global vars so that we don't have any dangling references left.
214 We also repoint the CvOUTSIDE of any about-to-be-orphaned
215 inner subs to the outer of this cv.
217 (This function should really be called pad_free, but the name was already
224 Perl_pad_undef(pTHX_ CV* cv)
227 PADLIST *padlist = CvPADLIST(cv);
231 if (!SvREFCNT(CvPADLIST(cv))) /* may be during global destruction */
234 DEBUG_X(PerlIO_printf(Perl_debug_log,
235 "Pad undef: cv=0x%"UVxf" padlist=0x%"UVxf"\n",
236 PTR2UV(cv), PTR2UV(padlist))
239 /* detach any '&' anon children in the pad; if afterwards they
240 * are still live, fix up their CvOUTSIDEs to point to our outside,
242 /* XXX DAPM for efficiency, we should only do this if we know we have
243 * children, or integrate this loop with general cleanup */
245 if (!PL_dirty) { /* don't bother during global destruction */
246 CV *outercv = CvOUTSIDE(cv);
247 U32 seq = CvOUTSIDE_SEQ(cv);
248 AV *comppad_name = (AV*)AvARRAY(padlist)[0];
249 SV **namepad = AvARRAY(comppad_name);
250 AV *comppad = (AV*)AvARRAY(padlist)[1];
251 SV **curpad = AvARRAY(comppad);
252 for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
253 SV *namesv = namepad[ix];
254 if (namesv && namesv != &PL_sv_undef
255 && *SvPVX(namesv) == '&')
257 CV *innercv = (CV*)curpad[ix];
258 namepad[ix] = Nullsv;
259 SvREFCNT_dec(namesv);
261 if (SvREFCNT(comppad) < 2) { /* allow for /(?{ sub{} })/ */
263 SvREFCNT_dec(innercv);
265 if (SvREFCNT(innercv) /* in use, not just a prototype */
266 && CvOUTSIDE(innercv) == cv)
268 assert(CvWEAKOUTSIDE(innercv));
269 /* don't relink to grandfather if he's being freed */
270 if (outercv && SvREFCNT(outercv)) {
271 CvWEAKOUTSIDE_off(innercv);
272 CvOUTSIDE(innercv) = outercv;
273 CvOUTSIDE_SEQ(innercv) = seq;
274 SvREFCNT_inc(outercv);
277 CvOUTSIDE(innercv) = Nullcv;
286 ix = AvFILLp(padlist);
288 SV* sv = AvARRAY(padlist)[ix--];
291 if (sv == (SV*)PL_comppad_name)
292 PL_comppad_name = Nullav;
293 else if (sv == (SV*)PL_comppad) {
294 PL_comppad = Null(PAD*);
295 PL_curpad = Null(SV**);
299 SvREFCNT_dec((SV*)CvPADLIST(cv));
300 CvPADLIST(cv) = Null(PADLIST*);
307 =for apidoc pad_add_name
309 Create a new name and associated PADMY SV in the current pad; return the
311 If C<typestash> is valid, the name is for a typed lexical; set the
312 name's stash to that value.
313 If C<ourstash> is valid, it's an our lexical, set the name's
314 GvSTASH to that value
316 If fake, it means we're cloning an existing entry
322 Perl_pad_add_name(pTHX_ char *name, HV* typestash, HV* ourstash, bool fake)
324 PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
325 SV* namesv = NEWSV(1102, 0);
327 ASSERT_CURPAD_ACTIVE("pad_add_name");
330 sv_upgrade(namesv, ourstash ? SVt_PVGV : typestash ? SVt_PVMG : SVt_PVNV);
331 sv_setpv(namesv, name);
334 SvFLAGS(namesv) |= SVpad_TYPED;
335 SvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*) typestash);
338 SvFLAGS(namesv) |= SVpad_OUR;
339 GvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*) ourstash);
342 av_store(PL_comppad_name, offset, namesv);
345 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
346 "Pad addname: %ld \"%s\" FAKE\n", (long)offset, name));
349 /* not yet introduced */
350 SvNVX(namesv) = (NV)PAD_MAX; /* min */
351 SvIVX(namesv) = 0; /* max */
353 if (!PL_min_intro_pending)
354 PL_min_intro_pending = offset;
355 PL_max_intro_pending = offset;
356 /* if it's not a simple scalar, replace with an AV or HV */
357 /* XXX DAPM since slot has been allocated, replace
358 * av_store with PL_curpad[offset] ? */
360 av_store(PL_comppad, offset, (SV*)newAV());
361 else if (*name == '%')
362 av_store(PL_comppad, offset, (SV*)newHV());
363 SvPADMY_on(PL_curpad[offset]);
364 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
365 "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
366 (long)offset, name, PTR2UV(PL_curpad[offset])));
376 =for apidoc pad_alloc
378 Allocate a new my or tmp pad entry. For a my, simply push a null SV onto
379 the end of PL_comppad, but for a tmp, scan the pad from PL_padix upwards
380 for a slot which has no name and and no active value.
385 /* XXX DAPM integrate alloc(), add_name() and add_anon(),
386 * or at least rationalise ??? */
390 Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
395 ASSERT_CURPAD_ACTIVE("pad_alloc");
397 if (AvARRAY(PL_comppad) != PL_curpad)
398 Perl_croak(aTHX_ "panic: pad_alloc");
399 if (PL_pad_reset_pending)
401 if (tmptype & SVs_PADMY) {
402 sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE);
403 retval = AvFILLp(PL_comppad);
406 SV **names = AvARRAY(PL_comppad_name);
407 SSize_t names_fill = AvFILLp(PL_comppad_name);
410 * "foreach" index vars temporarily become aliases to non-"my"
411 * values. Thus we must skip, not just pad values that are
412 * marked as current pad values, but also those with names.
414 /* HVDS why copy to sv here? we don't seem to use it */
415 if (++PL_padix <= names_fill &&
416 (sv = names[PL_padix]) && sv != &PL_sv_undef)
418 sv = *av_fetch(PL_comppad, PL_padix, TRUE);
419 if (!(SvFLAGS(sv) & (SVs_PADTMP | SVs_PADMY)) &&
420 !IS_PADGV(sv) && !IS_PADCONST(sv))
425 SvFLAGS(sv) |= tmptype;
426 PL_curpad = AvARRAY(PL_comppad);
428 DEBUG_X(PerlIO_printf(Perl_debug_log,
429 "Pad 0x%"UVxf"[0x%"UVxf"] alloc: %ld for %s\n",
430 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long) retval,
431 PL_op_name[optype]));
432 return (PADOFFSET)retval;
436 =for apidoc pad_add_anon
438 Add an anon code entry to the current compiling pad
444 Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
449 name = NEWSV(1106, 0);
450 sv_upgrade(name, SVt_PVNV);
451 sv_setpvn(name, "&", 1);
454 ix = pad_alloc(op_type, SVs_PADMY);
455 av_store(PL_comppad_name, ix, name);
456 /* XXX DAPM use PL_curpad[] ? */
457 av_store(PL_comppad, ix, sv);
460 /* to avoid ref loops, we never have parent + child referencing each
461 * other simultaneously */
462 if (CvOUTSIDE((CV*)sv)) {
463 assert(!CvWEAKOUTSIDE((CV*)sv));
464 CvWEAKOUTSIDE_on((CV*)sv);
465 SvREFCNT_dec(CvOUTSIDE((CV*)sv));
473 =for apidoc pad_check_dup
475 Check for duplicate declarations: report any of:
476 * a my in the current scope with the same name;
477 * an our (anywhere in the pad) with the same name and the same stash
479 C<is_our> indicates that the name to check is an 'our' declaration
484 /* XXX DAPM integrate this into pad_add_name ??? */
487 Perl_pad_check_dup(pTHX_ char *name, bool is_our, HV *ourstash)
492 ASSERT_CURPAD_ACTIVE("pad_check_dup");
493 if (!ckWARN(WARN_MISC) || AvFILLp(PL_comppad_name) < 0)
494 return; /* nothing to check */
496 svp = AvARRAY(PL_comppad_name);
497 top = AvFILLp(PL_comppad_name);
498 /* check the current scope */
499 /* XXX DAPM - why the (I32) cast - shouldn't we ensure they're the same
501 for (off = top; (I32)off > PL_comppad_name_floor; off--) {
503 && sv != &PL_sv_undef
505 && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
507 || ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash))
508 && strEQ(name, SvPVX(sv)))
510 Perl_warner(aTHX_ packWARN(WARN_MISC),
511 "\"%s\" variable %s masks earlier declaration in same %s",
512 (is_our ? "our" : "my"),
514 (SvIVX(sv) == PAD_MAX ? "scope" : "statement"));
519 /* check the rest of the pad */
523 && sv != &PL_sv_undef
525 && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
526 && ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash)
527 && strEQ(name, SvPVX(sv)))
529 Perl_warner(aTHX_ packWARN(WARN_MISC),
530 "\"our\" variable %s redeclared", name);
531 Perl_warner(aTHX_ packWARN(WARN_MISC),
532 "\t(Did you mean \"local\" instead of \"our\"?)\n");
535 } while ( off-- > 0 );
541 =for apidoc pad_findmy
543 Given a lexical name, try to find its offset, first in the current pad,
544 or failing that, in the pads of any lexically enclosing subs (including
545 the complications introduced by eval). If the name is found in an outer pad,
546 then a fake entry is added to the current pad.
547 Returns the offset in the current pad, or NOT_IN_PAD on failure.
553 Perl_pad_findmy(pTHX_ char *name)
561 offset = pad_findlex(name, PL_compcv, PL_cop_seqmax, 1,
562 Null(SV**), &out_sv, &out_flags);
563 if (offset != NOT_IN_PAD)
566 /* look for an our that's being introduced; this allows
567 * our $foo = 0 unless defined $foo;
568 * to not give a warning. (Yes, this is a hack) */
570 nameav = (AV*)AvARRAY(CvPADLIST(PL_compcv))[0];
571 name_svp = AvARRAY(nameav);
572 for (offset = AvFILLp(nameav); offset > 0; offset--) {
573 SV *namesv = name_svp[offset];
574 if (namesv && namesv != &PL_sv_undef
576 && (SvFLAGS(namesv) & SVpad_OUR)
577 && strEQ(SvPVX(namesv), name)
578 && U_32(SvNVX(namesv)) == PAD_MAX /* min */
586 * Returns the offset of a lexical $_, if there is one, at run time.
587 * Used by the UNDERBAR XS macro.
591 Perl_find_rundefsvoffset(pTHX)
595 return pad_findlex("$_", find_runcv(NULL), PL_curcop->cop_seq, 1,
596 Null(SV**), &out_sv, &out_flags);
600 =for apidoc pad_findlex
602 Find a named lexical anywhere in a chain of nested pads. Add fake entries
603 in the inner pads if it's found in an outer one.
605 Returns the offset in the bottom pad of the lex or the fake lex.
606 cv is the CV in which to start the search, and seq is the current cop_seq
607 to match against. If warn is true, print appropriate warnings. The out_*
608 vars return values, and so are pointers to where the returned values
609 should be stored. out_capture, if non-null, requests that the innermost
610 instance of the lexical is captured; out_name_sv is set to the innermost
611 matched namesv or fake namesv; out_flags returns the flags normally
612 associated with the IVX field of a fake namesv.
614 Note that pad_findlex() is recursive; it recurses up the chain of CVs,
615 then comes back down, adding fake entries as it goes. It has to be this way
616 because fake namesvs in anon protoypes have to store in NVX the index into
622 /* Flags set in the SvIVX field of FAKE namesvs */
624 #define PAD_FAKELEX_ANON 1 /* the lex is declared in an ANON, or ... */
625 #define PAD_FAKELEX_MULTI 2 /* the lex can be instantiated multiple times */
627 /* the CV has finished being compiled. This is not a sufficient test for
628 * all CVs (eg XSUBs), but suffices for the CVs found in a lexical chain */
629 #define CvCOMPILED(cv) CvROOT(cv)
631 /* the CV does late binding of its lexicals */
632 #define CvLATE(cv) (CvANON(cv) || SvTYPE(cv) == SVt_PVFM)
636 S_pad_findlex(pTHX_ char *name, CV* cv, U32 seq, int warn,
637 SV** out_capture, SV** out_name_sv, int *out_flags)
639 I32 offset, new_offset;
642 AV *padlist = CvPADLIST(cv);
646 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
647 "Pad findlex cv=0x%"UVxf" searching \"%s\" seq=%d%s\n",
648 PTR2UV(cv), name, (int)seq, out_capture ? " capturing" : "" ));
650 /* first, search this pad */
652 if (padlist) { /* not an undef CV */
654 AV *nameav = (AV*)AvARRAY(padlist)[0];
655 SV **name_svp = AvARRAY(nameav);
657 for (offset = AvFILLp(nameav); offset > 0; offset--) {
658 SV *namesv = name_svp[offset];
659 if (namesv && namesv != &PL_sv_undef
660 && strEQ(SvPVX(namesv), name))
663 fake_offset = offset; /* in case we don't find a real one */
664 else if ( seq > U_32(SvNVX(namesv)) /* min */
665 && seq <= (U32)SvIVX(namesv)) /* max */
670 if (offset > 0 || fake_offset > 0 ) { /* a match! */
671 if (offset > 0) { /* not fake */
673 *out_name_sv = name_svp[offset]; /* return the namesv */
675 /* set PAD_FAKELEX_MULTI if this lex can have multiple
676 * instances. For now, we just test !CvUNIQUE(cv), but
677 * ideally, we should detect my's declared within loops
678 * etc - this would allow a wider range of 'not stayed
679 * shared' warnings. We also treated alreadly-compiled
680 * lexes as not multi as viewed from evals. */
682 *out_flags = CvANON(cv) ?
684 (!CvUNIQUE(cv) && ! CvCOMPILED(cv))
685 ? PAD_FAKELEX_MULTI : 0;
687 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
688 "Pad findlex cv=0x%"UVxf" matched: offset=%ld (%ld,%ld)\n",
689 PTR2UV(cv), (long)offset, (long)U_32(SvNVX(*out_name_sv)),
690 (long)SvIVX(*out_name_sv)));
692 else { /* fake match */
693 offset = fake_offset;
694 *out_name_sv = name_svp[offset]; /* return the namesv */
695 *out_flags = SvIVX(*out_name_sv);
696 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
697 "Pad findlex cv=0x%"UVxf" matched: offset=%ld flags=0x%lx index=%lu\n",
698 PTR2UV(cv), (long)offset, (unsigned long)*out_flags,
699 (unsigned long)SvNVX(*out_name_sv)
703 /* return the lex? */
708 if ((SvFLAGS(*out_name_sv) & SVpad_OUR)) {
709 *out_capture = Nullsv;
713 /* trying to capture from an anon prototype? */
715 ? CvANON(cv) && CvCLONE(cv) && !CvCLONED(cv)
716 : *out_flags & PAD_FAKELEX_ANON)
718 if (warn && ckWARN(WARN_CLOSURE))
719 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
720 "Variable \"%s\" is not available", name);
721 *out_capture = Nullsv;
727 if (!CvCOMPILED(cv) && (*out_flags & PAD_FAKELEX_MULTI)
728 && warn && ckWARN(WARN_CLOSURE)) {
730 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
731 "Variable \"%s\" will not stay shared", name);
734 if (fake_offset && CvANON(cv)
735 && CvCLONE(cv) &&!CvCLONED(cv))
738 /* not yet caught - look further up */
739 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
740 "Pad findlex cv=0x%"UVxf" chasing lex in outer pad\n",
743 pad_findlex(name, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv),
744 newwarn, out_capture, out_name_sv, out_flags);
749 *out_capture = AvARRAY((AV*)AvARRAY(padlist)[
750 CvDEPTH(cv) ? CvDEPTH(cv) : 1])[offset];
751 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
752 "Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n",
753 PTR2UV(cv), PTR2UV(*out_capture)));
755 if (SvPADSTALE(*out_capture)) {
756 if (ckWARN(WARN_CLOSURE))
757 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
758 "Variable \"%s\" is not available", name);
759 *out_capture = Nullsv;
764 *out_capture = sv_2mortal((SV*)newAV());
765 else if (*name == '%')
766 *out_capture = sv_2mortal((SV*)newHV());
768 *out_capture = sv_newmortal();
776 /* it's not in this pad - try above */
781 /* out_capture non-null means caller wants us to capture lex; in
782 * addition we capture ourselves unless it's an ANON/format */
783 new_capturep = out_capture ? out_capture :
784 CvLATE(cv) ? Null(SV**) : &new_capture;
786 offset = pad_findlex(name, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1,
787 new_capturep, out_name_sv, out_flags);
788 if (offset == NOT_IN_PAD)
791 /* found in an outer CV. Add appropriate fake entry to this pad */
793 /* don't add new fake entries (via eval) to CVs that we have already
794 * finished compiling, or to undef CVs */
795 if (CvCOMPILED(cv) || !padlist)
796 return 0; /* this dummy (and invalid) value isnt used by the caller */
800 AV *ocomppad_name = PL_comppad_name;
801 PAD *ocomppad = PL_comppad;
802 PL_comppad_name = (AV*)AvARRAY(padlist)[0];
803 PL_comppad = (AV*)AvARRAY(padlist)[1];
804 PL_curpad = AvARRAY(PL_comppad);
806 new_offset = pad_add_name(
808 (SvFLAGS(*out_name_sv) & SVpad_TYPED)
809 ? SvSTASH(*out_name_sv) : Nullhv,
810 (SvFLAGS(*out_name_sv) & SVpad_OUR)
811 ? GvSTASH(*out_name_sv) : Nullhv,
815 new_namesv = AvARRAY(PL_comppad_name)[new_offset];
816 SvIVX(new_namesv) = *out_flags;
818 SvNVX(new_namesv) = (NV)0;
819 if (SvFLAGS(new_namesv) & SVpad_OUR) {
822 else if (CvLATE(cv)) {
823 /* delayed creation - just note the offset within parent pad */
824 SvNVX(new_namesv) = (NV)offset;
828 /* immediate creation - capture outer value right now */
829 av_store(PL_comppad, new_offset, SvREFCNT_inc(*new_capturep));
830 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
831 "Pad findlex cv=0x%"UVxf" saved captured sv 0x%"UVxf" at offset %ld\n",
832 PTR2UV(cv), PTR2UV(*new_capturep), (long)new_offset));
834 *out_name_sv = new_namesv;
835 *out_flags = SvIVX(new_namesv);
837 PL_comppad_name = ocomppad_name;
838 PL_comppad = ocomppad;
839 PL_curpad = ocomppad ? AvARRAY(ocomppad) : Null(SV **);
848 Get the value at offset po in the current pad.
849 Use macro PAD_SV instead of calling this function directly.
856 Perl_pad_sv(pTHX_ PADOFFSET po)
858 ASSERT_CURPAD_ACTIVE("pad_sv");
861 Perl_croak(aTHX_ "panic: pad_sv po");
862 DEBUG_X(PerlIO_printf(Perl_debug_log,
863 "Pad 0x%"UVxf"[0x%"UVxf"] sv: %ld sv=0x%"UVxf"\n",
864 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(PL_curpad[po]))
866 return PL_curpad[po];
871 =for apidoc pad_setsv
873 Set the entry at offset po in the current pad to sv.
874 Use the macro PAD_SETSV() rather than calling this function directly.
881 Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
883 ASSERT_CURPAD_ACTIVE("pad_setsv");
885 DEBUG_X(PerlIO_printf(Perl_debug_log,
886 "Pad 0x%"UVxf"[0x%"UVxf"] setsv: %ld sv=0x%"UVxf"\n",
887 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(sv))
896 =for apidoc pad_block_start
898 Update the pad compilation state variables on entry to a new block
904 * - integrate this in general state-saving routine ???
905 * - combine with the state-saving going on in pad_new ???
906 * - introduce a new SAVE type that does all this in one go ?
910 Perl_pad_block_start(pTHX_ int full)
912 ASSERT_CURPAD_ACTIVE("pad_block_start");
913 SAVEI32(PL_comppad_name_floor);
914 PL_comppad_name_floor = AvFILLp(PL_comppad_name);
916 PL_comppad_name_fill = PL_comppad_name_floor;
917 if (PL_comppad_name_floor < 0)
918 PL_comppad_name_floor = 0;
919 SAVEI32(PL_min_intro_pending);
920 SAVEI32(PL_max_intro_pending);
921 PL_min_intro_pending = 0;
922 SAVEI32(PL_comppad_name_fill);
923 SAVEI32(PL_padix_floor);
924 PL_padix_floor = PL_padix;
925 PL_pad_reset_pending = FALSE;
932 "Introduce" my variables to visible status.
944 ASSERT_CURPAD_ACTIVE("intro_my");
945 if (! PL_min_intro_pending)
946 return PL_cop_seqmax;
948 svp = AvARRAY(PL_comppad_name);
949 for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
950 if ((sv = svp[i]) && sv != &PL_sv_undef
951 && !SvFAKE(sv) && !SvIVX(sv))
953 SvIVX(sv) = PAD_MAX; /* Don't know scope end yet. */
954 SvNVX(sv) = (NV)PL_cop_seqmax;
955 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
956 "Pad intromy: %ld \"%s\", (%ld,%ld)\n",
958 (long)U_32(SvNVX(sv)), (long)SvIVX(sv))
962 PL_min_intro_pending = 0;
963 PL_comppad_name_fill = PL_max_intro_pending; /* Needn't search higher */
964 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
965 "Pad intromy: seq -> %ld\n", (long)(PL_cop_seqmax+1)));
967 return PL_cop_seqmax++;
971 =for apidoc pad_leavemy
973 Cleanup at end of scope during compilation: set the max seq number for
974 lexicals in this scope and warn of any lexicals that never got introduced.
980 Perl_pad_leavemy(pTHX)
983 SV **svp = AvARRAY(PL_comppad_name);
986 PL_pad_reset_pending = FALSE;
988 ASSERT_CURPAD_ACTIVE("pad_leavemy");
989 if (PL_min_intro_pending && PL_comppad_name_fill < PL_min_intro_pending) {
990 for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
991 if ((sv = svp[off]) && sv != &PL_sv_undef
992 && !SvFAKE(sv) && ckWARN_d(WARN_INTERNAL))
993 Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
994 "%"SVf" never introduced", sv);
997 /* "Deintroduce" my variables that are leaving with this scope. */
998 for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_fill; off--) {
999 if ((sv = svp[off]) && sv != &PL_sv_undef
1000 && !SvFAKE(sv) && SvIVX(sv) == PAD_MAX)
1002 SvIVX(sv) = PL_cop_seqmax;
1003 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1004 "Pad leavemy: %ld \"%s\", (%ld,%ld)\n",
1005 (long)off, SvPVX(sv),
1006 (long)U_32(SvNVX(sv)), (long)SvIVX(sv))
1011 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1012 "Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax));
1017 =for apidoc pad_swipe
1019 Abandon the tmp in the current pad at offset po and replace with a
1026 Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
1028 ASSERT_CURPAD_LEGAL("pad_swipe");
1031 if (AvARRAY(PL_comppad) != PL_curpad)
1032 Perl_croak(aTHX_ "panic: pad_swipe curpad");
1034 Perl_croak(aTHX_ "panic: pad_swipe po");
1036 DEBUG_X(PerlIO_printf(Perl_debug_log,
1037 "Pad 0x%"UVxf"[0x%"UVxf"] swipe: %ld\n",
1038 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po));
1041 SvPADTMP_off(PL_curpad[po]);
1043 SvREFCNT_dec(PL_curpad[po]);
1045 PL_curpad[po] = NEWSV(1107,0);
1046 SvPADTMP_on(PL_curpad[po]);
1047 if ((I32)po < PL_padix)
1053 =for apidoc pad_reset
1055 Mark all the current temporaries for reuse
1060 /* XXX pad_reset() is currently disabled because it results in serious bugs.
1061 * It causes pad temp TARGs to be shared between OPs. Since TARGs are pushed
1062 * on the stack by OPs that use them, there are several ways to get an alias
1063 * to a shared TARG. Such an alias will change randomly and unpredictably.
1064 * We avoid doing this until we can think of a Better Way.
1067 Perl_pad_reset(pTHX)
1069 #ifdef USE_BROKEN_PAD_RESET
1072 if (AvARRAY(PL_comppad) != PL_curpad)
1073 Perl_croak(aTHX_ "panic: pad_reset curpad");
1075 DEBUG_X(PerlIO_printf(Perl_debug_log,
1076 "Pad 0x%"UVxf"[0x%"UVxf"] reset: padix %ld -> %ld",
1077 PTR2UV(PL_comppad), PTR2UV(PL_curpad),
1078 (long)PL_padix, (long)PL_padix_floor
1082 if (!PL_tainting) { /* Can't mix tainted and non-tainted temporaries. */
1083 for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
1084 if (PL_curpad[po] && !SvIMMORTAL(PL_curpad[po]))
1085 SvPADTMP_off(PL_curpad[po]);
1087 PL_padix = PL_padix_floor;
1090 PL_pad_reset_pending = FALSE;
1095 =for apidoc pad_tidy
1097 Tidy up a pad after we've finished compiling it:
1098 * remove most stuff from the pads of anonsub prototypes;
1100 * mark tmps as such.
1105 /* XXX DAPM surely most of this stuff should be done properly
1106 * at the right time beforehand, rather than going around afterwards
1107 * cleaning up our mistakes ???
1111 Perl_pad_tidy(pTHX_ padtidy_type type)
1116 ASSERT_CURPAD_ACTIVE("pad_tidy");
1118 /* If this CV has had any 'eval-capable' ops planted in it
1119 * (ie it contains eval '...', //ee, /$var/ or /(?{..})/), Then any
1120 * anon prototypes in the chain of CVs should be marked as cloneable,
1121 * so that for example the eval's CV in C<< sub { eval '$x' } >> gets
1122 * the right CvOUTSIDE.
1123 * If running with -d, *any* sub may potentially have an eval
1124 * excuted within it.
1127 if (PL_cv_has_eval || PL_perldb) {
1128 for (cv = PL_compcv ;cv; cv = CvOUTSIDE(cv)) {
1129 if (cv != PL_compcv && CvCOMPILED(cv))
1130 break; /* no need to mark already-compiled code */
1132 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1133 "Pad clone on cv=0x%"UVxf"\n", PTR2UV(cv)));
1139 /* extend curpad to match namepad */
1140 if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
1141 av_store(PL_comppad_name, AvFILLp(PL_comppad), Nullsv);
1143 if (type == padtidy_SUBCLONE) {
1144 SV **namep = AvARRAY(PL_comppad_name);
1146 for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1149 if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
1152 * The only things that a clonable function needs in its
1153 * pad are anonymous subs.
1154 * The rest are created anew during cloning.
1156 if (!((namesv = namep[ix]) != Nullsv &&
1157 namesv != &PL_sv_undef &&
1158 *SvPVX(namesv) == '&'))
1160 SvREFCNT_dec(PL_curpad[ix]);
1161 PL_curpad[ix] = Nullsv;
1165 else if (type == padtidy_SUB) {
1166 /* XXX DAPM this same bit of code keeps appearing !!! Rationalise? */
1167 AV *av = newAV(); /* Will be @_ */
1169 av_store(PL_comppad, 0, (SV*)av);
1170 AvFLAGS(av) = AVf_REIFY;
1173 /* XXX DAPM rationalise these two similar branches */
1175 if (type == padtidy_SUB) {
1176 for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1177 if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
1179 if (!SvPADMY(PL_curpad[ix]))
1180 SvPADTMP_on(PL_curpad[ix]);
1183 else if (type == padtidy_FORMAT) {
1184 for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1185 if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix]))
1186 SvPADTMP_on(PL_curpad[ix]);
1189 PL_curpad = AvARRAY(PL_comppad);
1194 =for apidoc pad_free
1196 Free the SV at offet po in the current pad.
1201 /* XXX DAPM integrate with pad_swipe ???? */
1203 Perl_pad_free(pTHX_ PADOFFSET po)
1205 ASSERT_CURPAD_LEGAL("pad_free");
1208 if (AvARRAY(PL_comppad) != PL_curpad)
1209 Perl_croak(aTHX_ "panic: pad_free curpad");
1211 Perl_croak(aTHX_ "panic: pad_free po");
1213 DEBUG_X(PerlIO_printf(Perl_debug_log,
1214 "Pad 0x%"UVxf"[0x%"UVxf"] free: %ld\n",
1215 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po)
1218 if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
1219 SvPADTMP_off(PL_curpad[po]);
1221 /* SV could be a shared hash key (eg bugid #19022) */
1223 #ifdef PERL_COPY_ON_WRITE
1224 !SvIsCOW(PL_curpad[po])
1226 !SvFAKE(PL_curpad[po])
1229 SvREADONLY_off(PL_curpad[po]); /* could be a freed constant */
1232 if ((I32)po < PL_padix)
1239 =for apidoc do_dump_pad
1241 Dump the contents of a padlist
1247 Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
1259 pad_name = (AV*)*av_fetch((AV*)padlist, 0, FALSE);
1260 pad = (AV*)*av_fetch((AV*)padlist, 1, FALSE);
1261 pname = AvARRAY(pad_name);
1262 ppad = AvARRAY(pad);
1263 Perl_dump_indent(aTHX_ level, file,
1264 "PADNAME = 0x%"UVxf"(0x%"UVxf") PAD = 0x%"UVxf"(0x%"UVxf")\n",
1265 PTR2UV(pad_name), PTR2UV(pname), PTR2UV(pad), PTR2UV(ppad)
1268 for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
1270 if (namesv && namesv == &PL_sv_undef) {
1275 Perl_dump_indent(aTHX_ level+1, file,
1276 "%2d. 0x%"UVxf"<%lu> FAKE \"%s\" flags=0x%lx index=%lu\n",
1279 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
1281 (unsigned long)SvIVX(namesv),
1282 (unsigned long)SvNVX(namesv)
1286 Perl_dump_indent(aTHX_ level+1, file,
1287 "%2d. 0x%"UVxf"<%lu> (%ld,%ld) \"%s\"\n",
1290 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
1291 (long)U_32(SvNVX(namesv)),
1292 (long)SvIVX(namesv),
1297 Perl_dump_indent(aTHX_ level+1, file,
1298 "%2d. 0x%"UVxf"<%lu>\n",
1301 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0)
1312 dump the contents of a CV
1319 S_cv_dump(pTHX_ CV *cv, char *title)
1321 CV *outside = CvOUTSIDE(cv);
1322 AV* padlist = CvPADLIST(cv);
1324 PerlIO_printf(Perl_debug_log,
1325 " %s: CV=0x%"UVxf" (%s), OUTSIDE=0x%"UVxf" (%s)\n",
1328 (CvANON(cv) ? "ANON"
1329 : (SvTYPE(cv) == SVt_PVFM) ? "FORMAT"
1330 : (cv == PL_main_cv) ? "MAIN"
1331 : CvUNIQUE(cv) ? "UNIQUE"
1332 : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
1335 : CvANON(outside) ? "ANON"
1336 : (outside == PL_main_cv) ? "MAIN"
1337 : CvUNIQUE(outside) ? "UNIQUE"
1338 : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
1340 PerlIO_printf(Perl_debug_log,
1341 " PADLIST = 0x%"UVxf"\n", PTR2UV(padlist));
1342 do_dump_pad(1, Perl_debug_log, padlist, 1);
1344 #endif /* DEBUGGING */
1351 =for apidoc cv_clone
1353 Clone a CV: make a new CV which points to the same code etc, but which
1354 has a newly-created pad built by copying the prototype pad and capturing
1361 Perl_cv_clone(pTHX_ CV *proto)
1364 AV* protopadlist = CvPADLIST(proto);
1365 AV* protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
1366 AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
1367 SV** pname = AvARRAY(protopad_name);
1368 SV** ppad = AvARRAY(protopad);
1369 I32 fname = AvFILLp(protopad_name);
1370 I32 fpad = AvFILLp(protopad);
1377 assert(!CvUNIQUE(proto));
1379 /* Since cloneable anon subs can be nested, CvOUTSIDE may point
1380 * to a prototype; we instead want the cloned parent who called us.
1381 * Note that in general for formats, CvOUTSIDE != find_runcv */
1383 outside = CvOUTSIDE(proto);
1384 if (outside && CvCLONE(outside) && ! CvCLONED(outside))
1385 outside = find_runcv(NULL);
1386 depth = CvDEPTH(outside);
1387 assert(depth || SvTYPE(proto) == SVt_PVFM);
1390 assert(CvPADLIST(outside));
1393 SAVESPTR(PL_compcv);
1395 cv = PL_compcv = (CV*)NEWSV(1104, 0);
1396 sv_upgrade((SV *)cv, SvTYPE(proto));
1397 CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE);
1401 CvFILE(cv) = CvXSUB(proto) ? CvFILE(proto)
1402 : savepv(CvFILE(proto));
1404 CvFILE(cv) = CvFILE(proto);
1406 CvGV(cv) = CvGV(proto);
1407 CvSTASH(cv) = CvSTASH(proto);
1408 CvROOT(cv) = OpREFCNT_inc(CvROOT(proto));
1409 CvSTART(cv) = CvSTART(proto);
1410 CvOUTSIDE(cv) = (CV*)SvREFCNT_inc(outside);
1411 CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
1414 sv_setpvn((SV*)cv, SvPVX(proto), SvCUR(proto));
1416 CvPADLIST(cv) = comppadlist = pad_new(padnew_CLONE|padnew_SAVE);
1418 av_fill(PL_comppad, fpad);
1419 for (ix = fname; ix >= 0; ix--)
1420 av_store(PL_comppad_name, ix, SvREFCNT_inc(pname[ix]));
1422 PL_curpad = AvARRAY(PL_comppad);
1424 outpad = AvARRAY(AvARRAY(CvPADLIST(outside))[depth]);
1426 for (ix = fpad; ix > 0; ix--) {
1427 SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
1429 if (namesv && namesv != &PL_sv_undef) { /* lexical */
1430 if (SvFAKE(namesv)) { /* lexical from outside? */
1431 sv = outpad[(I32)SvNVX(namesv)];
1433 /* formats may have an inactive parent */
1434 if (SvTYPE(proto) == SVt_PVFM && SvPADSTALE(sv)) {
1435 if (ckWARN(WARN_CLOSURE))
1436 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
1437 "Variable \"%s\" is not available", SvPVX(namesv));
1441 assert(!SvPADSTALE(sv));
1442 sv = SvREFCNT_inc(sv);
1446 char *name = SvPVX(namesv);
1448 sv = SvREFCNT_inc(ppad[ix]);
1449 else if (*name == '@')
1451 else if (*name == '%')
1458 else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) {
1459 sv = SvREFCNT_inc(ppad[ix]);
1469 PerlIO_printf(Perl_debug_log, "\nPad CV clone\n");
1470 cv_dump(outside, "Outside");
1471 cv_dump(proto, "Proto");
1478 /* Constant sub () { $x } closing over $x - see lib/constant.pm:
1479 * The prototype was marked as a candiate for const-ization,
1480 * so try to grab the current const value, and if successful,
1481 * turn into a const sub:
1483 SV* const_sv = op_const_sv(CvSTART(cv), cv);
1486 cv = newCONSTSUB(CvSTASH(proto), 0, const_sv);
1498 =for apidoc pad_fixup_inner_anons
1500 For any anon CVs in the pad, change CvOUTSIDE of that CV from
1501 old_cv to new_cv if necessary. Needed when a newly-compiled CV has to be
1502 moved to a pre-existing CV struct.
1508 Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
1511 AV *comppad_name = (AV*)AvARRAY(padlist)[0];
1512 AV *comppad = (AV*)AvARRAY(padlist)[1];
1513 SV **namepad = AvARRAY(comppad_name);
1514 SV **curpad = AvARRAY(comppad);
1515 for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
1516 SV *namesv = namepad[ix];
1517 if (namesv && namesv != &PL_sv_undef
1518 && *SvPVX(namesv) == '&')
1520 CV *innercv = (CV*)curpad[ix];
1521 assert(CvWEAKOUTSIDE(innercv));
1522 assert(CvOUTSIDE(innercv) == old_cv);
1523 CvOUTSIDE(innercv) = new_cv;
1530 =for apidoc pad_push
1532 Push a new pad frame onto the padlist, unless there's already a pad at
1533 this depth, in which case don't bother creating a new one.
1534 If has_args is true, give the new pad an @_ in slot zero.
1539 /* XXX pad_push is now always called with has_args == 1. Get rid of
1540 * this arg at some point */
1543 Perl_pad_push(pTHX_ PADLIST *padlist, int depth, int has_args)
1545 if (depth <= AvFILLp(padlist))
1549 SV** svp = AvARRAY(padlist);
1550 AV *newpad = newAV();
1551 SV **oldpad = AvARRAY(svp[depth-1]);
1552 I32 ix = AvFILLp((AV*)svp[1]);
1553 I32 names_fill = AvFILLp((AV*)svp[0]);
1554 SV** names = AvARRAY(svp[0]);
1556 for ( ;ix > 0; ix--) {
1557 if (names_fill >= ix && names[ix] != &PL_sv_undef) {
1558 char *name = SvPVX(names[ix]);
1559 if ((SvFLAGS(names[ix]) & SVf_FAKE) || *name == '&') {
1560 /* outer lexical or anon code */
1561 av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]));
1563 else { /* our own lexical */
1565 av_store(newpad, ix, sv = (SV*)newAV());
1566 else if (*name == '%')
1567 av_store(newpad, ix, sv = (SV*)newHV());
1569 av_store(newpad, ix, sv = NEWSV(0, 0));
1573 else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
1574 av_store(newpad, ix, sv = SvREFCNT_inc(oldpad[ix]));
1577 /* save temporaries on recursion? */
1578 av_store(newpad, ix, sv = NEWSV(0, 0));
1585 av_store(newpad, 0, (SV*)av);
1586 AvFLAGS(av) = AVf_REIFY;
1588 av_store(padlist, depth, (SV*)newpad);
1589 AvFILLp(padlist) = depth;