Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

pad.c@ 3367

Visit:

Last change on this file since 3367 was 3181, checked in by bird, 19 years ago
perl 5.8.8
File size: 40.2 KB

Line
1	/* pad.c
2	*
3	* Copyright (C) 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
4	*
5	* You may distribute under the terms of either the GNU General Public
6	* License or the Artistic License, as specified in the README file.
7	*
8	* "Anyway: there was this Mr Frodo left an orphan and stranded, as you
9	* might say, among those queer Bucklanders, being brought up anyhow in
10	* Brandy Hall. A regular warren, by all accounts. Old Master Gorbadoc
11	* never had fewer than a couple of hundred relations in the place. Mr
12	* Bilbo never did a kinder deed than when he brought the lad back to
13	* live among decent folk." --the Gaffer
14	*/
15
16	/* XXX DAPM
17	* As of Sept 2002, this file is new and may be in a state of flux for
18	* a while. I've marked things I intent to come back and look at further
19	* with an 'XXX DAPM' comment.
20	*/
21
22	/*
23	=head1 Pad Data Structures
24
25	This file contains the functions that create and manipulate scratchpads,
26	which are array-of-array data structures attached to a CV (ie a sub)
27	and which store lexical variables and opcode temporary and per-thread
28	values.
29
30	=for apidoc m\|AV \|CvPADLIST\|CV cv
31	CV's can have CvPADLIST(cv) set to point to an AV.
32
33	For these purposes "forms" are a kind-of CV, eval""s are too (except they're
34	not callable at will and are always thrown away after the eval"" is done
35	executing).
36
37	XSUBs don't have CvPADLIST set - dXSTARG fetches values from PL_curpad,
38	but that is really the callers pad (a slot of which is allocated by
39	every entersub).
40
41	The CvPADLIST AV has does not have AvREAL set, so REFCNT of component items
42	is managed "manual" (mostly in pad.c) rather than normal av.c rules.
43	The items in the AV are not SVs as for a normal AV, but other AVs:
44
45	0'th Entry of the CvPADLIST is an AV which represents the "names" or rather
46	the "static type information" for lexicals.
47
48	The CvDEPTH'th entry of CvPADLIST AV is an AV which is the stack frame at that
49	depth of recursion into the CV.
50	The 0'th slot of a frame AV is an AV which is @_.
51	other entries are storage for variables and op targets.
52
53	During compilation:
54	C<PL_comppad_name> is set to the names AV.
55	C<PL_comppad> is set to the frame AV for the frame CvDEPTH == 1.
56	C<PL_curpad> is set to the body of the frame AV (i.e. AvARRAY(PL_comppad)).
57
58	During execution, C<PL_comppad> and C<PL_curpad> refer to the live
59	frame of the currently executing sub.
60
61	Iterating over the names AV iterates over all possible pad
62	items. Pad slots that are SVs_PADTMP (targets/GVs/constants) end up having
63	&PL_sv_undef "names" (see pad_alloc()).
64
65	Only my/our variable (SVs_PADMY/SVs_PADOUR) slots get valid names.
66	The rest are op targets/GVs/constants which are statically allocated
67	or resolved at compile time. These don't have names by which they
68	can be looked up from Perl code at run time through eval"" like
69	my/our variables can be. Since they can't be looked up by "name"
70	but only by their index allocated at compile time (which is usually
71	in PL_op->op_targ), wasting a name SV for them doesn't make sense.
72
73	The SVs in the names AV have their PV being the name of the variable.
74	NV+1..IV inclusive is a range of cop_seq numbers for which the name is
75	valid. For typed lexicals name SV is SVt_PVMG and SvSTASH points at the
76	type. For C<our> lexicals, the type is SVt_PVGV, and GvSTASH points at the
77	stash of the associated global (so that duplicate C<our> declarations in the
78	same package can be detected). SvCUR is sometimes hijacked to
79	store the generation number during compilation.
80
81	If SvFAKE is set on the name SV then slot in the frame AVs are
82	a REFCNT'ed references to a lexical from "outside". In this case,
83	the name SV does not have a cop_seq range, since it is in scope
84	throughout.
85
86	If the 'name' is '&' the corresponding entry in frame AV
87	is a CV representing a possible closure.
88	(SvFAKE and name of '&' is not a meaningful combination currently but could
89	become so if C<my sub foo {}> is implemented.)
90
91	The flag SVf_PADSTALE is cleared on lexicals each time the my() is executed,
92	and set on scope exit. This allows the 'Variable $x is not available' warning
93	to be generated in evals, such as
94
95	{ my $x = 1; sub f { eval '$x'} } f();
96
97	=cut
98	*/
99
100
101	#include "EXTERN.h"
102	#define PERL_IN_PAD_C
103	#include "perl.h"
104
105
106	#define PAD_MAX 999999999
107
108
109
110	/*
111	=for apidoc pad_new
112
113	Create a new compiling padlist, saving and updating the various global
114	vars at the same time as creating the pad itself. The following flags
115	can be OR'ed together:
116
117	padnew_CLONE this pad is for a cloned CV
118	padnew_SAVE save old globals
119	padnew_SAVESUB also save extra stuff for start of sub
120
121	=cut
122	*/
123
124	PADLIST *
125	Perl_pad_new(pTHX_ int flags)
126	{
127	AV padlist, padname, *pad;
128
129	ASSERT_CURPAD_LEGAL("pad_new");
130
131	/* XXX DAPM really need a new SAVEt_PAD which restores all or most
132	* vars (based on flags) rather than storing vals + addresses for
133	* each individually. Also see pad_block_start.
134	* XXX DAPM Try to see whether all these conditionals are required
135	*/
136
137	/* save existing state, ... */
138
139	if (flags & padnew_SAVE) {
140	SAVECOMPPAD();
141	SAVESPTR(PL_comppad_name);
142	if (! (flags & padnew_CLONE)) {
143	SAVEI32(PL_padix);
144	SAVEI32(PL_comppad_name_fill);
145	SAVEI32(PL_min_intro_pending);
146	SAVEI32(PL_max_intro_pending);
147	if (flags & padnew_SAVESUB) {
148	SAVEI32(PL_pad_reset_pending);
149	}
150	}
151	}
152	/* XXX DAPM interestingly, PL_comppad_name_floor never seems to be
153	* saved - check at some pt that this is okay */
154
155	/* ... create new pad ... */
156
157	padlist = newAV();
158	padname = newAV();
159	pad = newAV();
160
161	if (flags & padnew_CLONE) {
162	/* XXX DAPM I dont know why cv_clone needs it
163	* doing differently yet - perhaps this separate branch can be
164	* dispensed with eventually ???
165	*/
166
167	AV * const a0 = newAV(); /* will be @_ */
168	av_extend(a0, 0);
169	av_store(pad, 0, (SV*)a0);
170	AvFLAGS(a0) = AVf_REIFY;
171	}
172	else {
173	#ifdef USE_5005THREADS
174	AV * const a0 = newAV(); /* will be @_ */
175	av_store(padname, 0, newSVpvn("@_", 2));
176	SvPADMY_on((SV)a0); / XXX Needed? */
177	av_store(pad, 0, (SV*)a0);
178	#else
179	av_store(pad, 0, Nullsv);
180	#endif /* USE_THREADS */
181	}
182
183	AvREAL_off(padlist);
184	av_store(padlist, 0, (SV*)padname);
185	av_store(padlist, 1, (SV*)pad);
186
187	/* ... then update state variables */
188
189	PL_comppad_name = (AV)(av_fetch(padlist, 0, FALSE));
190	PL_comppad = (AV)(av_fetch(padlist, 1, FALSE));
191	PL_curpad = AvARRAY(PL_comppad);
192
193	if (! (flags & padnew_CLONE)) {
194	PL_comppad_name_fill = 0;
195	PL_min_intro_pending = 0;
196	PL_padix = 0;
197	}
198
199	DEBUG_X(PerlIO_printf(Perl_debug_log,
200	"Pad 0x%"UVxf"[0x%"UVxf"] new: padlist=0x%"UVxf
201	" name=0x%"UVxf" flags=0x%"UVxf"\n",
202	PTR2UV(PL_comppad), PTR2UV(PL_curpad), PTR2UV(padlist),
203	PTR2UV(padname), (UV)flags
204	)
205	);
206
207	return (PADLIST*)padlist;
208	}
209
210	/*
211	=for apidoc pad_undef
212
213	Free the padlist associated with a CV.
214	If parts of it happen to be current, we null the relevant
215	PL_pad global vars so that we don't have any dangling references left.
216	We also repoint the CvOUTSIDE of any about-to-be-orphaned
217	inner subs to the outer of this cv.
218
219	(This function should really be called pad_free, but the name was already
220	taken)
221
222	=cut
223	*/
224
225	void
226	Perl_pad_undef(pTHX_ CV* cv)
227	{
228	I32 ix;
229	const PADLIST * const padlist = CvPADLIST(cv);
230
231	if (!padlist)
232	return;
233	if (!SvREFCNT(CvPADLIST(cv))) /* may be during global destruction */
234	return;
235
236	DEBUG_X(PerlIO_printf(Perl_debug_log,
237	"Pad undef: padlist=0x%"UVxf"\n" , PTR2UV(padlist))
238	);
239
240	/* detach any '&' anon children in the pad; if afterwards they
241	* are still live, fix up their CvOUTSIDEs to point to our outside,
242	* bypassing us. */
243	/* XXX DAPM for efficiency, we should only do this if we know we have
244	* children, or integrate this loop with general cleanup */
245
246	if (!PL_dirty) { /* don't bother during global destruction */
247	CV * const outercv = CvOUTSIDE(cv);
248	const U32 seq = CvOUTSIDE_SEQ(cv);
249	AV * const comppad_name = (AV*)AvARRAY(padlist)[0];
250	SV ** const namepad = AvARRAY(comppad_name);
251	AV * const comppad = (AV*)AvARRAY(padlist)[1];
252	SV ** const curpad = AvARRAY(comppad);
253	for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
254	SV * const namesv = namepad[ix];
255	if (namesv && namesv != &PL_sv_undef
256	&& *SvPVX_const(namesv) == '&')
257	{
258	CV * const innercv = (CV*)curpad[ix];
259	U32 inner_rc = SvREFCNT(innercv);
260	assert(inner_rc);
261	namepad[ix] = Nullsv;
262	SvREFCNT_dec(namesv);
263
264	if (SvREFCNT(comppad) < 2) { /* allow for /(?{ sub{} })/ */
265	curpad[ix] = Nullsv;
266	SvREFCNT_dec(innercv);
267	inner_rc--;
268	}
269	if (inner_rc /* in use, not just a prototype */
270	&& CvOUTSIDE(innercv) == cv)
271	{
272	assert(CvWEAKOUTSIDE(innercv));
273	/* don't relink to grandfather if he's being freed */
274	if (outercv && SvREFCNT(outercv)) {
275	CvWEAKOUTSIDE_off(innercv);
276	CvOUTSIDE(innercv) = outercv;
277	CvOUTSIDE_SEQ(innercv) = seq;
278	(void)SvREFCNT_inc(outercv);
279	}
280	else {
281	CvOUTSIDE(innercv) = Nullcv;
282	}
283
284	}
285
286	}
287	}
288	}
289
290	ix = AvFILLp(padlist);
291	while (ix >= 0) {
292	SV* const sv = AvARRAY(padlist)[ix--];
293	if (!sv)
294	continue;
295	if (sv == (SV*)PL_comppad_name)
296	PL_comppad_name = Nullav;
297	else if (sv == (SV*)PL_comppad) {
298	PL_comppad = Null(PAD*);
299	PL_curpad = Null(SV**);
300	}
301	SvREFCNT_dec(sv);
302	}
303	SvREFCNT_dec((SV*)CvPADLIST(cv));
304	CvPADLIST(cv) = Null(PADLIST*);
305	}
306
307
308
309
310	/*
311	=for apidoc pad_add_name
312
313	Create a new name in the current pad at the specified offset.
314	If C<typestash> is valid, the name is for a typed lexical; set the
315	name's stash to that value.
316	If C<ourstash> is valid, it's an our lexical, set the name's
317	GvSTASH to that value
318
319	Also, if the name is @.. or %.., create a new array or hash for that slot
320
321	If fake, it means we're cloning an existing entry
322
323	=cut
324	*/
325
326	/*
327	* XXX DAPM this doesn't seem the right place to create a new array/hash.
328	* Whatever we do, we should be consistent - create scalars too, and
329	* create even if fake. Really need to integrate better the whole entry
330	* creation business - when + where does the name and value get created?
331	*/
332
333	PADOFFSET
334	Perl_pad_add_name(pTHX_ char name, HV typestash, HV* ourstash, bool fake)
335	{
336	const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
337	SV* const namesv = NEWSV(1102, 0);
338
339	ASSERT_CURPAD_ACTIVE("pad_add_name");
340
341
342	DEBUG_Xv(PerlIO_printf(Perl_debug_log,
343	"Pad addname: %ld \"%s\"%s\n",
344	(long)offset, name, (fake ? " FAKE" : "")
345	)
346	);
347
348	sv_upgrade(namesv, ourstash ? SVt_PVGV : typestash ? SVt_PVMG : SVt_PVNV);
349	sv_setpv(namesv, name);
350
351	if (typestash) {
352	SvFLAGS(namesv) \|= SVpad_TYPED;
353	SvSTASH_set(namesv, (HV)SvREFCNT_inc((SV) typestash));
354	}
355	if (ourstash) {
356	SvFLAGS(namesv) \|= SVpad_OUR;
357	GvSTASH(namesv) = (HV)SvREFCNT_inc((SV) ourstash);
358	}
359
360	av_store(PL_comppad_name, offset, namesv);
361	if (fake)
362	SvFAKE_on(namesv);
363	else {
364	/* not yet introduced */
365	SvNV_set(namesv, (NV)PAD_MAX); /* min */
366	SvIV_set(namesv, 0); /* max */
367
368	if (!PL_min_intro_pending)
369	PL_min_intro_pending = offset;
370	PL_max_intro_pending = offset;
371	/* XXX DAPM since slot has been allocated, replace
372	* av_store with PL_curpad[offset] ? */
373	if (*name == '@')
374	av_store(PL_comppad, offset, (SV*)newAV());
375	else if (*name == '%')
376	av_store(PL_comppad, offset, (SV*)newHV());
377	SvPADMY_on(PL_curpad[offset]);
378	}
379
380	return offset;
381	}
382
383
384
385
386	/*
387	=for apidoc pad_alloc
388
389	Allocate a new my or tmp pad entry. For a my, simply push a null SV onto
390	the end of PL_comppad, but for a tmp, scan the pad from PL_padix upwards
391	for a slot which has no name and no active value.
392
393	=cut
394	*/
395
396	/* XXX DAPM integrate alloc(), add_name() and add_anon(),
397	* or at least rationalise ??? */
398
399
400	PADOFFSET
401	Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
402	{
403	SV *sv;
404	I32 retval;
405
406	ASSERT_CURPAD_ACTIVE("pad_alloc");
407
408	if (AvARRAY(PL_comppad) != PL_curpad)
409	Perl_croak(aTHX_ "panic: pad_alloc");
410	if (PL_pad_reset_pending)
411	pad_reset();
412	if (tmptype & SVs_PADMY) {
413	do {
414	sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE);
415	} while (SvPADBUSY(sv)); /* need a fresh one */
416	retval = AvFILLp(PL_comppad);
417	}
418	else {
419	SV * const * const names = AvARRAY(PL_comppad_name);
420	const SSize_t names_fill = AvFILLp(PL_comppad_name);
421	for (;;) {
422	/*
423	* "foreach" index vars temporarily become aliases to non-"my"
424	* values. Thus we must skip, not just pad values that are
425	* marked as current pad values, but also those with names.
426	*/
427	/* HVDS why copy to sv here? we don't seem to use it */
428	if (++PL_padix <= names_fill &&
429	(sv = names[PL_padix]) && sv != &PL_sv_undef)
430	continue;
431	sv = *av_fetch(PL_comppad, PL_padix, TRUE);
432	if (!(SvFLAGS(sv) & (SVs_PADTMP \| SVs_PADMY)) &&
433	!IS_PADGV(sv) && !IS_PADCONST(sv))
434	break;
435	}
436	retval = PL_padix;
437	}
438	SvFLAGS(sv) \|= tmptype;
439	PL_curpad = AvARRAY(PL_comppad);
440
441	DEBUG_X(PerlIO_printf(Perl_debug_log,
442	"Pad 0x%"UVxf"[0x%"UVxf"] alloc: %ld for %s\n",
443	PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long) retval,
444	PL_op_name[optype]));
445	return (PADOFFSET)retval;
446	}
447
448	/*
449	=for apidoc pad_add_anon
450
451	Add an anon code entry to the current compiling pad
452
453	=cut
454	*/
455
456	PADOFFSET
457	Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
458	{
459	PADOFFSET ix;
460	SV* const name = NEWSV(1106, 0);
461	sv_upgrade(name, SVt_PVNV);
462	sv_setpvn(name, "&", 1);
463	SvIV_set(name, -1);
464	SvNV_set(name, 1);
465	ix = pad_alloc(op_type, SVs_PADMY);
466	av_store(PL_comppad_name, ix, name);
467	/* XXX DAPM use PL_curpad[] ? */
468	av_store(PL_comppad, ix, sv);
469	SvPADMY_on(sv);
470
471	/* to avoid ref loops, we never have parent + child referencing each
472	* other simultaneously */
473	if (CvOUTSIDE((CV*)sv)) {
474	assert(!CvWEAKOUTSIDE((CV*)sv));
475	CvWEAKOUTSIDE_on((CV*)sv);
476	SvREFCNT_dec(CvOUTSIDE((CV*)sv));
477	}
478	return ix;
479	}
480
481
482
483	/*
484	=for apidoc pad_check_dup
485
486	Check for duplicate declarations: report any of:
487	* a my in the current scope with the same name;
488	* an our (anywhere in the pad) with the same name and the same stash
489	as C<ourstash>
490	C<is_our> indicates that the name to check is an 'our' declaration
491
492	=cut
493	*/
494
495	/* XXX DAPM integrate this into pad_add_name ??? */
496
497	void
498	Perl_pad_check_dup(pTHX_ char name, bool is_our, HV ourstash)
499	{
500	SV **svp;
501	PADOFFSET top, off;
502
503	ASSERT_CURPAD_ACTIVE("pad_check_dup");
504	if (AvFILLp(PL_comppad_name) < 0 \|\| !ckWARN(WARN_MISC))
505	return; /* nothing to check */
506
507	svp = AvARRAY(PL_comppad_name);
508	top = AvFILLp(PL_comppad_name);
509	/* check the current scope */
510	/* XXX DAPM - why the (I32) cast - shouldn't we ensure they're the same
511	* type ? */
512	for (off = top; (I32)off > PL_comppad_name_floor; off--) {
513	SV * const sv = svp[off];
514	if (sv
515	&& sv != &PL_sv_undef
516	&& !SvFAKE(sv)
517	&& (SvIVX(sv) == PAD_MAX \|\| SvIVX(sv) == 0)
518	&& (!is_our
519	\|\| ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash))
520	&& strEQ(name, SvPVX_const(sv)))
521	{
522	Perl_warner(aTHX_ packWARN(WARN_MISC),
523	"\"%s\" variable %s masks earlier declaration in same %s",
524	(is_our ? "our" : "my"),
525	name,
526	(SvIVX(sv) == PAD_MAX ? "scope" : "statement"));
527	--off;
528	break;
529	}
530	}
531	/* check the rest of the pad */
532	if (is_our) {
533	do {
534	SV * const sv = svp[off];
535	if (sv
536	&& sv != &PL_sv_undef
537	&& !SvFAKE(sv)
538	&& (SvIVX(sv) == PAD_MAX \|\| SvIVX(sv) == 0)
539	&& ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash)
540	&& strEQ(name, SvPVX_const(sv)))
541	{
542	Perl_warner(aTHX_ packWARN(WARN_MISC),
543	"\"our\" variable %s redeclared", name);
544	Perl_warner(aTHX_ packWARN(WARN_MISC),
545	"\t(Did you mean \"local\" instead of \"our\"?)\n");
546	break;
547	}
548	} while ( off-- > 0 );
549	}
550	}
551
552
553
554	/*
555	=for apidoc pad_findmy
556
557	Given a lexical name, try to find its offset, first in the current pad,
558	or failing that, in the pads of any lexically enclosing subs (including
559	the complications introduced by eval). If the name is found in an outer pad,
560	then a fake entry is added to the current pad.
561	Returns the offset in the current pad, or NOT_IN_PAD on failure.
562
563	=cut
564	*/
565
566	PADOFFSET
567	Perl_pad_findmy(pTHX_ char *name)
568	{
569	I32 off;
570	I32 fake_off = 0;
571	I32 our_off = 0;
572	SV *sv;
573	SV **svp = AvARRAY(PL_comppad_name);
574	U32 seq = PL_cop_seqmax;
575
576	ASSERT_CURPAD_ACTIVE("pad_findmy");
577	DEBUG_Xv(PerlIO_printf(Perl_debug_log, "Pad findmy: \"%s\"\n", name));
578
579	#ifdef USE_5005THREADS
580	/*
581	* Special case to get lexical (and hence per-thread) @_.
582	* XXX I need to find out how to tell at parse-time whether use
583	* of @_ should refer to a lexical (from a sub) or defgv (global
584	* scope and maybe weird sub-ish things like formats). See
585	* startsub in perly.y. It's possible that @_ could be lexical
586	* (at least from subs) even in non-threaded perl.
587	*/
588	if (strEQ(name, "@_"))
589	return 0; /* success. (NOT_IN_PAD indicates failure) */
590	#endif /* USE_5005THREADS */
591
592	/* The one we're looking for is probably just before comppad_name_fill. */
593	for (off = AvFILLp(PL_comppad_name); off > 0; off--) {
594	sv = svp[off];
595	if (!sv \|\| sv == &PL_sv_undef \|\| !strEQ(SvPVX_const(sv), name))
596	continue;
597	if (SvFAKE(sv)) {
598	/* we'll use this later if we don't find a real entry */
599	fake_off = off;
600	continue;
601	}
602	else {
603	if ( seq > U_32(SvNVX(sv)) /* min */
604	&& seq <= (U32)SvIVX(sv)) /* max */
605	return off;
606	else if ((SvFLAGS(sv) & SVpad_OUR)
607	&& U_32(SvNVX(sv)) == PAD_MAX) /* min */
608	{
609	/* look for an our that's being introduced; this allows
610	* our $foo = 0 unless defined $foo;
611	* to not give a warning. (Yes, this is a hack) */
612	our_off = off;
613	}
614	}
615	}
616	if (fake_off)
617	return fake_off;
618
619	/* See if it's in a nested scope */
620	off = pad_findlex(name, 0, PL_compcv);
621	if (off) /* pad_findlex returns 0 for failure...*/
622	return off;
623	if (our_off)
624	return our_off;
625	return NOT_IN_PAD; /* ...but we return NOT_IN_PAD for failure */
626
627	}
628
629
630
631	/*
632	=for apidoc pad_findlex
633
634	Find a named lexical anywhere in a chain of nested pads. Add fake entries
635	in the inner pads if it's found in an outer one. innercv is the CV inside
636	the chain of outer CVs to be searched. If newoff is non-null, this is a
637	run-time cloning: don't add fake entries, just find the lexical and add a
638	ref to it at newoff in the current pad.
639
640	=cut
641	*/
642
643	STATIC PADOFFSET
644	S_pad_findlex(pTHX_ const char name, PADOFFSET newoff, const CV innercv)
645	{
646	CV *cv;
647	I32 off = 0;
648	SV *sv;
649	CV* startcv;
650	U32 seq;
651	I32 depth;
652	AV *oldpad;
653	SV *oldsv;
654	AV *curlist;
655
656	ASSERT_CURPAD_ACTIVE("pad_findlex");
657	DEBUG_Xv(PerlIO_printf(Perl_debug_log,
658	"Pad findlex: \"%s\" off=%ld startcv=0x%"UVxf"\n",
659	name, (long)newoff, PTR2UV(innercv))
660	);
661
662	seq = CvOUTSIDE_SEQ(innercv);
663	startcv = CvOUTSIDE(innercv);
664
665	for (cv = startcv; cv; seq = CvOUTSIDE_SEQ(cv), cv = CvOUTSIDE(cv)) {
666	SV **svp;
667	AV *curname;
668	I32 fake_off = 0;
669
670	DEBUG_Xv(PerlIO_printf(Perl_debug_log,
671	" searching: cv=0x%"UVxf" seq=%d\n",
672	PTR2UV(cv), (int) seq )
673	);
674
675	curlist = CvPADLIST(cv);
676	if (!curlist)
677	continue; /* an undef CV */
678	svp = av_fetch(curlist, 0, FALSE);
679	if (!svp \|\| *svp == &PL_sv_undef)
680	continue;
681	curname = (AV)svp;
682	svp = AvARRAY(curname);
683
684	depth = CvDEPTH(cv);
685	for (off = AvFILLp(curname); off > 0; off--) {
686	sv = svp[off];
687	if (!sv \|\| sv == &PL_sv_undef \|\| !strEQ(SvPVX_const(sv), name))
688	continue;
689	if (SvFAKE(sv)) {
690	/* we'll use this later if we don't find a real entry */
691	fake_off = off;
692	continue;
693	}
694	else {
695	if ( seq > U_32(SvNVX(sv)) /* min */
696	&& seq <= (U32)SvIVX(sv) /* max */
697	&& !(newoff && !depth) /* ignore inactive when cloning */
698	)
699	goto found;
700	}
701	}
702
703	/* no real entry - but did we find a fake one? */
704	if (fake_off) {
705	if (newoff && !depth)
706	return 0; /* don't clone from inactive stack frame */
707	off = fake_off;
708	sv = svp[off];
709	goto found;
710	}
711	}
712	return 0;
713
714	found:
715
716	if (!depth)
717	depth = 1;
718
719	oldpad = (AV*)AvARRAY(curlist)[depth];
720	oldsv = *av_fetch(oldpad, off, TRUE);
721
722	#ifdef DEBUGGING
723	if (SvFAKE(sv))
724	DEBUG_Xv(PerlIO_printf(Perl_debug_log,
725	" matched: offset %ld"
726	" FAKE, sv=0x%"UVxf"\n",
727	(long)off,
728	PTR2UV(oldsv)
729	)
730	);
731	else
732	DEBUG_Xv(PerlIO_printf(Perl_debug_log,
733	" matched: offset %ld"
734	" (%lu,%lu), sv=0x%"UVxf"\n",
735	(long)off,
736	(unsigned long)U_32(SvNVX(sv)),
737	(unsigned long)SvIVX(sv),
738	PTR2UV(oldsv)
739	)
740	);
741	#endif
742
743	if (!newoff) { /* Not a mere clone operation. */
744	newoff = pad_add_name(
745	SvPVX(sv),
746	(SvFLAGS(sv) & SVpad_TYPED) ? SvSTASH(sv) : Nullhv,
747	(SvFLAGS(sv) & SVpad_OUR) ? GvSTASH(sv) : Nullhv,
748	1 /* fake */
749	);
750
751	if (CvANON(PL_compcv) \|\| SvTYPE(PL_compcv) == SVt_PVFM) {
752	/* "It's closures all the way down." */
753	CvCLONE_on(PL_compcv);
754	if (cv == startcv) {
755	if (CvANON(PL_compcv))
756	oldsv = Nullsv; /* no need to keep ref */
757	}
758	else {
759	CV *bcv;
760	for (bcv = startcv;
761	bcv && bcv != cv && !CvCLONE(bcv);
762	bcv = CvOUTSIDE(bcv))
763	{
764	if (CvANON(bcv)) {
765	/* install the missing pad entry in intervening