3 * Copyright (c) 2002, Larry Wall
5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
8 * "Anyway: there was this Mr Frodo left an orphan and stranded, as you
9 * might say, among those queer Bucklanders, being brought up anyhow in
10 * Brandy Hall. A regular warren, by all accounts. Old Master Gorbadoc
11 * never had fewer than a couple of hundred relations in the place. Mr
12 * Bilbo never did a kinder deed than when he brought the lad back to
13 * live among decent folk." --the Gaffer
17 * As of Sept 2002, this file is new and may be in a state of flux for
18 * a while. I've marked things I intent to come back and look at further
19 * with an 'XXX DAPM' comment.
23 =head1 Pad Data Structures
25 =for apidoc m|AV *|CvPADLIST|CV *cv
26 CV's can have CvPADLIST(cv) set to point to an AV.
28 For these purposes "forms" are a kind-of CV, eval""s are too (except they're
29 not callable at will and are always thrown away after the eval"" is done
32 XSUBs don't have CvPADLIST set - dXSTARG fetches values from PL_curpad,
33 but that is really the callers pad (a slot of which is allocated by
36 The CvPADLIST AV has does not have AvREAL set, so REFCNT of component items
37 is managed "manual" (mostly in pad.c) rather than normal av.c rules.
38 The items in the AV are not SVs as for a normal AV, but other AVs:
40 0'th Entry of the CvPADLIST is an AV which represents the "names" or rather
41 the "static type information" for lexicals.
43 The CvDEPTH'th entry of CvPADLIST AV is an AV which is the stack frame at that
44 depth of recursion into the CV.
45 The 0'th slot of a frame AV is an AV which is @_.
46 other entries are storage for variables and op targets.
49 C<PL_comppad_name> is set the the the names AV.
50 C<PL_comppad> is set the the frame AV for the frame CvDEPTH == 1.
51 C<PL_curpad> is set the body of the frame AV (i.e. AvARRAY(PL_comppad)).
53 During execution, C<PL_comppad> and C<PL_curpad> refer to the live
54 frame of the currently executing sub.
56 Iterating over the names AV iterates over all possible pad
57 items. Pad slots that are SVs_PADTMP (targets/GVs/constants) end up having
58 &PL_sv_undef "names" (see pad_alloc()).
60 Only my/our variable (SVs_PADMY/SVs_PADOUR) slots get valid names.
61 The rest are op targets/GVs/constants which are statically allocated
62 or resolved at compile time. These don't have names by which they
63 can be looked up from Perl code at run time through eval"" like
64 my/our variables can be. Since they can't be looked up by "name"
65 but only by their index allocated at compile time (which is usually
66 in PL_op->op_targ), wasting a name SV for them doesn't make sense.
68 The SVs in the names AV have their PV being the name of the variable.
69 NV+1..IV inclusive is a range of cop_seq numbers for which the name is
70 valid. For typed lexicals name SV is SVt_PVMG and SvSTASH points at the
71 type. For C<our> lexicals, the type is SVt_PVGV, and GvSTASH points at the
72 stash of the associated global (so that duplicate C<our> delarations in the
73 same package can be detected). SvCUR is sometimes hijacked to
74 store the generation number during compilation.
76 If SvFAKE is set on the name SV then slot in the frame AVs are
77 a REFCNT'ed references to a lexical from "outside".
79 If the 'name' is '&' the the corresponding entry in frame AV
80 is a CV representing a possible closure.
81 (SvFAKE and name of '&' is not a meaningful combination currently but could
82 become so if C<my sub foo {}> is implemented.)
93 #define PAD_MAX 999999999
100 Create a new compiling padlist, saving and updating the various global
101 vars at the same time as creating the pad itself. The following flags
102 can be OR'ed together:
104 padnew_CLONE this pad is for a cloned CV
105 padnew_SAVE save old globals
106 padnew_SAVESUB also save extra stuff for start of sub
112 Perl_pad_new(pTHX_ padnew_flags flags)
114 AV *padlist, *padname, *pad, *a0;
116 ASSERT_CURPAD_LEGAL("pad_new");
118 /* XXX DAPM really need a new SAVEt_PAD which restores all or most
119 * vars (based on flags) rather than storing vals + addresses for
120 * each individually. Also see pad_block_start.
121 * XXX DAPM Try to see whether all these conditionals are required
124 /* save existing state, ... */
126 if (flags & padnew_SAVE) {
128 SAVESPTR(PL_comppad_name);
129 if (! (flags & padnew_CLONE)) {
131 SAVEI32(PL_comppad_name_fill);
132 SAVEI32(PL_min_intro_pending);
133 SAVEI32(PL_max_intro_pending);
134 if (flags & padnew_SAVESUB) {
135 SAVEI32(PL_pad_reset_pending);
139 /* XXX DAPM interestingly, PL_comppad_name_floor never seems to be
140 * saved - check at some pt that this is okay */
142 /* ... create new pad ... */
148 if (flags & padnew_CLONE) {
149 /* XXX DAPM I dont know why cv_clone needs it
150 * doing differently yet - perhaps this separate branch can be
151 * dispensed with eventually ???
154 a0 = newAV(); /* will be @_ */
156 av_store(pad, 0, (SV*)a0);
157 AvFLAGS(a0) = AVf_REIFY;
160 av_store(pad, 0, Nullsv);
164 av_store(padlist, 0, (SV*)padname);
165 av_store(padlist, 1, (SV*)pad);
167 /* ... then update state variables */
169 PL_comppad_name = (AV*)(*av_fetch(padlist, 0, FALSE));
170 PL_comppad = (AV*)(*av_fetch(padlist, 1, FALSE));
171 PL_curpad = AvARRAY(PL_comppad);
173 if (! (flags & padnew_CLONE)) {
174 PL_comppad_name_fill = 0;
175 PL_min_intro_pending = 0;
179 DEBUG_X(PerlIO_printf(Perl_debug_log,
180 "Pad 0x%"UVxf"[0x%"UVxf"] new: padlist=0x%"UVxf
181 " name=0x%"UVxf" flags=0x%"UVxf"\n",
182 PTR2UV(PL_comppad), PTR2UV(PL_curpad), PTR2UV(padlist),
183 PTR2UV(padname), (UV)flags
187 return (PADLIST*)padlist;
191 =for apidoc pad_undef
193 Free the padlist associated with a CV.
194 If parts of it happen to be current, we null the relevant
195 PL_*pad* global vars so that we don't have any dangling references left.
196 We also repoint the CvOUTSIDE of any about-to-be-orphaned
197 inner subs to the outer of this cv.
203 Perl_pad_undef(pTHX_ CV* cv)
206 PADLIST *padlist = CvPADLIST(cv);
210 if (!SvREFCNT(CvPADLIST(cv))) /* may be during global destruction */
213 DEBUG_X(PerlIO_printf(Perl_debug_log,
214 "Pad undef: padlist=0x%"UVxf"\n" , PTR2UV(padlist))
217 /* pads may be cleared out already during global destruction */
218 if ((CvEVAL(cv) && !CvGV(cv) /* is this eval"" ? */
219 && !PL_dirty) || CvSPECIAL(cv))
221 CV *outercv = CvOUTSIDE(cv);
222 U32 seq = CvOUTSIDE_SEQ(cv);
223 /* XXX DAPM the following code is very similar to
224 * pad_fixup_inner_anons(). Merge??? */
226 /* inner references to eval's/BEGIN's/etc cv must be fixed up */
227 AV *comppad_name = (AV*)AvARRAY(padlist)[0];
228 SV **namepad = AvARRAY(comppad_name);
229 AV *comppad = (AV*)AvARRAY(padlist)[1];
230 SV **curpad = AvARRAY(comppad);
231 for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
232 SV *namesv = namepad[ix];
233 if (namesv && namesv != &PL_sv_undef
234 && *SvPVX(namesv) == '&'
235 && ix <= AvFILLp(comppad))
237 CV *innercv = (CV*)curpad[ix];
238 if (innercv && SvTYPE(innercv) == SVt_PVCV
239 && CvOUTSIDE(innercv) == cv)
241 CvOUTSIDE(innercv) = outercv;
242 CvOUTSIDE_SEQ(innercv) = seq;
243 /* anon prototypes aren't refcounted */
244 if (!CvANON(innercv) || CvCLONED(innercv)) {
245 (void)SvREFCNT_inc(outercv);
253 ix = AvFILLp(padlist);
255 SV* sv = AvARRAY(padlist)[ix--];
258 if (sv == (SV*)PL_comppad_name)
259 PL_comppad_name = Nullav;
260 else if (sv == (SV*)PL_comppad) {
261 PL_comppad = Null(PAD*);
262 PL_curpad = Null(SV**);
266 SvREFCNT_dec((SV*)CvPADLIST(cv));
267 CvPADLIST(cv) = Null(PADLIST*);
274 =for apidoc pad_add_name
276 Create a new name in the current pad at the specified offset.
277 If C<typestash> is valid, the name is for a typed lexical; set the
278 name's stash to that value.
279 If C<ourstash> is valid, it's an our lexical, set the name's
280 GvSTASH to that value
282 Also, if the name is @.. or %.., create a new array or hash for that slot
284 If fake, it means we're cloning an existing entry
290 * XXX DAPM this doesn't seem the right place to create a new array/hash.
291 * Whatever we do, we should be consistent - create scalars too, and
292 * create even if fake. Really need to integrate better the whole entry
293 * creation business - when + where does the name and value get created?
297 Perl_pad_add_name(pTHX_ char *name, HV* typestash, HV* ourstash, bool fake)
299 PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
300 SV* namesv = NEWSV(1102, 0);
303 ASSERT_CURPAD_ACTIVE("pad_add_name");
306 min = PL_curcop->cop_seq;
310 /* not yet introduced */
315 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
316 "Pad addname: %ld \"%s\", (%lu,%lu)%s\n",
317 (long)offset, name, (unsigned long)min, (unsigned long)max,
318 (fake ? " FAKE" : "")
322 sv_upgrade(namesv, ourstash ? SVt_PVGV : typestash ? SVt_PVMG : SVt_PVNV);
323 sv_setpv(namesv, name);
326 SvFLAGS(namesv) |= SVpad_TYPED;
327 SvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*) typestash);
330 SvFLAGS(namesv) |= SVpad_OUR;
331 GvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*) ourstash);
334 av_store(PL_comppad_name, offset, namesv);
335 SvNVX(namesv) = (NV)min;
340 if (!PL_min_intro_pending)
341 PL_min_intro_pending = offset;
342 PL_max_intro_pending = offset;
343 /* XXX DAPM since slot has been allocated, replace
344 * av_store with PL_curpad[offset] ? */
346 av_store(PL_comppad, offset, (SV*)newAV());
347 else if (*name == '%')
348 av_store(PL_comppad, offset, (SV*)newHV());
349 SvPADMY_on(PL_curpad[offset]);
359 =for apidoc pad_alloc
361 Allocate a new my or tmp pad entry. For a my, simply push a null SV onto
362 the end of PL_comppad, but for a tmp, scan the pad from PL_padix upwards
363 for a slot which has no name and and no active value.
368 /* XXX DAPM integrate alloc(), add_name() and add_anon(),
369 * or at least rationalise ??? */
373 Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
378 ASSERT_CURPAD_ACTIVE("pad_alloc");
380 if (AvARRAY(PL_comppad) != PL_curpad)
381 Perl_croak(aTHX_ "panic: pad_alloc");
382 if (PL_pad_reset_pending)
384 if (tmptype & SVs_PADMY) {
386 sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE);
387 } while (SvPADBUSY(sv)); /* need a fresh one */
388 retval = AvFILLp(PL_comppad);
391 SV **names = AvARRAY(PL_comppad_name);
392 SSize_t names_fill = AvFILLp(PL_comppad_name);
395 * "foreach" index vars temporarily become aliases to non-"my"
396 * values. Thus we must skip, not just pad values that are
397 * marked as current pad values, but also those with names.
399 /* HVDS why copy to sv here? we don't seem to use it */
400 if (++PL_padix <= names_fill &&
401 (sv = names[PL_padix]) && sv != &PL_sv_undef)
403 sv = *av_fetch(PL_comppad, PL_padix, TRUE);
404 if (!(SvFLAGS(sv) & (SVs_PADTMP | SVs_PADMY)) &&
405 !IS_PADGV(sv) && !IS_PADCONST(sv))
410 SvFLAGS(sv) |= tmptype;
411 PL_curpad = AvARRAY(PL_comppad);
413 DEBUG_X(PerlIO_printf(Perl_debug_log,
414 "Pad 0x%"UVxf"[0x%"UVxf"] alloc: %ld for %s\n",
415 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long) retval,
416 PL_op_name[optype]));
417 return (PADOFFSET)retval;
421 =for apidoc pad_add_anon
423 Add an anon code entry to the current compiling pad
429 Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
434 name = NEWSV(1106, 0);
435 sv_upgrade(name, SVt_PVNV);
436 sv_setpvn(name, "&", 1);
439 ix = pad_alloc(op_type, SVs_PADMY);
440 av_store(PL_comppad_name, ix, name);
441 /* XXX DAPM use PL_curpad[] ? */
442 av_store(PL_comppad, ix, sv);
450 =for apidoc pad_check_dup
452 Check for duplicate declarations: report any of:
453 * a my in the current scope with the same name;
454 * an our (anywhere in the pad) with the same name and the same stash
456 C<is_our> indicates that the name to check is an 'our' declaration
461 /* XXX DAPM integrate this into pad_add_name ??? */
464 Perl_pad_check_dup(pTHX_ char *name, bool is_our, HV *ourstash)
469 ASSERT_CURPAD_ACTIVE("pad_check_dup");
470 if (!ckWARN(WARN_MISC) || AvFILLp(PL_comppad_name) < 0)
471 return; /* nothing to check */
473 svp = AvARRAY(PL_comppad_name);
474 top = AvFILLp(PL_comppad_name);
475 /* check the current scope */
476 /* XXX DAPM - why the (I32) cast - shouldn't we ensure they're the same
478 for (off = top; (I32)off > PL_comppad_name_floor; off--) {
480 && sv != &PL_sv_undef
481 && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
483 || ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash))
484 && strEQ(name, SvPVX(sv)))
486 Perl_warner(aTHX_ packWARN(WARN_MISC),
487 "\"%s\" variable %s masks earlier declaration in same %s",
488 (is_our ? "our" : "my"),
490 (SvIVX(sv) == PAD_MAX ? "scope" : "statement"));
495 /* check the rest of the pad */
499 && sv != &PL_sv_undef
500 && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
501 && ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash)
502 && strEQ(name, SvPVX(sv)))
504 Perl_warner(aTHX_ packWARN(WARN_MISC),
505 "\"our\" variable %s redeclared", name);
506 Perl_warner(aTHX_ packWARN(WARN_MISC),
507 "\t(Did you mean \"local\" instead of \"our\"?)\n");
510 } while ( off-- > 0 );
517 =for apidoc pad_findmy
519 Given a lexical name, try to find its offset, first in the current pad,
520 or failing that, in the pads of any lexically enclosing subs (including
521 the complications introduced by eval). If the name is found in an outer pad,
522 then a fake entry is added to the current pad.
523 Returns the offset in the current pad, or NOT_IN_PAD on failure.
529 Perl_pad_findmy(pTHX_ char *name)
534 SV **svp = AvARRAY(PL_comppad_name);
535 U32 seq = PL_cop_seqmax;
537 ASSERT_CURPAD_ACTIVE("pad_findmy");
538 DEBUG_Xv(PerlIO_printf(Perl_debug_log, "Pad findmy: \"%s\"\n", name));
540 /* The one we're looking for is probably just before comppad_name_fill. */
541 for (off = AvFILLp(PL_comppad_name); off > 0; off--) {
542 if ((sv = svp[off]) &&
543 sv != &PL_sv_undef &&
545 (seq <= (U32)SvIVX(sv) &&
546 seq > (U32)I_32(SvNVX(sv)))) &&
547 strEQ(SvPVX(sv), name))
549 if (SvIVX(sv) || SvFLAGS(sv) & SVpad_OUR)
550 return (PADOFFSET)off;
551 pendoff = off; /* this pending def. will override import */
555 /* See if it's in a nested scope */
556 off = pad_findlex(name, 0, PL_compcv);
557 if (!off) /* pad_findlex returns 0 for failure...*/
558 return NOT_IN_PAD; /* ...but we return NOT_IN_PAD for failure */
560 /* If there is a pending local definition, this new alias must die */
562 SvIVX(AvARRAY(PL_comppad_name)[off]) = seq;
569 =for apidoc pad_findlex
571 Find a named lexical anywhere in a chain of nested pads. Add fake entries
572 in the inner pads if it's found in an outer one. innercv is the CV *inside*
573 the chain of outer CVs to be searched. If newoff is non-null, this is a
574 run-time cloning: don't add fake entries, just find the lexical and add a
575 ref to it at newoff in the current pad.
581 S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, CV* innercv)
589 ASSERT_CURPAD_ACTIVE("pad_findlex");
590 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
591 "Pad findlex: \"%s\" off=%ld startcv=0x%"UVxf"\n",
592 name, (long)newoff, PTR2UV(innercv))
595 seq = CvOUTSIDE_SEQ(innercv);
596 startcv = CvOUTSIDE(innercv);
598 for (cv = startcv; cv; seq = CvOUTSIDE_SEQ(cv), cv = CvOUTSIDE(cv)) {
599 AV *curlist = CvPADLIST(cv);
600 SV **svp = av_fetch(curlist, 0, FALSE);
603 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
604 " searching: cv=0x%"UVxf" seq=%d\n",
605 PTR2UV(cv), (int) seq )
608 if (!svp || *svp == &PL_sv_undef)
611 svp = AvARRAY(curname);
612 for (off = AvFILLp(curname); off > 0; off--) {
619 sv != &PL_sv_undef &&
620 seq <= (U32)SvIVX(sv) &&
621 seq > (U32)I_32(SvNVX(sv)) &&
622 strEQ(SvPVX(sv), name))
631 return 0; /* don't clone from inactive stack frame */
636 oldpad = (AV*)AvARRAY(curlist)[depth];
637 oldsv = *av_fetch(oldpad, off, TRUE);
639 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
640 " matched: offset %ld"
641 " %s(%lu,%lu), sv=0x%"UVxf"\n",
643 SvFAKE(sv) ? "FAKE " : "",
644 (unsigned long)I_32(SvNVX(sv)),
645 (unsigned long)SvIVX(sv),
650 if (!newoff) { /* Not a mere clone operation. */
651 newoff = pad_add_name(
653 (SvFLAGS(sv) & SVpad_TYPED) ? SvSTASH(sv) : Nullhv,
654 (SvFLAGS(sv) & SVpad_OUR) ? GvSTASH(sv) : Nullhv,
658 if (CvANON(PL_compcv) || SvTYPE(PL_compcv) == SVt_PVFM) {
659 /* "It's closures all the way down." */
660 CvCLONE_on(PL_compcv);
662 if (CvANON(PL_compcv))
663 oldsv = Nullsv; /* no need to keep ref */
668 bcv && bcv != cv && !CvCLONE(bcv);
669 bcv = CvOUTSIDE(bcv))
672 /* install the missing pad entry in intervening
673 * nested subs and mark them cloneable. */
674 AV *ocomppad_name = PL_comppad_name;
675 PAD *ocomppad = PL_comppad;
676 AV *padlist = CvPADLIST(bcv);
677 PL_comppad_name = (AV*)AvARRAY(padlist)[0];
678 PL_comppad = (AV*)AvARRAY(padlist)[1];
679 PL_curpad = AvARRAY(PL_comppad);
682 (SvFLAGS(sv) & SVpad_TYPED)
683 ? SvSTASH(sv) : Nullhv,
684 (SvFLAGS(sv) & SVpad_OUR)
685 ? GvSTASH(sv) : Nullhv,
689 PL_comppad_name = ocomppad_name;
690 PL_comppad = ocomppad;
691 PL_curpad = ocomppad ?
692 AvARRAY(ocomppad) : Null(SV **);
696 if (ckWARN(WARN_CLOSURE)
697 && !CvUNIQUE(bcv) && !CvUNIQUE(cv))
699 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
700 "Variable \"%s\" may be unavailable",
708 else if (!CvUNIQUE(PL_compcv)) {
709 if (ckWARN(WARN_CLOSURE) && !SvFAKE(sv) && !CvUNIQUE(cv)
710 && !(SvFLAGS(sv) & SVpad_OUR))
712 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
713 "Variable \"%s\" will not stay shared", name);
717 av_store(PL_comppad, newoff, SvREFCNT_inc(oldsv));
718 ASSERT_CURPAD_ACTIVE("pad_findlex 2");
719 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
720 "Pad findlex: set offset %ld to sv 0x%"UVxf"\n",
721 (long)newoff, PTR2UV(oldsv)
734 Get the value at offset po in the current pad.
735 Use macro PAD_SV instead of calling this function directly.
742 Perl_pad_sv(pTHX_ PADOFFSET po)
744 ASSERT_CURPAD_ACTIVE("pad_sv");
747 Perl_croak(aTHX_ "panic: pad_sv po");
748 DEBUG_X(PerlIO_printf(Perl_debug_log,
749 "Pad 0x%"UVxf"[0x%"UVxf"] sv: %ld sv=0x%"UVxf"\n",
750 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(PL_curpad[po]))
752 return PL_curpad[po];
757 =for apidoc pad_setsv
759 Set the entry at offset po in the current pad to sv.
760 Use the macro PAD_SETSV() rather than calling this function directly.
767 Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
769 ASSERT_CURPAD_ACTIVE("pad_setsv");
771 DEBUG_X(PerlIO_printf(Perl_debug_log,
772 "Pad 0x%"UVxf"[0x%"UVxf"] setsv: %ld sv=0x%"UVxf"\n",
773 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(sv))
782 =for apidoc pad_block_start
784 Update the pad compilation state variables on entry to a new block
790 * - integrate this in general state-saving routine ???
791 * - combine with the state-saving going on in pad_new ???
792 * - introduce a new SAVE type that does all this in one go ?
796 Perl_pad_block_start(pTHX_ int full)
798 ASSERT_CURPAD_ACTIVE("pad_block_start");
799 SAVEI32(PL_comppad_name_floor);
800 PL_comppad_name_floor = AvFILLp(PL_comppad_name);
802 PL_comppad_name_fill = PL_comppad_name_floor;
803 if (PL_comppad_name_floor < 0)
804 PL_comppad_name_floor = 0;
805 SAVEI32(PL_min_intro_pending);
806 SAVEI32(PL_max_intro_pending);
807 PL_min_intro_pending = 0;
808 SAVEI32(PL_comppad_name_fill);
809 SAVEI32(PL_padix_floor);
810 PL_padix_floor = PL_padix;
811 PL_pad_reset_pending = FALSE;
818 "Introduce" my variables to visible status.
830 ASSERT_CURPAD_ACTIVE("intro_my");
831 if (! PL_min_intro_pending)
832 return PL_cop_seqmax;
834 svp = AvARRAY(PL_comppad_name);
835 for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
836 if ((sv = svp[i]) && sv != &PL_sv_undef && !SvIVX(sv)) {
837 SvIVX(sv) = PAD_MAX; /* Don't know scope end yet. */
838 SvNVX(sv) = (NV)PL_cop_seqmax;
839 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
840 "Pad intromy: %ld \"%s\", (%lu,%lu)\n",
842 (unsigned long)I_32(SvNVX(sv)), (unsigned long)SvIVX(sv))
846 PL_min_intro_pending = 0;
847 PL_comppad_name_fill = PL_max_intro_pending; /* Needn't search higher */
848 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
849 "Pad intromy: seq -> %ld\n", (long)(PL_cop_seqmax+1)));
851 return PL_cop_seqmax++;
855 =for apidoc pad_leavemy
857 Cleanup at end of scope during compilation: set the max seq number for
858 lexicals in this scope and warn of any lexicals that never got introduced.
864 Perl_pad_leavemy(pTHX)
867 SV **svp = AvARRAY(PL_comppad_name);
870 PL_pad_reset_pending = FALSE;
872 ASSERT_CURPAD_ACTIVE("pad_leavemy");
873 if (PL_min_intro_pending && PL_comppad_name_fill < PL_min_intro_pending) {
874 for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
875 if ((sv = svp[off]) && sv != &PL_sv_undef && ckWARN_d(WARN_INTERNAL))
876 Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
877 "%s never introduced", SvPVX(sv));
880 /* "Deintroduce" my variables that are leaving with this scope. */
881 for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_fill; off--) {
882 if ((sv = svp[off]) && sv != &PL_sv_undef && SvIVX(sv) == PAD_MAX) {
883 SvIVX(sv) = PL_cop_seqmax;
884 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
885 "Pad leavemy: %ld \"%s\", (%lu,%lu)\n",
886 (long)off, SvPVX(sv),
887 (unsigned long)I_32(SvNVX(sv)), (unsigned long)SvIVX(sv))
892 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
893 "Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax));
898 =for apidoc pad_swipe
900 Abandon the tmp in the current pad at offset po and replace with a
907 Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
909 ASSERT_CURPAD_LEGAL("pad_swipe");
912 if (AvARRAY(PL_comppad) != PL_curpad)
913 Perl_croak(aTHX_ "panic: pad_swipe curpad");
915 Perl_croak(aTHX_ "panic: pad_swipe po");
917 DEBUG_X(PerlIO_printf(Perl_debug_log,
918 "Pad 0x%"UVxf"[0x%"UVxf"] swipe: %ld\n",
919 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po));
922 SvPADTMP_off(PL_curpad[po]);
924 SvREFCNT_dec(PL_curpad[po]);
926 PL_curpad[po] = NEWSV(1107,0);
927 SvPADTMP_on(PL_curpad[po]);
928 if ((I32)po < PL_padix)
934 =for apidoc pad_reset
936 Mark all the current temporaries for reuse
941 /* XXX pad_reset() is currently disabled because it results in serious bugs.
942 * It causes pad temp TARGs to be shared between OPs. Since TARGs are pushed
943 * on the stack by OPs that use them, there are several ways to get an alias
944 * to a shared TARG. Such an alias will change randomly and unpredictably.
945 * We avoid doing this until we can think of a Better Way.
950 #ifdef USE_BROKEN_PAD_RESET
953 if (AvARRAY(PL_comppad) != PL_curpad)
954 Perl_croak(aTHX_ "panic: pad_reset curpad");
956 DEBUG_X(PerlIO_printf(Perl_debug_log,
957 "Pad 0x%"UVxf"[0x%"UVxf"] reset: padix %ld -> %ld",
958 PTR2UV(PL_comppad), PTR2UV(PL_curpad),
959 (long)PL_padix, (long)PL_padix_floor
963 if (!PL_tainting) { /* Can't mix tainted and non-tainted temporaries. */
964 for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
965 if (PL_curpad[po] && !SvIMMORTAL(PL_curpad[po]))
966 SvPADTMP_off(PL_curpad[po]);
968 PL_padix = PL_padix_floor;
971 PL_pad_reset_pending = FALSE;
978 Tidy up a pad after we've finished compiling it:
979 * remove most stuff from the pads of anonsub prototypes;
986 /* XXX DAPM surely most of this stuff should be done properly
987 * at the right time beforehand, rather than going around afterwards
988 * cleaning up our mistakes ???
992 Perl_pad_tidy(pTHX_ padtidy_type type)
996 ASSERT_CURPAD_ACTIVE("pad_tidy");
997 /* extend curpad to match namepad */
998 if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
999 av_store(PL_comppad_name, AvFILLp(PL_comppad), Nullsv);
1001 if (type == padtidy_SUBCLONE) {
1002 SV **namep = AvARRAY(PL_comppad_name);
1003 for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1006 if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
1009 * The only things that a clonable function needs in its
1010 * pad are references to outer lexicals and anonymous subs.
1011 * The rest are created anew during cloning.
1013 if (!((namesv = namep[ix]) != Nullsv &&
1014 namesv != &PL_sv_undef &&
1016 *SvPVX(namesv) == '&')))
1018 SvREFCNT_dec(PL_curpad[ix]);
1019 PL_curpad[ix] = Nullsv;
1023 else if (type == padtidy_SUB) {
1024 /* XXX DAPM this same bit of code keeps appearing !!! Rationalise? */
1025 AV *av = newAV(); /* Will be @_ */
1027 av_store(PL_comppad, 0, (SV*)av);
1028 AvFLAGS(av) = AVf_REIFY;
1031 /* XXX DAPM rationalise these two similar branches */
1033 if (type == padtidy_SUB) {
1034 for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1035 if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
1037 if (!SvPADMY(PL_curpad[ix]))
1038 SvPADTMP_on(PL_curpad[ix]);
1041 else if (type == padtidy_FORMAT) {
1042 for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1043 if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix]))
1044 SvPADTMP_on(PL_curpad[ix]);
1047 PL_curpad = AvARRAY(PL_comppad);
1052 =for apidoc pad_free
1054 Free the SV at offet po in the current pad.
1059 /* XXX DAPM integrate with pad_swipe ???? */
1061 Perl_pad_free(pTHX_ PADOFFSET po)
1063 ASSERT_CURPAD_LEGAL("pad_free");
1066 if (AvARRAY(PL_comppad) != PL_curpad)
1067 Perl_croak(aTHX_ "panic: pad_free curpad");
1069 Perl_croak(aTHX_ "panic: pad_free po");
1071 DEBUG_X(PerlIO_printf(Perl_debug_log,
1072 "Pad 0x%"UVxf"[0x%"UVxf"] free: %ld\n",
1073 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po)
1076 if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
1077 SvPADTMP_off(PL_curpad[po]);
1079 #ifdef PERL_COPY_ON_WRITE
1080 if (SvIsCOW(PL_curpad[po])) {
1081 sv_force_normal_flags(PL_curpad[po], SV_COW_DROP_PV);
1084 SvREADONLY_off(PL_curpad[po]); /* could be a freed constant */
1088 if ((I32)po < PL_padix)
1095 =for apidoc do_dump_pad
1097 Dump the contents of a padlist
1103 Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
1115 pad_name = (AV*)*av_fetch((AV*)padlist, 0, FALSE);
1116 pad = (AV*)*av_fetch((AV*)padlist, 1, FALSE);
1117 pname = AvARRAY(pad_name);
1118 ppad = AvARRAY(pad);
1119 Perl_dump_indent(aTHX_ level, file,
1120 "PADNAME = 0x%"UVxf"(0x%"UVxf") PAD = 0x%"UVxf"(0x%"UVxf")\n",
1121 PTR2UV(pad_name), PTR2UV(pname), PTR2UV(pad), PTR2UV(ppad)
1124 for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
1126 if (namesv && namesv == &PL_sv_undef) {
1130 Perl_dump_indent(aTHX_ level+1, file,
1131 "%2d. 0x%"UVxf"<%lu> %s (%lu,%lu) \"%s\"\n",
1134 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
1135 SvFAKE(namesv) ? "FAKE" : " ",
1136 (unsigned long)I_32(SvNVX(namesv)),
1137 (unsigned long)SvIVX(namesv),
1142 Perl_dump_indent(aTHX_ level+1, file,
1143 "%2d. 0x%"UVxf"<%lu>\n",
1146 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0)
1157 dump the contents of a CV
1164 S_cv_dump(pTHX_ CV *cv, char *title)
1166 CV *outside = CvOUTSIDE(cv);
1167 AV* padlist = CvPADLIST(cv);
1169 PerlIO_printf(Perl_debug_log,
1170 " %s: CV=0x%"UVxf" (%s), OUTSIDE=0x%"UVxf" (%s)\n",
1173 (CvANON(cv) ? "ANON"
1174 : (cv == PL_main_cv) ? "MAIN"
1175 : CvUNIQUE(cv) ? "UNIQUE"
1176 : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
1179 : CvANON(outside) ? "ANON"
1180 : (outside == PL_main_cv) ? "MAIN"
1181 : CvUNIQUE(outside) ? "UNIQUE"
1182 : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
1184 PerlIO_printf(Perl_debug_log,
1185 " PADLIST = 0x%"UVxf"\n", PTR2UV(padlist));
1186 do_dump_pad(1, Perl_debug_log, padlist, 1);
1188 #endif /* DEBUGGING */
1195 =for apidoc cv_clone
1197 Clone a CV: make a new CV which points to the same code etc, but which
1198 has a newly-created pad built by copying the prototype pad and capturing
1205 Perl_cv_clone(pTHX_ CV *proto)
1209 LOCK_CRED_MUTEX; /* XXX create separate mutex */
1210 cv = cv_clone2(proto, CvOUTSIDE(proto));
1211 UNLOCK_CRED_MUTEX; /* XXX create separate mutex */
1216 /* XXX DAPM separate out cv and paddish bits ???
1217 * ideally the CV-related stuff shouldn't be in pad.c - how about
1221 S_cv_clone2(pTHX_ CV *proto, CV *outside)
1224 AV* protopadlist = CvPADLIST(proto);
1225 AV* protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
1226 AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
1227 SV** pname = AvARRAY(protopad_name);
1228 SV** ppad = AvARRAY(protopad);
1229 I32 fname = AvFILLp(protopad_name);
1230 I32 fpad = AvFILLp(protopad);
1234 assert(!CvUNIQUE(proto));
1237 SAVESPTR(PL_compcv);
1239 cv = PL_compcv = (CV*)NEWSV(1104, 0);
1240 sv_upgrade((SV *)cv, SvTYPE(proto));
1241 CvFLAGS(cv) = CvFLAGS(proto) & ~CVf_CLONE;
1245 CvFILE(cv) = CvXSUB(proto) ? CvFILE(proto)
1246 : savepv(CvFILE(proto));
1248 CvFILE(cv) = CvFILE(proto);
1250 CvGV(cv) = CvGV(proto);
1251 CvSTASH(cv) = CvSTASH(proto);
1252 CvROOT(cv) = OpREFCNT_inc(CvROOT(proto));
1253 CvSTART(cv) = CvSTART(proto);
1255 CvOUTSIDE(cv) = (CV*)SvREFCNT_inc(outside);
1256 CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
1260 sv_setpvn((SV*)cv, SvPVX(proto), SvCUR(proto));
1262 CvPADLIST(cv) = comppadlist = pad_new(padnew_CLONE|padnew_SAVE);
1264 for (ix = fname; ix >= 0; ix--)
1265 av_store(PL_comppad_name, ix, SvREFCNT_inc(pname[ix]));
1267 av_fill(PL_comppad, fpad);
1268 PL_curpad = AvARRAY(PL_comppad);
1270 for (ix = fpad; ix > 0; ix--) {
1271 SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
1272 if (namesv && namesv != &PL_sv_undef) {
1273 char *name = SvPVX(namesv); /* XXX */
1274 if (SvFLAGS(namesv) & SVf_FAKE) { /* lexical from outside? */
1275 I32 off = pad_findlex(name, ix, cv);
1277 PL_curpad[ix] = SvREFCNT_inc(ppad[ix]);
1279 Perl_croak(aTHX_ "panic: cv_clone: %s", name);
1281 else { /* our own lexical */
1284 /* anon code -- we'll come back for it */
1285 sv = SvREFCNT_inc(ppad[ix]);
1287 else if (*name == '@')
1289 else if (*name == '%')
1298 else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) {
1299 PL_curpad[ix] = SvREFCNT_inc(ppad[ix]);
1302 SV* sv = NEWSV(0, 0);
1308 /* Now that vars are all in place, clone nested closures. */
1310 for (ix = fpad; ix > 0; ix--) {
1311 SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
1313 && namesv != &PL_sv_undef
1314 && !(SvFLAGS(namesv) & SVf_FAKE)
1315 && *SvPVX(namesv) == '&'
1316 && CvCLONE(ppad[ix]))
1318 CV *kid = cv_clone2((CV*)ppad[ix], cv);
1319 SvREFCNT_dec(ppad[ix]);
1322 PL_curpad[ix] = (SV*)kid;
1327 PerlIO_printf(Perl_debug_log, "\nPad CV clone\n");
1328 cv_dump(outside, "Outside");
1329 cv_dump(proto, "Proto");
1336 SV* const_sv = op_const_sv(CvSTART(cv), cv);
1338 /* constant sub () { $x } closing over $x - see lib/constant.pm */
1340 cv = newCONSTSUB(CvSTASH(proto), 0, const_sv);
1348 =for apidoc pad_fixup_inner_anons
1350 For any anon CVs in the pad, change CvOUTSIDE of that CV from
1351 old_cv to new_cv if necessary.
1357 Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
1360 AV *comppad_name = (AV*)AvARRAY(padlist)[0];
1361 AV *comppad = (AV*)AvARRAY(padlist)[1];
1362 SV **namepad = AvARRAY(comppad_name);
1363 SV **curpad = AvARRAY(comppad);
1364 for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
1365 SV *namesv = namepad[ix];
1366 if (namesv && namesv != &PL_sv_undef
1367 && *SvPVX(namesv) == '&')
1369 CV *innercv = (CV*)curpad[ix];
1370 if (CvOUTSIDE(innercv) == old_cv) {
1371 CvOUTSIDE(innercv) = new_cv;
1372 /* anon prototypes aren't refcounted */
1373 if (!CvANON(innercv) || CvCLONED(innercv)) {
1374 (void)SvREFCNT_inc(new_cv);
1375 SvREFCNT_dec(old_cv);
1383 =for apidoc pad_push
1385 Push a new pad frame onto the padlist, unless there's already a pad at
1386 this depth, in which case don't bother creating a new one.
1387 If has_args is true, give the new pad an @_ in slot zero.
1393 Perl_pad_push(pTHX_ PADLIST *padlist, int depth, int has_args)
1395 if (depth <= AvFILLp(padlist))
1399 SV** svp = AvARRAY(padlist);
1400 AV *newpad = newAV();
1401 SV **oldpad = AvARRAY(svp[depth-1]);
1402 I32 ix = AvFILLp((AV*)svp[1]);
1403 I32 names_fill = AvFILLp((AV*)svp[0]);
1404 SV** names = AvARRAY(svp[0]);
1406 for ( ;ix > 0; ix--) {
1407 if (names_fill >= ix && names[ix] != &PL_sv_undef) {
1408 char *name = SvPVX(names[ix]);
1409 if ((SvFLAGS(names[ix]) & SVf_FAKE) || *name == '&') {
1410 /* outer lexical or anon code */
1411 av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]));
1413 else { /* our own lexical */
1415 av_store(newpad, ix, sv = (SV*)newAV());
1416 else if (*name == '%')
1417 av_store(newpad, ix, sv = (SV*)newHV());
1419 av_store(newpad, ix, sv = NEWSV(0, 0));
1423 else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
1424 av_store(newpad, ix, sv = SvREFCNT_inc(oldpad[ix]));
1427 /* save temporaries on recursion? */
1428 av_store(newpad, ix, sv = NEWSV(0, 0));
1435 av_store(newpad, 0, (SV*)av);
1436 AvFLAGS(av) = AVf_REIFY;
1438 av_store(padlist, depth, (SV*)newpad);
1439 AvFILLp(padlist) = depth;