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