3 * Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 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 xlow+1..xhigh inclusive in the NV union is a range of cop_seq numbers for
76 which the name is valid. For typed lexicals name SV is SVt_PVMG and SvSTASH
77 points at the type. For C<our> lexicals, the type is also SVt_PVMG, with the
78 SvOURSTASH slot pointing at the stash of the associated global (so that
79 duplicate C<our> declarations in the same package can be detected). SvUVX is
80 sometimes 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 xlow and xhigh to store a cop_seq range, since it is
85 in scope throughout. Instead xhigh 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, xlow 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();
105 For state vars, SVf_PADSTALE is overloaded to mean 'not yet initialised'
112 #define PERL_IN_PAD_C
114 #include "keywords.h"
116 #define COP_SEQ_RANGE_LOW_set(sv,val) \
117 STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xlow = (val); } STMT_END
118 #define COP_SEQ_RANGE_HIGH_set(sv,val) \
119 STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xhigh = (val); } STMT_END
121 #define PARENT_PAD_INDEX_set(sv,val) \
122 STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xlow = (val); } STMT_END
123 #define PARENT_FAKELEX_FLAGS_set(sv,val) \
124 STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xhigh = (val); } STMT_END
126 #define PAD_MAX I32_MAX
129 void pad_peg(const char* s) {
138 Create a new compiling padlist, saving and updating the various global
139 vars at the same time as creating the pad itself. The following flags
140 can be OR'ed together:
142 padnew_CLONE this pad is for a cloned CV
143 padnew_SAVE save old globals
144 padnew_SAVESUB also save extra stuff for start of sub
150 Perl_pad_new(pTHX_ int flags)
153 AV *padlist, *padname, *pad;
155 ASSERT_CURPAD_LEGAL("pad_new");
157 /* XXX DAPM really need a new SAVEt_PAD which restores all or most
158 * vars (based on flags) rather than storing vals + addresses for
159 * each individually. Also see pad_block_start.
160 * XXX DAPM Try to see whether all these conditionals are required
163 /* save existing state, ... */
165 if (flags & padnew_SAVE) {
167 SAVESPTR(PL_comppad_name);
168 if (! (flags & padnew_CLONE)) {
170 SAVEI32(PL_comppad_name_fill);
171 SAVEI32(PL_min_intro_pending);
172 SAVEI32(PL_max_intro_pending);
173 SAVEBOOL(PL_cv_has_eval);
174 if (flags & padnew_SAVESUB) {
175 SAVEI32(PL_pad_reset_pending);
179 /* XXX DAPM interestingly, PL_comppad_name_floor never seems to be
180 * saved - check at some pt that this is okay */
182 /* ... create new pad ... */
188 if (flags & padnew_CLONE) {
189 /* XXX DAPM I dont know why cv_clone needs it
190 * doing differently yet - perhaps this separate branch can be
191 * dispensed with eventually ???
194 AV * const a0 = newAV(); /* will be @_ */
196 av_store(pad, 0, (SV*)a0);
200 av_store(pad, 0, NULL);
204 av_store(padlist, 0, (SV*)padname);
205 av_store(padlist, 1, (SV*)pad);
207 /* ... then update state variables */
209 PL_comppad_name = (AV*)(*av_fetch(padlist, 0, FALSE));
210 PL_comppad = (AV*)(*av_fetch(padlist, 1, FALSE));
211 PL_curpad = AvARRAY(PL_comppad);
213 if (! (flags & padnew_CLONE)) {
214 PL_comppad_name_fill = 0;
215 PL_min_intro_pending = 0;
220 DEBUG_X(PerlIO_printf(Perl_debug_log,
221 "Pad 0x%"UVxf"[0x%"UVxf"] new: compcv=0x%"UVxf
222 " name=0x%"UVxf" flags=0x%"UVxf"\n",
223 PTR2UV(PL_comppad), PTR2UV(PL_curpad), PTR2UV(PL_compcv),
224 PTR2UV(padname), (UV)flags
228 return (PADLIST*)padlist;
232 =for apidoc pad_undef
234 Free the padlist associated with a CV.
235 If parts of it happen to be current, we null the relevant
236 PL_*pad* global vars so that we don't have any dangling references left.
237 We also repoint the CvOUTSIDE of any about-to-be-orphaned
238 inner subs to the outer of this cv.
240 (This function should really be called pad_free, but the name was already
247 Perl_pad_undef(pTHX_ CV* cv)
251 const PADLIST * const padlist = CvPADLIST(cv);
253 pad_peg("pad_undef");
256 if (SvIS_FREED(padlist)) /* may be during global destruction */
259 DEBUG_X(PerlIO_printf(Perl_debug_log,
260 "Pad undef: cv=0x%"UVxf" padlist=0x%"UVxf" comppad=0x%"UVxf"\n",
261 PTR2UV(cv), PTR2UV(padlist), PTR2UV(PL_comppad))
264 /* detach any '&' anon children in the pad; if afterwards they
265 * are still live, fix up their CvOUTSIDEs to point to our outside,
267 /* XXX DAPM for efficiency, we should only do this if we know we have
268 * children, or integrate this loop with general cleanup */
270 if (!PL_dirty) { /* don't bother during global destruction */
271 CV * const outercv = CvOUTSIDE(cv);
272 const U32 seq = CvOUTSIDE_SEQ(cv);
273 AV * const comppad_name = (AV*)AvARRAY(padlist)[0];
274 SV ** const namepad = AvARRAY(comppad_name);
275 AV * const comppad = (AV*)AvARRAY(padlist)[1];
276 SV ** const curpad = AvARRAY(comppad);
277 for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
278 SV * const namesv = namepad[ix];
279 if (namesv && namesv != &PL_sv_undef
280 && *SvPVX_const(namesv) == '&')
282 CV * const innercv = (CV*)curpad[ix];
283 U32 inner_rc = SvREFCNT(innercv);
286 SvREFCNT_dec(namesv);
288 if (SvREFCNT(comppad) < 2) { /* allow for /(?{ sub{} })/ */
290 SvREFCNT_dec(innercv);
294 /* in use, not just a prototype */
295 if (inner_rc && (CvOUTSIDE(innercv) == cv)) {
296 assert(CvWEAKOUTSIDE(innercv));
297 /* don't relink to grandfather if he's being freed */
298 if (outercv && SvREFCNT(outercv)) {
299 CvWEAKOUTSIDE_off(innercv);
300 CvOUTSIDE(innercv) = outercv;
301 CvOUTSIDE_SEQ(innercv) = seq;
302 SvREFCNT_inc_simple_void_NN(outercv);
305 CvOUTSIDE(innercv) = NULL;
312 ix = AvFILLp(padlist);
314 const SV* const sv = AvARRAY(padlist)[ix--];
316 if (sv == (SV*)PL_comppad_name)
317 PL_comppad_name = NULL;
318 else if (sv == (SV*)PL_comppad) {
325 SvREFCNT_dec((SV*)CvPADLIST(cv));
326 CvPADLIST(cv) = NULL;
333 =for apidoc pad_add_name
335 Create a new name and associated PADMY SV in the current pad; return the
337 If C<typestash> is valid, the name is for a typed lexical; set the
338 name's stash to that value.
339 If C<ourstash> is valid, it's an our lexical, set the name's
340 SvOURSTASH to that value
342 If fake, it means we're cloning an existing entry
348 Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake, bool state)
351 const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
353 = newSV_type((ourstash || typestash) ? SVt_PVMG : SVt_PVNV);
355 ASSERT_CURPAD_ACTIVE("pad_add_name");
357 sv_setpv(namesv, name);
360 assert(SvTYPE(namesv) == SVt_PVMG);
361 SvPAD_TYPED_on(namesv);
362 SvSTASH_set(namesv, (HV*)SvREFCNT_inc_simple_NN((SV*)typestash));
365 SvPAD_OUR_on(namesv);
366 SvOURSTASH_set(namesv, ourstash);
367 SvREFCNT_inc_simple_void_NN(ourstash);
370 SvPAD_STATE_on(namesv);
373 av_store(PL_comppad_name, offset, namesv);
376 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
377 "Pad addname: %ld \"%s\" FAKE\n", (long)offset, name));
380 /* not yet introduced */
381 COP_SEQ_RANGE_LOW_set(namesv, PAD_MAX); /* min */
382 COP_SEQ_RANGE_HIGH_set(namesv, 0); /* max */
384 if (!PL_min_intro_pending)
385 PL_min_intro_pending = offset;
386 PL_max_intro_pending = offset;
387 /* if it's not a simple scalar, replace with an AV or HV */
388 /* XXX DAPM since slot has been allocated, replace
389 * av_store with PL_curpad[offset] ? */
391 av_store(PL_comppad, offset, (SV*)newAV());
392 else if (*name == '%')
393 av_store(PL_comppad, offset, (SV*)newHV());
394 SvPADMY_on(PL_curpad[offset]);
395 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
396 "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
397 (long)offset, name, PTR2UV(PL_curpad[offset])));
407 =for apidoc pad_alloc
409 Allocate a new my or tmp pad entry. For a my, simply push a null SV onto
410 the end of PL_comppad, but for a tmp, scan the pad from PL_padix upwards
411 for a slot which has no name and no active value.
416 /* XXX DAPM integrate alloc(), add_name() and add_anon(),
417 * or at least rationalise ??? */
418 /* And flag whether the incoming name is UTF8 or 8 bit?
419 Could do this either with the +ve/-ve hack of the HV code, or expanding
420 the flag bits. Either way, this makes proper Unicode safe pad support.
425 Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
431 PERL_UNUSED_ARG(optype);
432 ASSERT_CURPAD_ACTIVE("pad_alloc");
434 if (AvARRAY(PL_comppad) != PL_curpad)
435 Perl_croak(aTHX_ "panic: pad_alloc");
436 if (PL_pad_reset_pending)
438 if (tmptype & SVs_PADMY) {
439 sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE);
440 retval = AvFILLp(PL_comppad);
443 SV * const * const names = AvARRAY(PL_comppad_name);
444 const SSize_t names_fill = AvFILLp(PL_comppad_name);
447 * "foreach" index vars temporarily become aliases to non-"my"
448 * values. Thus we must skip, not just pad values that are
449 * marked as current pad values, but also those with names.
451 /* HVDS why copy to sv here? we don't seem to use it */
452 if (++PL_padix <= names_fill &&
453 (sv = names[PL_padix]) && sv != &PL_sv_undef)
455 sv = *av_fetch(PL_comppad, PL_padix, TRUE);
456 if (!(SvFLAGS(sv) & (SVs_PADTMP | SVs_PADMY)) &&
457 !IS_PADGV(sv) && !IS_PADCONST(sv))
462 SvFLAGS(sv) |= tmptype;
463 PL_curpad = AvARRAY(PL_comppad);
465 DEBUG_X(PerlIO_printf(Perl_debug_log,
466 "Pad 0x%"UVxf"[0x%"UVxf"] alloc: %ld for %s\n",
467 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long) retval,
468 PL_op_name[optype]));
469 #ifdef DEBUG_LEAKING_SCALARS
470 sv->sv_debug_optype = optype;
471 sv->sv_debug_inpad = 1;
473 return (PADOFFSET)retval;
477 =for apidoc pad_add_anon
479 Add an anon code entry to the current compiling pad
485 Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
489 SV* const name = newSV_type(SVt_PVNV);
491 sv_setpvn(name, "&", 1);
492 /* Are these two actually ever read? */
493 COP_SEQ_RANGE_HIGH_set(name, ~0);
494 COP_SEQ_RANGE_LOW_set(name, 1);
495 ix = pad_alloc(op_type, SVs_PADMY);
496 av_store(PL_comppad_name, ix, name);
497 /* XXX DAPM use PL_curpad[] ? */
498 av_store(PL_comppad, ix, sv);
501 /* to avoid ref loops, we never have parent + child referencing each
502 * other simultaneously */
503 if (CvOUTSIDE((CV*)sv)) {
504 assert(!CvWEAKOUTSIDE((CV*)sv));
505 CvWEAKOUTSIDE_on((CV*)sv);
506 SvREFCNT_dec(CvOUTSIDE((CV*)sv));
514 =for apidoc pad_check_dup
516 Check for duplicate declarations: report any of:
517 * a my in the current scope with the same name;
518 * an our (anywhere in the pad) with the same name and the same stash
520 C<is_our> indicates that the name to check is an 'our' declaration
525 /* XXX DAPM integrate this into pad_add_name ??? */
528 Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash)
534 ASSERT_CURPAD_ACTIVE("pad_check_dup");
535 if (AvFILLp(PL_comppad_name) < 0 || !ckWARN(WARN_MISC))
536 return; /* nothing to check */
538 svp = AvARRAY(PL_comppad_name);
539 top = AvFILLp(PL_comppad_name);
540 /* check the current scope */
541 /* XXX DAPM - why the (I32) cast - shouldn't we ensure they're the same
543 for (off = top; (I32)off > PL_comppad_name_floor; off--) {
544 SV * const sv = svp[off];
546 && sv != &PL_sv_undef
548 && (COP_SEQ_RANGE_HIGH(sv) == PAD_MAX || COP_SEQ_RANGE_HIGH(sv) == 0)
549 && strEQ(name, SvPVX_const(sv)))
551 if (is_our && (SvPAD_OUR(sv)))
552 break; /* "our" masking "our" */
553 Perl_warner(aTHX_ packWARN(WARN_MISC),
554 "\"%s\" variable %s masks earlier declaration in same %s",
555 (is_our ? "our" : PL_parser->in_my == KEY_my ? "my" : "state"),
557 (COP_SEQ_RANGE_HIGH(sv) == PAD_MAX ? "scope" : "statement"));
562 /* check the rest of the pad */
565 SV * const sv = svp[off];
567 && sv != &PL_sv_undef
569 && (COP_SEQ_RANGE_HIGH(sv) == PAD_MAX || COP_SEQ_RANGE_HIGH(sv) == 0)
570 && SvOURSTASH(sv) == ourstash
571 && strEQ(name, SvPVX_const(sv)))
573 Perl_warner(aTHX_ packWARN(WARN_MISC),
574 "\"our\" variable %s redeclared", name);
575 if ((I32)off <= PL_comppad_name_floor)
576 Perl_warner(aTHX_ packWARN(WARN_MISC),
577 "\t(Did you mean \"local\" instead of \"our\"?)\n");
580 } while ( off-- > 0 );
586 =for apidoc pad_findmy
588 Given a lexical name, try to find its offset, first in the current pad,
589 or failing that, in the pads of any lexically enclosing subs (including
590 the complications introduced by eval). If the name is found in an outer pad,
591 then a fake entry is added to the current pad.
592 Returns the offset in the current pad, or NOT_IN_PAD on failure.
598 Perl_pad_findmy(pTHX_ const char *name)
607 pad_peg("pad_findmy");
608 offset = pad_findlex(name, PL_compcv, PL_cop_seqmax, 1,
609 NULL, &out_sv, &out_flags);
610 if ((PADOFFSET)offset != NOT_IN_PAD)
613 /* look for an our that's being introduced; this allows
614 * our $foo = 0 unless defined $foo;
615 * to not give a warning. (Yes, this is a hack) */
617 nameav = (AV*)AvARRAY(CvPADLIST(PL_compcv))[0];
618 name_svp = AvARRAY(nameav);
619 for (offset = AvFILLp(nameav); offset > 0; offset--) {
620 const SV * const namesv = name_svp[offset];
621 if (namesv && namesv != &PL_sv_undef
623 && (SvPAD_OUR(namesv))
624 && strEQ(SvPVX_const(namesv), name)
625 && COP_SEQ_RANGE_LOW(namesv) == PAD_MAX /* min */
633 * Returns the offset of a lexical $_, if there is one, at run time.
634 * Used by the UNDERBAR XS macro.
638 Perl_find_rundefsvoffset(pTHX)
643 return pad_findlex("$_", find_runcv(NULL), PL_curcop->cop_seq, 1,
644 NULL, &out_sv, &out_flags);
648 =for apidoc pad_findlex
650 Find a named lexical anywhere in a chain of nested pads. Add fake entries
651 in the inner pads if it's found in an outer one.
653 Returns the offset in the bottom pad of the lex or the fake lex.
654 cv is the CV in which to start the search, and seq is the current cop_seq
655 to match against. If warn is true, print appropriate warnings. The out_*
656 vars return values, and so are pointers to where the returned values
657 should be stored. out_capture, if non-null, requests that the innermost
658 instance of the lexical is captured; out_name_sv is set to the innermost
659 matched namesv or fake namesv; out_flags returns the flags normally
660 associated with the IVX field of a fake namesv.
662 Note that pad_findlex() is recursive; it recurses up the chain of CVs,
663 then comes back down, adding fake entries as it goes. It has to be this way
664 because fake namesvs in anon protoypes have to store in xlow the index into
670 /* the CV has finished being compiled. This is not a sufficient test for
671 * all CVs (eg XSUBs), but suffices for the CVs found in a lexical chain */
672 #define CvCOMPILED(cv) CvROOT(cv)
674 /* the CV does late binding of its lexicals */
675 #define CvLATE(cv) (CvANON(cv) || SvTYPE(cv) == SVt_PVFM)
679 S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
680 SV** out_capture, SV** out_name_sv, int *out_flags)
683 I32 offset, new_offset;
686 const AV * const padlist = CvPADLIST(cv);
690 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
691 "Pad findlex cv=0x%"UVxf" searching \"%s\" seq=%d%s\n",
692 PTR2UV(cv), name, (int)seq, out_capture ? " capturing" : "" ));
694 /* first, search this pad */
696 if (padlist) { /* not an undef CV */
698 const AV * const nameav = (AV*)AvARRAY(padlist)[0];
699 SV * const * const name_svp = AvARRAY(nameav);
701 for (offset = AvFILLp(nameav); offset > 0; offset--) {
702 const SV * const namesv = name_svp[offset];
703 if (namesv && namesv != &PL_sv_undef
704 && strEQ(SvPVX_const(namesv), name))
707 fake_offset = offset; /* in case we don't find a real one */
708 else if ( seq > COP_SEQ_RANGE_LOW(namesv) /* min */
709 && seq <= COP_SEQ_RANGE_HIGH(namesv)) /* max */
714 if (offset > 0 || fake_offset > 0 ) { /* a match! */
715 if (offset > 0) { /* not fake */
717 *out_name_sv = name_svp[offset]; /* return the namesv */
719 /* set PAD_FAKELEX_MULTI if this lex can have multiple
720 * instances. For now, we just test !CvUNIQUE(cv), but
721 * ideally, we should detect my's declared within loops
722 * etc - this would allow a wider range of 'not stayed
723 * shared' warnings. We also treated alreadly-compiled
724 * lexes as not multi as viewed from evals. */
726 *out_flags = CvANON(cv) ?
728 (!CvUNIQUE(cv) && ! CvCOMPILED(cv))
729 ? PAD_FAKELEX_MULTI : 0;
731 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
732 "Pad findlex cv=0x%"UVxf" matched: offset=%ld (%lu,%lu)\n",
733 PTR2UV(cv), (long)offset,
734 (unsigned long)COP_SEQ_RANGE_LOW(*out_name_sv),
735 (unsigned long)COP_SEQ_RANGE_HIGH(*out_name_sv)));
737 else { /* fake match */
738 offset = fake_offset;
739 *out_name_sv = name_svp[offset]; /* return the namesv */
740 *out_flags = PARENT_FAKELEX_FLAGS(*out_name_sv);
741 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
742 "Pad findlex cv=0x%"UVxf" matched: offset=%ld flags=0x%lx index=%lu\n",
743 PTR2UV(cv), (long)offset, (unsigned long)*out_flags,
744 (unsigned long) PARENT_PAD_INDEX(*out_name_sv)
748 /* return the lex? */
753 if (SvPAD_OUR(*out_name_sv)) {
758 /* trying to capture from an anon prototype? */
760 ? CvANON(cv) && CvCLONE(cv) && !CvCLONED(cv)
761 : *out_flags & PAD_FAKELEX_ANON)
763 if (warn && ckWARN(WARN_CLOSURE))
764 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
765 "Variable \"%s\" is not available", name);
772 if (!CvCOMPILED(cv) && (*out_flags & PAD_FAKELEX_MULTI)
773 && !SvPAD_STATE(name_svp[offset])
774 && warn && ckWARN(WARN_CLOSURE)) {
776 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
777 "Variable \"%s\" will not stay shared", name);
780 if (fake_offset && CvANON(cv)
781 && CvCLONE(cv) &&!CvCLONED(cv))
784 /* not yet caught - look further up */
785 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
786 "Pad findlex cv=0x%"UVxf" chasing lex in outer pad\n",
789 (void) pad_findlex(name, CvOUTSIDE(cv),
791 newwarn, out_capture, out_name_sv, out_flags);
796 *out_capture = AvARRAY((AV*)AvARRAY(padlist)[
797 CvDEPTH(cv) ? CvDEPTH(cv) : 1])[offset];
798 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
799 "Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n",
800 PTR2UV(cv), PTR2UV(*out_capture)));
802 if (SvPADSTALE(*out_capture)
803 && !SvPAD_STATE(name_svp[offset]))
805 if (ckWARN(WARN_CLOSURE))
806 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
807 "Variable \"%s\" is not available", name);
813 *out_capture = sv_2mortal((SV*)newAV());
814 else if (*name == '%')
815 *out_capture = sv_2mortal((SV*)newHV());
817 *out_capture = sv_newmortal();
825 /* it's not in this pad - try above */
830 /* out_capture non-null means caller wants us to capture lex; in
831 * addition we capture ourselves unless it's an ANON/format */
832 new_capturep = out_capture ? out_capture :
833 CvLATE(cv) ? NULL : &new_capture;
835 offset = pad_findlex(name, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1,
836 new_capturep, out_name_sv, out_flags);
837 if ((PADOFFSET)offset == NOT_IN_PAD)
840 /* found in an outer CV. Add appropriate fake entry to this pad */
842 /* don't add new fake entries (via eval) to CVs that we have already
843 * finished compiling, or to undef CVs */
844 if (CvCOMPILED(cv) || !padlist)
845 return 0; /* this dummy (and invalid) value isnt used by the caller */
849 AV * const ocomppad_name = PL_comppad_name;
850 PAD * const ocomppad = PL_comppad;
851 PL_comppad_name = (AV*)AvARRAY(padlist)[0];
852 PL_comppad = (AV*)AvARRAY(padlist)[1];
853 PL_curpad = AvARRAY(PL_comppad);
855 new_offset = pad_add_name(
856 SvPVX_const(*out_name_sv),
857 SvPAD_TYPED(*out_name_sv)
858 ? SvSTASH(*out_name_sv) : NULL,
859 SvOURSTASH(*out_name_sv),
861 SvPAD_STATE(*out_name_sv) ? 1 : 0 /* state variable ? */
864 new_namesv = AvARRAY(PL_comppad_name)[new_offset];
865 PARENT_FAKELEX_FLAGS_set(new_namesv, *out_flags);
867 PARENT_PAD_INDEX_set(new_namesv, 0);
868 if (SvPAD_OUR(new_namesv)) {
869 NOOP; /* do nothing */
871 else if (CvLATE(cv)) {
872 /* delayed creation - just note the offset within parent pad */
873 PARENT_PAD_INDEX_set(new_namesv, offset);
877 /* immediate creation - capture outer value right now */
878 av_store(PL_comppad, new_offset, SvREFCNT_inc(*new_capturep));
879 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
880 "Pad findlex cv=0x%"UVxf" saved captured sv 0x%"UVxf" at offset %ld\n",
881 PTR2UV(cv), PTR2UV(*new_capturep), (long)new_offset));
883 *out_name_sv = new_namesv;
884 *out_flags = PARENT_FAKELEX_FLAGS(new_namesv);
886 PL_comppad_name = ocomppad_name;
887 PL_comppad = ocomppad;
888 PL_curpad = ocomppad ? AvARRAY(ocomppad) : NULL;
898 Get the value at offset po in the current pad.
899 Use macro PAD_SV instead of calling this function directly.
906 Perl_pad_sv(pTHX_ PADOFFSET po)
909 ASSERT_CURPAD_ACTIVE("pad_sv");
912 Perl_croak(aTHX_ "panic: pad_sv po");
913 DEBUG_X(PerlIO_printf(Perl_debug_log,
914 "Pad 0x%"UVxf"[0x%"UVxf"] sv: %ld sv=0x%"UVxf"\n",
915 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(PL_curpad[po]))
917 return PL_curpad[po];
922 =for apidoc pad_setsv
924 Set the entry at offset po in the current pad to sv.
925 Use the macro PAD_SETSV() rather than calling this function directly.
931 Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
934 ASSERT_CURPAD_ACTIVE("pad_setsv");
936 DEBUG_X(PerlIO_printf(Perl_debug_log,
937 "Pad 0x%"UVxf"[0x%"UVxf"] setsv: %ld sv=0x%"UVxf"\n",
938 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(sv))
947 =for apidoc pad_block_start
949 Update the pad compilation state variables on entry to a new block
955 * - integrate this in general state-saving routine ???
956 * - combine with the state-saving going on in pad_new ???
957 * - introduce a new SAVE type that does all this in one go ?
961 Perl_pad_block_start(pTHX_ int full)
964 ASSERT_CURPAD_ACTIVE("pad_block_start");
965 SAVEI32(PL_comppad_name_floor);
966 PL_comppad_name_floor = AvFILLp(PL_comppad_name);
968 PL_comppad_name_fill = PL_comppad_name_floor;
969 if (PL_comppad_name_floor < 0)
970 PL_comppad_name_floor = 0;
971 SAVEI32(PL_min_intro_pending);
972 SAVEI32(PL_max_intro_pending);
973 PL_min_intro_pending = 0;
974 SAVEI32(PL_comppad_name_fill);
975 SAVEI32(PL_padix_floor);
976 PL_padix_floor = PL_padix;
977 PL_pad_reset_pending = FALSE;
984 "Introduce" my variables to visible status.
996 ASSERT_CURPAD_ACTIVE("intro_my");
997 if (! PL_min_intro_pending)
998 return PL_cop_seqmax;
1000 svp = AvARRAY(PL_comppad_name);
1001 for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
1002 SV * const sv = svp[i];
1004 if (sv && sv != &PL_sv_undef && !SvFAKE(sv) && !COP_SEQ_RANGE_HIGH(sv)) {
1005 COP_SEQ_RANGE_HIGH_set(sv, PAD_MAX); /* Don't know scope end yet. */
1006 COP_SEQ_RANGE_LOW_set(sv, PL_cop_seqmax);
1007 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1008 "Pad intromy: %ld \"%s\", (%lu,%lu)\n",
1009 (long)i, SvPVX_const(sv),
1010 (unsigned long)COP_SEQ_RANGE_LOW(sv),
1011 (unsigned long)COP_SEQ_RANGE_HIGH(sv))
1015 PL_min_intro_pending = 0;
1016 PL_comppad_name_fill = PL_max_intro_pending; /* Needn't search higher */
1017 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1018 "Pad intromy: seq -> %ld\n", (long)(PL_cop_seqmax+1)));
1020 return PL_cop_seqmax++;
1024 =for apidoc pad_leavemy
1026 Cleanup at end of scope during compilation: set the max seq number for
1027 lexicals in this scope and warn of any lexicals that never got introduced.
1033 Perl_pad_leavemy(pTHX)
1037 SV * const * const svp = AvARRAY(PL_comppad_name);
1039 PL_pad_reset_pending = FALSE;
1041 ASSERT_CURPAD_ACTIVE("pad_leavemy");
1042 if (PL_min_intro_pending && PL_comppad_name_fill < PL_min_intro_pending) {
1043 for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
1044 const SV * const sv = svp[off];
1045 if (sv && sv != &PL_sv_undef
1046 && !SvFAKE(sv) && ckWARN_d(WARN_INTERNAL))
1047 Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
1048 "%"SVf" never introduced",
1052 /* "Deintroduce" my variables that are leaving with this scope. */
1053 for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_fill; off--) {
1054 const SV * const sv = svp[off];
1055 if (sv && sv != &PL_sv_undef && !SvFAKE(sv) && COP_SEQ_RANGE_HIGH(sv) == PAD_MAX) {
1056 COP_SEQ_RANGE_HIGH_set(sv, PL_cop_seqmax);
1057 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1058 "Pad leavemy: %ld \"%s\", (%lu,%lu)\n",
1059 (long)off, SvPVX_const(sv),
1060 (unsigned long)COP_SEQ_RANGE_LOW(sv),
1061 (unsigned long)COP_SEQ_RANGE_HIGH(sv))
1066 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1067 "Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax));
1072 =for apidoc pad_swipe
1074 Abandon the tmp in the current pad at offset po and replace with a
1081 Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
1084 ASSERT_CURPAD_LEGAL("pad_swipe");
1087 if (AvARRAY(PL_comppad) != PL_curpad)
1088 Perl_croak(aTHX_ "panic: pad_swipe curpad");
1090 Perl_croak(aTHX_ "panic: pad_swipe po");
1092 DEBUG_X(PerlIO_printf(Perl_debug_log,
1093 "Pad 0x%"UVxf"[0x%"UVxf"] swipe: %ld\n",
1094 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po));
1097 SvPADTMP_off(PL_curpad[po]);
1099 SvREFCNT_dec(PL_curpad[po]);
1102 /* if pad tmps aren't shared between ops, then there's no need to
1103 * create a new tmp when an existing op is freed */
1104 #ifdef USE_BROKEN_PAD_RESET
1105 PL_curpad[po] = newSV(0);
1106 SvPADTMP_on(PL_curpad[po]);
1108 PL_curpad[po] = &PL_sv_undef;
1110 if ((I32)po < PL_padix)
1116 =for apidoc pad_reset
1118 Mark all the current temporaries for reuse
1123 /* XXX pad_reset() is currently disabled because it results in serious bugs.
1124 * It causes pad temp TARGs to be shared between OPs. Since TARGs are pushed
1125 * on the stack by OPs that use them, there are several ways to get an alias
1126 * to a shared TARG. Such an alias will change randomly and unpredictably.
1127 * We avoid doing this until we can think of a Better Way.
1130 Perl_pad_reset(pTHX)
1133 #ifdef USE_BROKEN_PAD_RESET
1134 if (AvARRAY(PL_comppad) != PL_curpad)
1135 Perl_croak(aTHX_ "panic: pad_reset curpad");
1137 DEBUG_X(PerlIO_printf(Perl_debug_log,
1138 "Pad 0x%"UVxf"[0x%"UVxf"] reset: padix %ld -> %ld",
1139 PTR2UV(PL_comppad), PTR2UV(PL_curpad),
1140 (long)PL_padix, (long)PL_padix_floor
1144 if (!PL_tainting) { /* Can't mix tainted and non-tainted temporaries. */
1146 for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
1147 if (PL_curpad[po] && !SvIMMORTAL(PL_curpad[po]))
1148 SvPADTMP_off(PL_curpad[po]);
1150 PL_padix = PL_padix_floor;
1153 PL_pad_reset_pending = FALSE;
1158 =for apidoc pad_tidy
1160 Tidy up a pad after we've finished compiling it:
1161 * remove most stuff from the pads of anonsub prototypes;
1163 * mark tmps as such.
1168 /* XXX DAPM surely most of this stuff should be done properly
1169 * at the right time beforehand, rather than going around afterwards
1170 * cleaning up our mistakes ???
1174 Perl_pad_tidy(pTHX_ padtidy_type type)
1178 ASSERT_CURPAD_ACTIVE("pad_tidy");
1180 /* If this CV has had any 'eval-capable' ops planted in it
1181 * (ie it contains eval '...', //ee, /$var/ or /(?{..})/), Then any
1182 * anon prototypes in the chain of CVs should be marked as cloneable,
1183 * so that for example the eval's CV in C<< sub { eval '$x' } >> gets
1184 * the right CvOUTSIDE.
1185 * If running with -d, *any* sub may potentially have an eval
1186 * excuted within it.
1189 if (PL_cv_has_eval || PL_perldb) {
1191 for (cv = PL_compcv ;cv; cv = CvOUTSIDE(cv)) {
1192 if (cv != PL_compcv && CvCOMPILED(cv))
1193 break; /* no need to mark already-compiled code */
1195 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1196 "Pad clone on cv=0x%"UVxf"\n", PTR2UV(cv)));
1202 /* extend curpad to match namepad */
1203 if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
1204 av_store(PL_comppad_name, AvFILLp(PL_comppad), NULL);
1206 if (type == padtidy_SUBCLONE) {
1207 SV * const * const namep = AvARRAY(PL_comppad_name);
1210 for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1213 if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
1216 * The only things that a clonable function needs in its
1217 * pad are anonymous subs.
1218 * The rest are created anew during cloning.
1220 if (!((namesv = namep[ix]) != NULL &&
1221 namesv != &PL_sv_undef &&
1222 *SvPVX_const(namesv) == '&'))
1224 SvREFCNT_dec(PL_curpad[ix]);
1225 PL_curpad[ix] = NULL;
1229 else if (type == padtidy_SUB) {
1230 /* XXX DAPM this same bit of code keeps appearing !!! Rationalise? */
1231 AV * const av = newAV(); /* Will be @_ */
1233 av_store(PL_comppad, 0, (SV*)av);
1237 /* XXX DAPM rationalise these two similar branches */
1239 if (type == padtidy_SUB) {
1241 for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1242 if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
1244 if (!SvPADMY(PL_curpad[ix]))
1245 SvPADTMP_on(PL_curpad[ix]);
1248 else if (type == padtidy_FORMAT) {
1250 for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1251 if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix]))
1252 SvPADTMP_on(PL_curpad[ix]);
1255 PL_curpad = AvARRAY(PL_comppad);
1260 =for apidoc pad_free
1262 Free the SV at offset po in the current pad.
1267 /* XXX DAPM integrate with pad_swipe ???? */
1269 Perl_pad_free(pTHX_ PADOFFSET po)
1272 ASSERT_CURPAD_LEGAL("pad_free");
1275 if (AvARRAY(PL_comppad) != PL_curpad)
1276 Perl_croak(aTHX_ "panic: pad_free curpad");
1278 Perl_croak(aTHX_ "panic: pad_free po");
1280 DEBUG_X(PerlIO_printf(Perl_debug_log,
1281 "Pad 0x%"UVxf"[0x%"UVxf"] free: %ld\n",
1282 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po)
1285 if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
1286 SvPADTMP_off(PL_curpad[po]);
1288 /* SV could be a shared hash key (eg bugid #19022) */
1290 #ifdef PERL_OLD_COPY_ON_WRITE
1291 !SvIsCOW(PL_curpad[po])
1293 !SvFAKE(PL_curpad[po])
1296 SvREADONLY_off(PL_curpad[po]); /* could be a freed constant */
1299 if ((I32)po < PL_padix)
1306 =for apidoc do_dump_pad
1308 Dump the contents of a padlist
1314 Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
1326 pad_name = (AV*)*av_fetch((AV*)padlist, 0, FALSE);
1327 pad = (AV*)*av_fetch((AV*)padlist, 1, FALSE);
1328 pname = AvARRAY(pad_name);
1329 ppad = AvARRAY(pad);
1330 Perl_dump_indent(aTHX_ level, file,
1331 "PADNAME = 0x%"UVxf"(0x%"UVxf") PAD = 0x%"UVxf"(0x%"UVxf")\n",
1332 PTR2UV(pad_name), PTR2UV(pname), PTR2UV(pad), PTR2UV(ppad)
1335 for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
1336 const SV *namesv = pname[ix];
1337 if (namesv && namesv == &PL_sv_undef) {
1342 Perl_dump_indent(aTHX_ level+1, file,
1343 "%2d. 0x%"UVxf"<%lu> FAKE \"%s\" flags=0x%lx index=%lu\n",
1346 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
1347 SvPVX_const(namesv),
1348 (unsigned long)PARENT_FAKELEX_FLAGS(namesv),
1349 (unsigned long)PARENT_PAD_INDEX(namesv)
1353 Perl_dump_indent(aTHX_ level+1, file,
1354 "%2d. 0x%"UVxf"<%lu> (%lu,%lu) \"%s\"\n",
1357 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
1358 (unsigned long)COP_SEQ_RANGE_LOW(namesv),
1359 (unsigned long)COP_SEQ_RANGE_HIGH(namesv),
1364 Perl_dump_indent(aTHX_ level+1, file,
1365 "%2d. 0x%"UVxf"<%lu>\n",
1368 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0)
1379 dump the contents of a CV
1386 S_cv_dump(pTHX_ const CV *cv, const char *title)
1389 const CV * const outside = CvOUTSIDE(cv);
1390 AV* const padlist = CvPADLIST(cv);
1392 PerlIO_printf(Perl_debug_log,
1393 " %s: CV=0x%"UVxf" (%s), OUTSIDE=0x%"UVxf" (%s)\n",
1396 (CvANON(cv) ? "ANON"
1397 : (SvTYPE(cv) == SVt_PVFM) ? "FORMAT"
1398 : (cv == PL_main_cv) ? "MAIN"
1399 : CvUNIQUE(cv) ? "UNIQUE"
1400 : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
1403 : CvANON(outside) ? "ANON"
1404 : (outside == PL_main_cv) ? "MAIN"
1405 : CvUNIQUE(outside) ? "UNIQUE"
1406 : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
1408 PerlIO_printf(Perl_debug_log,
1409 " PADLIST = 0x%"UVxf"\n", PTR2UV(padlist));
1410 do_dump_pad(1, Perl_debug_log, padlist, 1);
1412 #endif /* DEBUGGING */
1419 =for apidoc cv_clone
1421 Clone a CV: make a new CV which points to the same code etc, but which
1422 has a newly-created pad built by copying the prototype pad and capturing
1429 Perl_cv_clone(pTHX_ CV *proto)
1433 AV* const protopadlist = CvPADLIST(proto);
1434 const AV* const protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
1435 const AV* const protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
1436 SV** const pname = AvARRAY(protopad_name);
1437 SV** const ppad = AvARRAY(protopad);
1438 const I32 fname = AvFILLp(protopad_name);
1439 const I32 fpad = AvFILLp(protopad);
1445 assert(!CvUNIQUE(proto));
1447 /* Since cloneable anon subs can be nested, CvOUTSIDE may point
1448 * to a prototype; we instead want the cloned parent who called us.
1449 * Note that in general for formats, CvOUTSIDE != find_runcv */
1451 outside = CvOUTSIDE(proto);
1452 if (outside && CvCLONE(outside) && ! CvCLONED(outside))
1453 outside = find_runcv(NULL);
1454 depth = CvDEPTH(outside);
1455 assert(depth || SvTYPE(proto) == SVt_PVFM);
1458 assert(CvPADLIST(outside));
1461 SAVESPTR(PL_compcv);
1463 cv = PL_compcv = (CV*)newSV_type(SvTYPE(proto));
1464 CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE);
1468 CvFILE(cv) = CvISXSUB(proto) ? CvFILE(proto)
1469 : savepv(CvFILE(proto));
1471 CvFILE(cv) = CvFILE(proto);
1473 CvGV(cv) = CvGV(proto);
1474 CvSTASH(cv) = CvSTASH(proto);
1476 CvROOT(cv) = OpREFCNT_inc(CvROOT(proto));
1478 CvSTART(cv) = CvSTART(proto);
1479 CvOUTSIDE(cv) = (CV*)SvREFCNT_inc_simple(outside);
1480 CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
1483 sv_setpvn((SV*)cv, SvPVX_const(proto), SvCUR(proto));
1485 CvPADLIST(cv) = pad_new(padnew_CLONE|padnew_SAVE);
1487 av_fill(PL_comppad, fpad);
1488 for (ix = fname; ix >= 0; ix--)
1489 av_store(PL_comppad_name, ix, SvREFCNT_inc(pname[ix]));
1491 PL_curpad = AvARRAY(PL_comppad);
1493 outpad = AvARRAY(AvARRAY(CvPADLIST(outside))[depth]);
1495 for (ix = fpad; ix > 0; ix--) {
1496 SV* const namesv = (ix <= fname) ? pname[ix] : NULL;
1498 if (namesv && namesv != &PL_sv_undef) { /* lexical */
1499 if (SvFAKE(namesv)) { /* lexical from outside? */
1500 sv = outpad[PARENT_PAD_INDEX(namesv)];
1502 /* formats may have an inactive parent,
1503 while my $x if $false can leave an active var marked as
1504 stale. And state vars are always available */
1505 if (SvPADSTALE(sv) && !SvPAD_STATE(namesv)) {
1506 if (ckWARN(WARN_CLOSURE))
1507 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
1508 "Variable \"%s\" is not available", SvPVX_const(namesv));
1512 SvREFCNT_inc_simple_void_NN(sv);
1515 const char sigil = SvPVX_const(namesv)[0];
1517 sv = SvREFCNT_inc(ppad[ix]);
1518 else if (sigil == '@')
1520 else if (sigil == '%')
1525 /* reset the 'assign only once' flag on each state var */
1526 if (SvPAD_STATE(namesv))
1530 else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) {
1531 sv = SvREFCNT_inc_NN(ppad[ix]);
1541 PerlIO_printf(Perl_debug_log, "\nPad CV clone\n");
1542 cv_dump(outside, "Outside");
1543 cv_dump(proto, "Proto");
1550 /* Constant sub () { $x } closing over $x - see lib/constant.pm:
1551 * The prototype was marked as a candiate for const-ization,
1552 * so try to grab the current const value, and if successful,
1553 * turn into a const sub:
1555 SV* const const_sv = op_const_sv(CvSTART(cv), cv);
1558 cv = newCONSTSUB(CvSTASH(proto), NULL, const_sv);
1570 =for apidoc pad_fixup_inner_anons
1572 For any anon CVs in the pad, change CvOUTSIDE of that CV from
1573 old_cv to new_cv if necessary. Needed when a newly-compiled CV has to be
1574 moved to a pre-existing CV struct.
1580 Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
1584 AV * const comppad_name = (AV*)AvARRAY(padlist)[0];
1585 AV * const comppad = (AV*)AvARRAY(padlist)[1];
1586 SV ** const namepad = AvARRAY(comppad_name);
1587 SV ** const curpad = AvARRAY(comppad);
1588 PERL_UNUSED_ARG(old_cv);
1590 for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
1591 const SV * const namesv = namepad[ix];
1592 if (namesv && namesv != &PL_sv_undef
1593 && *SvPVX_const(namesv) == '&')
1595 CV * const innercv = (CV*)curpad[ix];
1596 assert(CvWEAKOUTSIDE(innercv));
1597 assert(CvOUTSIDE(innercv) == old_cv);
1598 CvOUTSIDE(innercv) = new_cv;
1605 =for apidoc pad_push
1607 Push a new pad frame onto the padlist, unless there's already a pad at
1608 this depth, in which case don't bother creating a new one. Then give
1609 the new pad an @_ in slot zero.
1615 Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
1618 if (depth > AvFILLp(padlist)) {
1619 SV** const svp = AvARRAY(padlist);
1620 AV* const newpad = newAV();
1621 SV** const oldpad = AvARRAY(svp[depth-1]);
1622 I32 ix = AvFILLp((AV*)svp[1]);
1623 const I32 names_fill = AvFILLp((AV*)svp[0]);
1624 SV** const names = AvARRAY(svp[0]);
1627 for ( ;ix > 0; ix--) {
1628 if (names_fill >= ix && names[ix] != &PL_sv_undef) {
1629 const char sigil = SvPVX_const(names[ix])[0];
1630 if ((SvFLAGS(names[ix]) & SVf_FAKE)
1631 || (SvFLAGS(names[ix]) & SVpad_STATE)
1634 /* outer lexical or anon code */
1635 av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]));
1637 else { /* our own lexical */
1641 else if (sigil == '%')
1645 av_store(newpad, ix, sv);
1649 else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
1650 av_store(newpad, ix, SvREFCNT_inc_NN(oldpad[ix]));
1653 /* save temporaries on recursion? */
1654 SV * const sv = newSV(0);
1655 av_store(newpad, ix, sv);
1661 av_store(newpad, 0, (SV*)av);
1664 av_store(padlist, depth, (SV*)newpad);
1665 AvFILLp(padlist) = depth;
1671 Perl_pad_compname_type(pTHX_ const PADOFFSET po)
1674 SV* const * const av = av_fetch(PL_comppad_name, po, FALSE);
1675 if ( SvPAD_TYPED(*av) ) {
1676 return SvSTASH(*av);
1683 * c-indentation-style: bsd
1685 * indent-tabs-mode: t
1688 * ex: set ts=8 sts=4 sw=4 noet: