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