3 * Copyright (C) 2002, 2003, 2004, 2005 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;
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 AV * const a0 = newAV(); /* will be @_ */
178 av_store(pad, 0, (SV*)a0);
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 const PADLIST * const 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 * const outercv = CvOUTSIDE(cv);
252 const U32 seq = CvOUTSIDE_SEQ(cv);
253 AV * const comppad_name = (AV*)AvARRAY(padlist)[0];
254 SV ** const namepad = AvARRAY(comppad_name);
255 AV * const comppad = (AV*)AvARRAY(padlist)[1];
256 SV ** const curpad = AvARRAY(comppad);
257 for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
258 SV * const namesv = namepad[ix];
259 if (namesv && namesv != &PL_sv_undef
260 && *SvPVX_const(namesv) == '&')
262 CV * const innercv = (CV*)curpad[ix];
263 U32 inner_rc = SvREFCNT(innercv);
265 namepad[ix] = Nullsv;
266 SvREFCNT_dec(namesv);
268 if (SvREFCNT(comppad) < 2) { /* allow for /(?{ sub{} })/ */
270 SvREFCNT_dec(innercv);
273 if (inner_rc /* in use, not just a prototype */
274 && CvOUTSIDE(innercv) == cv)
276 assert(CvWEAKOUTSIDE(innercv));
277 /* don't relink to grandfather if he's being freed */
278 if (outercv && SvREFCNT(outercv)) {
279 CvWEAKOUTSIDE_off(innercv);
280 CvOUTSIDE(innercv) = outercv;
281 CvOUTSIDE_SEQ(innercv) = seq;
282 (void)SvREFCNT_inc(outercv);
285 CvOUTSIDE(innercv) = Nullcv;
294 ix = AvFILLp(padlist);
296 SV* const sv = AvARRAY(padlist)[ix--];
299 if (sv == (SV*)PL_comppad_name)
300 PL_comppad_name = Nullav;
301 else if (sv == (SV*)PL_comppad) {
302 PL_comppad = Null(PAD*);
303 PL_curpad = Null(SV**);
307 SvREFCNT_dec((SV*)CvPADLIST(cv));
308 CvPADLIST(cv) = Null(PADLIST*);
315 =for apidoc pad_add_name
317 Create a new name and associated PADMY SV in the current pad; return the
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
324 If fake, it means we're cloning an existing entry
330 Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake)
332 const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
333 SV* const namesv = NEWSV(1102, 0);
335 ASSERT_CURPAD_ACTIVE("pad_add_name");
338 sv_upgrade(namesv, ourstash ? SVt_PVGV : typestash ? SVt_PVMG : SVt_PVNV);
339 sv_setpv(namesv, name);
342 SvFLAGS(namesv) |= SVpad_TYPED;
343 SvSTASH_set(namesv, (HV*)SvREFCNT_inc((SV*) typestash));
346 SvFLAGS(namesv) |= SVpad_OUR;
347 GvSTASH(namesv) = ourstash;
348 Perl_sv_add_backref(aTHX_ (SV*)ourstash, namesv);
351 av_store(PL_comppad_name, offset, namesv);
354 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
355 "Pad addname: %ld \"%s\" FAKE\n", (long)offset, name));
358 /* not yet introduced */
359 SvNV_set(namesv, (NV)PAD_MAX); /* min */
360 SvIV_set(namesv, 0); /* max */
362 if (!PL_min_intro_pending)
363 PL_min_intro_pending = offset;
364 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] ? */
369 av_store(PL_comppad, offset, (SV*)newAV());
370 else if (*name == '%')
371 av_store(PL_comppad, offset, (SV*)newHV());
372 SvPADMY_on(PL_curpad[offset]);
373 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
374 "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
375 (long)offset, name, PTR2UV(PL_curpad[offset])));
385 =for apidoc pad_alloc
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.
394 /* XXX DAPM integrate alloc(), add_name() and add_anon(),
395 * or at least rationalise ??? */
399 Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
404 ASSERT_CURPAD_ACTIVE("pad_alloc");
406 if (AvARRAY(PL_comppad) != PL_curpad)
407 Perl_croak(aTHX_ "panic: pad_alloc");
408 if (PL_pad_reset_pending)
410 if (tmptype & SVs_PADMY) {
411 sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE);
412 retval = AvFILLp(PL_comppad);
415 SV ** const names = AvARRAY(PL_comppad_name);
416 const SSize_t names_fill = AvFILLp(PL_comppad_name);
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.
423 /* HVDS why copy to sv here? we don't seem to use it */
424 if (++PL_padix <= names_fill &&
425 (sv = names[PL_padix]) && sv != &PL_sv_undef)
427 sv = *av_fetch(PL_comppad, PL_padix, TRUE);
428 if (!(SvFLAGS(sv) & (SVs_PADTMP | SVs_PADMY)) &&
429 !IS_PADGV(sv) && !IS_PADCONST(sv))
434 SvFLAGS(sv) |= tmptype;
435 PL_curpad = AvARRAY(PL_comppad);
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 PL_op_name[optype]));
441 #ifdef DEBUG_LEAKING_SCALARS
442 sv->sv_debug_optype = optype;
443 sv->sv_debug_inpad = 1;
445 return (PADOFFSET)retval;
449 =for apidoc pad_add_anon
451 Add an anon code entry to the current compiling pad
457 Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
460 SV* const name = NEWSV(1106, 0);
461 sv_upgrade(name, SVt_PVNV);
462 sv_setpvn(name, "&", 1);
465 ix = pad_alloc(op_type, SVs_PADMY);
466 av_store(PL_comppad_name, ix, name);
467 /* XXX DAPM use PL_curpad[] ? */
468 av_store(PL_comppad, ix, sv);
471 /* to avoid ref loops, we never have parent + child referencing each
472 * other simultaneously */
473 if (CvOUTSIDE((CV*)sv)) {
474 assert(!CvWEAKOUTSIDE((CV*)sv));
475 CvWEAKOUTSIDE_on((CV*)sv);
476 SvREFCNT_dec(CvOUTSIDE((CV*)sv));
484 =for apidoc pad_check_dup
486 Check for duplicate declarations: report any of:
487 * a my in the current scope with the same name;
488 * an our (anywhere in the pad) with the same name and the same stash
490 C<is_our> indicates that the name to check is an 'our' declaration
495 /* XXX DAPM integrate this into pad_add_name ??? */
498 Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash)
503 ASSERT_CURPAD_ACTIVE("pad_check_dup");
504 if (!ckWARN(WARN_MISC) || AvFILLp(PL_comppad_name) < 0)
505 return; /* nothing to check */
507 svp = AvARRAY(PL_comppad_name);
508 top = AvFILLp(PL_comppad_name);
509 /* check the current scope */
510 /* XXX DAPM - why the (I32) cast - shouldn't we ensure they're the same
512 for (off = top; (I32)off > PL_comppad_name_floor; off--) {
513 SV * const sv = svp[off];
515 && sv != &PL_sv_undef
517 && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
519 || ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash))
520 && strEQ(name, SvPVX_const(sv)))
522 Perl_warner(aTHX_ packWARN(WARN_MISC),
523 "\"%s\" variable %s masks earlier declaration in same %s",
524 (is_our ? "our" : "my"),
526 (SvIVX(sv) == PAD_MAX ? "scope" : "statement"));
531 /* check the rest of the pad */
534 SV * const sv = svp[off];
536 && sv != &PL_sv_undef
538 && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
539 && ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash)
540 && strEQ(name, SvPVX_const(sv)))
542 Perl_warner(aTHX_ packWARN(WARN_MISC),
543 "\"our\" variable %s redeclared", name);
544 Perl_warner(aTHX_ packWARN(WARN_MISC),
545 "\t(Did you mean \"local\" instead of \"our\"?)\n");
548 } while ( off-- > 0 );
554 =for apidoc pad_findmy
556 Given a lexical name, try to find its offset, first in the current pad,
557 or failing that, in the pads of any lexically enclosing subs (including
558 the complications introduced by eval). If the name is found in an outer pad,
559 then a fake entry is added to the current pad.
560 Returns the offset in the current pad, or NOT_IN_PAD on failure.
566 Perl_pad_findmy(pTHX_ const char *name)
574 offset = pad_findlex(name, PL_compcv, PL_cop_seqmax, 1,
575 Null(SV**), &out_sv, &out_flags);
576 if (offset != NOT_IN_PAD)
579 /* look for an our that's being introduced; this allows
580 * our $foo = 0 unless defined $foo;
581 * to not give a warning. (Yes, this is a hack) */
583 nameav = (AV*)AvARRAY(CvPADLIST(PL_compcv))[0];
584 name_svp = AvARRAY(nameav);
585 for (offset = AvFILLp(nameav); offset > 0; offset--) {
586 const SV *namesv = name_svp[offset];
587 if (namesv && namesv != &PL_sv_undef
589 && (SvFLAGS(namesv) & SVpad_OUR)
590 && strEQ(SvPVX_const(namesv), name)
591 && U_32(SvNVX(namesv)) == PAD_MAX /* min */
599 * Returns the offset of a lexical $_, if there is one, at run time.
600 * Used by the UNDERBAR XS macro.
604 Perl_find_rundefsvoffset(pTHX)
608 return pad_findlex("$_", find_runcv(NULL), PL_curcop->cop_seq, 1,
609 Null(SV**), &out_sv, &out_flags);
613 =for apidoc pad_findlex
615 Find a named lexical anywhere in a chain of nested pads. Add fake entries
616 in the inner pads if it's found in an outer one.
618 Returns the offset in the bottom pad of the lex or the fake lex.
619 cv is the CV in which to start the search, and seq is the current cop_seq
620 to match against. If warn is true, print appropriate warnings. The out_*
621 vars return values, and so are pointers to where the returned values
622 should be stored. out_capture, if non-null, requests that the innermost
623 instance of the lexical is captured; out_name_sv is set to the innermost
624 matched namesv or fake namesv; out_flags returns the flags normally
625 associated with the IVX field of a fake namesv.
627 Note that pad_findlex() is recursive; it recurses up the chain of CVs,
628 then comes back down, adding fake entries as it goes. It has to be this way
629 because fake namesvs in anon protoypes have to store in NVX the index into
635 /* Flags set in the SvIVX field of FAKE namesvs */
637 #define PAD_FAKELEX_ANON 1 /* the lex is declared in an ANON, or ... */
638 #define PAD_FAKELEX_MULTI 2 /* the lex can be instantiated multiple times */
640 /* the CV has finished being compiled. This is not a sufficient test for
641 * all CVs (eg XSUBs), but suffices for the CVs found in a lexical chain */
642 #define CvCOMPILED(cv) CvROOT(cv)
644 /* the CV does late binding of its lexicals */
645 #define CvLATE(cv) (CvANON(cv) || SvTYPE(cv) == SVt_PVFM)
649 S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
650 SV** out_capture, SV** out_name_sv, int *out_flags)
652 I32 offset, new_offset;
655 const AV * const padlist = CvPADLIST(cv);
659 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
660 "Pad findlex cv=0x%"UVxf" searching \"%s\" seq=%d%s\n",
661 PTR2UV(cv), name, (int)seq, out_capture ? " capturing" : "" ));
663 /* first, search this pad */
665 if (padlist) { /* not an undef CV */
667 const AV *nameav = (AV*)AvARRAY(padlist)[0];
668 SV **name_svp = AvARRAY(nameav);
670 for (offset = AvFILLp(nameav); offset > 0; offset--) {
671 const SV *namesv = name_svp[offset];
672 if (namesv && namesv != &PL_sv_undef
673 && strEQ(SvPVX_const(namesv), name))
676 fake_offset = offset; /* in case we don't find a real one */
677 else if ( seq > U_32(SvNVX(namesv)) /* min */
678 && seq <= (U32)SvIVX(namesv)) /* max */
683 if (offset > 0 || fake_offset > 0 ) { /* a match! */
684 if (offset > 0) { /* not fake */
686 *out_name_sv = name_svp[offset]; /* return the namesv */
688 /* set PAD_FAKELEX_MULTI if this lex can have multiple
689 * instances. For now, we just test !CvUNIQUE(cv), but
690 * ideally, we should detect my's declared within loops
691 * etc - this would allow a wider range of 'not stayed
692 * shared' warnings. We also treated alreadly-compiled
693 * lexes as not multi as viewed from evals. */
695 *out_flags = CvANON(cv) ?
697 (!CvUNIQUE(cv) && ! CvCOMPILED(cv))
698 ? PAD_FAKELEX_MULTI : 0;
700 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
701 "Pad findlex cv=0x%"UVxf" matched: offset=%ld (%ld,%ld)\n",
702 PTR2UV(cv), (long)offset, (long)U_32(SvNVX(*out_name_sv)),
703 (long)SvIVX(*out_name_sv)));
705 else { /* fake match */
706 offset = fake_offset;
707 *out_name_sv = name_svp[offset]; /* return the namesv */
708 *out_flags = SvIVX(*out_name_sv);
709 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
710 "Pad findlex cv=0x%"UVxf" matched: offset=%ld flags=0x%lx index=%lu\n",
711 PTR2UV(cv), (long)offset, (unsigned long)*out_flags,
712 (unsigned long)SvNVX(*out_name_sv)
716 /* return the lex? */
721 if ((SvFLAGS(*out_name_sv) & SVpad_OUR)) {
722 *out_capture = Nullsv;
726 /* trying to capture from an anon prototype? */
728 ? CvANON(cv) && CvCLONE(cv) && !CvCLONED(cv)
729 : *out_flags & PAD_FAKELEX_ANON)
731 if (warn && ckWARN(WARN_CLOSURE))
732 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
733 "Variable \"%s\" is not available", name);
734 *out_capture = Nullsv;
740 if (!CvCOMPILED(cv) && (*out_flags & PAD_FAKELEX_MULTI)
741 && warn && ckWARN(WARN_CLOSURE)) {
743 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
744 "Variable \"%s\" will not stay shared", name);
747 if (fake_offset && CvANON(cv)
748 && CvCLONE(cv) &&!CvCLONED(cv))
751 /* not yet caught - look further up */
752 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
753 "Pad findlex cv=0x%"UVxf" chasing lex in outer pad\n",
756 pad_findlex(name, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv),
757 newwarn, out_capture, out_name_sv, out_flags);
762 *out_capture = AvARRAY((AV*)AvARRAY(padlist)[
763 CvDEPTH(cv) ? CvDEPTH(cv) : 1])[offset];
764 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
765 "Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n",
766 PTR2UV(cv), PTR2UV(*out_capture)));
768 if (SvPADSTALE(*out_capture)) {
769 if (ckWARN(WARN_CLOSURE))
770 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
771 "Variable \"%s\" is not available", name);
772 *out_capture = Nullsv;
777 *out_capture = sv_2mortal((SV*)newAV());
778 else if (*name == '%')
779 *out_capture = sv_2mortal((SV*)newHV());
781 *out_capture = sv_newmortal();
789 /* it's not in this pad - try above */
794 /* out_capture non-null means caller wants us to capture lex; in
795 * addition we capture ourselves unless it's an ANON/format */
796 new_capturep = out_capture ? out_capture :
797 CvLATE(cv) ? Null(SV**) : &new_capture;
799 offset = pad_findlex(name, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1,
800 new_capturep, out_name_sv, out_flags);
801 if (offset == NOT_IN_PAD)
804 /* found in an outer CV. Add appropriate fake entry to this pad */
806 /* don't add new fake entries (via eval) to CVs that we have already
807 * finished compiling, or to undef CVs */
808 if (CvCOMPILED(cv) || !padlist)
809 return 0; /* this dummy (and invalid) value isnt used by the caller */
813 AV * const ocomppad_name = PL_comppad_name;
814 PAD * const ocomppad = PL_comppad;
815 PL_comppad_name = (AV*)AvARRAY(padlist)[0];
816 PL_comppad = (AV*)AvARRAY(padlist)[1];
817 PL_curpad = AvARRAY(PL_comppad);
819 new_offset = pad_add_name(
820 SvPVX_const(*out_name_sv),
821 (SvFLAGS(*out_name_sv) & SVpad_TYPED)
822 ? SvSTASH(*out_name_sv) : Nullhv,
823 (SvFLAGS(*out_name_sv) & SVpad_OUR)
824 ? GvSTASH(*out_name_sv) : Nullhv,
828 new_namesv = AvARRAY(PL_comppad_name)[new_offset];
829 SvIV_set(new_namesv, *out_flags);
831 SvNV_set(new_namesv, (NV)0);
832 if (SvFLAGS(new_namesv) & SVpad_OUR) {
835 else if (CvLATE(cv)) {
836 /* delayed creation - just note the offset within parent pad */
837 SvNV_set(new_namesv, (NV)offset);
841 /* immediate creation - capture outer value right now */
842 av_store(PL_comppad, new_offset, SvREFCNT_inc(*new_capturep));
843 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
844 "Pad findlex cv=0x%"UVxf" saved captured sv 0x%"UVxf" at offset %ld\n",
845 PTR2UV(cv), PTR2UV(*new_capturep), (long)new_offset));
847 *out_name_sv = new_namesv;
848 *out_flags = SvIVX(new_namesv);
850 PL_comppad_name = ocomppad_name;
851 PL_comppad = ocomppad;
852 PL_curpad = ocomppad ? AvARRAY(ocomppad) : Null(SV **);
861 Get the value at offset po in the current pad.
862 Use macro PAD_SV instead of calling this function directly.
869 Perl_pad_sv(pTHX_ PADOFFSET po)
871 ASSERT_CURPAD_ACTIVE("pad_sv");
874 Perl_croak(aTHX_ "panic: pad_sv po");
875 DEBUG_X(PerlIO_printf(Perl_debug_log,
876 "Pad 0x%"UVxf"[0x%"UVxf"] sv: %ld sv=0x%"UVxf"\n",
877 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(PL_curpad[po]))
879 return PL_curpad[po];
884 =for apidoc pad_setsv
886 Set the entry at offset po in the current pad to sv.
887 Use the macro PAD_SETSV() rather than calling this function directly.
894 Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
896 ASSERT_CURPAD_ACTIVE("pad_setsv");
898 DEBUG_X(PerlIO_printf(Perl_debug_log,
899 "Pad 0x%"UVxf"[0x%"UVxf"] setsv: %ld sv=0x%"UVxf"\n",
900 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(sv))
909 =for apidoc pad_block_start
911 Update the pad compilation state variables on entry to a new block
917 * - integrate this in general state-saving routine ???
918 * - combine with the state-saving going on in pad_new ???
919 * - introduce a new SAVE type that does all this in one go ?
923 Perl_pad_block_start(pTHX_ int full)
925 ASSERT_CURPAD_ACTIVE("pad_block_start");
926 SAVEI32(PL_comppad_name_floor);
927 PL_comppad_name_floor = AvFILLp(PL_comppad_name);
929 PL_comppad_name_fill = PL_comppad_name_floor;
930 if (PL_comppad_name_floor < 0)
931 PL_comppad_name_floor = 0;
932 SAVEI32(PL_min_intro_pending);
933 SAVEI32(PL_max_intro_pending);
934 PL_min_intro_pending = 0;
935 SAVEI32(PL_comppad_name_fill);
936 SAVEI32(PL_padix_floor);
937 PL_padix_floor = PL_padix;
938 PL_pad_reset_pending = FALSE;
945 "Introduce" my variables to visible status.
956 ASSERT_CURPAD_ACTIVE("intro_my");
957 if (! PL_min_intro_pending)
958 return PL_cop_seqmax;
960 svp = AvARRAY(PL_comppad_name);
961 for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
962 SV * const sv = svp[i];
964 if (sv && sv != &PL_sv_undef && !SvFAKE(sv) && !SvIVX(sv)) {
965 SvIV_set(sv, PAD_MAX); /* Don't know scope end yet. */
966 SvNV_set(sv, (NV)PL_cop_seqmax);
967 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
968 "Pad intromy: %ld \"%s\", (%ld,%ld)\n",
969 (long)i, SvPVX_const(sv),
970 (long)U_32(SvNVX(sv)), (long)SvIVX(sv))
974 PL_min_intro_pending = 0;
975 PL_comppad_name_fill = PL_max_intro_pending; /* Needn't search higher */
976 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
977 "Pad intromy: seq -> %ld\n", (long)(PL_cop_seqmax+1)));
979 return PL_cop_seqmax++;
983 =for apidoc pad_leavemy
985 Cleanup at end of scope during compilation: set the max seq number for
986 lexicals in this scope and warn of any lexicals that never got introduced.
992 Perl_pad_leavemy(pTHX)
995 SV ** const svp = AvARRAY(PL_comppad_name);
997 PL_pad_reset_pending = FALSE;
999 ASSERT_CURPAD_ACTIVE("pad_leavemy");
1000 if (PL_min_intro_pending && PL_comppad_name_fill < PL_min_intro_pending) {
1001 for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
1002 const SV * const sv = svp[off];
1003 if (sv && sv != &PL_sv_undef
1004 && !SvFAKE(sv) && ckWARN_d(WARN_INTERNAL))
1005 Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
1006 "%"SVf" never introduced", sv);
1009 /* "Deintroduce" my variables that are leaving with this scope. */
1010 for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_fill; off--) {
1011 const SV * const sv = svp[off];
1012 if (sv && sv != &PL_sv_undef && !SvFAKE(sv) && SvIVX(sv) == PAD_MAX) {
1013 SvIV_set(sv, PL_cop_seqmax);
1014 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1015 "Pad leavemy: %ld \"%s\", (%ld,%ld)\n",
1016 (long)off, SvPVX_const(sv),
1017 (long)U_32(SvNVX(sv)), (long)SvIVX(sv))
1022 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1023 "Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax));
1028 =for apidoc pad_swipe
1030 Abandon the tmp in the current pad at offset po and replace with a
1037 Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
1039 ASSERT_CURPAD_LEGAL("pad_swipe");
1042 if (AvARRAY(PL_comppad) != PL_curpad)
1043 Perl_croak(aTHX_ "panic: pad_swipe curpad");
1045 Perl_croak(aTHX_ "panic: pad_swipe po");
1047 DEBUG_X(PerlIO_printf(Perl_debug_log,
1048 "Pad 0x%"UVxf"[0x%"UVxf"] swipe: %ld\n",
1049 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po));
1052 SvPADTMP_off(PL_curpad[po]);
1054 SvREFCNT_dec(PL_curpad[po]);
1057 /* if pad tmps aren't shared between ops, then there's no need to
1058 * create a new tmp when an existing op is freed */
1059 #ifdef USE_BROKEN_PAD_RESET
1060 PL_curpad[po] = NEWSV(1107,0);
1061 SvPADTMP_on(PL_curpad[po]);
1063 PL_curpad[po] = &PL_sv_undef;
1065 if ((I32)po < PL_padix)
1071 =for apidoc pad_reset
1073 Mark all the current temporaries for reuse
1078 /* XXX pad_reset() is currently disabled because it results in serious bugs.
1079 * It causes pad temp TARGs to be shared between OPs. Since TARGs are pushed
1080 * on the stack by OPs that use them, there are several ways to get an alias
1081 * to a shared TARG. Such an alias will change randomly and unpredictably.
1082 * We avoid doing this until we can think of a Better Way.
1085 Perl_pad_reset(pTHX)
1087 #ifdef USE_BROKEN_PAD_RESET
1088 if (AvARRAY(PL_comppad) != PL_curpad)
1089 Perl_croak(aTHX_ "panic: pad_reset curpad");
1091 DEBUG_X(PerlIO_printf(Perl_debug_log,
1092 "Pad 0x%"UVxf"[0x%"UVxf"] reset: padix %ld -> %ld",
1093 PTR2UV(PL_comppad), PTR2UV(PL_curpad),
1094 (long)PL_padix, (long)PL_padix_floor
1098 if (!PL_tainting) { /* Can't mix tainted and non-tainted temporaries. */
1100 for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
1101 if (PL_curpad[po] && !SvIMMORTAL(PL_curpad[po]))
1102 SvPADTMP_off(PL_curpad[po]);
1104 PL_padix = PL_padix_floor;
1107 PL_pad_reset_pending = FALSE;
1112 =for apidoc pad_tidy
1114 Tidy up a pad after we've finished compiling it:
1115 * remove most stuff from the pads of anonsub prototypes;
1117 * mark tmps as such.
1122 /* XXX DAPM surely most of this stuff should be done properly
1123 * at the right time beforehand, rather than going around afterwards
1124 * cleaning up our mistakes ???
1128 Perl_pad_tidy(pTHX_ padtidy_type type)
1132 ASSERT_CURPAD_ACTIVE("pad_tidy");
1134 /* If this CV has had any 'eval-capable' ops planted in it
1135 * (ie it contains eval '...', //ee, /$var/ or /(?{..})/), Then any
1136 * anon prototypes in the chain of CVs should be marked as cloneable,
1137 * so that for example the eval's CV in C<< sub { eval '$x' } >> gets
1138 * the right CvOUTSIDE.
1139 * If running with -d, *any* sub may potentially have an eval
1140 * excuted within it.
1143 if (PL_cv_has_eval || PL_perldb) {
1145 for (cv = PL_compcv ;cv; cv = CvOUTSIDE(cv)) {
1146 if (cv != PL_compcv && CvCOMPILED(cv))
1147 break; /* no need to mark already-compiled code */
1149 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1150 "Pad clone on cv=0x%"UVxf"\n", PTR2UV(cv)));
1156 /* extend curpad to match namepad */
1157 if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
1158 av_store(PL_comppad_name, AvFILLp(PL_comppad), Nullsv);
1160 if (type == padtidy_SUBCLONE) {
1161 SV ** const namep = AvARRAY(PL_comppad_name);
1164 for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1167 if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
1170 * The only things that a clonable function needs in its
1171 * pad are anonymous subs.
1172 * The rest are created anew during cloning.
1174 if (!((namesv = namep[ix]) != Nullsv &&
1175 namesv != &PL_sv_undef &&
1176 *SvPVX_const(namesv) == '&'))
1178 SvREFCNT_dec(PL_curpad[ix]);
1179 PL_curpad[ix] = Nullsv;
1183 else if (type == padtidy_SUB) {
1184 /* XXX DAPM this same bit of code keeps appearing !!! Rationalise? */
1185 AV * const av = newAV(); /* Will be @_ */
1187 av_store(PL_comppad, 0, (SV*)av);
1191 /* XXX DAPM rationalise these two similar branches */
1193 if (type == padtidy_SUB) {
1195 for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1196 if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
1198 if (!SvPADMY(PL_curpad[ix]))
1199 SvPADTMP_on(PL_curpad[ix]);
1202 else if (type == padtidy_FORMAT) {
1204 for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1205 if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix]))
1206 SvPADTMP_on(PL_curpad[ix]);
1209 PL_curpad = AvARRAY(PL_comppad);
1214 =for apidoc pad_free
1216 Free the SV at offet po in the current pad.
1221 /* XXX DAPM integrate with pad_swipe ???? */
1223 Perl_pad_free(pTHX_ PADOFFSET po)
1225 ASSERT_CURPAD_LEGAL("pad_free");
1228 if (AvARRAY(PL_comppad) != PL_curpad)
1229 Perl_croak(aTHX_ "panic: pad_free curpad");
1231 Perl_croak(aTHX_ "panic: pad_free po");
1233 DEBUG_X(PerlIO_printf(Perl_debug_log,
1234 "Pad 0x%"UVxf"[0x%"UVxf"] free: %ld\n",
1235 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po)
1238 if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
1239 SvPADTMP_off(PL_curpad[po]);
1241 /* SV could be a shared hash key (eg bugid #19022) */
1243 #ifdef PERL_OLD_COPY_ON_WRITE
1244 !SvIsCOW(PL_curpad[po])
1246 !SvFAKE(PL_curpad[po])
1249 SvREADONLY_off(PL_curpad[po]); /* could be a freed constant */
1252 if ((I32)po < PL_padix)
1259 =for apidoc do_dump_pad
1261 Dump the contents of a padlist
1267 Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
1278 pad_name = (AV*)*av_fetch((AV*)padlist, 0, FALSE);
1279 pad = (AV*)*av_fetch((AV*)padlist, 1, FALSE);
1280 pname = AvARRAY(pad_name);
1281 ppad = AvARRAY(pad);
1282 Perl_dump_indent(aTHX_ level, file,
1283 "PADNAME = 0x%"UVxf"(0x%"UVxf") PAD = 0x%"UVxf"(0x%"UVxf")\n",
1284 PTR2UV(pad_name), PTR2UV(pname), PTR2UV(pad), PTR2UV(ppad)
1287 for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
1288 const SV *namesv = pname[ix];
1289 if (namesv && namesv == &PL_sv_undef) {
1294 Perl_dump_indent(aTHX_ level+1, file,
1295 "%2d. 0x%"UVxf"<%lu> FAKE \"%s\" flags=0x%lx index=%lu\n",
1298 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
1299 SvPVX_const(namesv),
1300 (unsigned long)SvIVX(namesv),
1301 (unsigned long)SvNVX(namesv)
1305 Perl_dump_indent(aTHX_ level+1, file,
1306 "%2d. 0x%"UVxf"<%lu> (%ld,%ld) \"%s\"\n",
1309 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
1310 (long)U_32(SvNVX(namesv)),
1311 (long)SvIVX(namesv),
1316 Perl_dump_indent(aTHX_ level+1, file,
1317 "%2d. 0x%"UVxf"<%lu>\n",
1320 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0)
1331 dump the contents of a CV
1338 S_cv_dump(pTHX_ const CV *cv, const char *title)
1340 const CV * const outside = CvOUTSIDE(cv);
1341 AV* const padlist = CvPADLIST(cv);
1343 PerlIO_printf(Perl_debug_log,
1344 " %s: CV=0x%"UVxf" (%s), OUTSIDE=0x%"UVxf" (%s)\n",
1347 (CvANON(cv) ? "ANON"
1348 : (SvTYPE(cv) == SVt_PVFM) ? "FORMAT"
1349 : (cv == PL_main_cv) ? "MAIN"
1350 : CvUNIQUE(cv) ? "UNIQUE"
1351 : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
1354 : CvANON(outside) ? "ANON"
1355 : (outside == PL_main_cv) ? "MAIN"
1356 : CvUNIQUE(outside) ? "UNIQUE"
1357 : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
1359 PerlIO_printf(Perl_debug_log,
1360 " PADLIST = 0x%"UVxf"\n", PTR2UV(padlist));
1361 do_dump_pad(1, Perl_debug_log, padlist, 1);
1363 #endif /* DEBUGGING */
1370 =for apidoc cv_clone
1372 Clone a CV: make a new CV which points to the same code etc, but which
1373 has a newly-created pad built by copying the prototype pad and capturing
1380 Perl_cv_clone(pTHX_ CV *proto)
1384 AV* const protopadlist = CvPADLIST(proto);
1385 const AV* const protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
1386 const AV* const protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
1387 SV** const pname = AvARRAY(protopad_name);
1388 SV** const ppad = AvARRAY(protopad);
1389 const I32 fname = AvFILLp(protopad_name);
1390 const I32 fpad = AvFILLp(protopad);
1396 assert(!CvUNIQUE(proto));
1398 /* Since cloneable anon subs can be nested, CvOUTSIDE may point
1399 * to a prototype; we instead want the cloned parent who called us.
1400 * Note that in general for formats, CvOUTSIDE != find_runcv */
1402 outside = CvOUTSIDE(proto);
1403 if (outside && CvCLONE(outside) && ! CvCLONED(outside))
1404 outside = find_runcv(NULL);
1405 depth = CvDEPTH(outside);
1406 assert(depth || SvTYPE(proto) == SVt_PVFM);
1409 assert(CvPADLIST(outside));
1412 SAVESPTR(PL_compcv);
1414 cv = PL_compcv = (CV*)NEWSV(1104, 0);
1415 sv_upgrade((SV *)cv, SvTYPE(proto));
1416 CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE);
1420 CvFILE(cv) = CvXSUB(proto) ? CvFILE(proto)
1421 : savepv(CvFILE(proto));
1423 CvFILE(cv) = CvFILE(proto);
1425 CvGV(cv) = CvGV(proto);
1426 CvSTASH(cv) = CvSTASH(proto);
1428 CvROOT(cv) = OpREFCNT_inc(CvROOT(proto));
1430 CvSTART(cv) = CvSTART(proto);
1431 CvOUTSIDE(cv) = (CV*)SvREFCNT_inc(outside);
1432 CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
1435 sv_setpvn((SV*)cv, SvPVX_const(proto), SvCUR(proto));
1437 CvPADLIST(cv) = pad_new(padnew_CLONE|padnew_SAVE);
1439 av_fill(PL_comppad, fpad);
1440 for (ix = fname; ix >= 0; ix--)
1441 av_store(PL_comppad_name, ix, SvREFCNT_inc(pname[ix]));
1443 PL_curpad = AvARRAY(PL_comppad);
1445 outpad = AvARRAY(AvARRAY(CvPADLIST(outside))[depth]);
1447 for (ix = fpad; ix > 0; ix--) {
1448 SV* const namesv = (ix <= fname) ? pname[ix] : Nullsv;
1450 if (namesv && namesv != &PL_sv_undef) { /* lexical */
1451 if (SvFAKE(namesv)) { /* lexical from outside? */
1452 sv = outpad[(I32)SvNVX(namesv)];
1454 /* formats may have an inactive parent */
1455 if (SvTYPE(proto) == SVt_PVFM && SvPADSTALE(sv)) {
1456 if (ckWARN(WARN_CLOSURE))
1457 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
1458 "Variable \"%s\" is not available", SvPVX_const(namesv));
1462 assert(!SvPADSTALE(sv));
1463 sv = SvREFCNT_inc(sv);
1467 const char sigil = SvPVX_const(namesv)[0];
1469 sv = SvREFCNT_inc(ppad[ix]);
1470 else if (sigil == '@')
1472 else if (sigil == '%')
1479 else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) {
1480 sv = SvREFCNT_inc(ppad[ix]);
1490 PerlIO_printf(Perl_debug_log, "\nPad CV clone\n");
1491 cv_dump(outside, "Outside");
1492 cv_dump(proto, "Proto");
1499 /* Constant sub () { $x } closing over $x - see lib/constant.pm:
1500 * The prototype was marked as a candiate for const-ization,
1501 * so try to grab the current const value, and if successful,
1502 * turn into a const sub:
1504 SV* const_sv = op_const_sv(CvSTART(cv), cv);
1507 cv = newCONSTSUB(CvSTASH(proto), 0, const_sv);
1519 =for apidoc pad_fixup_inner_anons
1521 For any anon CVs in the pad, change CvOUTSIDE of that CV from
1522 old_cv to new_cv if necessary. Needed when a newly-compiled CV has to be
1523 moved to a pre-existing CV struct.
1529 Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
1532 AV * const comppad_name = (AV*)AvARRAY(padlist)[0];
1533 AV * const comppad = (AV*)AvARRAY(padlist)[1];
1534 SV ** const namepad = AvARRAY(comppad_name);
1535 SV ** const curpad = AvARRAY(comppad);
1536 for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
1537 const SV *namesv = namepad[ix];
1538 if (namesv && namesv != &PL_sv_undef
1539 && *SvPVX_const(namesv) == '&')
1541 CV *innercv = (CV*)curpad[ix];
1542 assert(CvWEAKOUTSIDE(innercv));
1543 assert(CvOUTSIDE(innercv) == old_cv);
1544 CvOUTSIDE(innercv) = new_cv;
1551 =for apidoc pad_push
1553 Push a new pad frame onto the padlist, unless there's already a pad at
1554 this depth, in which case don't bother creating a new one. Then give
1555 the new pad an @_ in slot zero.
1561 Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
1563 if (depth <= AvFILLp(padlist))
1567 SV** svp = AvARRAY(padlist);
1568 AV *newpad = newAV();
1569 SV **oldpad = AvARRAY(svp[depth-1]);
1570 I32 ix = AvFILLp((AV*)svp[1]);
1571 const I32 names_fill = AvFILLp((AV*)svp[0]);
1572 SV** names = AvARRAY(svp[0]);
1575 for ( ;ix > 0; ix--) {
1576 if (names_fill >= ix && names[ix] != &PL_sv_undef) {
1577 const char sigil = SvPVX_const(names[ix])[0];
1578 if ((SvFLAGS(names[ix]) & SVf_FAKE) || sigil == '&') {
1579 /* outer lexical or anon code */
1580 av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]));
1582 else { /* our own lexical */
1586 else if (sigil == '%')
1590 av_store(newpad, ix, sv);
1594 else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
1595 av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]));
1598 /* save temporaries on recursion? */
1599 SV *sv = NEWSV(0, 0);
1600 av_store(newpad, ix, sv);
1606 av_store(newpad, 0, (SV*)av);
1609 av_store(padlist, depth, (SV*)newpad);
1610 AvFILLp(padlist) = depth;
1616 Perl_pad_compname_type(pTHX_ const PADOFFSET po)
1618 SV** const av = av_fetch(PL_comppad_name, po, FALSE);
1619 if ( SvFLAGS(*av) & SVpad_TYPED ) {
1620 return SvSTASH(*av);
1627 * c-indentation-style: bsd
1629 * indent-tabs-mode: t
1632 * ex: set ts=8 sts=4 sw=4 noet: