This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
e1ac0676725beee254ca8b2474d5b1a71df2749a
[perl5.git] / pad.c
1 /*    pad.c
2  *
3  *    Copyright (c) 2002, Larry Wall
4  *
5  *    You may distribute under the terms of either the GNU General Public
6  *    License or the Artistic License, as specified in the README file.
7  *
8  *  "Anyway: there was this Mr Frodo left an orphan and stranded, as you
9  *  might say, among those queer Bucklanders, being brought up anyhow in
10  *  Brandy Hall. A regular warren, by all accounts. Old Master Gorbadoc
11  *  never had fewer than a couple of hundred relations in the place. Mr
12  *  Bilbo never did a kinder deed than when he brought the lad back to
13  *  live among decent folk." --the Gaffer
14  */
15
16 /* XXX DAPM
17  * As of Sept 2002, this file is new and may be in a state of flux for
18  * a while. I've marked things I intent to come back and look at further
19  * with an 'XXX DAPM' comment.
20  */
21
22 /*
23 =head1 Pad Data Structures
24
25 =for apidoc m|AV *|CvPADLIST|CV *cv
26 CV's can have CvPADLIST(cv) set to point to an AV.
27
28 For these purposes "forms" are a kind-of CV, eval""s are too (except they're
29 not callable at will and are always thrown away after the eval"" is done
30 executing).
31
32 XSUBs don't have CvPADLIST set - dXSTARG fetches values from PL_curpad,
33 but that is really the callers pad (a slot of which is allocated by
34 every entersub).
35
36 The CvPADLIST AV has does not have AvREAL set, so REFCNT of component items
37 is managed "manual" (mostly in pad.c) rather than normal av.c rules.
38 The items in the AV are not SVs as for a normal AV, but other AVs:
39
40 0'th Entry of the CvPADLIST is an AV which represents the "names" or rather
41 the "static type information" for lexicals.
42
43 The CvDEPTH'th entry of CvPADLIST AV is an AV which is the stack frame at that
44 depth of recursion into the CV.
45 The 0'th slot of a frame AV is an AV which is @_.
46 other entries are storage for variables and op targets.
47
48 During compilation:
49 C<PL_comppad_name> is set the the the names AV.
50 C<PL_comppad> is set the the frame AV for the frame CvDEPTH == 1.
51 C<PL_curpad> is set the body of the frame AV (i.e. AvARRAY(PL_comppad)).
52
53 During execution, C<PL_comppad> and C<PL_curpad> refer to the live
54 frame of the currently executing sub.
55
56 Iterating over the names AV iterates over all possible pad
57 items. Pad slots that are SVs_PADTMP (targets/GVs/constants) end up having
58 &PL_sv_undef "names" (see pad_alloc()).
59
60 Only my/our variable (SVs_PADMY/SVs_PADOUR) slots get valid names.
61 The rest are op targets/GVs/constants which are statically allocated
62 or resolved at compile time.  These don't have names by which they
63 can be looked up from Perl code at run time through eval"" like
64 my/our variables can be.  Since they can't be looked up by "name"
65 but only by their index allocated at compile time (which is usually
66 in PL_op->op_targ), wasting a name SV for them doesn't make sense.
67
68 The SVs in the names AV have their PV being the name of the variable.
69 NV+1..IV inclusive is a range of cop_seq numbers for which the name is
70 valid.  For typed lexicals name SV is SVt_PVMG and SvSTASH points at the
71 type.  For C<our> lexicals, the type is SVt_PVGV, and GvSTASH points at the
72 stash of the associated global (so that duplicate C<our> delarations in the
73 same package can be detected).  SvCUR is sometimes hijacked to
74 store the generation number during compilation.
75
76 If SvFAKE is set on the name SV then slot in the frame AVs are
77 a REFCNT'ed references to a lexical from "outside". In this case,
78 the name SV does not have a cop_seq range, since it is in scope
79 throughout.
80
81 If the 'name' is '&' the the corresponding entry in frame AV
82 is a CV representing a possible closure.
83 (SvFAKE and name of '&' is not a meaningful combination currently but could
84 become so if C<my sub foo {}> is implemented.)
85
86 =cut
87 */
88
89
90 #include "EXTERN.h"
91 #define PERL_IN_PAD_C
92 #include "perl.h"
93
94
95 #define PAD_MAX 999999999
96
97
98
99 /*
100 =for apidoc pad_new
101
102 Create a new compiling padlist, saving and updating the various global
103 vars at the same time as creating the pad itself. The following flags
104 can be OR'ed together:
105
106     padnew_CLONE        this pad is for a cloned CV
107     padnew_SAVE         save old globals
108     padnew_SAVESUB      also save extra stuff for start of sub
109
110 =cut
111 */
112
113 PADLIST *
114 Perl_pad_new(pTHX_ padnew_flags flags)
115 {
116     AV *padlist, *padname, *pad, *a0;
117
118     ASSERT_CURPAD_LEGAL("pad_new");
119
120     /* XXX DAPM really need a new SAVEt_PAD which restores all or most
121      * vars (based on flags) rather than storing vals + addresses for
122      * each individually. Also see pad_block_start.
123      * XXX DAPM Try to see whether all these conditionals are required
124      */
125
126     /* save existing state, ... */
127
128     if (flags & padnew_SAVE) {
129         SAVECOMPPAD();
130         SAVESPTR(PL_comppad_name);
131         if (! (flags & padnew_CLONE)) {
132             SAVEI32(PL_padix);
133             SAVEI32(PL_comppad_name_fill);
134             SAVEI32(PL_min_intro_pending);
135             SAVEI32(PL_max_intro_pending);
136             if (flags & padnew_SAVESUB) {
137                 SAVEI32(PL_pad_reset_pending);
138             }
139         }
140     }
141     /* XXX DAPM interestingly, PL_comppad_name_floor never seems to be
142      * saved - check at some pt that this is okay */
143
144     /* ... create new pad ... */
145
146     padlist     = newAV();
147     padname     = newAV();
148     pad         = newAV();
149
150     if (flags & padnew_CLONE) {
151         /* XXX DAPM  I dont know why cv_clone needs it
152          * doing differently yet - perhaps this separate branch can be
153          * dispensed with eventually ???
154          */
155
156         a0 = newAV();                   /* will be @_ */
157         av_extend(a0, 0);
158         av_store(pad, 0, (SV*)a0);
159         AvFLAGS(a0) = AVf_REIFY;
160     }
161     else {
162         av_store(pad, 0, Nullsv);
163     }
164
165     AvREAL_off(padlist);
166     av_store(padlist, 0, (SV*)padname);
167     av_store(padlist, 1, (SV*)pad);
168
169     /* ... then update state variables */
170
171     PL_comppad_name     = (AV*)(*av_fetch(padlist, 0, FALSE));
172     PL_comppad          = (AV*)(*av_fetch(padlist, 1, FALSE));
173     PL_curpad           = AvARRAY(PL_comppad);
174
175     if (! (flags & padnew_CLONE)) {
176         PL_comppad_name_fill = 0;
177         PL_min_intro_pending = 0;
178         PL_padix             = 0;
179     }
180
181     DEBUG_X(PerlIO_printf(Perl_debug_log,
182           "Pad 0x%"UVxf"[0x%"UVxf"] new:       padlist=0x%"UVxf
183               " name=0x%"UVxf" flags=0x%"UVxf"\n",
184           PTR2UV(PL_comppad), PTR2UV(PL_curpad), PTR2UV(padlist),
185               PTR2UV(padname), (UV)flags
186         )
187     );
188
189     return (PADLIST*)padlist;
190 }
191
192 /*
193 =for apidoc pad_undef
194
195 Free the padlist associated with a CV.
196 If parts of it happen to be current, we null the relevant
197 PL_*pad* global vars so that we don't have any dangling references left.
198 We also repoint the CvOUTSIDE of any about-to-be-orphaned
199 inner subs to the outer of this cv.
200
201 =cut
202 */
203
204 void
205 Perl_pad_undef(pTHX_ CV* cv)
206 {
207     I32 ix;
208     PADLIST *padlist = CvPADLIST(cv);
209
210     if (!padlist)
211         return;
212     if (!SvREFCNT(CvPADLIST(cv))) /* may be during global destruction */
213         return;
214
215     DEBUG_X(PerlIO_printf(Perl_debug_log,
216           "Pad undef: padlist=0x%"UVxf"\n" , PTR2UV(padlist))
217     );
218
219     /* pads may be cleared out already during global destruction */
220     if ((CvEVAL(cv) && !CvGV(cv) /* is this eval"" ? */
221             && !PL_dirty) || CvSPECIAL(cv))
222     {
223         CV *outercv = CvOUTSIDE(cv);
224         U32 seq     = CvOUTSIDE_SEQ(cv);
225         /* XXX DAPM the following code is very similar to
226          * pad_fixup_inner_anons(). Merge??? */
227
228         /* inner references to eval's/BEGIN's/etc cv must be fixed up */
229         AV *comppad_name = (AV*)AvARRAY(padlist)[0];
230         SV **namepad = AvARRAY(comppad_name);
231         AV *comppad = (AV*)AvARRAY(padlist)[1];
232         SV **curpad = AvARRAY(comppad);
233         for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
234             SV *namesv = namepad[ix];
235             if (namesv && namesv != &PL_sv_undef
236                 && *SvPVX(namesv) == '&'
237                 && ix <= AvFILLp(comppad))
238             {
239                 CV *innercv = (CV*)curpad[ix];
240                 if (innercv && SvTYPE(innercv) == SVt_PVCV
241                     && CvOUTSIDE(innercv) == cv)
242                 {
243                     CvOUTSIDE(innercv) = outercv;
244                     CvOUTSIDE_SEQ(innercv) = seq;
245                     /* anon prototypes aren't refcounted */
246                     if (!CvANON(innercv) || CvCLONED(innercv)) {
247                         (void)SvREFCNT_inc(outercv);
248                         if (SvREFCNT(cv))
249                             SvREFCNT_dec(cv);
250                     }
251                 }
252             }
253         }
254     }
255     ix = AvFILLp(padlist);
256     while (ix >= 0) {
257         SV* sv = AvARRAY(padlist)[ix--];
258         if (!sv)
259             continue;
260         if (sv == (SV*)PL_comppad_name)
261             PL_comppad_name = Nullav;
262         else if (sv == (SV*)PL_comppad) {
263             PL_comppad = Null(PAD*);
264             PL_curpad = Null(SV**);
265         }
266         SvREFCNT_dec(sv);
267     }
268     SvREFCNT_dec((SV*)CvPADLIST(cv));
269     CvPADLIST(cv) = Null(PADLIST*);
270 }
271
272
273
274
275 /*
276 =for apidoc pad_add_name
277
278 Create a new name in the current pad at the specified offset.
279 If C<typestash> is valid, the name is for a typed lexical; set the
280 name's stash to that value.
281 If C<ourstash> is valid, it's an our lexical, set the name's
282 GvSTASH to that value
283
284 Also, if the name is @.. or %.., create a new array or hash for that slot
285
286 If fake, it means we're cloning an existing entry
287
288 =cut
289 */
290
291 /*
292  * XXX DAPM this doesn't seem the right place to create a new array/hash.
293  * Whatever we do, we should be consistent - create scalars too, and
294  * create even if fake. Really need to integrate better the whole entry
295  * creation business - when + where does the name and value get created?
296  */
297
298 PADOFFSET
299 Perl_pad_add_name(pTHX_ char *name, HV* typestash, HV* ourstash, bool fake)
300 {
301     PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
302     SV* namesv = NEWSV(1102, 0);
303
304     ASSERT_CURPAD_ACTIVE("pad_add_name");
305
306
307     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
308           "Pad addname: %ld \"%s\"%s\n",
309            (long)offset, name, (fake ? " FAKE" : "")
310           )
311     );
312
313     sv_upgrade(namesv, ourstash ? SVt_PVGV : typestash ? SVt_PVMG : SVt_PVNV);
314     sv_setpv(namesv, name);
315
316     if (typestash) {
317         SvFLAGS(namesv) |= SVpad_TYPED;
318         SvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*) typestash);
319     }
320     if (ourstash) {
321         SvFLAGS(namesv) |= SVpad_OUR;
322         GvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*) ourstash);
323     }
324
325     av_store(PL_comppad_name, offset, namesv);
326     if (fake)
327         SvFAKE_on(namesv);
328     else {
329         /* not yet introduced */
330         SvNVX(namesv) = (NV)PAD_MAX;    /* min */
331         SvIVX(namesv) = 0;              /* max */
332
333         if (!PL_min_intro_pending)
334             PL_min_intro_pending = offset;
335         PL_max_intro_pending = offset;
336         /* XXX DAPM since slot has been allocated, replace
337          * av_store with PL_curpad[offset] ? */
338         if (*name == '@')
339             av_store(PL_comppad, offset, (SV*)newAV());
340         else if (*name == '%')
341             av_store(PL_comppad, offset, (SV*)newHV());
342         SvPADMY_on(PL_curpad[offset]);
343     }
344
345     return offset;
346 }
347
348
349
350
351 /*
352 =for apidoc pad_alloc
353
354 Allocate a new my or tmp pad entry. For a my, simply push a null SV onto
355 the end of PL_comppad, but for a tmp, scan the pad from PL_padix upwards
356 for a slot which has no name and and no active value.
357
358 =cut
359 */
360
361 /* XXX DAPM integrate alloc(), add_name() and add_anon(),
362  * or at least rationalise ??? */
363
364
365 PADOFFSET
366 Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
367 {
368     SV *sv;
369     I32 retval;
370
371     ASSERT_CURPAD_ACTIVE("pad_alloc");
372
373     if (AvARRAY(PL_comppad) != PL_curpad)
374         Perl_croak(aTHX_ "panic: pad_alloc");
375     if (PL_pad_reset_pending)
376         pad_reset();
377     if (tmptype & SVs_PADMY) {
378         do {
379             sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE);
380         } while (SvPADBUSY(sv));                /* need a fresh one */
381         retval = AvFILLp(PL_comppad);
382     }
383     else {
384         SV **names = AvARRAY(PL_comppad_name);
385         SSize_t names_fill = AvFILLp(PL_comppad_name);
386         for (;;) {
387             /*
388              * "foreach" index vars temporarily become aliases to non-"my"
389              * values.  Thus we must skip, not just pad values that are
390              * marked as current pad values, but also those with names.
391              */
392             /* HVDS why copy to sv here? we don't seem to use it */
393             if (++PL_padix <= names_fill &&
394                    (sv = names[PL_padix]) && sv != &PL_sv_undef)
395                 continue;
396             sv = *av_fetch(PL_comppad, PL_padix, TRUE);
397             if (!(SvFLAGS(sv) & (SVs_PADTMP | SVs_PADMY)) &&
398                 !IS_PADGV(sv) && !IS_PADCONST(sv))
399                 break;
400         }
401         retval = PL_padix;
402     }
403     SvFLAGS(sv) |= tmptype;
404     PL_curpad = AvARRAY(PL_comppad);
405
406     DEBUG_X(PerlIO_printf(Perl_debug_log,
407           "Pad 0x%"UVxf"[0x%"UVxf"] alloc:   %ld for %s\n",
408           PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long) retval,
409           PL_op_name[optype]));
410     return (PADOFFSET)retval;
411 }
412
413 /*
414 =for apidoc pad_add_anon
415
416 Add an anon code entry to the current compiling pad
417
418 =cut
419 */
420
421 PADOFFSET
422 Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
423 {
424     PADOFFSET ix;
425     SV* name;
426
427     name = NEWSV(1106, 0);
428     sv_upgrade(name, SVt_PVNV);
429     sv_setpvn(name, "&", 1);
430     SvIVX(name) = -1;
431     SvNVX(name) = 1;
432     ix = pad_alloc(op_type, SVs_PADMY);
433     av_store(PL_comppad_name, ix, name);
434     /* XXX DAPM use PL_curpad[] ? */
435     av_store(PL_comppad, ix, sv);
436     SvPADMY_on(sv);
437     return ix;
438 }
439
440
441
442 /*
443 =for apidoc pad_check_dup
444
445 Check for duplicate declarations: report any of:
446      * a my in the current scope with the same name;
447      * an our (anywhere in the pad) with the same name and the same stash
448        as C<ourstash>
449 C<is_our> indicates that the name to check is an 'our' declaration
450
451 =cut
452 */
453
454 /* XXX DAPM integrate this into pad_add_name ??? */
455
456 void
457 Perl_pad_check_dup(pTHX_ char *name, bool is_our, HV *ourstash)
458 {
459     SV          **svp, *sv;
460     PADOFFSET   top, off;
461
462     ASSERT_CURPAD_ACTIVE("pad_check_dup");
463     if (!ckWARN(WARN_MISC) || AvFILLp(PL_comppad_name) < 0)
464         return; /* nothing to check */
465
466     svp = AvARRAY(PL_comppad_name);
467     top = AvFILLp(PL_comppad_name);
468     /* check the current scope */
469     /* XXX DAPM - why the (I32) cast - shouldn't we ensure they're the same
470      * type ? */
471     for (off = top; (I32)off > PL_comppad_name_floor; off--) {
472         if ((sv = svp[off])
473             && sv != &PL_sv_undef
474             && !SvFAKE(sv)
475             && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
476             && (!is_our
477                 || ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash))
478             && strEQ(name, SvPVX(sv)))
479         {
480             Perl_warner(aTHX_ packWARN(WARN_MISC),
481                 "\"%s\" variable %s masks earlier declaration in same %s",
482                 (is_our ? "our" : "my"),
483                 name,
484                 (SvIVX(sv) == PAD_MAX ? "scope" : "statement"));
485             --off;
486             break;
487         }
488     }
489     /* check the rest of the pad */
490     if (is_our) {
491         do {
492             if ((sv = svp[off])
493                 && sv != &PL_sv_undef
494                 && !SvFAKE(sv)
495                 && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
496                 && ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash)
497                 && strEQ(name, SvPVX(sv)))
498             {
499                 Perl_warner(aTHX_ packWARN(WARN_MISC),
500                     "\"our\" variable %s redeclared", name);
501                 Perl_warner(aTHX_ packWARN(WARN_MISC),
502                     "\t(Did you mean \"local\" instead of \"our\"?)\n");
503                 break;
504             }
505         } while ( off-- > 0 );
506     }
507 }
508
509
510
511 /*
512 =for apidoc pad_findmy
513
514 Given a lexical name, try to find its offset, first in the current pad,
515 or failing that, in the pads of any lexically enclosing subs (including
516 the complications introduced by eval). If the name is found in an outer pad,
517 then a fake entry is added to the current pad.
518 Returns the offset in the current pad, or NOT_IN_PAD on failure.
519
520 =cut
521 */
522
523 PADOFFSET
524 Perl_pad_findmy(pTHX_ char *name)
525 {
526     I32 off;
527     I32 fake_off = 0;
528     SV *sv;
529     SV **svp = AvARRAY(PL_comppad_name);
530     U32 seq = PL_cop_seqmax;
531
532     ASSERT_CURPAD_ACTIVE("pad_findmy");
533     DEBUG_Xv(PerlIO_printf(Perl_debug_log, "Pad findmy:  \"%s\"\n", name));
534
535     /* The one we're looking for is probably just before comppad_name_fill. */
536     for (off = AvFILLp(PL_comppad_name); off > 0; off--) {
537         sv = svp[off];
538         if (!sv || sv == &PL_sv_undef || !strEQ(SvPVX(sv), name))
539             continue;
540         if (SvFAKE(sv)) {
541             /* we'll use this later if we don't find a real entry */
542             fake_off = off;
543             continue;
544         }
545         else {
546             if (
547                    (   seq >  (U32)I_32(SvNVX(sv))      /* min */
548                     && seq <= (U32)SvIVX(sv))           /* max */
549                 ||
550                     /* 'our' is visible before introduction */
551                     (!SvIVX(sv) && (SvFLAGS(sv) & SVpad_OUR))
552             )
553                 return off;
554         }
555     }
556     if (fake_off)
557         return fake_off;
558
559     /* See if it's in a nested scope */
560     off = pad_findlex(name, 0, PL_compcv);
561     if (!off)                   /* pad_findlex returns 0 for failure...*/
562         return NOT_IN_PAD;      /* ...but we return NOT_IN_PAD for failure */
563
564     return off;
565 }
566
567
568
569 /*
570 =for apidoc pad_findlex
571
572 Find a named lexical anywhere in a chain of nested pads. Add fake entries
573 in the inner pads if it's found in an outer one. innercv is the CV *inside*
574 the chain of outer CVs to be searched. If newoff is non-null, this is a
575 run-time cloning: don't add fake entries, just find the lexical and add a
576 ref to it at newoff in the current pad.
577
578 =cut
579 */
580
581 STATIC PADOFFSET
582 S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, CV* innercv)
583 {
584     CV *cv;
585     I32 off = 0;
586     SV *sv;
587     CV* startcv;
588     U32 seq;
589     I32 depth;
590     AV *oldpad;
591     SV *oldsv;
592     AV *curlist;
593
594     ASSERT_CURPAD_ACTIVE("pad_findlex");
595     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
596         "Pad findlex: \"%s\" off=%ld startcv=0x%"UVxf"\n",
597             name, (long)newoff, PTR2UV(innercv))
598     );
599
600     seq = CvOUTSIDE_SEQ(innercv);
601     startcv = CvOUTSIDE(innercv);
602
603     for (cv = startcv; cv; seq = CvOUTSIDE_SEQ(cv), cv = CvOUTSIDE(cv)) {
604         SV **svp;
605         AV *curname;
606         I32 fake_off = 0;
607
608         DEBUG_Xv(PerlIO_printf(Perl_debug_log,
609             "             searching: cv=0x%"UVxf" seq=%d\n",
610             PTR2UV(cv), (int) seq )
611         );
612
613         curlist = CvPADLIST(cv);
614         svp = av_fetch(curlist, 0, FALSE);
615         if (!svp || *svp == &PL_sv_undef)
616             continue;
617         curname = (AV*)*svp;
618         svp = AvARRAY(curname);
619
620         depth = CvDEPTH(cv);
621         for (off = AvFILLp(curname); off > 0; off--) {
622             sv = svp[off];
623             if (!sv || sv == &PL_sv_undef || !strEQ(SvPVX(sv), name))
624                 continue;
625             if (SvFAKE(sv)) {
626                 /* we'll use this later if we don't find a real entry */
627                 fake_off = off;
628                 continue;
629             }
630             else {
631                 if (   seq >  (U32)I_32(SvNVX(sv))      /* min */
632                     && seq <= (U32)SvIVX(sv)            /* max */
633                     && !(newoff && !depth) /* ignore inactive when cloning */
634                 )
635                     goto found;
636             }
637         }
638
639         /* no real entry - but did we find a fake one? */
640         if (fake_off) {
641             if (newoff && !depth)
642                 return 0; /* don't clone from inactive stack frame */
643             off = fake_off;
644             sv = svp[off];
645             goto found;
646         }
647     }
648     return 0;
649
650 found:
651
652     if (!depth) 
653         depth = 1;
654
655     oldpad = (AV*)AvARRAY(curlist)[depth];
656     oldsv = *av_fetch(oldpad, off, TRUE);
657
658 #ifdef DEBUGGING
659     if (SvFAKE(sv))
660         DEBUG_Xv(PerlIO_printf(Perl_debug_log,
661                 "             matched:   offset %ld"
662                     " FAKE, sv=0x%"UVxf"\n",
663                 (long)off,
664                 PTR2UV(oldsv)
665             )
666         );
667     else
668         DEBUG_Xv(PerlIO_printf(Perl_debug_log,
669                 "             matched:   offset %ld"
670                     " (%lu,%lu), sv=0x%"UVxf"\n",
671                 (long)off,
672                 (unsigned long)I_32(SvNVX(sv)),
673                 (unsigned long)SvIVX(sv),
674                 PTR2UV(oldsv)
675             )
676         );
677 #endif
678
679     if (!newoff) {              /* Not a mere clone operation. */
680         newoff = pad_add_name(
681             SvPVX(sv),
682             (SvFLAGS(sv) & SVpad_TYPED) ? SvSTASH(sv) : Nullhv,
683             (SvFLAGS(sv) & SVpad_OUR)   ? GvSTASH(sv) : Nullhv,
684             1  /* fake */
685         );
686
687         if (CvANON(PL_compcv) || SvTYPE(PL_compcv) == SVt_PVFM) {
688             /* "It's closures all the way down." */
689             CvCLONE_on(PL_compcv);
690             if (cv == startcv) {
691                 if (CvANON(PL_compcv))
692                     oldsv = Nullsv; /* no need to keep ref */
693             }
694             else {
695                 CV *bcv;
696                 for (bcv = startcv;
697                      bcv && bcv != cv && !CvCLONE(bcv);
698                      bcv = CvOUTSIDE(bcv))
699                 {
700                     if (CvANON(bcv)) {
701                         /* install the missing pad entry in intervening
702                          * nested subs and mark them cloneable. */
703                         AV *ocomppad_name = PL_comppad_name;
704                         PAD *ocomppad = PL_comppad;
705                         AV *padlist = CvPADLIST(bcv);
706                         PL_comppad_name = (AV*)AvARRAY(padlist)[0];
707                         PL_comppad = (AV*)AvARRAY(padlist)[1];
708                         PL_curpad = AvARRAY(PL_comppad);
709                         pad_add_name(
710                             SvPVX(sv),
711                             (SvFLAGS(sv) & SVpad_TYPED)
712                                 ? SvSTASH(sv) : Nullhv,
713                             (SvFLAGS(sv) & SVpad_OUR)
714                                 ? GvSTASH(sv) : Nullhv,
715                             1  /* fake */
716                         );
717
718                         PL_comppad_name = ocomppad_name;
719                         PL_comppad = ocomppad;
720                         PL_curpad = ocomppad ?
721                                 AvARRAY(ocomppad) : Null(SV **);
722                         CvCLONE_on(bcv);
723                     }
724                     else {
725                         if (ckWARN(WARN_CLOSURE)
726                             && !CvUNIQUE(bcv) && !CvUNIQUE(cv))
727                         {
728                             Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
729                               "Variable \"%s\" may be unavailable",
730                                  name);
731                         }
732                         break;
733                     }
734                 }
735             }
736         }
737         else if (!CvUNIQUE(PL_compcv)) {
738             if (ckWARN(WARN_CLOSURE) && !SvFAKE(sv) && !CvUNIQUE(cv)
739                 && !(SvFLAGS(sv) & SVpad_OUR))
740             {
741                 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
742                     "Variable \"%s\" will not stay shared", name);
743             }
744         }
745     }
746     av_store(PL_comppad, newoff, SvREFCNT_inc(oldsv));
747     ASSERT_CURPAD_ACTIVE("pad_findlex 2");
748     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
749                 "Pad findlex: set offset %ld to sv 0x%"UVxf"\n",
750                 (long)newoff, PTR2UV(oldsv)
751             )
752     );
753     return newoff;
754 }
755
756
757 /*
758 =for apidoc pad_sv
759
760 Get the value at offset po in the current pad.
761 Use macro PAD_SV instead of calling this function directly.
762
763 =cut
764 */
765
766
767 SV *
768 Perl_pad_sv(pTHX_ PADOFFSET po)
769 {
770     ASSERT_CURPAD_ACTIVE("pad_sv");
771
772     if (!po)
773         Perl_croak(aTHX_ "panic: pad_sv po");
774     DEBUG_X(PerlIO_printf(Perl_debug_log,
775         "Pad 0x%"UVxf"[0x%"UVxf"] sv:      %ld sv=0x%"UVxf"\n",
776         PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(PL_curpad[po]))
777     );
778     return PL_curpad[po];
779 }
780
781
782 /*
783 =for apidoc pad_setsv
784
785 Set the entry at offset po in the current pad to sv.
786 Use the macro PAD_SETSV() rather than calling this function directly.
787
788 =cut
789 */
790
791 #ifdef DEBUGGING
792 void
793 Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
794 {
795     ASSERT_CURPAD_ACTIVE("pad_setsv");
796
797     DEBUG_X(PerlIO_printf(Perl_debug_log,
798         "Pad 0x%"UVxf"[0x%"UVxf"] setsv:   %ld sv=0x%"UVxf"\n",
799         PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(sv))
800     );
801     PL_curpad[po] = sv;
802 }
803 #endif
804
805
806
807 /*
808 =for apidoc pad_block_start
809
810 Update the pad compilation state variables on entry to a new block
811
812 =cut
813 */
814
815 /* XXX DAPM perhaps:
816  *      - integrate this in general state-saving routine ???
817  *      - combine with the state-saving going on in pad_new ???
818  *      - introduce a new SAVE type that does all this in one go ?
819  */
820
821 void
822 Perl_pad_block_start(pTHX_ int full)
823 {
824     ASSERT_CURPAD_ACTIVE("pad_block_start");
825     SAVEI32(PL_comppad_name_floor);
826     PL_comppad_name_floor = AvFILLp(PL_comppad_name);
827     if (full)
828         PL_comppad_name_fill = PL_comppad_name_floor;
829     if (PL_comppad_name_floor < 0)
830         PL_comppad_name_floor = 0;
831     SAVEI32(PL_min_intro_pending);
832     SAVEI32(PL_max_intro_pending);
833     PL_min_intro_pending = 0;
834     SAVEI32(PL_comppad_name_fill);
835     SAVEI32(PL_padix_floor);
836     PL_padix_floor = PL_padix;
837     PL_pad_reset_pending = FALSE;
838 }
839
840
841 /*
842 =for apidoc intro_my
843
844 "Introduce" my variables to visible status.
845
846 =cut
847 */
848
849 U32
850 Perl_intro_my(pTHX)
851 {
852     SV **svp;
853     SV *sv;
854     I32 i;
855
856     ASSERT_CURPAD_ACTIVE("intro_my");
857     if (! PL_min_intro_pending)
858         return PL_cop_seqmax;
859
860     svp = AvARRAY(PL_comppad_name);
861     for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
862         if ((sv = svp[i]) && sv != &PL_sv_undef
863                 && !SvFAKE(sv) && !SvIVX(sv))
864         {
865             SvIVX(sv) = PAD_MAX;        /* Don't know scope end yet. */
866             SvNVX(sv) = (NV)PL_cop_seqmax;
867             DEBUG_Xv(PerlIO_printf(Perl_debug_log,
868                 "Pad intromy: %ld \"%s\", (%lu,%lu)\n",
869                 (long)i, SvPVX(sv),
870                 (unsigned long)I_32(SvNVX(sv)), (unsigned long)SvIVX(sv))
871             );
872         }
873     }
874     PL_min_intro_pending = 0;
875     PL_comppad_name_fill = PL_max_intro_pending; /* Needn't search higher */
876     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
877                 "Pad intromy: seq -> %ld\n", (long)(PL_cop_seqmax+1)));
878
879     return PL_cop_seqmax++;
880 }
881
882 /*
883 =for apidoc pad_leavemy
884
885 Cleanup at end of scope during compilation: set the max seq number for
886 lexicals in this scope and warn of any lexicals that never got introduced.
887
888 =cut
889 */
890
891 void
892 Perl_pad_leavemy(pTHX)
893 {
894     I32 off;
895     SV **svp = AvARRAY(PL_comppad_name);
896     SV *sv;
897
898     PL_pad_reset_pending = FALSE;
899
900     ASSERT_CURPAD_ACTIVE("pad_leavemy");
901     if (PL_min_intro_pending && PL_comppad_name_fill < PL_min_intro_pending) {
902         for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
903             if ((sv = svp[off]) && sv != &PL_sv_undef
904                     && !SvFAKE(sv) && ckWARN_d(WARN_INTERNAL))
905                 Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
906                                         "%s never introduced", SvPVX(sv));
907         }
908     }
909     /* "Deintroduce" my variables that are leaving with this scope. */
910     for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_fill; off--) {
911         if ((sv = svp[off]) && sv != &PL_sv_undef
912                 && !SvFAKE(sv) && SvIVX(sv) == PAD_MAX)
913         {
914             SvIVX(sv) = PL_cop_seqmax;
915             DEBUG_Xv(PerlIO_printf(Perl_debug_log,
916                 "Pad leavemy: %ld \"%s\", (%lu,%lu)\n",
917                 (long)off, SvPVX(sv),
918                 (unsigned long)I_32(SvNVX(sv)), (unsigned long)SvIVX(sv))
919             );
920         }
921     }
922     PL_cop_seqmax++;
923     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
924             "Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax));
925 }
926
927
928 /*
929 =for apidoc pad_swipe
930
931 Abandon the tmp in the current pad at offset po and replace with a
932 new one.
933
934 =cut
935 */
936
937 void
938 Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
939 {
940     ASSERT_CURPAD_LEGAL("pad_swipe");
941     if (!PL_curpad)
942         return;
943     if (AvARRAY(PL_comppad) != PL_curpad)
944         Perl_croak(aTHX_ "panic: pad_swipe curpad");
945     if (!po)
946         Perl_croak(aTHX_ "panic: pad_swipe po");
947
948     DEBUG_X(PerlIO_printf(Perl_debug_log,
949                 "Pad 0x%"UVxf"[0x%"UVxf"] swipe:   %ld\n",
950                 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po));
951
952     if (PL_curpad[po])
953         SvPADTMP_off(PL_curpad[po]);
954     if (refadjust)
955         SvREFCNT_dec(PL_curpad[po]);
956
957     PL_curpad[po] = NEWSV(1107,0);
958     SvPADTMP_on(PL_curpad[po]);
959     if ((I32)po < PL_padix)
960         PL_padix = po - 1;
961 }
962
963
964 /*
965 =for apidoc pad_reset
966
967 Mark all the current temporaries for reuse
968
969 =cut
970 */
971
972 /* XXX pad_reset() is currently disabled because it results in serious bugs.
973  * It causes pad temp TARGs to be shared between OPs. Since TARGs are pushed
974  * on the stack by OPs that use them, there are several ways to get an alias
975  * to  a shared TARG.  Such an alias will change randomly and unpredictably.
976  * We avoid doing this until we can think of a Better Way.
977  * GSAR 97-10-29 */
978 void
979 Perl_pad_reset(pTHX)
980 {
981 #ifdef USE_BROKEN_PAD_RESET
982     register I32 po;
983
984     if (AvARRAY(PL_comppad) != PL_curpad)
985         Perl_croak(aTHX_ "panic: pad_reset curpad");
986
987     DEBUG_X(PerlIO_printf(Perl_debug_log,
988             "Pad 0x%"UVxf"[0x%"UVxf"] reset:     padix %ld -> %ld",
989             PTR2UV(PL_comppad), PTR2UV(PL_curpad),
990                 (long)PL_padix, (long)PL_padix_floor
991             )
992     );
993
994     if (!PL_tainting) { /* Can't mix tainted and non-tainted temporaries. */
995         for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
996             if (PL_curpad[po] && !SvIMMORTAL(PL_curpad[po]))
997                 SvPADTMP_off(PL_curpad[po]);
998         }
999         PL_padix = PL_padix_floor;
1000     }
1001 #endif
1002     PL_pad_reset_pending = FALSE;
1003 }
1004
1005
1006 /*
1007 =for apidoc pad_tidy
1008
1009 Tidy up a pad after we've finished compiling it:
1010     * remove most stuff from the pads of anonsub prototypes;
1011     * give it a @_;
1012     * mark tmps as such.
1013
1014 =cut
1015 */
1016
1017 /* XXX DAPM surely most of this stuff should be done properly
1018  * at the right time beforehand, rather than going around afterwards
1019  * cleaning up our mistakes ???
1020  */
1021
1022 void
1023 Perl_pad_tidy(pTHX_ padtidy_type type)
1024 {
1025     PADOFFSET ix;
1026
1027     ASSERT_CURPAD_ACTIVE("pad_tidy");
1028     /* extend curpad to match namepad */
1029     if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
1030         av_store(PL_comppad_name, AvFILLp(PL_comppad), Nullsv);
1031
1032     if (type == padtidy_SUBCLONE) {
1033         SV **namep = AvARRAY(PL_comppad_name);
1034         for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1035             SV *namesv;
1036
1037             if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
1038                 continue;
1039             /*
1040              * The only things that a clonable function needs in its
1041              * pad are references to outer lexicals and anonymous subs.
1042              * The rest are created anew during cloning.
1043              */
1044             if (!((namesv = namep[ix]) != Nullsv &&
1045                   namesv != &PL_sv_undef &&
1046                   (SvFAKE(namesv) ||
1047                    *SvPVX(namesv) == '&')))
1048             {
1049                 SvREFCNT_dec(PL_curpad[ix]);
1050                 PL_curpad[ix] = Nullsv;
1051             }
1052         }
1053     }
1054     else if (type == padtidy_SUB) {
1055         /* XXX DAPM this same bit of code keeps appearing !!! Rationalise? */
1056         AV *av = newAV();                       /* Will be @_ */
1057         av_extend(av, 0);
1058         av_store(PL_comppad, 0, (SV*)av);
1059         AvFLAGS(av) = AVf_REIFY;
1060     }
1061
1062     /* XXX DAPM rationalise these two similar branches */
1063
1064     if (type == padtidy_SUB) {
1065         for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1066             if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
1067                 continue;
1068             if (!SvPADMY(PL_curpad[ix]))
1069                 SvPADTMP_on(PL_curpad[ix]);
1070         }
1071     }
1072     else if (type == padtidy_FORMAT) {
1073         for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1074             if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix]))
1075                 SvPADTMP_on(PL_curpad[ix]);
1076         }
1077     }
1078     PL_curpad = AvARRAY(PL_comppad);
1079 }
1080
1081
1082 /*
1083 =for apidoc pad_free
1084
1085 Free the SV at offet po in the current pad.
1086
1087 =cut
1088 */
1089
1090 /* XXX DAPM integrate with pad_swipe ???? */
1091 void
1092 Perl_pad_free(pTHX_ PADOFFSET po)
1093 {
1094     ASSERT_CURPAD_LEGAL("pad_free");
1095     if (!PL_curpad)
1096         return;
1097     if (AvARRAY(PL_comppad) != PL_curpad)
1098         Perl_croak(aTHX_ "panic: pad_free curpad");
1099     if (!po)
1100         Perl_croak(aTHX_ "panic: pad_free po");
1101
1102     DEBUG_X(PerlIO_printf(Perl_debug_log,
1103             "Pad 0x%"UVxf"[0x%"UVxf"] free:    %ld\n",
1104             PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po)
1105     );
1106
1107     if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
1108         SvPADTMP_off(PL_curpad[po]);
1109 #ifdef USE_ITHREADS
1110 #ifdef PERL_COPY_ON_WRITE
1111         if (SvIsCOW(PL_curpad[po])) {
1112             sv_force_normal_flags(PL_curpad[po], SV_COW_DROP_PV);
1113         } else
1114 #endif
1115             SvREADONLY_off(PL_curpad[po]);      /* could be a freed constant */
1116
1117 #endif
1118     }
1119     if ((I32)po < PL_padix)
1120         PL_padix = po - 1;
1121 }
1122
1123
1124
1125 /*
1126 =for apidoc do_dump_pad
1127
1128 Dump the contents of a padlist
1129
1130 =cut
1131 */
1132
1133 void
1134 Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
1135 {
1136     AV *pad_name;
1137     AV *pad;
1138     SV **pname;
1139     SV **ppad;
1140     SV *namesv;
1141     I32 ix;
1142
1143     if (!padlist) {
1144         return;
1145     }
1146     pad_name = (AV*)*av_fetch((AV*)padlist, 0, FALSE);
1147     pad = (AV*)*av_fetch((AV*)padlist, 1, FALSE);
1148     pname = AvARRAY(pad_name);
1149     ppad = AvARRAY(pad);
1150     Perl_dump_indent(aTHX_ level, file,
1151             "PADNAME = 0x%"UVxf"(0x%"UVxf") PAD = 0x%"UVxf"(0x%"UVxf")\n",
1152             PTR2UV(pad_name), PTR2UV(pname), PTR2UV(pad), PTR2UV(ppad)
1153     );
1154
1155     for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
1156         namesv = pname[ix];
1157         if (namesv && namesv == &PL_sv_undef) {
1158             namesv = Nullsv;
1159         }
1160         if (namesv) {
1161             if (SvFAKE(namesv))
1162                 Perl_dump_indent(aTHX_ level+1, file,
1163                     "%2d. 0x%"UVxf"<%lu> FAKE \"%s\"\n",
1164                     (int) ix,
1165                     PTR2UV(ppad[ix]),
1166                     (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
1167                     SvPVX(namesv)
1168                 );
1169             else
1170                 Perl_dump_indent(aTHX_ level+1, file,
1171                     "%2d. 0x%"UVxf"<%lu> (%lu,%lu) \"%s\"\n",
1172                     (int) ix,
1173                     PTR2UV(ppad[ix]),
1174                     (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
1175                     (unsigned long)I_32(SvNVX(namesv)),
1176                     (unsigned long)SvIVX(namesv),
1177                     SvPVX(namesv)
1178                 );
1179         }
1180         else if (full) {
1181             Perl_dump_indent(aTHX_ level+1, file,
1182                 "%2d. 0x%"UVxf"<%lu>\n",
1183                 (int) ix,
1184                 PTR2UV(ppad[ix]),
1185                 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0)
1186             );
1187         }
1188     }
1189 }
1190
1191
1192
1193 /*
1194 =for apidoc cv_dump
1195
1196 dump the contents of a CV
1197
1198 =cut
1199 */
1200
1201 #ifdef DEBUGGING
1202 STATIC void
1203 S_cv_dump(pTHX_ CV *cv, char *title)
1204 {
1205     CV *outside = CvOUTSIDE(cv);
1206     AV* padlist = CvPADLIST(cv);
1207
1208     PerlIO_printf(Perl_debug_log,
1209                   "  %s: CV=0x%"UVxf" (%s), OUTSIDE=0x%"UVxf" (%s)\n",
1210                   title,
1211                   PTR2UV(cv),
1212                   (CvANON(cv) ? "ANON"
1213                    : (cv == PL_main_cv) ? "MAIN"
1214                    : CvUNIQUE(cv) ? "UNIQUE"
1215                    : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
1216                   PTR2UV(outside),
1217                   (!outside ? "null"
1218                    : CvANON(outside) ? "ANON"
1219                    : (outside == PL_main_cv) ? "MAIN"
1220                    : CvUNIQUE(outside) ? "UNIQUE"
1221                    : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
1222
1223     PerlIO_printf(Perl_debug_log,
1224                     "    PADLIST = 0x%"UVxf"\n", PTR2UV(padlist));
1225     do_dump_pad(1, Perl_debug_log, padlist, 1);
1226 }
1227 #endif /* DEBUGGING */
1228
1229
1230
1231
1232
1233 /*
1234 =for apidoc cv_clone
1235
1236 Clone a CV: make a new CV which points to the same code etc, but which
1237 has a newly-created pad built by copying the prototype pad and capturing
1238 any outer lexicals.
1239
1240 =cut
1241 */
1242
1243 CV *
1244 Perl_cv_clone(pTHX_ CV *proto)
1245 {
1246     CV *cv;
1247
1248     LOCK_CRED_MUTEX;                    /* XXX create separate mutex */
1249     cv = cv_clone2(proto, CvOUTSIDE(proto));
1250     UNLOCK_CRED_MUTEX;                  /* XXX create separate mutex */
1251     return cv;
1252 }
1253
1254
1255 /* XXX DAPM separate out cv and paddish bits ???
1256  * ideally the CV-related stuff shouldn't be in pad.c - how about
1257  * a cv.c? */
1258
1259 STATIC CV *
1260 S_cv_clone2(pTHX_ CV *proto, CV *outside)
1261 {
1262     I32 ix;
1263     AV* protopadlist = CvPADLIST(proto);
1264     AV* protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
1265     AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
1266     SV** pname = AvARRAY(protopad_name);
1267     SV** ppad = AvARRAY(protopad);
1268     I32 fname = AvFILLp(protopad_name);
1269     I32 fpad = AvFILLp(protopad);
1270     AV* comppadlist;
1271     CV* cv;
1272
1273     assert(!CvUNIQUE(proto));
1274
1275     ENTER;
1276     SAVESPTR(PL_compcv);
1277
1278     cv = PL_compcv = (CV*)NEWSV(1104, 0);
1279     sv_upgrade((SV *)cv, SvTYPE(proto));
1280     CvFLAGS(cv) = CvFLAGS(proto) & ~CVf_CLONE;
1281     CvCLONED_on(cv);
1282
1283 #ifdef USE_ITHREADS
1284     CvFILE(cv)          = CvXSUB(proto) ? CvFILE(proto)
1285                                         : savepv(CvFILE(proto));
1286 #else
1287     CvFILE(cv)          = CvFILE(proto);
1288 #endif
1289     CvGV(cv)            = CvGV(proto);
1290     CvSTASH(cv)         = CvSTASH(proto);
1291     CvROOT(cv)          = OpREFCNT_inc(CvROOT(proto));
1292     CvSTART(cv)         = CvSTART(proto);
1293     if (outside) {
1294         CvOUTSIDE(cv)   = (CV*)SvREFCNT_inc(outside);
1295         CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
1296     }
1297
1298     if (SvPOK(proto))
1299         sv_setpvn((SV*)cv, SvPVX(proto), SvCUR(proto));
1300
1301     CvPADLIST(cv) = comppadlist = pad_new(padnew_CLONE|padnew_SAVE);
1302
1303     for (ix = fname; ix >= 0; ix--)
1304         av_store(PL_comppad_name, ix, SvREFCNT_inc(pname[ix]));
1305
1306     av_fill(PL_comppad, fpad);
1307     PL_curpad = AvARRAY(PL_comppad);
1308
1309     for (ix = fpad; ix > 0; ix--) {
1310         SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
1311         if (namesv && namesv != &PL_sv_undef) {
1312             char *name = SvPVX(namesv);    /* XXX */
1313             if (SvFLAGS(namesv) & SVf_FAKE) {   /* lexical from outside? */
1314                 I32 off = pad_findlex(name, ix, cv);
1315                 if (!off)
1316                     PL_curpad[ix] = SvREFCNT_inc(ppad[ix]);
1317                 else if (off != ix)
1318                     Perl_croak(aTHX_ "panic: cv_clone: %s", name);
1319             }
1320             else {                              /* our own lexical */
1321                 SV* sv;
1322                 if (*name == '&') {
1323                     /* anon code -- we'll come back for it */
1324                     sv = SvREFCNT_inc(ppad[ix]);
1325                 }
1326                 else if (*name == '@')
1327                     sv = (SV*)newAV();
1328                 else if (*name == '%')
1329                     sv = (SV*)newHV();
1330                 else
1331                     sv = NEWSV(0, 0);
1332                 if (!SvPADBUSY(sv))
1333                     SvPADMY_on(sv);
1334                 PL_curpad[ix] = sv;
1335             }
1336         }
1337         else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) {
1338             PL_curpad[ix] = SvREFCNT_inc(ppad[ix]);
1339         }
1340         else {
1341             SV* sv = NEWSV(0, 0);
1342             SvPADTMP_on(sv);
1343             PL_curpad[ix] = sv;
1344         }
1345     }
1346
1347     /* Now that vars are all in place, clone nested closures. */
1348
1349     for (ix = fpad; ix > 0; ix--) {
1350         SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
1351         if (namesv
1352             && namesv != &PL_sv_undef
1353             && !(SvFLAGS(namesv) & SVf_FAKE)
1354             && *SvPVX(namesv) == '&'
1355             && CvCLONE(ppad[ix]))
1356         {
1357             CV *kid = cv_clone2((CV*)ppad[ix], cv);
1358             SvREFCNT_dec(ppad[ix]);
1359             CvCLONE_on(kid);
1360             SvPADMY_on(kid);
1361             PL_curpad[ix] = (SV*)kid;
1362         }
1363     }
1364
1365     DEBUG_Xv(
1366         PerlIO_printf(Perl_debug_log, "\nPad CV clone\n");
1367         cv_dump(outside, "Outside");
1368         cv_dump(proto,   "Proto");
1369         cv_dump(cv,      "To");
1370     );
1371
1372     LEAVE;
1373
1374     if (CvCONST(cv)) {
1375         SV* const_sv = op_const_sv(CvSTART(cv), cv);
1376         assert(const_sv);
1377         /* constant sub () { $x } closing over $x - see lib/constant.pm */
1378         SvREFCNT_dec(cv);
1379         cv = newCONSTSUB(CvSTASH(proto), 0, const_sv);
1380     }
1381
1382     return cv;
1383 }
1384
1385
1386 /*
1387 =for apidoc pad_fixup_inner_anons
1388
1389 For any anon CVs in the pad, change CvOUTSIDE of that CV from
1390 old_cv to new_cv if necessary.
1391
1392 =cut
1393 */
1394
1395 void
1396 Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
1397 {
1398     I32 ix;
1399     AV *comppad_name = (AV*)AvARRAY(padlist)[0];
1400     AV *comppad = (AV*)AvARRAY(padlist)[1];
1401     SV **namepad = AvARRAY(comppad_name);
1402     SV **curpad = AvARRAY(comppad);
1403     for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
1404         SV *namesv = namepad[ix];
1405         if (namesv && namesv != &PL_sv_undef
1406             && *SvPVX(namesv) == '&')
1407         {
1408             CV *innercv = (CV*)curpad[ix];
1409             if (CvOUTSIDE(innercv) == old_cv) {
1410                 CvOUTSIDE(innercv) = new_cv;
1411                 /* anon prototypes aren't refcounted */
1412                 if (!CvANON(innercv) || CvCLONED(innercv)) {
1413                     (void)SvREFCNT_inc(new_cv);
1414                     SvREFCNT_dec(old_cv);
1415                 }
1416             }
1417         }
1418     }
1419 }
1420
1421 /*
1422 =for apidoc pad_push
1423
1424 Push a new pad frame onto the padlist, unless there's already a pad at
1425 this depth, in which case don't bother creating a new one.
1426 If has_args is true, give the new pad an @_ in slot zero.
1427
1428 =cut
1429 */
1430
1431 void
1432 Perl_pad_push(pTHX_ PADLIST *padlist, int depth, int has_args)
1433 {
1434     if (depth <= AvFILLp(padlist))
1435         return;
1436
1437     {
1438         SV** svp = AvARRAY(padlist);
1439         AV *newpad = newAV();
1440         SV **oldpad = AvARRAY(svp[depth-1]);
1441         I32 ix = AvFILLp((AV*)svp[1]);
1442         I32 names_fill = AvFILLp((AV*)svp[0]);
1443         SV** names = AvARRAY(svp[0]);
1444         SV* sv;
1445         for ( ;ix > 0; ix--) {
1446             if (names_fill >= ix && names[ix] != &PL_sv_undef) {
1447                 char *name = SvPVX(names[ix]);
1448                 if ((SvFLAGS(names[ix]) & SVf_FAKE) || *name == '&') {
1449                     /* outer lexical or anon code */
1450                     av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]));
1451                 }
1452                 else {          /* our own lexical */
1453                     if (*name == '@')
1454                         av_store(newpad, ix, sv = (SV*)newAV());
1455                     else if (*name == '%')
1456                         av_store(newpad, ix, sv = (SV*)newHV());
1457                     else
1458                         av_store(newpad, ix, sv = NEWSV(0, 0));
1459                     SvPADMY_on(sv);
1460                 }
1461             }
1462             else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
1463                 av_store(newpad, ix, sv = SvREFCNT_inc(oldpad[ix]));
1464             }
1465             else {
1466                 /* save temporaries on recursion? */
1467                 av_store(newpad, ix, sv = NEWSV(0, 0));
1468                 SvPADTMP_on(sv);
1469             }
1470         }
1471         if (has_args) {
1472             AV* av = newAV();
1473             av_extend(av, 0);
1474             av_store(newpad, 0, (SV*)av);
1475             AvFLAGS(av) = AVf_REIFY;
1476         }
1477         av_store(padlist, depth, (SV*)newpad);
1478         AvFILLp(padlist) = depth;
1479     }
1480 }