3 * Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
4 * by Larry Wall and others
6 * You may distribute under the terms of either the GNU General Public
7 * License or the Artistic License, as specified in the README file.
11 * 'Anyway: there was this Mr. Frodo left an orphan and stranded, as you
12 * might say, among those queer Bucklanders, being brought up anyhow in
13 * Brandy Hall. A regular warren, by all accounts. Old Master Gorbadoc
14 * never had fewer than a couple of hundred relations in the place.
15 * Mr. Bilbo never did a kinder deed than when he brought the lad back
16 * to live among decent folk.' --the Gaffer
18 * [p.23 of _The Lord of the Rings_, I/i: "A Long-Expected Party"]
22 * As of Sept 2002, this file is new and may be in a state of flux for
23 * a while. I've marked things I intent to come back and look at further
24 * with an 'XXX DAPM' comment.
28 =head1 Pad Data Structures
30 =for apidoc Amx|PADLIST *|CvPADLIST|CV *cv
32 CV's can have CvPADLIST(cv) set to point to an AV. This is the CV's
33 scratchpad, which stores lexical variables and opcode temporary and
36 For these purposes "forms" are a kind-of CV, eval""s are too (except they're
37 not callable at will and are always thrown away after the eval"" is done
38 executing). Require'd files are simply evals without any outer lexical
41 XSUBs don't have CvPADLIST set - dXSTARG fetches values from PL_curpad,
42 but that is really the callers pad (a slot of which is allocated by
45 The CvPADLIST AV has does not have AvREAL set, so REFCNT of component items
46 is managed "manual" (mostly in pad.c) rather than normal av.c rules.
47 The items in the AV are not SVs as for a normal AV, but other AVs:
49 0'th Entry of the CvPADLIST is an AV which represents the "names" or rather
50 the "static type information" for lexicals.
52 The CvDEPTH'th entry of CvPADLIST AV is an AV which is the stack frame at that
53 depth of recursion into the CV.
54 The 0'th slot of a frame AV is an AV which is @_.
55 other entries are storage for variables and op targets.
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 xlow+1..xhigh inclusive in the NV union is a range of cop_seq numbers for
71 which the name is valid (accessed through the macros COP_SEQ_RANGE_LOW and
72 _HIGH). During compilation, these fields may hold the special value
73 PERL_PADSEQ_INTRO to indicate various stages:
75 COP_SEQ_RANGE_LOW _HIGH
76 ----------------- -----
77 PERL_PADSEQ_INTRO 0 variable not yet introduced: { my ($x
78 valid-seq# PERL_PADSEQ_INTRO variable in scope: { my ($x)
79 valid-seq# valid-seq# compilation of scope complete: { my ($x) }
81 For typed lexicals name SV is SVt_PVMG and SvSTASH
82 points at the type. For C<our> lexicals, the type is also SVt_PVMG, with the
83 SvOURSTASH slot pointing at the stash of the associated global (so that
84 duplicate C<our> declarations in the same package can be detected). SvUVX is
85 sometimes hijacked to store the generation number during compilation.
87 If SvFAKE is set on the name SV, then that slot in the frame AV is
88 a REFCNT'ed reference to a lexical from "outside". In this case,
89 the name SV does not use xlow and xhigh to store a cop_seq range, since it is
90 in scope throughout. Instead xhigh stores some flags containing info about
91 the real lexical (is it declared in an anon, and is it capable of being
92 instantiated multiple times?), and for fake ANONs, xlow contains the index
93 within the parent's pad where the lexical's value is stored, to make
96 If the 'name' is '&' the corresponding entry in frame AV
97 is a CV representing a possible closure.
98 (SvFAKE and name of '&' is not a meaningful combination currently but could
99 become so if C<my sub foo {}> is implemented.)
101 Note that formats are treated as anon subs, and are cloned each time
102 write is called (if necessary).
104 The flag SVs_PADSTALE is cleared on lexicals each time the my() is executed,
105 and set on scope exit. This allows the 'Variable $x is not available' warning
106 to be generated in evals, such as
108 { my $x = 1; sub f { eval '$x'} } f();
110 For state vars, SVs_PADSTALE is overloaded to mean 'not yet initialised'
112 =for apidoc AmxU|AV *|PL_comppad_name
114 During compilation, this points to the array containing the names part
115 of the pad for the currently-compiling code.
117 =for apidoc AmxU|AV *|PL_comppad
119 During compilation, this points to the array containing the values
120 part of the pad for the currently-compiling code. (At runtime a CV may
121 have many such value arrays; at compile time just one is constructed.)
122 At runtime, this points to the array containing the currently-relevant
123 values for the pad for the currently-executing code.
125 =for apidoc AmxU|SV **|PL_curpad
127 Points directly to the body of the L</PL_comppad> array.
128 (I.e., this is C<AvARRAY(PL_comppad)>.)
135 #define PERL_IN_PAD_C
137 #include "keywords.h"
139 #define COP_SEQ_RANGE_LOW_set(sv,val) \
140 STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xlow = (val); } STMT_END
141 #define COP_SEQ_RANGE_HIGH_set(sv,val) \
142 STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xhigh = (val); } STMT_END
144 #define PARENT_PAD_INDEX_set(sv,val) \
145 STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xlow = (val); } STMT_END
146 #define PARENT_FAKELEX_FLAGS_set(sv,val) \
147 STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xhigh = (val); } STMT_END
150 =for apidoc mx|void|pad_peg|const char *s
152 When PERL_MAD is enabled, this is a small no-op function that gets called
153 at the start of each pad-related function. It can be breakpointed to
154 track all pad operations. The parameter is a string indicating the type
155 of pad operation being performed.
161 void pad_peg(const char* s) {
162 static int pegcnt; /* XXX not threadsafe */
165 PERL_ARGS_ASSERT_PAD_PEG;
172 This is basically sv_eq_flags() in sv.c, but we avoid the magic
177 sv_eq_pvn_flags(pTHX_ const SV *sv, const char* pv, const STRLEN pvlen, const U32 flags) {
178 if ( (SvUTF8(sv) & SVf_UTF8 ) != (flags & SVf_UTF8) ) {
179 const char *pv1 = SvPVX_const(sv);
180 STRLEN cur1 = SvCUR(sv);
181 const char *pv2 = pv;
186 svrecode = newSVpvn(pv2, cur2);
187 sv_recode_to_utf8(svrecode, PL_encoding);
188 pv2 = SvPV_const(svrecode, cur2);
191 svrecode = newSVpvn(pv1, cur1);
192 sv_recode_to_utf8(svrecode, PL_encoding);
193 pv1 = SvPV_const(svrecode, cur1);
195 SvREFCNT_dec(svrecode);
197 if (flags & SVf_UTF8)
198 return (bytes_cmp_utf8(
199 (const U8*)pv1, cur1,
200 (const U8*)pv2, cur2) == 0);
202 return (bytes_cmp_utf8(
203 (const U8*)pv2, cur2,
204 (const U8*)pv1, cur1) == 0);
207 return ((SvPVX_const(sv) == pv)
208 || memEQ(SvPVX_const(sv), pv, pvlen));
213 =for apidoc Am|PADLIST *|pad_new|int flags
215 Create a new padlist, updating the global variables for the
216 currently-compiling padlist to point to the new padlist. The following
217 flags can be OR'ed together:
219 padnew_CLONE this pad is for a cloned CV
220 padnew_SAVE save old globals on the save stack
221 padnew_SAVESUB also save extra stuff for start of sub
227 Perl_pad_new(pTHX_ int flags)
230 AV *padlist, *padname, *pad;
233 ASSERT_CURPAD_LEGAL("pad_new");
235 /* XXX DAPM really need a new SAVEt_PAD which restores all or most
236 * vars (based on flags) rather than storing vals + addresses for
237 * each individually. Also see pad_block_start.
238 * XXX DAPM Try to see whether all these conditionals are required
241 /* save existing state, ... */
243 if (flags & padnew_SAVE) {
245 SAVESPTR(PL_comppad_name);
246 if (! (flags & padnew_CLONE)) {
248 SAVEI32(PL_comppad_name_fill);
249 SAVEI32(PL_min_intro_pending);
250 SAVEI32(PL_max_intro_pending);
251 SAVEBOOL(PL_cv_has_eval);
252 if (flags & padnew_SAVESUB) {
253 SAVEBOOL(PL_pad_reset_pending);
257 /* XXX DAPM interestingly, PL_comppad_name_floor never seems to be
258 * saved - check at some pt that this is okay */
260 /* ... create new pad ... */
266 if (flags & padnew_CLONE) {
267 /* XXX DAPM I dont know why cv_clone needs it
268 * doing differently yet - perhaps this separate branch can be
269 * dispensed with eventually ???
272 AV * const a0 = newAV(); /* will be @_ */
273 av_store(pad, 0, MUTABLE_SV(a0));
277 av_store(pad, 0, NULL);
281 /* Most subroutines never recurse, hence only need 2 entries in the padlist
282 array - names, and depth=1. The default for av_store() is to allocate
283 0..3, and even an explicit call to av_extend() with <3 will be rounded
284 up, so we inline the allocation of the array here. */
286 AvFILLp(padlist) = 1;
288 AvALLOC(padlist) = ary;
289 AvARRAY(padlist) = ary;
290 ary[0] = MUTABLE_SV(padname);
291 ary[1] = MUTABLE_SV(pad);
293 /* ... then update state variables */
295 PL_comppad_name = padname;
297 PL_curpad = AvARRAY(pad);
299 if (! (flags & padnew_CLONE)) {
300 PL_comppad_name_fill = 0;
301 PL_min_intro_pending = 0;
306 DEBUG_X(PerlIO_printf(Perl_debug_log,
307 "Pad 0x%"UVxf"[0x%"UVxf"] new: compcv=0x%"UVxf
308 " name=0x%"UVxf" flags=0x%"UVxf"\n",
309 PTR2UV(PL_comppad), PTR2UV(PL_curpad), PTR2UV(PL_compcv),
310 PTR2UV(padname), (UV)flags
314 return (PADLIST*)padlist;
319 =head1 Embedding Functions
323 Clear out all the active components of a CV. This can happen either
324 by an explicit C<undef &foo>, or by the reference count going to zero.
325 In the former case, we keep the CvOUTSIDE pointer, so that any anonymous
326 children can still follow the full lexical scope chain.
332 Perl_cv_undef(pTHX_ CV *cv)
335 const PADLIST *padlist = CvPADLIST(cv);
337 PERL_ARGS_ASSERT_CV_UNDEF;
339 DEBUG_X(PerlIO_printf(Perl_debug_log,
340 "CV undef: cv=0x%"UVxf" comppad=0x%"UVxf"\n",
341 PTR2UV(cv), PTR2UV(PL_comppad))
344 if (CvFILE(cv) && CvDYNFILE(cv)) {
345 Safefree(CvFILE(cv));
349 if (!CvISXSUB(cv) && CvROOT(cv)) {
350 if (SvTYPE(cv) == SVt_PVCV && CvDEPTH(cv))
351 Perl_croak(aTHX_ "Can't undef active subroutine");
354 PAD_SAVE_SETNULLPAD();
361 SvPOK_off(MUTABLE_SV(cv)); /* forget prototype */
364 /* This statement and the subsequence if block was pad_undef(). */
365 pad_peg("pad_undef");
367 if (padlist && !SvIS_FREED(padlist) /* may be during global destruction */
371 /* Free the padlist associated with a CV.
372 If parts of it happen to be current, we null the relevant PL_*pad*
373 global vars so that we don't have any dangling references left.
374 We also repoint the CvOUTSIDE of any about-to-be-orphaned inner
375 subs to the outer of this cv. */
377 DEBUG_X(PerlIO_printf(Perl_debug_log,
378 "Pad undef: cv=0x%"UVxf" padlist=0x%"UVxf" comppad=0x%"UVxf"\n",
379 PTR2UV(cv), PTR2UV(padlist), PTR2UV(PL_comppad))
382 /* detach any '&' anon children in the pad; if afterwards they
383 * are still live, fix up their CvOUTSIDEs to point to our outside,
385 /* XXX DAPM for efficiency, we should only do this if we know we have
386 * children, or integrate this loop with general cleanup */
388 if (PL_phase != PERL_PHASE_DESTRUCT) { /* don't bother during global destruction */
389 CV * const outercv = CvOUTSIDE(cv);
390 const U32 seq = CvOUTSIDE_SEQ(cv);
391 AV * const comppad_name = MUTABLE_AV(AvARRAY(padlist)[0]);
392 SV ** const namepad = AvARRAY(comppad_name);
393 AV * const comppad = MUTABLE_AV(AvARRAY(padlist)[1]);
394 SV ** const curpad = AvARRAY(comppad);
395 for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
396 SV * const namesv = namepad[ix];
397 if (namesv && namesv != &PL_sv_undef
398 && *SvPVX_const(namesv) == '&')
400 CV * const innercv = MUTABLE_CV(curpad[ix]);
401 U32 inner_rc = SvREFCNT(innercv);
404 SvREFCNT_dec(namesv);
406 if (SvREFCNT(comppad) < 2) { /* allow for /(?{ sub{} })/ */
408 SvREFCNT_dec(innercv);
412 /* in use, not just a prototype */
413 if (inner_rc && (CvOUTSIDE(innercv) == cv)) {
414 assert(CvWEAKOUTSIDE(innercv));
415 /* don't relink to grandfather if he's being freed */
416 if (outercv && SvREFCNT(outercv)) {
417 CvWEAKOUTSIDE_off(innercv);
418 CvOUTSIDE(innercv) = outercv;
419 CvOUTSIDE_SEQ(innercv) = seq;
420 SvREFCNT_inc_simple_void_NN(outercv);
423 CvOUTSIDE(innercv) = NULL;
430 ix = AvFILLp(padlist);
432 SV* const sv = AvARRAY(padlist)[ix--];
434 if (sv == (const SV *)PL_comppad) {
442 SV *const sv = AvARRAY(padlist)[0];
443 if (sv == (const SV *)PL_comppad_name)
444 PL_comppad_name = NULL;
447 SvREFCNT_dec(MUTABLE_SV(CvPADLIST(cv)));
448 CvPADLIST(cv) = NULL;
452 /* remove CvOUTSIDE unless this is an undef rather than a free */
453 if (!SvREFCNT(cv) && CvOUTSIDE(cv)) {
454 if (!CvWEAKOUTSIDE(cv))
455 SvREFCNT_dec(CvOUTSIDE(cv));
456 CvOUTSIDE(cv) = NULL;
459 SvREFCNT_dec(MUTABLE_SV(CvXSUBANY(cv).any_ptr));
462 if (CvISXSUB(cv) && CvXSUB(cv)) {
465 /* delete all flags except WEAKOUTSIDE and CVGV_RC, which indicate the
466 * ref status of CvOUTSIDE and CvGV */
467 CvFLAGS(cv) &= (CVf_WEAKOUTSIDE|CVf_CVGV_RC);
471 =for apidoc m|PADOFFSET|pad_alloc_name|SV *namesv|U32 flags|HV *typestash|HV *ourstash
473 Allocates a place in the currently-compiling
474 pad (via L<perlapi/pad_alloc>) and
475 then stores a name for that entry. I<namesv> is adopted and becomes the
476 name entry; it must already contain the name string and be sufficiently
477 upgraded. I<typestash> and I<ourstash> and the C<padadd_STATE> flag get
478 added to I<namesv>. None of the other
479 processing of L<perlapi/pad_add_name_pvn>
480 is done. Returns the offset of the allocated pad slot.
486 S_pad_alloc_name(pTHX_ SV *namesv, U32 flags, HV *typestash, HV *ourstash)
489 const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
491 PERL_ARGS_ASSERT_PAD_ALLOC_NAME;
493 ASSERT_CURPAD_ACTIVE("pad_alloc_name");
496 assert(SvTYPE(namesv) == SVt_PVMG);
497 SvPAD_TYPED_on(namesv);
498 SvSTASH_set(namesv, MUTABLE_HV(SvREFCNT_inc_simple_NN(MUTABLE_SV(typestash))));
501 SvPAD_OUR_on(namesv);
502 SvOURSTASH_set(namesv, ourstash);
503 SvREFCNT_inc_simple_void_NN(ourstash);
505 else if (flags & padadd_STATE) {
506 SvPAD_STATE_on(namesv);
509 av_store(PL_comppad_name, offset, namesv);
514 =for apidoc Am|PADOFFSET|pad_add_name_pvn|const char *namepv|STRLEN namelen|U32 flags|HV *typestash|HV *ourstash
516 Allocates a place in the currently-compiling pad for a named lexical
517 variable. Stores the name and other metadata in the name part of the
518 pad, and makes preparations to manage the variable's lexical scoping.
519 Returns the offset of the allocated pad slot.
521 I<namepv>/I<namelen> specify the variable's name, including leading sigil.
522 If I<typestash> is non-null, the name is for a typed lexical, and this
523 identifies the type. If I<ourstash> is non-null, it's a lexical reference
524 to a package variable, and this identifies the package. The following
525 flags can be OR'ed together:
527 padadd_OUR redundantly specifies if it's a package var
528 padadd_STATE variable will retain value persistently
529 padadd_NO_DUP_CHECK skip check for lexical shadowing
535 Perl_pad_add_name_pvn(pTHX_ const char *namepv, STRLEN namelen,
536 U32 flags, HV *typestash, HV *ourstash)
543 PERL_ARGS_ASSERT_PAD_ADD_NAME_PVN;
545 if (flags & ~(padadd_OUR|padadd_STATE|padadd_NO_DUP_CHECK|padadd_UTF8_NAME))
546 Perl_croak(aTHX_ "panic: pad_add_name_pvn illegal flag bits 0x%" UVxf,
549 namesv = newSV_type((ourstash || typestash) ? SVt_PVMG : SVt_PVNV);
551 if ((is_utf8 = ((flags & padadd_UTF8_NAME) != 0))) {
552 namepv = (const char*)bytes_from_utf8((U8*)namepv, &namelen, &is_utf8);
555 sv_setpvn(namesv, namepv, namelen);
558 flags |= padadd_UTF8_NAME;
562 flags &= ~padadd_UTF8_NAME;
564 if ((flags & padadd_NO_DUP_CHECK) == 0) {
565 /* check for duplicate declaration */
566 pad_check_dup(namesv, flags & padadd_OUR, ourstash);
569 offset = pad_alloc_name(namesv, flags & ~padadd_UTF8_NAME, typestash, ourstash);
571 /* not yet introduced */
572 COP_SEQ_RANGE_LOW_set(namesv, PERL_PADSEQ_INTRO);
573 COP_SEQ_RANGE_HIGH_set(namesv, 0);
575 if (!PL_min_intro_pending)
576 PL_min_intro_pending = offset;
577 PL_max_intro_pending = offset;
578 /* if it's not a simple scalar, replace with an AV or HV */
579 assert(SvTYPE(PL_curpad[offset]) == SVt_NULL);
580 assert(SvREFCNT(PL_curpad[offset]) == 1);
581 if (namelen != 0 && *namepv == '@')
582 sv_upgrade(PL_curpad[offset], SVt_PVAV);
583 else if (namelen != 0 && *namepv == '%')
584 sv_upgrade(PL_curpad[offset], SVt_PVHV);
585 assert(SvPADMY(PL_curpad[offset]));
586 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
587 "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
588 (long)offset, SvPVX(namesv),
589 PTR2UV(PL_curpad[offset])));
595 =for apidoc Am|PADOFFSET|pad_add_name_pv|const char *name|U32 flags|HV *typestash|HV *ourstash
597 Exactly like L</pad_add_name_pvn>, but takes a nul-terminated string
598 instead of a string/length pair.
604 Perl_pad_add_name_pv(pTHX_ const char *name,
605 const U32 flags, HV *typestash, HV *ourstash)
607 PERL_ARGS_ASSERT_PAD_ADD_NAME_PV;
608 return pad_add_name_pvn(name, strlen(name), flags, typestash, ourstash);
612 =for apidoc Am|PADOFFSET|pad_add_name_sv|SV *name|U32 flags|HV *typestash|HV *ourstash
614 Exactly like L</pad_add_name_pvn>, but takes the name string in the form
615 of an SV instead of a string/length pair.
621 Perl_pad_add_name_sv(pTHX_ SV *name, U32 flags, HV *typestash, HV *ourstash)
625 PERL_ARGS_ASSERT_PAD_ADD_NAME_SV;
626 namepv = SvPV(name, namelen);
628 flags |= padadd_UTF8_NAME;
629 return pad_add_name_pvn(namepv, namelen, flags, typestash, ourstash);
633 =for apidoc Amx|PADOFFSET|pad_alloc|I32 optype|U32 tmptype
635 Allocates a place in the currently-compiling pad,
636 returning the offset of the allocated pad slot.
637 No name is initially attached to the pad slot.
638 I<tmptype> is a set of flags indicating the kind of pad entry required,
639 which will be set in the value SV for the allocated pad entry:
641 SVs_PADMY named lexical variable ("my", "our", "state")
642 SVs_PADTMP unnamed temporary store
644 I<optype> should be an opcode indicating the type of operation that the
645 pad entry is to support. This doesn't affect operational semantics,
646 but is used for debugging.
651 /* XXX DAPM integrate alloc(), add_name() and add_anon(),
652 * or at least rationalise ??? */
653 /* And flag whether the incoming name is UTF8 or 8 bit?
654 Could do this either with the +ve/-ve hack of the HV code, or expanding
655 the flag bits. Either way, this makes proper Unicode safe pad support.
660 Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
666 PERL_UNUSED_ARG(optype);
667 ASSERT_CURPAD_ACTIVE("pad_alloc");
669 if (AvARRAY(PL_comppad) != PL_curpad)
670 Perl_croak(aTHX_ "panic: pad_alloc");
671 if (PL_pad_reset_pending)
673 if (tmptype & SVs_PADMY) {
674 /* For a my, simply push a null SV onto the end of PL_comppad. */
675 sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE);
676 retval = AvFILLp(PL_comppad);
679 /* For a tmp, scan the pad from PL_padix upwards
680 * for a slot which has no name and no active value.
682 SV * const * const names = AvARRAY(PL_comppad_name);
683 const SSize_t names_fill = AvFILLp(PL_comppad_name);
686 * "foreach" index vars temporarily become aliases to non-"my"
687 * values. Thus we must skip, not just pad values that are
688 * marked as current pad values, but also those with names.
690 /* HVDS why copy to sv here? we don't seem to use it */
691 if (++PL_padix <= names_fill &&
692 (sv = names[PL_padix]) && sv != &PL_sv_undef)
694 sv = *av_fetch(PL_comppad, PL_padix, TRUE);
695 if (!(SvFLAGS(sv) & (SVs_PADTMP | SVs_PADMY)) &&
696 !IS_PADGV(sv) && !IS_PADCONST(sv))
701 SvFLAGS(sv) |= tmptype;
702 PL_curpad = AvARRAY(PL_comppad);
704 DEBUG_X(PerlIO_printf(Perl_debug_log,
705 "Pad 0x%"UVxf"[0x%"UVxf"] alloc: %ld for %s\n",
706 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long) retval,
707 PL_op_name[optype]));
708 #ifdef DEBUG_LEAKING_SCALARS
709 sv->sv_debug_optype = optype;
710 sv->sv_debug_inpad = 1;
712 return (PADOFFSET)retval;
716 =for apidoc Am|PADOFFSET|pad_add_anon|CV *func|I32 optype
718 Allocates a place in the currently-compiling pad (via L</pad_alloc>)
719 for an anonymous function that is lexically scoped inside the
720 currently-compiling function.
721 The function I<func> is linked into the pad, and its C<CvOUTSIDE> link
722 to the outer scope is weakened to avoid a reference loop.
724 I<optype> should be an opcode indicating the type of operation that the
725 pad entry is to support. This doesn't affect operational semantics,
726 but is used for debugging.
732 Perl_pad_add_anon(pTHX_ CV* func, I32 optype)
736 SV* const name = newSV_type(SVt_PVNV);
738 PERL_ARGS_ASSERT_PAD_ADD_ANON;
741 sv_setpvs(name, "&");
742 /* These two aren't used; just make sure they're not equal to
743 * PERL_PADSEQ_INTRO */
744 COP_SEQ_RANGE_LOW_set(name, 0);
745 COP_SEQ_RANGE_HIGH_set(name, 0);
746 ix = pad_alloc(optype, SVs_PADMY);
747 av_store(PL_comppad_name, ix, name);
748 /* XXX DAPM use PL_curpad[] ? */
749 av_store(PL_comppad, ix, (SV*)func);
750 SvPADMY_on((SV*)func);
752 /* to avoid ref loops, we never have parent + child referencing each
753 * other simultaneously */
754 if (CvOUTSIDE(func)) {
755 assert(!CvWEAKOUTSIDE(func));
756 CvWEAKOUTSIDE_on(func);
757 SvREFCNT_dec(CvOUTSIDE(func));
763 =for apidoc m|pad_check_dup|SV *name|U32 flags|const HV *ourstash
765 Check for duplicate declarations: report any of:
766 * a my in the current scope with the same name;
767 * an our (anywhere in the pad) with the same name and the same stash
769 C<is_our> indicates that the name to check is an 'our' declaration
775 S_pad_check_dup(pTHX_ SV *name, U32 flags, const HV *ourstash)
780 const U32 is_our = flags & padadd_OUR;
782 PERL_ARGS_ASSERT_PAD_CHECK_DUP;
784 ASSERT_CURPAD_ACTIVE("pad_check_dup");
786 assert((flags & ~padadd_OUR) == 0);
788 if (AvFILLp(PL_comppad_name) < 0 || !ckWARN(WARN_MISC))
789 return; /* nothing to check */
791 svp = AvARRAY(PL_comppad_name);
792 top = AvFILLp(PL_comppad_name);
793 /* check the current scope */
794 /* XXX DAPM - why the (I32) cast - shouldn't we ensure they're the same
796 for (off = top; (I32)off > PL_comppad_name_floor; off--) {
797 SV * const sv = svp[off];
799 && sv != &PL_sv_undef
801 && ( COP_SEQ_RANGE_LOW(sv) == PERL_PADSEQ_INTRO
802 || COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
805 if (is_our && (SvPAD_OUR(sv)))
806 break; /* "our" masking "our" */
807 Perl_warner(aTHX_ packWARN(WARN_MISC),
808 "\"%s\" variable %"SVf" masks earlier declaration in same %s",
809 (is_our ? "our" : PL_parser->in_my == KEY_my ? "my" : "state"),
811 (COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO
812 ? "scope" : "statement"));
817 /* check the rest of the pad */
820 SV * const sv = svp[off];
822 && sv != &PL_sv_undef
824 && ( COP_SEQ_RANGE_LOW(sv) == PERL_PADSEQ_INTRO
825 || COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
826 && SvOURSTASH(sv) == ourstash
829 Perl_warner(aTHX_ packWARN(WARN_MISC),
830 "\"our\" variable %"SVf" redeclared", sv);
831 if ((I32)off <= PL_comppad_name_floor)
832 Perl_warner(aTHX_ packWARN(WARN_MISC),
833 "\t(Did you mean \"local\" instead of \"our\"?)\n");
843 =for apidoc Am|PADOFFSET|pad_findmy_pvn|const char *namepv|STRLEN namelen|U32 flags
845 Given the name of a lexical variable, find its position in the
846 currently-compiling pad.
847 I<namepv>/I<namelen> specify the variable's name, including leading sigil.
848 I<flags> is reserved and must be zero.
849 If it is not in the current pad but appears in the pad of any lexically
850 enclosing scope, then a pseudo-entry for it is added in the current pad.
851 Returns the offset in the current pad,
852 or C<NOT_IN_PAD> if no such lexical is in scope.
858 Perl_pad_findmy_pvn(pTHX_ const char *namepv, STRLEN namelen, U32 flags)
867 PERL_ARGS_ASSERT_PAD_FINDMY_PVN;
869 pad_peg("pad_findmy_pvn");
871 if (flags & ~padadd_UTF8_NAME)
872 Perl_croak(aTHX_ "panic: pad_findmy_pvn illegal flag bits 0x%" UVxf,
875 if (flags & padadd_UTF8_NAME) {
877 namepv = (const char*)bytes_from_utf8((U8*)namepv, &namelen, &is_utf8);
880 flags |= padadd_UTF8_NAME;
882 flags &= ~padadd_UTF8_NAME;
885 offset = pad_findlex(namepv, namelen, flags,
886 PL_compcv, PL_cop_seqmax, 1, NULL, &out_sv, &out_flags);
887 if ((PADOFFSET)offset != NOT_IN_PAD)
890 /* look for an our that's being introduced; this allows
891 * our $foo = 0 unless defined $foo;
892 * to not give a warning. (Yes, this is a hack) */
894 nameav = MUTABLE_AV(AvARRAY(CvPADLIST(PL_compcv))[0]);
895 name_svp = AvARRAY(nameav);
896 for (offset = AvFILLp(nameav); offset > 0; offset--) {
897 const SV * const namesv = name_svp[offset];
898 if (namesv && namesv != &PL_sv_undef
900 && (SvPAD_OUR(namesv))
901 && SvCUR(namesv) == namelen
902 && sv_eq_pvn_flags(aTHX_ namesv, namepv, namelen,
903 flags & padadd_UTF8_NAME ? SVf_UTF8 : 0 )
904 && COP_SEQ_RANGE_LOW(namesv) == PERL_PADSEQ_INTRO
912 =for apidoc Am|PADOFFSET|pad_findmy_pv|const char *name|U32 flags
914 Exactly like L</pad_findmy_pvn>, but takes a nul-terminated string
915 instead of a string/length pair.
921 Perl_pad_findmy_pv(pTHX_ const char *name, U32 flags)
923 PERL_ARGS_ASSERT_PAD_FINDMY_PV;
924 return pad_findmy_pvn(name, strlen(name), flags);
928 =for apidoc Am|PADOFFSET|pad_findmy_sv|SV *name|U32 flags
930 Exactly like L</pad_findmy_pvn>, but takes the name string in the form
931 of an SV instead of a string/length pair.
937 Perl_pad_findmy_sv(pTHX_ SV *name, U32 flags)
941 PERL_ARGS_ASSERT_PAD_FINDMY_SV;
942 namepv = SvPV(name, namelen);
944 flags |= padadd_UTF8_NAME;
945 return pad_findmy_pvn(namepv, namelen, flags);
949 =for apidoc Amp|PADOFFSET|find_rundefsvoffset
951 Find the position of the lexical C<$_> in the pad of the
952 currently-executing function. Returns the offset in the current pad,
953 or C<NOT_IN_PAD> if there is no lexical C<$_> in scope (in which case
954 the global one should be used instead).
955 L</find_rundefsv> is likely to be more convenient.
961 Perl_find_rundefsvoffset(pTHX)
966 return pad_findlex("$_", 2, 0, find_runcv(NULL), PL_curcop->cop_seq, 1,
967 NULL, &out_sv, &out_flags);
971 =for apidoc Am|SV *|find_rundefsv
973 Find and return the variable that is named C<$_> in the lexical scope
974 of the currently-executing function. This may be a lexical C<$_>,
975 or will otherwise be the global one.
981 Perl_find_rundefsv(pTHX)
987 po = pad_findlex("$_", 2, 0, find_runcv(NULL), PL_curcop->cop_seq, 1,
988 NULL, &namesv, &flags);
990 if (po == NOT_IN_PAD || SvPAD_OUR(namesv))
997 =for apidoc m|PADOFFSET|pad_findlex|const char *namepv|STRLEN namelen|U32 flags|const CV* cv|U32 seq|int warn|SV** out_capture|SV** out_name_sv|int *out_flags
999 Find a named lexical anywhere in a chain of nested pads. Add fake entries
1000 in the inner pads if it's found in an outer one.
1002 Returns the offset in the bottom pad of the lex or the fake lex.
1003 cv is the CV in which to start the search, and seq is the current cop_seq
1004 to match against. If warn is true, print appropriate warnings. The out_*
1005 vars return values, and so are pointers to where the returned values
1006 should be stored. out_capture, if non-null, requests that the innermost
1007 instance of the lexical is captured; out_name_sv is set to the innermost
1008 matched namesv or fake namesv; out_flags returns the flags normally
1009 associated with the IVX field of a fake namesv.
1011 Note that pad_findlex() is recursive; it recurses up the chain of CVs,
1012 then comes back down, adding fake entries as it goes. It has to be this way
1013 because fake namesvs in anon protoypes have to store in xlow the index into
1019 /* the CV has finished being compiled. This is not a sufficient test for
1020 * all CVs (eg XSUBs), but suffices for the CVs found in a lexical chain */
1021 #define CvCOMPILED(cv) CvROOT(cv)
1023 /* the CV does late binding of its lexicals */
1024 #define CvLATE(cv) (CvANON(cv) || SvTYPE(cv) == SVt_PVFM)
1028 S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv, U32 seq,
1029 int warn, SV** out_capture, SV** out_name_sv, int *out_flags)
1032 I32 offset, new_offset;
1035 const AV * const padlist = CvPADLIST(cv);
1037 PERL_ARGS_ASSERT_PAD_FINDLEX;
1039 if (flags & ~padadd_UTF8_NAME)
1040 Perl_croak(aTHX_ "panic: pad_findlex illegal flag bits 0x%" UVxf,
1045 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1046 "Pad findlex cv=0x%"UVxf" searching \"%.*s\" seq=%d%s\n",
1047 PTR2UV(cv), (int)namelen, namepv, (int)seq,
1048 out_capture ? " capturing" : "" ));
1050 /* first, search this pad */
1052 if (padlist) { /* not an undef CV */
1053 I32 fake_offset = 0;
1054 const AV * const nameav = MUTABLE_AV(AvARRAY(padlist)[0]);
1055 SV * const * const name_svp = AvARRAY(nameav);
1057 for (offset = AvFILLp(nameav); offset > 0; offset--) {
1058 const SV * const namesv = name_svp[offset];
1059 if (namesv && namesv != &PL_sv_undef
1060 && SvCUR(namesv) == namelen
1061 && sv_eq_pvn_flags(aTHX_ namesv, namepv, namelen,
1062 flags & padadd_UTF8_NAME ? SVf_UTF8 : 0))
1064 if (SvFAKE(namesv)) {
1065 fake_offset = offset; /* in case we don't find a real one */
1068 /* is seq within the range _LOW to _HIGH ?
1069 * This is complicated by the fact that PL_cop_seqmax
1070 * may have wrapped around at some point */
1071 if (COP_SEQ_RANGE_LOW(namesv) == PERL_PADSEQ_INTRO)
1072 continue; /* not yet introduced */
1074 if (COP_SEQ_RANGE_HIGH(namesv) == PERL_PADSEQ_INTRO) {
1075 /* in compiling scope */
1077 (seq > COP_SEQ_RANGE_LOW(namesv))
1078 ? (seq - COP_SEQ_RANGE_LOW(namesv) < (U32_MAX >> 1))
1079 : (COP_SEQ_RANGE_LOW(namesv) - seq > (U32_MAX >> 1))
1084 (COP_SEQ_RANGE_LOW(namesv) > COP_SEQ_RANGE_HIGH(namesv))
1086 ( seq > COP_SEQ_RANGE_LOW(namesv)
1087 || seq <= COP_SEQ_RANGE_HIGH(namesv))
1089 : ( seq > COP_SEQ_RANGE_LOW(namesv)
1090 && seq <= COP_SEQ_RANGE_HIGH(namesv))
1096 if (offset > 0 || fake_offset > 0 ) { /* a match! */
1097 if (offset > 0) { /* not fake */
1099 *out_name_sv = name_svp[offset]; /* return the namesv */
1101 /* set PAD_FAKELEX_MULTI if this lex can have multiple
1102 * instances. For now, we just test !CvUNIQUE(cv), but
1103 * ideally, we should detect my's declared within loops
1104 * etc - this would allow a wider range of 'not stayed
1105 * shared' warnings. We also treated already-compiled
1106 * lexes as not multi as viewed from evals. */
1108 *out_flags = CvANON(cv) ?
1110 (!CvUNIQUE(cv) && ! CvCOMPILED(cv))
1111 ? PAD_FAKELEX_MULTI : 0;
1113 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1114 "Pad findlex cv=0x%"UVxf" matched: offset=%ld (%lu,%lu)\n",
1115 PTR2UV(cv), (long)offset,
1116 (unsigned long)COP_SEQ_RANGE_LOW(*out_name_sv),
1117 (unsigned long)COP_SEQ_RANGE_HIGH(*out_name_sv)));
1119 else { /* fake match */
1120 offset = fake_offset;
1121 *out_name_sv = name_svp[offset]; /* return the namesv */
1122 *out_flags = PARENT_FAKELEX_FLAGS(*out_name_sv);
1123 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1124 "Pad findlex cv=0x%"UVxf" matched: offset=%ld flags=0x%lx index=%lu\n",
1125 PTR2UV(cv), (long)offset, (unsigned long)*out_flags,
1126 (unsigned long) PARENT_PAD_INDEX(*out_name_sv)
1130 /* return the lex? */
1135 if (SvPAD_OUR(*out_name_sv)) {
1136 *out_capture = NULL;
1140 /* trying to capture from an anon prototype? */
1142 ? CvANON(cv) && CvCLONE(cv) && !CvCLONED(cv)
1143 : *out_flags & PAD_FAKELEX_ANON)
1146 Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
1147 "Variable \"%"SVf"\" is not available",
1148 newSVpvn_flags(namepv, namelen,
1150 (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
1152 *out_capture = NULL;
1158 if (!CvCOMPILED(cv) && (*out_flags & PAD_FAKELEX_MULTI)
1159 && !SvPAD_STATE(name_svp[offset])
1160 && warn && ckWARN(WARN_CLOSURE)) {
1162 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
1163 "Variable \"%"SVf"\" will not stay shared",
1164 newSVpvn_flags(namepv, namelen,
1166 (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
1169 if (fake_offset && CvANON(cv)
1170 && CvCLONE(cv) &&!CvCLONED(cv))
1173 /* not yet caught - look further up */
1174 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1175 "Pad findlex cv=0x%"UVxf" chasing lex in outer pad\n",
1178 (void) pad_findlex(namepv, namelen, flags, CvOUTSIDE(cv),
1180 newwarn, out_capture, out_name_sv, out_flags);
1185 *out_capture = AvARRAY(MUTABLE_AV(AvARRAY(padlist)[
1186 CvDEPTH(cv) ? CvDEPTH(cv) : 1]))[offset];
1187 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1188 "Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n",
1189 PTR2UV(cv), PTR2UV(*out_capture)));
1191 if (SvPADSTALE(*out_capture)
1192 && !SvPAD_STATE(name_svp[offset]))
1194 Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
1195 "Variable \"%"SVf"\" is not available",
1196 newSVpvn_flags(namepv, namelen,
1198 (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
1199 *out_capture = NULL;
1202 if (!*out_capture) {
1203 if (namelen != 0 && *namepv == '@')
1204 *out_capture = sv_2mortal(MUTABLE_SV(newAV()));
1205 else if (namelen != 0 && *namepv == '%')
1206 *out_capture = sv_2mortal(MUTABLE_SV(newHV()));
1208 *out_capture = sv_newmortal();
1216 /* it's not in this pad - try above */
1221 /* out_capture non-null means caller wants us to capture lex; in
1222 * addition we capture ourselves unless it's an ANON/format */
1223 new_capturep = out_capture ? out_capture :
1224 CvLATE(cv) ? NULL : &new_capture;
1226 offset = pad_findlex(namepv, namelen, flags, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1,
1227 new_capturep, out_name_sv, out_flags);
1228 if ((PADOFFSET)offset == NOT_IN_PAD)
1231 /* found in an outer CV. Add appropriate fake entry to this pad */
1233 /* don't add new fake entries (via eval) to CVs that we have already
1234 * finished compiling, or to undef CVs */
1235 if (CvCOMPILED(cv) || !padlist)
1236 return 0; /* this dummy (and invalid) value isnt used by the caller */
1239 /* This relies on sv_setsv_flags() upgrading the destination to the same
1240 type as the source, independent of the flags set, and on it being
1241 "good" and only copying flag bits and pointers that it understands.
1243 SV *new_namesv = newSVsv(*out_name_sv);
1244 AV * const ocomppad_name = PL_comppad_name;
1245 PAD * const ocomppad = PL_comppad;
1246 PL_comppad_name = MUTABLE_AV(AvARRAY(padlist)[0]);
1247 PL_comppad = MUTABLE_AV(AvARRAY(padlist)[1]);
1248 PL_curpad = AvARRAY(PL_comppad);
1251 = pad_alloc_name(new_namesv,
1252 (SvPAD_STATE(*out_name_sv) ? padadd_STATE : 0),
1253 SvPAD_TYPED(*out_name_sv)
1254 ? SvSTASH(*out_name_sv) : NULL,
1255 SvOURSTASH(*out_name_sv)
1258 SvFAKE_on(new_namesv);
1259 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1260 "Pad addname: %ld \"%.*s\" FAKE\n",
1262 (int) SvCUR(new_namesv), SvPVX(new_namesv)));
1263 PARENT_FAKELEX_FLAGS_set(new_namesv, *out_flags);
1265 PARENT_PAD_INDEX_set(new_namesv, 0);
1266 if (SvPAD_OUR(new_namesv)) {
1267 NOOP; /* do nothing */
1269 else if (CvLATE(cv)) {
1270 /* delayed creation - just note the offset within parent pad */
1271 PARENT_PAD_INDEX_set(new_namesv, offset);
1275 /* immediate creation - capture outer value right now */
1276 av_store(PL_comppad, new_offset, SvREFCNT_inc(*new_capturep));
1277 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1278 "Pad findlex cv=0x%"UVxf" saved captured sv 0x%"UVxf" at offset %ld\n",
1279 PTR2UV(cv), PTR2UV(*new_capturep), (long)new_offset));
1281 *out_name_sv = new_namesv;
1282 *out_flags = PARENT_FAKELEX_FLAGS(new_namesv);
1284 PL_comppad_name = ocomppad_name;
1285 PL_comppad = ocomppad;
1286 PL_curpad = ocomppad ? AvARRAY(ocomppad) : NULL;
1294 =for apidoc Am|SV *|pad_sv|PADOFFSET po
1296 Get the value at offset I<po> in the current (compiling or executing) pad.
1297 Use macro PAD_SV instead of calling this function directly.
1303 Perl_pad_sv(pTHX_ PADOFFSET po)
1306 ASSERT_CURPAD_ACTIVE("pad_sv");
1309 Perl_croak(aTHX_ "panic: pad_sv po");
1310 DEBUG_X(PerlIO_printf(Perl_debug_log,
1311 "Pad 0x%"UVxf"[0x%"UVxf"] sv: %ld sv=0x%"UVxf"\n",
1312 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(PL_curpad[po]))
1314 return PL_curpad[po];
1318 =for apidoc Am|void|pad_setsv|PADOFFSET po|SV *sv
1320 Set the value at offset I<po> in the current (compiling or executing) pad.
1321 Use the macro PAD_SETSV() rather than calling this function directly.
1327 Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
1331 PERL_ARGS_ASSERT_PAD_SETSV;
1333 ASSERT_CURPAD_ACTIVE("pad_setsv");
1335 DEBUG_X(PerlIO_printf(Perl_debug_log,
1336 "Pad 0x%"UVxf"[0x%"UVxf"] setsv: %ld sv=0x%"UVxf"\n",
1337 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(sv))
1342 #endif /* DEBUGGING */
1345 =for apidoc m|void|pad_block_start|int full
1347 Update the pad compilation state variables on entry to a new block
1352 /* XXX DAPM perhaps:
1353 * - integrate this in general state-saving routine ???
1354 * - combine with the state-saving going on in pad_new ???
1355 * - introduce a new SAVE type that does all this in one go ?
1359 Perl_pad_block_start(pTHX_ int full)
1362 ASSERT_CURPAD_ACTIVE("pad_block_start");
1363 SAVEI32(PL_comppad_name_floor);
1364 PL_comppad_name_floor = AvFILLp(PL_comppad_name);
1366 PL_comppad_name_fill = PL_comppad_name_floor;
1367 if (PL_comppad_name_floor < 0)
1368 PL_comppad_name_floor = 0;
1369 SAVEI32(PL_min_intro_pending);
1370 SAVEI32(PL_max_intro_pending);
1371 PL_min_intro_pending = 0;
1372 SAVEI32(PL_comppad_name_fill);
1373 SAVEI32(PL_padix_floor);
1374 PL_padix_floor = PL_padix;
1375 PL_pad_reset_pending = FALSE;
1379 =for apidoc m|U32|intro_my
1381 "Introduce" my variables to visible status.
1394 ASSERT_CURPAD_ACTIVE("intro_my");
1395 if (! PL_min_intro_pending)
1396 return PL_cop_seqmax;
1398 svp = AvARRAY(PL_comppad_name);
1399 for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
1400 SV * const sv = svp[i];
1402 if (sv && sv != &PL_sv_undef && !SvFAKE(sv)
1403 && COP_SEQ_RANGE_LOW(sv) == PERL_PADSEQ_INTRO)
1405 COP_SEQ_RANGE_HIGH_set(sv, PERL_PADSEQ_INTRO); /* Don't know scope end yet. */
1406 COP_SEQ_RANGE_LOW_set(sv, PL_cop_seqmax);
1407 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1408 "Pad intromy: %ld \"%s\", (%lu,%lu)\n",
1409 (long)i, SvPVX_const(sv),
1410 (unsigned long)COP_SEQ_RANGE_LOW(sv),
1411 (unsigned long)COP_SEQ_RANGE_HIGH(sv))
1415 seq = PL_cop_seqmax;
1417 if (PL_cop_seqmax == PERL_PADSEQ_INTRO) /* not a legal value */
1419 PL_min_intro_pending = 0;
1420 PL_comppad_name_fill = PL_max_intro_pending; /* Needn't search higher */
1421 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1422 "Pad intromy: seq -> %ld\n", (long)(PL_cop_seqmax)));
1428 =for apidoc m|void|pad_leavemy
1430 Cleanup at end of scope during compilation: set the max seq number for
1431 lexicals in this scope and warn of any lexicals that never got introduced.
1437 Perl_pad_leavemy(pTHX)
1441 SV * const * const svp = AvARRAY(PL_comppad_name);
1443 PL_pad_reset_pending = FALSE;
1445 ASSERT_CURPAD_ACTIVE("pad_leavemy");
1446 if (PL_min_intro_pending && PL_comppad_name_fill < PL_min_intro_pending) {
1447 for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
1448 const SV * const sv = svp[off];
1449 if (sv && sv != &PL_sv_undef && !SvFAKE(sv))
1450 Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
1451 "%"SVf" never introduced",
1455 /* "Deintroduce" my variables that are leaving with this scope. */
1456 for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_fill; off--) {
1457 const SV * const sv = svp[off];
1458 if (sv && sv != &PL_sv_undef && !SvFAKE(sv)
1459 && COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
1461 COP_SEQ_RANGE_HIGH_set(sv, PL_cop_seqmax);
1462 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1463 "Pad leavemy: %ld \"%s\", (%lu,%lu)\n",
1464 (long)off, SvPVX_const(sv),
1465 (unsigned long)COP_SEQ_RANGE_LOW(sv),
1466 (unsigned long)COP_SEQ_RANGE_HIGH(sv))
1471 if (PL_cop_seqmax == PERL_PADSEQ_INTRO) /* not a legal value */
1473 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1474 "Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax));
1478 =for apidoc m|void|pad_swipe|PADOFFSET po|bool refadjust
1480 Abandon the tmp in the current pad at offset po and replace with a
1487 Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
1490 ASSERT_CURPAD_LEGAL("pad_swipe");
1493 if (AvARRAY(PL_comppad) != PL_curpad)
1494 Perl_croak(aTHX_ "panic: pad_swipe curpad");
1496 Perl_croak(aTHX_ "panic: pad_swipe po");
1498 DEBUG_X(PerlIO_printf(Perl_debug_log,
1499 "Pad 0x%"UVxf"[0x%"UVxf"] swipe: %ld\n",
1500 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po));
1503 SvPADTMP_off(PL_curpad[po]);
1505 SvREFCNT_dec(PL_curpad[po]);
1508 /* if pad tmps aren't shared between ops, then there's no need to
1509 * create a new tmp when an existing op is freed */
1510 #ifdef USE_BROKEN_PAD_RESET
1511 PL_curpad[po] = newSV(0);
1512 SvPADTMP_on(PL_curpad[po]);
1514 PL_curpad[po] = &PL_sv_undef;
1516 if ((I32)po < PL_padix)
1521 =for apidoc m|void|pad_reset
1523 Mark all the current temporaries for reuse
1528 /* XXX pad_reset() is currently disabled because it results in serious bugs.
1529 * It causes pad temp TARGs to be shared between OPs. Since TARGs are pushed
1530 * on the stack by OPs that use them, there are several ways to get an alias
1531 * to a shared TARG. Such an alias will change randomly and unpredictably.
1532 * We avoid doing this until we can think of a Better Way.
1538 #ifdef USE_BROKEN_PAD_RESET
1539 if (AvARRAY(PL_comppad) != PL_curpad)
1540 Perl_croak(aTHX_ "panic: pad_reset curpad");
1542 DEBUG_X(PerlIO_printf(Perl_debug_log,
1543 "Pad 0x%"UVxf"[0x%"UVxf"] reset: padix %ld -> %ld",
1544 PTR2UV(PL_comppad), PTR2UV(PL_curpad),
1545 (long)PL_padix, (long)PL_padix_floor
1549 if (!PL_tainting) { /* Can't mix tainted and non-tainted temporaries. */
1551 for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
1552 if (PL_curpad[po] && !SvIMMORTAL(PL_curpad[po]))
1553 SvPADTMP_off(PL_curpad[po]);
1555 PL_padix = PL_padix_floor;
1558 PL_pad_reset_pending = FALSE;
1562 =for apidoc Amx|void|pad_tidy|padtidy_type type
1564 Tidy up a pad at the end of compilation of the code to which it belongs.
1565 Jobs performed here are: remove most stuff from the pads of anonsub
1566 prototypes; give it a @_; mark temporaries as such. I<type> indicates
1567 the kind of subroutine:
1569 padtidy_SUB ordinary subroutine
1570 padtidy_SUBCLONE prototype for lexical closure
1571 padtidy_FORMAT format
1576 /* XXX DAPM surely most of this stuff should be done properly
1577 * at the right time beforehand, rather than going around afterwards
1578 * cleaning up our mistakes ???
1582 Perl_pad_tidy(pTHX_ padtidy_type type)
1586 ASSERT_CURPAD_ACTIVE("pad_tidy");
1588 /* If this CV has had any 'eval-capable' ops planted in it
1589 * (ie it contains eval '...', //ee, /$var/ or /(?{..})/), Then any
1590 * anon prototypes in the chain of CVs should be marked as cloneable,
1591 * so that for example the eval's CV in C<< sub { eval '$x' } >> gets
1592 * the right CvOUTSIDE.
1593 * If running with -d, *any* sub may potentially have an eval
1594 * executed within it.
1597 if (PL_cv_has_eval || PL_perldb) {
1599 for (cv = PL_compcv ;cv; cv = CvOUTSIDE(cv)) {
1600 if (cv != PL_compcv && CvCOMPILED(cv))
1601 break; /* no need to mark already-compiled code */
1603 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1604 "Pad clone on cv=0x%"UVxf"\n", PTR2UV(cv)));
1610 /* extend curpad to match namepad */
1611 if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
1612 av_store(PL_comppad_name, AvFILLp(PL_comppad), NULL);
1614 if (type == padtidy_SUBCLONE) {
1615 SV * const * const namep = AvARRAY(PL_comppad_name);
1618 for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1621 if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
1624 * The only things that a clonable function needs in its
1625 * pad are anonymous subs.
1626 * The rest are created anew during cloning.
1628 if (!((namesv = namep[ix]) != NULL &&
1629 namesv != &PL_sv_undef &&
1630 *SvPVX_const(namesv) == '&'))
1632 SvREFCNT_dec(PL_curpad[ix]);
1633 PL_curpad[ix] = NULL;
1637 else if (type == padtidy_SUB) {
1638 /* XXX DAPM this same bit of code keeps appearing !!! Rationalise? */
1639 AV * const av = newAV(); /* Will be @_ */
1640 av_store(PL_comppad, 0, MUTABLE_SV(av));
1644 if (type == padtidy_SUB || type == padtidy_FORMAT) {
1645 SV * const * const namep = AvARRAY(PL_comppad_name);
1647 for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1648 if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
1650 if (!SvPADMY(PL_curpad[ix])) {
1651 SvPADTMP_on(PL_curpad[ix]);
1652 } else if (!SvFAKE(namep[ix])) {
1653 /* This is a work around for how the current implementation of
1654 ?{ } blocks in regexps interacts with lexicals.
1656 One of our lexicals.
1657 Can't do this on all lexicals, otherwise sub baz() won't
1666 because completion of compiling &bar calling pad_tidy()
1667 would cause (top level) $foo to be marked as stale, and
1668 "no longer available". */
1669 SvPADSTALE_on(PL_curpad[ix]);
1673 PL_curpad = AvARRAY(PL_comppad);
1677 =for apidoc m|void|pad_free|PADOFFSET po
1679 Free the SV at offset po in the current pad.
1684 /* XXX DAPM integrate with pad_swipe ???? */
1686 Perl_pad_free(pTHX_ PADOFFSET po)
1689 ASSERT_CURPAD_LEGAL("pad_free");
1692 if (AvARRAY(PL_comppad) != PL_curpad)
1693 Perl_croak(aTHX_ "panic: pad_free curpad");
1695 Perl_croak(aTHX_ "panic: pad_free po");
1697 DEBUG_X(PerlIO_printf(Perl_debug_log,
1698 "Pad 0x%"UVxf"[0x%"UVxf"] free: %ld\n",
1699 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po)
1702 if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
1703 SvPADTMP_off(PL_curpad[po]);
1705 if ((I32)po < PL_padix)
1710 =for apidoc m|void|do_dump_pad|I32 level|PerlIO *file|PADLIST *padlist|int full
1712 Dump the contents of a padlist
1718 Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
1727 PERL_ARGS_ASSERT_DO_DUMP_PAD;
1732 pad_name = MUTABLE_AV(*av_fetch(MUTABLE_AV(padlist), 0, FALSE));
1733 pad = MUTABLE_AV(*av_fetch(MUTABLE_AV(padlist), 1, FALSE));
1734 pname = AvARRAY(pad_name);
1735 ppad = AvARRAY(pad);
1736 Perl_dump_indent(aTHX_ level, file,
1737 "PADNAME = 0x%"UVxf"(0x%"UVxf") PAD = 0x%"UVxf"(0x%"UVxf")\n",
1738 PTR2UV(pad_name), PTR2UV(pname), PTR2UV(pad), PTR2UV(ppad)
1741 for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
1742 const SV *namesv = pname[ix];
1743 if (namesv && namesv == &PL_sv_undef) {
1748 Perl_dump_indent(aTHX_ level+1, file,
1749 "%2d. 0x%"UVxf"<%lu> FAKE \"%s\" flags=0x%lx index=%lu\n",
1752 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
1753 SvPVX_const(namesv),
1754 (unsigned long)PARENT_FAKELEX_FLAGS(namesv),
1755 (unsigned long)PARENT_PAD_INDEX(namesv)
1759 Perl_dump_indent(aTHX_ level+1, file,
1760 "%2d. 0x%"UVxf"<%lu> (%lu,%lu) \"%s\"\n",
1763 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
1764 (unsigned long)COP_SEQ_RANGE_LOW(namesv),
1765 (unsigned long)COP_SEQ_RANGE_HIGH(namesv),
1770 Perl_dump_indent(aTHX_ level+1, file,
1771 "%2d. 0x%"UVxf"<%lu>\n",
1774 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0)
1783 =for apidoc m|void|cv_dump|CV *cv|const char *title
1785 dump the contents of a CV
1791 S_cv_dump(pTHX_ const CV *cv, const char *title)
1794 const CV * const outside = CvOUTSIDE(cv);
1795 AV* const padlist = CvPADLIST(cv);
1797 PERL_ARGS_ASSERT_CV_DUMP;
1799 PerlIO_printf(Perl_debug_log,
1800 " %s: CV=0x%"UVxf" (%s), OUTSIDE=0x%"UVxf" (%s)\n",
1803 (CvANON(cv) ? "ANON"
1804 : (SvTYPE(cv) == SVt_PVFM) ? "FORMAT"
1805 : (cv == PL_main_cv) ? "MAIN"
1806 : CvUNIQUE(cv) ? "UNIQUE"
1807 : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
1810 : CvANON(outside) ? "ANON"
1811 : (outside == PL_main_cv) ? "MAIN"
1812 : CvUNIQUE(outside) ? "UNIQUE"
1813 : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
1815 PerlIO_printf(Perl_debug_log,
1816 " PADLIST = 0x%"UVxf"\n", PTR2UV(padlist));
1817 do_dump_pad(1, Perl_debug_log, padlist, 1);
1820 #endif /* DEBUGGING */
1823 =for apidoc Am|CV *|cv_clone|CV *proto
1825 Clone a CV, making a lexical closure. I<proto> supplies the prototype
1826 of the function: its code, pad structure, and other attributes.
1827 The prototype is combined with a capture of outer lexicals to which the
1828 code refers, which are taken from the currently-executing instance of
1829 the immediately surrounding code.
1835 Perl_cv_clone(pTHX_ CV *proto)
1839 AV* const protopadlist = CvPADLIST(proto);
1840 const AV *const protopad_name = (const AV *)*av_fetch(protopadlist, 0, FALSE);
1841 const AV *const protopad = (const AV *)*av_fetch(protopadlist, 1, FALSE);
1842 SV** const pname = AvARRAY(protopad_name);
1843 SV** const ppad = AvARRAY(protopad);
1844 const I32 fname = AvFILLp(protopad_name);
1845 const I32 fpad = AvFILLp(protopad);
1851 PERL_ARGS_ASSERT_CV_CLONE;
1853 assert(!CvUNIQUE(proto));
1855 /* Since cloneable anon subs can be nested, CvOUTSIDE may point
1856 * to a prototype; we instead want the cloned parent who called us.
1857 * Note that in general for formats, CvOUTSIDE != find_runcv */
1859 outside = CvOUTSIDE(proto);
1860 if (outside && CvCLONE(outside) && ! CvCLONED(outside))
1861 outside = find_runcv(NULL);
1862 depth = CvDEPTH(outside);
1863 assert(depth || SvTYPE(proto) == SVt_PVFM);
1866 assert(CvPADLIST(outside));
1869 SAVESPTR(PL_compcv);
1871 cv = PL_compcv = MUTABLE_CV(newSV_type(SvTYPE(proto)));
1872 CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE|CVf_CVGV_RC);
1875 CvFILE(cv) = CvDYNFILE(proto) ? savepv(CvFILE(proto))
1877 CvGV_set(cv,CvGV(proto));
1878 CvSTASH_set(cv, CvSTASH(proto));
1880 CvROOT(cv) = OpREFCNT_inc(CvROOT(proto));
1882 CvSTART(cv) = CvSTART(proto);
1883 CvOUTSIDE(cv) = MUTABLE_CV(SvREFCNT_inc_simple(outside));
1884 CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
1887 sv_setpvn(MUTABLE_SV(cv), SvPVX_const(proto), SvCUR(proto));
1889 CvPADLIST(cv) = pad_new(padnew_CLONE|padnew_SAVE);
1891 av_fill(PL_comppad, fpad);
1892 for (ix = fname; ix > 0; ix--)
1893 av_store(PL_comppad_name, ix, SvREFCNT_inc(pname[ix]));
1895 PL_curpad = AvARRAY(PL_comppad);
1897 outpad = AvARRAY(AvARRAY(CvPADLIST(outside))[depth]);
1899 for (ix = fpad; ix > 0; ix--) {
1900 SV* const namesv = (ix <= fname) ? pname[ix] : NULL;
1902 if (namesv && namesv != &PL_sv_undef) { /* lexical */
1903 if (SvFAKE(namesv)) { /* lexical from outside? */
1904 sv = outpad[PARENT_PAD_INDEX(namesv)];
1906 /* formats may have an inactive parent,
1907 while my $x if $false can leave an active var marked as
1908 stale. And state vars are always available */
1909 if (SvPADSTALE(sv) && !SvPAD_STATE(namesv)) {
1910 Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
1911 "Variable \"%"SVf"\" is not available", namesv);
1915 SvREFCNT_inc_simple_void_NN(sv);
1918 const char sigil = SvPVX_const(namesv)[0];
1920 sv = SvREFCNT_inc(ppad[ix]);
1921 else if (sigil == '@')
1922 sv = MUTABLE_SV(newAV());
1923 else if (sigil == '%')
1924 sv = MUTABLE_SV(newHV());
1928 /* reset the 'assign only once' flag on each state var */
1929 if (SvPAD_STATE(namesv))
1933 else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) {
1934 sv = SvREFCNT_inc_NN(ppad[ix]);
1944 PerlIO_printf(Perl_debug_log, "\nPad CV clone\n");
1945 cv_dump(outside, "Outside");
1946 cv_dump(proto, "Proto");
1953 /* Constant sub () { $x } closing over $x - see lib/constant.pm:
1954 * The prototype was marked as a candiate for const-ization,
1955 * so try to grab the current const value, and if successful,
1956 * turn into a const sub:
1958 SV* const const_sv = op_const_sv(CvSTART(cv), cv);
1961 cv = newCONSTSUB(CvSTASH(proto), NULL, const_sv);
1972 =for apidoc m|void|pad_fixup_inner_anons|PADLIST *padlist|CV *old_cv|CV *new_cv
1974 For any anon CVs in the pad, change CvOUTSIDE of that CV from
1975 old_cv to new_cv if necessary. Needed when a newly-compiled CV has to be
1976 moved to a pre-existing CV struct.
1982 Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
1986 AV * const comppad_name = MUTABLE_AV(AvARRAY(padlist)[0]);
1987 AV * const comppad = MUTABLE_AV(AvARRAY(padlist)[1]);
1988 SV ** const namepad = AvARRAY(comppad_name);
1989 SV ** const curpad = AvARRAY(comppad);
1991 PERL_ARGS_ASSERT_PAD_FIXUP_INNER_ANONS;
1992 PERL_UNUSED_ARG(old_cv);
1994 for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
1995 const SV * const namesv = namepad[ix];
1996 if (namesv && namesv != &PL_sv_undef
1997 && *SvPVX_const(namesv) == '&')
1999 CV * const innercv = MUTABLE_CV(curpad[ix]);
2000 assert(CvWEAKOUTSIDE(innercv));
2001 assert(CvOUTSIDE(innercv) == old_cv);
2002 CvOUTSIDE(innercv) = new_cv;
2008 =for apidoc m|void|pad_push|PADLIST *padlist|int depth
2010 Push a new pad frame onto the padlist, unless there's already a pad at
2011 this depth, in which case don't bother creating a new one. Then give
2012 the new pad an @_ in slot zero.
2018 Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
2022 PERL_ARGS_ASSERT_PAD_PUSH;
2024 if (depth > AvFILLp(padlist)) {
2025 SV** const svp = AvARRAY(padlist);
2026 AV* const newpad = newAV();
2027 SV** const oldpad = AvARRAY(svp[depth-1]);
2028 I32 ix = AvFILLp((const AV *)svp[1]);
2029 const I32 names_fill = AvFILLp((const AV *)svp[0]);
2030 SV** const names = AvARRAY(svp[0]);
2033 for ( ;ix > 0; ix--) {
2034 if (names_fill >= ix && names[ix] != &PL_sv_undef) {
2035 const char sigil = SvPVX_const(names[ix])[0];
2036 if ((SvFLAGS(names[ix]) & SVf_FAKE)
2037 || (SvFLAGS(names[ix]) & SVpad_STATE)
2040 /* outer lexical or anon code */
2041 av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]));
2043 else { /* our own lexical */
2046 sv = MUTABLE_SV(newAV());
2047 else if (sigil == '%')
2048 sv = MUTABLE_SV(newHV());
2051 av_store(newpad, ix, sv);
2055 else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
2056 av_store(newpad, ix, SvREFCNT_inc_NN(oldpad[ix]));
2059 /* save temporaries on recursion? */
2060 SV * const sv = newSV(0);
2061 av_store(newpad, ix, sv);
2066 av_store(newpad, 0, MUTABLE_SV(av));
2069 av_store(padlist, depth, MUTABLE_SV(newpad));
2070 AvFILLp(padlist) = depth;
2075 =for apidoc Am|HV *|pad_compname_type|PADOFFSET po
2077 Looks up the type of the lexical variable at position I<po> in the
2078 currently-compiling pad. If the variable is typed, the stash of the
2079 class to which it is typed is returned. If not, C<NULL> is returned.
2085 Perl_pad_compname_type(pTHX_ const PADOFFSET po)
2088 SV* const * const av = av_fetch(PL_comppad_name, po, FALSE);
2089 if ( SvPAD_TYPED(*av) ) {
2090 return SvSTASH(*av);
2095 #if defined(USE_ITHREADS)
2097 # define av_dup_inc(s,t) MUTABLE_AV(sv_dup_inc((const SV *)s,t))
2100 =for apidoc m|AV *|padlist_dup|AV *srcpad|CLONE_PARAMS *param
2108 Perl_padlist_dup(pTHX_ AV *srcpad, CLONE_PARAMS *param)
2111 PERL_ARGS_ASSERT_PADLIST_DUP;
2116 assert(!AvREAL(srcpad));
2118 if (param->flags & CLONEf_COPY_STACKS
2119 || SvREFCNT(AvARRAY(srcpad)[1]) > 1) {
2120 /* XXX padlists are real, but pretend to be not */
2122 dstpad = av_dup_inc(srcpad, param);
2125 assert (SvREFCNT(AvARRAY(srcpad)[1]) == 1);
2127 /* CvDEPTH() on our subroutine will be set to 0, so there's no need
2128 to build anything other than the first level of pads. */
2130 I32 ix = AvFILLp((const AV *)AvARRAY(srcpad)[1]);
2132 const I32 names_fill = AvFILLp((const AV *)(AvARRAY(srcpad)[0]));
2133 const AV *const srcpad1 = (const AV *) AvARRAY(srcpad)[1];
2134 SV **oldpad = AvARRAY(srcpad1);
2138 /* look for it in the table first.
2139 I *think* that it shouldn't be possible to find it there.
2140 Well, except for how Perl_sv_compile_2op() "works" :-( */
2141 dstpad = (AV*)ptr_table_fetch(PL_ptr_table, srcpad);
2147 ptr_table_store(PL_ptr_table, srcpad, dstpad);
2149 av_extend(dstpad, 1);
2150 AvARRAY(dstpad)[0] = MUTABLE_SV(av_dup_inc(AvARRAY(srcpad)[0], param));
2151 names = AvARRAY(AvARRAY(dstpad)[0]);
2155 av_extend(pad1, ix);
2156 AvARRAY(dstpad)[1] = MUTABLE_SV(pad1);
2157 pad1a = AvARRAY(pad1);
2158 AvFILLp(dstpad) = 1;
2163 for ( ;ix > 0; ix--) {
2166 } else if (names_fill >= ix && names[ix] != &PL_sv_undef) {
2167 const char sigil = SvPVX_const(names[ix])[0];
2168 if ((SvFLAGS(names[ix]) & SVf_FAKE)
2169 || (SvFLAGS(names[ix]) & SVpad_STATE)
2172 /* outer lexical or anon code */
2173 pad1a[ix] = sv_dup_inc(oldpad[ix], param);
2175 else { /* our own lexical */
2176 if(SvPADSTALE(oldpad[ix]) && SvREFCNT(oldpad[ix]) > 1) {
2177 /* This is a work around for how the current
2178 implementation of ?{ } blocks in regexps
2179 interacts with lexicals. */
2180 pad1a[ix] = sv_dup_inc(oldpad[ix], param);
2185 sv = MUTABLE_SV(newAV());
2186 else if (sigil == '%')
2187 sv = MUTABLE_SV(newHV());
2195 else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
2196 pad1a[ix] = sv_dup_inc(oldpad[ix], param);
2199 /* save temporaries on recursion? */
2200 SV * const sv = newSV(0);
2203 /* SvREFCNT(oldpad[ix]) != 1 for some code in threads.xs
2204 FIXTHAT before merging this branch.
2205 (And I know how to) */
2206 if (SvPADMY(oldpad[ix]))
2214 args = newAV(); /* Will be @_ */
2216 pad1a[0] = (SV *)args;
2224 #endif /* USE_ITHREADS */
2228 * c-indentation-style: bsd
2230 * indent-tabs-mode: t
2233 * ex: set ts=8 sts=4 sw=4 noet: