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". In this case,
78 the name SV does not have a cop_seq range, since it is in scope
81 If the 'name' is '&' the the corresponding entry in frame AV
82 is a CV representing a possible closure.
83 (SvFAKE and name of '&' is not a meaningful combination currently but could
84 become so if C<my sub foo {}> is implemented.)
95 #define PAD_MAX 999999999
102 Create a new compiling padlist, saving and updating the various global
103 vars at the same time as creating the pad itself. The following flags
104 can be OR'ed together:
106 padnew_CLONE this pad is for a cloned CV
107 padnew_SAVE save old globals
108 padnew_SAVESUB also save extra stuff for start of sub
114 Perl_pad_new(pTHX_ padnew_flags flags)
116 AV *padlist, *padname, *pad, *a0;
118 ASSERT_CURPAD_LEGAL("pad_new");
120 /* XXX DAPM really need a new SAVEt_PAD which restores all or most
121 * vars (based on flags) rather than storing vals + addresses for
122 * each individually. Also see pad_block_start.
123 * XXX DAPM Try to see whether all these conditionals are required
126 /* save existing state, ... */
128 if (flags & padnew_SAVE) {
130 SAVESPTR(PL_comppad_name);
131 if (! (flags & padnew_CLONE)) {
133 SAVEI32(PL_comppad_name_fill);
134 SAVEI32(PL_min_intro_pending);
135 SAVEI32(PL_max_intro_pending);
136 if (flags & padnew_SAVESUB) {
137 SAVEI32(PL_pad_reset_pending);
141 /* XXX DAPM interestingly, PL_comppad_name_floor never seems to be
142 * saved - check at some pt that this is okay */
144 /* ... create new pad ... */
150 if (flags & padnew_CLONE) {
151 /* XXX DAPM I dont know why cv_clone needs it
152 * doing differently yet - perhaps this separate branch can be
153 * dispensed with eventually ???
156 a0 = newAV(); /* will be @_ */
158 av_store(pad, 0, (SV*)a0);
159 AvFLAGS(a0) = AVf_REIFY;
162 av_store(pad, 0, Nullsv);
166 av_store(padlist, 0, (SV*)padname);
167 av_store(padlist, 1, (SV*)pad);
169 /* ... then update state variables */
171 PL_comppad_name = (AV*)(*av_fetch(padlist, 0, FALSE));
172 PL_comppad = (AV*)(*av_fetch(padlist, 1, FALSE));
173 PL_curpad = AvARRAY(PL_comppad);
175 if (! (flags & padnew_CLONE)) {
176 PL_comppad_name_fill = 0;
177 PL_min_intro_pending = 0;
181 DEBUG_X(PerlIO_printf(Perl_debug_log,
182 "Pad 0x%"UVxf"[0x%"UVxf"] new: padlist=0x%"UVxf
183 " name=0x%"UVxf" flags=0x%"UVxf"\n",
184 PTR2UV(PL_comppad), PTR2UV(PL_curpad), PTR2UV(padlist),
185 PTR2UV(padname), (UV)flags
189 return (PADLIST*)padlist;
193 =for apidoc pad_undef
195 Free the padlist associated with a CV.
196 If parts of it happen to be current, we null the relevant
197 PL_*pad* global vars so that we don't have any dangling references left.
198 We also repoint the CvOUTSIDE of any about-to-be-orphaned
199 inner subs to the outer of this cv.
205 Perl_pad_undef(pTHX_ CV* cv)
208 PADLIST *padlist = CvPADLIST(cv);
212 if (!SvREFCNT(CvPADLIST(cv))) /* may be during global destruction */
215 DEBUG_X(PerlIO_printf(Perl_debug_log,
216 "Pad undef: padlist=0x%"UVxf"\n" , PTR2UV(padlist))
219 /* pads may be cleared out already during global destruction */
220 if ((CvEVAL(cv) && !CvGV(cv) /* is this eval"" ? */
221 && !PL_dirty) || CvSPECIAL(cv))
223 CV *outercv = CvOUTSIDE(cv);
224 U32 seq = CvOUTSIDE_SEQ(cv);
225 /* XXX DAPM the following code is very similar to
226 * pad_fixup_inner_anons(). Merge??? */
228 /* inner references to eval's/BEGIN's/etc cv must be fixed up */
229 AV *comppad_name = (AV*)AvARRAY(padlist)[0];
230 SV **namepad = AvARRAY(comppad_name);
231 AV *comppad = (AV*)AvARRAY(padlist)[1];
232 SV **curpad = AvARRAY(comppad);
233 for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
234 SV *namesv = namepad[ix];
235 if (namesv && namesv != &PL_sv_undef
236 && *SvPVX(namesv) == '&'
237 && ix <= AvFILLp(comppad))
239 CV *innercv = (CV*)curpad[ix];
240 if (innercv && SvTYPE(innercv) == SVt_PVCV
241 && CvOUTSIDE(innercv) == cv)
243 CvOUTSIDE(innercv) = outercv;
244 CvOUTSIDE_SEQ(innercv) = seq;
245 /* anon prototypes aren't refcounted */
246 if (!CvANON(innercv) || CvCLONED(innercv)) {
247 (void)SvREFCNT_inc(outercv);
255 ix = AvFILLp(padlist);
257 SV* sv = AvARRAY(padlist)[ix--];
260 if (sv == (SV*)PL_comppad_name)
261 PL_comppad_name = Nullav;
262 else if (sv == (SV*)PL_comppad) {
263 PL_comppad = Null(PAD*);
264 PL_curpad = Null(SV**);
268 SvREFCNT_dec((SV*)CvPADLIST(cv));
269 CvPADLIST(cv) = Null(PADLIST*);
276 =for apidoc pad_add_name
278 Create a new name in the current pad at the specified offset.
279 If C<typestash> is valid, the name is for a typed lexical; set the
280 name's stash to that value.
281 If C<ourstash> is valid, it's an our lexical, set the name's
282 GvSTASH to that value
284 Also, if the name is @.. or %.., create a new array or hash for that slot
286 If fake, it means we're cloning an existing entry
292 * XXX DAPM this doesn't seem the right place to create a new array/hash.
293 * Whatever we do, we should be consistent - create scalars too, and
294 * create even if fake. Really need to integrate better the whole entry
295 * creation business - when + where does the name and value get created?
299 Perl_pad_add_name(pTHX_ char *name, HV* typestash, HV* ourstash, bool fake)
301 PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
302 SV* namesv = NEWSV(1102, 0);
304 ASSERT_CURPAD_ACTIVE("pad_add_name");
307 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
308 "Pad addname: %ld \"%s\"%s\n",
309 (long)offset, name, (fake ? " FAKE" : "")
313 sv_upgrade(namesv, ourstash ? SVt_PVGV : typestash ? SVt_PVMG : SVt_PVNV);
314 sv_setpv(namesv, name);
317 SvFLAGS(namesv) |= SVpad_TYPED;
318 SvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*) typestash);
321 SvFLAGS(namesv) |= SVpad_OUR;
322 GvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*) ourstash);
325 av_store(PL_comppad_name, offset, namesv);
329 /* not yet introduced */
330 SvNVX(namesv) = (NV)PAD_MAX; /* min */
331 SvIVX(namesv) = 0; /* max */
333 if (!PL_min_intro_pending)
334 PL_min_intro_pending = offset;
335 PL_max_intro_pending = offset;
336 /* XXX DAPM since slot has been allocated, replace
337 * av_store with PL_curpad[offset] ? */
339 av_store(PL_comppad, offset, (SV*)newAV());
340 else if (*name == '%')
341 av_store(PL_comppad, offset, (SV*)newHV());
342 SvPADMY_on(PL_curpad[offset]);
352 =for apidoc pad_alloc
354 Allocate a new my or tmp pad entry. For a my, simply push a null SV onto
355 the end of PL_comppad, but for a tmp, scan the pad from PL_padix upwards
356 for a slot which has no name and and no active value.
361 /* XXX DAPM integrate alloc(), add_name() and add_anon(),
362 * or at least rationalise ??? */
366 Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
371 ASSERT_CURPAD_ACTIVE("pad_alloc");
373 if (AvARRAY(PL_comppad) != PL_curpad)
374 Perl_croak(aTHX_ "panic: pad_alloc");
375 if (PL_pad_reset_pending)
377 if (tmptype & SVs_PADMY) {
379 sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE);
380 } while (SvPADBUSY(sv)); /* need a fresh one */
381 retval = AvFILLp(PL_comppad);
384 SV **names = AvARRAY(PL_comppad_name);
385 SSize_t names_fill = AvFILLp(PL_comppad_name);
388 * "foreach" index vars temporarily become aliases to non-"my"
389 * values. Thus we must skip, not just pad values that are
390 * marked as current pad values, but also those with names.
392 /* HVDS why copy to sv here? we don't seem to use it */
393 if (++PL_padix <= names_fill &&
394 (sv = names[PL_padix]) && sv != &PL_sv_undef)
396 sv = *av_fetch(PL_comppad, PL_padix, TRUE);
397 if (!(SvFLAGS(sv) & (SVs_PADTMP | SVs_PADMY)) &&
398 !IS_PADGV(sv) && !IS_PADCONST(sv))
403 SvFLAGS(sv) |= tmptype;
404 PL_curpad = AvARRAY(PL_comppad);
406 DEBUG_X(PerlIO_printf(Perl_debug_log,
407 "Pad 0x%"UVxf"[0x%"UVxf"] alloc: %ld for %s\n",
408 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long) retval,
409 PL_op_name[optype]));
410 return (PADOFFSET)retval;
414 =for apidoc pad_add_anon
416 Add an anon code entry to the current compiling pad
422 Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
427 name = NEWSV(1106, 0);
428 sv_upgrade(name, SVt_PVNV);
429 sv_setpvn(name, "&", 1);
432 ix = pad_alloc(op_type, SVs_PADMY);
433 av_store(PL_comppad_name, ix, name);
434 /* XXX DAPM use PL_curpad[] ? */
435 av_store(PL_comppad, ix, sv);
443 =for apidoc pad_check_dup
445 Check for duplicate declarations: report any of:
446 * a my in the current scope with the same name;
447 * an our (anywhere in the pad) with the same name and the same stash
449 C<is_our> indicates that the name to check is an 'our' declaration
454 /* XXX DAPM integrate this into pad_add_name ??? */
457 Perl_pad_check_dup(pTHX_ char *name, bool is_our, HV *ourstash)
462 ASSERT_CURPAD_ACTIVE("pad_check_dup");
463 if (!ckWARN(WARN_MISC) || AvFILLp(PL_comppad_name) < 0)
464 return; /* nothing to check */
466 svp = AvARRAY(PL_comppad_name);
467 top = AvFILLp(PL_comppad_name);
468 /* check the current scope */
469 /* XXX DAPM - why the (I32) cast - shouldn't we ensure they're the same
471 for (off = top; (I32)off > PL_comppad_name_floor; off--) {
473 && sv != &PL_sv_undef
475 && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
477 || ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash))
478 && strEQ(name, SvPVX(sv)))
480 Perl_warner(aTHX_ packWARN(WARN_MISC),
481 "\"%s\" variable %s masks earlier declaration in same %s",
482 (is_our ? "our" : "my"),
484 (SvIVX(sv) == PAD_MAX ? "scope" : "statement"));
489 /* check the rest of the pad */
493 && sv != &PL_sv_undef
495 && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
496 && ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash)
497 && strEQ(name, SvPVX(sv)))
499 Perl_warner(aTHX_ packWARN(WARN_MISC),
500 "\"our\" variable %s redeclared", name);
501 Perl_warner(aTHX_ packWARN(WARN_MISC),
502 "\t(Did you mean \"local\" instead of \"our\"?)\n");
505 } while ( off-- > 0 );
512 =for apidoc pad_findmy
514 Given a lexical name, try to find its offset, first in the current pad,
515 or failing that, in the pads of any lexically enclosing subs (including
516 the complications introduced by eval). If the name is found in an outer pad,
517 then a fake entry is added to the current pad.
518 Returns the offset in the current pad, or NOT_IN_PAD on failure.
524 Perl_pad_findmy(pTHX_ char *name)
529 SV **svp = AvARRAY(PL_comppad_name);
530 U32 seq = PL_cop_seqmax;
532 ASSERT_CURPAD_ACTIVE("pad_findmy");
533 DEBUG_Xv(PerlIO_printf(Perl_debug_log, "Pad findmy: \"%s\"\n", name));
535 /* The one we're looking for is probably just before comppad_name_fill. */
536 for (off = AvFILLp(PL_comppad_name); off > 0; off--) {
538 if (!sv || sv == &PL_sv_undef || !strEQ(SvPVX(sv), name))
541 /* we'll use this later if we don't find a real entry */
547 ( seq > (U32)I_32(SvNVX(sv)) /* min */
548 && seq <= (U32)SvIVX(sv)) /* max */
550 /* 'our' is visible before introduction */
551 (!SvIVX(sv) && (SvFLAGS(sv) & SVpad_OUR))
559 /* See if it's in a nested scope */
560 off = pad_findlex(name, 0, PL_compcv);
561 if (!off) /* pad_findlex returns 0 for failure...*/
562 return NOT_IN_PAD; /* ...but we return NOT_IN_PAD for failure */
570 =for apidoc pad_findlex
572 Find a named lexical anywhere in a chain of nested pads. Add fake entries
573 in the inner pads if it's found in an outer one. innercv is the CV *inside*
574 the chain of outer CVs to be searched. If newoff is non-null, this is a
575 run-time cloning: don't add fake entries, just find the lexical and add a
576 ref to it at newoff in the current pad.
582 S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, CV* innercv)
594 ASSERT_CURPAD_ACTIVE("pad_findlex");
595 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
596 "Pad findlex: \"%s\" off=%ld startcv=0x%"UVxf"\n",
597 name, (long)newoff, PTR2UV(innercv))
600 seq = CvOUTSIDE_SEQ(innercv);
601 startcv = CvOUTSIDE(innercv);
603 for (cv = startcv; cv; seq = CvOUTSIDE_SEQ(cv), cv = CvOUTSIDE(cv)) {
608 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
609 " searching: cv=0x%"UVxf" seq=%d\n",
610 PTR2UV(cv), (int) seq )
613 curlist = CvPADLIST(cv);
614 svp = av_fetch(curlist, 0, FALSE);
615 if (!svp || *svp == &PL_sv_undef)
618 svp = AvARRAY(curname);
621 for (off = AvFILLp(curname); off > 0; off--) {
623 if (!sv || sv == &PL_sv_undef || !strEQ(SvPVX(sv), name))
626 /* we'll use this later if we don't find a real entry */
631 if ( seq > (U32)I_32(SvNVX(sv)) /* min */
632 && seq <= (U32)SvIVX(sv) /* max */
633 && !(newoff && !depth) /* ignore inactive when cloning */
639 /* no real entry - but did we find a fake one? */
641 if (newoff && !depth)
642 return 0; /* don't clone from inactive stack frame */
655 oldpad = (AV*)AvARRAY(curlist)[depth];
656 oldsv = *av_fetch(oldpad, off, TRUE);
660 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
661 " matched: offset %ld"
662 " FAKE, sv=0x%"UVxf"\n",
668 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
669 " matched: offset %ld"
670 " (%lu,%lu), sv=0x%"UVxf"\n",
672 (unsigned long)I_32(SvNVX(sv)),
673 (unsigned long)SvIVX(sv),
679 if (!newoff) { /* Not a mere clone operation. */
680 newoff = pad_add_name(
682 (SvFLAGS(sv) & SVpad_TYPED) ? SvSTASH(sv) : Nullhv,
683 (SvFLAGS(sv) & SVpad_OUR) ? GvSTASH(sv) : Nullhv,
687 if (CvANON(PL_compcv) || SvTYPE(PL_compcv) == SVt_PVFM) {
688 /* "It's closures all the way down." */
689 CvCLONE_on(PL_compcv);
691 if (CvANON(PL_compcv))
692 oldsv = Nullsv; /* no need to keep ref */
697 bcv && bcv != cv && !CvCLONE(bcv);
698 bcv = CvOUTSIDE(bcv))
701 /* install the missing pad entry in intervening
702 * nested subs and mark them cloneable. */
703 AV *ocomppad_name = PL_comppad_name;
704 PAD *ocomppad = PL_comppad;
705 AV *padlist = CvPADLIST(bcv);
706 PL_comppad_name = (AV*)AvARRAY(padlist)[0];
707 PL_comppad = (AV*)AvARRAY(padlist)[1];
708 PL_curpad = AvARRAY(PL_comppad);
711 (SvFLAGS(sv) & SVpad_TYPED)
712 ? SvSTASH(sv) : Nullhv,
713 (SvFLAGS(sv) & SVpad_OUR)
714 ? GvSTASH(sv) : Nullhv,
718 PL_comppad_name = ocomppad_name;
719 PL_comppad = ocomppad;
720 PL_curpad = ocomppad ?
721 AvARRAY(ocomppad) : Null(SV **);
725 if (ckWARN(WARN_CLOSURE)
726 && !CvUNIQUE(bcv) && !CvUNIQUE(cv))
728 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
729 "Variable \"%s\" may be unavailable",
737 else if (!CvUNIQUE(PL_compcv)) {
738 if (ckWARN(WARN_CLOSURE) && !SvFAKE(sv) && !CvUNIQUE(cv)
739 && !(SvFLAGS(sv) & SVpad_OUR))
741 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
742 "Variable \"%s\" will not stay shared", name);
746 av_store(PL_comppad, newoff, SvREFCNT_inc(oldsv));
747 ASSERT_CURPAD_ACTIVE("pad_findlex 2");
748 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
749 "Pad findlex: set offset %ld to sv 0x%"UVxf"\n",
750 (long)newoff, PTR2UV(oldsv)
760 Get the value at offset po in the current pad.
761 Use macro PAD_SV instead of calling this function directly.
768 Perl_pad_sv(pTHX_ PADOFFSET po)
770 ASSERT_CURPAD_ACTIVE("pad_sv");
773 Perl_croak(aTHX_ "panic: pad_sv po");
774 DEBUG_X(PerlIO_printf(Perl_debug_log,
775 "Pad 0x%"UVxf"[0x%"UVxf"] sv: %ld sv=0x%"UVxf"\n",
776 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(PL_curpad[po]))
778 return PL_curpad[po];
783 =for apidoc pad_setsv
785 Set the entry at offset po in the current pad to sv.
786 Use the macro PAD_SETSV() rather than calling this function directly.
793 Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
795 ASSERT_CURPAD_ACTIVE("pad_setsv");
797 DEBUG_X(PerlIO_printf(Perl_debug_log,
798 "Pad 0x%"UVxf"[0x%"UVxf"] setsv: %ld sv=0x%"UVxf"\n",
799 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(sv))
808 =for apidoc pad_block_start
810 Update the pad compilation state variables on entry to a new block
816 * - integrate this in general state-saving routine ???
817 * - combine with the state-saving going on in pad_new ???
818 * - introduce a new SAVE type that does all this in one go ?
822 Perl_pad_block_start(pTHX_ int full)
824 ASSERT_CURPAD_ACTIVE("pad_block_start");
825 SAVEI32(PL_comppad_name_floor);
826 PL_comppad_name_floor = AvFILLp(PL_comppad_name);
828 PL_comppad_name_fill = PL_comppad_name_floor;
829 if (PL_comppad_name_floor < 0)
830 PL_comppad_name_floor = 0;
831 SAVEI32(PL_min_intro_pending);
832 SAVEI32(PL_max_intro_pending);
833 PL_min_intro_pending = 0;
834 SAVEI32(PL_comppad_name_fill);
835 SAVEI32(PL_padix_floor);
836 PL_padix_floor = PL_padix;
837 PL_pad_reset_pending = FALSE;
844 "Introduce" my variables to visible status.
856 ASSERT_CURPAD_ACTIVE("intro_my");
857 if (! PL_min_intro_pending)
858 return PL_cop_seqmax;
860 svp = AvARRAY(PL_comppad_name);
861 for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
862 if ((sv = svp[i]) && sv != &PL_sv_undef
863 && !SvFAKE(sv) && !SvIVX(sv))
865 SvIVX(sv) = PAD_MAX; /* Don't know scope end yet. */
866 SvNVX(sv) = (NV)PL_cop_seqmax;
867 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
868 "Pad intromy: %ld \"%s\", (%lu,%lu)\n",
870 (unsigned long)I_32(SvNVX(sv)), (unsigned long)SvIVX(sv))
874 PL_min_intro_pending = 0;
875 PL_comppad_name_fill = PL_max_intro_pending; /* Needn't search higher */
876 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
877 "Pad intromy: seq -> %ld\n", (long)(PL_cop_seqmax+1)));
879 return PL_cop_seqmax++;
883 =for apidoc pad_leavemy
885 Cleanup at end of scope during compilation: set the max seq number for
886 lexicals in this scope and warn of any lexicals that never got introduced.
892 Perl_pad_leavemy(pTHX)
895 SV **svp = AvARRAY(PL_comppad_name);
898 PL_pad_reset_pending = FALSE;
900 ASSERT_CURPAD_ACTIVE("pad_leavemy");
901 if (PL_min_intro_pending && PL_comppad_name_fill < PL_min_intro_pending) {
902 for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
903 if ((sv = svp[off]) && sv != &PL_sv_undef
904 && !SvFAKE(sv) && ckWARN_d(WARN_INTERNAL))
905 Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
906 "%s never introduced", SvPVX(sv));
909 /* "Deintroduce" my variables that are leaving with this scope. */
910 for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_fill; off--) {
911 if ((sv = svp[off]) && sv != &PL_sv_undef
912 && !SvFAKE(sv) && SvIVX(sv) == PAD_MAX)
914 SvIVX(sv) = PL_cop_seqmax;
915 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
916 "Pad leavemy: %ld \"%s\", (%lu,%lu)\n",
917 (long)off, SvPVX(sv),
918 (unsigned long)I_32(SvNVX(sv)), (unsigned long)SvIVX(sv))
923 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
924 "Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax));
929 =for apidoc pad_swipe
931 Abandon the tmp in the current pad at offset po and replace with a
938 Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
940 ASSERT_CURPAD_LEGAL("pad_swipe");
943 if (AvARRAY(PL_comppad) != PL_curpad)
944 Perl_croak(aTHX_ "panic: pad_swipe curpad");
946 Perl_croak(aTHX_ "panic: pad_swipe po");
948 DEBUG_X(PerlIO_printf(Perl_debug_log,
949 "Pad 0x%"UVxf"[0x%"UVxf"] swipe: %ld\n",
950 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po));
953 SvPADTMP_off(PL_curpad[po]);
955 SvREFCNT_dec(PL_curpad[po]);
957 PL_curpad[po] = NEWSV(1107,0);
958 SvPADTMP_on(PL_curpad[po]);
959 if ((I32)po < PL_padix)
965 =for apidoc pad_reset
967 Mark all the current temporaries for reuse
972 /* XXX pad_reset() is currently disabled because it results in serious bugs.
973 * It causes pad temp TARGs to be shared between OPs. Since TARGs are pushed
974 * on the stack by OPs that use them, there are several ways to get an alias
975 * to a shared TARG. Such an alias will change randomly and unpredictably.
976 * We avoid doing this until we can think of a Better Way.
981 #ifdef USE_BROKEN_PAD_RESET
984 if (AvARRAY(PL_comppad) != PL_curpad)
985 Perl_croak(aTHX_ "panic: pad_reset curpad");
987 DEBUG_X(PerlIO_printf(Perl_debug_log,
988 "Pad 0x%"UVxf"[0x%"UVxf"] reset: padix %ld -> %ld",
989 PTR2UV(PL_comppad), PTR2UV(PL_curpad),
990 (long)PL_padix, (long)PL_padix_floor
994 if (!PL_tainting) { /* Can't mix tainted and non-tainted temporaries. */
995 for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
996 if (PL_curpad[po] && !SvIMMORTAL(PL_curpad[po]))
997 SvPADTMP_off(PL_curpad[po]);
999 PL_padix = PL_padix_floor;
1002 PL_pad_reset_pending = FALSE;
1007 =for apidoc pad_tidy
1009 Tidy up a pad after we've finished compiling it:
1010 * remove most stuff from the pads of anonsub prototypes;
1012 * mark tmps as such.
1017 /* XXX DAPM surely most of this stuff should be done properly
1018 * at the right time beforehand, rather than going around afterwards
1019 * cleaning up our mistakes ???
1023 Perl_pad_tidy(pTHX_ padtidy_type type)
1027 ASSERT_CURPAD_ACTIVE("pad_tidy");
1028 /* extend curpad to match namepad */
1029 if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
1030 av_store(PL_comppad_name, AvFILLp(PL_comppad), Nullsv);
1032 if (type == padtidy_SUBCLONE) {
1033 SV **namep = AvARRAY(PL_comppad_name);
1034 for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1037 if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
1040 * The only things that a clonable function needs in its
1041 * pad are references to outer lexicals and anonymous subs.
1042 * The rest are created anew during cloning.
1044 if (!((namesv = namep[ix]) != Nullsv &&
1045 namesv != &PL_sv_undef &&
1047 *SvPVX(namesv) == '&')))
1049 SvREFCNT_dec(PL_curpad[ix]);
1050 PL_curpad[ix] = Nullsv;
1054 else if (type == padtidy_SUB) {
1055 /* XXX DAPM this same bit of code keeps appearing !!! Rationalise? */
1056 AV *av = newAV(); /* Will be @_ */
1058 av_store(PL_comppad, 0, (SV*)av);
1059 AvFLAGS(av) = AVf_REIFY;
1062 /* XXX DAPM rationalise these two similar branches */
1064 if (type == padtidy_SUB) {
1065 for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1066 if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
1068 if (!SvPADMY(PL_curpad[ix]))
1069 SvPADTMP_on(PL_curpad[ix]);
1072 else if (type == padtidy_FORMAT) {
1073 for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1074 if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix]))
1075 SvPADTMP_on(PL_curpad[ix]);
1078 PL_curpad = AvARRAY(PL_comppad);
1083 =for apidoc pad_free
1085 Free the SV at offet po in the current pad.
1090 /* XXX DAPM integrate with pad_swipe ???? */
1092 Perl_pad_free(pTHX_ PADOFFSET po)
1094 ASSERT_CURPAD_LEGAL("pad_free");
1097 if (AvARRAY(PL_comppad) != PL_curpad)
1098 Perl_croak(aTHX_ "panic: pad_free curpad");
1100 Perl_croak(aTHX_ "panic: pad_free po");
1102 DEBUG_X(PerlIO_printf(Perl_debug_log,
1103 "Pad 0x%"UVxf"[0x%"UVxf"] free: %ld\n",
1104 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po)
1107 if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
1108 SvPADTMP_off(PL_curpad[po]);
1110 #ifdef PERL_COPY_ON_WRITE
1111 if (SvIsCOW(PL_curpad[po])) {
1112 sv_force_normal_flags(PL_curpad[po], SV_COW_DROP_PV);
1115 SvREADONLY_off(PL_curpad[po]); /* could be a freed constant */
1119 if ((I32)po < PL_padix)
1126 =for apidoc do_dump_pad
1128 Dump the contents of a padlist
1134 Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
1146 pad_name = (AV*)*av_fetch((AV*)padlist, 0, FALSE);
1147 pad = (AV*)*av_fetch((AV*)padlist, 1, FALSE);
1148 pname = AvARRAY(pad_name);
1149 ppad = AvARRAY(pad);
1150 Perl_dump_indent(aTHX_ level, file,
1151 "PADNAME = 0x%"UVxf"(0x%"UVxf") PAD = 0x%"UVxf"(0x%"UVxf")\n",
1152 PTR2UV(pad_name), PTR2UV(pname), PTR2UV(pad), PTR2UV(ppad)
1155 for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
1157 if (namesv && namesv == &PL_sv_undef) {
1162 Perl_dump_indent(aTHX_ level+1, file,
1163 "%2d. 0x%"UVxf"<%lu> FAKE \"%s\"\n",
1166 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
1170 Perl_dump_indent(aTHX_ level+1, file,
1171 "%2d. 0x%"UVxf"<%lu> (%lu,%lu) \"%s\"\n",
1174 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
1175 (unsigned long)I_32(SvNVX(namesv)),
1176 (unsigned long)SvIVX(namesv),
1181 Perl_dump_indent(aTHX_ level+1, file,
1182 "%2d. 0x%"UVxf"<%lu>\n",
1185 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0)
1196 dump the contents of a CV
1203 S_cv_dump(pTHX_ CV *cv, char *title)
1205 CV *outside = CvOUTSIDE(cv);
1206 AV* padlist = CvPADLIST(cv);
1208 PerlIO_printf(Perl_debug_log,
1209 " %s: CV=0x%"UVxf" (%s), OUTSIDE=0x%"UVxf" (%s)\n",
1212 (CvANON(cv) ? "ANON"
1213 : (cv == PL_main_cv) ? "MAIN"
1214 : CvUNIQUE(cv) ? "UNIQUE"
1215 : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
1218 : CvANON(outside) ? "ANON"
1219 : (outside == PL_main_cv) ? "MAIN"
1220 : CvUNIQUE(outside) ? "UNIQUE"
1221 : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
1223 PerlIO_printf(Perl_debug_log,
1224 " PADLIST = 0x%"UVxf"\n", PTR2UV(padlist));
1225 do_dump_pad(1, Perl_debug_log, padlist, 1);
1227 #endif /* DEBUGGING */
1234 =for apidoc cv_clone
1236 Clone a CV: make a new CV which points to the same code etc, but which
1237 has a newly-created pad built by copying the prototype pad and capturing
1244 Perl_cv_clone(pTHX_ CV *proto)
1248 LOCK_CRED_MUTEX; /* XXX create separate mutex */
1249 cv = cv_clone2(proto, CvOUTSIDE(proto));
1250 UNLOCK_CRED_MUTEX; /* XXX create separate mutex */
1255 /* XXX DAPM separate out cv and paddish bits ???
1256 * ideally the CV-related stuff shouldn't be in pad.c - how about
1260 S_cv_clone2(pTHX_ CV *proto, CV *outside)
1263 AV* protopadlist = CvPADLIST(proto);
1264 AV* protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
1265 AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
1266 SV** pname = AvARRAY(protopad_name);
1267 SV** ppad = AvARRAY(protopad);
1268 I32 fname = AvFILLp(protopad_name);
1269 I32 fpad = AvFILLp(protopad);
1273 assert(!CvUNIQUE(proto));
1276 SAVESPTR(PL_compcv);
1278 cv = PL_compcv = (CV*)NEWSV(1104, 0);
1279 sv_upgrade((SV *)cv, SvTYPE(proto));
1280 CvFLAGS(cv) = CvFLAGS(proto) & ~CVf_CLONE;
1284 CvFILE(cv) = CvXSUB(proto) ? CvFILE(proto)
1285 : savepv(CvFILE(proto));
1287 CvFILE(cv) = CvFILE(proto);
1289 CvGV(cv) = CvGV(proto);
1290 CvSTASH(cv) = CvSTASH(proto);
1291 CvROOT(cv) = OpREFCNT_inc(CvROOT(proto));
1292 CvSTART(cv) = CvSTART(proto);
1294 CvOUTSIDE(cv) = (CV*)SvREFCNT_inc(outside);
1295 CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
1299 sv_setpvn((SV*)cv, SvPVX(proto), SvCUR(proto));
1301 CvPADLIST(cv) = comppadlist = pad_new(padnew_CLONE|padnew_SAVE);
1303 for (ix = fname; ix >= 0; ix--)
1304 av_store(PL_comppad_name, ix, SvREFCNT_inc(pname[ix]));
1306 av_fill(PL_comppad, fpad);
1307 PL_curpad = AvARRAY(PL_comppad);
1309 for (ix = fpad; ix > 0; ix--) {
1310 SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
1311 if (namesv && namesv != &PL_sv_undef) {
1312 char *name = SvPVX(namesv); /* XXX */
1313 if (SvFLAGS(namesv) & SVf_FAKE) { /* lexical from outside? */
1314 I32 off = pad_findlex(name, ix, cv);
1316 PL_curpad[ix] = SvREFCNT_inc(ppad[ix]);
1318 Perl_croak(aTHX_ "panic: cv_clone: %s", name);
1320 else { /* our own lexical */
1323 /* anon code -- we'll come back for it */
1324 sv = SvREFCNT_inc(ppad[ix]);
1326 else if (*name == '@')
1328 else if (*name == '%')
1337 else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) {
1338 PL_curpad[ix] = SvREFCNT_inc(ppad[ix]);
1341 SV* sv = NEWSV(0, 0);
1347 /* Now that vars are all in place, clone nested closures. */
1349 for (ix = fpad; ix > 0; ix--) {
1350 SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
1352 && namesv != &PL_sv_undef
1353 && !(SvFLAGS(namesv) & SVf_FAKE)
1354 && *SvPVX(namesv) == '&'
1355 && CvCLONE(ppad[ix]))
1357 CV *kid = cv_clone2((CV*)ppad[ix], cv);
1358 SvREFCNT_dec(ppad[ix]);
1361 PL_curpad[ix] = (SV*)kid;
1366 PerlIO_printf(Perl_debug_log, "\nPad CV clone\n");
1367 cv_dump(outside, "Outside");
1368 cv_dump(proto, "Proto");
1375 SV* const_sv = op_const_sv(CvSTART(cv), cv);
1377 /* constant sub () { $x } closing over $x - see lib/constant.pm */
1379 cv = newCONSTSUB(CvSTASH(proto), 0, const_sv);
1387 =for apidoc pad_fixup_inner_anons
1389 For any anon CVs in the pad, change CvOUTSIDE of that CV from
1390 old_cv to new_cv if necessary.
1396 Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
1399 AV *comppad_name = (AV*)AvARRAY(padlist)[0];
1400 AV *comppad = (AV*)AvARRAY(padlist)[1];
1401 SV **namepad = AvARRAY(comppad_name);
1402 SV **curpad = AvARRAY(comppad);
1403 for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
1404 SV *namesv = namepad[ix];
1405 if (namesv && namesv != &PL_sv_undef
1406 && *SvPVX(namesv) == '&')
1408 CV *innercv = (CV*)curpad[ix];
1409 if (CvOUTSIDE(innercv) == old_cv) {
1410 CvOUTSIDE(innercv) = new_cv;
1411 /* anon prototypes aren't refcounted */
1412 if (!CvANON(innercv) || CvCLONED(innercv)) {
1413 (void)SvREFCNT_inc(new_cv);
1414 SvREFCNT_dec(old_cv);
1422 =for apidoc pad_push
1424 Push a new pad frame onto the padlist, unless there's already a pad at
1425 this depth, in which case don't bother creating a new one.
1426 If has_args is true, give the new pad an @_ in slot zero.
1432 Perl_pad_push(pTHX_ PADLIST *padlist, int depth, int has_args)
1434 if (depth <= AvFILLp(padlist))
1438 SV** svp = AvARRAY(padlist);
1439 AV *newpad = newAV();
1440 SV **oldpad = AvARRAY(svp[depth-1]);
1441 I32 ix = AvFILLp((AV*)svp[1]);
1442 I32 names_fill = AvFILLp((AV*)svp[0]);
1443 SV** names = AvARRAY(svp[0]);
1445 for ( ;ix > 0; ix--) {
1446 if (names_fill >= ix && names[ix] != &PL_sv_undef) {
1447 char *name = SvPVX(names[ix]);
1448 if ((SvFLAGS(names[ix]) & SVf_FAKE) || *name == '&') {
1449 /* outer lexical or anon code */
1450 av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]));
1452 else { /* our own lexical */
1454 av_store(newpad, ix, sv = (SV*)newAV());
1455 else if (*name == '%')
1456 av_store(newpad, ix, sv = (SV*)newHV());
1458 av_store(newpad, ix, sv = NEWSV(0, 0));
1462 else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
1463 av_store(newpad, ix, sv = SvREFCNT_inc(oldpad[ix]));
1466 /* save temporaries on recursion? */
1467 av_store(newpad, ix, sv = NEWSV(0, 0));
1474 av_store(newpad, 0, (SV*)av);
1475 AvFLAGS(av) = AVf_REIFY;
1477 av_store(padlist, depth, (SV*)newpad);
1478 AvFILLp(padlist) = depth;