3 * Copyright (C) 2002,2003 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 =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
30 executing). Require'd files are simply evals without any outer lexical
33 XSUBs don't have CvPADLIST set - dXSTARG fetches values from PL_curpad,
34 but that is really the callers pad (a slot of which is allocated by
37 The CvPADLIST AV has does not have AvREAL set, so REFCNT of component items
38 is managed "manual" (mostly in pad.c) rather than normal av.c rules.
39 The items in the AV are not SVs as for a normal AV, but other AVs:
41 0'th Entry of the CvPADLIST is an AV which represents the "names" or rather
42 the "static type information" for lexicals.
44 The CvDEPTH'th entry of CvPADLIST AV is an AV which is the stack frame at that
45 depth of recursion into the CV.
46 The 0'th slot of a frame AV is an AV which is @_.
47 other entries are storage for variables and op targets.
50 C<PL_comppad_name> is set to the names AV.
51 C<PL_comppad> is set to the frame AV for the frame CvDEPTH == 1.
52 C<PL_curpad> is set to the body of the frame AV (i.e. AvARRAY(PL_comppad)).
54 During execution, C<PL_comppad> and C<PL_curpad> refer to the live
55 frame of the currently executing sub.
57 Iterating over the names AV iterates over all possible pad
58 items. Pad slots that are SVs_PADTMP (targets/GVs/constants) end up having
59 &PL_sv_undef "names" (see pad_alloc()).
61 Only my/our variable (SVs_PADMY/SVs_PADOUR) slots get valid names.
62 The rest are op targets/GVs/constants which are statically allocated
63 or resolved at compile time. These don't have names by which they
64 can be looked up from Perl code at run time through eval"" like
65 my/our variables can be. Since they can't be looked up by "name"
66 but only by their index allocated at compile time (which is usually
67 in PL_op->op_targ), wasting a name SV for them doesn't make sense.
69 The SVs in the names AV have their PV being the name of the variable.
70 NV+1..IV inclusive is a range of cop_seq numbers for which the name is
71 valid. For typed lexicals name SV is SVt_PVMG and SvSTASH points at the
72 type. For C<our> lexicals, the type is SVt_PVGV, and GvSTASH points at the
73 stash of the associated global (so that duplicate C<our> delarations in the
74 same package can be detected). SvCUR is sometimes hijacked to
75 store the generation number during compilation.
77 If SvFAKE is set on the name SV, then that slot in the frame AV is
78 a REFCNT'ed reference to a lexical from "outside". In this case,
79 the name SV does not use NVX and IVX to store a cop_seq range, since it is
80 in scope throughout. Instead IVX stores some flags containing info about
81 the real lexical (is it declared in an anon, and is it capable of being
82 instantiated multiple times?), and for fake ANONs, NVX contains the index
83 within the parent's pad where the lexical's value is stored, to make
86 If the 'name' is '&' the corresponding entry in frame AV
87 is a CV representing a possible closure.
88 (SvFAKE and name of '&' is not a meaningful combination currently but could
89 become so if C<my sub foo {}> is implemented.)
100 #define PAD_MAX 999999999
107 Create a new compiling padlist, saving and updating the various global
108 vars at the same time as creating the pad itself. The following flags
109 can be OR'ed together:
111 padnew_CLONE this pad is for a cloned CV
112 padnew_SAVE save old globals
113 padnew_SAVESUB also save extra stuff for start of sub
119 Perl_pad_new(pTHX_ int flags)
121 AV *padlist, *padname, *pad, *a0;
123 ASSERT_CURPAD_LEGAL("pad_new");
125 /* XXX DAPM really need a new SAVEt_PAD which restores all or most
126 * vars (based on flags) rather than storing vals + addresses for
127 * each individually. Also see pad_block_start.
128 * XXX DAPM Try to see whether all these conditionals are required
131 /* save existing state, ... */
133 if (flags & padnew_SAVE) {
135 SAVESPTR(PL_comppad_name);
136 if (! (flags & padnew_CLONE)) {
138 SAVEI32(PL_comppad_name_fill);
139 SAVEI32(PL_min_intro_pending);
140 SAVEI32(PL_max_intro_pending);
141 SAVEI32(PL_cv_has_eval);
142 if (flags & padnew_SAVESUB) {
143 SAVEI32(PL_pad_reset_pending);
147 /* XXX DAPM interestingly, PL_comppad_name_floor never seems to be
148 * saved - check at some pt that this is okay */
150 /* ... create new pad ... */
156 if (flags & padnew_CLONE) {
157 /* XXX DAPM I dont know why cv_clone needs it
158 * doing differently yet - perhaps this separate branch can be
159 * dispensed with eventually ???
162 a0 = newAV(); /* will be @_ */
164 av_store(pad, 0, (SV*)a0);
165 AvFLAGS(a0) = AVf_REIFY;
168 av_store(pad, 0, Nullsv);
172 av_store(padlist, 0, (SV*)padname);
173 av_store(padlist, 1, (SV*)pad);
175 /* ... then update state variables */
177 PL_comppad_name = (AV*)(*av_fetch(padlist, 0, FALSE));
178 PL_comppad = (AV*)(*av_fetch(padlist, 1, FALSE));
179 PL_curpad = AvARRAY(PL_comppad);
181 if (! (flags & padnew_CLONE)) {
182 PL_comppad_name_fill = 0;
183 PL_min_intro_pending = 0;
188 DEBUG_X(PerlIO_printf(Perl_debug_log,
189 "Pad 0x%"UVxf"[0x%"UVxf"] new: compcv=0x%"UVxf
190 " name=0x%"UVxf" flags=0x%"UVxf"\n",
191 PTR2UV(PL_comppad), PTR2UV(PL_curpad), PTR2UV(PL_compcv),
192 PTR2UV(padname), (UV)flags
196 return (PADLIST*)padlist;
200 =for apidoc pad_undef
202 Free the padlist associated with a CV.
203 If parts of it happen to be current, we null the relevant
204 PL_*pad* global vars so that we don't have any dangling references left.
205 We also repoint the CvOUTSIDE of any about-to-be-orphaned
206 inner subs to the outer of this cv.
208 (This function should really be called pad_free, but the name was already
215 Perl_pad_undef(pTHX_ CV* cv)
218 PADLIST *padlist = CvPADLIST(cv);
222 if (!SvREFCNT(CvPADLIST(cv))) /* may be during global destruction */
225 DEBUG_X(PerlIO_printf(Perl_debug_log,
226 "Pad undef: cv=0x%"UVxf" padlist=0x%"UVxf"\n",
227 PTR2UV(cv), PTR2UV(padlist))
230 /* detach any '&' anon children in the pad; if afterwards they
231 * are still live, fix up their CvOUTSIDEs to point to our outside,
233 /* XXX DAPM for efficiency, we should only do this if we know we have
234 * children, or integrate this loop with general cleanup */
236 if (!PL_dirty) { /* don't bother during global destruction */
237 CV *outercv = CvOUTSIDE(cv);
238 U32 seq = CvOUTSIDE_SEQ(cv);
239 AV *comppad_name = (AV*)AvARRAY(padlist)[0];
240 SV **namepad = AvARRAY(comppad_name);
241 AV *comppad = (AV*)AvARRAY(padlist)[1];
242 SV **curpad = AvARRAY(comppad);
243 for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
244 SV *namesv = namepad[ix];
245 if (namesv && namesv != &PL_sv_undef
246 && *SvPVX(namesv) == '&')
248 CV *innercv = (CV*)curpad[ix];
249 namepad[ix] = Nullsv;
250 SvREFCNT_dec(namesv);
252 SvREFCNT_dec(innercv);
253 if (SvREFCNT(innercv) /* in use, not just a prototype */
254 && CvOUTSIDE(innercv) == cv)
256 assert(CvWEAKOUTSIDE(innercv));
257 CvWEAKOUTSIDE_off(innercv);
258 CvOUTSIDE(innercv) = outercv;
259 CvOUTSIDE_SEQ(innercv) = seq;
260 SvREFCNT_inc(outercv);
266 ix = AvFILLp(padlist);
268 SV* sv = AvARRAY(padlist)[ix--];
271 if (sv == (SV*)PL_comppad_name)
272 PL_comppad_name = Nullav;
273 else if (sv == (SV*)PL_comppad) {
274 PL_comppad = Null(PAD*);
275 PL_curpad = Null(SV**);
279 SvREFCNT_dec((SV*)CvPADLIST(cv));
280 CvPADLIST(cv) = Null(PADLIST*);
287 =for apidoc pad_add_name
289 Create a new name and associated PADMY SV in the current pad; return the
291 If C<typestash> is valid, the name is for a typed lexical; set the
292 name's stash to that value.
293 If C<ourstash> is valid, it's an our lexical, set the name's
294 GvSTASH to that value
296 If fake, it means we're cloning an existing entry
302 Perl_pad_add_name(pTHX_ char *name, HV* typestash, HV* ourstash, bool fake)
304 PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
305 SV* namesv = NEWSV(1102, 0);
307 ASSERT_CURPAD_ACTIVE("pad_add_name");
310 sv_upgrade(namesv, ourstash ? SVt_PVGV : typestash ? SVt_PVMG : SVt_PVNV);
311 sv_setpv(namesv, name);
314 SvFLAGS(namesv) |= SVpad_TYPED;
315 SvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*) typestash);
318 SvFLAGS(namesv) |= SVpad_OUR;
319 GvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*) ourstash);
322 av_store(PL_comppad_name, offset, namesv);
325 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
326 "Pad addname: %ld \"%s\" FAKE\n", (long)offset, name));
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 /* if it's not a simple scalar, replace with an AV or HV */
337 /* XXX DAPM since slot has been allocated, replace
338 * av_store with PL_curpad[offset] ? */
340 av_store(PL_comppad, offset, (SV*)newAV());
341 else if (*name == '%')
342 av_store(PL_comppad, offset, (SV*)newHV());
343 SvPADMY_on(PL_curpad[offset]);
344 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
345 "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
346 (long)offset, name, PTR2UV(PL_curpad[offset])));
356 =for apidoc pad_alloc
358 Allocate a new my or tmp pad entry. For a my, simply push a null SV onto
359 the end of PL_comppad, but for a tmp, scan the pad from PL_padix upwards
360 for a slot which has no name and and no active value.
365 /* XXX DAPM integrate alloc(), add_name() and add_anon(),
366 * or at least rationalise ??? */
370 Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
375 ASSERT_CURPAD_ACTIVE("pad_alloc");
377 if (AvARRAY(PL_comppad) != PL_curpad)
378 Perl_croak(aTHX_ "panic: pad_alloc");
379 if (PL_pad_reset_pending)
381 if (tmptype & SVs_PADMY) {
382 sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE);
383 retval = AvFILLp(PL_comppad);
386 SV **names = AvARRAY(PL_comppad_name);
387 SSize_t names_fill = AvFILLp(PL_comppad_name);
390 * "foreach" index vars temporarily become aliases to non-"my"
391 * values. Thus we must skip, not just pad values that are
392 * marked as current pad values, but also those with names.
394 /* HVDS why copy to sv here? we don't seem to use it */
395 if (++PL_padix <= names_fill &&
396 (sv = names[PL_padix]) && sv != &PL_sv_undef)
398 sv = *av_fetch(PL_comppad, PL_padix, TRUE);
399 if (!(SvFLAGS(sv) & (SVs_PADTMP | SVs_PADMY)) &&
400 !IS_PADGV(sv) && !IS_PADCONST(sv))
405 SvFLAGS(sv) |= tmptype;
406 PL_curpad = AvARRAY(PL_comppad);
408 DEBUG_X(PerlIO_printf(Perl_debug_log,
409 "Pad 0x%"UVxf"[0x%"UVxf"] alloc: %ld for %s\n",
410 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long) retval,
411 PL_op_name[optype]));
412 return (PADOFFSET)retval;
416 =for apidoc pad_add_anon
418 Add an anon code entry to the current compiling pad
424 Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
429 name = NEWSV(1106, 0);
430 sv_upgrade(name, SVt_PVNV);
431 sv_setpvn(name, "&", 1);
434 ix = pad_alloc(op_type, SVs_PADMY);
435 av_store(PL_comppad_name, ix, name);
436 /* XXX DAPM use PL_curpad[] ? */
437 av_store(PL_comppad, ix, sv);
440 /* to avoid ref loops, we never have parent + child referencing each
441 * other simultaneously */
442 if (CvOUTSIDE((CV*)sv)) {
443 assert(!CvWEAKOUTSIDE((CV*)sv));
444 CvWEAKOUTSIDE_on((CV*)sv);
445 SvREFCNT_dec(CvOUTSIDE((CV*)sv));
453 =for apidoc pad_check_dup
455 Check for duplicate declarations: report any of:
456 * a my in the current scope with the same name;
457 * an our (anywhere in the pad) with the same name and the same stash
459 C<is_our> indicates that the name to check is an 'our' declaration
464 /* XXX DAPM integrate this into pad_add_name ??? */
467 Perl_pad_check_dup(pTHX_ char *name, bool is_our, HV *ourstash)
472 ASSERT_CURPAD_ACTIVE("pad_check_dup");
473 if (!ckWARN(WARN_MISC) || AvFILLp(PL_comppad_name) < 0)
474 return; /* nothing to check */
476 svp = AvARRAY(PL_comppad_name);
477 top = AvFILLp(PL_comppad_name);
478 /* check the current scope */
479 /* XXX DAPM - why the (I32) cast - shouldn't we ensure they're the same
481 for (off = top; (I32)off > PL_comppad_name_floor; off--) {
483 && sv != &PL_sv_undef
485 && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
487 || ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash))
488 && strEQ(name, SvPVX(sv)))
490 Perl_warner(aTHX_ packWARN(WARN_MISC),
491 "\"%s\" variable %s masks earlier declaration in same %s",
492 (is_our ? "our" : "my"),
494 (SvIVX(sv) == PAD_MAX ? "scope" : "statement"));
499 /* check the rest of the pad */
503 && sv != &PL_sv_undef
505 && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
506 && ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash)
507 && strEQ(name, SvPVX(sv)))
509 Perl_warner(aTHX_ packWARN(WARN_MISC),
510 "\"our\" variable %s redeclared", name);
511 Perl_warner(aTHX_ packWARN(WARN_MISC),
512 "\t(Did you mean \"local\" instead of \"our\"?)\n");
515 } while ( off-- > 0 );
521 =for apidoc pad_findmy
523 Given a lexical name, try to find its offset, first in the current pad,
524 or failing that, in the pads of any lexically enclosing subs (including
525 the complications introduced by eval). If the name is found in an outer pad,
526 then a fake entry is added to the current pad.
527 Returns the offset in the current pad, or NOT_IN_PAD on failure.
533 Perl_pad_findmy(pTHX_ char *name)
538 return pad_findlex(name, PL_compcv, PL_cop_seqmax, 1,
539 Null(SV**), &out_sv, &out_flags);
544 =for apidoc pad_findlex
546 Find a named lexical anywhere in a chain of nested pads. Add fake entries
547 in the inner pads if it's found in an outer one.
549 Returns the offset in the bottom pad of the lex or the fake lex.
550 cv is the CV in which to start the search, and seq is the current cop_seq
551 to match against. If warn is true, print appropriate warnings. The out_*
552 vars return values, and so are pointers to where the returned values
553 should be stored. out_capture, if non-null, requests that the innermost
554 instance of the lexical is captured; out_name_sv is set to the innermost
555 matched namesv or fake namesv; out_flags returns the flags normally
556 associated with the IVX field of a fake namesv.
558 Note that pad_findlex() is recursive; it recurses up the chain of CVs,
559 then comes back down, adding fake entries as it goes. It has to be this way
560 because fake namesvs in anon protoypes have to store in NVX the index into
566 /* Flags set in the SvIVX field of FAKE namesvs */
568 #define PAD_FAKELEX_ANON 1 /* the lex is declared in an ANON, or ... */
569 #define PAD_FAKELEX_MULTI 2 /* the lex can be instantiated multiple times */
571 /* the CV has finished being compiled. This is not a sufficient test for
572 * all CVs (eg XSUBs), but suffices for the CVs found in a lexical chain */
573 #define CvCOMPILED(cv) CvROOT(cv)
577 S_pad_findlex(pTHX_ char *name, CV* cv, U32 seq, int warn,
578 SV** out_capture, SV** out_name_sv, int *out_flags)
580 I32 offset, new_offset;
583 AV *padlist = CvPADLIST(cv);
587 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
588 "Pad findlex cv=0x%"UVxf" searching \"%s\" seq=%d%s\n",
589 PTR2UV(cv), name, (int)seq, out_capture ? " capturing" : "" ));
591 /* first, search this pad */
593 if (padlist) { /* not an undef CV */
595 AV *nameav = (AV*)AvARRAY(padlist)[0];
596 SV **name_svp = AvARRAY(nameav);
598 for (offset = AvFILLp(nameav); offset > 0; offset--) {
599 SV *namesv = name_svp[offset];
600 if (namesv && namesv != &PL_sv_undef
601 && strEQ(SvPVX(namesv), name))
604 fake_offset = offset; /* in case we don't find a real one */
605 else if ( seq > (U32)I_32(SvNVX(namesv)) /* min */
606 && seq <= (U32)SvIVX(namesv)) /* max */
611 if (offset > 0 || fake_offset > 0 ) { /* a match! */
612 if (offset > 0) { /* not fake */
614 *out_name_sv = name_svp[offset]; /* return the namesv */
616 /* set PAD_FAKELEX_MULTI if this lex can have multiple
617 * instances. For now, we just test !CvUNIQUE(cv), but
618 * ideally, we should detect my's declared within loops
619 * etc - this would allow a wider range of 'not stayed
620 * shared' warnings. We also treated alreadly-compiled
621 * lexes as not multi as viewed from evals. */
623 *out_flags = CvANON(cv) ?
625 (!CvUNIQUE(cv) && ! CvCOMPILED(cv))
626 ? PAD_FAKELEX_MULTI : 0;
628 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
629 "Pad findlex cv=0x%"UVxf" matched: offset=%ld (%ld,%ld)\n",
630 PTR2UV(cv), (long)offset, (long)I_32(SvNVX(*out_name_sv)),
631 (long)SvIVX(*out_name_sv)));
633 else { /* fake match */
634 offset = fake_offset;
635 *out_name_sv = name_svp[offset]; /* return the namesv */
636 *out_flags = SvIVX(*out_name_sv);
637 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
638 "Pad findlex cv=0x%"UVxf" matched: offset=%ld flags=0x%x index=%lu\n",
639 PTR2UV(cv), (long)offset, (unsigned long)*out_flags,
640 (unsigned long)SvNVX(*out_name_sv)
644 /* return the lex? */
649 if ((SvFLAGS(*out_name_sv) & SVpad_OUR)) {
650 *out_capture = Nullsv;
654 /* trying to capture from an anon prototype? */
656 ? CvANON(cv) && CvCLONE(cv) && !CvCLONED(cv)
657 : *out_flags & PAD_FAKELEX_ANON)
659 if (warn && ckWARN(WARN_CLOSURE))
660 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
661 "Variable \"%s\" is not available", name);
662 *out_capture = Nullsv;
668 if (!CvCOMPILED(cv) && (*out_flags & PAD_FAKELEX_MULTI)
669 && warn && ckWARN(WARN_CLOSURE)) {
671 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
672 "Variable \"%s\" will not stay shared", name);
675 if (fake_offset && CvANON(cv)
676 && CvCLONE(cv) &&!CvCLONED(cv))
679 /* not yet caught - look further up */
680 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
681 "Pad findlex cv=0x%"UVxf" chasing lex in outer pad\n",
684 pad_findlex(name, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv),
685 newwarn, out_capture, out_name_sv, out_flags);
690 *out_capture = AvARRAY((AV*)AvARRAY(padlist)[
691 CvDEPTH(cv) ? CvDEPTH(cv) : 1])[offset];
692 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
693 "Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n",
694 PTR2UV(cv), *out_capture));
696 if (SvPADSTALE(*out_capture)) {
697 if (ckWARN(WARN_CLOSURE))
698 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
699 "Variable \"%s\" is not available", name);
700 *out_capture = Nullsv;
705 *out_capture = sv_2mortal((SV*)newAV());
706 else if (*name == '%')
707 *out_capture = sv_2mortal((SV*)newHV());
709 *out_capture = sv_newmortal();
717 /* it's not in this pad - try above */
722 /* out_capture non-null means caller wants us to capture lex; in
723 * addition we capture ourselves unless its an ANON */
724 new_capturep = out_capture ? out_capture :
725 CvANON(cv) ? Null(SV**) : &new_capture;
727 offset = pad_findlex(name, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1,
728 new_capturep, out_name_sv, out_flags);
729 if (offset == NOT_IN_PAD)
732 /* found in an outer CV. Add appropriate fake entry to this pad */
734 /* don't add new fake entries (via eval) to CVs that we have already
735 * finished compiling, or to undef CVs */
736 if (CvCOMPILED(cv) || !padlist)
737 return 0; /* this dummy (and invalid) value isnt used by the caller */
741 AV *ocomppad_name = PL_comppad_name;
742 PAD *ocomppad = PL_comppad;
743 PL_comppad_name = (AV*)AvARRAY(padlist)[0];
744 PL_comppad = (AV*)AvARRAY(padlist)[1];
745 PL_curpad = AvARRAY(PL_comppad);
747 new_offset = pad_add_name(
749 (SvFLAGS(*out_name_sv) & SVpad_TYPED)
750 ? SvSTASH(*out_name_sv) : Nullhv,
751 (SvFLAGS(*out_name_sv) & SVpad_OUR)
752 ? GvSTASH(*out_name_sv) : Nullhv,
756 new_namesv = AvARRAY(PL_comppad_name)[new_offset];
757 SvIVX(new_namesv) = *out_flags;
759 SvNVX(new_namesv) = (NV)0;
760 if (SvFLAGS(new_namesv) & SVpad_OUR) {
763 else if (CvANON(cv)) {
764 /* delayed creation - just note the offset within parent pad */
765 SvNVX(new_namesv) = (NV)offset;
769 /* immediate creation - capture outer value right now */
770 av_store(PL_comppad, new_offset, SvREFCNT_inc(*new_capturep));
771 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
772 "Pad findlex cv=0x%"UVxf" saved captured sv 0x%"UVxf" at offset %ld\n",
773 PTR2UV(cv), PTR2UV(*new_capturep), (long)new_offset));
775 *out_name_sv = new_namesv;
776 *out_flags = SvIVX(new_namesv);
778 PL_comppad_name = ocomppad_name;
779 PL_comppad = ocomppad;
780 PL_curpad = ocomppad ? AvARRAY(ocomppad) : Null(SV **);
789 Get the value at offset po in the current pad.
790 Use macro PAD_SV instead of calling this function directly.
797 Perl_pad_sv(pTHX_ PADOFFSET po)
799 ASSERT_CURPAD_ACTIVE("pad_sv");
802 Perl_croak(aTHX_ "panic: pad_sv po");
803 DEBUG_X(PerlIO_printf(Perl_debug_log,
804 "Pad 0x%"UVxf"[0x%"UVxf"] sv: %ld sv=0x%"UVxf"\n",
805 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(PL_curpad[po]))
807 return PL_curpad[po];
812 =for apidoc pad_setsv
814 Set the entry at offset po in the current pad to sv.
815 Use the macro PAD_SETSV() rather than calling this function directly.
822 Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
824 ASSERT_CURPAD_ACTIVE("pad_setsv");
826 DEBUG_X(PerlIO_printf(Perl_debug_log,
827 "Pad 0x%"UVxf"[0x%"UVxf"] setsv: %ld sv=0x%"UVxf"\n",
828 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(sv))
837 =for apidoc pad_block_start
839 Update the pad compilation state variables on entry to a new block
845 * - integrate this in general state-saving routine ???
846 * - combine with the state-saving going on in pad_new ???
847 * - introduce a new SAVE type that does all this in one go ?
851 Perl_pad_block_start(pTHX_ int full)
853 ASSERT_CURPAD_ACTIVE("pad_block_start");
854 SAVEI32(PL_comppad_name_floor);
855 PL_comppad_name_floor = AvFILLp(PL_comppad_name);
857 PL_comppad_name_fill = PL_comppad_name_floor;
858 if (PL_comppad_name_floor < 0)
859 PL_comppad_name_floor = 0;
860 SAVEI32(PL_min_intro_pending);
861 SAVEI32(PL_max_intro_pending);
862 PL_min_intro_pending = 0;
863 SAVEI32(PL_comppad_name_fill);
864 SAVEI32(PL_padix_floor);
865 PL_padix_floor = PL_padix;
866 PL_pad_reset_pending = FALSE;
873 "Introduce" my variables to visible status.
885 ASSERT_CURPAD_ACTIVE("intro_my");
886 if (! PL_min_intro_pending)
887 return PL_cop_seqmax;
889 svp = AvARRAY(PL_comppad_name);
890 for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
891 if ((sv = svp[i]) && sv != &PL_sv_undef
892 && !SvFAKE(sv) && !SvIVX(sv))
894 SvIVX(sv) = PAD_MAX; /* Don't know scope end yet. */
895 SvNVX(sv) = (NV)PL_cop_seqmax;
896 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
897 "Pad intromy: %ld \"%s\", (%ld,%ld)\n",
899 (long)I_32(SvNVX(sv)), (long)SvIVX(sv))
903 PL_min_intro_pending = 0;
904 PL_comppad_name_fill = PL_max_intro_pending; /* Needn't search higher */
905 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
906 "Pad intromy: seq -> %ld\n", (long)(PL_cop_seqmax+1)));
908 return PL_cop_seqmax++;
912 =for apidoc pad_leavemy
914 Cleanup at end of scope during compilation: set the max seq number for
915 lexicals in this scope and warn of any lexicals that never got introduced.
921 Perl_pad_leavemy(pTHX)
924 SV **svp = AvARRAY(PL_comppad_name);
927 PL_pad_reset_pending = FALSE;
929 ASSERT_CURPAD_ACTIVE("pad_leavemy");
930 if (PL_min_intro_pending && PL_comppad_name_fill < PL_min_intro_pending) {
931 for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
932 if ((sv = svp[off]) && sv != &PL_sv_undef
933 && !SvFAKE(sv) && ckWARN_d(WARN_INTERNAL))
934 Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
935 "%"SVf" never introduced", sv);
938 /* "Deintroduce" my variables that are leaving with this scope. */
939 for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_fill; off--) {
940 if ((sv = svp[off]) && sv != &PL_sv_undef
941 && !SvFAKE(sv) && SvIVX(sv) == PAD_MAX)
943 SvIVX(sv) = PL_cop_seqmax;
944 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
945 "Pad leavemy: %ld \"%s\", (%ld,%ld)\n",
946 (long)off, SvPVX(sv),
947 (long)I_32(SvNVX(sv)), (long)SvIVX(sv))
952 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
953 "Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax));
958 =for apidoc pad_swipe
960 Abandon the tmp in the current pad at offset po and replace with a
967 Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
969 ASSERT_CURPAD_LEGAL("pad_swipe");
972 if (AvARRAY(PL_comppad) != PL_curpad)
973 Perl_croak(aTHX_ "panic: pad_swipe curpad");
975 Perl_croak(aTHX_ "panic: pad_swipe po");
977 DEBUG_X(PerlIO_printf(Perl_debug_log,
978 "Pad 0x%"UVxf"[0x%"UVxf"] swipe: %ld\n",
979 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po));
982 SvPADTMP_off(PL_curpad[po]);
984 SvREFCNT_dec(PL_curpad[po]);
986 PL_curpad[po] = NEWSV(1107,0);
987 SvPADTMP_on(PL_curpad[po]);
988 if ((I32)po < PL_padix)
994 =for apidoc pad_reset
996 Mark all the current temporaries for reuse
1001 /* XXX pad_reset() is currently disabled because it results in serious bugs.
1002 * It causes pad temp TARGs to be shared between OPs. Since TARGs are pushed
1003 * on the stack by OPs that use them, there are several ways to get an alias
1004 * to a shared TARG. Such an alias will change randomly and unpredictably.
1005 * We avoid doing this until we can think of a Better Way.
1008 Perl_pad_reset(pTHX)
1010 #ifdef USE_BROKEN_PAD_RESET
1013 if (AvARRAY(PL_comppad) != PL_curpad)
1014 Perl_croak(aTHX_ "panic: pad_reset curpad");
1016 DEBUG_X(PerlIO_printf(Perl_debug_log,
1017 "Pad 0x%"UVxf"[0x%"UVxf"] reset: padix %ld -> %ld",
1018 PTR2UV(PL_comppad), PTR2UV(PL_curpad),
1019 (long)PL_padix, (long)PL_padix_floor
1023 if (!PL_tainting) { /* Can't mix tainted and non-tainted temporaries. */
1024 for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
1025 if (PL_curpad[po] && !SvIMMORTAL(PL_curpad[po]))
1026 SvPADTMP_off(PL_curpad[po]);
1028 PL_padix = PL_padix_floor;
1031 PL_pad_reset_pending = FALSE;
1036 =for apidoc pad_tidy
1038 Tidy up a pad after we've finished compiling it:
1039 * remove most stuff from the pads of anonsub prototypes;
1041 * mark tmps as such.
1046 /* XXX DAPM surely most of this stuff should be done properly
1047 * at the right time beforehand, rather than going around afterwards
1048 * cleaning up our mistakes ???
1052 Perl_pad_tidy(pTHX_ padtidy_type type)
1057 ASSERT_CURPAD_ACTIVE("pad_tidy");
1059 /* If this CV has had any 'eval-capable' ops planted in it
1060 * (ie it contains eval '...', //ee, /$var/ or /(?{..})/), Then any
1061 * anon prototypes in the chain of CVs should be marked as cloneable,
1062 * so that for example the eval's CV in C<< sub { eval '$x' } >> gets
1063 * the right CvOUTSIDE.
1064 * If running with -d, *any* sub may potentially have an eval
1065 * excuted within it.
1068 if (PL_cv_has_eval || PL_perldb) {
1069 for (cv = PL_compcv ;cv; cv = CvOUTSIDE(cv)) {
1070 if (cv != PL_compcv && CvCOMPILED(cv))
1071 break; /* no need to mark already-compiled code */
1073 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1074 "Pad clone on cv=0x%"UVxf"\n", PTR2UV(cv)));
1080 /* extend curpad to match namepad */
1081 if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
1082 av_store(PL_comppad_name, AvFILLp(PL_comppad), Nullsv);
1084 if (type == padtidy_SUBCLONE) {
1085 SV **namep = AvARRAY(PL_comppad_name);
1087 for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1090 if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
1093 * The only things that a clonable function needs in its
1094 * pad are anonymous subs.
1095 * The rest are created anew during cloning.
1097 if (!((namesv = namep[ix]) != Nullsv &&
1098 namesv != &PL_sv_undef &&
1099 *SvPVX(namesv) == '&'))
1101 SvREFCNT_dec(PL_curpad[ix]);
1102 PL_curpad[ix] = Nullsv;
1106 else if (type == padtidy_SUB) {
1107 /* XXX DAPM this same bit of code keeps appearing !!! Rationalise? */
1108 AV *av = newAV(); /* Will be @_ */
1110 av_store(PL_comppad, 0, (SV*)av);
1111 AvFLAGS(av) = AVf_REIFY;
1114 /* XXX DAPM rationalise these two similar branches */
1116 if (type == padtidy_SUB) {
1117 for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1118 if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
1120 if (!SvPADMY(PL_curpad[ix]))
1121 SvPADTMP_on(PL_curpad[ix]);
1124 else if (type == padtidy_FORMAT) {
1125 for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1126 if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix]))
1127 SvPADTMP_on(PL_curpad[ix]);
1130 PL_curpad = AvARRAY(PL_comppad);
1135 =for apidoc pad_free
1137 Free the SV at offet po in the current pad.
1142 /* XXX DAPM integrate with pad_swipe ???? */
1144 Perl_pad_free(pTHX_ PADOFFSET po)
1146 ASSERT_CURPAD_LEGAL("pad_free");
1149 if (AvARRAY(PL_comppad) != PL_curpad)
1150 Perl_croak(aTHX_ "panic: pad_free curpad");
1152 Perl_croak(aTHX_ "panic: pad_free po");
1154 DEBUG_X(PerlIO_printf(Perl_debug_log,
1155 "Pad 0x%"UVxf"[0x%"UVxf"] free: %ld\n",
1156 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po)
1159 if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
1160 SvPADTMP_off(PL_curpad[po]);
1162 /* SV could be a shared hash key (eg bugid #19022) */
1164 #ifdef PERL_COPY_ON_WRITE
1165 !SvIsCOW(PL_curpad[po])
1167 !SvFAKE(PL_curpad[po])
1170 SvREADONLY_off(PL_curpad[po]); /* could be a freed constant */
1173 if ((I32)po < PL_padix)
1180 =for apidoc do_dump_pad
1182 Dump the contents of a padlist
1188 Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
1200 pad_name = (AV*)*av_fetch((AV*)padlist, 0, FALSE);
1201 pad = (AV*)*av_fetch((AV*)padlist, 1, FALSE);
1202 pname = AvARRAY(pad_name);
1203 ppad = AvARRAY(pad);
1204 Perl_dump_indent(aTHX_ level, file,
1205 "PADNAME = 0x%"UVxf"(0x%"UVxf") PAD = 0x%"UVxf"(0x%"UVxf")\n",
1206 PTR2UV(pad_name), PTR2UV(pname), PTR2UV(pad), PTR2UV(ppad)
1209 for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
1211 if (namesv && namesv == &PL_sv_undef) {
1216 Perl_dump_indent(aTHX_ level+1, file,
1217 "%2d. 0x%"UVxf"<%lu> FAKE \"%s\" flags=0x%x index=%lu\n",
1220 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
1222 (unsigned long)SvIVX(namesv),
1223 (unsigned long)SvNVX(namesv)
1227 Perl_dump_indent(aTHX_ level+1, file,
1228 "%2d. 0x%"UVxf"<%lu> (%ld,%ld) \"%s\"\n",
1231 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
1232 (long)I_32(SvNVX(namesv)),
1233 (long)SvIVX(namesv),
1238 Perl_dump_indent(aTHX_ level+1, file,
1239 "%2d. 0x%"UVxf"<%lu>\n",
1242 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0)
1253 dump the contents of a CV
1260 S_cv_dump(pTHX_ CV *cv, char *title)
1262 CV *outside = CvOUTSIDE(cv);
1263 AV* padlist = CvPADLIST(cv);
1265 PerlIO_printf(Perl_debug_log,
1266 " %s: CV=0x%"UVxf" (%s), OUTSIDE=0x%"UVxf" (%s)\n",
1269 (CvANON(cv) ? "ANON"
1270 : (cv == PL_main_cv) ? "MAIN"
1271 : CvUNIQUE(cv) ? "UNIQUE"
1272 : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
1275 : CvANON(outside) ? "ANON"
1276 : (outside == PL_main_cv) ? "MAIN"
1277 : CvUNIQUE(outside) ? "UNIQUE"
1278 : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
1280 PerlIO_printf(Perl_debug_log,
1281 " PADLIST = 0x%"UVxf"\n", PTR2UV(padlist));
1282 do_dump_pad(1, Perl_debug_log, padlist, 1);
1284 #endif /* DEBUGGING */
1291 =for apidoc cv_clone
1293 Clone a CV: make a new CV which points to the same code etc, but which
1294 has a newly-created pad built by copying the prototype pad and capturing
1301 Perl_cv_clone(pTHX_ CV *proto)
1304 AV* protopadlist = CvPADLIST(proto);
1305 AV* protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
1306 AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
1307 SV** pname = AvARRAY(protopad_name);
1308 SV** ppad = AvARRAY(protopad);
1309 I32 fname = AvFILLp(protopad_name);
1310 I32 fpad = AvFILLp(protopad);
1316 assert(!CvUNIQUE(proto));
1318 outside = find_runcv(NULL);
1319 /* presumably whoever invoked us must be active */
1321 assert(CvDEPTH(outside));
1322 assert(CvPADLIST(outside));
1325 SAVESPTR(PL_compcv);
1327 cv = PL_compcv = (CV*)NEWSV(1104, 0);
1328 sv_upgrade((SV *)cv, SvTYPE(proto));
1329 CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE);
1333 CvFILE(cv) = CvXSUB(proto) ? CvFILE(proto)
1334 : savepv(CvFILE(proto));
1336 CvFILE(cv) = CvFILE(proto);
1338 CvGV(cv) = CvGV(proto);
1339 CvSTASH(cv) = CvSTASH(proto);
1340 CvROOT(cv) = OpREFCNT_inc(CvROOT(proto));
1341 CvSTART(cv) = CvSTART(proto);
1342 CvOUTSIDE(cv) = (CV*)SvREFCNT_inc(outside);
1343 CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
1346 sv_setpvn((SV*)cv, SvPVX(proto), SvCUR(proto));
1348 CvPADLIST(cv) = comppadlist = pad_new(padnew_CLONE|padnew_SAVE);
1350 av_fill(PL_comppad, fpad);
1351 for (ix = fname; ix >= 0; ix--)
1352 av_store(PL_comppad_name, ix, SvREFCNT_inc(pname[ix]));
1354 PL_curpad = AvARRAY(PL_comppad);
1356 outpad = AvARRAY(AvARRAY(CvPADLIST(outside))[CvDEPTH(outside)]);
1358 for (ix = fpad; ix > 0; ix--) {
1359 SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
1361 if (namesv && namesv != &PL_sv_undef) {
1362 if (SvFAKE(namesv)) { /* lexical from outside? */
1363 assert(outpad[(I32)SvNVX(namesv)] &&
1364 !SvPADSTALE(outpad[(I32)SvNVX(namesv)]));
1365 PL_curpad[ix] = SvREFCNT_inc(outpad[(I32)SvNVX(namesv)]);
1368 char *name = SvPVX(namesv);
1370 sv = SvREFCNT_inc(ppad[ix]);
1371 else if (*name == '@')
1373 else if (*name == '%')
1381 else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) {
1382 PL_curpad[ix] = SvREFCNT_inc(ppad[ix]);
1392 PerlIO_printf(Perl_debug_log, "\nPad CV clone\n");
1393 cv_dump(outside, "Outside");
1394 cv_dump(proto, "Proto");
1401 /* Constant sub () { $x } closing over $x - see lib/constant.pm:
1402 * The prototype was marked as a candiate for const-ization,
1403 * so try to grab the current const value, and if successful,
1404 * turn into a const sub:
1406 SV* const_sv = op_const_sv(CvSTART(cv), cv);
1409 cv = newCONSTSUB(CvSTASH(proto), 0, const_sv);
1421 =for apidoc pad_fixup_inner_anons
1423 For any anon CVs in the pad, change CvOUTSIDE of that CV from
1424 old_cv to new_cv if necessary. Needed when a newly-compiled CV has to be
1425 moved to a pre-existing CV struct.
1431 Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
1434 AV *comppad_name = (AV*)AvARRAY(padlist)[0];
1435 AV *comppad = (AV*)AvARRAY(padlist)[1];
1436 SV **namepad = AvARRAY(comppad_name);
1437 SV **curpad = AvARRAY(comppad);
1438 for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
1439 SV *namesv = namepad[ix];
1440 if (namesv && namesv != &PL_sv_undef
1441 && *SvPVX(namesv) == '&')
1443 CV *innercv = (CV*)curpad[ix];
1444 assert(CvWEAKOUTSIDE(innercv));
1445 assert(CvOUTSIDE(innercv) == old_cv);
1446 CvOUTSIDE(innercv) = new_cv;
1453 =for apidoc pad_push
1455 Push a new pad frame onto the padlist, unless there's already a pad at
1456 this depth, in which case don't bother creating a new one.
1457 If has_args is true, give the new pad an @_ in slot zero.
1463 Perl_pad_push(pTHX_ PADLIST *padlist, int depth, int has_args)
1465 if (depth <= AvFILLp(padlist))
1469 SV** svp = AvARRAY(padlist);
1470 AV *newpad = newAV();
1471 SV **oldpad = AvARRAY(svp[depth-1]);
1472 I32 ix = AvFILLp((AV*)svp[1]);
1473 I32 names_fill = AvFILLp((AV*)svp[0]);
1474 SV** names = AvARRAY(svp[0]);
1476 for ( ;ix > 0; ix--) {
1477 if (names_fill >= ix && names[ix] != &PL_sv_undef) {
1478 char *name = SvPVX(names[ix]);
1479 if ((SvFLAGS(names[ix]) & SVf_FAKE) || *name == '&') {
1480 /* outer lexical or anon code */
1481 av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]));
1483 else { /* our own lexical */
1485 av_store(newpad, ix, sv = (SV*)newAV());
1486 else if (*name == '%')
1487 av_store(newpad, ix, sv = (SV*)newHV());
1489 av_store(newpad, ix, sv = NEWSV(0, 0));
1493 else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
1494 av_store(newpad, ix, sv = SvREFCNT_inc(oldpad[ix]));
1497 /* save temporaries on recursion? */
1498 av_store(newpad, ix, sv = NEWSV(0, 0));
1505 av_store(newpad, 0, (SV*)av);
1506 AvFLAGS(av) = AVf_REIFY;
1508 av_store(padlist, depth, (SV*)newpad);
1509 AvFILLp(padlist) = depth;