Upgrade to Text-Tabs+Wrap-2012.0818
[perl.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 =for apidoc Amx|PADLIST *|CvPADLIST|CV *cv
31
32 CV's can have CvPADLIST(cv) set to point to an AV.  This is the CV's
33 scratchpad, which stores lexical variables and opcode temporary and
34 per-thread values.
35
36 For these purposes "forms" are a kind-of CV, eval""s are too (except they're
37 not callable at will and are always thrown away after the eval"" is done
38 executing). Require'd files are simply evals without any outer lexical
39 scope.
40
41 XSUBs don't have CvPADLIST set - dXSTARG fetches values from PL_curpad,
42 but that is really the callers pad (a slot of which is allocated by
43 every entersub).
44
45 The CvPADLIST AV has the REFCNT of its component items managed "manually"
46 (mostly in pad.c) rather than by normal av.c rules.  So we turn off AvREAL
47 just before freeing it, to let av.c know not to touch the entries.
48 The items in the AV are not SVs as for a normal AV, but other AVs:
49
50 0'th Entry of the CvPADLIST is an AV which represents the "names" or rather
51 the "static type information" for lexicals.
52
53 The CvDEPTH'th entry of CvPADLIST AV is an AV which is the stack frame at that
54 depth of recursion into the CV.
55 The 0'th slot of a frame AV is an AV which is @_.
56 other entries are storage for variables and op targets.
57
58 Iterating over the names AV iterates over all possible pad
59 items. Pad slots that are SVs_PADTMP (targets/GVs/constants) end up having
60 &PL_sv_undef "names" (see pad_alloc()).
61
62 Only my/our variable (SVs_PADMY/SVs_PADOUR) slots get valid names.
63 The rest are op targets/GVs/constants which are statically allocated
64 or resolved at compile time.  These don't have names by which they
65 can be looked up from Perl code at run time through eval"" like
66 my/our variables can be.  Since they can't be looked up by "name"
67 but only by their index allocated at compile time (which is usually
68 in PL_op->op_targ), wasting a name SV for them doesn't make sense.
69
70 The SVs in the names AV have their PV being the name of the variable.
71 xlow+1..xhigh inclusive in the NV union is a range of cop_seq numbers for
72 which the name is valid (accessed through the macros COP_SEQ_RANGE_LOW and
73 _HIGH).  During compilation, these fields may hold the special value
74 PERL_PADSEQ_INTRO to indicate various stages:
75
76    COP_SEQ_RANGE_LOW        _HIGH
77    -----------------        -----
78    PERL_PADSEQ_INTRO            0   variable not yet introduced:   { my ($x
79    valid-seq#   PERL_PADSEQ_INTRO   variable in scope:             { my ($x)
80    valid-seq#          valid-seq#   compilation of scope complete: { my ($x) }
81
82 For typed lexicals name SV is SVt_PVMG and SvSTASH
83 points at the type.  For C<our> lexicals, the type is also SVt_PVMG, with the
84 SvOURSTASH slot pointing at the stash of the associated global (so that
85 duplicate C<our> declarations in the same package can be detected).  SvUVX is
86 sometimes hijacked to store the generation number during compilation.
87
88 If SvFAKE is set on the name SV, then that slot in the frame AV is
89 a REFCNT'ed reference to a lexical from "outside". In this case,
90 the name SV does not use xlow and xhigh to store a cop_seq range, since it is
91 in scope throughout. Instead xhigh stores some flags containing info about
92 the real lexical (is it declared in an anon, and is it capable of being
93 instantiated multiple times?), and for fake ANONs, xlow contains the index
94 within the parent's pad where the lexical's value is stored, to make
95 cloning quicker.
96
97 If the 'name' is '&' the corresponding entry in frame AV
98 is a CV representing a possible closure.
99 (SvFAKE and name of '&' is not a meaningful combination currently but could
100 become so if C<my sub foo {}> is implemented.)
101
102 Note that formats are treated as anon subs, and are cloned each time
103 write is called (if necessary).
104
105 The flag SVs_PADSTALE is cleared on lexicals each time the my() is executed,
106 and set on scope exit. This allows the 'Variable $x is not available' warning
107 to be generated in evals, such as 
108
109     { my $x = 1; sub f { eval '$x'} } f();
110
111 For state vars, SVs_PADSTALE is overloaded to mean 'not yet initialised'
112
113 =for apidoc AmxU|AV *|PL_comppad_name
114
115 During compilation, this points to the array containing the names part
116 of the pad for the currently-compiling code.
117
118 =for apidoc AmxU|AV *|PL_comppad
119
120 During compilation, this points to the array containing the values
121 part of the pad for the currently-compiling code.  (At runtime a CV may
122 have many such value arrays; at compile time just one is constructed.)
123 At runtime, this points to the array containing the currently-relevant
124 values for the pad for the currently-executing code.
125
126 =for apidoc AmxU|SV **|PL_curpad
127
128 Points directly to the body of the L</PL_comppad> array.
129 (I.e., this is C<AvARRAY(PL_comppad)>.)
130
131 =cut
132 */
133
134
135 #include "EXTERN.h"
136 #define PERL_IN_PAD_C
137 #include "perl.h"
138 #include "keywords.h"
139
140 #define COP_SEQ_RANGE_LOW_set(sv,val)           \
141   STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xlow = (val); } STMT_END
142 #define COP_SEQ_RANGE_HIGH_set(sv,val)          \
143   STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xhigh = (val); } STMT_END
144
145 #define PARENT_PAD_INDEX_set(sv,val)            \
146   STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xlow = (val); } STMT_END
147 #define PARENT_FAKELEX_FLAGS_set(sv,val)        \
148   STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xhigh = (val); } STMT_END
149
150 /*
151 =for apidoc mx|void|pad_peg|const char *s
152
153 When PERL_MAD is enabled, this is a small no-op function that gets called
154 at the start of each pad-related function.  It can be breakpointed to
155 track all pad operations.  The parameter is a string indicating the type
156 of pad operation being performed.
157
158 =cut
159 */
160
161 #ifdef PERL_MAD
162 void pad_peg(const char* s) {
163     static int pegcnt; /* XXX not threadsafe */
164     PERL_UNUSED_ARG(s);
165
166     PERL_ARGS_ASSERT_PAD_PEG;
167
168     pegcnt++;
169 }
170 #endif
171
172 /*
173 This is basically sv_eq_flags() in sv.c, but we avoid the magic
174 and bytes checking.
175 */
176
177 static bool
178 sv_eq_pvn_flags(pTHX_ const SV *sv, const char* pv, const STRLEN pvlen, const U32 flags) {
179     if ( (SvUTF8(sv) & SVf_UTF8 ) != (flags & SVf_UTF8) ) {
180         const char *pv1 = SvPVX_const(sv);
181         STRLEN cur1     = SvCUR(sv);
182         const char *pv2 = pv;
183         STRLEN cur2     = pvlen;
184         if (PL_encoding) {
185               SV* svrecode = NULL;
186               if (SvUTF8(sv)) {
187                    svrecode = newSVpvn(pv2, cur2);
188                    sv_recode_to_utf8(svrecode, PL_encoding);
189                    pv2      = SvPV_const(svrecode, cur2);
190               }
191               else {
192                    svrecode = newSVpvn(pv1, cur1);
193                    sv_recode_to_utf8(svrecode, PL_encoding);
194                    pv1      = SvPV_const(svrecode, cur1);
195               }
196               SvREFCNT_dec(svrecode);
197         }
198         if (flags & SVf_UTF8)
199             return (bytes_cmp_utf8(
200                         (const U8*)pv1, cur1,
201                         (const U8*)pv2, cur2) == 0);
202         else
203             return (bytes_cmp_utf8(
204                         (const U8*)pv2, cur2,
205                         (const U8*)pv1, cur1) == 0);
206     }
207     else
208         return ((SvPVX_const(sv) == pv)
209                     || memEQ(SvPVX_const(sv), pv, pvlen));
210 }
211
212
213 /*
214 =for apidoc Am|PADLIST *|pad_new|int flags
215
216 Create a new padlist, updating the global variables for the
217 currently-compiling padlist to point to the new padlist.  The following
218 flags can be OR'ed together:
219
220     padnew_CLONE        this pad is for a cloned CV
221     padnew_SAVE         save old globals on the save stack
222     padnew_SAVESUB      also save extra stuff for start of sub
223
224 =cut
225 */
226
227 PADLIST *
228 Perl_pad_new(pTHX_ int flags)
229 {
230     dVAR;
231     AV *padlist, *padname, *pad;
232     SV **ary;
233
234     ASSERT_CURPAD_LEGAL("pad_new");
235
236     /* XXX DAPM really need a new SAVEt_PAD which restores all or most
237      * vars (based on flags) rather than storing vals + addresses for
238      * each individually. Also see pad_block_start.
239      * XXX DAPM Try to see whether all these conditionals are required
240      */
241
242     /* save existing state, ... */
243
244     if (flags & padnew_SAVE) {
245         SAVECOMPPAD();
246         SAVESPTR(PL_comppad_name);
247         if (! (flags & padnew_CLONE)) {
248             SAVEI32(PL_padix);
249             SAVEI32(PL_comppad_name_fill);
250             SAVEI32(PL_min_intro_pending);
251             SAVEI32(PL_max_intro_pending);
252             SAVEBOOL(PL_cv_has_eval);
253             if (flags & padnew_SAVESUB) {
254                 SAVEBOOL(PL_pad_reset_pending);
255             }
256         }
257     }
258     /* XXX DAPM interestingly, PL_comppad_name_floor never seems to be
259      * saved - check at some pt that this is okay */
260
261     /* ... create new pad ... */
262
263     padlist     = newAV();
264     padname     = newAV();
265     pad         = newAV();
266
267     if (flags & padnew_CLONE) {
268         /* XXX DAPM  I dont know why cv_clone needs it
269          * doing differently yet - perhaps this separate branch can be
270          * dispensed with eventually ???
271          */
272
273         AV * const a0 = newAV();                        /* will be @_ */
274         av_store(pad, 0, MUTABLE_SV(a0));
275         AvREIFY_only(a0);
276     }
277     else {
278         av_store(pad, 0, NULL);
279     }
280
281     /* Most subroutines never recurse, hence only need 2 entries in the padlist
282        array - names, and depth=1.  The default for av_store() is to allocate
283        0..3, and even an explicit call to av_extend() with <3 will be rounded
284        up, so we inline the allocation of the array here.  */
285     Newx(ary, 2, SV*);
286     AvFILLp(padlist) = 1;
287     AvMAX(padlist) = 1;
288     AvALLOC(padlist) = ary;
289     AvARRAY(padlist) = ary;
290     ary[0] = MUTABLE_SV(padname);
291     ary[1] = MUTABLE_SV(pad);
292
293     /* ... then update state variables */
294
295     PL_comppad_name     = padname;
296     PL_comppad          = pad;
297     PL_curpad           = AvARRAY(pad);
298
299     if (! (flags & padnew_CLONE)) {
300         PL_comppad_name_fill = 0;
301         PL_min_intro_pending = 0;
302         PL_padix             = 0;
303         PL_cv_has_eval       = 0;
304     }
305
306     DEBUG_X(PerlIO_printf(Perl_debug_log,
307           "Pad 0x%"UVxf"[0x%"UVxf"] new:       compcv=0x%"UVxf
308               " name=0x%"UVxf" flags=0x%"UVxf"\n",
309           PTR2UV(PL_comppad), PTR2UV(PL_curpad), PTR2UV(PL_compcv),
310               PTR2UV(padname), (UV)flags
311         )
312     );
313
314     return (PADLIST*)padlist;
315 }
316
317
318 /*
319 =head1 Embedding Functions
320
321 =for apidoc cv_undef
322
323 Clear out all the active components of a CV. This can happen either
324 by an explicit C<undef &foo>, or by the reference count going to zero.
325 In the former case, we keep the CvOUTSIDE pointer, so that any anonymous
326 children can still follow the full lexical scope chain.
327
328 =cut
329 */
330
331 void
332 Perl_cv_undef(pTHX_ CV *cv)
333 {
334     dVAR;
335     const PADLIST *padlist = CvPADLIST(cv);
336     bool const slabbed = !!CvSLABBED(cv);
337
338     PERL_ARGS_ASSERT_CV_UNDEF;
339
340     DEBUG_X(PerlIO_printf(Perl_debug_log,
341           "CV undef: cv=0x%"UVxf" comppad=0x%"UVxf"\n",
342             PTR2UV(cv), PTR2UV(PL_comppad))
343     );
344
345     if (CvFILE(cv) && CvDYNFILE(cv)) {
346         Safefree(CvFILE(cv));
347     }
348     CvFILE(cv) = NULL;
349
350     CvSLABBED_off(cv);
351     if (!CvISXSUB(cv) && CvROOT(cv)) {
352         if (SvTYPE(cv) == SVt_PVCV && CvDEPTH(cv))
353             Perl_croak(aTHX_ "Can't undef active subroutine");
354         ENTER;
355
356         PAD_SAVE_SETNULLPAD();
357
358         if (slabbed) OpslabREFCNT_dec_padok(OpSLAB(CvROOT(cv)));
359         op_free(CvROOT(cv));
360         CvROOT(cv) = NULL;
361         CvSTART(cv) = NULL;
362         LEAVE;
363     }
364     else if (slabbed && CvSTART(cv)) {
365         ENTER;
366         PAD_SAVE_SETNULLPAD();
367
368         /* discard any leaked ops */
369         opslab_force_free((OPSLAB *)CvSTART(cv));
370         CvSTART(cv) = NULL;
371
372         LEAVE;
373     }
374 #ifdef DEBUGGING
375     else if (slabbed) Perl_warn(aTHX_ "Slab leaked from cv %p", cv);
376 #endif
377     SvPOK_off(MUTABLE_SV(cv));          /* forget prototype */
378     sv_unmagic((SV *)cv, PERL_MAGIC_checkcall);
379     CvGV_set(cv, NULL);
380
381     /* This statement and the subsequence if block was pad_undef().  */
382     pad_peg("pad_undef");
383
384     if (padlist && !SvIS_FREED(padlist) /* may be during global destruction */
385         ) {
386         I32 ix;
387
388         /* Free the padlist associated with a CV.
389            If parts of it happen to be current, we null the relevant PL_*pad*
390            global vars so that we don't have any dangling references left.
391            We also repoint the CvOUTSIDE of any about-to-be-orphaned inner
392            subs to the outer of this cv.  */
393
394         DEBUG_X(PerlIO_printf(Perl_debug_log,
395                               "Pad undef: cv=0x%"UVxf" padlist=0x%"UVxf" comppad=0x%"UVxf"\n",
396                               PTR2UV(cv), PTR2UV(padlist), PTR2UV(PL_comppad))
397                 );
398
399         /* detach any '&' anon children in the pad; if afterwards they
400          * are still live, fix up their CvOUTSIDEs to point to our outside,
401          * bypassing us. */
402         /* XXX DAPM for efficiency, we should only do this if we know we have
403          * children, or integrate this loop with general cleanup */
404
405         if (PL_phase != PERL_PHASE_DESTRUCT) { /* don't bother during global destruction */
406             CV * const outercv = CvOUTSIDE(cv);
407             const U32 seq = CvOUTSIDE_SEQ(cv);
408             AV *  const comppad_name = MUTABLE_AV(AvARRAY(padlist)[0]);
409             SV ** const namepad = AvARRAY(comppad_name);
410             AV *  const comppad = MUTABLE_AV(AvARRAY(padlist)[1]);
411             SV ** const curpad = AvARRAY(comppad);
412             for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
413                 SV * const namesv = namepad[ix];
414                 if (namesv && namesv != &PL_sv_undef
415                     && *SvPVX_const(namesv) == '&')
416                     {
417                         CV * const innercv = MUTABLE_CV(curpad[ix]);
418                         U32 inner_rc = SvREFCNT(innercv);
419                         assert(inner_rc);
420                         assert(SvTYPE(innercv) != SVt_PVFM);
421                         namepad[ix] = NULL;
422                         SvREFCNT_dec(namesv);
423
424                         if (SvREFCNT(comppad) < 2) { /* allow for /(?{ sub{} })/  */
425                             curpad[ix] = NULL;
426                             SvREFCNT_dec(innercv);
427                             inner_rc--;
428                         }
429
430                         /* in use, not just a prototype */
431                         if (inner_rc && (CvOUTSIDE(innercv) == cv)) {
432                             assert(CvWEAKOUTSIDE(innercv));
433                             /* don't relink to grandfather if he's being freed */
434                             if (outercv && SvREFCNT(outercv)) {
435                                 CvWEAKOUTSIDE_off(innercv);
436                                 CvOUTSIDE(innercv) = outercv;
437                                 CvOUTSIDE_SEQ(innercv) = seq;
438                                 SvREFCNT_inc_simple_void_NN(outercv);
439                             }
440                             else {
441                                 CvOUTSIDE(innercv) = NULL;
442                             }
443                         }
444                     }
445             }
446         }
447
448         ix = AvFILLp(padlist);
449         while (ix > 0) {
450             SV* const sv = AvARRAY(padlist)[ix--];
451             if (sv) {
452                 if (sv == (const SV *)PL_comppad) {
453                     PL_comppad = NULL;
454                     PL_curpad = NULL;
455                 }
456                 SvREFCNT_dec(sv);
457             }
458         }
459         {
460             SV *const sv = AvARRAY(padlist)[0];
461             if (sv == (const SV *)PL_comppad_name)
462                 PL_comppad_name = NULL;
463             SvREFCNT_dec(sv);
464         }
465         AvREAL_off(CvPADLIST(cv));
466         SvREFCNT_dec(MUTABLE_SV(CvPADLIST(cv)));
467         CvPADLIST(cv) = NULL;
468     }
469
470
471     /* remove CvOUTSIDE unless this is an undef rather than a free */
472     if (!SvREFCNT(cv) && CvOUTSIDE(cv)) {
473         if (!CvWEAKOUTSIDE(cv))
474             SvREFCNT_dec(CvOUTSIDE(cv));
475         CvOUTSIDE(cv) = NULL;
476     }
477     if (CvCONST(cv)) {
478         SvREFCNT_dec(MUTABLE_SV(CvXSUBANY(cv).any_ptr));
479         CvCONST_off(cv);
480     }
481     if (CvISXSUB(cv) && CvXSUB(cv)) {
482         CvXSUB(cv) = NULL;
483     }
484     /* delete all flags except WEAKOUTSIDE and CVGV_RC, which indicate the
485      * ref status of CvOUTSIDE and CvGV, and ANON, which pp_entersub uses
486      * to choose an error message */
487     CvFLAGS(cv) &= (CVf_WEAKOUTSIDE|CVf_CVGV_RC|CVf_ANON);
488 }
489
490 /*
491 =for apidoc cv_forget_slab
492
493 When a CV has a reference count on its slab (CvSLABBED), it is responsible
494 for making sure it is freed.  (Hence, no two CVs should ever have a
495 reference count on the same slab.)  The CV only needs to reference the slab
496 during compilation.  Once it is compiled and CvROOT attached, it has
497 finished its job, so it can forget the slab.
498
499 =cut
500 */
501
502 void
503 Perl_cv_forget_slab(pTHX_ CV *cv)
504 {
505     const bool slabbed = !!CvSLABBED(cv);
506 #ifdef PERL_DEBUG_READONLY_OPS
507     OPSLAB *slab = NULL;
508 #endif
509
510     PERL_ARGS_ASSERT_CV_FORGET_SLAB;
511
512     if (!slabbed) return;
513
514     CvSLABBED_off(cv);
515
516 #ifdef PERL_DEBUG_READONLY_OPS
517     if      (CvROOT(cv))  slab = OpSLAB(CvROOT(cv));
518     else if (CvSTART(cv)) slab = (OPSLAB *)CvSTART(cv);
519 #else
520     if      (CvROOT(cv))  OpslabREFCNT_dec(OpSLAB(CvROOT(cv)));
521     else if (CvSTART(cv)) OpslabREFCNT_dec((OPSLAB *)CvSTART(cv));
522 #endif
523 #ifdef DEBUGGING
524     else if (slabbed)     Perl_warn(aTHX_ "Slab leaked from cv %p", cv);
525 #endif
526
527 #ifdef PERL_DEBUG_READONLY_OPS
528     if (slab) {
529         size_t refcnt;
530         refcnt = slab->opslab_refcnt;
531         OpslabREFCNT_dec(slab);
532         if (refcnt > 1) Slab_to_ro(slab);
533     }
534 #endif
535 }
536
537 /*
538 =for apidoc m|PADOFFSET|pad_alloc_name|SV *namesv|U32 flags|HV *typestash|HV *ourstash
539
540 Allocates a place in the currently-compiling
541 pad (via L<perlapi/pad_alloc>) and
542 then stores a name for that entry.  I<namesv> is adopted and becomes the
543 name entry; it must already contain the name string and be sufficiently
544 upgraded.  I<typestash> and I<ourstash> and the C<padadd_STATE> flag get
545 added to I<namesv>.  None of the other
546 processing of L<perlapi/pad_add_name_pvn>
547 is done.  Returns the offset of the allocated pad slot.
548
549 =cut
550 */
551
552 static PADOFFSET
553 S_pad_alloc_name(pTHX_ SV *namesv, U32 flags, HV *typestash, HV *ourstash)
554 {
555     dVAR;
556     const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
557
558     PERL_ARGS_ASSERT_PAD_ALLOC_NAME;
559
560     ASSERT_CURPAD_ACTIVE("pad_alloc_name");
561
562     if (typestash) {
563         assert(SvTYPE(namesv) == SVt_PVMG);
564         SvPAD_TYPED_on(namesv);
565         SvSTASH_set(namesv, MUTABLE_HV(SvREFCNT_inc_simple_NN(MUTABLE_SV(typestash))));
566     }
567     if (ourstash) {
568         SvPAD_OUR_on(namesv);
569         SvOURSTASH_set(namesv, ourstash);
570         SvREFCNT_inc_simple_void_NN(ourstash);
571     }
572     else if (flags & padadd_STATE) {
573         SvPAD_STATE_on(namesv);
574     }
575
576     av_store(PL_comppad_name, offset, namesv);
577     return offset;
578 }
579
580 /*
581 =for apidoc Am|PADOFFSET|pad_add_name_pvn|const char *namepv|STRLEN namelen|U32 flags|HV *typestash|HV *ourstash
582
583 Allocates a place in the currently-compiling pad for a named lexical
584 variable.  Stores the name and other metadata in the name part of the
585 pad, and makes preparations to manage the variable's lexical scoping.
586 Returns the offset of the allocated pad slot.
587
588 I<namepv>/I<namelen> specify the variable's name, including leading sigil.
589 If I<typestash> is non-null, the name is for a typed lexical, and this
590 identifies the type.  If I<ourstash> is non-null, it's a lexical reference
591 to a package variable, and this identifies the package.  The following
592 flags can be OR'ed together:
593
594     padadd_OUR          redundantly specifies if it's a package var
595     padadd_STATE        variable will retain value persistently
596     padadd_NO_DUP_CHECK skip check for lexical shadowing
597
598 =cut
599 */
600
601 PADOFFSET
602 Perl_pad_add_name_pvn(pTHX_ const char *namepv, STRLEN namelen,
603                 U32 flags, HV *typestash, HV *ourstash)
604 {
605     dVAR;
606     PADOFFSET offset;
607     SV *namesv;
608     bool is_utf8;
609
610     PERL_ARGS_ASSERT_PAD_ADD_NAME_PVN;
611
612     if (flags & ~(padadd_OUR|padadd_STATE|padadd_NO_DUP_CHECK|padadd_UTF8_NAME))
613         Perl_croak(aTHX_ "panic: pad_add_name_pvn illegal flag bits 0x%" UVxf,
614                    (UV)flags);
615
616     namesv = newSV_type((ourstash || typestash) ? SVt_PVMG : SVt_PVNV);
617     
618     if ((is_utf8 = ((flags & padadd_UTF8_NAME) != 0))) {
619         namepv = (const char*)bytes_from_utf8((U8*)namepv, &namelen, &is_utf8);
620     }
621
622     sv_setpvn(namesv, namepv, namelen);
623
624     if (is_utf8) {
625         flags |= padadd_UTF8_NAME;
626         SvUTF8_on(namesv);
627     }
628     else
629         flags &= ~padadd_UTF8_NAME;
630
631     if ((flags & padadd_NO_DUP_CHECK) == 0) {
632         /* check for duplicate declaration */
633         pad_check_dup(namesv, flags & padadd_OUR, ourstash);
634     }
635
636     offset = pad_alloc_name(namesv, flags & ~padadd_UTF8_NAME, typestash, ourstash);
637
638     /* not yet introduced */
639     COP_SEQ_RANGE_LOW_set(namesv, PERL_PADSEQ_INTRO);
640     COP_SEQ_RANGE_HIGH_set(namesv, 0);
641
642     if (!PL_min_intro_pending)
643         PL_min_intro_pending = offset;
644     PL_max_intro_pending = offset;
645     /* if it's not a simple scalar, replace with an AV or HV */
646     assert(SvTYPE(PL_curpad[offset]) == SVt_NULL);
647     assert(SvREFCNT(PL_curpad[offset]) == 1);
648     if (namelen != 0 && *namepv == '@')
649         sv_upgrade(PL_curpad[offset], SVt_PVAV);
650     else if (namelen != 0 && *namepv == '%')
651         sv_upgrade(PL_curpad[offset], SVt_PVHV);
652     assert(SvPADMY(PL_curpad[offset]));
653     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
654                            "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
655                            (long)offset, SvPVX(namesv),
656                            PTR2UV(PL_curpad[offset])));
657
658     return offset;
659 }
660
661 /*
662 =for apidoc Am|PADOFFSET|pad_add_name_pv|const char *name|U32 flags|HV *typestash|HV *ourstash
663
664 Exactly like L</pad_add_name_pvn>, but takes a nul-terminated string
665 instead of a string/length pair.
666
667 =cut
668 */
669
670 PADOFFSET
671 Perl_pad_add_name_pv(pTHX_ const char *name,
672                      const U32 flags, HV *typestash, HV *ourstash)
673 {
674     PERL_ARGS_ASSERT_PAD_ADD_NAME_PV;
675     return pad_add_name_pvn(name, strlen(name), flags, typestash, ourstash);
676 }
677
678 /*
679 =for apidoc Am|PADOFFSET|pad_add_name_sv|SV *name|U32 flags|HV *typestash|HV *ourstash
680
681 Exactly like L</pad_add_name_pvn>, but takes the name string in the form
682 of an SV instead of a string/length pair.
683
684 =cut
685 */
686
687 PADOFFSET
688 Perl_pad_add_name_sv(pTHX_ SV *name, U32 flags, HV *typestash, HV *ourstash)
689 {
690     char *namepv;
691     STRLEN namelen;
692     PERL_ARGS_ASSERT_PAD_ADD_NAME_SV;
693     namepv = SvPV(name, namelen);
694     if (SvUTF8(name))
695         flags |= padadd_UTF8_NAME;
696     return pad_add_name_pvn(namepv, namelen, flags, typestash, ourstash);
697 }
698
699 /*
700 =for apidoc Amx|PADOFFSET|pad_alloc|I32 optype|U32 tmptype
701
702 Allocates a place in the currently-compiling pad,
703 returning the offset of the allocated pad slot.
704 No name is initially attached to the pad slot.
705 I<tmptype> is a set of flags indicating the kind of pad entry required,
706 which will be set in the value SV for the allocated pad entry:
707
708     SVs_PADMY    named lexical variable ("my", "our", "state")
709     SVs_PADTMP   unnamed temporary store
710
711 I<optype> should be an opcode indicating the type of operation that the
712 pad entry is to support.  This doesn't affect operational semantics,
713 but is used for debugging.
714
715 =cut
716 */
717
718 /* XXX DAPM integrate alloc(), add_name() and add_anon(),
719  * or at least rationalise ??? */
720
721 PADOFFSET
722 Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
723 {
724     dVAR;
725     SV *sv;
726     I32 retval;
727
728     PERL_UNUSED_ARG(optype);
729     ASSERT_CURPAD_ACTIVE("pad_alloc");
730
731     if (AvARRAY(PL_comppad) != PL_curpad)
732         Perl_croak(aTHX_ "panic: pad_alloc, %p!=%p",
733                    AvARRAY(PL_comppad), PL_curpad);
734     if (PL_pad_reset_pending)
735         pad_reset();
736     if (tmptype & SVs_PADMY) {
737         /* For a my, simply push a null SV onto the end of PL_comppad. */
738         sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE);
739         retval = AvFILLp(PL_comppad);
740     }
741     else {
742         /* For a tmp, scan the pad from PL_padix upwards
743          * for a slot which has no name and no active value.
744          */
745         SV * const * const names = AvARRAY(PL_comppad_name);
746         const SSize_t names_fill = AvFILLp(PL_comppad_name);
747         for (;;) {
748             /*
749              * "foreach" index vars temporarily become aliases to non-"my"
750              * values.  Thus we must skip, not just pad values that are
751              * marked as current pad values, but also those with names.
752              */
753             /* HVDS why copy to sv here? we don't seem to use it */
754             if (++PL_padix <= names_fill &&
755                    (sv = names[PL_padix]) && sv != &PL_sv_undef)
756                 continue;
757             sv = *av_fetch(PL_comppad, PL_padix, TRUE);
758             if (!(SvFLAGS(sv) & (SVs_PADTMP | SVs_PADMY)) &&
759                 !IS_PADGV(sv) && !IS_PADCONST(sv))
760                 break;
761         }
762         retval = PL_padix;
763     }
764     SvFLAGS(sv) |= tmptype;
765     PL_curpad = AvARRAY(PL_comppad);
766
767     DEBUG_X(PerlIO_printf(Perl_debug_log,
768           "Pad 0x%"UVxf"[0x%"UVxf"] alloc:   %ld for %s\n",
769           PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long) retval,
770           PL_op_name[optype]));
771 #ifdef DEBUG_LEAKING_SCALARS
772     sv->sv_debug_optype = optype;
773     sv->sv_debug_inpad = 1;
774 #endif
775     return (PADOFFSET)retval;
776 }
777
778 /*
779 =for apidoc Am|PADOFFSET|pad_add_anon|CV *func|I32 optype
780
781 Allocates a place in the currently-compiling pad (via L</pad_alloc>)
782 for an anonymous function that is lexically scoped inside the
783 currently-compiling function.
784 The function I<func> is linked into the pad, and its C<CvOUTSIDE> link
785 to the outer scope is weakened to avoid a reference loop.
786
787 One reference count is stolen, so you may need to do C<SvREFCNT_inc(func)>.
788
789 I<optype> should be an opcode indicating the type of operation that the
790 pad entry is to support.  This doesn't affect operational semantics,
791 but is used for debugging.
792
793 =cut
794 */
795
796 PADOFFSET
797 Perl_pad_add_anon(pTHX_ CV* func, I32 optype)
798 {
799     dVAR;
800     PADOFFSET ix;
801     SV* const name = newSV_type(SVt_PVNV);
802
803     PERL_ARGS_ASSERT_PAD_ADD_ANON;
804
805     pad_peg("add_anon");
806     sv_setpvs(name, "&");
807     /* These two aren't used; just make sure they're not equal to
808      * PERL_PADSEQ_INTRO */
809     COP_SEQ_RANGE_LOW_set(name, 0);
810     COP_SEQ_RANGE_HIGH_set(name, 0);
811     ix = pad_alloc(optype, SVs_PADMY);
812     av_store(PL_comppad_name, ix, name);
813     /* XXX DAPM use PL_curpad[] ? */
814     if (SvTYPE(func) == SVt_PVCV || !CvOUTSIDE(func))
815         av_store(PL_comppad, ix, (SV*)func);
816     else {
817         SV *rv = newRV_noinc((SV *)func);
818         sv_rvweaken(rv);
819         assert (SvTYPE(func) == SVt_PVFM);
820         av_store(PL_comppad, ix, rv);
821     }
822     SvPADMY_on((SV*)func);
823
824     /* to avoid ref loops, we never have parent + child referencing each
825      * other simultaneously */
826     if (CvOUTSIDE(func) && SvTYPE(func) == SVt_PVCV) {
827         assert(!CvWEAKOUTSIDE(func));
828         CvWEAKOUTSIDE_on(func);
829         SvREFCNT_dec(CvOUTSIDE(func));
830     }
831     return ix;
832 }
833
834 /*
835 =for apidoc pad_check_dup
836
837 Check for duplicate declarations: report any of:
838
839      * a my in the current scope with the same name;
840      * an our (anywhere in the pad) with the same name and the
841        same stash as C<ourstash>
842
843 C<is_our> indicates that the name to check is an 'our' declaration.
844
845 =cut
846 */
847
848 STATIC void
849 S_pad_check_dup(pTHX_ SV *name, U32 flags, const HV *ourstash)
850 {
851     dVAR;
852     SV          **svp;
853     PADOFFSET   top, off;
854     const U32   is_our = flags & padadd_OUR;
855
856     PERL_ARGS_ASSERT_PAD_CHECK_DUP;
857
858     ASSERT_CURPAD_ACTIVE("pad_check_dup");
859
860     assert((flags & ~padadd_OUR) == 0);
861
862     if (AvFILLp(PL_comppad_name) < 0 || !ckWARN(WARN_MISC))
863         return; /* nothing to check */
864
865     svp = AvARRAY(PL_comppad_name);
866     top = AvFILLp(PL_comppad_name);
867     /* check the current scope */
868     /* XXX DAPM - why the (I32) cast - shouldn't we ensure they're the same
869      * type ? */
870     for (off = top; (I32)off > PL_comppad_name_floor; off--) {
871         SV * const sv = svp[off];
872         if (sv
873             && sv != &PL_sv_undef
874             && !SvFAKE(sv)
875             && (   COP_SEQ_RANGE_LOW(sv)  == PERL_PADSEQ_INTRO
876                 || COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
877             && sv_eq(name, sv))
878         {
879             if (is_our && (SvPAD_OUR(sv)))
880                 break; /* "our" masking "our" */
881             Perl_warner(aTHX_ packWARN(WARN_MISC),
882                 "\"%s\" variable %"SVf" masks earlier declaration in same %s",
883                 (is_our ? "our" : PL_parser->in_my == KEY_my ? "my" : "state"),
884                 sv,
885                 (COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO
886                     ? "scope" : "statement"));
887             --off;
888             break;
889         }
890     }
891     /* check the rest of the pad */
892     if (is_our) {
893         while (off > 0) {
894             SV * const sv = svp[off];
895             if (sv
896                 && sv != &PL_sv_undef
897                 && !SvFAKE(sv)
898                 && (   COP_SEQ_RANGE_LOW(sv)  == PERL_PADSEQ_INTRO
899                     || COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
900                 && SvOURSTASH(sv) == ourstash
901                 && sv_eq(name, sv))
902             {
903                 Perl_warner(aTHX_ packWARN(WARN_MISC),
904                     "\"our\" variable %"SVf" redeclared", sv);
905                 if ((I32)off <= PL_comppad_name_floor)
906                     Perl_warner(aTHX_ packWARN(WARN_MISC),
907                         "\t(Did you mean \"local\" instead of \"our\"?)\n");
908                 break;
909             }
910             --off;
911         }
912     }
913 }
914
915
916 /*
917 =for apidoc Am|PADOFFSET|pad_findmy_pvn|const char *namepv|STRLEN namelen|U32 flags
918
919 Given the name of a lexical variable, find its position in the
920 currently-compiling pad.
921 I<namepv>/I<namelen> specify the variable's name, including leading sigil.
922 I<flags> is reserved and must be zero.
923 If it is not in the current pad but appears in the pad of any lexically
924 enclosing scope, then a pseudo-entry for it is added in the current pad.
925 Returns the offset in the current pad,
926 or C<NOT_IN_PAD> if no such lexical is in scope.
927
928 =cut
929 */
930
931 PADOFFSET
932 Perl_pad_findmy_pvn(pTHX_ const char *namepv, STRLEN namelen, U32 flags)
933 {
934     dVAR;
935     SV *out_sv;
936     int out_flags;
937     I32 offset;
938     const AV *nameav;
939     SV **name_svp;
940
941     PERL_ARGS_ASSERT_PAD_FINDMY_PVN;
942
943     pad_peg("pad_findmy_pvn");
944
945     if (flags & ~padadd_UTF8_NAME)
946         Perl_croak(aTHX_ "panic: pad_findmy_pvn illegal flag bits 0x%" UVxf,
947                    (UV)flags);
948
949     if (flags & padadd_UTF8_NAME) {
950         bool is_utf8 = TRUE;
951         namepv = (const char*)bytes_from_utf8((U8*)namepv, &namelen, &is_utf8);
952
953         if (is_utf8)
954             flags |= padadd_UTF8_NAME;
955         else
956             flags &= ~padadd_UTF8_NAME;
957     }
958
959     offset = pad_findlex(namepv, namelen, flags,
960                 PL_compcv, PL_cop_seqmax, 1, NULL, &out_sv, &out_flags);
961     if ((PADOFFSET)offset != NOT_IN_PAD) 
962         return offset;
963
964     /* look for an our that's being introduced; this allows
965      *    our $foo = 0 unless defined $foo;
966      * to not give a warning. (Yes, this is a hack) */
967
968     nameav = MUTABLE_AV(AvARRAY(CvPADLIST(PL_compcv))[0]);
969     name_svp = AvARRAY(nameav);
970     for (offset = AvFILLp(nameav); offset > 0; offset--) {
971         const SV * const namesv = name_svp[offset];
972         if (namesv && namesv != &PL_sv_undef
973             && !SvFAKE(namesv)
974             && (SvPAD_OUR(namesv))
975             && SvCUR(namesv) == namelen
976             && sv_eq_pvn_flags(aTHX_ namesv, namepv, namelen,
977                                 flags & padadd_UTF8_NAME ? SVf_UTF8 : 0 )
978             && COP_SEQ_RANGE_LOW(namesv) == PERL_PADSEQ_INTRO
979         )
980             return offset;
981     }
982     return NOT_IN_PAD;
983 }
984
985 /*
986 =for apidoc Am|PADOFFSET|pad_findmy_pv|const char *name|U32 flags
987
988 Exactly like L</pad_findmy_pvn>, but takes a nul-terminated string
989 instead of a string/length pair.
990
991 =cut
992 */
993
994 PADOFFSET
995 Perl_pad_findmy_pv(pTHX_ const char *name, U32 flags)
996 {
997     PERL_ARGS_ASSERT_PAD_FINDMY_PV;
998     return pad_findmy_pvn(name, strlen(name), flags);
999 }
1000
1001 /*
1002 =for apidoc Am|PADOFFSET|pad_findmy_sv|SV *name|U32 flags
1003
1004 Exactly like L</pad_findmy_pvn>, but takes the name string in the form
1005 of an SV instead of a string/length pair.
1006
1007 =cut
1008 */
1009
1010 PADOFFSET
1011 Perl_pad_findmy_sv(pTHX_ SV *name, U32 flags)
1012 {
1013     char *namepv;
1014     STRLEN namelen;
1015     PERL_ARGS_ASSERT_PAD_FINDMY_SV;
1016     namepv = SvPV(name, namelen);
1017     if (SvUTF8(name))
1018         flags |= padadd_UTF8_NAME;
1019     return pad_findmy_pvn(namepv, namelen, flags);
1020 }
1021
1022 /*
1023 =for apidoc Amp|PADOFFSET|find_rundefsvoffset
1024
1025 Find the position of the lexical C<$_> in the pad of the
1026 currently-executing function.  Returns the offset in the current pad,
1027 or C<NOT_IN_PAD> if there is no lexical C<$_> in scope (in which case
1028 the global one should be used instead).
1029 L</find_rundefsv> is likely to be more convenient.
1030
1031 =cut
1032 */
1033
1034 PADOFFSET
1035 Perl_find_rundefsvoffset(pTHX)
1036 {
1037     dVAR;
1038     SV *out_sv;
1039     int out_flags;
1040     return pad_findlex("$_", 2, 0, find_runcv(NULL), PL_curcop->cop_seq, 1,
1041             NULL, &out_sv, &out_flags);
1042 }
1043
1044 /*
1045 =for apidoc Am|SV *|find_rundefsv
1046
1047 Find and return the variable that is named C<$_> in the lexical scope
1048 of the currently-executing function.  This may be a lexical C<$_>,
1049 or will otherwise be the global one.
1050
1051 =cut
1052 */
1053
1054 SV *
1055 Perl_find_rundefsv(pTHX)
1056 {
1057     SV *namesv;
1058     int flags;
1059     PADOFFSET po;
1060
1061     po = pad_findlex("$_", 2, 0, find_runcv(NULL), PL_curcop->cop_seq, 1,
1062             NULL, &namesv, &flags);
1063
1064     if (po == NOT_IN_PAD || SvPAD_OUR(namesv))
1065         return DEFSV;
1066
1067     return PAD_SVl(po);
1068 }
1069
1070 SV *
1071 Perl_find_rundefsv2(pTHX_ CV *cv, U32 seq)
1072 {
1073     SV *namesv;
1074     int flags;
1075     PADOFFSET po;
1076
1077     PERL_ARGS_ASSERT_FIND_RUNDEFSV2;
1078
1079     po = pad_findlex("$_", 2, 0, cv, seq, 1,
1080             NULL, &namesv, &flags);
1081
1082     if (po == NOT_IN_PAD || SvPAD_OUR(namesv))
1083         return DEFSV;
1084
1085     return AvARRAY((PAD*) (AvARRAY(CvPADLIST(cv))[CvDEPTH(cv)]))[po];
1086 }
1087
1088 /*
1089 =for apidoc m|PADOFFSET|pad_findlex|const char *namepv|STRLEN namelen|U32 flags|const CV* cv|U32 seq|int warn|SV** out_capture|SV** out_name_sv|int *out_flags
1090
1091 Find a named lexical anywhere in a chain of nested pads. Add fake entries
1092 in the inner pads if it's found in an outer one.
1093
1094 Returns the offset in the bottom pad of the lex or the fake lex.
1095 cv is the CV in which to start the search, and seq is the current cop_seq
1096 to match against. If warn is true, print appropriate warnings.  The out_*
1097 vars return values, and so are pointers to where the returned values
1098 should be stored. out_capture, if non-null, requests that the innermost
1099 instance of the lexical is captured; out_name_sv is set to the innermost
1100 matched namesv or fake namesv; out_flags returns the flags normally
1101 associated with the IVX field of a fake namesv.
1102
1103 Note that pad_findlex() is recursive; it recurses up the chain of CVs,
1104 then comes back down, adding fake entries as it goes. It has to be this way
1105 because fake namesvs in anon protoypes have to store in xlow the index into
1106 the parent pad.
1107
1108 =cut
1109 */
1110
1111 /* the CV has finished being compiled. This is not a sufficient test for
1112  * all CVs (eg XSUBs), but suffices for the CVs found in a lexical chain */
1113 #define CvCOMPILED(cv)  CvROOT(cv)
1114
1115 /* the CV does late binding of its lexicals */
1116 #define CvLATE(cv) (CvANON(cv) || SvTYPE(cv) == SVt_PVFM)
1117
1118
1119 STATIC PADOFFSET
1120 S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv, U32 seq,
1121         int warn, SV** out_capture, SV** out_name_sv, int *out_flags)
1122 {
1123     dVAR;
1124     I32 offset, new_offset;
1125     SV *new_capture;
1126     SV **new_capturep;
1127     const AV * const padlist = CvPADLIST(cv);
1128     const bool staleok = !!(flags & padadd_STALEOK);
1129
1130     PERL_ARGS_ASSERT_PAD_FINDLEX;
1131
1132     if (flags & ~(padadd_UTF8_NAME|padadd_STALEOK))
1133         Perl_croak(aTHX_ "panic: pad_findlex illegal flag bits 0x%" UVxf,
1134                    (UV)flags);
1135     flags &= ~ padadd_STALEOK; /* one-shot flag */
1136
1137     *out_flags = 0;
1138
1139     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1140         "Pad findlex cv=0x%"UVxf" searching \"%.*s\" seq=%d%s\n",
1141                            PTR2UV(cv), (int)namelen, namepv, (int)seq,
1142         out_capture ? " capturing" : "" ));
1143
1144     /* first, search this pad */
1145
1146     if (padlist) { /* not an undef CV */
1147         I32 fake_offset = 0;
1148         const AV * const nameav = MUTABLE_AV(AvARRAY(padlist)[0]);
1149         SV * const * const name_svp = AvARRAY(nameav);
1150
1151         for (offset = AvFILLp(nameav); offset > 0; offset--) {
1152             const SV * const namesv = name_svp[offset];
1153             if (namesv && namesv != &PL_sv_undef
1154                     && SvCUR(namesv) == namelen
1155                     && sv_eq_pvn_flags(aTHX_ namesv, namepv, namelen,
1156                                     flags & padadd_UTF8_NAME ? SVf_UTF8 : 0))
1157             {
1158                 if (SvFAKE(namesv)) {
1159                     fake_offset = offset; /* in case we don't find a real one */
1160                     continue;
1161                 }
1162                 /* is seq within the range _LOW to _HIGH ?
1163                  * This is complicated by the fact that PL_cop_seqmax
1164                  * may have wrapped around at some point */
1165                 if (COP_SEQ_RANGE_LOW(namesv) == PERL_PADSEQ_INTRO)
1166                     continue; /* not yet introduced */
1167
1168                 if (COP_SEQ_RANGE_HIGH(namesv) == PERL_PADSEQ_INTRO) {
1169                     /* in compiling scope */
1170                     if (
1171                         (seq >  COP_SEQ_RANGE_LOW(namesv))
1172                         ? (seq - COP_SEQ_RANGE_LOW(namesv) < (U32_MAX >> 1))
1173                         : (COP_SEQ_RANGE_LOW(namesv) - seq > (U32_MAX >> 1))
1174                     )
1175                        break;
1176                 }
1177                 else if (
1178                     (COP_SEQ_RANGE_LOW(namesv) > COP_SEQ_RANGE_HIGH(namesv))
1179                     ?
1180                         (  seq >  COP_SEQ_RANGE_LOW(namesv)
1181                         || seq <= COP_SEQ_RANGE_HIGH(namesv))
1182
1183                     :    (  seq >  COP_SEQ_RANGE_LOW(namesv)
1184                          && seq <= COP_SEQ_RANGE_HIGH(namesv))
1185                 )
1186                 break;
1187             }
1188         }
1189
1190         if (offset > 0 || fake_offset > 0 ) { /* a match! */
1191             if (offset > 0) { /* not fake */
1192                 fake_offset = 0;
1193                 *out_name_sv = name_svp[offset]; /* return the namesv */
1194
1195                 /* set PAD_FAKELEX_MULTI if this lex can have multiple
1196                  * instances. For now, we just test !CvUNIQUE(cv), but
1197                  * ideally, we should detect my's declared within loops
1198                  * etc - this would allow a wider range of 'not stayed
1199                  * shared' warnings. We also treated already-compiled
1200                  * lexes as not multi as viewed from evals. */
1201
1202                 *out_flags = CvANON(cv) ?
1203                         PAD_FAKELEX_ANON :
1204                             (!CvUNIQUE(cv) && ! CvCOMPILED(cv))
1205                                 ? PAD_FAKELEX_MULTI : 0;
1206
1207                 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1208                     "Pad findlex cv=0x%"UVxf" matched: offset=%ld (%lu,%lu)\n",
1209                     PTR2UV(cv), (long)offset,
1210                     (unsigned long)COP_SEQ_RANGE_LOW(*out_name_sv),
1211                     (unsigned long)COP_SEQ_RANGE_HIGH(*out_name_sv)));
1212             }
1213             else { /* fake match */
1214                 offset = fake_offset;
1215                 *out_name_sv = name_svp[offset]; /* return the namesv */
1216                 *out_flags = PARENT_FAKELEX_FLAGS(*out_name_sv);
1217                 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1218                     "Pad findlex cv=0x%"UVxf" matched: offset=%ld flags=0x%lx index=%lu\n",
1219                     PTR2UV(cv), (long)offset, (unsigned long)*out_flags,
1220                     (unsigned long) PARENT_PAD_INDEX(*out_name_sv) 
1221                 ));
1222             }
1223
1224             /* return the lex? */
1225
1226             if (out_capture) {
1227
1228                 /* our ? */
1229                 if (SvPAD_OUR(*out_name_sv)) {
1230                     *out_capture = NULL;
1231                     return offset;
1232                 }
1233
1234                 /* trying to capture from an anon prototype? */
1235                 if (CvCOMPILED(cv)
1236                         ? CvANON(cv) && CvCLONE(cv) && !CvCLONED(cv)
1237                         : *out_flags & PAD_FAKELEX_ANON)
1238                 {
1239                     if (warn)
1240                         Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
1241                                        "Variable \"%"SVf"\" is not available",
1242                                        newSVpvn_flags(namepv, namelen,
1243                                            SVs_TEMP |
1244                                            (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
1245
1246                     *out_capture = NULL;
1247                 }
1248
1249                 /* real value */
1250                 else {
1251                     int newwarn = warn;
1252                     if (!CvCOMPILED(cv) && (*out_flags & PAD_FAKELEX_MULTI)
1253                          && !SvPAD_STATE(name_svp[offset])
1254                          && warn && ckWARN(WARN_CLOSURE)) {
1255                         newwarn = 0;
1256                         Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
1257                             "Variable \"%"SVf"\" will not stay shared",
1258                             newSVpvn_flags(namepv, namelen,
1259                                 SVs_TEMP |
1260                                 (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
1261                     }
1262
1263                     if (fake_offset && CvANON(cv)
1264                             && CvCLONE(cv) &&!CvCLONED(cv))
1265                     {
1266                         SV *n;
1267                         /* not yet caught - look further up */
1268                         DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1269                             "Pad findlex cv=0x%"UVxf" chasing lex in outer pad\n",
1270                             PTR2UV(cv)));
1271                         n = *out_name_sv;
1272                         (void) pad_findlex(namepv, namelen, flags, CvOUTSIDE(cv),
1273                             CvOUTSIDE_SEQ(cv),
1274                             newwarn, out_capture, out_name_sv, out_flags);
1275                         *out_name_sv = n;
1276                         return offset;
1277                     }
1278
1279                     *out_capture = AvARRAY(MUTABLE_AV(AvARRAY(padlist)[
1280                                     CvDEPTH(cv) ? CvDEPTH(cv) : 1]))[offset];
1281                     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1282                         "Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n",
1283                         PTR2UV(cv), PTR2UV(*out_capture)));
1284
1285                     if (SvPADSTALE(*out_capture)
1286                         && (!CvDEPTH(cv) || !staleok)
1287                         && !SvPAD_STATE(name_svp[offset]))
1288                     {
1289                         Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
1290                                        "Variable \"%"SVf"\" is not available",
1291                                        newSVpvn_flags(namepv, namelen,
1292                                            SVs_TEMP |
1293                                            (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
1294                         *out_capture = NULL;
1295                     }
1296                 }
1297                 if (!*out_capture) {
1298                     if (namelen != 0 && *namepv == '@')
1299                         *out_capture = sv_2mortal(MUTABLE_SV(newAV()));
1300                     else if (namelen != 0 && *namepv == '%')
1301                         *out_capture = sv_2mortal(MUTABLE_SV(newHV()));
1302                     else
1303                         *out_capture = sv_newmortal();
1304                 }
1305             }
1306
1307             return offset;
1308         }
1309     }
1310
1311     /* it's not in this pad - try above */
1312
1313     if (!CvOUTSIDE(cv))
1314         return NOT_IN_PAD;
1315
1316     /* out_capture non-null means caller wants us to capture lex; in
1317      * addition we capture ourselves unless it's an ANON/format */
1318     new_capturep = out_capture ? out_capture :
1319                 CvLATE(cv) ? NULL : &new_capture;
1320
1321     offset = pad_findlex(namepv, namelen,
1322                 flags | padadd_STALEOK*(new_capturep == &new_capture),
1323                 CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1,
1324                 new_capturep, out_name_sv, out_flags);
1325     if ((PADOFFSET)offset == NOT_IN_PAD)
1326         return NOT_IN_PAD;
1327
1328     /* found in an outer CV. Add appropriate fake entry to this pad */
1329
1330     /* don't add new fake entries (via eval) to CVs that we have already
1331      * finished compiling, or to undef CVs */
1332     if (CvCOMPILED(cv) || !padlist)
1333         return 0; /* this dummy (and invalid) value isnt used by the caller */
1334
1335     {
1336         /* This relies on sv_setsv_flags() upgrading the destination to the same
1337            type as the source, independent of the flags set, and on it being
1338            "good" and only copying flag bits and pointers that it understands.
1339         */
1340         SV *new_namesv = newSVsv(*out_name_sv);
1341         AV *  const ocomppad_name = PL_comppad_name;
1342         PAD * const ocomppad = PL_comppad;
1343         PL_comppad_name = MUTABLE_AV(AvARRAY(padlist)[0]);
1344         PL_comppad = MUTABLE_AV(AvARRAY(padlist)[1]);
1345         PL_curpad = AvARRAY(PL_comppad);
1346
1347         new_offset
1348             = pad_alloc_name(new_namesv,
1349                               (SvPAD_STATE(*out_name_sv) ? padadd_STATE : 0),
1350                               SvPAD_TYPED(*out_name_sv)
1351                               ? SvSTASH(*out_name_sv) : NULL,
1352                               SvOURSTASH(*out_name_sv)
1353                               );
1354
1355         SvFAKE_on(new_namesv);
1356         DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1357                                "Pad addname: %ld \"%.*s\" FAKE\n",
1358                                (long)new_offset,
1359                                (int) SvCUR(new_namesv), SvPVX(new_namesv)));
1360         PARENT_FAKELEX_FLAGS_set(new_namesv, *out_flags);
1361
1362         PARENT_PAD_INDEX_set(new_namesv, 0);
1363         if (SvPAD_OUR(new_namesv)) {
1364             NOOP;   /* do nothing */
1365         }
1366         else if (CvLATE(cv)) {
1367             /* delayed creation - just note the offset within parent pad */
1368             PARENT_PAD_INDEX_set(new_namesv, offset);
1369             CvCLONE_on(cv);
1370         }
1371         else {
1372             /* immediate creation - capture outer value right now */
1373             av_store(PL_comppad, new_offset, SvREFCNT_inc(*new_capturep));
1374             DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1375                 "Pad findlex cv=0x%"UVxf" saved captured sv 0x%"UVxf" at offset %ld\n",
1376                 PTR2UV(cv), PTR2UV(*new_capturep), (long)new_offset));
1377         }
1378         *out_name_sv = new_namesv;
1379         *out_flags = PARENT_FAKELEX_FLAGS(new_namesv);
1380
1381         PL_comppad_name = ocomppad_name;
1382         PL_comppad = ocomppad;
1383         PL_curpad = ocomppad ? AvARRAY(ocomppad) : NULL;
1384     }
1385     return new_offset;
1386 }
1387
1388 #ifdef DEBUGGING
1389
1390 /*
1391 =for apidoc Am|SV *|pad_sv|PADOFFSET po
1392
1393 Get the value at offset I<po> in the current (compiling or executing) pad.
1394 Use macro PAD_SV instead of calling this function directly.
1395
1396 =cut
1397 */
1398
1399 SV *
1400 Perl_pad_sv(pTHX_ PADOFFSET po)
1401 {
1402     dVAR;
1403     ASSERT_CURPAD_ACTIVE("pad_sv");
1404
1405     if (!po)
1406         Perl_croak(aTHX_ "panic: pad_sv po");
1407     DEBUG_X(PerlIO_printf(Perl_debug_log,
1408         "Pad 0x%"UVxf"[0x%"UVxf"] sv:      %ld sv=0x%"UVxf"\n",
1409         PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(PL_curpad[po]))
1410     );
1411     return PL_curpad[po];
1412 }
1413
1414 /*
1415 =for apidoc Am|void|pad_setsv|PADOFFSET po|SV *sv
1416
1417 Set the value at offset I<po> in the current (compiling or executing) pad.
1418 Use the macro PAD_SETSV() rather than calling this function directly.
1419
1420 =cut
1421 */
1422
1423 void
1424 Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
1425 {
1426     dVAR;
1427
1428     PERL_ARGS_ASSERT_PAD_SETSV;
1429
1430     ASSERT_CURPAD_ACTIVE("pad_setsv");
1431
1432     DEBUG_X(PerlIO_printf(Perl_debug_log,
1433         "Pad 0x%"UVxf"[0x%"UVxf"] setsv:   %ld sv=0x%"UVxf"\n",
1434         PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(sv))
1435     );
1436     PL_curpad[po] = sv;
1437 }
1438
1439 #endif /* DEBUGGING */
1440
1441 /*
1442 =for apidoc m|void|pad_block_start|int full
1443
1444 Update the pad compilation state variables on entry to a new block.
1445
1446 =cut
1447 */
1448
1449 /* XXX DAPM perhaps:
1450  *      - integrate this in general state-saving routine ???
1451  *      - combine with the state-saving going on in pad_new ???
1452  *      - introduce a new SAVE type that does all this in one go ?
1453  */
1454
1455 void
1456 Perl_pad_block_start(pTHX_ int full)
1457 {
1458     dVAR;
1459     ASSERT_CURPAD_ACTIVE("pad_block_start");
1460     SAVEI32(PL_comppad_name_floor);
1461     PL_comppad_name_floor = AvFILLp(PL_comppad_name);
1462     if (full)
1463         PL_comppad_name_fill = PL_comppad_name_floor;
1464     if (PL_comppad_name_floor < 0)
1465         PL_comppad_name_floor = 0;
1466     SAVEI32(PL_min_intro_pending);
1467     SAVEI32(PL_max_intro_pending);
1468     PL_min_intro_pending = 0;
1469     SAVEI32(PL_comppad_name_fill);
1470     SAVEI32(PL_padix_floor);
1471     PL_padix_floor = PL_padix;
1472     PL_pad_reset_pending = FALSE;
1473 }
1474
1475 /*
1476 =for apidoc m|U32|intro_my
1477
1478 "Introduce" my variables to visible status.  This is called during parsing
1479 at the end of each statement to make lexical variables visible to
1480 subsequent statements.
1481
1482 =cut
1483 */
1484
1485 U32
1486 Perl_intro_my(pTHX)
1487 {
1488     dVAR;
1489     SV **svp;
1490     I32 i;
1491     U32 seq;
1492
1493     ASSERT_CURPAD_ACTIVE("intro_my");
1494     if (! PL_min_intro_pending)
1495         return PL_cop_seqmax;
1496
1497     svp = AvARRAY(PL_comppad_name);
1498     for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
1499         SV * const sv = svp[i];
1500
1501         if (sv && sv != &PL_sv_undef && !SvFAKE(sv)
1502             && COP_SEQ_RANGE_LOW(sv) == PERL_PADSEQ_INTRO)
1503         {
1504             COP_SEQ_RANGE_HIGH_set(sv, PERL_PADSEQ_INTRO); /* Don't know scope end yet. */
1505             COP_SEQ_RANGE_LOW_set(sv, PL_cop_seqmax);
1506             DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1507                 "Pad intromy: %ld \"%s\", (%lu,%lu)\n",
1508                 (long)i, SvPVX_const(sv),
1509                 (unsigned long)COP_SEQ_RANGE_LOW(sv),
1510                 (unsigned long)COP_SEQ_RANGE_HIGH(sv))
1511             );
1512         }
1513     }
1514     seq = PL_cop_seqmax;
1515     PL_cop_seqmax++;
1516     if (PL_cop_seqmax == PERL_PADSEQ_INTRO) /* not a legal value */
1517         PL_cop_seqmax++;
1518     PL_min_intro_pending = 0;
1519     PL_comppad_name_fill = PL_max_intro_pending; /* Needn't search higher */
1520     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1521                 "Pad intromy: seq -> %ld\n", (long)(PL_cop_seqmax)));
1522
1523     return seq;
1524 }
1525
1526 /*
1527 =for apidoc m|void|pad_leavemy
1528
1529 Cleanup at end of scope during compilation: set the max seq number for
1530 lexicals in this scope and warn of any lexicals that never got introduced.
1531
1532 =cut
1533 */
1534
1535 void
1536 Perl_pad_leavemy(pTHX)
1537 {
1538     dVAR;
1539     I32 off;
1540     SV * const * const svp = AvARRAY(PL_comppad_name);
1541
1542     PL_pad_reset_pending = FALSE;
1543
1544     ASSERT_CURPAD_ACTIVE("pad_leavemy");
1545     if (PL_min_intro_pending && PL_comppad_name_fill < PL_min_intro_pending) {
1546         for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
1547             const SV * const sv = svp[off];
1548             if (sv && sv != &PL_sv_undef && !SvFAKE(sv))
1549                 Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
1550                                  "%"SVf" never introduced",
1551                                  SVfARG(sv));
1552         }
1553     }
1554     /* "Deintroduce" my variables that are leaving with this scope. */
1555     for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_fill; off--) {
1556         const SV * const sv = svp[off];
1557         if (sv && sv != &PL_sv_undef && !SvFAKE(sv)
1558             && COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
1559         {
1560             COP_SEQ_RANGE_HIGH_set(sv, PL_cop_seqmax);
1561             DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1562                 "Pad leavemy: %ld \"%s\", (%lu,%lu)\n",
1563                 (long)off, SvPVX_const(sv),
1564                 (unsigned long)COP_SEQ_RANGE_LOW(sv),
1565                 (unsigned long)COP_SEQ_RANGE_HIGH(sv))
1566             );
1567         }
1568     }
1569     PL_cop_seqmax++;
1570     if (PL_cop_seqmax == PERL_PADSEQ_INTRO) /* not a legal value */
1571         PL_cop_seqmax++;
1572     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1573             "Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax));
1574 }
1575
1576 /*
1577 =for apidoc m|void|pad_swipe|PADOFFSET po|bool refadjust
1578
1579 Abandon the tmp in the current pad at offset po and replace with a
1580 new one.
1581
1582 =cut
1583 */
1584
1585 void
1586 Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
1587 {
1588     dVAR;
1589     ASSERT_CURPAD_LEGAL("pad_swipe");
1590     if (!PL_curpad)
1591         return;
1592     if (AvARRAY(PL_comppad) != PL_curpad)
1593         Perl_croak(aTHX_ "panic: pad_swipe curpad, %p!=%p",
1594                    AvARRAY(PL_comppad), PL_curpad);
1595     if (!po || ((SSize_t)po) > AvFILLp(PL_comppad))
1596         Perl_croak(aTHX_ "panic: pad_swipe po=%ld, fill=%ld",
1597                    (long)po, (long)AvFILLp(PL_comppad));
1598
1599     DEBUG_X(PerlIO_printf(Perl_debug_log,
1600                 "Pad 0x%"UVxf"[0x%"UVxf"] swipe:   %ld\n",
1601                 PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po));
1602
1603     if (PL_curpad[po])
1604         SvPADTMP_off(PL_curpad[po]);
1605     if (refadjust)
1606         SvREFCNT_dec(PL_curpad[po]);
1607
1608
1609     /* if pad tmps aren't shared between ops, then there's no need to
1610      * create a new tmp when an existing op is freed */
1611 #ifdef USE_BROKEN_PAD_RESET
1612     PL_curpad[po] = newSV(0);
1613     SvPADTMP_on(PL_curpad[po]);
1614 #else
1615     PL_curpad[po] = &PL_sv_undef;
1616 #endif
1617     if ((I32)po < PL_padix)
1618         PL_padix = po - 1;
1619 }
1620
1621 /*
1622 =for apidoc m|void|pad_reset
1623
1624 Mark all the current temporaries for reuse
1625
1626 =cut
1627 */
1628
1629 /* XXX pad_reset() is currently disabled because it results in serious bugs.
1630  * It causes pad temp TARGs to be shared between OPs. Since TARGs are pushed
1631  * on the stack by OPs that use them, there are several ways to get an alias
1632  * to  a shared TARG.  Such an alias will change randomly and unpredictably.
1633  * We avoid doing this until we can think of a Better Way.
1634  * GSAR 97-10-29 */
1635 static void
1636 S_pad_reset(pTHX)
1637 {
1638     dVAR;
1639 #ifdef USE_BROKEN_PAD_RESET
1640     if (AvARRAY(PL_comppad) != PL_curpad)
1641         Perl_croak(aTHX_ "panic: pad_reset curpad, %p!=%p",
1642                    AvARRAY(PL_comppad), PL_curpad);
1643
1644     DEBUG_X(PerlIO_printf(Perl_debug_log,
1645             "Pad 0x%"UVxf"[0x%"UVxf"] reset:     padix %ld -> %ld",
1646             PTR2UV(PL_comppad), PTR2UV(PL_curpad),
1647                 (long)PL_padix, (long)PL_padix_floor
1648             )
1649     );
1650
1651     if (!PL_tainting) { /* Can't mix tainted and non-tainted temporaries. */
1652         I32 po;
1653         for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
1654             if (PL_curpad[po] && !SvIMMORTAL(PL_curpad[po]))
1655                 SvPADTMP_off(PL_curpad[po]);
1656         }
1657         PL_padix = PL_padix_floor;
1658     }
1659 #endif
1660     PL_pad_reset_pending = FALSE;
1661 }
1662
1663 /*
1664 =for apidoc Amx|void|pad_tidy|padtidy_type type
1665
1666 Tidy up a pad at the end of compilation of the code to which it belongs.
1667 Jobs performed here are: remove most stuff from the pads of anonsub
1668 prototypes; give it a @_; mark temporaries as such.  I<type> indicates
1669 the kind of subroutine:
1670
1671     padtidy_SUB        ordinary subroutine
1672     padtidy_SUBCLONE   prototype for lexical closure
1673     padtidy_FORMAT     format
1674
1675 =cut
1676 */
1677
1678 /* XXX DAPM surely most of this stuff should be done properly
1679  * at the right time beforehand, rather than going around afterwards
1680  * cleaning up our mistakes ???
1681  */
1682
1683 void
1684 Perl_pad_tidy(pTHX_ padtidy_type type)
1685 {
1686     dVAR;
1687
1688     ASSERT_CURPAD_ACTIVE("pad_tidy");
1689
1690     /* If this CV has had any 'eval-capable' ops planted in it
1691      * (ie it contains eval '...', //ee, /$var/ or /(?{..})/), Then any
1692      * anon prototypes in the chain of CVs should be marked as cloneable,
1693      * so that for example the eval's CV in C<< sub { eval '$x' } >> gets
1694      * the right CvOUTSIDE.
1695      * If running with -d, *any* sub may potentially have an eval
1696      * executed within it.
1697      */
1698
1699     if (PL_cv_has_eval || PL_perldb) {
1700         const CV *cv;
1701         for (cv = PL_compcv ;cv; cv = CvOUTSIDE(cv)) {
1702             if (cv != PL_compcv && CvCOMPILED(cv))
1703                 break; /* no need to mark already-compiled code */
1704             if (CvANON(cv)) {
1705                 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1706                     "Pad clone on cv=0x%"UVxf"\n", PTR2UV(cv)));
1707                 CvCLONE_on(cv);
1708                 CvHASEVAL_on(cv);
1709             }
1710         }
1711     }
1712
1713     /* extend curpad to match namepad */
1714     if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
1715         av_store(PL_comppad_name, AvFILLp(PL_comppad), NULL);
1716
1717     if (type == padtidy_SUBCLONE) {
1718         SV * const * const namep = AvARRAY(PL_comppad_name);
1719         PADOFFSET ix;
1720
1721         for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1722             SV *namesv;
1723
1724             if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
1725                 continue;
1726             /*
1727              * The only things that a clonable function needs in its
1728              * pad are anonymous subs.
1729              * The rest are created anew during cloning.
1730              */
1731             if (!((namesv = namep[ix]) != NULL &&
1732                   namesv != &PL_sv_undef &&
1733                    *SvPVX_const(namesv) == '&'))
1734             {
1735                 SvREFCNT_dec(PL_curpad[ix]);
1736                 PL_curpad[ix] = NULL;
1737             }
1738         }
1739     }
1740     else if (type == padtidy_SUB) {
1741         /* XXX DAPM this same bit of code keeps appearing !!! Rationalise? */
1742         AV * const av = newAV();                        /* Will be @_ */
1743         av_store(PL_comppad, 0, MUTABLE_SV(av));
1744         AvREIFY_only(av);
1745     }
1746
1747     if (type == padtidy_SUB || type == padtidy_FORMAT) {
1748         SV * const * const namep = AvARRAY(PL_comppad_name);
1749         PADOFFSET ix;
1750         for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
1751             if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
1752                 continue;
1753             if (!SvPADMY(PL_curpad[ix])) {
1754                 SvPADTMP_on(PL_curpad[ix]);
1755             } else if (!SvFAKE(namep[ix])) {
1756                 /* This is a work around for how the current implementation of
1757                    ?{ } blocks in regexps interacts with lexicals.
1758
1759                    One of our lexicals.
1760                    Can't do this on all lexicals, otherwise sub baz() won't
1761                    compile in
1762
1763                    my $foo;
1764
1765                    sub bar { ++$foo; }
1766
1767                    sub baz { ++$foo; }
1768
1769                    because completion of compiling &bar calling pad_tidy()
1770                    would cause (top level) $foo to be marked as stale, and
1771                    "no longer available".  */
1772                 SvPADSTALE_on(PL_curpad[ix]);
1773             }
1774         }
1775     }
1776     PL_curpad = AvARRAY(PL_comppad);
1777 }
1778
1779 /*
1780 =for apidoc m|void|pad_free|PADOFFSET po
1781
1782 Free the SV at offset po in the current pad.
1783
1784 =cut
1785 */
1786
1787 /* XXX DAPM integrate with pad_swipe ???? */
1788 void
1789 Perl_pad_free(pTHX_ PADOFFSET po)
1790 {
1791     dVAR;
1792     ASSERT_CURPAD_LEGAL("pad_free");
1793     if (!PL_curpad)
1794         return;
1795     if (AvARRAY(PL_comppad) != PL_curpad)
1796         Perl_croak(aTHX_ "panic: pad_free curpad, %p!=%p",
1797                    AvARRAY(PL_comppad), PL_curpad);
1798     if (!po)
1799         Perl_croak(aTHX_ "panic: pad_free po");
1800
1801     DEBUG_X(PerlIO_printf(Perl_debug_log,
1802             "Pad 0x%"UVxf"[0x%"UVxf"] free:    %ld\n",
1803             PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po)
1804     );
1805
1806     if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
1807         SvFLAGS(PL_curpad[po]) &= ~SVs_PADTMP; /* also clears SVs_PADSTALE */
1808     }
1809     if ((I32)po < PL_padix)
1810         PL_padix = po - 1;
1811 }
1812
1813 /*
1814 =for apidoc m|void|do_dump_pad|I32 level|PerlIO *file|PADLIST *padlist|int full
1815
1816 Dump the contents of a padlist
1817
1818 =cut
1819 */
1820
1821 void
1822 Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
1823 {
1824     dVAR;
1825     const AV *pad_name;
1826     const AV *pad;
1827     SV **pname;
1828     SV **ppad;
1829     I32 ix;
1830
1831     PERL_ARGS_ASSERT_DO_DUMP_PAD;
1832
1833     if (!padlist) {
1834         return;
1835     }
1836     pad_name = MUTABLE_AV(*av_fetch(MUTABLE_AV(padlist), 0, FALSE));
1837     pad = MUTABLE_AV(*av_fetch(MUTABLE_AV(padlist), 1, FALSE));
1838     pname = AvARRAY(pad_name);
1839     ppad = AvARRAY(pad);
1840     Perl_dump_indent(aTHX_ level, file,
1841             "PADNAME = 0x%"UVxf"(0x%"UVxf") PAD = 0x%"UVxf"(0x%"UVxf")\n",
1842             PTR2UV(pad_name), PTR2UV(pname), PTR2UV(pad), PTR2UV(ppad)
1843     );
1844
1845     for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
1846         const SV *namesv = pname[ix];
1847         if (namesv && namesv == &PL_sv_undef) {
1848             namesv = NULL;
1849         }
1850         if (namesv) {
1851             if (SvFAKE(namesv))
1852                 Perl_dump_indent(aTHX_ level+1, file,
1853                     "%2d. 0x%"UVxf"<%lu> FAKE \"%s\" flags=0x%lx index=%lu\n",
1854                     (int) ix,
1855                     PTR2UV(ppad[ix]),
1856                     (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
1857                     SvPVX_const(namesv),
1858                     (unsigned long)PARENT_FAKELEX_FLAGS(namesv),
1859                     (unsigned long)PARENT_PAD_INDEX(namesv)
1860
1861                 );
1862             else
1863                 Perl_dump_indent(aTHX_ level+1, file,
1864                     "%2d. 0x%"UVxf"<%lu> (%lu,%lu) \"%s\"\n",
1865                     (int) ix,
1866                     PTR2UV(ppad[ix]),
1867                     (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
1868                     (unsigned long)COP_SEQ_RANGE_LOW(namesv),
1869                     (unsigned long)COP_SEQ_RANGE_HIGH(namesv),
1870                     SvPVX_const(namesv)
1871                 );
1872         }
1873         else if (full) {
1874             Perl_dump_indent(aTHX_ level+1, file,
1875                 "%2d. 0x%"UVxf"<%lu>\n",
1876                 (int) ix,
1877                 PTR2UV(ppad[ix]),
1878                 (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0)
1879             );
1880         }
1881     }
1882 }
1883
1884 #ifdef DEBUGGING
1885
1886 /*
1887 =for apidoc m|void|cv_dump|CV *cv|const char *title
1888
1889 dump the contents of a CV
1890
1891 =cut
1892 */
1893
1894 STATIC void
1895 S_cv_dump(pTHX_ const CV *cv, const char *title)
1896 {
1897     dVAR;
1898     const CV * const outside = CvOUTSIDE(cv);
1899     AV* const padlist = CvPADLIST(cv);
1900
1901     PERL_ARGS_ASSERT_CV_DUMP;
1902
1903     PerlIO_printf(Perl_debug_log,
1904                   "  %s: CV=0x%"UVxf" (%s), OUTSIDE=0x%"UVxf" (%s)\n",
1905                   title,
1906                   PTR2UV(cv),
1907                   (CvANON(cv) ? "ANON"
1908                    : (SvTYPE(cv) == SVt_PVFM) ? "FORMAT"
1909                    : (cv == PL_main_cv) ? "MAIN"
1910                    : CvUNIQUE(cv) ? "UNIQUE"
1911                    : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
1912                   PTR2UV(outside),
1913                   (!outside ? "null"
1914                    : CvANON(outside) ? "ANON"
1915                    : (outside == PL_main_cv) ? "MAIN"
1916                    : CvUNIQUE(outside) ? "UNIQUE"
1917                    : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
1918
1919     PerlIO_printf(Perl_debug_log,
1920                     "    PADLIST = 0x%"UVxf"\n", PTR2UV(padlist));
1921     do_dump_pad(1, Perl_debug_log, padlist, 1);
1922 }
1923
1924 #endif /* DEBUGGING */
1925
1926 /*
1927 =for apidoc Am|CV *|cv_clone|CV *proto
1928
1929 Clone a CV, making a lexical closure.  I<proto> supplies the prototype
1930 of the function: its code, pad structure, and other attributes.
1931 The prototype is combined with a capture of outer lexicals to which the
1932 code refers, which are taken from the currently-executing instance of
1933 the immediately surrounding code.
1934
1935 =cut
1936 */
1937
1938 CV *
1939 Perl_cv_clone(pTHX_ CV *proto)
1940 {
1941     dVAR;
1942     I32 ix;
1943     AV* const protopadlist = CvPADLIST(proto);
1944     const AV *const protopad_name = (const AV *)*av_fetch(protopadlist, 0, FALSE);
1945     const AV *const protopad = (const AV *)*av_fetch(protopadlist, 1, FALSE);
1946     SV** const pname = AvARRAY(protopad_name);
1947     SV** const ppad = AvARRAY(protopad);
1948     const I32 fname = AvFILLp(protopad_name);
1949     const I32 fpad = AvFILLp(protopad);
1950     CV* cv;
1951     SV** outpad;
1952     CV* outside;
1953     long depth;
1954
1955     PERL_ARGS_ASSERT_CV_CLONE;
1956
1957     assert(!CvUNIQUE(proto));
1958
1959     /* Anonymous subs have a weak CvOUTSIDE pointer, so its value is not
1960      * reliable.  The currently-running sub is always the one we need to
1961      * close over.
1962      * Note that in general for formats, CvOUTSIDE != find_runcv.
1963      * Since formats may be nested inside closures, CvOUTSIDE may point
1964      * to a prototype; we instead want the cloned parent who called us.
1965      */
1966
1967     if (SvTYPE(proto) == SVt_PVCV)
1968         outside = find_runcv(NULL);
1969     else {
1970         outside = CvOUTSIDE(proto);
1971         if (CvCLONE(outside) && ! CvCLONED(outside)) {
1972             CV * const runcv = find_runcv_where(
1973                 FIND_RUNCV_root_eq, (void *)CvROOT(outside), NULL
1974             );
1975             if (runcv) outside = runcv;
1976         }
1977     }
1978     depth = CvDEPTH(outside);
1979     assert(depth || SvTYPE(proto) == SVt_PVFM);
1980     if (!depth)
1981         depth = 1;
1982     assert(CvPADLIST(outside) || SvTYPE(proto) == SVt_PVFM);
1983
1984     ENTER;
1985     SAVESPTR(PL_compcv);
1986
1987     cv = PL_compcv = MUTABLE_CV(newSV_type(SvTYPE(proto)));
1988     CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE|CVf_CVGV_RC
1989                                     |CVf_SLABBED);
1990     CvCLONED_on(cv);
1991
1992     CvFILE(cv)          = CvDYNFILE(proto) ? savepv(CvFILE(proto))
1993                                            : CvFILE(proto);
1994     CvGV_set(cv,CvGV(proto));
1995     CvSTASH_set(cv, CvSTASH(proto));
1996     OP_REFCNT_LOCK;
1997     CvROOT(cv)          = OpREFCNT_inc(CvROOT(proto));
1998     OP_REFCNT_UNLOCK;
1999     CvSTART(cv)         = CvSTART(proto);
2000     if (CvHASEVAL(cv))
2001         CvOUTSIDE(cv)   = MUTABLE_CV(SvREFCNT_inc_simple(outside));
2002     CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
2003
2004     if (SvPOK(proto))
2005         sv_setpvn(MUTABLE_SV(cv), SvPVX_const(proto), SvCUR(proto));
2006     if (SvMAGIC(proto))
2007         mg_copy((SV *)proto, (SV *)cv, 0, 0);
2008
2009     CvPADLIST(cv) = pad_new(padnew_CLONE|padnew_SAVE);
2010
2011     av_fill(PL_comppad, fpad);
2012     for (ix = fname; ix > 0; ix--)
2013         av_store(PL_comppad_name, ix, SvREFCNT_inc(pname[ix]));
2014
2015     PL_curpad = AvARRAY(PL_comppad);
2016
2017     outpad = CvPADLIST(outside)
2018         ? AvARRAY(AvARRAY(CvPADLIST(outside))[depth])
2019         : NULL;
2020     assert(outpad || SvTYPE(cv) == SVt_PVFM);
2021
2022     for (ix = fpad; ix > 0; ix--) {
2023         SV* const namesv = (ix <= fname) ? pname[ix] : NULL;
2024         SV *sv = NULL;
2025         if (namesv && namesv != &PL_sv_undef) { /* lexical */
2026             if (SvFAKE(namesv)) {   /* lexical from outside? */
2027                 /* formats may have an inactive, or even undefined, parent;
2028                    but state vars are always available. */
2029                 if (!outpad || !(sv = outpad[PARENT_PAD_INDEX(namesv)])
2030                  || (  SvPADSTALE(sv) && !SvPAD_STATE(namesv)
2031                     && !CvDEPTH(outside))  ) {
2032                     assert(SvTYPE(cv) == SVt_PVFM);
2033                     Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
2034                                    "Variable \"%"SVf"\" is not available", namesv);
2035                     sv = NULL;
2036                 }
2037                 else 
2038                     SvREFCNT_inc_simple_void_NN(sv);
2039             }
2040             if (!sv) {
2041                 const char sigil = SvPVX_const(namesv)[0];
2042                 if (sigil == '&')
2043                     sv = SvREFCNT_inc(ppad[ix]);
2044                 else if (sigil == '@')
2045                     sv = MUTABLE_SV(newAV());
2046                 else if (sigil == '%')
2047                     sv = MUTABLE_SV(newHV());
2048                 else
2049                     sv = newSV(0);
2050                 SvPADMY_on(sv);
2051                 /* reset the 'assign only once' flag on each state var */
2052                 if (SvPAD_STATE(namesv))
2053                     SvPADSTALE_on(sv);
2054             }
2055         }
2056         else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) {
2057             sv = SvREFCNT_inc_NN(ppad[ix]);
2058         }
2059         else {
2060             sv = newSV(0);
2061             SvPADTMP_on(sv);
2062         }
2063         PL_curpad[ix] = sv;
2064     }
2065
2066     DEBUG_Xv(
2067         PerlIO_printf(Perl_debug_log, "\nPad CV clone\n");
2068         cv_dump(outside, "Outside");
2069         cv_dump(proto,   "Proto");
2070         cv_dump(cv,      "To");
2071     );
2072
2073     LEAVE;
2074
2075     if (CvCONST(cv)) {
2076         /* Constant sub () { $x } closing over $x - see lib/constant.pm:
2077          * The prototype was marked as a candiate for const-ization,
2078          * so try to grab the current const value, and if successful,
2079          * turn into a const sub:
2080          */
2081         SV* const const_sv = op_const_sv(CvSTART(cv), cv);
2082         if (const_sv) {
2083             SvREFCNT_dec(cv);
2084             /* For this calling case, op_const_sv returns a *copy*, which we
2085                donate to newCONSTSUB. Yes, this is ugly, and should be killed.
2086                Need to fix how lib/constant.pm works to eliminate this.  */
2087             cv = newCONSTSUB(CvSTASH(proto), NULL, const_sv);
2088         }
2089         else {
2090             CvCONST_off(cv);
2091         }
2092     }
2093
2094     return cv;
2095 }
2096
2097 /*
2098 =for apidoc m|void|pad_fixup_inner_anons|PADLIST *padlist|CV *old_cv|CV *new_cv
2099
2100 For any anon CVs in the pad, change CvOUTSIDE of that CV from
2101 old_cv to new_cv if necessary. Needed when a newly-compiled CV has to be
2102 moved to a pre-existing CV struct.
2103
2104 =cut
2105 */
2106
2107 void
2108 Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
2109 {
2110     dVAR;
2111     I32 ix;
2112     AV * const comppad_name = MUTABLE_AV(AvARRAY(padlist)[0]);
2113     AV * const comppad = MUTABLE_AV(AvARRAY(padlist)[1]);
2114     SV ** const namepad = AvARRAY(comppad_name);
2115     SV ** const curpad = AvARRAY(comppad);
2116
2117     PERL_ARGS_ASSERT_PAD_FIXUP_INNER_ANONS;
2118     PERL_UNUSED_ARG(old_cv);
2119
2120     for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
2121         const SV * const namesv = namepad[ix];
2122         if (namesv && namesv != &PL_sv_undef
2123             && *SvPVX_const(namesv) == '&')
2124         {
2125           if (SvTYPE(curpad[ix]) == SVt_PVCV) {
2126             CV * const innercv = MUTABLE_CV(curpad[ix]);
2127             assert(CvWEAKOUTSIDE(innercv));
2128             assert(CvOUTSIDE(innercv) == old_cv);
2129             CvOUTSIDE(innercv) = new_cv;
2130           }
2131           else { /* format reference */
2132             SV * const rv = curpad[ix];
2133             CV *innercv;
2134             if (!SvOK(rv)) continue;
2135             assert(SvROK(rv));
2136             assert(SvWEAKREF(rv));
2137             innercv = (CV *)SvRV(rv);
2138             assert(!CvWEAKOUTSIDE(innercv));
2139             SvREFCNT_dec(CvOUTSIDE(innercv));
2140             CvOUTSIDE(innercv) = (CV *)SvREFCNT_inc_simple_NN(new_cv);
2141           }
2142         }
2143     }
2144 }
2145
2146 /*
2147 =for apidoc m|void|pad_push|PADLIST *padlist|int depth
2148
2149 Push a new pad frame onto the padlist, unless there's already a pad at
2150 this depth, in which case don't bother creating a new one.  Then give
2151 the new pad an @_ in slot zero.
2152
2153 =cut
2154 */
2155
2156 void
2157 Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
2158 {
2159     dVAR;
2160
2161     PERL_ARGS_ASSERT_PAD_PUSH;
2162
2163     if (depth > AvFILLp(padlist)) {
2164         SV** const svp = AvARRAY(padlist);
2165         AV* const newpad = newAV();
2166         SV** const oldpad = AvARRAY(svp[depth-1]);
2167         I32 ix = AvFILLp((const AV *)svp[1]);
2168         const I32 names_fill = AvFILLp((const AV *)svp[0]);
2169         SV** const names = AvARRAY(svp[0]);
2170         AV *av;
2171
2172         for ( ;ix > 0; ix--) {
2173             if (names_fill >= ix && names[ix] != &PL_sv_undef) {
2174                 const char sigil = SvPVX_const(names[ix])[0];
2175                 if ((SvFLAGS(names[ix]) & SVf_FAKE)
2176                         || (SvFLAGS(names[ix]) & SVpad_STATE)
2177                         || sigil == '&')
2178                 {
2179                     /* outer lexical or anon code */
2180                     av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]));
2181                 }
2182                 else {          /* our own lexical */
2183                     SV *sv; 
2184                     if (sigil == '@')
2185                         sv = MUTABLE_SV(newAV());
2186                     else if (sigil == '%')
2187                         sv = MUTABLE_SV(newHV());
2188                     else
2189                         sv = newSV(0);
2190                     av_store(newpad, ix, sv);
2191                     SvPADMY_on(sv);
2192                 }
2193             }
2194             else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
2195                 av_store(newpad, ix, SvREFCNT_inc_NN(oldpad[ix]));
2196             }
2197             else {
2198                 /* save temporaries on recursion? */
2199                 SV * const sv = newSV(0);
2200                 av_store(newpad, ix, sv);
2201                 SvPADTMP_on(sv);
2202             }
2203         }
2204         av = newAV();
2205         av_store(newpad, 0, MUTABLE_SV(av));
2206         AvREIFY_only(av);
2207
2208         av_store(padlist, depth, MUTABLE_SV(newpad));
2209         AvFILLp(padlist) = depth;
2210     }
2211 }
2212
2213 /*
2214 =for apidoc Am|HV *|pad_compname_type|PADOFFSET po
2215
2216 Looks up the type of the lexical variable at position I<po> in the
2217 currently-compiling pad.  If the variable is typed, the stash of the
2218 class to which it is typed is returned.  If not, C<NULL> is returned.
2219
2220 =cut
2221 */
2222
2223 HV *
2224 Perl_pad_compname_type(pTHX_ const PADOFFSET po)
2225 {
2226     dVAR;
2227     SV* const * const av = av_fetch(PL_comppad_name, po, FALSE);
2228     if ( SvPAD_TYPED(*av) ) {
2229         return SvSTASH(*av);
2230     }
2231     return NULL;
2232 }
2233
2234 #if defined(USE_ITHREADS)
2235
2236 #  define av_dup_inc(s,t)       MUTABLE_AV(sv_dup_inc((const SV *)s,t))
2237
2238 /*
2239 =for apidoc m|AV *|padlist_dup|AV *srcpad|CLONE_PARAMS *param
2240
2241 Duplicates a pad.
2242
2243 =cut
2244 */
2245
2246 AV *
2247 Perl_padlist_dup(pTHX_ AV *srcpad, CLONE_PARAMS *param)
2248 {
2249     AV *dstpad;
2250     PERL_ARGS_ASSERT_PADLIST_DUP;
2251
2252     if (!srcpad)
2253         return NULL;
2254
2255     if (param->flags & CLONEf_COPY_STACKS
2256         || SvREFCNT(AvARRAY(srcpad)[1]) > 1) {
2257         dstpad = av_dup_inc(srcpad, param);
2258         assert (SvREFCNT(AvARRAY(srcpad)[1]) == 1);
2259     } else {
2260         /* CvDEPTH() on our subroutine will be set to 0, so there's no need
2261            to build anything other than the first level of pads.  */
2262
2263         I32 ix = AvFILLp((const AV *)AvARRAY(srcpad)[1]);
2264         AV *pad1;
2265         const I32 names_fill = AvFILLp((const AV *)(AvARRAY(srcpad)[0]));
2266         const AV *const srcpad1 = (const AV *) AvARRAY(srcpad)[1];
2267         SV **oldpad = AvARRAY(srcpad1);
2268         SV **names;
2269         SV **pad1a;
2270         AV *args;
2271         /* Look for it in the table first, as the padlist may have ended up
2272            as an element of @DB::args (or theoretically even @_), so it may
2273            may have been cloned already. */
2274         dstpad = (AV*)ptr_table_fetch(PL_ptr_table, srcpad);
2275
2276         if (dstpad)
2277             return (AV *)SvREFCNT_inc_simple_NN(dstpad);
2278
2279         dstpad = newAV();
2280         ptr_table_store(PL_ptr_table, srcpad, dstpad);
2281         av_extend(dstpad, 1);
2282         AvARRAY(dstpad)[0] = MUTABLE_SV(av_dup_inc(AvARRAY(srcpad)[0], param));
2283         names = AvARRAY(AvARRAY(dstpad)[0]);
2284
2285         pad1 = newAV();
2286
2287         av_extend(pad1, ix);
2288         AvARRAY(dstpad)[1] = MUTABLE_SV(pad1);
2289         pad1a = AvARRAY(pad1);
2290         AvFILLp(dstpad) = 1;
2291
2292         if (ix > -1) {
2293             AvFILLp(pad1) = ix;
2294
2295             for ( ;ix > 0; ix--) {
2296                 if (!oldpad[ix]) {
2297                     pad1a[ix] = NULL;
2298                 } else if (names_fill >= ix && names[ix] != &PL_sv_undef) {
2299                     const char sigil = SvPVX_const(names[ix])[0];
2300                     if ((SvFLAGS(names[ix]) & SVf_FAKE)
2301                         || (SvFLAGS(names[ix]) & SVpad_STATE)
2302                         || sigil == '&')
2303                         {
2304                             /* outer lexical or anon code */
2305                             pad1a[ix] = sv_dup_inc(oldpad[ix], param);
2306                         }
2307                     else {              /* our own lexical */
2308                         if(SvPADSTALE(oldpad[ix]) && SvREFCNT(oldpad[ix]) > 1) {
2309                             /* This is a work around for how the current
2310                                implementation of ?{ } blocks in regexps
2311                                interacts with lexicals.  */
2312                             pad1a[ix] = sv_dup_inc(oldpad[ix], param);
2313                         } else {
2314                             SV *sv; 
2315                             
2316                             if (sigil == '@')
2317                                 sv = MUTABLE_SV(newAV());
2318                             else if (sigil == '%')
2319                                 sv = MUTABLE_SV(newHV());
2320                             else
2321                                 sv = newSV(0);
2322                             pad1a[ix] = sv;
2323                             SvPADMY_on(sv);
2324                         }
2325                     }
2326                 }
2327                 else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
2328                     pad1a[ix] = sv_dup_inc(oldpad[ix], param);
2329                 }
2330                 else {
2331                     /* save temporaries on recursion? */
2332                     SV * const sv = newSV(0);
2333                     pad1a[ix] = sv;
2334
2335                     /* SvREFCNT(oldpad[ix]) != 1 for some code in threads.xs
2336                        FIXTHAT before merging this branch.
2337                        (And I know how to) */
2338                     if (SvPADMY(oldpad[ix]))
2339                         SvPADMY_on(sv);
2340                     else
2341                         SvPADTMP_on(sv);
2342                 }
2343             }
2344
2345             if (oldpad[0]) {
2346                 args = newAV();                 /* Will be @_ */
2347                 AvREIFY_only(args);
2348                 pad1a[0] = (SV *)args;
2349             }
2350         }
2351     }
2352
2353     return dstpad;
2354 }
2355
2356 #endif /* USE_ITHREADS */
2357
2358 /*
2359  * Local variables:
2360  * c-indentation-style: bsd
2361  * c-basic-offset: 4
2362  * indent-tabs-mode: nil
2363  * End:
2364  *
2365  * ex: set ts=8 sts=4 sw=4 et:
2366  */