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