Don't clone the contents of lexicals in pads.
[p5sagit/p5-mst-13.2.git] / pad.c
1 /*    pad.c
2  *
3  *    Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
4  *    by Larry Wall and others
5  *
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.
8  */
9
10 /*
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
17  *
18  *     [p.23 of _The Lord of the Rings_, I/i: "A Long-Expected Party"]
19  */
20
21 /* XXX DAPM
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.
25  */
26
27 /*
28 =head1 Pad Data Structures
29
30 This file contains the functions that create and manipulate scratchpads,
31 which are array-of-array data structures attached to a CV (ie a sub)
32 and which store lexical variables and opcode temporary and per-thread
33 values.
34
35 =for apidoc m|AV *|CvPADLIST|CV *cv
36 CV's can have CvPADLIST(cv) set to point to an AV.
37
38 For these purposes "forms" are a kind-of CV, eval""s are too (except they're
39 not callable at will and are always thrown away after the eval"" is done
40 executing). Require'd files are simply evals without any outer lexical
41 scope.
42
43 XSUBs don't have CvPADLIST set - dXSTARG fetches values from PL_curpad,
44 but that is really the callers pad (a slot of which is allocated by
45 every entersub).
46
47 The CvPADLIST AV has does not have AvREAL set, so REFCNT of component items
48 is managed "manual" (mostly in pad.c) rather than normal av.c rules.
49 The items in the AV are not SVs as for a normal AV, but other AVs:
50
51 0'th Entry of the CvPADLIST is an AV which represents the "names" or rather
52 the "static type information" for lexicals.
53
54 The CvDEPTH'th entry of CvPADLIST AV is an AV which is the stack frame at that
55 depth of recursion into the CV.
56 The 0'th slot of a frame AV is an AV which is @_.
57 other entries are storage for variables and op targets.
58
59 During compilation:
60 C<PL_comppad_name> is set to the names AV.
61 C<PL_comppad> is set to the frame AV for the frame CvDEPTH == 1.
62 C<PL_curpad> is set to the body of the frame AV (i.e. AvARRAY(PL_comppad)).
63
64 During execution, C<PL_comppad> and C<PL_curpad> refer to the live
65 frame of the currently executing sub.
66
67 Iterating over the names AV iterates over all possible pad
68 items. Pad slots that are SVs_PADTMP (targets/GVs/constants) end up having
69 &PL_sv_undef "names" (see pad_alloc()).
70
71 Only my/our variable (SVs_PADMY/SVs_PADOUR) slots get valid names.
72 The rest are op targets/GVs/constants which are statically allocated
73 or resolved at compile time.  These don't have names by which they
74 can be looked up from Perl code at run time through eval"" like
75 my/our variables can be.  Since they can't be looked up by "name"
76 but only by their index allocated at compile time (which is usually
77 in PL_op->op_targ), wasting a name SV for them doesn't make sense.
78
79 The SVs in the names AV have their PV being the name of the variable.
80 xlow+1..xhigh inclusive in the NV union is a range of cop_seq numbers for
81 which the name is valid.  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.
86
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
94 cloning quicker.
95
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.)
100
101 Note that formats are treated as anon subs, and are cloned each time
102 write is called (if necessary).
103
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 
107
108     { my $x = 1; sub f { eval '$x'} } f();
109
110 For state vars, SVs_PADSTALE is overloaded to mean 'not yet initialised'
111
112 =cut
113 */
114
115
116 #include "EXTERN.h"
117 #define PERL_IN_PAD_C
118 #include "perl.h"
119 #include "keywords.h"
120
121 #define COP_SEQ_RANGE_LOW_set(sv,val)           \
122   STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xlow = (val); } STMT_END
123 #define COP_SEQ_RANGE_HIGH_set(sv,val)          \
124   STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xhigh = (val); } STMT_END
125
126 #define PARENT_PAD_INDEX_set(sv,val)            \
127   STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xlow = (val); } STMT_END
128 #define PARENT_FAKELEX_FLAGS_set(sv,val)        \
129   STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xhigh = (val); } STMT_END
130
131 #define PAD_MAX I32_MAX
132
133 #ifdef PERL_MAD
134 void pad_peg(const char* s) {
135     static int pegcnt;
136
137     PERL_ARGS_ASSERT_PAD_PEG;
138
139     pegcnt++;
140 }
141 #endif
142
143 /*
144 =for apidoc pad_new
145
146 Create a new compiling padlist, saving and updating the various global
147 vars at the same time as creating the pad itself. The following flags
148 can be OR'ed together:
149
150     padnew_CLONE        this pad is for a cloned CV
151     padnew_SAVE         save old globals
152     padnew_SAVESUB      also save extra stuff for start of sub
153
154 =cut
155 */
156
157 PADLIST *
158 Perl_pad_new(pTHX_ int flags)
159 {
160     dVAR;
161     AV *padlist, *padname, *pad;
162
163     ASSERT_CURPAD_LEGAL("pad_new");
164
165     /* XXX DAPM really need a new SAVEt_PAD which restores all or most
166      * vars (based on flags) rather than storing vals + addresses for
167      * each individually. Also see pad_block_start.
168      * XXX DAPM Try to see whether all these conditionals are required
169      */
170
171     /* save existing state, ... */
172
173     if (flags & padnew_SAVE) {
174         SAVECOMPPAD();
175         SAVESPTR(PL_comppad_name);
176         if (! (flags & padnew_CLONE)) {
177             SAVEI32(PL_padix);
178             SAVEI32(PL_comppad_name_fill);
179             SAVEI32(PL_min_intro_pending);
180             SAVEI32(PL_max_intro_pending);
181             SAVEBOOL(PL_cv_has_eval);
182             if (flags & padnew_SAVESUB) {
183                 SAVEBOOL(PL_pad_reset_pending);
184             }
185         }
186     }
187     /* XXX DAPM interestingly, PL_comppad_name_floor never seems to be
188      * saved - check at some pt that this is okay */
189
190     /* ... create new pad ... */
191
192     padlist     = newAV();
193     padname     = newAV();
194     pad         = newAV();
195
196     if (flags & padnew_CLONE) {
197         /* XXX DAPM  I dont know why cv_clone needs it
198          * doing differently yet - perhaps this separate branch can be
199          * dispensed with eventually ???
200          */
201
202         AV * const a0 = newAV();                        /* will be @_ */
203         av_extend(a0, 0);
204         av_store(pad, 0, MUTABLE_SV(a0));
205         AvREIFY_only(a0);
206     }
207     else {
208         av_store(pad, 0, NULL);
209     }
210
211     AvREAL_off(padlist);
212     av_store(padlist, 0, MUTABLE_SV(padname));
213     av_store(padlist, 1, MUTABLE_SV(pad));
214
215     /* ... then update state variables */
216
217     PL_comppad_name     = MUTABLE_AV((*av_fetch(padlist, 0, FALSE)));
218     PL_comppad          = MUTABLE_AV((*av_fetch(padlist, 1, FALSE)));
219     PL_curpad           = AvARRAY(PL_comppad);
220
221     if (! (flags & padnew_CLONE)) {
222         PL_comppad_name_fill = 0;
223         PL_min_intro_pending = 0;
224         PL_padix             = 0;
225         PL_cv_has_eval       = 0;
226     }
227
228     DEBUG_X(PerlIO_printf(Perl_debug_log,
229           "Pad 0x%"UVxf"[0x%"UVxf"] new:       compcv=0x%"UVxf
230               " name=0x%"UVxf" flags=0x%"UVxf"\n",
231           PTR2UV(PL_comppad), PTR2UV(PL_curpad), PTR2UV(PL_compcv),
232               PTR2UV(padname), (UV)flags
233         )
234     );
235
236     return (PADLIST*)padlist;
237 }
238
239 /*
240 =for apidoc pad_undef
241
242 Free the padlist associated with a CV.
243 If parts of it happen to be current, we null the relevant
244 PL_*pad* global vars so that we don't have any dangling references left.
245 We also repoint the CvOUTSIDE of any about-to-be-orphaned
246 inner subs to the outer of this cv.
247
248 (This function should really be called pad_free, but the name was already
249 taken)
250
251 =cut
252 */
253
254 void
255 Perl_pad_undef(pTHX_ CV* cv)
256 {
257     dVAR;
258     I32 ix;
259     const PADLIST * const padlist = CvPADLIST(cv);
260
261     PERL_ARGS_ASSERT_PAD_UNDEF;
262
263     pad_peg("pad_undef");
264     if (!padlist)
265         return;
266     if (SvIS_FREED(padlist)) /* may be during global destruction */
267         return;
268
269     DEBUG_X(PerlIO_printf(Perl_debug_log,
270           "Pad undef: cv=0x%"UVxf" padlist=0x%"UVxf" comppad=0x%"UVxf"\n",
271             PTR2UV(cv), PTR2UV(padlist), PTR2UV(PL_comppad))
272     );
273
274     /* detach any '&' anon children in the pad; if afterwards they
275      * are still live, fix up their CvOUTSIDEs to point to our outside,
276      * bypassing us. */
277     /* XXX DAPM for efficiency, we should only do this if we know we have
278      * children, or integrate this loop with general cleanup */
279
280     if (!PL_dirty) { /* don't bother during global destruction */
281         CV * const outercv = CvOUTSIDE(cv);
282         const U32 seq = CvOUTSIDE_SEQ(cv);
283         AV *  const comppad_name = MUTABLE_AV(AvARRAY(padlist)[0]);
284         SV ** const namepad = AvARRAY(comppad_name);
285         AV *  const comppad = MUTABLE_AV(AvARRAY(padlist)[1]);
286         SV ** const curpad = AvARRAY(comppad);
287         for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
288             SV * const namesv = namepad[ix];
289             if (namesv && namesv != &PL_sv_undef
290                 && *SvPVX_const(namesv) == '&')
291             {
292                 CV * const innercv = MUTABLE_CV(curpad[ix]);
293                 U32 inner_rc = SvREFCNT(innercv);
294                 assert(inner_rc);
295                 namepad[ix] = NULL;
296                 SvREFCNT_dec(namesv);
297
298                 if (SvREFCNT(comppad) < 2) { /* allow for /(?{ sub{} })/  */
299                     curpad[ix] = NULL;
300                     SvREFCNT_dec(innercv);
301                     inner_rc--;
302                 }
303
304                 /* in use, not just a prototype */
305                 if (inner_rc && (CvOUTSIDE(innercv) == cv)) {
306                     assert(CvWEAKOUTSIDE(innercv));
307                     /* don't relink to grandfather if he's being freed */
308                     if (outercv && SvREFCNT(outercv)) {
309                         CvWEAKOUTSIDE_off(innercv);
310                         CvOUTSIDE(innercv) = outercv;
311                         CvOUTSIDE_SEQ(innercv) = seq;
312                         SvREFCNT_inc_simple_void_NN(outercv);
313                     }
314                     else {
315                         CvOUTSIDE(innercv) = NULL;
316                     }
317                 }
318             }
319         }
320     }
321
322     ix = AvFILLp(padlist);
323     while (ix >= 0) {
324         SV* const sv = AvARRAY(padlist)[ix--];
325         if (sv) {
326             if (sv == (const SV *)PL_comppad_name)
327                 PL_comppad_name = NULL;
328             else if (sv == (const SV *)PL_comppad) {
329                 PL_comppad = NULL;
330                 PL_curpad = NULL;
331             }
332         }
333         SvREFCNT_dec(sv);
334     }
335     SvREFCNT_dec(MUTABLE_SV(CvPADLIST(cv)));
336     CvPADLIST(cv) = NULL;
337 }
338
339
340
341
342 static PADOFFSET
343 S_pad_add_name_sv(pTHX_ SV *namesv, const U32 flags, HV *typestash,
344                   HV *ourstash)
345 {
346     dVAR;
347     const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
348
349     PERL_ARGS_ASSERT_PAD_ADD_NAME_SV;
350
351     ASSERT_CURPAD_ACTIVE("pad_add_name");
352
353     if (typestash) {
354         assert(SvTYPE(namesv) == SVt_PVMG);
355         SvPAD_TYPED_on(namesv);
356         SvSTASH_set(namesv, MUTABLE_HV(SvREFCNT_inc_simple_NN(MUTABLE_SV(typestash))));
357     }
358     if (ourstash) {
359         SvPAD_OUR_on(namesv);
360         SvOURSTASH_set(namesv, ourstash);
361         SvREFCNT_inc_simple_void_NN(ourstash);
362     }
363     else if (flags & padadd_STATE) {
364         SvPAD_STATE_on(namesv);
365     }
366
367     av_store(PL_comppad_name, offset, namesv);
368     return offset;
369 }
370
371 /*
372 =for apidoc pad_add_name
373
374 Create a new name and associated PADMY SV in the current pad; return the
375 offset.
376 If C<typestash> is valid, the name is for a typed lexical; set the
377 name's stash to that value.
378 If C<ourstash> is valid, it's an our lexical, set the name's
379 SvOURSTASH to that value
380
381 If fake, it means we're cloning an existing entry
382
383 =cut
384 */
385
386 PADOFFSET
387 Perl_pad_add_name(pTHX_ const char *name, const STRLEN len, const U32 flags,
388                   HV *typestash, HV *ourstash)
389 {
390     dVAR;
391     PADOFFSET offset;
392     SV *namesv;
393
394     PERL_ARGS_ASSERT_PAD_ADD_NAME;
395
396     if (flags & ~(padadd_OUR|padadd_STATE|padadd_NO_DUP_CHECK))
397         Perl_croak(aTHX_ "panic: pad_add_name illegal flag bits 0x%" UVxf,
398                    (UV)flags);
399
400     namesv = newSV_type((ourstash || typestash) ? SVt_PVMG : SVt_PVNV);
401
402     /* Until we're using the length for real, cross check that we're being told
403        the truth.  */
404     PERL_UNUSED_ARG(len);
405     assert(strlen(name) == len);
406
407     sv_setpv(namesv, name);
408
409     if ((flags & padadd_NO_DUP_CHECK) == 0) {
410         /* check for duplicate declaration */
411         pad_check_dup(namesv, flags & padadd_OUR, ourstash);
412     }
413
414     offset = pad_add_name_sv(namesv, flags, typestash, ourstash);
415
416     /* not yet introduced */
417     COP_SEQ_RANGE_LOW_set(namesv, PAD_MAX);     /* min */
418     COP_SEQ_RANGE_HIGH_set(namesv, 0);          /* max */
419
420     if (!PL_min_intro_pending)
421         PL_min_intro_pending = offset;
422     PL_max_intro_pending = offset;
423     /* if it's not a simple scalar, replace with an AV or HV */
424     /* XXX DAPM since slot has been allocated, replace
425      * av_store with PL_curpad[offset] ? */
426     if (*name == '@')
427         av_store(PL_comppad, offset, MUTABLE_SV(newAV()));
428     else if (*name == '%')
429         av_store(PL_comppad, offset, MUTABLE_SV(newHV()));
430     SvPADMY_on(PL_curpad[offset]);
431     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
432                            "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
433                            (long)offset, name, PTR2UV(PL_curpad[offset])));
434
435     return offset;
436 }
437
438
439
440
441 /*
442 =for apidoc pad_alloc
443
444 Allocate a new my or tmp pad entry. For a my, simply push a null SV onto
445 the end of PL_comppad, but for a tmp, scan the pad from PL_padix upwards
446 for a slot which has no name and no active value.
447
448 =cut
449 */
450
451 /* XXX DAPM integrate alloc(), add_name() and add_anon(),
452  * or at least rationalise ??? */
453 /* And flag whether the incoming name is UTF8 or 8 bit?
454    Could do this either with the +ve/-ve hack of the HV code, or expanding
455    the flag bits. Either way, this makes proper Unicode safe pad support.
456    NWC
457 */
458
459 PADOFFSET
460 Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
461 {
462     dVAR;
463     SV *sv;
464     I32 retval;
465
466     PERL_UNUSED_ARG(optype);
467     ASSERT_CURPAD_ACTIVE("pad_alloc");
468
469     if (AvARRAY(PL_comppad) != PL_curpad)
470         Perl_croak(aTHX_ "panic: pad_alloc");
471     if (PL_pad_reset_pending)
472         pad_reset();
473     if (tmptype & SVs_PADMY) {
474         sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE);
475         retval = AvFILLp(PL_comppad);
476     }
477     else {
478         SV * const * const names = AvARRAY(PL_comppad_name);
479         const SSize_t names_fill = AvFILLp(PL_comppad_name);
480         for (;;) {
481             /*
482              * "foreach" index vars temporarily become aliases to non-"my"
483              * values.  Thus we must skip, not just pad values that are
484              * marked as current pad values, but also those with names.
485              */
486             /* HVDS why copy to sv here? we don't seem to use it */
487             if (++PL_padix <= names_fill &&
488                    (sv = names[PL_padix]) && sv != &PL_sv_undef)
489                 continue;
490             sv = *av_fetch(PL_comppad, PL_padix, TRUE);
491             if (!(SvFLAGS(sv) & (SVs_PADTMP | SVs_PADMY)) &&
492                 !IS_PADGV(sv) && !IS_PADCONST(sv))
493                 break;
494         }
495         retval = PL_padix;
496     }
497     SvFLAGS(sv) |= tmptype;
498     PL_curpad = AvARRAY(PL_comppad);
499
500     DEBUG_X(PerlIO_printf(Perl_debug_log,
501           "Pad 0x%"UVxf"[0x%"UVxf"] alloc:   %ld for %s\n",
502           PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long) retval,
503           PL_op_name[optype]));
504 #ifdef DEBUG_LEAKING_SCALARS
505     sv->sv_debug_optype = optype;
506     sv->sv_debug_inpad = 1;
507 #endif
508     return (PADOFFSET)retval;
509 }
510
511 /*
512 =for apidoc pad_add_anon
513
514 Add an anon code entry to the current compiling pad
515
516 =cut
517 */
518
519 PADOFFSET
520 Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
521 {
522     dVAR;
523     PADOFFSET ix;
524     SV* const name = newSV_type(SVt_PVNV);
525
526     PERL_ARGS_ASSERT_PAD_ADD_ANON;
527
528     pad_peg("add_anon");
529     sv_setpvs(name, "&");
530     /* Are these two actually ever read? */
531     COP_SEQ_RANGE_HIGH_set(name, ~0);
532     COP_SEQ_RANGE_LOW_set(name, 1);
533     ix = pad_alloc(op_type, SVs_PADMY);
534     av_store(PL_comppad_name, ix, name);
535     /* XXX DAPM use PL_curpad[] ? */
536     av_store(PL_comppad, ix, sv);
537     SvPADMY_on(sv);
538
539     /* to avoid ref loops, we never have parent + child referencing each
540      * other simultaneously */
541     if (CvOUTSIDE((const CV *)sv)) {
542         assert(!CvWEAKOUTSIDE((const CV *)sv));
543         CvWEAKOUTSIDE_on(MUTABLE_CV(sv));
544         SvREFCNT_dec(CvOUTSIDE(MUTABLE_CV(sv)));
545     }
546     return ix;
547 }
548
549
550
551 /*
552 =for apidoc pad_check_dup
553
554 Check for duplicate declarations: report any of:
555      * a my in the current scope with the same name;
556      * an our (anywhere in the pad) with the same name and the same stash
557        as C<ourstash>
558 C<is_our> indicates that the name to check is an 'our' declaration
559
560 =cut
561 */
562
563 STATIC void
564 S_pad_check_dup(pTHX_ SV *name, const U32 flags, const HV *ourstash)
565 {
566     dVAR;
567     SV          **svp;
568     PADOFFSET   top, off;
569     const U32   is_our = flags & padadd_OUR;
570
571     PERL_ARGS_ASSERT_PAD_CHECK_DUP;
572
573     ASSERT_CURPAD_ACTIVE("pad_check_dup");
574
575     assert((flags & ~padadd_OUR) == 0);
576
577     if (AvFILLp(PL_comppad_name) < 0 || !ckWARN(WARN_MISC))
578         return; /* nothing to check */
579
580     svp = AvARRAY(PL_comppad_name);
581     top = AvFILLp(PL_comppad_name);
582     /* check the current scope */
583     /* XXX DAPM - why the (I32) cast - shouldn't we ensure they're the same
584      * type ? */
585     for (off = top; (I32)off > PL_comppad_name_floor; off--) {
586         SV * const sv = svp[off];
587         if (sv
588             && sv != &PL_sv_undef
589             && !SvFAKE(sv)
590             && (COP_SEQ_RANGE_HIGH(sv) == PAD_MAX || COP_SEQ_RANGE_HIGH(sv) == 0)
591             && sv_eq(name, sv))
592         {
593             if (is_our && (SvPAD_OUR(sv)))
594                 break; /* "our" masking "our" */
595             Perl_warner(aTHX_ packWARN(WARN_MISC),
596                 "\"%s\" variable %"SVf" masks earlier declaration in same %s",
597                 (is_our ? "our" : PL_parser->in_my == KEY_my ? "my" : "state"),
598                 sv,
599                 (COP_SEQ_RANGE_HIGH(sv) == PAD_MAX ? "scope" : "statement"));
600             --off;
601             break;
602         }
603     }
604     /* check the rest of the pad */
605     if (is_our) {
606         do {
607             SV * const sv = svp[off];
608             if (sv
609                 && sv != &PL_sv_undef
610                 && !SvFAKE(sv)
611                 && (COP_SEQ_RANGE_HIGH(sv) == PAD_MAX || COP_SEQ_RANGE_HIGH(sv) == 0)
612                 && SvOURSTASH(sv) == ourstash
613                 && sv_eq(name, sv))
614             {
615                 Perl_warner(aTHX_ packWARN(WARN_MISC),
616                     "\"our\" variable %"SVf" redeclared", sv);
617                 if ((I32)off <= PL_comppad_name_floor)
618                     Perl_warner(aTHX_ packWARN(WARN_MISC),
619                         "\t(Did you mean \"local\" instead of \"our\"?)\n");
620                 break;
621             }
622         } while ( off-- > 0 );
623     }
624 }
625
626
627 /*
628 =for apidoc pad_findmy
629
630 Given a lexical name, try to find its offset, first in the current pad,
631 or failing that, in the pads of any lexically enclosing subs (including
632 the complications introduced by eval). If the name is found in an outer pad,
633 then a fake entry is added to the current pad.
634 Returns the offset in the current pad, or NOT_IN_PAD on failure.
635
636 =cut
637 */
638
639 PADOFFSET
640 Perl_pad_findmy(pTHX_ const char *name, STRLEN len, U32 flags)
641 {
642     dVAR;
643     SV *out_sv;
644     int out_flags;
645     I32 offset;
646     const AV *nameav;
647     SV **name_svp;
648
649     PERL_ARGS_ASSERT_PAD_FINDMY;
650
651     pad_peg("pad_findmy");
652
653     if (flags)
654         Perl_croak(aTHX_ "panic: pad_findmy illegal flag bits 0x%" UVxf,
655                    (UV)flags);
656
657     /* Yes, it is a bug (read work in progress) that we're not really using this
658        length parameter, and instead relying on strlen() later on. But I'm not
659        comfortable about changing the pad API piecemeal to use and rely on
660        lengths. This only exists to avoid an "unused parameter" warning.  */
661     if (len < 2) 
662         return NOT_IN_PAD;
663
664     /* But until we're using the length for real, cross check that we're being
665        told the truth.  */
666     assert(strlen(name) == len);
667
668     offset = pad_findlex(name, PL_compcv, PL_cop_seqmax, 1,
669                 NULL, &out_sv, &out_flags);
670     if ((PADOFFSET)offset != NOT_IN_PAD) 
671         return offset;
672
673     /* look for an our that's being introduced; this allows
674      *    our $foo = 0 unless defined $foo;
675      * to not give a warning. (Yes, this is a hack) */
676
677     nameav = MUTABLE_AV(AvARRAY(CvPADLIST(PL_compcv))[0]);
678     name_svp = AvARRAY(nameav);
679     for (offset = AvFILLp(nameav); offset > 0; offset--) {
680         const SV * const namesv = name_svp[offset];
681         if (namesv && namesv != &PL_sv_undef
682             && !SvFAKE(namesv)
683             && (SvPAD_OUR(namesv))
684             && strEQ(SvPVX_const(namesv), name)
685             && COP_SEQ_RANGE_LOW(namesv) == PAD_MAX /* min */
686         )
687             return offset;
688     }
689     return NOT_IN_PAD;
690 }
691
692 /*
693  * Returns the offset of a lexical $_, if there is one, at run time.
694  * Used by the UNDERBAR XS macro.
695  */
696
697 PADOFFSET
698 Perl_find_rundefsvoffset(pTHX)
699 {
700     dVAR;
701     SV *out_sv;
702     int out_flags;
703     return pad_findlex("$_", find_runcv(NULL), PL_curcop->cop_seq, 1,
704             NULL, &out_sv, &out_flags);
705 }
706
707 /*
708 =for apidoc pad_findlex
709
710 Find a named lexical anywhere in a chain of nested pads. Add fake entries
711 in the inner pads if it's found in an outer one.
712
713 Returns the offset in the bottom pad of the lex or the fake lex.
714 cv is the CV in which to start the search, and seq is the current cop_seq
715 to match against. If warn is true, print appropriate warnings.  The out_*
716 vars return values, and so are pointers to where the returned values
717 should be stored. out_capture, if non-null, requests that the innermost
718 instance of the lexical is captured; out_name_sv is set to the innermost
719 matched namesv or fake namesv; out_flags returns the flags normally
720 associated with the IVX field of a fake namesv.
721
722 Note that pad_findlex() is recursive; it recurses up the chain of CVs,
723 then comes back down, adding fake entries as it goes. It has to be this way
724 because fake namesvs in anon protoypes have to store in xlow the index into
725 the parent pad.
726
727 =cut
728 */
729
730 /* the CV has finished being compiled. This is not a sufficient test for
731  * all CVs (eg XSUBs), but suffices for the CVs found in a lexical chain */
732 #define CvCOMPILED(cv)  CvROOT(cv)
733
734 /* the CV does late binding of its lexicals */
735 #define CvLATE(cv) (CvANON(cv) || SvTYPE(cv) == SVt_PVFM)
736
737
738 STATIC PADOFFSET
739 S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
740         SV** out_capture, SV** out_name_sv, int *out_flags)
741 {
742     dVAR;
743     I32 offset, new_offset;
744     SV *new_capture;
745     SV **new_capturep;
746     const AV * const padlist = CvPADLIST(cv);
747
748     PERL_ARGS_ASSERT_PAD_FINDLEX;
749
750     *out_flags = 0;
751
752     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
753         "Pad findlex cv=0x%"UVxf" searching \"%s\" seq=%d%s\n",
754         PTR2UV(cv), name, (int)seq, out_capture ? " capturing" : "" ));
755
756     /* first, search this pad */
757
758     if (padlist) { /* not an undef CV */
759         I32 fake_offset = 0;
760         const AV * const nameav = MUTABLE_AV(AvARRAY(padlist)[0]);
761         SV * const * const name_svp = AvARRAY(nameav);
762
763         for (offset = AvFILLp(nameav); offset > 0; offset--) {
764             const SV * const namesv = name_svp[offset];
765             if (namesv && namesv != &PL_sv_undef
766                     && strEQ(SvPVX_const(namesv), name))
767             {
768                 if (SvFAKE(namesv))
769                     fake_offset = offset; /* in case we don't find a real one */
770                 else if (  seq >  COP_SEQ_RANGE_LOW(namesv)     /* min */
771                         && seq <= COP_SEQ_RANGE_HIGH(namesv))   /* max */
772                     break;
773             }
774         }
775
776         if (offset > 0 || fake_offset > 0 ) { /* a match! */
777             if (offset > 0) { /* not fake */
778                 fake_offset = 0;
779                 *out_name_sv = name_svp[offset]; /* return the namesv */
780
781                 /* set PAD_FAKELEX_MULTI if this lex can have multiple
782                  * instances. For now, we just test !CvUNIQUE(cv), but
783                  * ideally, we should detect my's declared within loops
784                  * etc - this would allow a wider range of 'not stayed
785                  * shared' warnings. We also treated alreadly-compiled
786                  * lexes as not multi as viewed from evals. */
787
788                 *out_flags = CvANON(cv) ?
789                         PAD_FAKELEX_ANON :
790                             (!CvUNIQUE(cv) && ! CvCOMPILED(cv))
791                                 ? PAD_FAKELEX_MULTI : 0;
792
793                 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
794                     "Pad findlex cv=0x%"UVxf" matched: offset=%ld (%lu,%lu)\n",
795                     PTR2UV(cv), (long)offset,
796                     (unsigned long)COP_SEQ_RANGE_LOW(*out_name_sv),
797                     (unsigned long)COP_SEQ_RANGE_HIGH(*out_name_sv)));
798             }
799             else { /* fake match */
800                 offset = fake_offset;
801                 *out_name_sv = name_svp[offset]; /* return the namesv */
802                 *out_flags = PARENT_FAKELEX_FLAGS(*out_name_sv);
803                 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
804                     "Pad findlex cv=0x%"UVxf" matched: offset=%ld flags=0x%lx index=%lu\n",
805                     PTR2UV(cv), (long)offset, (unsigned long)*out_flags,
806                     (unsigned long) PARENT_PAD_INDEX(*out_name_sv) 
807                 ));
808             }
809
810             /* return the lex? */
811
812             if (out_capture) {
813
814                 /* our ? */
815                 if (SvPAD_OUR(*out_name_sv)) {
816                     *out_capture = NULL;
817                     return offset;
818                 }
819
820                 /* trying to capture from an anon prototype? */
821                 if (CvCOMPILED(cv)
822                         ? CvANON(cv) && CvCLONE(cv) && !CvCLONED(cv)
823                         : *out_flags & PAD_FAKELEX_ANON)
824                 {
825                     if (warn)
826                         Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
827                                        "Variable \"%s\" is not available", name);
828                     *out_capture = NULL;
829                 }
830
831                 /* real value */
832                 else {
833                     int newwarn = warn;
834                     if (!CvCOMPILED(cv) && (*out_flags & PAD_FAKELEX_MULTI)
835                          && !SvPAD_STATE(name_svp[offset])
836                          && warn && ckWARN(WARN_CLOSURE)) {
837                         newwarn = 0;
838                         Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
839                             "Variable \"%s\" will not stay shared", name);
840                     }
841
842                     if (fake_offset && CvANON(cv)
843                             && CvCLONE(cv) &&!CvCLONED(cv))
844                     {
845                         SV *n;
846                         /* not yet caught - look further up */
847                         DEBUG_Xv(PerlIO_printf(Perl_debug_log,
848                             "Pad findlex cv=0x%"UVxf" chasing lex in outer pad\n",
849                             PTR2UV(cv)));
850                         n = *out_name_sv;
851                         (void) pad_findlex(name, CvOUTSIDE(cv),
852                             CvOUTSIDE_SEQ(cv),
853                             newwarn, out_capture, out_name_sv, out_flags);
854                         *out_name_sv = n;
855                         return offset;
856                     }
857
858                     *out_capture = AvARRAY(MUTABLE_AV(AvARRAY(padlist)[
859                                     CvDEPTH(cv) ? CvDEPTH(cv) : 1]))[offset];
860                     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
861                         "Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n",
862                         PTR2UV(cv), PTR2UV(*out_capture)));
863
864                     if (SvPADSTALE(*out_capture)
865                         && !SvPAD_STATE(name_svp[offset]))
866                     {
867                         Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
868                                        "Variable \"%s\" is not available", name);
869                         *out_capture = NULL;
870                     }
871                 }
872                 if (!*out_capture) {
873                     if (*name == '@')
874                         *out_capture = sv_2mortal(MUTABLE_SV(newAV()));
875                     else if (*name == '%')
876                         *out_capture = sv_2mortal(MUTABLE_SV(newHV()));
877                     else
878                         *out_capture = sv_newmortal();
879                 }
880             }
881
882             return offset;
883         }
884     }
885
886     /* it's not in this pad - try above */
887
888     if (!CvOUTSIDE(cv))
889         return NOT_IN_PAD;
890
891     /* out_capture non-null means caller wants us to capture lex; in
892      * addition we capture ourselves unless it's an ANON/format */
893     new_capturep = out_capture ? out_capture :
894                 CvLATE(cv) ? NULL : &new_capture;
895
896     offset = pad_findlex(name, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1,
897                 new_capturep, out_name_sv, out_flags);
898     if ((PADOFFSET)offset == NOT_IN_PAD)
899         return NOT_IN_PAD;
900
901     /* found in an outer CV. Add appropriate fake entry to this pad */
902
903     /* don't add new fake entries (via eval) to CVs that we have already
904      * finished compiling, or to undef CVs */
905     if (CvCOMPILED(cv) || !padlist)
906         return 0; /* this dummy (and invalid) value isnt used by the caller */
907
908     {
909         /* This relies on sv_setsv_flags() upgrading the destination to the same
910            type as the source, independant of the flags set, and on it being
911            "good" and only copying flag bits and pointers that it understands.
912         */
913         SV *new_namesv = newSVsv(*out_name_sv);
914         AV *  const ocomppad_name = PL_comppad_name;
915         PAD * const ocomppad = PL_comppad;
916         PL_comppad_name = MUTABLE_AV(AvARRAY(padlist)[0]);
917         PL_comppad = MUTABLE_AV(AvARRAY(padlist)[1]);
918         PL_curpad = AvARRAY(PL_comppad);
919
920         new_offset
921             = pad_add_name_sv(new_namesv,
922                               (SvPAD_STATE(*out_name_sv) ? padadd_STATE : 0),
923                               SvPAD_TYPED(*out_name_sv)
924                               ? SvSTASH(*out_name_sv) : NULL,
925                               SvOURSTASH(*out_name_sv)
926                               );
927
928         SvFAKE_on(new_namesv);
929         DEBUG_Xv(PerlIO_printf(Perl_debug_log,
930                                "Pad addname: %ld \"%.*s\" FAKE\n",
931                                (long)new_offset,
932                                (int) SvCUR(new_namesv), SvPVX(new_namesv)));
933         PARENT_FAKELEX_FLAGS_set(new_namesv, *out_flags);
934
935         PARENT_PAD_INDEX_set(new_namesv, 0);
936         if (SvPAD_OUR(new_namesv)) {
937             NOOP;   /* do nothing */
938         }
939         else if (CvLATE(cv)) {
940             /* delayed creation - just note the offset within parent pad */
941             PARENT_PAD_INDEX_set(new_namesv, offset);
942             CvCLONE_on(cv);
943         }
944         else {
945             /* immediate creation - capture outer value right now */
946             av_store(PL_comppad, new_offset, SvREFCNT_inc(*new_capturep));
947             DEBUG_Xv(PerlIO_printf(Perl_debug_log,
948                 "Pad findlex cv=0x%"UVxf" saved captured sv 0x%"UVxf" at offset %ld\n",
949                 PTR2UV(cv), PTR2UV(*new_capturep), (long)new_offset));
950         }
951         *out_name_sv = new_namesv;
952         *out_flags = PARENT_FAKELEX_FLAGS(new_namesv);
953
954         PL_comppad_name = ocomppad_name;
955         PL_comppad = ocomppad;
956         PL_curpad = ocomppad ? AvARRAY(ocomppad) : NULL;
957     }
958     return new_offset;
959 }
960
961
962 #ifdef DEBUGGING
963 /*
964 =for apidoc pad_sv
965
966 Get the value at offset po in the current pad.
967 Use macro PAD_SV instead of calling this function directly.
968
969 =cut
970 */
971
972
973 SV *
974 Perl_pad_sv(pTHX_ PADOFFSET po)
975 {
976     dVAR;
977     ASSERT_CURPAD_ACTIVE("pad_sv");
978
979     if (!po)
980         Perl_croak(aTHX_ "panic: pad_sv po");
981     DEBUG_X(PerlIO_printf(Perl_debug_log,
982         "Pad 0x%"UVxf"[0x%"UVxf"] sv:      %ld sv=0x%"UVxf"\n",
983         PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(PL_curpad[po]))
984     );
985     return PL_curpad[po];
986 }
987
988
989 /*
990 =for apidoc pad_setsv
991
992 Set the entry at offset po in the current pad to sv.
993 Use the macro PAD_SETSV() rather than calling this function directly.
994
995 =cut
996 */
997
998 void
999 Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
1000 {
1001     dVAR;
1002
1003     PERL_ARGS_ASSERT_PAD_SETSV;
1004
1005     ASSERT_CURPAD_ACTIVE("pad_setsv");
1006
1007     DEBUG_X(PerlIO_printf(Perl_debug_log,
1008         "Pad 0x%"UVxf"[0x%"UVxf"] setsv:   %ld sv=0x%"UVxf"\n",
1009         PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(sv))
1010     );
1011     PL_curpad[po] = sv;
1012 }
1013 #endif
1014
1015
1016
1017 /*
1018 =for apidoc pad_block_start
1019
1020 Update the pad compilation state variables on entry to a new block
1021
1022 =cut
1023 */
1024
1025 /* XXX DAPM perhaps:
1026  *      - integrate this in general state-saving routine ???
1027  *      - combine with the state-saving going on in pad_new ???
1028  *      - introduce a new SAVE type that does all this in one go ?
1029  */
1030
1031 void
1032 Perl_pad_block_start(pTHX_ int full)
1033 {
1034     dVAR;
1035     ASSERT_CURPAD_ACTIVE("pad_block_start");
1036     SAVEI32(PL_comppad_name_floor);
1037     PL_comppad_name_floor = AvFILLp(PL_comppad_name);
1038     if (full)
1039         PL_comppad_name_fill = PL_comppad_name_floor;
1040     if (PL_comppad_name_floor < 0)
1041         PL_comppad_name_floor = 0;
1042     SAVEI32(PL_min_intro_pending);
1043     SAVEI32(PL_max_intro_pending);
1044     PL_min_intro_pending = 0;
1045     SAVEI32(PL_comppad_name_fill);
1046     SAVEI32(PL_padix_floor);
1047     PL_padix_floor = PL_padix;
1048     PL_pad_reset_pending = FALSE;
1049 }
1050
1051
1052 /*
1053 =for apidoc intro_my
1054
1055 "Introduce" my variables to visible status.
1056
1057 =cut
1058 */
1059
1060 U32
1061 Perl_intro_my(pTHX)
1062 {
1063     dVAR;
1064     SV **svp;
1065     I32 i;
1066
1067     ASSERT_CURPAD_ACTIVE("intro_my");
1068     if (! PL_min_intro_pending)
1069         return PL_cop_seqmax;
1070
1071     svp = AvARRAY(PL_comppad_name);
1072     for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
1073         SV * const sv = svp[i];
1074
1075         if (sv && sv != &PL_sv_undef && !SvFAKE(sv) && !COP_SEQ_RANGE_HIGH(sv)) {
1076             COP_SEQ_RANGE_HIGH_set(sv, PAD_MAX);        /* Don't know scope end yet. */
1077             COP_SEQ_RANGE_LOW_set(sv, PL_cop_seqmax);
1078             DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1079                 "Pad intromy: %ld \"%s\", (%lu,%lu)\n",
1080                 (long)i, SvPVX_const(sv),
1081                 (unsigned long)COP_SEQ_RANGE_LOW(sv),
1082                 (unsigned long)COP_SEQ_RANGE_HIGH(sv))
1083             );
1084         }
1085     }
1086     PL_min_intro_pending = 0;
1087     PL_comppad_name_fill = PL_max_intro_pending; /* Needn't search higher */
1088     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1089                 "Pad intromy: seq -> %ld\n", (long)(PL_cop_seqmax+1)));
1090
1091     return PL_cop_seqmax++;
1092 }
1093
1094 /*
1095 =for apidoc pad_leavemy
1096
1097 Cleanup at end of scope during compilation: set the max seq number for
1098 lexicals in this scope and warn of any lexicals that never got introduced.
1099
1100 =cut
1101 */
1102
1103 void
1104 Perl_pad_leavemy(pTHX)
1105 {
1106     dVAR;
1107     I32 off;
1108     SV * const * const svp = AvARRAY(PL_comppad_name);
1109
1110     PL_pad_reset_pending = FALSE;
1111
1112     ASSERT_CURPAD_ACTIVE("pad_leavemy");
1113     if (PL_min_intro_pending && PL_comppad_name_fill < PL_min_intro_pending) {
1114         for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
1115             const SV * const sv = svp[off];
1116             if (sv && sv != &PL_sv_undef && !SvFAKE(sv))
1117                 Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
1118                                  "%"SVf" never introduced",
1119                                  SVfARG(sv));
1120         }
1121     }
1122     /* "Deintroduce" my variables that are leaving with this scope. */
1123     for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_fill; off--) {
1124         const SV * const sv = svp[off];
1125         if (sv && sv != &PL_sv_undef && !SvFAKE(sv) && COP_SEQ_RANGE_HIGH(sv) == PAD_MAX) {
1126             COP_SEQ_RANGE_HIGH_set(sv, PL_cop_seqmax);
1127             DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1128                 "Pad leavemy: %ld \"%s\", (%lu,%lu)\n",
1129                 (long)off, SvPVX_const(sv),
1130                 (unsigned long)COP_SEQ_RANGE_LOW(sv),
1131                 (unsigned long)COP_SEQ_RANGE_HIGH(sv))
1132             );
1133         }
1134     }
1135     PL_cop_seqmax++;
1136     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1137             "Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax));
1138 }
1139
1140
1141 /*
1142 =for apidoc pad_swipe
1143
1144 Abandon the tmp in the current pad at offset po and replace with a
1145 new one.
1146
1147 =cut
1148 */
1149
1150 void
1151 Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
1152 {
1153     dVAR;
1154     ASSERT_CURPAD_LEGAL("pad_swipe");
1155     if (!PL_curpad)
1156         return;
1157     if (AvARRAY(PL_comppad) != PL_curpad)
1158         Perl_croak(aTHX_ "panic: pad_swipe curpad");
1159     if (!po)
1160         Perl_croak(aTHX_ "panic: pad_swipe po");
1161
1162     DEBUG_X(PerlIO_printf(Perl_debug_log,
1163                 "Pad 0x%"UVxf"[0x%"UVxf"] swipe:   %ld\n",
1164                 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po));
1165
1166     if (PL_curpad[po])
1167         SvPADTMP_off(PL_curpad[po]);
1168     if (refadjust)
1169         SvREFCNT_dec(PL_curpad[po]);
1170
1171
1172     /* if pad tmps aren't shared between ops, then there's no need to
1173      * create a new tmp when an existing op is freed */
1174 #ifdef USE_BROKEN_PAD_RESET
1175     PL_curpad[po] = newSV(0);
1176     SvPADTMP_on(PL_curpad[po]);
1177 #else
1178     PL_curpad[po] = &PL_sv_undef;
1179 #endif
1180     if ((I32)po < PL_padix)
1181         PL_padix = po - 1;
1182 }
1183
1184
1185 /*
1186 =for apidoc pad_reset
1187
1188 Mark all the current temporaries for reuse
1189
1190 =cut
1191 */
1192
1193 /* XXX pad_reset() is currently disabled because it results in serious bugs.
1194  * It causes pad temp TARGs to be shared between OPs. Since TARGs are pushed
1195  * on the stack by OPs that use them, there are several ways to get an alias
1196  * to  a shared TARG.  Such an alias will change randomly and unpredictably.
1197  * We avoid doing this until we can think of a Better Way.
1198  * GSAR 97-10-29 */
1199 static void
1200 S_pad_reset(pTHX)
1201 {
1202     dVAR;
1203 #ifdef USE_BROKEN_PAD_RESET
1204     if (AvARRAY(PL_comppad) != PL_curpad)
1205         Perl_croak(aTHX_ "panic: pad_reset curpad");
1206
1207     DEBUG_X(PerlIO_printf(Perl_debug_log,
1208             "Pad 0x%"UVxf"[0x%"UVxf"] reset:     padix %ld -> %ld",
1209             PTR2UV(PL_comppad), PTR2UV(PL_curpad),
1210                 (long)PL_padix, (long)PL_padix_floor
1211             )
1212     );
1213
1214     if (!PL_tainting) { /* Can't mix tainted and non-tainted temporaries. */
1215         register I32 po;
1216         for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
1217             if (PL_curpad[po] && !SvIMMORTAL(PL_curpad[po]))
1218                 SvPADTMP_off(PL_curpad[po]);
1219         }
1220         PL_padix = PL_padix_floor;
1221     }
1222 #endif
1223     PL_pad_reset_pending = FALSE;
1224 }
1225
1226
1227 /*
1228 =for apidoc pad_tidy
1229
1230 Tidy up a pad after we've finished compiling it:
1231     * remove most stuff from the pads of anonsub prototypes;
1232     * give it a @_;
1233     * mark tmps as such.
1234
1235 =cut
1236 */
1237
1238 /* XXX DAPM surely most of this stuff should be done properly
1239  * at the right time beforehand, rather than going around afterwards
1240  * cleaning up our mistakes ???
1241  */
1242
1243 void
1244 Perl_pad_tidy(pTHX_ padtidy_type type)
1245 {
1246     dVAR;
1247
1248     ASSERT_CURPAD_ACTIVE("pad_tidy");
1249
1250     /* If this CV has had any 'eval-capable' ops planted in it
1251      * (ie it contains eval '...', //ee, /$var/ or /(?{..})/), Then any
1252      * anon prototypes in the chain of CVs should be marked as cloneable,
1253      * so that for example the eval's CV in C<< sub { eval '$x' } >> gets
1254      * the right CvOUTSIDE.
1255      * If running with -d, *any* sub may potentially have an eval
1256      * excuted within it.
1257      */
1258
1259     if (PL_cv_has_eval || PL_perldb) {
1260         const CV *cv;
1261         for (cv = PL_compcv ;cv; cv = CvOUTSIDE(cv)) {
1262             if (cv != PL_compcv && CvCOMPILED(cv))
1263                 break; /* no need to mark already-compiled code */
1264             if (CvANON(cv)) {
1265                 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1266                     "Pad clone on cv=0x%"UVxf"\n", PTR2UV(cv)));
1267                 CvCLONE_on(cv);
1268             }
1269         }
1270     }
1271
1272     /* extend curpad to match namepad */
1273     if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
1274         av_store(PL_comppad_name, AvFILLp(PL_comppad), NULL);
1275
1276     if (type == padtidy_SUBCLONE) {
1277         SV * const * const namep = AvARRAY(PL_comppad_name);
1278         PADOFFSET ix;
1279
1280         for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1281             SV *namesv;
1282
1283             if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
1284                 continue;
1285             /*
1286              * The only things that a clonable function needs in its
1287              * pad are anonymous subs.
1288              * The rest are created anew during cloning.
1289              */
1290             if (!((namesv = namep[ix]) != NULL &&
1291                   namesv != &PL_sv_undef &&
1292                    *SvPVX_const(namesv) == '&'))
1293             {
1294                 SvREFCNT_dec(PL_curpad[ix]);
1295                 PL_curpad[ix] = NULL;
1296             }
1297         }
1298     }
1299     else if (type == padtidy_SUB) {
1300         /* XXX DAPM this same bit of code keeps appearing !!! Rationalise? */
1301         AV * const av = newAV();                        /* Will be @_ */
1302         av_extend(av, 0);
1303         av_store(PL_comppad, 0, MUTABLE_SV(av));
1304         AvREIFY_only(av);
1305     }
1306
1307     if (type == padtidy_SUB || type == padtidy_FORMAT) {
1308         PADOFFSET ix;
1309         for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1310             if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
1311                 continue;
1312             if (!SvPADMY(PL_curpad[ix]))
1313                 SvPADTMP_on(PL_curpad[ix]);
1314         }
1315     }
1316     PL_curpad = AvARRAY(PL_comppad);
1317 }
1318
1319
1320 /*
1321 =for apidoc pad_free
1322
1323 Free the SV at offset po in the current pad.
1324
1325 =cut
1326 */
1327
1328 /* XXX DAPM integrate with pad_swipe ???? */
1329 void
1330 Perl_pad_free(pTHX_ PADOFFSET po)
1331 {
1332     dVAR;
1333     ASSERT_CURPAD_LEGAL("pad_free");
1334     if (!PL_curpad)
1335         return;
1336     if (AvARRAY(PL_comppad) != PL_curpad)
1337         Perl_croak(aTHX_ "panic: pad_free curpad");
1338     if (!po)
1339         Perl_croak(aTHX_ "panic: pad_free po");
1340
1341     DEBUG_X(PerlIO_printf(Perl_debug_log,
1342             "Pad 0x%"UVxf"[0x%"UVxf"] free:    %ld\n",
1343             PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po)
1344     );
1345
1346     if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
1347         SvPADTMP_off(PL_curpad[po]);
1348 #ifdef USE_ITHREADS
1349         /* SV could be a shared hash key (eg bugid #19022) */
1350         if (!SvIsCOW(PL_curpad[po]))
1351             SvREADONLY_off(PL_curpad[po]);      /* could be a freed constant */
1352 #endif
1353     }
1354     if ((I32)po < PL_padix)
1355         PL_padix = po - 1;
1356 }
1357
1358
1359
1360 /*
1361 =for apidoc do_dump_pad
1362
1363 Dump the contents of a padlist
1364
1365 =cut
1366 */
1367
1368 void
1369 Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
1370 {
1371     dVAR;
1372     const AV *pad_name;
1373     const AV *pad;
1374     SV **pname;
1375     SV **ppad;
1376     I32 ix;
1377
1378     PERL_ARGS_ASSERT_DO_DUMP_PAD;
1379
1380     if (!padlist) {
1381         return;
1382     }
1383     pad_name = MUTABLE_AV(*av_fetch(MUTABLE_AV(padlist), 0, FALSE));
1384     pad = MUTABLE_AV(*av_fetch(MUTABLE_AV(padlist), 1, FALSE));
1385     pname = AvARRAY(pad_name);
1386     ppad = AvARRAY(pad);
1387     Perl_dump_indent(aTHX_ level, file,
1388             "PADNAME = 0x%"UVxf"(0x%"UVxf") PAD = 0x%"UVxf"(0x%"UVxf")\n",
1389             PTR2UV(pad_name), PTR2UV(pname), PTR2UV(pad), PTR2UV(ppad)
1390     );
1391
1392     for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
1393         const SV *namesv = pname[ix];
1394         if (namesv && namesv == &PL_sv_undef) {
1395             namesv = NULL;
1396         }
1397         if (namesv) {
1398             if (SvFAKE(namesv))
1399                 Perl_dump_indent(aTHX_ level+1, file,
1400                     "%2d. 0x%"UVxf"<%lu> FAKE \"%s\" flags=0x%lx index=%lu\n",
1401                     (int) ix,
1402                     PTR2UV(ppad[ix]),
1403                     (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
1404                     SvPVX_const(namesv),
1405                     (unsigned long)PARENT_FAKELEX_FLAGS(namesv),
1406                     (unsigned long)PARENT_PAD_INDEX(namesv)
1407
1408                 );
1409             else
1410                 Perl_dump_indent(aTHX_ level+1, file,
1411                     "%2d. 0x%"UVxf"<%lu> (%lu,%lu) \"%s\"\n",
1412                     (int) ix,
1413                     PTR2UV(ppad[ix]),
1414                     (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
1415                     (unsigned long)COP_SEQ_RANGE_LOW(namesv),
1416                     (unsigned long)COP_SEQ_RANGE_HIGH(namesv),
1417                     SvPVX_const(namesv)
1418                 );
1419         }
1420         else if (full) {
1421             Perl_dump_indent(aTHX_ level+1, file,
1422                 "%2d. 0x%"UVxf"<%lu>\n",
1423                 (int) ix,
1424                 PTR2UV(ppad[ix]),
1425                 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0)
1426             );
1427         }
1428     }
1429 }
1430
1431
1432
1433 /*
1434 =for apidoc cv_dump
1435
1436 dump the contents of a CV
1437
1438 =cut
1439 */
1440
1441 #ifdef DEBUGGING
1442 STATIC void
1443 S_cv_dump(pTHX_ const CV *cv, const char *title)
1444 {
1445     dVAR;
1446     const CV * const outside = CvOUTSIDE(cv);
1447     AV* const padlist = CvPADLIST(cv);
1448
1449     PERL_ARGS_ASSERT_CV_DUMP;
1450
1451     PerlIO_printf(Perl_debug_log,
1452                   "  %s: CV=0x%"UVxf" (%s), OUTSIDE=0x%"UVxf" (%s)\n",
1453                   title,
1454                   PTR2UV(cv),
1455                   (CvANON(cv) ? "ANON"
1456                    : (SvTYPE(cv) == SVt_PVFM) ? "FORMAT"
1457                    : (cv == PL_main_cv) ? "MAIN"
1458                    : CvUNIQUE(cv) ? "UNIQUE"
1459                    : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
1460                   PTR2UV(outside),
1461                   (!outside ? "null"
1462                    : CvANON(outside) ? "ANON"
1463                    : (outside == PL_main_cv) ? "MAIN"
1464                    : CvUNIQUE(outside) ? "UNIQUE"
1465                    : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
1466
1467     PerlIO_printf(Perl_debug_log,
1468                     "    PADLIST = 0x%"UVxf"\n", PTR2UV(padlist));
1469     do_dump_pad(1, Perl_debug_log, padlist, 1);
1470 }
1471 #endif /* DEBUGGING */
1472
1473
1474
1475
1476
1477 /*
1478 =for apidoc cv_clone
1479
1480 Clone a CV: make a new CV which points to the same code etc, but which
1481 has a newly-created pad built by copying the prototype pad and capturing
1482 any outer lexicals.
1483
1484 =cut
1485 */
1486
1487 CV *
1488 Perl_cv_clone(pTHX_ CV *proto)
1489 {
1490     dVAR;
1491     I32 ix;
1492     AV* const protopadlist = CvPADLIST(proto);
1493     const AV *const protopad_name = (const AV *)*av_fetch(protopadlist, 0, FALSE);
1494     const AV *const protopad = (const AV *)*av_fetch(protopadlist, 1, FALSE);
1495     SV** const pname = AvARRAY(protopad_name);
1496     SV** const ppad = AvARRAY(protopad);
1497     const I32 fname = AvFILLp(protopad_name);
1498     const I32 fpad = AvFILLp(protopad);
1499     CV* cv;
1500     SV** outpad;
1501     CV* outside;
1502     long depth;
1503
1504     PERL_ARGS_ASSERT_CV_CLONE;
1505
1506     assert(!CvUNIQUE(proto));
1507
1508     /* Since cloneable anon subs can be nested, CvOUTSIDE may point
1509      * to a prototype; we instead want the cloned parent who called us.
1510      * Note that in general for formats, CvOUTSIDE != find_runcv */
1511
1512     outside = CvOUTSIDE(proto);
1513     if (outside && CvCLONE(outside) && ! CvCLONED(outside))
1514         outside = find_runcv(NULL);
1515     depth = CvDEPTH(outside);
1516     assert(depth || SvTYPE(proto) == SVt_PVFM);
1517     if (!depth)
1518         depth = 1;
1519     assert(CvPADLIST(outside));
1520
1521     ENTER;
1522     SAVESPTR(PL_compcv);
1523
1524     cv = PL_compcv = MUTABLE_CV(newSV_type(SvTYPE(proto)));
1525     CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE);
1526     CvCLONED_on(cv);
1527
1528 #ifdef USE_ITHREADS
1529     CvFILE(cv)          = CvISXSUB(proto) ? CvFILE(proto)
1530                                           : savepv(CvFILE(proto));
1531 #else
1532     CvFILE(cv)          = CvFILE(proto);
1533 #endif
1534     CvGV(cv)            = CvGV(proto);
1535     CvSTASH(cv)         = CvSTASH(proto);
1536     OP_REFCNT_LOCK;
1537     CvROOT(cv)          = OpREFCNT_inc(CvROOT(proto));
1538     OP_REFCNT_UNLOCK;
1539     CvSTART(cv)         = CvSTART(proto);
1540     CvOUTSIDE(cv)       = MUTABLE_CV(SvREFCNT_inc_simple(outside));
1541     CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
1542
1543     if (SvPOK(proto))
1544         sv_setpvn(MUTABLE_SV(cv), SvPVX_const(proto), SvCUR(proto));
1545
1546     CvPADLIST(cv) = pad_new(padnew_CLONE|padnew_SAVE);
1547
1548     av_fill(PL_comppad, fpad);
1549     for (ix = fname; ix >= 0; ix--)
1550         av_store(PL_comppad_name, ix, SvREFCNT_inc(pname[ix]));
1551
1552     PL_curpad = AvARRAY(PL_comppad);
1553
1554     outpad = AvARRAY(AvARRAY(CvPADLIST(outside))[depth]);
1555
1556     for (ix = fpad; ix > 0; ix--) {
1557         SV* const namesv = (ix <= fname) ? pname[ix] : NULL;
1558         SV *sv = NULL;
1559         if (namesv && namesv != &PL_sv_undef) { /* lexical */
1560             if (SvFAKE(namesv)) {   /* lexical from outside? */
1561                 sv = outpad[PARENT_PAD_INDEX(namesv)];
1562                 assert(sv);
1563                 /* formats may have an inactive parent,
1564                    while my $x if $false can leave an active var marked as
1565                    stale. And state vars are always available */
1566                 if (SvPADSTALE(sv) && !SvPAD_STATE(namesv)) {
1567                     Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
1568                                    "Variable \"%s\" is not available", SvPVX_const(namesv));
1569                     sv = NULL;
1570                 }
1571                 else 
1572                     SvREFCNT_inc_simple_void_NN(sv);
1573             }
1574             if (!sv) {
1575                 const char sigil = SvPVX_const(namesv)[0];
1576                 if (sigil == '&')
1577                     sv = SvREFCNT_inc(ppad[ix]);
1578                 else if (sigil == '@')
1579                     sv = MUTABLE_SV(newAV());
1580                 else if (sigil == '%')
1581                     sv = MUTABLE_SV(newHV());
1582                 else
1583                     sv = newSV(0);
1584                 SvPADMY_on(sv);
1585                 /* reset the 'assign only once' flag on each state var */
1586                 if (SvPAD_STATE(namesv))
1587                     SvPADSTALE_on(sv);
1588             }
1589         }
1590         else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) {
1591             sv = SvREFCNT_inc_NN(ppad[ix]);
1592         }
1593         else {
1594             sv = newSV(0);
1595             SvPADTMP_on(sv);
1596         }
1597         PL_curpad[ix] = sv;
1598     }
1599
1600     DEBUG_Xv(
1601         PerlIO_printf(Perl_debug_log, "\nPad CV clone\n");
1602         cv_dump(outside, "Outside");
1603         cv_dump(proto,   "Proto");
1604         cv_dump(cv,      "To");
1605     );
1606
1607     LEAVE;
1608
1609     if (CvCONST(cv)) {
1610         /* Constant sub () { $x } closing over $x - see lib/constant.pm:
1611          * The prototype was marked as a candiate for const-ization,
1612          * so try to grab the current const value, and if successful,
1613          * turn into a const sub:
1614          */
1615         SV* const const_sv = op_const_sv(CvSTART(cv), cv);
1616         if (const_sv) {
1617             SvREFCNT_dec(cv);
1618             cv = newCONSTSUB(CvSTASH(proto), NULL, const_sv);
1619         }
1620         else {
1621             CvCONST_off(cv);
1622         }
1623     }
1624
1625     return cv;
1626 }
1627
1628
1629 /*
1630 =for apidoc pad_fixup_inner_anons
1631
1632 For any anon CVs in the pad, change CvOUTSIDE of that CV from
1633 old_cv to new_cv if necessary. Needed when a newly-compiled CV has to be
1634 moved to a pre-existing CV struct.
1635
1636 =cut
1637 */
1638
1639 void
1640 Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
1641 {
1642     dVAR;
1643     I32 ix;
1644     AV * const comppad_name = MUTABLE_AV(AvARRAY(padlist)[0]);
1645     AV * const comppad = MUTABLE_AV(AvARRAY(padlist)[1]);
1646     SV ** const namepad = AvARRAY(comppad_name);
1647     SV ** const curpad = AvARRAY(comppad);
1648
1649     PERL_ARGS_ASSERT_PAD_FIXUP_INNER_ANONS;
1650     PERL_UNUSED_ARG(old_cv);
1651
1652     for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
1653         const SV * const namesv = namepad[ix];
1654         if (namesv && namesv != &PL_sv_undef
1655             && *SvPVX_const(namesv) == '&')
1656         {
1657             CV * const innercv = MUTABLE_CV(curpad[ix]);
1658             assert(CvWEAKOUTSIDE(innercv));
1659             assert(CvOUTSIDE(innercv) == old_cv);
1660             CvOUTSIDE(innercv) = new_cv;
1661         }
1662     }
1663 }
1664
1665
1666 /*
1667 =for apidoc pad_push
1668
1669 Push a new pad frame onto the padlist, unless there's already a pad at
1670 this depth, in which case don't bother creating a new one.  Then give
1671 the new pad an @_ in slot zero.
1672
1673 =cut
1674 */
1675
1676 void
1677 Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
1678 {
1679     dVAR;
1680
1681     PERL_ARGS_ASSERT_PAD_PUSH;
1682
1683     if (depth > AvFILLp(padlist)) {
1684         SV** const svp = AvARRAY(padlist);
1685         AV* const newpad = newAV();
1686         SV** const oldpad = AvARRAY(svp[depth-1]);
1687         I32 ix = AvFILLp((const AV *)svp[1]);
1688         const I32 names_fill = AvFILLp((const AV *)svp[0]);
1689         SV** const names = AvARRAY(svp[0]);
1690         AV *av;
1691
1692         for ( ;ix > 0; ix--) {
1693             if (names_fill >= ix && names[ix] != &PL_sv_undef) {
1694                 const char sigil = SvPVX_const(names[ix])[0];
1695                 if ((SvFLAGS(names[ix]) & SVf_FAKE)
1696                         || (SvFLAGS(names[ix]) & SVpad_STATE)
1697                         || sigil == '&')
1698                 {
1699                     /* outer lexical or anon code */
1700                     av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]));
1701                 }
1702                 else {          /* our own lexical */
1703                     SV *sv; 
1704                     if (sigil == '@')
1705                         sv = MUTABLE_SV(newAV());
1706                     else if (sigil == '%')
1707                         sv = MUTABLE_SV(newHV());
1708                     else
1709                         sv = newSV(0);
1710                     av_store(newpad, ix, sv);
1711                     SvPADMY_on(sv);
1712                 }
1713             }
1714             else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
1715                 av_store(newpad, ix, SvREFCNT_inc_NN(oldpad[ix]));
1716             }
1717             else {
1718                 /* save temporaries on recursion? */
1719                 SV * const sv = newSV(0);
1720                 av_store(newpad, ix, sv);
1721                 SvPADTMP_on(sv);
1722             }
1723         }
1724         av = newAV();
1725         av_extend(av, 0);
1726         av_store(newpad, 0, MUTABLE_SV(av));
1727         AvREIFY_only(av);
1728
1729         av_store(padlist, depth, MUTABLE_SV(newpad));
1730         AvFILLp(padlist) = depth;
1731     }
1732 }
1733
1734
1735 HV *
1736 Perl_pad_compname_type(pTHX_ const PADOFFSET po)
1737 {
1738     dVAR;
1739     SV* const * const av = av_fetch(PL_comppad_name, po, FALSE);
1740     if ( SvPAD_TYPED(*av) ) {
1741         return SvSTASH(*av);
1742     }
1743     return NULL;
1744 }
1745
1746 #if defined(USE_ITHREADS)
1747
1748 #  define av_dup_inc(s,t)       MUTABLE_AV(sv_dup_inc((const SV *)s,t))
1749
1750 AV *
1751 Perl_padlist_dup(pTHX_ AV *const srcpad, CLONE_PARAMS *const param)
1752 {
1753     AV *dstpad;
1754     PERL_ARGS_ASSERT_PADLIST_DUP;
1755
1756     if (!srcpad)
1757         return NULL;
1758
1759     assert(!AvREAL(srcpad));
1760
1761     if (param->flags & CLONEf_COPY_STACKS
1762         || SvREFCNT(AvARRAY(srcpad)[1]) > 1) {
1763         /* XXX padlists are real, but pretend to be not */
1764         AvREAL_on(srcpad);
1765         dstpad = av_dup_inc(srcpad, param);
1766         AvREAL_off(srcpad);
1767         AvREAL_off(dstpad);
1768         assert (SvREFCNT(AvARRAY(srcpad)[1]) == 1);
1769     } else {
1770         /* CvDEPTH() on our subroutine will be set to 0, so there's no need
1771            to build anything other than the first level of pads.  */
1772
1773         I32 ix = AvFILLp((const AV *)AvARRAY(srcpad)[1]);
1774         AV *pad1;
1775         const I32 names_fill = AvFILLp((const AV *)(AvARRAY(srcpad)[0]));
1776         const AV *const srcpad1 = (const AV *) AvARRAY(srcpad)[1];
1777         SV **oldpad = AvARRAY(srcpad1);
1778         SV **names;
1779         SV **pad1a;
1780         AV *args;
1781         /* look for it in the table first.
1782            I *think* that it shouldn't be possible to find it there.
1783            Well, except for how Perl_sv_compile_2op() "works" :-(   */
1784         dstpad = (AV*)ptr_table_fetch(PL_ptr_table, srcpad);
1785
1786         if (dstpad)
1787             return dstpad;
1788
1789         dstpad = newAV();
1790         ptr_table_store(PL_ptr_table, srcpad, dstpad);
1791         AvREAL_off(dstpad);
1792         av_extend(dstpad, 1);
1793         AvARRAY(dstpad)[0] = MUTABLE_SV(av_dup_inc(AvARRAY(srcpad)[0], param));
1794         names = AvARRAY(AvARRAY(dstpad)[0]);
1795
1796         pad1 = newAV();
1797
1798         av_extend(pad1, ix);
1799         AvARRAY(dstpad)[1] = MUTABLE_SV(pad1);
1800         pad1a = AvARRAY(pad1);
1801         AvFILLp(dstpad) = 1;
1802
1803         if (ix > -1) {
1804             AvFILLp(pad1) = ix;
1805
1806             for ( ;ix > 0; ix--) {
1807                 if (!oldpad[ix]) {
1808                     pad1a[ix] = NULL;
1809                 } else if (names_fill >= ix && names[ix] != &PL_sv_undef) {
1810                     const char sigil = SvPVX_const(names[ix])[0];
1811                     if ((SvFLAGS(names[ix]) & SVf_FAKE)
1812                         || (SvFLAGS(names[ix]) & SVpad_STATE)
1813                         || sigil == '&')
1814                         {
1815                             /* outer lexical or anon code */
1816                             pad1a[ix] = sv_dup_inc(oldpad[ix], param);
1817                         }
1818                     else {              /* our own lexical */
1819                         if(SvREFCNT(oldpad[ix]) > 1) {
1820                             pad1a[ix] = sv_dup_inc(oldpad[ix], param);
1821                         } else {
1822                             SV *sv; 
1823                             
1824                             if (sigil == '@')
1825                                 sv = MUTABLE_SV(newAV());
1826                             else if (sigil == '%')
1827                                 sv = MUTABLE_SV(newHV());
1828                             else
1829                                 sv = newSV(0);
1830                             pad1a[ix] = sv;
1831                             SvPADMY_on(sv);
1832                         }
1833                     }
1834                 }
1835                 else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
1836                     pad1a[ix] = sv_dup_inc(oldpad[ix], param);
1837                 }
1838                 else {
1839                     /* save temporaries on recursion? */
1840                     SV * const sv = newSV(0);
1841                     pad1a[ix] = sv;
1842
1843                     /* SvREFCNT(oldpad[ix]) != 1 for some code in threads.xs
1844                        FIXTHAT before merging this branch.
1845                        (And I know how to) */
1846                     if (SvPADMY(oldpad[ix]))
1847                         SvPADMY_on(sv);
1848                     else
1849                         SvPADTMP_on(sv);
1850                 }
1851             }
1852
1853             if (oldpad[0]) {
1854                 args = newAV();                 /* Will be @_ */
1855                 AvREIFY_only(args);
1856                 pad1a[0] = (SV *)args;
1857             }
1858         }
1859     }
1860
1861     return dstpad;
1862 }
1863
1864 #endif
1865
1866 /*
1867  * Local variables:
1868  * c-indentation-style: bsd
1869  * c-basic-offset: 4
1870  * indent-tabs-mode: t
1871  * End:
1872  *
1873  * ex: set ts=8 sts=4 sw=4 noet:
1874  */