3 * Copyright (C) 2002, 2003, 2004, 2005, 2006, 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 also SVt_PVMG, with the OURSTASH slot
78 pointing at the stash of the associated global (so that duplicate C<our>
79 declarations in the same package can be detected). SvCUR is sometimes
80 hijacked to 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
112 #include "keywords.h"
115 #define PAD_MAX 999999999
118 void pad_peg(const char* s) {
127 Create a new compiling padlist, saving and updating the various global
128 vars at the same time as creating the pad itself. The following flags
129 can be OR'ed together:
131 padnew_CLONE this pad is for a cloned CV
132 padnew_SAVE save old globals
133 padnew_SAVESUB also save extra stuff for start of sub
139 Perl_pad_new(pTHX_ int flags)
142 AV *padlist, *padname, *pad;
144 ASSERT_CURPAD_LEGAL("pad_new");
146 /* XXX DAPM really need a new SAVEt_PAD which restores all or most
147 * vars (based on flags) rather than storing vals + addresses for
148 * each individually. Also see pad_block_start.
149 * XXX DAPM Try to see whether all these conditionals are required
152 /* save existing state, ... */
154 if (flags & padnew_SAVE) {
156 SAVESPTR(PL_comppad_name);
157 if (! (flags & padnew_CLONE)) {
159 SAVEI32(PL_comppad_name_fill);
160 SAVEI32(PL_min_intro_pending);
161 SAVEI32(PL_max_intro_pending);
162 SAVEI32(PL_cv_has_eval);
163 if (flags & padnew_SAVESUB) {
164 SAVEI32(PL_pad_reset_pending);
168 /* XXX DAPM interestingly, PL_comppad_name_floor never seems to be
169 * saved - check at some pt that this is okay */
171 /* ... create new pad ... */
177 if (flags & padnew_CLONE) {
178 /* XXX DAPM I dont know why cv_clone needs it
179 * doing differently yet - perhaps this separate branch can be
180 * dispensed with eventually ???
183 AV * const a0 = newAV(); /* will be @_ */
185 av_store(pad, 0, (SV*)a0);
189 av_store(pad, 0, NULL);
193 av_store(padlist, 0, (SV*)padname);
194 av_store(padlist, 1, (SV*)pad);
196 /* ... then update state variables */
198 PL_comppad_name = (AV*)(*av_fetch(padlist, 0, FALSE));
199 PL_comppad = (AV*)(*av_fetch(padlist, 1, FALSE));
200 PL_curpad = AvARRAY(PL_comppad);
202 if (! (flags & padnew_CLONE)) {
203 PL_comppad_name_fill = 0;
204 PL_min_intro_pending = 0;
209 DEBUG_X(PerlIO_printf(Perl_debug_log,
210 "Pad 0x%"UVxf"[0x%"UVxf"] new: compcv=0x%"UVxf
211 " name=0x%"UVxf" flags=0x%"UVxf"\n",
212 PTR2UV(PL_comppad), PTR2UV(PL_curpad), PTR2UV(PL_compcv),
213 PTR2UV(padname), (UV)flags
217 return (PADLIST*)padlist;
221 =for apidoc pad_undef
223 Free the padlist associated with a CV.
224 If parts of it happen to be current, we null the relevant
225 PL_*pad* global vars so that we don't have any dangling references left.
226 We also repoint the CvOUTSIDE of any about-to-be-orphaned
227 inner subs to the outer of this cv.
229 (This function should really be called pad_free, but the name was already
236 Perl_pad_undef(pTHX_ CV* cv)
240 const PADLIST * const padlist = CvPADLIST(cv);
242 pad_peg("pad_undef");
245 if (SvIS_FREED(padlist)) /* may be during global destruction */
248 DEBUG_X(PerlIO_printf(Perl_debug_log,
249 "Pad undef: cv=0x%"UVxf" padlist=0x%"UVxf"\n",
250 PTR2UV(cv), PTR2UV(padlist))
253 /* detach any '&' anon children in the pad; if afterwards they
254 * are still live, fix up their CvOUTSIDEs to point to our outside,
256 /* XXX DAPM for efficiency, we should only do this if we know we have
257 * children, or integrate this loop with general cleanup */
259 if (!PL_dirty) { /* don't bother during global destruction */
260 CV * const outercv = CvOUTSIDE(cv);
261 const U32 seq = CvOUTSIDE_SEQ(cv);
262 AV * const comppad_name = (AV*)AvARRAY(padlist)[0];
263 SV ** const namepad = AvARRAY(comppad_name);
264 AV * const comppad = (AV*)AvARRAY(padlist)[1];
265 SV ** const curpad = AvARRAY(comppad);
266 for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
267 SV * const namesv = namepad[ix];
268 if (namesv && namesv != &PL_sv_undef
269 && *SvPVX_const(namesv) == '&')
271 CV * const innercv = (CV*)curpad[ix];
272 U32 inner_rc = SvREFCNT(innercv);
275 SvREFCNT_dec(namesv);
277 if (SvREFCNT(comppad) < 2) { /* allow for /(?{ sub{} })/ */
279 SvREFCNT_dec(innercv);
283 /* in use, not just a prototype */
284 if (inner_rc && (CvOUTSIDE(innercv) == cv)) {
285 assert(CvWEAKOUTSIDE(innercv));
286 /* don't relink to grandfather if he's being freed */
287 if (outercv && SvREFCNT(outercv)) {
288 CvWEAKOUTSIDE_off(innercv);
289 CvOUTSIDE(innercv) = outercv;
290 CvOUTSIDE_SEQ(innercv) = seq;
291 SvREFCNT_inc_simple_void_NN(outercv);
294 CvOUTSIDE(innercv) = NULL;
301 ix = AvFILLp(padlist);
303 const SV* const sv = AvARRAY(padlist)[ix--];
305 if (sv == (SV*)PL_comppad_name)
306 PL_comppad_name = NULL;
307 else if (sv == (SV*)PL_comppad) {
314 SvREFCNT_dec((SV*)CvPADLIST(cv));
315 CvPADLIST(cv) = NULL;
322 =for apidoc pad_add_name
324 Create a new name and associated PADMY SV in the current pad; return the
326 If C<typestash> is valid, the name is for a typed lexical; set the
327 name's stash to that value.
328 If C<ourstash> is valid, it's an our lexical, set the name's
329 OURSTASH to that value
331 If fake, it means we're cloning an existing entry
337 Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake, bool state)
340 const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
341 SV* const namesv = newSV(0);
343 ASSERT_CURPAD_ACTIVE("pad_add_name");
346 sv_upgrade(namesv, (ourstash || typestash) ? SVt_PVMG : SVt_PVNV);
347 sv_setpv(namesv, name);
350 assert(SvTYPE(namesv) == SVt_PVMG);
351 SvPAD_TYPED_on(namesv);
352 SvSTASH_set(namesv, (HV*)SvREFCNT_inc_simple_NN((SV*)typestash));
355 SvPAD_OUR_on(namesv);
356 OURSTASH_set(namesv, ourstash);
357 SvREFCNT_inc_simple_void_NN(ourstash);
360 SvPAD_STATE_on(namesv);
363 av_store(PL_comppad_name, offset, namesv);
366 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
367 "Pad addname: %ld \"%s\" FAKE\n", (long)offset, name));
370 /* not yet introduced */
371 SvNV_set(namesv, (NV)PAD_MAX); /* min */
372 SvIV_set(namesv, 0); /* max */
374 if (!PL_min_intro_pending)
375 PL_min_intro_pending = offset;
376 PL_max_intro_pending = offset;
377 /* if it's not a simple scalar, replace with an AV or HV */
378 /* XXX DAPM since slot has been allocated, replace
379 * av_store with PL_curpad[offset] ? */
381 av_store(PL_comppad, offset, (SV*)newAV());
382 else if (*name == '%')
383 av_store(PL_comppad, offset, (SV*)newHV());
384 SvPADMY_on(PL_curpad[offset]);
385 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
386 "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
387 (long)offset, name, PTR2UV(PL_curpad[offset])));
397 =for apidoc pad_alloc
399 Allocate a new my or tmp pad entry. For a my, simply push a null SV onto
400 the end of PL_comppad, but for a tmp, scan the pad from PL_padix upwards
401 for a slot which has no name and no active value.
406 /* XXX DAPM integrate alloc(), add_name() and add_anon(),
407 * or at least rationalise ??? */
408 /* And flag whether the incoming name is UTF8 or 8 bit?
409 Could do this either with the +ve/-ve hack of the HV code, or expanding
410 the flag bits. Either way, this makes proper Unicode safe pad support.
411 Also could change the sv structure to make the NV a union with 2 U32s,
412 so that SvCUR() could stop being overloaded in pad SVs.
417 Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
423 PERL_UNUSED_ARG(optype);
424 ASSERT_CURPAD_ACTIVE("pad_alloc");
426 if (AvARRAY(PL_comppad) != PL_curpad)
427 Perl_croak(aTHX_ "panic: pad_alloc");
428 if (PL_pad_reset_pending)
430 if (tmptype & SVs_PADMY) {
431 sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE);
432 retval = AvFILLp(PL_comppad);
435 SV * const * const names = AvARRAY(PL_comppad_name);
436 const SSize_t names_fill = AvFILLp(PL_comppad_name);
439 * "foreach" index vars temporarily become aliases to non-"my"
440 * values. Thus we must skip, not just pad values that are
441 * marked as current pad values, but also those with names.
443 /* HVDS why copy to sv here? we don't seem to use it */
444 if (++PL_padix <= names_fill &&
445 (sv = names[PL_padix]) && sv != &PL_sv_undef)
447 sv = *av_fetch(PL_comppad, PL_padix, TRUE);
448 if (!(SvFLAGS(sv) & (SVs_PADTMP | SVs_PADMY)) &&
449 !IS_PADGV(sv) && !IS_PADCONST(sv))
454 SvFLAGS(sv) |= tmptype;
455 PL_curpad = AvARRAY(PL_comppad);
457 DEBUG_X(PerlIO_printf(Perl_debug_log,
458 "Pad 0x%"UVxf"[0x%"UVxf"] alloc: %ld for %s\n",
459 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long) retval,
460 PL_op_name[optype]));
461 #ifdef DEBUG_LEAKING_SCALARS
462 sv->sv_debug_optype = optype;
463 sv->sv_debug_inpad = 1;
465 return (PADOFFSET)retval;
469 =for apidoc pad_add_anon
471 Add an anon code entry to the current compiling pad
477 Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
481 SV* const name = newSV(0);
483 sv_upgrade(name, SVt_PVNV);
484 sv_setpvn(name, "&", 1);
487 ix = pad_alloc(op_type, SVs_PADMY);
488 av_store(PL_comppad_name, ix, name);
489 /* XXX DAPM use PL_curpad[] ? */
490 av_store(PL_comppad, ix, sv);
493 /* to avoid ref loops, we never have parent + child referencing each
494 * other simultaneously */
495 if (CvOUTSIDE((CV*)sv)) {
496 assert(!CvWEAKOUTSIDE((CV*)sv));
497 CvWEAKOUTSIDE_on((CV*)sv);
498 SvREFCNT_dec(CvOUTSIDE((CV*)sv));
506 =for apidoc pad_check_dup
508 Check for duplicate declarations: report any of:
509 * a my in the current scope with the same name;
510 * an our (anywhere in the pad) with the same name and the same stash
512 C<is_our> indicates that the name to check is an 'our' declaration
517 /* XXX DAPM integrate this into pad_add_name ??? */
520 Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash)
526 ASSERT_CURPAD_ACTIVE("pad_check_dup");
527 if (AvFILLp(PL_comppad_name) < 0 || !ckWARN(WARN_MISC))
528 return; /* nothing to check */
530 svp = AvARRAY(PL_comppad_name);
531 top = AvFILLp(PL_comppad_name);
532 /* check the current scope */
533 /* XXX DAPM - why the (I32) cast - shouldn't we ensure they're the same
535 for (off = top; (I32)off > PL_comppad_name_floor; off--) {
536 SV * const sv = svp[off];
538 && sv != &PL_sv_undef
540 && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
541 && strEQ(name, SvPVX_const(sv)))
543 if (is_our && (SvPAD_OUR(sv)))
544 break; /* "our" masking "our" */
545 Perl_warner(aTHX_ packWARN(WARN_MISC),
546 "\"%s\" variable %s masks earlier declaration in same %s",
547 (is_our ? "our" : PL_in_my == KEY_my ? "my" : "state"),
549 (SvIVX(sv) == PAD_MAX ? "scope" : "statement"));
554 /* check the rest of the pad */
557 SV * const sv = svp[off];
559 && sv != &PL_sv_undef
561 && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
562 && OURSTASH(sv) == ourstash
563 && strEQ(name, SvPVX_const(sv)))
565 Perl_warner(aTHX_ packWARN(WARN_MISC),
566 "\"our\" variable %s redeclared", name);
567 if ((I32)off <= PL_comppad_name_floor)
568 Perl_warner(aTHX_ packWARN(WARN_MISC),
569 "\t(Did you mean \"local\" instead of \"our\"?)\n");
572 } while ( off-- > 0 );
578 =for apidoc pad_findmy
580 Given a lexical name, try to find its offset, first in the current pad,
581 or failing that, in the pads of any lexically enclosing subs (including
582 the complications introduced by eval). If the name is found in an outer pad,
583 then a fake entry is added to the current pad.
584 Returns the offset in the current pad, or NOT_IN_PAD on failure.
590 Perl_pad_findmy(pTHX_ const char *name)
599 pad_peg("pad_findmy");
600 offset = pad_findlex(name, PL_compcv, PL_cop_seqmax, 1,
601 NULL, &out_sv, &out_flags);
602 if ((PADOFFSET)offset != NOT_IN_PAD)
605 /* look for an our that's being introduced; this allows
606 * our $foo = 0 unless defined $foo;
607 * to not give a warning. (Yes, this is a hack) */
609 nameav = (AV*)AvARRAY(CvPADLIST(PL_compcv))[0];
610 name_svp = AvARRAY(nameav);
611 for (offset = AvFILLp(nameav); offset > 0; offset--) {
612 const SV * const namesv = name_svp[offset];
613 if (namesv && namesv != &PL_sv_undef
615 && (SvPAD_OUR(namesv))
616 && strEQ(SvPVX_const(namesv), name)
617 && U_32(SvNVX(namesv)) == PAD_MAX /* min */
625 * Returns the offset of a lexical $_, if there is one, at run time.
626 * Used by the UNDERBAR XS macro.
630 Perl_find_rundefsvoffset(pTHX)
635 return pad_findlex("$_", find_runcv(NULL), PL_curcop->cop_seq, 1,
636 NULL, &out_sv, &out_flags);
640 =for apidoc pad_findlex
642 Find a named lexical anywhere in a chain of nested pads. Add fake entries
643 in the inner pads if it's found in an outer one.
645 Returns the offset in the bottom pad of the lex or the fake lex.
646 cv is the CV in which to start the search, and seq is the current cop_seq
647 to match against. If warn is true, print appropriate warnings. The out_*
648 vars return values, and so are pointers to where the returned values
649 should be stored. out_capture, if non-null, requests that the innermost
650 instance of the lexical is captured; out_name_sv is set to the innermost
651 matched namesv or fake namesv; out_flags returns the flags normally
652 associated with the IVX field of a fake namesv.
654 Note that pad_findlex() is recursive; it recurses up the chain of CVs,
655 then comes back down, adding fake entries as it goes. It has to be this way
656 because fake namesvs in anon protoypes have to store in NVX the index into
662 /* Flags set in the SvIVX field of FAKE namesvs */
664 #define PAD_FAKELEX_ANON 1 /* the lex is declared in an ANON, or ... */
665 #define PAD_FAKELEX_MULTI 2 /* the lex can be instantiated multiple times */
667 /* the CV has finished being compiled. This is not a sufficient test for
668 * all CVs (eg XSUBs), but suffices for the CVs found in a lexical chain */
669 #define CvCOMPILED(cv) CvROOT(cv)
671 /* the CV does late binding of its lexicals */
672 #define CvLATE(cv) (CvANON(cv) || SvTYPE(cv) == SVt_PVFM)
676 S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
677 SV** out_capture, SV** out_name_sv, int *out_flags)
680 I32 offset, new_offset;
683 const AV * const padlist = CvPADLIST(cv);
687 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
688 "Pad findlex cv=0x%"UVxf" searching \"%s\" seq=%d%s\n",
689 PTR2UV(cv), name, (int)seq, out_capture ? " capturing" : "" ));
691 /* first, search this pad */
693 if (padlist) { /* not an undef CV */
695 const AV * const nameav = (AV*)AvARRAY(padlist)[0];
696 SV * const * const name_svp = AvARRAY(nameav);
698 for (offset = AvFILLp(nameav); offset > 0; offset--) {
699 const SV * const namesv = name_svp[offset];
700 if (namesv && namesv != &PL_sv_undef
701 && strEQ(SvPVX_const(namesv), name))
704 fake_offset = offset; /* in case we don't find a real one */
705 else if ( seq > U_32(SvNVX(namesv)) /* min */
706 && seq <= (U32)SvIVX(namesv)) /* max */
711 if (offset > 0 || fake_offset > 0 ) { /* a match! */
712 if (offset > 0) { /* not fake */
714 *out_name_sv = name_svp[offset]; /* return the namesv */
716 /* set PAD_FAKELEX_MULTI if this lex can have multiple
717 * instances. For now, we just test !CvUNIQUE(cv), but
718 * ideally, we should detect my's declared within loops
719 * etc - this would allow a wider range of 'not stayed
720 * shared' warnings. We also treated alreadly-compiled
721 * lexes as not multi as viewed from evals. */
723 *out_flags = CvANON(cv) ?
725 (!CvUNIQUE(cv) && ! CvCOMPILED(cv))
726 ? PAD_FAKELEX_MULTI : 0;
728 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
729 "Pad findlex cv=0x%"UVxf" matched: offset=%ld (%ld,%ld)\n",
730 PTR2UV(cv), (long)offset, (long)U_32(SvNVX(*out_name_sv)),
731 (long)SvIVX(*out_name_sv)));
733 else { /* fake match */
734 offset = fake_offset;
735 *out_name_sv = name_svp[offset]; /* return the namesv */
736 *out_flags = SvIVX(*out_name_sv);
737 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
738 "Pad findlex cv=0x%"UVxf" matched: offset=%ld flags=0x%lx index=%lu\n",
739 PTR2UV(cv), (long)offset, (unsigned long)*out_flags,
740 (unsigned long)SvNVX(*out_name_sv)
744 /* return the lex? */
749 if (SvPAD_OUR(*out_name_sv)) {
754 /* trying to capture from an anon prototype? */
756 ? CvANON(cv) && CvCLONE(cv) && !CvCLONED(cv)
757 : *out_flags & PAD_FAKELEX_ANON)
759 if (warn && ckWARN(WARN_CLOSURE))
760 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
761 "Variable \"%s\" is not available", name);
768 if (!CvCOMPILED(cv) && (*out_flags & PAD_FAKELEX_MULTI)
769 && warn && ckWARN(WARN_CLOSURE)) {
771 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
772 "Variable \"%s\" will not stay shared", name);
775 if (fake_offset && CvANON(cv)
776 && CvCLONE(cv) &&!CvCLONED(cv))
779 /* not yet caught - look further up */
780 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
781 "Pad findlex cv=0x%"UVxf" chasing lex in outer pad\n",
784 (void) pad_findlex(name, CvOUTSIDE(cv),
786 newwarn, out_capture, out_name_sv, out_flags);
791 *out_capture = AvARRAY((AV*)AvARRAY(padlist)[
792 CvDEPTH(cv) ? CvDEPTH(cv) : 1])[offset];
793 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
794 "Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n",
795 PTR2UV(cv), PTR2UV(*out_capture)));
797 if (SvPADSTALE(*out_capture)) {
798 if (ckWARN(WARN_CLOSURE))
799 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
800 "Variable \"%s\" is not available", name);
806 *out_capture = sv_2mortal((SV*)newAV());
807 else if (*name == '%')
808 *out_capture = sv_2mortal((SV*)newHV());
810 *out_capture = sv_newmortal();
818 /* it's not in this pad - try above */
823 /* out_capture non-null means caller wants us to capture lex; in
824 * addition we capture ourselves unless it's an ANON/format */
825 new_capturep = out_capture ? out_capture :
826 CvLATE(cv) ? NULL : &new_capture;
828 offset = pad_findlex(name, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1,
829 new_capturep, out_name_sv, out_flags);
830 if ((PADOFFSET)offset == NOT_IN_PAD)
833 /* found in an outer CV. Add appropriate fake entry to this pad */
835 /* don't add new fake entries (via eval) to CVs that we have already
836 * finished compiling, or to undef CVs */
837 if (CvCOMPILED(cv) || !padlist)
838 return 0; /* this dummy (and invalid) value isnt used by the caller */
842 AV * const ocomppad_name = PL_comppad_name;
843 PAD * const ocomppad = PL_comppad;
844 PL_comppad_name = (AV*)AvARRAY(padlist)[0];
845 PL_comppad = (AV*)AvARRAY(padlist)[1];
846 PL_curpad = AvARRAY(PL_comppad);
848 new_offset = pad_add_name(
849 SvPVX_const(*out_name_sv),
850 SvPAD_TYPED(*out_name_sv)
851 ? SvSTASH(*out_name_sv) : NULL,
852 OURSTASH(*out_name_sv),
854 0 /* not a state variable */
857 new_namesv = AvARRAY(PL_comppad_name)[new_offset];
858 SvIV_set(new_namesv, *out_flags);
860 SvNV_set(new_namesv, (NV)0);
861 if (SvPAD_OUR(new_namesv)) {
862 NOOP; /* do nothing */
864 else if (CvLATE(cv)) {
865 /* delayed creation - just note the offset within parent pad */
866 SvNV_set(new_namesv, (NV)offset);
870 /* immediate creation - capture outer value right now */
871 av_store(PL_comppad, new_offset, SvREFCNT_inc(*new_capturep));
872 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
873 "Pad findlex cv=0x%"UVxf" saved captured sv 0x%"UVxf" at offset %ld\n",
874 PTR2UV(cv), PTR2UV(*new_capturep), (long)new_offset));
876 *out_name_sv = new_namesv;
877 *out_flags = SvIVX(new_namesv);
879 PL_comppad_name = ocomppad_name;
880 PL_comppad = ocomppad;
881 PL_curpad = ocomppad ? AvARRAY(ocomppad) : NULL;
891 Get the value at offset po in the current pad.
892 Use macro PAD_SV instead of calling this function directly.
899 Perl_pad_sv(pTHX_ PADOFFSET po)
902 ASSERT_CURPAD_ACTIVE("pad_sv");
905 Perl_croak(aTHX_ "panic: pad_sv po");
906 DEBUG_X(PerlIO_printf(Perl_debug_log,
907 "Pad 0x%"UVxf"[0x%"UVxf"] sv: %ld sv=0x%"UVxf"\n",
908 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(PL_curpad[po]))
910 return PL_curpad[po];
915 =for apidoc pad_setsv
917 Set the entry at offset po in the current pad to sv.
918 Use the macro PAD_SETSV() rather than calling this function directly.
924 Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
927 ASSERT_CURPAD_ACTIVE("pad_setsv");
929 DEBUG_X(PerlIO_printf(Perl_debug_log,
930 "Pad 0x%"UVxf"[0x%"UVxf"] setsv: %ld sv=0x%"UVxf"\n",
931 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(sv))
940 =for apidoc pad_block_start
942 Update the pad compilation state variables on entry to a new block
948 * - integrate this in general state-saving routine ???
949 * - combine with the state-saving going on in pad_new ???
950 * - introduce a new SAVE type that does all this in one go ?
954 Perl_pad_block_start(pTHX_ int full)
957 ASSERT_CURPAD_ACTIVE("pad_block_start");
958 SAVEI32(PL_comppad_name_floor);
959 PL_comppad_name_floor = AvFILLp(PL_comppad_name);
961 PL_comppad_name_fill = PL_comppad_name_floor;
962 if (PL_comppad_name_floor < 0)
963 PL_comppad_name_floor = 0;
964 SAVEI32(PL_min_intro_pending);
965 SAVEI32(PL_max_intro_pending);
966 PL_min_intro_pending = 0;
967 SAVEI32(PL_comppad_name_fill);
968 SAVEI32(PL_padix_floor);
969 PL_padix_floor = PL_padix;
970 PL_pad_reset_pending = FALSE;
977 "Introduce" my variables to visible status.
989 ASSERT_CURPAD_ACTIVE("intro_my");
990 if (! PL_min_intro_pending)
991 return PL_cop_seqmax;
993 svp = AvARRAY(PL_comppad_name);
994 for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
995 SV * const sv = svp[i];
997 if (sv && sv != &PL_sv_undef && !SvFAKE(sv) && !SvIVX(sv)) {
998 SvIV_set(sv, PAD_MAX); /* Don't know scope end yet. */
999 SvNV_set(sv, (NV)PL_cop_seqmax);
1000 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1001 "Pad intromy: %ld \"%s\", (%ld,%ld)\n",
1002 (long)i, SvPVX_const(sv),
1003 (long)U_32(SvNVX(sv)), (long)SvIVX(sv))
1007 PL_min_intro_pending = 0;
1008 PL_comppad_name_fill = PL_max_intro_pending; /* Needn't search higher */
1009 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1010 "Pad intromy: seq -> %ld\n", (long)(PL_cop_seqmax+1)));
1012 return PL_cop_seqmax++;
1016 =for apidoc pad_leavemy
1018 Cleanup at end of scope during compilation: set the max seq number for
1019 lexicals in this scope and warn of any lexicals that never got introduced.
1025 Perl_pad_leavemy(pTHX)
1029 SV * const * const svp = AvARRAY(PL_comppad_name);
1031 PL_pad_reset_pending = FALSE;
1033 ASSERT_CURPAD_ACTIVE("pad_leavemy");
1034 if (PL_min_intro_pending && PL_comppad_name_fill < PL_min_intro_pending) {
1035 for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
1036 const SV * const sv = svp[off];
1037 if (sv && sv != &PL_sv_undef
1038 && !SvFAKE(sv) && ckWARN_d(WARN_INTERNAL))
1039 Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
1040 "%"SVf" never introduced",
1044 /* "Deintroduce" my variables that are leaving with this scope. */
1045 for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_fill; off--) {
1046 const SV * const sv = svp[off];
1047 if (sv && sv != &PL_sv_undef && !SvFAKE(sv) && SvIVX(sv) == PAD_MAX) {
1048 SvIV_set(sv, PL_cop_seqmax);
1049 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1050 "Pad leavemy: %ld \"%s\", (%ld,%ld)\n",
1051 (long)off, SvPVX_const(sv),
1052 (long)U_32(SvNVX(sv)), (long)SvIVX(sv))
1057 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1058 "Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax));
1063 =for apidoc pad_swipe
1065 Abandon the tmp in the current pad at offset po and replace with a
1072 Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
1075 ASSERT_CURPAD_LEGAL("pad_swipe");
1078 if (AvARRAY(PL_comppad) != PL_curpad)
1079 Perl_croak(aTHX_ "panic: pad_swipe curpad");
1081 Perl_croak(aTHX_ "panic: pad_swipe po");
1083 DEBUG_X(PerlIO_printf(Perl_debug_log,
1084 "Pad 0x%"UVxf"[0x%"UVxf"] swipe: %ld\n",
1085 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po));
1088 SvPADTMP_off(PL_curpad[po]);
1090 SvREFCNT_dec(PL_curpad[po]);
1093 /* if pad tmps aren't shared between ops, then there's no need to
1094 * create a new tmp when an existing op is freed */
1095 #ifdef USE_BROKEN_PAD_RESET
1096 PL_curpad[po] = newSV(0);
1097 SvPADTMP_on(PL_curpad[po]);
1099 PL_curpad[po] = &PL_sv_undef;
1101 if ((I32)po < PL_padix)
1107 =for apidoc pad_reset
1109 Mark all the current temporaries for reuse
1114 /* XXX pad_reset() is currently disabled because it results in serious bugs.
1115 * It causes pad temp TARGs to be shared between OPs. Since TARGs are pushed
1116 * on the stack by OPs that use them, there are several ways to get an alias
1117 * to a shared TARG. Such an alias will change randomly and unpredictably.
1118 * We avoid doing this until we can think of a Better Way.
1121 Perl_pad_reset(pTHX)
1124 #ifdef USE_BROKEN_PAD_RESET
1125 if (AvARRAY(PL_comppad) != PL_curpad)
1126 Perl_croak(aTHX_ "panic: pad_reset curpad");
1128 DEBUG_X(PerlIO_printf(Perl_debug_log,
1129 "Pad 0x%"UVxf"[0x%"UVxf"] reset: padix %ld -> %ld",
1130 PTR2UV(PL_comppad), PTR2UV(PL_curpad),
1131 (long)PL_padix, (long)PL_padix_floor
1135 if (!PL_tainting) { /* Can't mix tainted and non-tainted temporaries. */
1137 for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
1138 if (PL_curpad[po] && !SvIMMORTAL(PL_curpad[po]))
1139 SvPADTMP_off(PL_curpad[po]);
1141 PL_padix = PL_padix_floor;
1144 PL_pad_reset_pending = FALSE;
1149 =for apidoc pad_tidy
1151 Tidy up a pad after we've finished compiling it:
1152 * remove most stuff from the pads of anonsub prototypes;
1154 * mark tmps as such.
1159 /* XXX DAPM surely most of this stuff should be done properly
1160 * at the right time beforehand, rather than going around afterwards
1161 * cleaning up our mistakes ???
1165 Perl_pad_tidy(pTHX_ padtidy_type type)
1169 ASSERT_CURPAD_ACTIVE("pad_tidy");
1171 /* If this CV has had any 'eval-capable' ops planted in it
1172 * (ie it contains eval '...', //ee, /$var/ or /(?{..})/), Then any
1173 * anon prototypes in the chain of CVs should be marked as cloneable,
1174 * so that for example the eval's CV in C<< sub { eval '$x' } >> gets
1175 * the right CvOUTSIDE.
1176 * If running with -d, *any* sub may potentially have an eval
1177 * excuted within it.
1180 if (PL_cv_has_eval || PL_perldb) {
1182 for (cv = PL_compcv ;cv; cv = CvOUTSIDE(cv)) {
1183 if (cv != PL_compcv && CvCOMPILED(cv))
1184 break; /* no need to mark already-compiled code */
1186 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1187 "Pad clone on cv=0x%"UVxf"\n", PTR2UV(cv)));
1193 /* extend curpad to match namepad */
1194 if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
1195 av_store(PL_comppad_name, AvFILLp(PL_comppad), NULL);
1197 if (type == padtidy_SUBCLONE) {
1198 SV * const * const namep = AvARRAY(PL_comppad_name);
1201 for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1204 if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
1207 * The only things that a clonable function needs in its
1208 * pad are anonymous subs.
1209 * The rest are created anew during cloning.
1211 if (!((namesv = namep[ix]) != NULL &&
1212 namesv != &PL_sv_undef &&
1213 *SvPVX_const(namesv) == '&'))
1215 SvREFCNT_dec(PL_curpad[ix]);
1216 PL_curpad[ix] = NULL;
1220 else if (type == padtidy_SUB) {
1221 /* XXX DAPM this same bit of code keeps appearing !!! Rationalise? */
1222 AV * const av = newAV(); /* Will be @_ */
1224 av_store(PL_comppad, 0, (SV*)av);
1228 /* XXX DAPM rationalise these two similar branches */
1230 if (type == padtidy_SUB) {
1232 for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1233 if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
1235 if (!SvPADMY(PL_curpad[ix]))
1236 SvPADTMP_on(PL_curpad[ix]);
1239 else if (type == padtidy_FORMAT) {
1241 for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1242 if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix]))
1243 SvPADTMP_on(PL_curpad[ix]);
1246 PL_curpad = AvARRAY(PL_comppad);
1251 =for apidoc pad_free
1253 Free the SV at offset po in the current pad.
1258 /* XXX DAPM integrate with pad_swipe ???? */
1260 Perl_pad_free(pTHX_ PADOFFSET po)
1263 ASSERT_CURPAD_LEGAL("pad_free");
1266 if (AvARRAY(PL_comppad) != PL_curpad)
1267 Perl_croak(aTHX_ "panic: pad_free curpad");
1269 Perl_croak(aTHX_ "panic: pad_free po");
1271 DEBUG_X(PerlIO_printf(Perl_debug_log,
1272 "Pad 0x%"UVxf"[0x%"UVxf"] free: %ld\n",
1273 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po)
1276 if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
1277 SvPADTMP_off(PL_curpad[po]);
1279 /* SV could be a shared hash key (eg bugid #19022) */
1281 #ifdef PERL_OLD_COPY_ON_WRITE
1282 !SvIsCOW(PL_curpad[po])
1284 !SvFAKE(PL_curpad[po])
1287 SvREADONLY_off(PL_curpad[po]); /* could be a freed constant */
1290 if ((I32)po < PL_padix)
1297 =for apidoc do_dump_pad
1299 Dump the contents of a padlist
1305 Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
1317 pad_name = (AV*)*av_fetch((AV*)padlist, 0, FALSE);
1318 pad = (AV*)*av_fetch((AV*)padlist, 1, FALSE);
1319 pname = AvARRAY(pad_name);
1320 ppad = AvARRAY(pad);
1321 Perl_dump_indent(aTHX_ level, file,
1322 "PADNAME = 0x%"UVxf"(0x%"UVxf") PAD = 0x%"UVxf"(0x%"UVxf")\n",
1323 PTR2UV(pad_name), PTR2UV(pname), PTR2UV(pad), PTR2UV(ppad)
1326 for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
1327 const SV *namesv = pname[ix];
1328 if (namesv && namesv == &PL_sv_undef) {
1333 Perl_dump_indent(aTHX_ level+1, file,
1334 "%2d. 0x%"UVxf"<%lu> FAKE \"%s\" flags=0x%lx index=%lu\n",
1337 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
1338 SvPVX_const(namesv),
1339 (unsigned long)SvIVX(namesv),
1340 (unsigned long)SvNVX(namesv)
1344 Perl_dump_indent(aTHX_ level+1, file,
1345 "%2d. 0x%"UVxf"<%lu> (%ld,%ld) \"%s\"\n",
1348 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
1349 (long)U_32(SvNVX(namesv)),
1350 (long)SvIVX(namesv),
1355 Perl_dump_indent(aTHX_ level+1, file,
1356 "%2d. 0x%"UVxf"<%lu>\n",
1359 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0)
1370 dump the contents of a CV
1377 S_cv_dump(pTHX_ const CV *cv, const char *title)
1380 const CV * const outside = CvOUTSIDE(cv);
1381 AV* const padlist = CvPADLIST(cv);
1383 PerlIO_printf(Perl_debug_log,
1384 " %s: CV=0x%"UVxf" (%s), OUTSIDE=0x%"UVxf" (%s)\n",
1387 (CvANON(cv) ? "ANON"
1388 : (SvTYPE(cv) == SVt_PVFM) ? "FORMAT"
1389 : (cv == PL_main_cv) ? "MAIN"
1390 : CvUNIQUE(cv) ? "UNIQUE"
1391 : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
1394 : CvANON(outside) ? "ANON"
1395 : (outside == PL_main_cv) ? "MAIN"
1396 : CvUNIQUE(outside) ? "UNIQUE"
1397 : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
1399 PerlIO_printf(Perl_debug_log,
1400 " PADLIST = 0x%"UVxf"\n", PTR2UV(padlist));
1401 do_dump_pad(1, Perl_debug_log, padlist, 1);
1403 #endif /* DEBUGGING */
1410 =for apidoc cv_clone
1412 Clone a CV: make a new CV which points to the same code etc, but which
1413 has a newly-created pad built by copying the prototype pad and capturing
1420 Perl_cv_clone(pTHX_ CV *proto)
1424 AV* const protopadlist = CvPADLIST(proto);
1425 const AV* const protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
1426 const AV* const protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
1427 SV** const pname = AvARRAY(protopad_name);
1428 SV** const ppad = AvARRAY(protopad);
1429 const I32 fname = AvFILLp(protopad_name);
1430 const I32 fpad = AvFILLp(protopad);
1436 assert(!CvUNIQUE(proto));
1438 /* Since cloneable anon subs can be nested, CvOUTSIDE may point
1439 * to a prototype; we instead want the cloned parent who called us.
1440 * Note that in general for formats, CvOUTSIDE != find_runcv */
1442 outside = CvOUTSIDE(proto);
1443 if (outside && CvCLONE(outside) && ! CvCLONED(outside))
1444 outside = find_runcv(NULL);
1445 depth = CvDEPTH(outside);
1446 assert(depth || SvTYPE(proto) == SVt_PVFM);
1449 assert(CvPADLIST(outside));
1452 SAVESPTR(PL_compcv);
1454 cv = PL_compcv = (CV*)newSV(0);
1455 sv_upgrade((SV *)cv, SvTYPE(proto));
1456 CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE);
1460 CvFILE(cv) = CvISXSUB(proto) ? CvFILE(proto)
1461 : savepv(CvFILE(proto));
1463 CvFILE(cv) = CvFILE(proto);
1465 CvGV(cv) = CvGV(proto);
1466 CvSTASH(cv) = CvSTASH(proto);
1468 CvROOT(cv) = OpREFCNT_inc(CvROOT(proto));
1470 CvSTART(cv) = CvSTART(proto);
1471 CvOUTSIDE(cv) = (CV*)SvREFCNT_inc_simple(outside);
1472 CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
1475 sv_setpvn((SV*)cv, SvPVX_const(proto), SvCUR(proto));
1477 CvPADLIST(cv) = pad_new(padnew_CLONE|padnew_SAVE);
1479 av_fill(PL_comppad, fpad);
1480 for (ix = fname; ix >= 0; ix--)
1481 av_store(PL_comppad_name, ix, SvREFCNT_inc(pname[ix]));
1483 PL_curpad = AvARRAY(PL_comppad);
1485 outpad = AvARRAY(AvARRAY(CvPADLIST(outside))[depth]);
1487 for (ix = fpad; ix > 0; ix--) {
1488 SV* const namesv = (ix <= fname) ? pname[ix] : NULL;
1490 if (namesv && namesv != &PL_sv_undef) { /* lexical */
1491 if (SvFAKE(namesv)) { /* lexical from outside? */
1492 sv = outpad[(I32)SvNVX(namesv)];
1494 /* formats may have an inactive parent */
1495 if (SvTYPE(proto) == SVt_PVFM && SvPADSTALE(sv)) {
1496 if (ckWARN(WARN_CLOSURE))
1497 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
1498 "Variable \"%s\" is not available", SvPVX_const(namesv));
1502 assert(!SvPADSTALE(sv));
1503 SvREFCNT_inc_simple_void_NN(sv);
1507 const char sigil = SvPVX_const(namesv)[0];
1509 sv = SvREFCNT_inc(ppad[ix]);
1510 else if (sigil == '@')
1512 else if (sigil == '%')
1519 else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) {
1520 sv = SvREFCNT_inc_NN(ppad[ix]);
1530 PerlIO_printf(Perl_debug_log, "\nPad CV clone\n");
1531 cv_dump(outside, "Outside");
1532 cv_dump(proto, "Proto");
1539 /* Constant sub () { $x } closing over $x - see lib/constant.pm:
1540 * The prototype was marked as a candiate for const-ization,
1541 * so try to grab the current const value, and if successful,
1542 * turn into a const sub:
1544 SV* const const_sv = op_const_sv(CvSTART(cv), cv);
1547 cv = newCONSTSUB(CvSTASH(proto), NULL, const_sv);
1559 =for apidoc pad_fixup_inner_anons
1561 For any anon CVs in the pad, change CvOUTSIDE of that CV from
1562 old_cv to new_cv if necessary. Needed when a newly-compiled CV has to be
1563 moved to a pre-existing CV struct.
1569 Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
1573 AV * const comppad_name = (AV*)AvARRAY(padlist)[0];
1574 AV * const comppad = (AV*)AvARRAY(padlist)[1];
1575 SV ** const namepad = AvARRAY(comppad_name);
1576 SV ** const curpad = AvARRAY(comppad);
1577 PERL_UNUSED_ARG(old_cv);
1579 for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
1580 const SV * const namesv = namepad[ix];
1581 if (namesv && namesv != &PL_sv_undef
1582 && *SvPVX_const(namesv) == '&')
1584 CV * const innercv = (CV*)curpad[ix];
1585 assert(CvWEAKOUTSIDE(innercv));
1586 assert(CvOUTSIDE(innercv) == old_cv);
1587 CvOUTSIDE(innercv) = new_cv;
1594 =for apidoc pad_push
1596 Push a new pad frame onto the padlist, unless there's already a pad at
1597 this depth, in which case don't bother creating a new one. Then give
1598 the new pad an @_ in slot zero.
1604 Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
1607 if (depth > AvFILLp(padlist)) {
1608 SV** const svp = AvARRAY(padlist);
1609 AV* const newpad = newAV();
1610 SV** const oldpad = AvARRAY(svp[depth-1]);
1611 I32 ix = AvFILLp((AV*)svp[1]);
1612 const I32 names_fill = AvFILLp((AV*)svp[0]);
1613 SV** const names = AvARRAY(svp[0]);
1616 for ( ;ix > 0; ix--) {
1617 if (names_fill >= ix && names[ix] != &PL_sv_undef) {
1618 const char sigil = SvPVX_const(names[ix])[0];
1619 if ((SvFLAGS(names[ix]) & SVf_FAKE) || sigil == '&') {
1620 /* outer lexical or anon code */
1621 av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]));
1623 else { /* our own lexical */
1627 else if (sigil == '%')
1631 av_store(newpad, ix, sv);
1635 else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
1636 av_store(newpad, ix, SvREFCNT_inc_NN(oldpad[ix]));
1639 /* save temporaries on recursion? */
1640 SV * const sv = newSV(0);
1641 av_store(newpad, ix, sv);
1647 av_store(newpad, 0, (SV*)av);
1650 av_store(padlist, depth, (SV*)newpad);
1651 AvFILLp(padlist) = depth;
1657 Perl_pad_compname_type(pTHX_ const PADOFFSET po)
1660 SV* const * const av = av_fetch(PL_comppad_name, po, FALSE);
1661 if ( SvPAD_TYPED(*av) ) {
1662 return SvSTASH(*av);
1669 * c-indentation-style: bsd
1671 * indent-tabs-mode: t
1674 * ex: set ts=8 sts=4 sw=4 noet: