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 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 OURSTASH slot pointing at the stash of the associated global (so that
79 duplicate C<our> declarations in the same package can be detected). SvCUR 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();
110 #define PERL_IN_PAD_C
112 #include "keywords.h"
114 #define COP_SEQ_RANGE_LOW_set(sv,val) \
115 STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xlow = (val); } STMT_END
116 #define COP_SEQ_RANGE_HIGH_set(sv,val) \
117 STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xhigh = (val); } STMT_END
119 #define PARENT_PAD_INDEX_set(sv,val) \
120 STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xlow = (val); } STMT_END
121 #define PARENT_FAKELEX_FLAGS_set(sv,val) \
122 STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xhigh = (val); } STMT_END
124 #define PAD_MAX IV_MAX
127 void pad_peg(const char* s) {
136 Create a new compiling padlist, saving and updating the various global
137 vars at the same time as creating the pad itself. The following flags
138 can be OR'ed together:
140 padnew_CLONE this pad is for a cloned CV
141 padnew_SAVE save old globals
142 padnew_SAVESUB also save extra stuff for start of sub
148 Perl_pad_new(pTHX_ int flags)
151 AV *padlist, *padname, *pad;
153 ASSERT_CURPAD_LEGAL("pad_new");
155 /* XXX DAPM really need a new SAVEt_PAD which restores all or most
156 * vars (based on flags) rather than storing vals + addresses for
157 * each individually. Also see pad_block_start.
158 * XXX DAPM Try to see whether all these conditionals are required
161 /* save existing state, ... */
163 if (flags & padnew_SAVE) {
165 SAVESPTR(PL_comppad_name);
166 if (! (flags & padnew_CLONE)) {
168 SAVEI32(PL_comppad_name_fill);
169 SAVEI32(PL_min_intro_pending);
170 SAVEI32(PL_max_intro_pending);
171 SAVEI32(PL_cv_has_eval);
172 if (flags & padnew_SAVESUB) {
173 SAVEI32(PL_pad_reset_pending);
177 /* XXX DAPM interestingly, PL_comppad_name_floor never seems to be
178 * saved - check at some pt that this is okay */
180 /* ... create new pad ... */
186 if (flags & padnew_CLONE) {
187 /* XXX DAPM I dont know why cv_clone needs it
188 * doing differently yet - perhaps this separate branch can be
189 * dispensed with eventually ???
192 AV * const a0 = newAV(); /* will be @_ */
194 av_store(pad, 0, (SV*)a0);
198 av_store(pad, 0, NULL);
202 av_store(padlist, 0, (SV*)padname);
203 av_store(padlist, 1, (SV*)pad);
205 /* ... then update state variables */
207 PL_comppad_name = (AV*)(*av_fetch(padlist, 0, FALSE));
208 PL_comppad = (AV*)(*av_fetch(padlist, 1, FALSE));
209 PL_curpad = AvARRAY(PL_comppad);
211 if (! (flags & padnew_CLONE)) {
212 PL_comppad_name_fill = 0;
213 PL_min_intro_pending = 0;
218 DEBUG_X(PerlIO_printf(Perl_debug_log,
219 "Pad 0x%"UVxf"[0x%"UVxf"] new: compcv=0x%"UVxf
220 " name=0x%"UVxf" flags=0x%"UVxf"\n",
221 PTR2UV(PL_comppad), PTR2UV(PL_curpad), PTR2UV(PL_compcv),
222 PTR2UV(padname), (UV)flags
226 return (PADLIST*)padlist;
230 =for apidoc pad_undef
232 Free the padlist associated with a CV.
233 If parts of it happen to be current, we null the relevant
234 PL_*pad* global vars so that we don't have any dangling references left.
235 We also repoint the CvOUTSIDE of any about-to-be-orphaned
236 inner subs to the outer of this cv.
238 (This function should really be called pad_free, but the name was already
245 Perl_pad_undef(pTHX_ CV* cv)
249 const PADLIST * const padlist = CvPADLIST(cv);
251 pad_peg("pad_undef");
254 if (SvIS_FREED(padlist)) /* may be during global destruction */
257 DEBUG_X(PerlIO_printf(Perl_debug_log,
258 "Pad undef: cv=0x%"UVxf" padlist=0x%"UVxf"\n",
259 PTR2UV(cv), PTR2UV(padlist))
262 /* detach any '&' anon children in the pad; if afterwards they
263 * are still live, fix up their CvOUTSIDEs to point to our outside,
265 /* XXX DAPM for efficiency, we should only do this if we know we have
266 * children, or integrate this loop with general cleanup */
268 if (!PL_dirty) { /* don't bother during global destruction */
269 CV * const outercv = CvOUTSIDE(cv);
270 const U32 seq = CvOUTSIDE_SEQ(cv);
271 AV * const comppad_name = (AV*)AvARRAY(padlist)[0];
272 SV ** const namepad = AvARRAY(comppad_name);
273 AV * const comppad = (AV*)AvARRAY(padlist)[1];
274 SV ** const curpad = AvARRAY(comppad);
275 for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
276 SV * const namesv = namepad[ix];
277 if (namesv && namesv != &PL_sv_undef
278 && *SvPVX_const(namesv) == '&')
280 CV * const innercv = (CV*)curpad[ix];
281 U32 inner_rc = SvREFCNT(innercv);
284 SvREFCNT_dec(namesv);
286 if (SvREFCNT(comppad) < 2) { /* allow for /(?{ sub{} })/ */
288 SvREFCNT_dec(innercv);
292 /* in use, not just a prototype */
293 if (inner_rc && (CvOUTSIDE(innercv) == cv)) {
294 assert(CvWEAKOUTSIDE(innercv));
295 /* don't relink to grandfather if he's being freed */
296 if (outercv && SvREFCNT(outercv)) {
297 CvWEAKOUTSIDE_off(innercv);
298 CvOUTSIDE(innercv) = outercv;
299 CvOUTSIDE_SEQ(innercv) = seq;
300 SvREFCNT_inc_simple_void_NN(outercv);
303 CvOUTSIDE(innercv) = NULL;
310 ix = AvFILLp(padlist);
312 const SV* const sv = AvARRAY(padlist)[ix--];
314 if (sv == (SV*)PL_comppad_name)
315 PL_comppad_name = NULL;
316 else if (sv == (SV*)PL_comppad) {
323 SvREFCNT_dec((SV*)CvPADLIST(cv));
324 CvPADLIST(cv) = NULL;
331 =for apidoc pad_add_name
333 Create a new name and associated PADMY SV in the current pad; return the
335 If C<typestash> is valid, the name is for a typed lexical; set the
336 name's stash to that value.
337 If C<ourstash> is valid, it's an our lexical, set the name's
338 OURSTASH to that value
340 If fake, it means we're cloning an existing entry
346 Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake, bool state)
349 const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
350 SV* const namesv = newSV(0);
352 ASSERT_CURPAD_ACTIVE("pad_add_name");
355 sv_upgrade(namesv, (ourstash || typestash) ? SVt_PVMG : SVt_PVNV);
356 sv_setpv(namesv, name);
359 assert(SvTYPE(namesv) == SVt_PVMG);
360 SvPAD_TYPED_on(namesv);
361 SvSTASH_set(namesv, (HV*)SvREFCNT_inc_simple_NN((SV*)typestash));
364 SvPAD_OUR_on(namesv);
365 OURSTASH_set(namesv, ourstash);
366 SvREFCNT_inc_simple_void_NN(ourstash);
369 SvPAD_STATE_on(namesv);
372 av_store(PL_comppad_name, offset, namesv);
375 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
376 "Pad addname: %ld \"%s\" FAKE\n", (long)offset, name));
379 /* not yet introduced */
380 COP_SEQ_RANGE_LOW_set(namesv, PAD_MAX); /* min */
381 COP_SEQ_RANGE_HIGH_set(namesv, 0); /* max */
383 if (!PL_min_intro_pending)
384 PL_min_intro_pending = offset;
385 PL_max_intro_pending = offset;
386 /* if it's not a simple scalar, replace with an AV or HV */
387 /* XXX DAPM since slot has been allocated, replace
388 * av_store with PL_curpad[offset] ? */
390 av_store(PL_comppad, offset, (SV*)newAV());
391 else if (*name == '%')
392 av_store(PL_comppad, offset, (SV*)newHV());
393 SvPADMY_on(PL_curpad[offset]);
394 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
395 "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
396 (long)offset, name, PTR2UV(PL_curpad[offset])));
406 =for apidoc pad_alloc
408 Allocate a new my or tmp pad entry. For a my, simply push a null SV onto
409 the end of PL_comppad, but for a tmp, scan the pad from PL_padix upwards
410 for a slot which has no name and no active value.
415 /* XXX DAPM integrate alloc(), add_name() and add_anon(),
416 * or at least rationalise ??? */
417 /* And flag whether the incoming name is UTF8 or 8 bit?
418 Could do this either with the +ve/-ve hack of the HV code, or expanding
419 the flag bits. Either way, this makes proper Unicode safe pad support.
420 Also could change the sv structure to make the NV a union with 2 U32s,
421 so that SvCUR() could stop being overloaded in pad SVs.
426 Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
432 PERL_UNUSED_ARG(optype);
433 ASSERT_CURPAD_ACTIVE("pad_alloc");
435 if (AvARRAY(PL_comppad) != PL_curpad)
436 Perl_croak(aTHX_ "panic: pad_alloc");
437 if (PL_pad_reset_pending)
439 if (tmptype & SVs_PADMY) {
440 sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE);
441 retval = AvFILLp(PL_comppad);
444 SV * const * const names = AvARRAY(PL_comppad_name);
445 const SSize_t names_fill = AvFILLp(PL_comppad_name);
448 * "foreach" index vars temporarily become aliases to non-"my"
449 * values. Thus we must skip, not just pad values that are
450 * marked as current pad values, but also those with names.
452 /* HVDS why copy to sv here? we don't seem to use it */
453 if (++PL_padix <= names_fill &&
454 (sv = names[PL_padix]) && sv != &PL_sv_undef)
456 sv = *av_fetch(PL_comppad, PL_padix, TRUE);
457 if (!(SvFLAGS(sv) & (SVs_PADTMP | SVs_PADMY)) &&
458 !IS_PADGV(sv) && !IS_PADCONST(sv))
463 SvFLAGS(sv) |= tmptype;
464 PL_curpad = AvARRAY(PL_comppad);
466 DEBUG_X(PerlIO_printf(Perl_debug_log,
467 "Pad 0x%"UVxf"[0x%"UVxf"] alloc: %ld for %s\n",
468 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long) retval,
469 PL_op_name[optype]));
470 #ifdef DEBUG_LEAKING_SCALARS
471 sv->sv_debug_optype = optype;
472 sv->sv_debug_inpad = 1;
474 return (PADOFFSET)retval;
478 =for apidoc pad_add_anon
480 Add an anon code entry to the current compiling pad
486 Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
490 SV* const name = newSV(0);
492 sv_upgrade(name, SVt_PVNV);
493 sv_setpvn(name, "&", 1);
494 /* Are these two actually ever read? */
495 COP_SEQ_RANGE_HIGH_set(name, ~0);
496 COP_SEQ_RANGE_LOW_set(name, 1);
497 ix = pad_alloc(op_type, SVs_PADMY);
498 av_store(PL_comppad_name, ix, name);
499 /* XXX DAPM use PL_curpad[] ? */
500 av_store(PL_comppad, ix, sv);
503 /* to avoid ref loops, we never have parent + child referencing each
504 * other simultaneously */
505 if (CvOUTSIDE((CV*)sv)) {
506 assert(!CvWEAKOUTSIDE((CV*)sv));
507 CvWEAKOUTSIDE_on((CV*)sv);
508 SvREFCNT_dec(CvOUTSIDE((CV*)sv));
516 =for apidoc pad_check_dup
518 Check for duplicate declarations: report any of:
519 * a my in the current scope with the same name;
520 * an our (anywhere in the pad) with the same name and the same stash
522 C<is_our> indicates that the name to check is an 'our' declaration
527 /* XXX DAPM integrate this into pad_add_name ??? */
530 Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash)
536 ASSERT_CURPAD_ACTIVE("pad_check_dup");
537 if (AvFILLp(PL_comppad_name) < 0 || !ckWARN(WARN_MISC))
538 return; /* nothing to check */
540 svp = AvARRAY(PL_comppad_name);
541 top = AvFILLp(PL_comppad_name);
542 /* check the current scope */
543 /* XXX DAPM - why the (I32) cast - shouldn't we ensure they're the same
545 for (off = top; (I32)off > PL_comppad_name_floor; off--) {
546 SV * const sv = svp[off];
548 && sv != &PL_sv_undef
550 && (COP_SEQ_RANGE_HIGH(sv) == PAD_MAX || COP_SEQ_RANGE_HIGH(sv) == 0)
551 && strEQ(name, SvPVX_const(sv)))
553 if (is_our && (SvPAD_OUR(sv)))
554 break; /* "our" masking "our" */
555 Perl_warner(aTHX_ packWARN(WARN_MISC),
556 "\"%s\" variable %s masks earlier declaration in same %s",
557 (is_our ? "our" : PL_in_my == KEY_my ? "my" : "state"),
559 (COP_SEQ_RANGE_HIGH(sv) == PAD_MAX ? "scope" : "statement"));
564 /* check the rest of the pad */
567 SV * const sv = svp[off];
569 && sv != &PL_sv_undef
571 && (COP_SEQ_RANGE_HIGH(sv) == PAD_MAX || COP_SEQ_RANGE_HIGH(sv) == 0)
572 && OURSTASH(sv) == ourstash
573 && strEQ(name, SvPVX_const(sv)))
575 Perl_warner(aTHX_ packWARN(WARN_MISC),
576 "\"our\" variable %s redeclared", name);
577 if ((I32)off <= PL_comppad_name_floor)
578 Perl_warner(aTHX_ packWARN(WARN_MISC),
579 "\t(Did you mean \"local\" instead of \"our\"?)\n");
582 } while ( off-- > 0 );
588 =for apidoc pad_findmy
590 Given a lexical name, try to find its offset, first in the current pad,
591 or failing that, in the pads of any lexically enclosing subs (including
592 the complications introduced by eval). If the name is found in an outer pad,
593 then a fake entry is added to the current pad.
594 Returns the offset in the current pad, or NOT_IN_PAD on failure.
600 Perl_pad_findmy(pTHX_ const char *name)
609 pad_peg("pad_findmy");
610 offset = pad_findlex(name, PL_compcv, PL_cop_seqmax, 1,
611 NULL, &out_sv, &out_flags);
612 if ((PADOFFSET)offset != NOT_IN_PAD)
615 /* look for an our that's being introduced; this allows
616 * our $foo = 0 unless defined $foo;
617 * to not give a warning. (Yes, this is a hack) */
619 nameav = (AV*)AvARRAY(CvPADLIST(PL_compcv))[0];
620 name_svp = AvARRAY(nameav);
621 for (offset = AvFILLp(nameav); offset > 0; offset--) {
622 const SV * const namesv = name_svp[offset];
623 if (namesv && namesv != &PL_sv_undef
625 && (SvPAD_OUR(namesv))
626 && strEQ(SvPVX_const(namesv), name)
627 && COP_SEQ_RANGE_LOW(namesv) == PAD_MAX /* min */
635 * Returns the offset of a lexical $_, if there is one, at run time.
636 * Used by the UNDERBAR XS macro.
640 Perl_find_rundefsvoffset(pTHX)
645 return pad_findlex("$_", find_runcv(NULL), PL_curcop->cop_seq, 1,
646 NULL, &out_sv, &out_flags);
650 =for apidoc pad_findlex
652 Find a named lexical anywhere in a chain of nested pads. Add fake entries
653 in the inner pads if it's found in an outer one.
655 Returns the offset in the bottom pad of the lex or the fake lex.
656 cv is the CV in which to start the search, and seq is the current cop_seq
657 to match against. If warn is true, print appropriate warnings. The out_*
658 vars return values, and so are pointers to where the returned values
659 should be stored. out_capture, if non-null, requests that the innermost
660 instance of the lexical is captured; out_name_sv is set to the innermost
661 matched namesv or fake namesv; out_flags returns the flags normally
662 associated with the IVX field of a fake namesv.
664 Note that pad_findlex() is recursive; it recurses up the chain of CVs,
665 then comes back down, adding fake entries as it goes. It has to be this way
666 because fake namesvs in anon protoypes have to store in xlow the index into
672 /* Flags set in the SvIVX field of FAKE namesvs */
674 #define PAD_FAKELEX_ANON 1 /* the lex is declared in an ANON, or ... */
675 #define PAD_FAKELEX_MULTI 2 /* the lex can be instantiated multiple times */
677 /* the CV has finished being compiled. This is not a sufficient test for
678 * all CVs (eg XSUBs), but suffices for the CVs found in a lexical chain */
679 #define CvCOMPILED(cv) CvROOT(cv)
681 /* the CV does late binding of its lexicals */
682 #define CvLATE(cv) (CvANON(cv) || SvTYPE(cv) == SVt_PVFM)
686 S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
687 SV** out_capture, SV** out_name_sv, int *out_flags)
690 I32 offset, new_offset;
693 const AV * const padlist = CvPADLIST(cv);
697 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
698 "Pad findlex cv=0x%"UVxf" searching \"%s\" seq=%d%s\n",
699 PTR2UV(cv), name, (int)seq, out_capture ? " capturing" : "" ));
701 /* first, search this pad */
703 if (padlist) { /* not an undef CV */
705 const AV * const nameav = (AV*)AvARRAY(padlist)[0];
706 SV * const * const name_svp = AvARRAY(nameav);
708 for (offset = AvFILLp(nameav); offset > 0; offset--) {
709 const SV * const namesv = name_svp[offset];
710 if (namesv && namesv != &PL_sv_undef
711 && strEQ(SvPVX_const(namesv), name))
714 fake_offset = offset; /* in case we don't find a real one */
715 else if ( seq > COP_SEQ_RANGE_LOW(namesv) /* min */
716 && seq <= COP_SEQ_RANGE_HIGH(namesv)) /* max */
721 if (offset > 0 || fake_offset > 0 ) { /* a match! */
722 if (offset > 0) { /* not fake */
724 *out_name_sv = name_svp[offset]; /* return the namesv */
726 /* set PAD_FAKELEX_MULTI if this lex can have multiple
727 * instances. For now, we just test !CvUNIQUE(cv), but
728 * ideally, we should detect my's declared within loops
729 * etc - this would allow a wider range of 'not stayed
730 * shared' warnings. We also treated alreadly-compiled
731 * lexes as not multi as viewed from evals. */
733 *out_flags = CvANON(cv) ?
735 (!CvUNIQUE(cv) && ! CvCOMPILED(cv))
736 ? PAD_FAKELEX_MULTI : 0;
738 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
739 "Pad findlex cv=0x%"UVxf" matched: offset=%ld (%lu,%lu)\n",
740 PTR2UV(cv), (long)offset,
741 (unsigned long)COP_SEQ_RANGE_LOW(*out_name_sv),
742 (unsigned long)COP_SEQ_RANGE_HIGH(*out_name_sv)));
744 else { /* fake match */
745 offset = fake_offset;
746 *out_name_sv = name_svp[offset]; /* return the namesv */
747 *out_flags = PARENT_FAKELEX_FLAGS(*out_name_sv);
748 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
749 "Pad findlex cv=0x%"UVxf" matched: offset=%ld flags=0x%lx index=%lu\n",
750 PTR2UV(cv), (long)offset, (unsigned long)*out_flags,
751 (unsigned long) PARENT_PAD_INDEX(*out_name_sv)
755 /* return the lex? */
760 if (SvPAD_OUR(*out_name_sv)) {
765 /* trying to capture from an anon prototype? */
767 ? CvANON(cv) && CvCLONE(cv) && !CvCLONED(cv)
768 : *out_flags & PAD_FAKELEX_ANON)
770 if (warn && ckWARN(WARN_CLOSURE))
771 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
772 "Variable \"%s\" is not available", name);
779 if (!CvCOMPILED(cv) && (*out_flags & PAD_FAKELEX_MULTI)
780 && warn && ckWARN(WARN_CLOSURE)) {
782 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
783 "Variable \"%s\" will not stay shared", name);
786 if (fake_offset && CvANON(cv)
787 && CvCLONE(cv) &&!CvCLONED(cv))
790 /* not yet caught - look further up */
791 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
792 "Pad findlex cv=0x%"UVxf" chasing lex in outer pad\n",
795 (void) pad_findlex(name, CvOUTSIDE(cv),
797 newwarn, out_capture, out_name_sv, out_flags);
802 *out_capture = AvARRAY((AV*)AvARRAY(padlist)[
803 CvDEPTH(cv) ? CvDEPTH(cv) : 1])[offset];
804 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
805 "Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n",
806 PTR2UV(cv), PTR2UV(*out_capture)));
808 if (SvPADSTALE(*out_capture)) {
809 if (ckWARN(WARN_CLOSURE))
810 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
811 "Variable \"%s\" is not available", name);
817 *out_capture = sv_2mortal((SV*)newAV());
818 else if (*name == '%')
819 *out_capture = sv_2mortal((SV*)newHV());
821 *out_capture = sv_newmortal();
829 /* it's not in this pad - try above */
834 /* out_capture non-null means caller wants us to capture lex; in
835 * addition we capture ourselves unless it's an ANON/format */
836 new_capturep = out_capture ? out_capture :
837 CvLATE(cv) ? NULL : &new_capture;
839 offset = pad_findlex(name, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1,
840 new_capturep, out_name_sv, out_flags);
841 if ((PADOFFSET)offset == NOT_IN_PAD)
844 /* found in an outer CV. Add appropriate fake entry to this pad */
846 /* don't add new fake entries (via eval) to CVs that we have already
847 * finished compiling, or to undef CVs */
848 if (CvCOMPILED(cv) || !padlist)
849 return 0; /* this dummy (and invalid) value isnt used by the caller */
853 AV * const ocomppad_name = PL_comppad_name;
854 PAD * const ocomppad = PL_comppad;
855 PL_comppad_name = (AV*)AvARRAY(padlist)[0];
856 PL_comppad = (AV*)AvARRAY(padlist)[1];
857 PL_curpad = AvARRAY(PL_comppad);
859 new_offset = pad_add_name(
860 SvPVX_const(*out_name_sv),
861 SvPAD_TYPED(*out_name_sv)
862 ? SvSTASH(*out_name_sv) : NULL,
863 OURSTASH(*out_name_sv),
865 0 /* not a state variable */
868 new_namesv = AvARRAY(PL_comppad_name)[new_offset];
869 PARENT_FAKELEX_FLAGS_set(new_namesv, *out_flags);
871 PARENT_PAD_INDEX_set(new_namesv, 0);
872 if (SvPAD_OUR(new_namesv)) {
873 NOOP; /* do nothing */
875 else if (CvLATE(cv)) {
876 /* delayed creation - just note the offset within parent pad */
877 PARENT_PAD_INDEX_set(new_namesv, offset);
881 /* immediate creation - capture outer value right now */
882 av_store(PL_comppad, new_offset, SvREFCNT_inc(*new_capturep));
883 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
884 "Pad findlex cv=0x%"UVxf" saved captured sv 0x%"UVxf" at offset %ld\n",
885 PTR2UV(cv), PTR2UV(*new_capturep), (long)new_offset));
887 *out_name_sv = new_namesv;
888 *out_flags = PARENT_FAKELEX_FLAGS(new_namesv);
890 PL_comppad_name = ocomppad_name;
891 PL_comppad = ocomppad;
892 PL_curpad = ocomppad ? AvARRAY(ocomppad) : NULL;
902 Get the value at offset po in the current pad.
903 Use macro PAD_SV instead of calling this function directly.
910 Perl_pad_sv(pTHX_ PADOFFSET po)
913 ASSERT_CURPAD_ACTIVE("pad_sv");
916 Perl_croak(aTHX_ "panic: pad_sv po");
917 DEBUG_X(PerlIO_printf(Perl_debug_log,
918 "Pad 0x%"UVxf"[0x%"UVxf"] sv: %ld sv=0x%"UVxf"\n",
919 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(PL_curpad[po]))
921 return PL_curpad[po];
926 =for apidoc pad_setsv
928 Set the entry at offset po in the current pad to sv.
929 Use the macro PAD_SETSV() rather than calling this function directly.
935 Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
938 ASSERT_CURPAD_ACTIVE("pad_setsv");
940 DEBUG_X(PerlIO_printf(Perl_debug_log,
941 "Pad 0x%"UVxf"[0x%"UVxf"] setsv: %ld sv=0x%"UVxf"\n",
942 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(sv))
951 =for apidoc pad_block_start
953 Update the pad compilation state variables on entry to a new block
959 * - integrate this in general state-saving routine ???
960 * - combine with the state-saving going on in pad_new ???
961 * - introduce a new SAVE type that does all this in one go ?
965 Perl_pad_block_start(pTHX_ int full)
968 ASSERT_CURPAD_ACTIVE("pad_block_start");
969 SAVEI32(PL_comppad_name_floor);
970 PL_comppad_name_floor = AvFILLp(PL_comppad_name);
972 PL_comppad_name_fill = PL_comppad_name_floor;
973 if (PL_comppad_name_floor < 0)
974 PL_comppad_name_floor = 0;
975 SAVEI32(PL_min_intro_pending);
976 SAVEI32(PL_max_intro_pending);
977 PL_min_intro_pending = 0;
978 SAVEI32(PL_comppad_name_fill);
979 SAVEI32(PL_padix_floor);
980 PL_padix_floor = PL_padix;
981 PL_pad_reset_pending = FALSE;
988 "Introduce" my variables to visible status.
1000 ASSERT_CURPAD_ACTIVE("intro_my");
1001 if (! PL_min_intro_pending)
1002 return PL_cop_seqmax;
1004 svp = AvARRAY(PL_comppad_name);
1005 for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
1006 SV * const sv = svp[i];
1008 if (sv && sv != &PL_sv_undef && !SvFAKE(sv) && !COP_SEQ_RANGE_HIGH(sv)) {
1009 COP_SEQ_RANGE_HIGH_set(sv, PAD_MAX); /* Don't know scope end yet. */
1010 COP_SEQ_RANGE_LOW_set(sv, PL_cop_seqmax);
1011 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1012 "Pad intromy: %ld \"%s\", (%lu,%lu)\n",
1013 (long)i, SvPVX_const(sv),
1014 (unsigned long)COP_SEQ_RANGE_LOW(sv),
1015 (unsigned long)COP_SEQ_RANGE_HIGH(sv))
1019 PL_min_intro_pending = 0;
1020 PL_comppad_name_fill = PL_max_intro_pending; /* Needn't search higher */
1021 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1022 "Pad intromy: seq -> %ld\n", (long)(PL_cop_seqmax+1)));
1024 return PL_cop_seqmax++;
1028 =for apidoc pad_leavemy
1030 Cleanup at end of scope during compilation: set the max seq number for
1031 lexicals in this scope and warn of any lexicals that never got introduced.
1037 Perl_pad_leavemy(pTHX)
1041 SV * const * const svp = AvARRAY(PL_comppad_name);
1043 PL_pad_reset_pending = FALSE;
1045 ASSERT_CURPAD_ACTIVE("pad_leavemy");
1046 if (PL_min_intro_pending && PL_comppad_name_fill < PL_min_intro_pending) {
1047 for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
1048 const SV * const sv = svp[off];
1049 if (sv && sv != &PL_sv_undef
1050 && !SvFAKE(sv) && ckWARN_d(WARN_INTERNAL))
1051 Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
1052 "%"SVf" never introduced",
1056 /* "Deintroduce" my variables that are leaving with this scope. */
1057 for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_fill; off--) {
1058 const SV * const sv = svp[off];
1059 if (sv && sv != &PL_sv_undef && !SvFAKE(sv) && COP_SEQ_RANGE_HIGH(sv) == PAD_MAX) {
1060 COP_SEQ_RANGE_HIGH_set(sv, PL_cop_seqmax);
1061 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1062 "Pad leavemy: %ld \"%s\", (%lu,%lu)\n",
1063 (long)off, SvPVX_const(sv),
1064 (unsigned long)COP_SEQ_RANGE_LOW(sv),
1065 (unsigned long)COP_SEQ_RANGE_HIGH(sv))
1070 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1071 "Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax));
1076 =for apidoc pad_swipe
1078 Abandon the tmp in the current pad at offset po and replace with a
1085 Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
1088 ASSERT_CURPAD_LEGAL("pad_swipe");
1091 if (AvARRAY(PL_comppad) != PL_curpad)
1092 Perl_croak(aTHX_ "panic: pad_swipe curpad");
1094 Perl_croak(aTHX_ "panic: pad_swipe po");
1096 DEBUG_X(PerlIO_printf(Perl_debug_log,
1097 "Pad 0x%"UVxf"[0x%"UVxf"] swipe: %ld\n",
1098 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po));
1101 SvPADTMP_off(PL_curpad[po]);
1103 SvREFCNT_dec(PL_curpad[po]);
1106 /* if pad tmps aren't shared between ops, then there's no need to
1107 * create a new tmp when an existing op is freed */
1108 #ifdef USE_BROKEN_PAD_RESET
1109 PL_curpad[po] = newSV(0);
1110 SvPADTMP_on(PL_curpad[po]);
1112 PL_curpad[po] = &PL_sv_undef;
1114 if ((I32)po < PL_padix)
1120 =for apidoc pad_reset
1122 Mark all the current temporaries for reuse
1127 /* XXX pad_reset() is currently disabled because it results in serious bugs.
1128 * It causes pad temp TARGs to be shared between OPs. Since TARGs are pushed
1129 * on the stack by OPs that use them, there are several ways to get an alias
1130 * to a shared TARG. Such an alias will change randomly and unpredictably.
1131 * We avoid doing this until we can think of a Better Way.
1134 Perl_pad_reset(pTHX)
1137 #ifdef USE_BROKEN_PAD_RESET
1138 if (AvARRAY(PL_comppad) != PL_curpad)
1139 Perl_croak(aTHX_ "panic: pad_reset curpad");
1141 DEBUG_X(PerlIO_printf(Perl_debug_log,
1142 "Pad 0x%"UVxf"[0x%"UVxf"] reset: padix %ld -> %ld",
1143 PTR2UV(PL_comppad), PTR2UV(PL_curpad),
1144 (long)PL_padix, (long)PL_padix_floor
1148 if (!PL_tainting) { /* Can't mix tainted and non-tainted temporaries. */
1150 for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
1151 if (PL_curpad[po] && !SvIMMORTAL(PL_curpad[po]))
1152 SvPADTMP_off(PL_curpad[po]);
1154 PL_padix = PL_padix_floor;
1157 PL_pad_reset_pending = FALSE;
1162 =for apidoc pad_tidy
1164 Tidy up a pad after we've finished compiling it:
1165 * remove most stuff from the pads of anonsub prototypes;
1167 * mark tmps as such.
1172 /* XXX DAPM surely most of this stuff should be done properly
1173 * at the right time beforehand, rather than going around afterwards
1174 * cleaning up our mistakes ???
1178 Perl_pad_tidy(pTHX_ padtidy_type type)
1182 ASSERT_CURPAD_ACTIVE("pad_tidy");
1184 /* If this CV has had any 'eval-capable' ops planted in it
1185 * (ie it contains eval '...', //ee, /$var/ or /(?{..})/), Then any
1186 * anon prototypes in the chain of CVs should be marked as cloneable,
1187 * so that for example the eval's CV in C<< sub { eval '$x' } >> gets
1188 * the right CvOUTSIDE.
1189 * If running with -d, *any* sub may potentially have an eval
1190 * excuted within it.
1193 if (PL_cv_has_eval || PL_perldb) {
1195 for (cv = PL_compcv ;cv; cv = CvOUTSIDE(cv)) {
1196 if (cv != PL_compcv && CvCOMPILED(cv))
1197 break; /* no need to mark already-compiled code */
1199 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1200 "Pad clone on cv=0x%"UVxf"\n", PTR2UV(cv)));
1206 /* extend curpad to match namepad */
1207 if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
1208 av_store(PL_comppad_name, AvFILLp(PL_comppad), NULL);
1210 if (type == padtidy_SUBCLONE) {
1211 SV * const * const namep = AvARRAY(PL_comppad_name);
1214 for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1217 if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
1220 * The only things that a clonable function needs in its
1221 * pad are anonymous subs.
1222 * The rest are created anew during cloning.
1224 if (!((namesv = namep[ix]) != NULL &&
1225 namesv != &PL_sv_undef &&
1226 *SvPVX_const(namesv) == '&'))
1228 SvREFCNT_dec(PL_curpad[ix]);
1229 PL_curpad[ix] = NULL;
1233 else if (type == padtidy_SUB) {
1234 /* XXX DAPM this same bit of code keeps appearing !!! Rationalise? */
1235 AV * const av = newAV(); /* Will be @_ */
1237 av_store(PL_comppad, 0, (SV*)av);
1241 /* XXX DAPM rationalise these two similar branches */
1243 if (type == padtidy_SUB) {
1245 for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1246 if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
1248 if (!SvPADMY(PL_curpad[ix]))
1249 SvPADTMP_on(PL_curpad[ix]);
1252 else if (type == padtidy_FORMAT) {
1254 for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1255 if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix]))
1256 SvPADTMP_on(PL_curpad[ix]);
1259 PL_curpad = AvARRAY(PL_comppad);
1264 =for apidoc pad_free
1266 Free the SV at offset po in the current pad.
1271 /* XXX DAPM integrate with pad_swipe ???? */
1273 Perl_pad_free(pTHX_ PADOFFSET po)
1276 ASSERT_CURPAD_LEGAL("pad_free");
1279 if (AvARRAY(PL_comppad) != PL_curpad)
1280 Perl_croak(aTHX_ "panic: pad_free curpad");
1282 Perl_croak(aTHX_ "panic: pad_free po");
1284 DEBUG_X(PerlIO_printf(Perl_debug_log,
1285 "Pad 0x%"UVxf"[0x%"UVxf"] free: %ld\n",
1286 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po)
1289 if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
1290 SvPADTMP_off(PL_curpad[po]);
1292 /* SV could be a shared hash key (eg bugid #19022) */
1294 #ifdef PERL_OLD_COPY_ON_WRITE
1295 !SvIsCOW(PL_curpad[po])
1297 !SvFAKE(PL_curpad[po])
1300 SvREADONLY_off(PL_curpad[po]); /* could be a freed constant */
1303 if ((I32)po < PL_padix)
1310 =for apidoc do_dump_pad
1312 Dump the contents of a padlist
1318 Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
1330 pad_name = (AV*)*av_fetch((AV*)padlist, 0, FALSE);
1331 pad = (AV*)*av_fetch((AV*)padlist, 1, FALSE);
1332 pname = AvARRAY(pad_name);
1333 ppad = AvARRAY(pad);
1334 Perl_dump_indent(aTHX_ level, file,
1335 "PADNAME = 0x%"UVxf"(0x%"UVxf") PAD = 0x%"UVxf"(0x%"UVxf")\n",
1336 PTR2UV(pad_name), PTR2UV(pname), PTR2UV(pad), PTR2UV(ppad)
1339 for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
1340 const SV *namesv = pname[ix];
1341 if (namesv && namesv == &PL_sv_undef) {
1346 Perl_dump_indent(aTHX_ level+1, file,
1347 "%2d. 0x%"UVxf"<%lu> FAKE \"%s\" flags=0x%lx index=%lu\n",
1350 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
1351 SvPVX_const(namesv),
1352 (unsigned long)PARENT_FAKELEX_FLAGS(namesv),
1353 (unsigned long)PARENT_PAD_INDEX(namesv)
1357 Perl_dump_indent(aTHX_ level+1, file,
1358 "%2d. 0x%"UVxf"<%lu> (%lu,%lu) \"%s\"\n",
1361 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
1362 (unsigned long)COP_SEQ_RANGE_LOW(namesv),
1363 (unsigned long)COP_SEQ_RANGE_HIGH(namesv),
1368 Perl_dump_indent(aTHX_ level+1, file,
1369 "%2d. 0x%"UVxf"<%lu>\n",
1372 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0)
1383 dump the contents of a CV
1390 S_cv_dump(pTHX_ const CV *cv, const char *title)
1393 const CV * const outside = CvOUTSIDE(cv);
1394 AV* const padlist = CvPADLIST(cv);
1396 PerlIO_printf(Perl_debug_log,
1397 " %s: CV=0x%"UVxf" (%s), OUTSIDE=0x%"UVxf" (%s)\n",
1400 (CvANON(cv) ? "ANON"
1401 : (SvTYPE(cv) == SVt_PVFM) ? "FORMAT"
1402 : (cv == PL_main_cv) ? "MAIN"
1403 : CvUNIQUE(cv) ? "UNIQUE"
1404 : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
1407 : CvANON(outside) ? "ANON"
1408 : (outside == PL_main_cv) ? "MAIN"
1409 : CvUNIQUE(outside) ? "UNIQUE"
1410 : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
1412 PerlIO_printf(Perl_debug_log,
1413 " PADLIST = 0x%"UVxf"\n", PTR2UV(padlist));
1414 do_dump_pad(1, Perl_debug_log, padlist, 1);
1416 #endif /* DEBUGGING */
1423 =for apidoc cv_clone
1425 Clone a CV: make a new CV which points to the same code etc, but which
1426 has a newly-created pad built by copying the prototype pad and capturing
1433 Perl_cv_clone(pTHX_ CV *proto)
1437 AV* const protopadlist = CvPADLIST(proto);
1438 const AV* const protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
1439 const AV* const protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
1440 SV** const pname = AvARRAY(protopad_name);
1441 SV** const ppad = AvARRAY(protopad);
1442 const I32 fname = AvFILLp(protopad_name);
1443 const I32 fpad = AvFILLp(protopad);
1449 assert(!CvUNIQUE(proto));
1451 /* Since cloneable anon subs can be nested, CvOUTSIDE may point
1452 * to a prototype; we instead want the cloned parent who called us.
1453 * Note that in general for formats, CvOUTSIDE != find_runcv */
1455 outside = CvOUTSIDE(proto);
1456 if (outside && CvCLONE(outside) && ! CvCLONED(outside))
1457 outside = find_runcv(NULL);
1458 depth = CvDEPTH(outside);
1459 assert(depth || SvTYPE(proto) == SVt_PVFM);
1462 assert(CvPADLIST(outside));
1465 SAVESPTR(PL_compcv);
1467 cv = PL_compcv = (CV*)newSV(0);
1468 sv_upgrade((SV *)cv, SvTYPE(proto));
1469 CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE);
1473 CvFILE(cv) = CvISXSUB(proto) ? CvFILE(proto)
1474 : savepv(CvFILE(proto));
1476 CvFILE(cv) = CvFILE(proto);
1478 CvGV(cv) = CvGV(proto);
1479 CvSTASH(cv) = CvSTASH(proto);
1481 CvROOT(cv) = OpREFCNT_inc(CvROOT(proto));
1483 CvSTART(cv) = CvSTART(proto);
1484 CvOUTSIDE(cv) = (CV*)SvREFCNT_inc_simple(outside);
1485 CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
1488 sv_setpvn((SV*)cv, SvPVX_const(proto), SvCUR(proto));
1490 CvPADLIST(cv) = pad_new(padnew_CLONE|padnew_SAVE);
1492 av_fill(PL_comppad, fpad);
1493 for (ix = fname; ix >= 0; ix--)
1494 av_store(PL_comppad_name, ix, SvREFCNT_inc(pname[ix]));
1496 PL_curpad = AvARRAY(PL_comppad);
1498 outpad = AvARRAY(AvARRAY(CvPADLIST(outside))[depth]);
1500 for (ix = fpad; ix > 0; ix--) {
1501 SV* const namesv = (ix <= fname) ? pname[ix] : NULL;
1503 if (namesv && namesv != &PL_sv_undef) { /* lexical */
1504 if (SvFAKE(namesv)) { /* lexical from outside? */
1505 sv = outpad[PARENT_PAD_INDEX(namesv)];
1507 /* formats may have an inactive parent */
1508 if (SvTYPE(proto) == SVt_PVFM && SvPADSTALE(sv)) {
1509 if (ckWARN(WARN_CLOSURE))
1510 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
1511 "Variable \"%s\" is not available", SvPVX_const(namesv));
1515 assert(!SvPADSTALE(sv));
1516 SvREFCNT_inc_simple_void_NN(sv);
1520 const char sigil = SvPVX_const(namesv)[0];
1522 sv = SvREFCNT_inc(ppad[ix]);
1523 else if (sigil == '@')
1525 else if (sigil == '%')
1532 else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) {
1533 sv = SvREFCNT_inc_NN(ppad[ix]);
1543 PerlIO_printf(Perl_debug_log, "\nPad CV clone\n");
1544 cv_dump(outside, "Outside");
1545 cv_dump(proto, "Proto");
1552 /* Constant sub () { $x } closing over $x - see lib/constant.pm:
1553 * The prototype was marked as a candiate for const-ization,
1554 * so try to grab the current const value, and if successful,
1555 * turn into a const sub:
1557 SV* const const_sv = op_const_sv(CvSTART(cv), cv);
1560 cv = newCONSTSUB(CvSTASH(proto), NULL, const_sv);
1572 =for apidoc pad_fixup_inner_anons
1574 For any anon CVs in the pad, change CvOUTSIDE of that CV from
1575 old_cv to new_cv if necessary. Needed when a newly-compiled CV has to be
1576 moved to a pre-existing CV struct.
1582 Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
1586 AV * const comppad_name = (AV*)AvARRAY(padlist)[0];
1587 AV * const comppad = (AV*)AvARRAY(padlist)[1];
1588 SV ** const namepad = AvARRAY(comppad_name);
1589 SV ** const curpad = AvARRAY(comppad);
1590 PERL_UNUSED_ARG(old_cv);
1592 for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
1593 const SV * const namesv = namepad[ix];
1594 if (namesv && namesv != &PL_sv_undef
1595 && *SvPVX_const(namesv) == '&')
1597 CV * const innercv = (CV*)curpad[ix];
1598 assert(CvWEAKOUTSIDE(innercv));
1599 assert(CvOUTSIDE(innercv) == old_cv);
1600 CvOUTSIDE(innercv) = new_cv;
1607 =for apidoc pad_push
1609 Push a new pad frame onto the padlist, unless there's already a pad at
1610 this depth, in which case don't bother creating a new one. Then give
1611 the new pad an @_ in slot zero.
1617 Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
1620 if (depth > AvFILLp(padlist)) {
1621 SV** const svp = AvARRAY(padlist);
1622 AV* const newpad = newAV();
1623 SV** const oldpad = AvARRAY(svp[depth-1]);
1624 I32 ix = AvFILLp((AV*)svp[1]);
1625 const I32 names_fill = AvFILLp((AV*)svp[0]);
1626 SV** const names = AvARRAY(svp[0]);
1629 for ( ;ix > 0; ix--) {
1630 if (names_fill >= ix && names[ix] != &PL_sv_undef) {
1631 const char sigil = SvPVX_const(names[ix])[0];
1632 if ((SvFLAGS(names[ix]) & SVf_FAKE) || sigil == '&') {
1633 /* outer lexical or anon code */
1634 av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]));
1636 else { /* our own lexical */
1640 else if (sigil == '%')
1644 av_store(newpad, ix, sv);
1648 else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
1649 av_store(newpad, ix, SvREFCNT_inc_NN(oldpad[ix]));
1652 /* save temporaries on recursion? */
1653 SV * const sv = newSV(0);
1654 av_store(newpad, ix, sv);
1660 av_store(newpad, 0, (SV*)av);
1663 av_store(padlist, depth, (SV*)newpad);
1664 AvFILLp(padlist) = depth;
1670 Perl_pad_compname_type(pTHX_ const PADOFFSET po)
1673 SV* const * const av = av_fetch(PL_comppad_name, po, FALSE);
1674 if ( SvPAD_TYPED(*av) ) {
1675 return SvSTASH(*av);
1682 * c-indentation-style: bsd
1684 * indent-tabs-mode: t
1687 * ex: set ts=8 sts=4 sw=4 noet: