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 I32 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))
345 if (CvFILE(cv) && !CvISXSUB(cv)) {
346 /* for XSUBs CvFILE point directly to static memory; __FILE__ */
347 Safefree(CvFILE(cv));
352 if (!CvISXSUB(cv) && CvROOT(cv)) {
353 if (SvTYPE(cv) == SVt_PVCV && CvDEPTH(cv))
354 Perl_croak(aTHX_ "Can't undef active subroutine");
357 PAD_SAVE_SETNULLPAD();
364 SvPOK_off(MUTABLE_SV(cv)); /* forget prototype */
367 /* This statement and the subsequence if block was pad_undef(). */
368 pad_peg("pad_undef");
370 if (padlist && !SvIS_FREED(padlist) /* may be during global destruction */
374 /* Free the padlist associated with a CV.
375 If parts of it happen to be current, we null the relevant PL_*pad*
376 global vars so that we don't have any dangling references left.
377 We also repoint the CvOUTSIDE of any about-to-be-orphaned inner
378 subs to the outer of this cv. */
380 DEBUG_X(PerlIO_printf(Perl_debug_log,
381 "Pad undef: cv=0x%"UVxf" padlist=0x%"UVxf" comppad=0x%"UVxf"\n",
382 PTR2UV(cv), PTR2UV(padlist), PTR2UV(PL_comppad))
385 /* detach any '&' anon children in the pad; if afterwards they
386 * are still live, fix up their CvOUTSIDEs to point to our outside,
388 /* XXX DAPM for efficiency, we should only do this if we know we have
389 * children, or integrate this loop with general cleanup */
391 if (PL_phase != PERL_PHASE_DESTRUCT) { /* don't bother during global destruction */
392 CV * const outercv = CvOUTSIDE(cv);
393 const U32 seq = CvOUTSIDE_SEQ(cv);
394 AV * const comppad_name = MUTABLE_AV(AvARRAY(padlist)[0]);
395 SV ** const namepad = AvARRAY(comppad_name);
396 AV * const comppad = MUTABLE_AV(AvARRAY(padlist)[1]);
397 SV ** const curpad = AvARRAY(comppad);
398 for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
399 SV * const namesv = namepad[ix];
400 if (namesv && namesv != &PL_sv_undef
401 && *SvPVX_const(namesv) == '&')
403 CV * const innercv = MUTABLE_CV(curpad[ix]);
404 U32 inner_rc = SvREFCNT(innercv);
407 SvREFCNT_dec(namesv);
409 if (SvREFCNT(comppad) < 2) { /* allow for /(?{ sub{} })/ */
411 SvREFCNT_dec(innercv);
415 /* in use, not just a prototype */
416 if (inner_rc && (CvOUTSIDE(innercv) == cv)) {
417 assert(CvWEAKOUTSIDE(innercv));
418 /* don't relink to grandfather if he's being freed */
419 if (outercv && SvREFCNT(outercv)) {
420 CvWEAKOUTSIDE_off(innercv);
421 CvOUTSIDE(innercv) = outercv;
422 CvOUTSIDE_SEQ(innercv) = seq;
423 SvREFCNT_inc_simple_void_NN(outercv);
426 CvOUTSIDE(innercv) = NULL;
433 ix = AvFILLp(padlist);
435 SV* const sv = AvARRAY(padlist)[ix--];
437 if (sv == (const SV *)PL_comppad) {
445 SV *const sv = AvARRAY(padlist)[0];
446 if (sv == (const SV *)PL_comppad_name)
447 PL_comppad_name = NULL;
450 SvREFCNT_dec(MUTABLE_SV(CvPADLIST(cv)));
451 CvPADLIST(cv) = NULL;
455 /* remove CvOUTSIDE unless this is an undef rather than a free */
456 if (!SvREFCNT(cv) && CvOUTSIDE(cv)) {
457 if (!CvWEAKOUTSIDE(cv))
458 SvREFCNT_dec(CvOUTSIDE(cv));
459 CvOUTSIDE(cv) = NULL;
462 SvREFCNT_dec(MUTABLE_SV(CvXSUBANY(cv).any_ptr));
465 if (CvISXSUB(cv) && CvXSUB(cv)) {
468 /* delete all flags except WEAKOUTSIDE and CVGV_RC, which indicate the
469 * ref status of CvOUTSIDE and CvGV */
470 CvFLAGS(cv) &= (CVf_WEAKOUTSIDE|CVf_CVGV_RC);
474 =for apidoc m|PADOFFSET|pad_alloc_name|SV *namesv|U32 flags|HV *typestash|HV *ourstash
476 Allocates a place in the currently-compiling
477 pad (via L<perlapi/pad_alloc>) and
478 then stores a name for that entry. I<namesv> is adopted and becomes the
479 name entry; it must already contain the name string and be sufficiently
480 upgraded. I<typestash> and I<ourstash> and the C<padadd_STATE> flag get
481 added to I<namesv>. None of the other
482 processing of L<perlapi/pad_add_name_pvn>
483 is done. Returns the offset of the allocated pad slot.
489 S_pad_alloc_name(pTHX_ SV *namesv, U32 flags, HV *typestash, HV *ourstash)
492 const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
494 PERL_ARGS_ASSERT_PAD_ALLOC_NAME;
496 ASSERT_CURPAD_ACTIVE("pad_alloc_name");
499 assert(SvTYPE(namesv) == SVt_PVMG);
500 SvPAD_TYPED_on(namesv);
501 SvSTASH_set(namesv, MUTABLE_HV(SvREFCNT_inc_simple_NN(MUTABLE_SV(typestash))));
504 SvPAD_OUR_on(namesv);
505 SvOURSTASH_set(namesv, ourstash);
506 SvREFCNT_inc_simple_void_NN(ourstash);
508 else if (flags & padadd_STATE) {
509 SvPAD_STATE_on(namesv);
512 av_store(PL_comppad_name, offset, namesv);
517 =for apidoc Am|PADOFFSET|pad_add_name_pvn|const char *namepv|STRLEN namelen|U32 flags|HV *typestash|HV *ourstash
519 Allocates a place in the currently-compiling pad for a named lexical
520 variable. Stores the name and other metadata in the name part of the
521 pad, and makes preparations to manage the variable's lexical scoping.
522 Returns the offset of the allocated pad slot.
524 I<namepv>/I<namelen> specify the variable's name, including leading sigil.
525 If I<typestash> is non-null, the name is for a typed lexical, and this
526 identifies the type. If I<ourstash> is non-null, it's a lexical reference
527 to a package variable, and this identifies the package. The following
528 flags can be OR'ed together:
530 padadd_OUR redundantly specifies if it's a package var
531 padadd_STATE variable will retain value persistently
532 padadd_NO_DUP_CHECK skip check for lexical shadowing
538 Perl_pad_add_name_pvn(pTHX_ const char *namepv, STRLEN namelen,
539 U32 flags, HV *typestash, HV *ourstash)
546 PERL_ARGS_ASSERT_PAD_ADD_NAME_PVN;
548 if (flags & ~(padadd_OUR|padadd_STATE|padadd_NO_DUP_CHECK|padadd_UTF8_NAME))
549 Perl_croak(aTHX_ "panic: pad_add_name_pvn illegal flag bits 0x%" UVxf,
552 namesv = newSV_type((ourstash || typestash) ? SVt_PVMG : SVt_PVNV);
554 if ((is_utf8 = ((flags & padadd_UTF8_NAME) != 0))) {
555 namepv = (const char*)bytes_from_utf8((U8*)namepv, &namelen, &is_utf8);
558 sv_setpvn(namesv, namepv, namelen);
561 flags |= padadd_UTF8_NAME;
565 flags &= ~padadd_UTF8_NAME;
567 if ((flags & padadd_NO_DUP_CHECK) == 0) {
568 /* check for duplicate declaration */
569 pad_check_dup(namesv, flags & padadd_OUR, ourstash);
572 offset = pad_alloc_name(namesv, flags & ~padadd_UTF8_NAME, typestash, ourstash);
574 /* not yet introduced */
575 COP_SEQ_RANGE_LOW_set(namesv, PERL_PADSEQ_INTRO);
576 COP_SEQ_RANGE_HIGH_set(namesv, 0);
578 if (!PL_min_intro_pending)
579 PL_min_intro_pending = offset;
580 PL_max_intro_pending = offset;
581 /* if it's not a simple scalar, replace with an AV or HV */
582 assert(SvTYPE(PL_curpad[offset]) == SVt_NULL);
583 assert(SvREFCNT(PL_curpad[offset]) == 1);
584 if (namelen != 0 && *namepv == '@')
585 sv_upgrade(PL_curpad[offset], SVt_PVAV);
586 else if (namelen != 0 && *namepv == '%')
587 sv_upgrade(PL_curpad[offset], SVt_PVHV);
588 assert(SvPADMY(PL_curpad[offset]));
589 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
590 "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
591 (long)offset, SvPVX(namesv),
592 PTR2UV(PL_curpad[offset])));
598 =for apidoc Am|PADOFFSET|pad_add_name_pv|const char *name|U32 flags|HV *typestash|HV *ourstash
600 Exactly like L</pad_add_name_pvn>, but takes a nul-terminated string
601 instead of a string/length pair.
607 Perl_pad_add_name_pv(pTHX_ const char *name,
608 U32 flags, HV *typestash, HV *ourstash)
610 PERL_ARGS_ASSERT_PAD_ADD_NAME_PV;
611 return pad_add_name_pvn(name, strlen(name), flags, typestash, ourstash);
615 =for apidoc Am|PADOFFSET|pad_add_name_sv|SV *name|U32 flags|HV *typestash|HV *ourstash
617 Exactly like L</pad_add_name_pvn>, but takes the name string in the form
618 of an SV instead of a string/length pair.
624 Perl_pad_add_name_sv(pTHX_ SV *name, U32 flags, HV *typestash, HV *ourstash)
628 PERL_ARGS_ASSERT_PAD_ADD_NAME_SV;
629 namepv = SvPV(name, namelen);
631 flags |= padadd_UTF8_NAME;
632 return pad_add_name_pvn(namepv, namelen, flags, typestash, ourstash);
636 =for apidoc Amx|PADOFFSET|pad_alloc|I32 optype|U32 tmptype
638 Allocates a place in the currently-compiling pad,
639 returning the offset of the allocated pad slot.
640 No name is initially attached to the pad slot.
641 I<tmptype> is a set of flags indicating the kind of pad entry required,
642 which will be set in the value SV for the allocated pad entry:
644 SVs_PADMY named lexical variable ("my", "our", "state")
645 SVs_PADTMP unnamed temporary store
647 I<optype> should be an opcode indicating the type of operation that the
648 pad entry is to support. This doesn't affect operational semantics,
649 but is used for debugging.
654 /* XXX DAPM integrate alloc(), add_name() and add_anon(),
655 * or at least rationalise ??? */
656 /* And flag whether the incoming name is UTF8 or 8 bit?
657 Could do this either with the +ve/-ve hack of the HV code, or expanding
658 the flag bits. Either way, this makes proper Unicode safe pad support.
663 Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
669 PERL_UNUSED_ARG(optype);
670 ASSERT_CURPAD_ACTIVE("pad_alloc");
672 if (AvARRAY(PL_comppad) != PL_curpad)
673 Perl_croak(aTHX_ "panic: pad_alloc");
674 if (PL_pad_reset_pending)
676 if (tmptype & SVs_PADMY) {
677 /* For a my, simply push a null SV onto the end of PL_comppad. */
678 sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE);
679 retval = AvFILLp(PL_comppad);
682 /* For a tmp, scan the pad from PL_padix upwards
683 * for a slot which has no name and no active value.
685 SV * const * const names = AvARRAY(PL_comppad_name);
686 const SSize_t names_fill = AvFILLp(PL_comppad_name);
689 * "foreach" index vars temporarily become aliases to non-"my"
690 * values. Thus we must skip, not just pad values that are
691 * marked as current pad values, but also those with names.
693 /* HVDS why copy to sv here? we don't seem to use it */
694 if (++PL_padix <= names_fill &&
695 (sv = names[PL_padix]) && sv != &PL_sv_undef)
697 sv = *av_fetch(PL_comppad, PL_padix, TRUE);
698 if (!(SvFLAGS(sv) & (SVs_PADTMP | SVs_PADMY)) &&
699 !IS_PADGV(sv) && !IS_PADCONST(sv))
704 SvFLAGS(sv) |= tmptype;
705 PL_curpad = AvARRAY(PL_comppad);
707 DEBUG_X(PerlIO_printf(Perl_debug_log,
708 "Pad 0x%"UVxf"[0x%"UVxf"] alloc: %ld for %s\n",
709 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long) retval,
710 PL_op_name[optype]));
711 #ifdef DEBUG_LEAKING_SCALARS
712 sv->sv_debug_optype = optype;
713 sv->sv_debug_inpad = 1;
715 return (PADOFFSET)retval;
719 =for apidoc Am|PADOFFSET|pad_add_anon|CV *func|I32 optype
721 Allocates a place in the currently-compiling pad (via L</pad_alloc>)
722 for an anonymous function that is lexically scoped inside the
723 currently-compiling function.
724 The function I<func> is linked into the pad, and its C<CvOUTSIDE> link
725 to the outer scope is weakened to avoid a reference loop.
727 I<optype> should be an opcode indicating the type of operation that the
728 pad entry is to support. This doesn't affect operational semantics,
729 but is used for debugging.
735 Perl_pad_add_anon(pTHX_ CV* func, I32 optype)
739 SV* const name = newSV_type(SVt_PVNV);
741 PERL_ARGS_ASSERT_PAD_ADD_ANON;
744 sv_setpvs(name, "&");
745 /* These two aren't used; just make sure they're not equal to
746 * PERL_PADSEQ_INTRO */
747 COP_SEQ_RANGE_LOW_set(name, 0);
748 COP_SEQ_RANGE_HIGH_set(name, 0);
749 ix = pad_alloc(optype, SVs_PADMY);
750 av_store(PL_comppad_name, ix, name);
751 /* XXX DAPM use PL_curpad[] ? */
752 av_store(PL_comppad, ix, (SV*)func);
753 SvPADMY_on((SV*)func);
755 /* to avoid ref loops, we never have parent + child referencing each
756 * other simultaneously */
757 if (CvOUTSIDE(func)) {
758 assert(!CvWEAKOUTSIDE(func));
759 CvWEAKOUTSIDE_on(func);
760 SvREFCNT_dec(CvOUTSIDE(func));
766 =for apidoc m|pad_check_dup|SV *name|U32 flags|const HV *ourstash
768 Check for duplicate declarations: report any of:
769 * a my in the current scope with the same name;
770 * an our (anywhere in the pad) with the same name and the same stash
772 C<is_our> indicates that the name to check is an 'our' declaration
778 S_pad_check_dup(pTHX_ SV *name, U32 flags, const HV *ourstash)
783 const U32 is_our = flags & padadd_OUR;
785 PERL_ARGS_ASSERT_PAD_CHECK_DUP;
787 ASSERT_CURPAD_ACTIVE("pad_check_dup");
789 assert((flags & ~padadd_OUR) == 0);
791 if (AvFILLp(PL_comppad_name) < 0 || !ckWARN(WARN_MISC))
792 return; /* nothing to check */
794 svp = AvARRAY(PL_comppad_name);
795 top = AvFILLp(PL_comppad_name);
796 /* check the current scope */
797 /* XXX DAPM - why the (I32) cast - shouldn't we ensure they're the same
799 for (off = top; (I32)off > PL_comppad_name_floor; off--) {
800 SV * const sv = svp[off];
802 && sv != &PL_sv_undef
804 && ( COP_SEQ_RANGE_LOW(sv) == PERL_PADSEQ_INTRO
805 || COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
808 if (is_our && (SvPAD_OUR(sv)))
809 break; /* "our" masking "our" */
810 Perl_warner(aTHX_ packWARN(WARN_MISC),
811 "\"%s\" variable %"SVf" masks earlier declaration in same %s",
812 (is_our ? "our" : PL_parser->in_my == KEY_my ? "my" : "state"),
814 (COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO
815 ? "scope" : "statement"));
820 /* check the rest of the pad */
823 SV * const sv = svp[off];
825 && sv != &PL_sv_undef
827 && ( COP_SEQ_RANGE_LOW(sv) == PERL_PADSEQ_INTRO
828 || COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
829 && SvOURSTASH(sv) == ourstash
832 Perl_warner(aTHX_ packWARN(WARN_MISC),
833 "\"our\" variable %"SVf" redeclared", sv);
834 if ((I32)off <= PL_comppad_name_floor)
835 Perl_warner(aTHX_ packWARN(WARN_MISC),
836 "\t(Did you mean \"local\" instead of \"our\"?)\n");
846 =for apidoc Am|PADOFFSET|pad_findmy_pvn|const char *namepv|STRLEN namelen|U32 flags
848 Given the name of a lexical variable, find its position in the
849 currently-compiling pad.
850 I<namepv>/I<namelen> specify the variable's name, including leading sigil.
851 I<flags> is reserved and must be zero.
852 If it is not in the current pad but appears in the pad of any lexically
853 enclosing scope, then a pseudo-entry for it is added in the current pad.
854 Returns the offset in the current pad,
855 or C<NOT_IN_PAD> if no such lexical is in scope.
861 Perl_pad_findmy_pvn(pTHX_ const char *namepv, STRLEN namelen, U32 flags)
870 PERL_ARGS_ASSERT_PAD_FINDMY_PVN;
872 pad_peg("pad_findmy_pvn");
874 if (flags & ~padadd_UTF8_NAME)
875 Perl_croak(aTHX_ "panic: pad_findmy_pvn illegal flag bits 0x%" UVxf,
878 if (flags & padadd_UTF8_NAME) {
880 namepv = (const char*)bytes_from_utf8((U8*)namepv, &namelen, &is_utf8);
883 flags |= padadd_UTF8_NAME;
885 flags &= ~padadd_UTF8_NAME;
888 offset = pad_findlex(namepv, namelen, flags,
889 PL_compcv, PL_cop_seqmax, 1, NULL, &out_sv, &out_flags);
890 if ((PADOFFSET)offset != NOT_IN_PAD)
893 /* look for an our that's being introduced; this allows
894 * our $foo = 0 unless defined $foo;
895 * to not give a warning. (Yes, this is a hack) */
897 nameav = MUTABLE_AV(AvARRAY(CvPADLIST(PL_compcv))[0]);
898 name_svp = AvARRAY(nameav);
899 for (offset = AvFILLp(nameav); offset > 0; offset--) {
900 const SV * const namesv = name_svp[offset];
901 if (namesv && namesv != &PL_sv_undef
903 && (SvPAD_OUR(namesv))
904 && SvCUR(namesv) == namelen
905 && sv_eq_pvn_flags(aTHX_ namesv, namepv, namelen,
906 flags & padadd_UTF8_NAME ? SVf_UTF8 : 0 )
907 && COP_SEQ_RANGE_LOW(namesv) == PERL_PADSEQ_INTRO
915 =for apidoc Am|PADOFFSET|pad_findmy_pv|const char *name|U32 flags
917 Exactly like L</pad_findmy_pvn>, but takes a nul-terminated string
918 instead of a string/length pair.
924 Perl_pad_findmy_pv(pTHX_ const char *name, U32 flags)
926 PERL_ARGS_ASSERT_PAD_FINDMY_PV;
927 return pad_findmy_pvn(name, strlen(name), flags);
931 =for apidoc Am|PADOFFSET|pad_findmy_sv|SV *name|U32 flags
933 Exactly like L</pad_findmy_pvn>, but takes the name string in the form
934 of an SV instead of a string/length pair.
940 Perl_pad_findmy_sv(pTHX_ SV *name, U32 flags)
944 PERL_ARGS_ASSERT_PAD_FINDMY_SV;
945 namepv = SvPV(name, namelen);
947 flags |= padadd_UTF8_NAME;
948 return pad_findmy_pvn(namepv, namelen, flags);
952 =for apidoc Amp|PADOFFSET|find_rundefsvoffset
954 Find the position of the lexical C<$_> in the pad of the
955 currently-executing function. Returns the offset in the current pad,
956 or C<NOT_IN_PAD> if there is no lexical C<$_> in scope (in which case
957 the global one should be used instead).
958 L</find_rundefsv> is likely to be more convenient.
964 Perl_find_rundefsvoffset(pTHX)
969 return pad_findlex("$_", 2, 0, find_runcv(NULL), PL_curcop->cop_seq, 1,
970 NULL, &out_sv, &out_flags);
974 =for apidoc Am|SV *|find_rundefsv
976 Find and return the variable that is named C<$_> in the lexical scope
977 of the currently-executing function. This may be a lexical C<$_>,
978 or will otherwise be the global one.
984 Perl_find_rundefsv(pTHX)
990 po = pad_findlex("$_", 2, 0, find_runcv(NULL), PL_curcop->cop_seq, 1,
991 NULL, &namesv, &flags);
993 if (po == NOT_IN_PAD || SvPAD_OUR(namesv))
1000 =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
1002 Find a named lexical anywhere in a chain of nested pads. Add fake entries
1003 in the inner pads if it's found in an outer one.
1005 Returns the offset in the bottom pad of the lex or the fake lex.
1006 cv is the CV in which to start the search, and seq is the current cop_seq
1007 to match against. If warn is true, print appropriate warnings. The out_*
1008 vars return values, and so are pointers to where the returned values
1009 should be stored. out_capture, if non-null, requests that the innermost
1010 instance of the lexical is captured; out_name_sv is set to the innermost
1011 matched namesv or fake namesv; out_flags returns the flags normally
1012 associated with the IVX field of a fake namesv.
1014 Note that pad_findlex() is recursive; it recurses up the chain of CVs,
1015 then comes back down, adding fake entries as it goes. It has to be this way
1016 because fake namesvs in anon protoypes have to store in xlow the index into
1022 /* the CV has finished being compiled. This is not a sufficient test for
1023 * all CVs (eg XSUBs), but suffices for the CVs found in a lexical chain */
1024 #define CvCOMPILED(cv) CvROOT(cv)
1026 /* the CV does late binding of its lexicals */
1027 #define CvLATE(cv) (CvANON(cv) || SvTYPE(cv) == SVt_PVFM)
1031 S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv, U32 seq,
1032 int warn, SV** out_capture, SV** out_name_sv, int *out_flags)
1035 I32 offset, new_offset;
1038 const AV * const padlist = CvPADLIST(cv);
1040 PERL_ARGS_ASSERT_PAD_FINDLEX;
1042 if (flags & ~padadd_UTF8_NAME)
1043 Perl_croak(aTHX_ "panic: pad_findlex illegal flag bits 0x%" UVxf,
1048 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1049 "Pad findlex cv=0x%"UVxf" searching \"%.*s\" seq=%d%s\n",
1050 PTR2UV(cv), namelen, namepv, (int)seq,
1051 out_capture ? " capturing" : "" ));
1053 /* first, search this pad */
1055 if (padlist) { /* not an undef CV */
1056 I32 fake_offset = 0;
1057 const AV * const nameav = MUTABLE_AV(AvARRAY(padlist)[0]);
1058 SV * const * const name_svp = AvARRAY(nameav);
1060 for (offset = AvFILLp(nameav); offset > 0; offset--) {
1061 const SV * const namesv = name_svp[offset];
1062 if (namesv && namesv != &PL_sv_undef
1063 && SvCUR(namesv) == namelen
1064 && sv_eq_pvn_flags(aTHX_ namesv, namepv, namelen,
1065 flags & padadd_UTF8_NAME ? SVf_UTF8 : 0))
1067 if (SvFAKE(namesv)) {
1068 fake_offset = offset; /* in case we don't find a real one */
1071 /* is seq within the range _LOW to _HIGH ?
1072 * This is complicated by the fact that PL_cop_seqmax
1073 * may have wrapped around at some point */
1074 if (COP_SEQ_RANGE_LOW(namesv) == PERL_PADSEQ_INTRO)
1075 continue; /* not yet introduced */
1077 if (COP_SEQ_RANGE_HIGH(namesv) == PERL_PADSEQ_INTRO) {
1078 /* in compiling scope */
1080 (seq > COP_SEQ_RANGE_LOW(namesv))
1081 ? (seq - COP_SEQ_RANGE_LOW(namesv) < (U32_MAX >> 1))
1082 : (COP_SEQ_RANGE_LOW(namesv) - seq > (U32_MAX >> 1))
1087 (COP_SEQ_RANGE_LOW(namesv) > COP_SEQ_RANGE_HIGH(namesv))
1089 ( seq > COP_SEQ_RANGE_LOW(namesv)
1090 || seq <= COP_SEQ_RANGE_HIGH(namesv))
1092 : ( seq > COP_SEQ_RANGE_LOW(namesv)
1093 && seq <= COP_SEQ_RANGE_HIGH(namesv))
1099 if (offset > 0 || fake_offset > 0 ) { /* a match! */
1100 if (offset > 0) { /* not fake */
1102 *out_name_sv = name_svp[offset]; /* return the namesv */
1104 /* set PAD_FAKELEX_MULTI if this lex can have multiple
1105 * instances. For now, we just test !CvUNIQUE(cv), but
1106 * ideally, we should detect my's declared within loops
1107 * etc - this would allow a wider range of 'not stayed
1108 * shared' warnings. We also treated already-compiled
1109 * lexes as not multi as viewed from evals. */
1111 *out_flags = CvANON(cv) ?
1113 (!CvUNIQUE(cv) && ! CvCOMPILED(cv))
1114 ? PAD_FAKELEX_MULTI : 0;
1116 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1117 "Pad findlex cv=0x%"UVxf" matched: offset=%ld (%lu,%lu)\n",
1118 PTR2UV(cv), (long)offset,
1119 (unsigned long)COP_SEQ_RANGE_LOW(*out_name_sv),
1120 (unsigned long)COP_SEQ_RANGE_HIGH(*out_name_sv)));
1122 else { /* fake match */
1123 offset = fake_offset;
1124 *out_name_sv = name_svp[offset]; /* return the namesv */
1125 *out_flags = PARENT_FAKELEX_FLAGS(*out_name_sv);
1126 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1127 "Pad findlex cv=0x%"UVxf" matched: offset=%ld flags=0x%lx index=%lu\n",
1128 PTR2UV(cv), (long)offset, (unsigned long)*out_flags,
1129 (unsigned long) PARENT_PAD_INDEX(*out_name_sv)
1133 /* return the lex? */
1138 if (SvPAD_OUR(*out_name_sv)) {
1139 *out_capture = NULL;
1143 /* trying to capture from an anon prototype? */
1145 ? CvANON(cv) && CvCLONE(cv) && !CvCLONED(cv)
1146 : *out_flags & PAD_FAKELEX_ANON)
1149 Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
1150 "Variable \"%"SVf"\" is not available",
1151 newSVpvn_flags(namepv, namelen,
1153 (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
1155 *out_capture = NULL;
1161 if (!CvCOMPILED(cv) && (*out_flags & PAD_FAKELEX_MULTI)
1162 && !SvPAD_STATE(name_svp[offset])
1163 && warn && ckWARN(WARN_CLOSURE)) {
1165 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
1166 "Variable \"%"SVf"\" will not stay shared",
1167 newSVpvn_flags(namepv, namelen,
1169 (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
1172 if (fake_offset && CvANON(cv)
1173 && CvCLONE(cv) &&!CvCLONED(cv))
1176 /* not yet caught - look further up */
1177 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1178 "Pad findlex cv=0x%"UVxf" chasing lex in outer pad\n",
1181 (void) pad_findlex(namepv, namelen, flags, CvOUTSIDE(cv),
1183 newwarn, out_capture, out_name_sv, out_flags);
1188 *out_capture = AvARRAY(MUTABLE_AV(AvARRAY(padlist)[
1189 CvDEPTH(cv) ? CvDEPTH(cv) : 1]))[offset];
1190 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1191 "Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n",
1192 PTR2UV(cv), PTR2UV(*out_capture)));
1194 if (SvPADSTALE(*out_capture)
1195 && !SvPAD_STATE(name_svp[offset]))
1197 Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
1198 "Variable \"%"SVf"\" is not available",
1199 newSVpvn_flags(namepv, namelen,
1201 (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
1202 *out_capture = NULL;
1205 if (!*out_capture) {
1206 if (namelen != 0 && *namepv == '@')
1207 *out_capture = sv_2mortal(MUTABLE_SV(newAV()));
1208 else if (namelen != 0 && *namepv == '%')
1209 *out_capture = sv_2mortal(MUTABLE_SV(newHV()));
1211 *out_capture = sv_newmortal();
1219 /* it's not in this pad - try above */
1224 /* out_capture non-null means caller wants us to capture lex; in
1225 * addition we capture ourselves unless it's an ANON/format */
1226 new_capturep = out_capture ? out_capture :
1227 CvLATE(cv) ? NULL : &new_capture;
1229 offset = pad_findlex(namepv, namelen, flags, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1,
1230 new_capturep, out_name_sv, out_flags);
1231 if ((PADOFFSET)offset == NOT_IN_PAD)
1234 /* found in an outer CV. Add appropriate fake entry to this pad */
1236 /* don't add new fake entries (via eval) to CVs that we have already
1237 * finished compiling, or to undef CVs */
1238 if (CvCOMPILED(cv) || !padlist)
1239 return 0; /* this dummy (and invalid) value isnt used by the caller */
1242 /* This relies on sv_setsv_flags() upgrading the destination to the same
1243 type as the source, independent of the flags set, and on it being
1244 "good" and only copying flag bits and pointers that it understands.
1246 SV *new_namesv = newSVsv(*out_name_sv);
1247 AV * const ocomppad_name = PL_comppad_name;
1248 PAD * const ocomppad = PL_comppad;
1249 PL_comppad_name = MUTABLE_AV(AvARRAY(padlist)[0]);
1250 PL_comppad = MUTABLE_AV(AvARRAY(padlist)[1]);
1251 PL_curpad = AvARRAY(PL_comppad);
1254 = pad_alloc_name(new_namesv,
1255 (SvPAD_STATE(*out_name_sv) ? padadd_STATE : 0),
1256 SvPAD_TYPED(*out_name_sv)
1257 ? SvSTASH(*out_name_sv) : NULL,
1258 SvOURSTASH(*out_name_sv)
1261 SvFAKE_on(new_namesv);
1262 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1263 "Pad addname: %ld \"%.*s\" FAKE\n",
1265 (int) SvCUR(new_namesv), SvPVX(new_namesv)));
1266 PARENT_FAKELEX_FLAGS_set(new_namesv, *out_flags);
1268 PARENT_PAD_INDEX_set(new_namesv, 0);
1269 if (SvPAD_OUR(new_namesv)) {
1270 NOOP; /* do nothing */
1272 else if (CvLATE(cv)) {
1273 /* delayed creation - just note the offset within parent pad */
1274 PARENT_PAD_INDEX_set(new_namesv, offset);
1278 /* immediate creation - capture outer value right now */
1279 av_store(PL_comppad, new_offset, SvREFCNT_inc(*new_capturep));
1280 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1281 "Pad findlex cv=0x%"UVxf" saved captured sv 0x%"UVxf" at offset %ld\n",
1282 PTR2UV(cv), PTR2UV(*new_capturep), (long)new_offset));
1284 *out_name_sv = new_namesv;
1285 *out_flags = PARENT_FAKELEX_FLAGS(new_namesv);
1287 PL_comppad_name = ocomppad_name;
1288 PL_comppad = ocomppad;
1289 PL_curpad = ocomppad ? AvARRAY(ocomppad) : NULL;
1297 =for apidoc Am|SV *|pad_sv|PADOFFSET po
1299 Get the value at offset I<po> in the current (compiling or executing) pad.
1300 Use macro PAD_SV instead of calling this function directly.
1306 Perl_pad_sv(pTHX_ PADOFFSET po)
1309 ASSERT_CURPAD_ACTIVE("pad_sv");
1312 Perl_croak(aTHX_ "panic: pad_sv po");
1313 DEBUG_X(PerlIO_printf(Perl_debug_log,
1314 "Pad 0x%"UVxf"[0x%"UVxf"] sv: %ld sv=0x%"UVxf"\n",
1315 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(PL_curpad[po]))
1317 return PL_curpad[po];
1321 =for apidoc Am|void|pad_setsv|PADOFFSET po|SV *sv
1323 Set the value at offset I<po> in the current (compiling or executing) pad.
1324 Use the macro PAD_SETSV() rather than calling this function directly.
1330 Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
1334 PERL_ARGS_ASSERT_PAD_SETSV;
1336 ASSERT_CURPAD_ACTIVE("pad_setsv");
1338 DEBUG_X(PerlIO_printf(Perl_debug_log,
1339 "Pad 0x%"UVxf"[0x%"UVxf"] setsv: %ld sv=0x%"UVxf"\n",
1340 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(sv))
1345 #endif /* DEBUGGING */
1348 =for apidoc m|void|pad_block_start|int full
1350 Update the pad compilation state variables on entry to a new block
1355 /* XXX DAPM perhaps:
1356 * - integrate this in general state-saving routine ???
1357 * - combine with the state-saving going on in pad_new ???
1358 * - introduce a new SAVE type that does all this in one go ?
1362 Perl_pad_block_start(pTHX_ int full)
1365 ASSERT_CURPAD_ACTIVE("pad_block_start");
1366 SAVEI32(PL_comppad_name_floor);
1367 PL_comppad_name_floor = AvFILLp(PL_comppad_name);
1369 PL_comppad_name_fill = PL_comppad_name_floor;
1370 if (PL_comppad_name_floor < 0)
1371 PL_comppad_name_floor = 0;
1372 SAVEI32(PL_min_intro_pending);
1373 SAVEI32(PL_max_intro_pending);
1374 PL_min_intro_pending = 0;
1375 SAVEI32(PL_comppad_name_fill);
1376 SAVEI32(PL_padix_floor);
1377 PL_padix_floor = PL_padix;
1378 PL_pad_reset_pending = FALSE;
1382 =for apidoc m|U32|intro_my
1384 "Introduce" my variables to visible status.
1397 ASSERT_CURPAD_ACTIVE("intro_my");
1398 if (! PL_min_intro_pending)
1399 return PL_cop_seqmax;
1401 svp = AvARRAY(PL_comppad_name);
1402 for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
1403 SV * const sv = svp[i];
1405 if (sv && sv != &PL_sv_undef && !SvFAKE(sv)
1406 && COP_SEQ_RANGE_LOW(sv) == PERL_PADSEQ_INTRO)
1408 COP_SEQ_RANGE_HIGH_set(sv, PERL_PADSEQ_INTRO); /* Don't know scope end yet. */
1409 COP_SEQ_RANGE_LOW_set(sv, PL_cop_seqmax);
1410 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1411 "Pad intromy: %ld \"%s\", (%lu,%lu)\n",
1412 (long)i, SvPVX_const(sv),
1413 (unsigned long)COP_SEQ_RANGE_LOW(sv),
1414 (unsigned long)COP_SEQ_RANGE_HIGH(sv))
1418 seq = PL_cop_seqmax;
1420 if (PL_cop_seqmax == PERL_PADSEQ_INTRO) /* not a legal value */
1422 PL_min_intro_pending = 0;
1423 PL_comppad_name_fill = PL_max_intro_pending; /* Needn't search higher */
1424 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1425 "Pad intromy: seq -> %ld\n", (long)(PL_cop_seqmax)));
1431 =for apidoc m|void|pad_leavemy
1433 Cleanup at end of scope during compilation: set the max seq number for
1434 lexicals in this scope and warn of any lexicals that never got introduced.
1440 Perl_pad_leavemy(pTHX)
1444 SV * const * const svp = AvARRAY(PL_comppad_name);
1446 PL_pad_reset_pending = FALSE;
1448 ASSERT_CURPAD_ACTIVE("pad_leavemy");
1449 if (PL_min_intro_pending && PL_comppad_name_fill < PL_min_intro_pending) {
1450 for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
1451 const SV * const sv = svp[off];
1452 if (sv && sv != &PL_sv_undef && !SvFAKE(sv))
1453 Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
1454 "%"SVf" never introduced",
1458 /* "Deintroduce" my variables that are leaving with this scope. */
1459 for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_fill; off--) {
1460 const SV * const sv = svp[off];
1461 if (sv && sv != &PL_sv_undef && !SvFAKE(sv)
1462 && COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
1464 COP_SEQ_RANGE_HIGH_set(sv, PL_cop_seqmax);
1465 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1466 "Pad leavemy: %ld \"%s\", (%lu,%lu)\n",
1467 (long)off, SvPVX_const(sv),
1468 (unsigned long)COP_SEQ_RANGE_LOW(sv),
1469 (unsigned long)COP_SEQ_RANGE_HIGH(sv))
1474 if (PL_cop_seqmax == PERL_PADSEQ_INTRO) /* not a legal value */
1476 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1477 "Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax));
1481 =for apidoc m|void|pad_swipe|PADOFFSET po|bool refadjust
1483 Abandon the tmp in the current pad at offset po and replace with a
1490 Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
1493 ASSERT_CURPAD_LEGAL("pad_swipe");
1496 if (AvARRAY(PL_comppad) != PL_curpad)
1497 Perl_croak(aTHX_ "panic: pad_swipe curpad");
1499 Perl_croak(aTHX_ "panic: pad_swipe po");
1501 DEBUG_X(PerlIO_printf(Perl_debug_log,
1502 "Pad 0x%"UVxf"[0x%"UVxf"] swipe: %ld\n",
1503 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po));
1506 SvPADTMP_off(PL_curpad[po]);
1508 SvREFCNT_dec(PL_curpad[po]);
1511 /* if pad tmps aren't shared between ops, then there's no need to
1512 * create a new tmp when an existing op is freed */
1513 #ifdef USE_BROKEN_PAD_RESET
1514 PL_curpad[po] = newSV(0);
1515 SvPADTMP_on(PL_curpad[po]);
1517 PL_curpad[po] = &PL_sv_undef;
1519 if ((I32)po < PL_padix)
1524 =for apidoc m|void|pad_reset
1526 Mark all the current temporaries for reuse
1531 /* XXX pad_reset() is currently disabled because it results in serious bugs.
1532 * It causes pad temp TARGs to be shared between OPs. Since TARGs are pushed
1533 * on the stack by OPs that use them, there are several ways to get an alias
1534 * to a shared TARG. Such an alias will change randomly and unpredictably.
1535 * We avoid doing this until we can think of a Better Way.
1541 #ifdef USE_BROKEN_PAD_RESET
1542 if (AvARRAY(PL_comppad) != PL_curpad)
1543 Perl_croak(aTHX_ "panic: pad_reset curpad");
1545 DEBUG_X(PerlIO_printf(Perl_debug_log,
1546 "Pad 0x%"UVxf"[0x%"UVxf"] reset: padix %ld -> %ld",
1547 PTR2UV(PL_comppad), PTR2UV(PL_curpad),
1548 (long)PL_padix, (long)PL_padix_floor
1552 if (!PL_tainting) { /* Can't mix tainted and non-tainted temporaries. */
1554 for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
1555 if (PL_curpad[po] && !SvIMMORTAL(PL_curpad[po]))
1556 SvPADTMP_off(PL_curpad[po]);
1558 PL_padix = PL_padix_floor;
1561 PL_pad_reset_pending = FALSE;
1565 =for apidoc Amx|void|pad_tidy|padtidy_type type
1567 Tidy up a pad at the end of compilation of the code to which it belongs.
1568 Jobs performed here are: remove most stuff from the pads of anonsub
1569 prototypes; give it a @_; mark temporaries as such. I<type> indicates
1570 the kind of subroutine:
1572 padtidy_SUB ordinary subroutine
1573 padtidy_SUBCLONE prototype for lexical closure
1574 padtidy_FORMAT format
1579 /* XXX DAPM surely most of this stuff should be done properly
1580 * at the right time beforehand, rather than going around afterwards
1581 * cleaning up our mistakes ???
1585 Perl_pad_tidy(pTHX_ padtidy_type type)
1589 ASSERT_CURPAD_ACTIVE("pad_tidy");
1591 /* If this CV has had any 'eval-capable' ops planted in it
1592 * (ie it contains eval '...', //ee, /$var/ or /(?{..})/), Then any
1593 * anon prototypes in the chain of CVs should be marked as cloneable,
1594 * so that for example the eval's CV in C<< sub { eval '$x' } >> gets
1595 * the right CvOUTSIDE.
1596 * If running with -d, *any* sub may potentially have an eval
1597 * executed within it.
1600 if (PL_cv_has_eval || PL_perldb) {
1602 for (cv = PL_compcv ;cv; cv = CvOUTSIDE(cv)) {
1603 if (cv != PL_compcv && CvCOMPILED(cv))
1604 break; /* no need to mark already-compiled code */
1606 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1607 "Pad clone on cv=0x%"UVxf"\n", PTR2UV(cv)));
1613 /* extend curpad to match namepad */
1614 if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
1615 av_store(PL_comppad_name, AvFILLp(PL_comppad), NULL);
1617 if (type == padtidy_SUBCLONE) {
1618 SV * const * const namep = AvARRAY(PL_comppad_name);
1621 for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1624 if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
1627 * The only things that a clonable function needs in its
1628 * pad are anonymous subs.
1629 * The rest are created anew during cloning.
1631 if (!((namesv = namep[ix]) != NULL &&
1632 namesv != &PL_sv_undef &&
1633 *SvPVX_const(namesv) == '&'))
1635 SvREFCNT_dec(PL_curpad[ix]);
1636 PL_curpad[ix] = NULL;
1640 else if (type == padtidy_SUB) {
1641 /* XXX DAPM this same bit of code keeps appearing !!! Rationalise? */
1642 AV * const av = newAV(); /* Will be @_ */
1643 av_store(PL_comppad, 0, MUTABLE_SV(av));
1647 if (type == padtidy_SUB || type == padtidy_FORMAT) {
1648 SV * const * const namep = AvARRAY(PL_comppad_name);
1650 for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1651 if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
1653 if (!SvPADMY(PL_curpad[ix])) {
1654 SvPADTMP_on(PL_curpad[ix]);
1655 } else if (!SvFAKE(namep[ix])) {
1656 /* This is a work around for how the current implementation of
1657 ?{ } blocks in regexps interacts with lexicals.
1659 One of our lexicals.
1660 Can't do this on all lexicals, otherwise sub baz() won't
1669 because completion of compiling &bar calling pad_tidy()
1670 would cause (top level) $foo to be marked as stale, and
1671 "no longer available". */
1672 SvPADSTALE_on(PL_curpad[ix]);
1676 PL_curpad = AvARRAY(PL_comppad);
1680 =for apidoc m|void|pad_free|PADOFFSET po
1682 Free the SV at offset po in the current pad.
1687 /* XXX DAPM integrate with pad_swipe ???? */
1689 Perl_pad_free(pTHX_ PADOFFSET po)
1692 ASSERT_CURPAD_LEGAL("pad_free");
1695 if (AvARRAY(PL_comppad) != PL_curpad)
1696 Perl_croak(aTHX_ "panic: pad_free curpad");
1698 Perl_croak(aTHX_ "panic: pad_free po");
1700 DEBUG_X(PerlIO_printf(Perl_debug_log,
1701 "Pad 0x%"UVxf"[0x%"UVxf"] free: %ld\n",
1702 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po)
1705 if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
1706 SvPADTMP_off(PL_curpad[po]);
1708 if ((I32)po < PL_padix)
1713 =for apidoc m|void|do_dump_pad|I32 level|PerlIO *file|PADLIST *padlist|int full
1715 Dump the contents of a padlist
1721 Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
1730 PERL_ARGS_ASSERT_DO_DUMP_PAD;
1735 pad_name = MUTABLE_AV(*av_fetch(MUTABLE_AV(padlist), 0, FALSE));
1736 pad = MUTABLE_AV(*av_fetch(MUTABLE_AV(padlist), 1, FALSE));
1737 pname = AvARRAY(pad_name);
1738 ppad = AvARRAY(pad);
1739 Perl_dump_indent(aTHX_ level, file,
1740 "PADNAME = 0x%"UVxf"(0x%"UVxf") PAD = 0x%"UVxf"(0x%"UVxf")\n",
1741 PTR2UV(pad_name), PTR2UV(pname), PTR2UV(pad), PTR2UV(ppad)
1744 for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
1745 const SV *namesv = pname[ix];
1746 if (namesv && namesv == &PL_sv_undef) {
1751 Perl_dump_indent(aTHX_ level+1, file,
1752 "%2d. 0x%"UVxf"<%lu> FAKE \"%s\" flags=0x%lx index=%lu\n",
1755 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
1756 SvPVX_const(namesv),
1757 (unsigned long)PARENT_FAKELEX_FLAGS(namesv),
1758 (unsigned long)PARENT_PAD_INDEX(namesv)
1762 Perl_dump_indent(aTHX_ level+1, file,
1763 "%2d. 0x%"UVxf"<%lu> (%lu,%lu) \"%s\"\n",
1766 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
1767 (unsigned long)COP_SEQ_RANGE_LOW(namesv),
1768 (unsigned long)COP_SEQ_RANGE_HIGH(namesv),
1773 Perl_dump_indent(aTHX_ level+1, file,
1774 "%2d. 0x%"UVxf"<%lu>\n",
1777 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0)
1786 =for apidoc m|void|cv_dump|CV *cv|const char *title
1788 dump the contents of a CV
1794 S_cv_dump(pTHX_ const CV *cv, const char *title)
1797 const CV * const outside = CvOUTSIDE(cv);
1798 AV* const padlist = CvPADLIST(cv);
1800 PERL_ARGS_ASSERT_CV_DUMP;
1802 PerlIO_printf(Perl_debug_log,
1803 " %s: CV=0x%"UVxf" (%s), OUTSIDE=0x%"UVxf" (%s)\n",
1806 (CvANON(cv) ? "ANON"
1807 : (SvTYPE(cv) == SVt_PVFM) ? "FORMAT"
1808 : (cv == PL_main_cv) ? "MAIN"
1809 : CvUNIQUE(cv) ? "UNIQUE"
1810 : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
1813 : CvANON(outside) ? "ANON"
1814 : (outside == PL_main_cv) ? "MAIN"
1815 : CvUNIQUE(outside) ? "UNIQUE"
1816 : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
1818 PerlIO_printf(Perl_debug_log,
1819 " PADLIST = 0x%"UVxf"\n", PTR2UV(padlist));
1820 do_dump_pad(1, Perl_debug_log, padlist, 1);
1823 #endif /* DEBUGGING */
1826 =for apidoc Am|CV *|cv_clone|CV *proto
1828 Clone a CV, making a lexical closure. I<proto> supplies the prototype
1829 of the function: its code, pad structure, and other attributes.
1830 The prototype is combined with a capture of outer lexicals to which the
1831 code refers, which are taken from the currently-executing instance of
1832 the immediately surrounding code.
1838 Perl_cv_clone(pTHX_ CV *proto)
1842 AV* const protopadlist = CvPADLIST(proto);
1843 const AV *const protopad_name = (const AV *)*av_fetch(protopadlist, 0, FALSE);
1844 const AV *const protopad = (const AV *)*av_fetch(protopadlist, 1, FALSE);
1845 SV** const pname = AvARRAY(protopad_name);
1846 SV** const ppad = AvARRAY(protopad);
1847 const I32 fname = AvFILLp(protopad_name);
1848 const I32 fpad = AvFILLp(protopad);
1854 PERL_ARGS_ASSERT_CV_CLONE;
1856 assert(!CvUNIQUE(proto));
1858 /* Since cloneable anon subs can be nested, CvOUTSIDE may point
1859 * to a prototype; we instead want the cloned parent who called us.
1860 * Note that in general for formats, CvOUTSIDE != find_runcv */
1862 outside = CvOUTSIDE(proto);
1863 if (outside && CvCLONE(outside) && ! CvCLONED(outside))
1864 outside = find_runcv(NULL);
1865 depth = CvDEPTH(outside);
1866 assert(depth || SvTYPE(proto) == SVt_PVFM);
1869 assert(CvPADLIST(outside));
1872 SAVESPTR(PL_compcv);
1874 cv = PL_compcv = MUTABLE_CV(newSV_type(SvTYPE(proto)));
1875 CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE|CVf_CVGV_RC);
1879 CvFILE(cv) = CvISXSUB(proto) ? CvFILE(proto)
1880 : savepv(CvFILE(proto));
1882 CvFILE(cv) = CvFILE(proto);
1884 CvGV_set(cv,CvGV(proto));
1885 CvSTASH_set(cv, CvSTASH(proto));
1887 CvROOT(cv) = OpREFCNT_inc(CvROOT(proto));
1889 CvSTART(cv) = CvSTART(proto);
1890 CvOUTSIDE(cv) = MUTABLE_CV(SvREFCNT_inc_simple(outside));
1891 CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
1894 sv_setpvn(MUTABLE_SV(cv), SvPVX_const(proto), SvCUR(proto));
1896 CvPADLIST(cv) = pad_new(padnew_CLONE|padnew_SAVE);
1898 av_fill(PL_comppad, fpad);
1899 for (ix = fname; ix > 0; ix--)
1900 av_store(PL_comppad_name, ix, SvREFCNT_inc(pname[ix]));
1902 PL_curpad = AvARRAY(PL_comppad);
1904 outpad = AvARRAY(AvARRAY(CvPADLIST(outside))[depth]);
1906 for (ix = fpad; ix > 0; ix--) {
1907 SV* const namesv = (ix <= fname) ? pname[ix] : NULL;
1909 if (namesv && namesv != &PL_sv_undef) { /* lexical */
1910 if (SvFAKE(namesv)) { /* lexical from outside? */
1911 sv = outpad[PARENT_PAD_INDEX(namesv)];
1913 /* formats may have an inactive parent,
1914 while my $x if $false can leave an active var marked as
1915 stale. And state vars are always available */
1916 if (SvPADSTALE(sv) && !SvPAD_STATE(namesv)) {
1917 Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
1918 "Variable \"%"SVf"\" is not available", namesv);
1922 SvREFCNT_inc_simple_void_NN(sv);
1925 const char sigil = SvPVX_const(namesv)[0];
1927 sv = SvREFCNT_inc(ppad[ix]);
1928 else if (sigil == '@')
1929 sv = MUTABLE_SV(newAV());
1930 else if (sigil == '%')
1931 sv = MUTABLE_SV(newHV());
1935 /* reset the 'assign only once' flag on each state var */
1936 if (SvPAD_STATE(namesv))
1940 else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) {
1941 sv = SvREFCNT_inc_NN(ppad[ix]);
1951 PerlIO_printf(Perl_debug_log, "\nPad CV clone\n");
1952 cv_dump(outside, "Outside");
1953 cv_dump(proto, "Proto");
1960 /* Constant sub () { $x } closing over $x - see lib/constant.pm:
1961 * The prototype was marked as a candiate for const-ization,
1962 * so try to grab the current const value, and if successful,
1963 * turn into a const sub:
1965 SV* const const_sv = op_const_sv(CvSTART(cv), cv);
1968 cv = newCONSTSUB(CvSTASH(proto), NULL, const_sv);
1979 =for apidoc m|void|pad_fixup_inner_anons|PADLIST *padlist|CV *old_cv|CV *new_cv
1981 For any anon CVs in the pad, change CvOUTSIDE of that CV from
1982 old_cv to new_cv if necessary. Needed when a newly-compiled CV has to be
1983 moved to a pre-existing CV struct.
1989 Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
1993 AV * const comppad_name = MUTABLE_AV(AvARRAY(padlist)[0]);
1994 AV * const comppad = MUTABLE_AV(AvARRAY(padlist)[1]);
1995 SV ** const namepad = AvARRAY(comppad_name);
1996 SV ** const curpad = AvARRAY(comppad);
1998 PERL_ARGS_ASSERT_PAD_FIXUP_INNER_ANONS;
1999 PERL_UNUSED_ARG(old_cv);
2001 for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
2002 const SV * const namesv = namepad[ix];
2003 if (namesv && namesv != &PL_sv_undef
2004 && *SvPVX_const(namesv) == '&')
2006 CV * const innercv = MUTABLE_CV(curpad[ix]);
2007 assert(CvWEAKOUTSIDE(innercv));
2008 assert(CvOUTSIDE(innercv) == old_cv);
2009 CvOUTSIDE(innercv) = new_cv;
2015 =for apidoc m|void|pad_push|PADLIST *padlist|int depth
2017 Push a new pad frame onto the padlist, unless there's already a pad at
2018 this depth, in which case don't bother creating a new one. Then give
2019 the new pad an @_ in slot zero.
2025 Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
2029 PERL_ARGS_ASSERT_PAD_PUSH;
2031 if (depth > AvFILLp(padlist)) {
2032 SV** const svp = AvARRAY(padlist);
2033 AV* const newpad = newAV();
2034 SV** const oldpad = AvARRAY(svp[depth-1]);
2035 I32 ix = AvFILLp((const AV *)svp[1]);
2036 const I32 names_fill = AvFILLp((const AV *)svp[0]);
2037 SV** const names = AvARRAY(svp[0]);
2040 for ( ;ix > 0; ix--) {
2041 if (names_fill >= ix && names[ix] != &PL_sv_undef) {
2042 const char sigil = SvPVX_const(names[ix])[0];
2043 if ((SvFLAGS(names[ix]) & SVf_FAKE)
2044 || (SvFLAGS(names[ix]) & SVpad_STATE)
2047 /* outer lexical or anon code */
2048 av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]));
2050 else { /* our own lexical */
2053 sv = MUTABLE_SV(newAV());
2054 else if (sigil == '%')
2055 sv = MUTABLE_SV(newHV());
2058 av_store(newpad, ix, sv);
2062 else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
2063 av_store(newpad, ix, SvREFCNT_inc_NN(oldpad[ix]));
2066 /* save temporaries on recursion? */
2067 SV * const sv = newSV(0);
2068 av_store(newpad, ix, sv);
2073 av_store(newpad, 0, MUTABLE_SV(av));
2076 av_store(padlist, depth, MUTABLE_SV(newpad));
2077 AvFILLp(padlist) = depth;
2082 =for apidoc Am|HV *|pad_compname_type|PADOFFSET po
2084 Looks up the type of the lexical variable at position I<po> in the
2085 currently-compiling pad. If the variable is typed, the stash of the
2086 class to which it is typed is returned. If not, C<NULL> is returned.
2092 Perl_pad_compname_type(pTHX_ const PADOFFSET po)
2095 SV* const * const av = av_fetch(PL_comppad_name, po, FALSE);
2096 if ( SvPAD_TYPED(*av) ) {
2097 return SvSTASH(*av);
2102 #if defined(USE_ITHREADS)
2104 # define av_dup_inc(s,t) MUTABLE_AV(sv_dup_inc((const SV *)s,t))
2107 =for apidoc m|AV *|padlist_dup|AV *srcpad|CLONE_PARAMS *param
2115 Perl_padlist_dup(pTHX_ AV *srcpad, CLONE_PARAMS *param)
2118 PERL_ARGS_ASSERT_PADLIST_DUP;
2123 assert(!AvREAL(srcpad));
2125 if (param->flags & CLONEf_COPY_STACKS
2126 || SvREFCNT(AvARRAY(srcpad)[1]) > 1) {
2127 /* XXX padlists are real, but pretend to be not */
2129 dstpad = av_dup_inc(srcpad, param);
2132 assert (SvREFCNT(AvARRAY(srcpad)[1]) == 1);
2134 /* CvDEPTH() on our subroutine will be set to 0, so there's no need
2135 to build anything other than the first level of pads. */
2137 I32 ix = AvFILLp((const AV *)AvARRAY(srcpad)[1]);
2139 const I32 names_fill = AvFILLp((const AV *)(AvARRAY(srcpad)[0]));
2140 const AV *const srcpad1 = (const AV *) AvARRAY(srcpad)[1];
2141 SV **oldpad = AvARRAY(srcpad1);
2145 /* look for it in the table first.
2146 I *think* that it shouldn't be possible to find it there.
2147 Well, except for how Perl_sv_compile_2op() "works" :-( */
2148 dstpad = (AV*)ptr_table_fetch(PL_ptr_table, srcpad);
2154 ptr_table_store(PL_ptr_table, srcpad, dstpad);
2156 av_extend(dstpad, 1);
2157 AvARRAY(dstpad)[0] = MUTABLE_SV(av_dup_inc(AvARRAY(srcpad)[0], param));
2158 names = AvARRAY(AvARRAY(dstpad)[0]);
2162 av_extend(pad1, ix);
2163 AvARRAY(dstpad)[1] = MUTABLE_SV(pad1);
2164 pad1a = AvARRAY(pad1);
2165 AvFILLp(dstpad) = 1;
2170 for ( ;ix > 0; ix--) {
2173 } else if (names_fill >= ix && names[ix] != &PL_sv_undef) {
2174 const char sigil = SvPVX_const(names[ix])[0];
2175 if ((SvFLAGS(names[ix]) & SVf_FAKE)
2176 || (SvFLAGS(names[ix]) & SVpad_STATE)
2179 /* outer lexical or anon code */
2180 pad1a[ix] = sv_dup_inc(oldpad[ix], param);
2182 else { /* our own lexical */
2183 if(SvPADSTALE(oldpad[ix]) && SvREFCNT(oldpad[ix]) > 1) {
2184 /* This is a work around for how the current
2185 implementation of ?{ } blocks in regexps
2186 interacts with lexicals. */
2187 pad1a[ix] = sv_dup_inc(oldpad[ix], param);
2192 sv = MUTABLE_SV(newAV());
2193 else if (sigil == '%')
2194 sv = MUTABLE_SV(newHV());
2202 else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
2203 pad1a[ix] = sv_dup_inc(oldpad[ix], param);
2206 /* save temporaries on recursion? */
2207 SV * const sv = newSV(0);
2210 /* SvREFCNT(oldpad[ix]) != 1 for some code in threads.xs
2211 FIXTHAT before merging this branch.
2212 (And I know how to) */
2213 if (SvPADMY(oldpad[ix]))
2221 args = newAV(); /* Will be @_ */
2223 pad1a[0] = (SV *)args;
2231 #endif /* USE_ITHREADS */
2235 * c-indentation-style: bsd
2237 * indent-tabs-mode: t
2240 * ex: set ts=8 sts=4 sw=4 noet: