move all pad-related code to its own src file

Message-ID: <20020925234023.A20044@fdgroup.com>

p4raw-id: //depot/perl@17953

1 files changed, 96 insertions, 904 deletions

diff --git a/op.c b/op.c
index 9b2f205083..4804bf11c3 100644
--- a/op.c
+++ b/op.c
@@ -108,7 +108,6 @@ S_Slab_Free(pTHX_ void *op)
 	 Nullop )						\
      : CALL_FPTR(PL_check[type])(aTHX_ (OP*)o))
 
-#define PAD_MAX 999999999
 #define RETURN_UNLIMITED_NUMBER (PERL_INT_MAX / 2)
 
 STATIC char*
@@ -160,11 +159,11 @@ S_no_bareword_allowed(pTHX_ OP *o)
 /* "register" allocation */
 
 PADOFFSET
-Perl_pad_allocmy(pTHX_ char *name)
+Perl_allocmy(pTHX_ char *name)
 {
     PADOFFSET off;
-    SV *sv;
 
+    /* complain about "my $_" etc etc */
     if (!(PL_in_my == KEY_our ||
 	  isALPHA(name[1]) ||
 	  (USE_UTF8_IN_NAMES && UTF8_IS_START(name[1])) ||
@@ -191,492 +190,32 @@ Perl_pad_allocmy(pTHX_ char *name)
 	}
 	yyerror(Perl_form(aTHX_ "Can't use global %s in \"my\"",name));
     }
-    if (ckWARN(WARN_MISC) && AvFILLp(PL_comppad_name) >= 0) {
-	SV **svp = AvARRAY(PL_comppad_name);
-	HV *ourstash = (PL_curstash ? PL_curstash : PL_defstash);
-	PADOFFSET top = AvFILLp(PL_comppad_name);
-	for (off = top; (I32)off > PL_comppad_name_floor; off--) {
-	    if ((sv = svp[off])
-		&& sv != &PL_sv_undef
-		&& (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
-		&& (PL_in_my != KEY_our
-		    || ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash))
-		&& strEQ(name, SvPVX(sv)))
-	    {
-		Perl_warner(aTHX_ packWARN(WARN_MISC),
-		    "\"%s\" variable %s masks earlier declaration in same %s",
-		    (PL_in_my == KEY_our ? "our" : "my"),
-		    name,
-		    (SvIVX(sv) == PAD_MAX ? "scope" : "statement"));
-		--off;
-		break;
-	    }
-	}
-	if (PL_in_my == KEY_our) {
-	    do {
-		if ((sv = svp[off])
-		    && sv != &PL_sv_undef
-		    && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
-		    && ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash)
-		    && strEQ(name, SvPVX(sv)))
-		{
-		    Perl_warner(aTHX_ packWARN(WARN_MISC),
-			"\"our\" variable %s redeclared", name);
-		    Perl_warner(aTHX_ packWARN(WARN_MISC),
-			"\t(Did you mean \"local\" instead of \"our\"?)\n");
-		    break;
-		}
-	    } while ( off-- > 0 );
-	}
-    }
-    off = pad_alloc(OP_PADSV, SVs_PADMY);
-    sv = NEWSV(1102,0);
-    sv_upgrade(sv, SVt_PVNV);
-    sv_setpv(sv, name);
-    if (PL_in_my_stash) {
-	if (*name != '$')
-	    yyerror(Perl_form(aTHX_ "Can't declare class for non-scalar %s in \"%s\"",
-			 name, PL_in_my == KEY_our ? "our" : "my"));
-	SvFLAGS(sv) |= SVpad_TYPED;
-	(void)SvUPGRADE(sv, SVt_PVMG);
-	SvSTASH(sv) = (HV*)SvREFCNT_inc(PL_in_my_stash);
-    }
-    if (PL_in_my == KEY_our) {
-	(void)SvUPGRADE(sv, SVt_PVGV);
-	GvSTASH(sv) = (HV*)SvREFCNT_inc(PL_curstash ? (SV*)PL_curstash : (SV*)PL_defstash);
-	SvFLAGS(sv) |= SVpad_OUR;
-    }
-    av_store(PL_comppad_name, off, sv);
-    SvNVX(sv) = (NV)PAD_MAX;
-    SvIVX(sv) = 0;			/* Not yet introduced--see newSTATEOP */
-    if (!PL_min_intro_pending)
-	PL_min_intro_pending = off;
-    PL_max_intro_pending = off;
-    if (*name == '@')
-	av_store(PL_comppad, off, (SV*)newAV());
-    else if (*name == '%')
-	av_store(PL_comppad, off, (SV*)newHV());
-    SvPADMY_on(PL_curpad[off]);
-    return off;
-}
-
-STATIC PADOFFSET
-S_pad_addlex(pTHX_ SV *proto_namesv)
-{
-    SV *namesv = NEWSV(1103,0);
-    PADOFFSET newoff = pad_alloc(OP_PADSV, SVs_PADMY);
-    sv_upgrade(namesv, SVt_PVNV);
-    sv_setpv(namesv, SvPVX(proto_namesv));
-    av_store(PL_comppad_name, newoff, namesv);
-    SvNVX(namesv) = (NV)PL_curcop->cop_seq;
-    SvIVX(namesv) = PAD_MAX;			/* A ref, intro immediately */
-    SvFAKE_on(namesv);				/* A ref, not a real var */
-    if (SvFLAGS(proto_namesv) & SVpad_OUR) {	/* An "our" variable */
-	SvFLAGS(namesv) |= SVpad_OUR;
-	(void)SvUPGRADE(namesv, SVt_PVGV);
-	GvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*)GvSTASH(proto_namesv));
-    }
-    if (SvFLAGS(proto_namesv) & SVpad_TYPED) {	/* A typed lexical */
-	SvFLAGS(namesv) |= SVpad_TYPED;
-	(void)SvUPGRADE(namesv, SVt_PVMG);
-	SvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*)SvSTASH(proto_namesv));
-    }
-    return newoff;
-}
-
-#define FINDLEX_NOSEARCH	1		/* don't search outer contexts */
-
-STATIC PADOFFSET
-S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
-	    I32 cx_ix, I32 saweval, U32 flags)
-{
-    CV *cv;
-    I32 off;
-    SV *sv;
-    register I32 i;
-    register PERL_CONTEXT *cx;
-
-    for (cv = startcv; cv; cv = CvOUTSIDE(cv)) {
-	AV *curlist = CvPADLIST(cv);
-	SV **svp = av_fetch(curlist, 0, FALSE);
-	AV *curname;
-
-	if (!svp || *svp == &PL_sv_undef)
-	    continue;
-	curname = (AV*)*svp;
-	svp = AvARRAY(curname);
-	for (off = AvFILLp(curname); off > 0; off--) {
-	    if ((sv = svp[off]) &&
-		sv != &PL_sv_undef &&
-		seq <= (U32)SvIVX(sv) &&
-		seq > (U32)I_32(SvNVX(sv)) &&
-		strEQ(SvPVX(sv), name))
-	    {
-		I32 depth;
-		AV *oldpad;
-		SV *oldsv;
-
-		depth = CvDEPTH(cv);
-		if (!depth) {
-		    if (newoff) {
-			if (SvFAKE(sv))
-			    continue;
-			return 0; /* don't clone from inactive stack frame */
-		    }
-		    depth = 1;
-		}
-		oldpad = (AV*)AvARRAY(curlist)[depth];
-		oldsv = *av_fetch(oldpad, off, TRUE);
-		if (!newoff) {		/* Not a mere clone operation. */
-		    newoff = pad_addlex(sv);
-		    if (CvANON(PL_compcv) || SvTYPE(PL_compcv) == SVt_PVFM) {
-			/* "It's closures all the way down." */
-			CvCLONE_on(PL_compcv);
-			if (cv == startcv) {
-			    if (CvANON(PL_compcv))
-				oldsv = Nullsv; /* no need to keep ref */
-			}
-			else {
-			    CV *bcv;
-			    for (bcv = startcv;
-				 bcv && bcv != cv && !CvCLONE(bcv);
-				 bcv = CvOUTSIDE(bcv))
-			    {
-				if (CvANON(bcv)) {
-				    /* install the missing pad entry in intervening
-				     * nested subs and mark them cloneable.
-				     * XXX fix pad_foo() to not use globals */
-				    AV *ocomppad_name = PL_comppad_name;
-				    AV *ocomppad = PL_comppad;
-				    SV **ocurpad = PL_curpad;
-				    AV *padlist = CvPADLIST(bcv);
-				    PL_comppad_name = (AV*)AvARRAY(padlist)[0];
-				    PL_comppad = (AV*)AvARRAY(padlist)[1];
-				    PL_curpad = AvARRAY(PL_comppad);
-				    pad_addlex(sv);
-				    PL_comppad_name = ocomppad_name;
-				    PL_comppad = ocomppad;
-				    PL_curpad = ocurpad;
-				    CvCLONE_on(bcv);
-				}
-				else {
-				    if (ckWARN(WARN_CLOSURE)
-					&& !CvUNIQUE(bcv) && !CvUNIQUE(cv))
-				    {
-					Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
-					  "Variable \"%s\" may be unavailable",
-					     name);
-				    }
-				    break;
-				}
-			    }
-			}
-		    }
-		    else if (!CvUNIQUE(PL_compcv)) {
-			if (ckWARN(WARN_CLOSURE) && !SvFAKE(sv) && !CvUNIQUE(cv)
-			    && !(SvFLAGS(sv) & SVpad_OUR))
-			{
-			    Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
-				"Variable \"%s\" will not stay shared", name);
-			}
-		    }
-		}
-		av_store(PL_comppad, newoff, SvREFCNT_inc(oldsv));
-		return newoff;
-	    }
-	}
-    }
 
-    if (flags & FINDLEX_NOSEARCH)
-	return 0;
-
-    /* Nothing in current lexical context--try eval's context, if any.
-     * This is necessary to let the perldb get at lexically scoped variables.
-     * XXX This will also probably interact badly with eval tree caching.
-     */
+    /* check for duplicate declaration */
+    pad_check_dup(name,
+		PL_in_my == KEY_our,
+		(PL_curstash ? PL_curstash : PL_defstash)
+    );
 
-    for (i = cx_ix; i >= 0; i--) {
-	cx = &cxstack[i];
-	switch (CxTYPE(cx)) {
-	default:
-	    if (i == 0 && saweval) {
-		return pad_findlex(name, newoff, seq, PL_main_cv, -1, saweval, 0);
-	    }
-	    break;
-	case CXt_EVAL:
-	    switch (cx->blk_eval.old_op_type) {
-	    case OP_ENTEREVAL:
-		if (CxREALEVAL(cx)) {
-		    PADOFFSET off;
-		    saweval = i;
-		    seq = cxstack[i].blk_oldcop->cop_seq;
-		    startcv = cxstack[i].blk_eval.cv;
-		    if (startcv && CvOUTSIDE(startcv)) {
-			off = pad_findlex(name, newoff, seq, CvOUTSIDE(startcv),
-					  i-1, saweval, 0);
-			if (off)	/* continue looking if not found here */
-			    return off;
-		    }
-		}
-		break;
-	    case OP_DOFILE:
-	    case OP_REQUIRE:
-		/* require/do must have their own scope */
-		return 0;
-	    }
-	    break;
-	case CXt_FORMAT:
-	case CXt_SUB:
-	    if (!saweval)
-		return 0;
-	    cv = cx->blk_sub.cv;
-	    if (PL_debstash && CvSTASH(cv) == PL_debstash) {	/* ignore DB'* scope */
-		saweval = i;	/* so we know where we were called from */
-		seq = cxstack[i].blk_oldcop->cop_seq;
-		continue;
-	    }
-	    return pad_findlex(name, newoff, seq, cv, i-1, saweval,FINDLEX_NOSEARCH);
-	}
+    if (PL_in_my_stash && *name != '$') {
+	yyerror(Perl_form(aTHX_
+		    "Can't declare class for non-scalar %s in \"%s\"",
+		     name, PL_in_my == KEY_our ? "our" : "my"));
     }
 
-    return 0;
-}
-
-PADOFFSET
-Perl_pad_findmy(pTHX_ char *name)
-{
-    I32 off;
-    I32 pendoff = 0;
-    SV *sv;
-    SV **svp = AvARRAY(PL_comppad_name);
-    U32 seq = PL_cop_seqmax;
-    PERL_CONTEXT *cx;
-    CV *outside;
+    /* allocate a spare slot and store the name in that slot */
 
-#ifdef USE_5005THREADS
-    /*
-     * Special case to get lexical (and hence per-thread) @_.
-     * XXX I need to find out how to tell at parse-time whether use
-     * of @_ should refer to a lexical (from a sub) or defgv (global
-     * scope and maybe weird sub-ish things like formats). See
-     * startsub in perly.y.  It's possible that @_ could be lexical
-     * (at least from subs) even in non-threaded perl.
-     */
-    if (strEQ(name, "@_"))
-	return 0;		/* success. (NOT_IN_PAD indicates failure) */
-#endif /* USE_5005THREADS */
-
-    /* The one we're looking for is probably just before comppad_name_fill. */
-    for (off = AvFILLp(PL_comppad_name); off > 0; off--) {
-	if ((sv = svp[off]) &&
-	    sv != &PL_sv_undef &&
-	    (!SvIVX(sv) ||
-	     (seq <= (U32)SvIVX(sv) &&
-	      seq > (U32)I_32(SvNVX(sv)))) &&
-	    strEQ(SvPVX(sv), name))
-	{
-	    if (SvIVX(sv) || SvFLAGS(sv) & SVpad_OUR)
-		return (PADOFFSET)off;
-	    pendoff = off;	/* this pending def. will override import */
-	}
-    }
-
-    outside = CvOUTSIDE(PL_compcv);
-
-    /* Check if if we're compiling an eval'', and adjust seq to be the
-     * eval's seq number.  This depends on eval'' having a non-null
-     * CvOUTSIDE() while it is being compiled.  The eval'' itself is
-     * identified by CvEVAL being true and CvGV being null. */
-    if (outside && CvEVAL(PL_compcv) && !CvGV(PL_compcv) && cxstack_ix >= 0) {
-	cx = &cxstack[cxstack_ix];
-	if (CxREALEVAL(cx))
-	    seq = cx->blk_oldcop->cop_seq;
-    }
-
-    /* See if it's in a nested scope */
-    off = pad_findlex(name, 0, seq, outside, cxstack_ix, 0, 0);
-    if (off) {
-	/* If there is a pending local definition, this new alias must die */
-	if (pendoff)
-	    SvIVX(AvARRAY(PL_comppad_name)[off]) = seq;
-	return off;		/* pad_findlex returns 0 for failure...*/
-    }
-    return NOT_IN_PAD;		/* ...but we return NOT_IN_PAD for failure */
-}
-
-void
-Perl_pad_leavemy(pTHX_ I32 fill)
-{
-    I32 off;
-    SV **svp = AvARRAY(PL_comppad_name);
-    SV *sv;
-    if (PL_min_intro_pending && fill < PL_min_intro_pending) {
-	for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
-	    if ((sv = svp[off]) && sv != &PL_sv_undef && ckWARN_d(WARN_INTERNAL))
-		Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "%s never introduced", SvPVX(sv));
-	}
-    }
-    /* "Deintroduce" my variables that are leaving with this scope. */
-    for (off = AvFILLp(PL_comppad_name); off > fill; off--) {
-	if ((sv = svp[off]) && sv != &PL_sv_undef && SvIVX(sv) == PAD_MAX)
-	    SvIVX(sv) = PL_cop_seqmax;
-    }
-}
-
-PADOFFSET
-Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
-{
-    SV *sv;
-    I32 retval;
-
-    if (AvARRAY(PL_comppad) != PL_curpad)
-	Perl_croak(aTHX_ "panic: pad_alloc");
-    if (PL_pad_reset_pending)
-	pad_reset();
-    if (tmptype & SVs_PADMY) {
-	do {
-	    sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE);
-	} while (SvPADBUSY(sv));		/* need a fresh one */
-	retval = AvFILLp(PL_comppad);
-    }
-    else {
-	SV **names = AvARRAY(PL_comppad_name);
-	SSize_t names_fill = AvFILLp(PL_comppad_name);
-	for (;;) {
-	    /*
-	     * "foreach" index vars temporarily become aliases to non-"my"
-	     * values.  Thus we must skip, not just pad values that are
-	     * marked as current pad values, but also those with names.
-	     */
-	    if (++PL_padix <= names_fill &&
-		   (sv = names[PL_padix]) && sv != &PL_sv_undef)
-		continue;
-	    sv = *av_fetch(PL_comppad, PL_padix, TRUE);
-	    if (!(SvFLAGS(sv) & (SVs_PADTMP|SVs_PADMY)) &&
-		!IS_PADGV(sv) && !IS_PADCONST(sv))
-		break;
-	}
-	retval = PL_padix;
-    }
-    SvFLAGS(sv) |= tmptype;
-    PL_curpad = AvARRAY(PL_comppad);
-#ifdef USE_5005THREADS
-    DEBUG_X(PerlIO_printf(Perl_debug_log,
-			  "0x%"UVxf" Pad 0x%"UVxf" alloc %ld for %s\n",
-			  PTR2UV(thr), PTR2UV(PL_curpad),
-			  (long) retval, PL_op_name[optype]));
-#else
-    DEBUG_X(PerlIO_printf(Perl_debug_log,
-			  "Pad 0x%"UVxf" alloc %ld for %s\n",
-			  PTR2UV(PL_curpad),
-			  (long) retval, PL_op_name[optype]));
-#endif /* USE_5005THREADS */
-    return (PADOFFSET)retval;
-}
-
-SV *
-Perl_pad_sv(pTHX_ PADOFFSET po)
-{
-#ifdef USE_5005THREADS
-    DEBUG_X(PerlIO_printf(Perl_debug_log,
-			  "0x%"UVxf" Pad 0x%"UVxf" sv %"IVdf"\n",
-			  PTR2UV(thr), PTR2UV(PL_curpad), (IV)po));
-#else
-    if (!po)
-	Perl_croak(aTHX_ "panic: pad_sv po");
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" sv %"IVdf"\n",
-			  PTR2UV(PL_curpad), (IV)po));
-#endif /* USE_5005THREADS */
-    return PL_curpad[po];		/* eventually we'll turn this into a macro */
-}
-
-void
-Perl_pad_free(pTHX_ PADOFFSET po)
-{
-    if (!PL_curpad)
-	return;
-    if (AvARRAY(PL_comppad) != PL_curpad)
-	Perl_croak(aTHX_ "panic: pad_free curpad");
-    if (!po)
-	Perl_croak(aTHX_ "panic: pad_free po");
-#ifdef USE_5005THREADS
-    DEBUG_X(PerlIO_printf(Perl_debug_log,
-			  "0x%"UVxf" Pad 0x%"UVxf" free %"IVdf"\n",
-			  PTR2UV(thr), PTR2UV(PL_curpad), (IV)po));
-#else
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" free %"IVdf"\n",
-			  PTR2UV(PL_curpad), (IV)po));
-#endif /* USE_5005THREADS */
-    if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
-	SvPADTMP_off(PL_curpad[po]);
-#ifdef USE_ITHREADS
-#ifdef PERL_COPY_ON_WRITE
-	if (SvIsCOW(PL_curpad[po])) {
-	    sv_force_normal_flags(PL_curpad[po], SV_COW_DROP_PV);
-	} else
-#endif
-	    SvREADONLY_off(PL_curpad[po]);	/* could be a freed constant */
-#endif
-    }
-    if ((I32)po < PL_padix)
-	PL_padix = po - 1;
+    off = pad_add_name(name,
+		    PL_in_my_stash,
+		    (PL_in_my == KEY_our 
+			? (PL_curstash ? PL_curstash : PL_defstash)
+			: Nullhv
+		    ),
+		    0 /*  not fake */
+    );
+    return off;
 }
 
-void
-Perl_pad_swipe(pTHX_ PADOFFSET po)
-{
-    if (AvARRAY(PL_comppad) != PL_curpad)
-	Perl_croak(aTHX_ "panic: pad_swipe curpad");
-    if (!po)
-	Perl_croak(aTHX_ "panic: pad_swipe po");
-#ifdef USE_5005THREADS
-    DEBUG_X(PerlIO_printf(Perl_debug_log,
-			  "0x%"UVxf" Pad 0x%"UVxf" swipe %"IVdf"\n",
-			  PTR2UV(thr), PTR2UV(PL_curpad), (IV)po));
-#else
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" swipe %"IVdf"\n",
-			  PTR2UV(PL_curpad), (IV)po));
-#endif /* USE_5005THREADS */
-    if (PL_curpad[po])
-	SvPADTMP_off(PL_curpad[po]);
-    PL_curpad[po] = NEWSV(1107,0);
-    SvPADTMP_on(PL_curpad[po]);
-    if ((I32)po < PL_padix)
-	PL_padix = po - 1;
-}
-
-/* XXX pad_reset() is currently disabled because it results in serious bugs.
- * It causes pad temp TARGs to be shared between OPs. Since TARGs are pushed
- * on the stack by OPs that use them, there are several ways to get an alias
- * to  a shared TARG.  Such an alias will change randomly and unpredictably.
- * We avoid doing this until we can think of a Better Way.
- * GSAR 97-10-29 */
-void
-Perl_pad_reset(pTHX)
-{
-#ifdef USE_BROKEN_PAD_RESET
-    register I32 po;
-
-    if (AvARRAY(PL_comppad) != PL_curpad)
-	Perl_croak(aTHX_ "panic: pad_reset curpad");
-#ifdef USE_5005THREADS
-    DEBUG_X(PerlIO_printf(Perl_debug_log,
-			  "0x%"UVxf" Pad 0x%"UVxf" reset\n",
-			  PTR2UV(thr), PTR2UV(PL_curpad)));
-#else
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" reset\n",
-			  PTR2UV(PL_curpad)));
-#endif /* USE_5005THREADS */
-    if (!PL_tainting) {	/* Can't mix tainted and non-tainted temporaries. */
-	for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
-	    if (PL_curpad[po] && !SvIMMORTAL(PL_curpad[po]))
-		SvPADTMP_off(PL_curpad[po]);
-	}
-	PL_padix = PL_padix_floor;
-    }
-#endif
-    PL_pad_reset_pending = FALSE;
-}
 
 #ifdef USE_5005THREADS
 /* find_threadsv is not reentrant */
@@ -823,13 +362,9 @@ Perl_op_clear(pTHX_ OP *o)
     case OP_AELEMFAST:
 #ifdef USE_ITHREADS
 	if (cPADOPo->op_padix > 0) {
-	    if (PL_curpad) {
-		GV *gv = cGVOPo_gv;
-		pad_swipe(cPADOPo->op_padix);
-		/* No GvIN_PAD_off(gv) here, because other references may still
-		 * exist on the pad */
-		SvREFCNT_dec(gv);
-	    }
+	    /* No GvIN_PAD_off(cGVOPo_gv) here, because other references
+	     * may still exist on the pad */
+	    pad_swipe(cPADOPo->op_padix, TRUE);
 	    cPADOPo->op_padix = 0;
 	}
 #else
@@ -865,13 +400,9 @@ Perl_op_clear(pTHX_ OP *o)
     case OP_PUSHRE:
 #ifdef USE_ITHREADS
         if (INT2PTR(PADOFFSET, cPMOPo->op_pmreplroot)) {
-	    if (PL_curpad) {
-		GV *gv = (GV*)PL_curpad[INT2PTR(PADOFFSET, cPMOPo->op_pmreplroot)];
-		pad_swipe(INT2PTR(PADOFFSET, cPMOPo->op_pmreplroot));
-		/* No GvIN_PAD_off(gv) here, because other references may still
-		 * exist on the pad */
-		SvREFCNT_dec(gv);
-	    }
+	    /* No GvIN_PAD_off here, because other references may still
+	     * exist on the pad */
+	    pad_swipe(INT2PTR(PADOFFSET, cPMOPo->op_pmreplroot), TRUE);
 	}
 #else
 	SvREFCNT_dec((SV*)cPMOPo->op_pmreplroot);
@@ -1424,7 +955,6 @@ OP *
 Perl_mod(pTHX_ OP *o, I32 type)
 {
     OP *kid;
-    STRLEN n_a;
 
     if (!o || PL_error_count)
 	return o;
@@ -1650,8 +1180,13 @@ Perl_mod(pTHX_ OP *o, I32 type)
     case OP_PADSV:
 	PL_modcount++;
 	if (!type)
+	{   /* XXX DAPM 2002.08.25 tmp assert test */
+	    /* XXX */ assert(av_fetch(PL_comppad_name, (o->op_targ), FALSE));
+	    /* XXX */ assert(*av_fetch(PL_comppad_name, (o->op_targ), FALSE));
+
 	    Perl_croak(aTHX_ "Can't localize lexical variable %s",
-		SvPV(*av_fetch(PL_comppad_name, o->op_targ, 4), n_a));
+		 PAD_COMPNAME_PV(o->op_targ));
+	}
 	break;
 
 #ifdef USE_5005THREADS
@@ -1995,7 +1530,7 @@ S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp)
 	   target->op_type == OP_PADAV);
 
     /* Ensure that attributes.pm is loaded. */
-    apply_attrs(stash, pad_sv(target->op_targ), attrs, TRUE);
+    apply_attrs(stash, PAD_SV(target->op_targ), attrs, TRUE);
 
     /* Need package name for method call. */
     pack = newSVOP(OP_CONST, 0, newSVpvn(ATTRSMODULE, sizeof(ATTRSMODULE)-1));
@@ -2123,16 +1658,13 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
     }
     else if (attrs && type != OP_PUSHMARK) {
 	HV *stash;
-	SV **namesvp;
 
 	PL_in_my = FALSE;
 	PL_in_my_stash = Nullhv;
 
 	/* check for C<my Dog $spot> when deciding package */
-	namesvp = av_fetch(PL_comppad_name, o->op_targ, FALSE);
-	if (namesvp && *namesvp && (SvFLAGS(*namesvp) & SVpad_TYPED))
-	    stash = SvSTASH(*namesvp);
-	else
+	stash = PAD_COMPNAME_TYPE(o->op_targ);
+	if (!stash)
 	    stash = PL_curstash;
 	apply_attrs_my(stash, o, attrs, imopsp);
     }
@@ -2285,19 +1817,7 @@ Perl_block_start(pTHX_ int full)
 {
     int retval = PL_savestack_ix;
 
-    SAVEI32(PL_comppad_name_floor);
-    PL_comppad_name_floor = AvFILLp(PL_comppad_name);
-    if (full)
-	PL_comppad_name_fill = PL_comppad_name_floor;
-    if (PL_comppad_name_floor < 0)
-	PL_comppad_name_floor = 0;
-    SAVEI32(PL_min_intro_pending);
-    SAVEI32(PL_max_intro_pending);
-    PL_min_intro_pending = 0;
-    SAVEI32(PL_comppad_name_fill);
-    SAVEI32(PL_padix_floor);
-    PL_padix_floor = PL_padix;
-    PL_pad_reset_pending = FALSE;
+    pad_block_start(full);
     SAVEHINTS();
     PL_hints &= ~HINT_BLOCK_SCOPE;
     SAVESPTR(PL_compiling.cop_warnings);
@@ -2322,12 +1842,10 @@ Perl_block_end(pTHX_ I32 floor, OP *seq)
     OP* retval = seq ? scalarseq(seq) : newSTATEOP(0, Nullch, seq);
     PL_copline = copline;  /* XXX newSTATEOP may reset PL_copline */
     LEAVE_SCOPE(floor);
-    PL_pad_reset_pending = FALSE;
     PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
     if (needblockscope)
 	PL_hints |= HINT_BLOCK_SCOPE; /* propagate out */
-    pad_leavemy(PL_comppad_name_fill);
-    PL_cop_seqmax++;
+    pad_leavemy();
     return retval;
 }
 
@@ -2500,7 +2018,7 @@ Perl_fold_constants(pTHX_ register OP *o)
     CALLRUNOPS(aTHX);
     sv = *(PL_stack_sp--);
     if (o->op_targ && sv == PAD_SV(o->op_targ))	/* grab pad temp? */
-	pad_swipe(o->op_targ);
+	pad_swipe(o->op_targ,  FALSE);
     else if (SvTEMP(sv)) {			/* grab mortal temp? */
 	(void)SvREFCNT_inc(sv);
 	SvTEMP_off(sv);
@@ -3323,8 +2841,8 @@ Perl_newPADOP(pTHX_ I32 type, I32 flags, SV *sv)
     padop->op_type = (OPCODE)type;
     padop->op_ppaddr = PL_ppaddr[type];
     padop->op_padix = pad_alloc(type, SVs_PADTMP);
-    SvREFCNT_dec(PL_curpad[padop->op_padix]);
-    PL_curpad[padop->op_padix] = sv;
+    SvREFCNT_dec(PAD_SVl(padop->op_padix));
+    PAD_SETSV(padop->op_padix, sv);
     if (sv)
 	SvPADTMP_on(sv);
     padop->op_next = (OP*)padop;
@@ -3658,6 +3176,21 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 	curop = list(force_list(left));
 	o = newBINOP(OP_AASSIGN, flags, list(force_list(right)), curop);
 	o->op_private = (U8)(0 | (flags >> 8));
+
+	/* PL_generation sorcery:
+	 * an assignment like ($a,$b) = ($c,$d) is easier than
+	 * ($a,$b) = ($c,$a), since there is no need for temporary vars.
+	 * To detect whether there are common vars, the global var
+	 * PL_generation is incremented for each assign op we compile.
+	 * Then, while compiling the assign op, we run through all the
+	 * variables on both sides of the assignment, setting a spare slot
+	 * in each of them to PL_generation. If any of them already have
+	 * that value, we know we've got commonality.  We could use a
+	 * single bit marker, but then we'd have to make 2 passes, first
+	 * to clear the flag, then to test and set it.  To find somewhere
+	 * to store these values, evil chicanery is done with SvCUR().
+	 */
+
 	if (!(left->op_private & OPpLVAL_INTRO)) {
 	    OP *lastop = o;
 	    PL_generation++;
@@ -3672,12 +3205,14 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 		    else if (curop->op_type == OP_PADSV ||
 			     curop->op_type == OP_PADAV ||
 			     curop->op_type == OP_PADHV ||
-			     curop->op_type == OP_PADANY) {
-			SV **svp = AvARRAY(PL_comppad_name);
-			SV *sv = svp[curop->op_targ];
-			if ((int)SvCUR(sv) == PL_generation)
+			     curop->op_type == OP_PADANY)
+		    {
+			if (PAD_COMPNAME_GEN(curop->op_targ)
+						    == PL_generation)
 			    break;
-			SvCUR(sv) = PL_generation;	/* (SvCUR not used any more) */
+			PAD_COMPNAME_GEN(curop->op_targ)
+			    				= PL_generation;
+
 		    }
 		    else if (curop->op_type == OP_RV2CV)
 			break;
@@ -3691,7 +3226,8 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 		    else if (curop->op_type == OP_PUSHRE) {
 			if (((PMOP*)curop)->op_pmreplroot) {
 #ifdef USE_ITHREADS
-			    GV *gv = (GV*)PL_curpad[INT2PTR(PADOFFSET,((PMOP*)curop)->op_pmreplroot)];
+			    GV *gv = (GV*)PAD_SVl(INT2PTR(PADOFFSET,
+					((PMOP*)curop)->op_pmreplroot));
 #else
 			    GV *gv = (GV*)((PMOP*)curop)->op_pmreplroot;
 #endif
@@ -3834,28 +3370,6 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
     return prepend_elem(OP_LINESEQ, (OP*)cop, o);
 }
 
-/* "Introduce" my variables to visible status. */
-U32
-Perl_intro_my(pTHX)
-{
-    SV **svp;
-    SV *sv;
-    I32 i;
-
-    if (! PL_min_intro_pending)
-	return PL_cop_seqmax;
-
-    svp = AvARRAY(PL_comppad_name);
-    for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
-	if ((sv = svp[i]) && sv != &PL_sv_undef && !SvIVX(sv)) {
-	    SvIVX(sv) = PAD_MAX;	/* Don't know scope end yet. */
-	    SvNVX(sv) = (NV)PL_cop_seqmax;
-	}
-    }
-    PL_min_intro_pending = 0;
-    PL_comppad_name_fill = PL_max_intro_pending;	/* Needn't search higher */
-    return PL_cop_seqmax++;
-}
 
 OP *
 Perl_newLOGOP(pTHX_ I32 type, I32 flags, OP *first, OP *other)
@@ -4349,7 +3863,6 @@ Perl_cv_undef(pTHX_ CV *cv)
 {
     CV *outsidecv;
     CV *freecv = Nullcv;
-    bool is_eval = CvEVAL(cv) && !CvGV(cv);	/* is this eval"" ? */
 
 #ifdef USE_5005THREADS
     if (CvMUTEXP(cv)) {
@@ -4377,8 +3890,7 @@ Perl_cv_undef(pTHX_ CV *cv)
 #endif /* USE_5005THREADS */
 	ENTER;
 
-	SAVEVPTR(PL_curpad);
-	PL_curpad = 0;
+	PAD_SAVE_SETNULLPAD;
 
 	op_free(CvROOT(cv));
 	CvROOT(cv) = Nullop;
@@ -4399,58 +3911,8 @@ Perl_cv_undef(pTHX_ CV *cv)
 	SvREFCNT_dec((SV*)CvXSUBANY(cv).any_ptr);
 	CvCONST_off(cv);
     }
-    if (CvPADLIST(cv)) {
-	/* may be during global destruction */
-	if (SvREFCNT(CvPADLIST(cv))) {
-	    AV *padlist = CvPADLIST(cv);
-	    I32 ix;
-	    /* pads may be cleared out already during global destruction */
-	    if ((is_eval && !PL_dirty) || CvSPECIAL(cv)) {
-		/* inner references to eval's cv must be fixed up */
-		AV *comppad_name = (AV*)AvARRAY(padlist)[0];
-		AV *comppad = (AV*)AvARRAY(padlist)[1];
-		SV **namepad = AvARRAY(comppad_name);
-		SV **curpad = AvARRAY(comppad);
-		for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
-		    SV *namesv = namepad[ix];
-		    if (namesv && namesv != &PL_sv_undef
-			&& *SvPVX(namesv) == '&'
-			&& ix <= AvFILLp(comppad))
-		    {
-			CV *innercv = (CV*)curpad[ix];
-			if (innercv && SvTYPE(innercv) == SVt_PVCV
-			    && CvOUTSIDE(innercv) == cv)
-			{
-			    CvOUTSIDE(innercv) = outsidecv;
-			    if (!CvANON(innercv) || CvCLONED(innercv)) {
-				(void)SvREFCNT_inc(outsidecv);
-				if (SvREFCNT(cv))
-				    SvREFCNT_dec(cv);
-			    }
-			}
-		    }
-		}
-	    }
-	    if (freecv)
-		SvREFCNT_dec(freecv);
-	    ix = AvFILLp(padlist);
-	    while (ix >= 0) {
-		SV* sv = AvARRAY(padlist)[ix--];
-		if (!sv)
-		    continue;
-		if (sv == (SV*)PL_comppad_name)
-		    PL_comppad_name = Nullav;
-		else if (sv == (SV*)PL_comppad) {
-		    PL_comppad = Nullav;
-		    PL_curpad = Null(SV**);
-		}
-		SvREFCNT_dec(sv);
-	    }
-	    SvREFCNT_dec((SV*)CvPADLIST(cv));
-	}
-	CvPADLIST(cv) = Nullav;
-    }
-    else if (freecv)
+    pad_undef(cv, outsidecv);
+    if (freecv)
 	SvREFCNT_dec(freecv);
     if (CvXSUB(cv)) {
         CvXSUB(cv) = 0;
@@ -4458,211 +3920,6 @@ Perl_cv_undef(pTHX_ CV *cv)
     CvFLAGS(cv) = 0;
 }
 
-#ifdef DEBUG_CLOSURES
-STATIC void
-S_cv_dump(pTHX_ CV *cv)
-{
-#ifdef DEBUGGING
-    CV *outside = CvOUTSIDE(cv);
-    AV* padlist = CvPADLIST(cv);
-    AV* pad_name;
-    AV* pad;
-    SV** pname;
-    SV** ppad;
-    I32 ix;
-
-    PerlIO_printf(Perl_debug_log,
-		  "\tCV=0x%"UVxf" (%s), OUTSIDE=0x%"UVxf" (%s)\n",
-		  PTR2UV(cv),
-		  (CvANON(cv) ? "ANON"
-		   : (cv == PL_main_cv) ? "MAIN"
-		   : CvUNIQUE(cv) ? "UNIQUE"
-		   : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
-		  PTR2UV(outside),
-		  (!outside ? "null"
-		   : CvANON(outside) ? "ANON"
-		   : (outside == PL_main_cv) ? "MAIN"
-		   : CvUNIQUE(outside) ? "UNIQUE"
-		   : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
-
-    if (!padlist)
-	return;
-
-    pad_name = (AV*)*av_fetch(padlist, 0, FALSE);
-    pad = (AV*)*av_fetch(padlist, 1, FALSE);
-    pname = AvARRAY(pad_name);
-    ppad = AvARRAY(pad);
-
-    for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
-	if (SvPOK(pname[ix]))
-	    PerlIO_printf(Perl_debug_log,
-			  "\t%4d. 0x%"UVxf" (%s\"%s\" %"IVdf"-%"IVdf")\n",
-			  (int)ix, PTR2UV(ppad[ix]),
-			  SvFAKE(pname[ix]) ? "FAKE " : "",
-			  SvPVX(pname[ix]),
-			  (IV)I_32(SvNVX(pname[ix])),
-			  SvIVX(pname[ix]));
-    }
-#endif /* DEBUGGING */
-}
-#endif /* DEBUG_CLOSURES */
-
-STATIC CV *
-S_cv_clone2(pTHX_ CV *proto, CV *outside)
-{
-    AV* av;
-    I32 ix;
-    AV* protopadlist = CvPADLIST(proto);
-    AV* protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
-    AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
-    SV** pname = AvARRAY(protopad_name);
-    SV** ppad = AvARRAY(protopad);
-    I32 fname = AvFILLp(protopad_name);
-    I32 fpad = AvFILLp(protopad);
-    AV* comppadlist;
-    CV* cv;
-
-    assert(!CvUNIQUE(proto));
-
-    ENTER;
-    SAVECOMPPAD();
-    SAVESPTR(PL_comppad_name);
-    SAVESPTR(PL_compcv);
-
-    cv = PL_compcv = (CV*)NEWSV(1104,0);
-    sv_upgrade((SV *)cv, SvTYPE(proto));
-    CvFLAGS(cv) = CvFLAGS(proto) & ~CVf_CLONE;
-    CvCLONED_on(cv);
-
-#ifdef USE_5005THREADS
-    New(666, CvMUTEXP(cv), 1, perl_mutex);
-    MUTEX_INIT(CvMUTEXP(cv));
-    CvOWNER(cv)		= 0;
-#endif /* USE_5005THREADS */
-#ifdef USE_ITHREADS
-    CvFILE(cv)		= CvXSUB(proto) ? CvFILE(proto)
-					: savepv(CvFILE(proto));
-#else
-    CvFILE(cv)		= CvFILE(proto);
-#endif
-    CvGV(cv)		= CvGV(proto);
-    CvSTASH(cv)		= CvSTASH(proto);
-    CvROOT(cv)		= OpREFCNT_inc(CvROOT(proto));
-    CvSTART(cv)		= CvSTART(proto);
-    if (outside)
-	CvOUTSIDE(cv)	= (CV*)SvREFCNT_inc(outside);
-
-    if (SvPOK(proto))
-	sv_setpvn((SV*)cv, SvPVX(proto), SvCUR(proto));
-
-    PL_comppad_name = newAV();
-    for (ix = fname; ix >= 0; ix--)
-	av_store(PL_comppad_name, ix, SvREFCNT_inc(pname[ix]));
-
-    PL_comppad = newAV();
-
-    comppadlist = newAV();
-    AvREAL_off(comppadlist);
-    av_store(comppadlist, 0, (SV*)PL_comppad_name);
-    av_store(comppadlist, 1, (SV*)PL_comppad);
-    CvPADLIST(cv) = comppadlist;
-    av_fill(PL_comppad, AvFILLp(protopad));
-    PL_curpad = AvARRAY(PL_comppad);
-
-    av = newAV();           /* will be @_ */
-    av_extend(av, 0);
-    av_store(PL_comppad, 0, (SV*)av);
-    AvFLAGS(av) = AVf_REIFY;
-
-    for (ix = fpad; ix > 0; ix--) {
-	SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
-	if (namesv && namesv != &PL_sv_undef) {
-	    char *name = SvPVX(namesv);    /* XXX */
-	    if (SvFLAGS(namesv) & SVf_FAKE) {   /* lexical from outside? */
-		I32 off = pad_findlex(name, ix, SvIVX(namesv),
-				      CvOUTSIDE(cv), cxstack_ix, 0, 0);
-		if (!off)
-		    PL_curpad[ix] = SvREFCNT_inc(ppad[ix]);
-		else if (off != ix)
-		    Perl_croak(aTHX_ "panic: cv_clone: %s", name);
-	    }
-	    else {				/* our own lexical */
-		SV* sv;
-		if (*name == '&') {
-		    /* anon code -- we'll come back for it */
-		    sv = SvREFCNT_inc(ppad[ix]);
-		}
-		else if (*name == '@')
-		    sv = (SV*)newAV();
-		else if (*name == '%')
-		    sv = (SV*)newHV();
-		else
-		    sv = NEWSV(0,0);
-		if (!SvPADBUSY(sv))
-		    SvPADMY_on(sv);
-		PL_curpad[ix] = sv;
-	    }
-	}
-	else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) {
-	    PL_curpad[ix] = SvREFCNT_inc(ppad[ix]);
-	}
-	else {
-	    SV* sv = NEWSV(0,0);
-	    SvPADTMP_on(sv);
-	    PL_curpad[ix] = sv;
-	}
-    }
-
-    /* Now that vars are all in place, clone nested closures. */
-
-    for (ix = fpad; ix > 0; ix--) {
-	SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
-	if (namesv
-	    && namesv != &PL_sv_undef
-	    && !(SvFLAGS(namesv) & SVf_FAKE)
-	    && *SvPVX(namesv) == '&'
-	    && CvCLONE(ppad[ix]))
-	{
-	    CV *kid = cv_clone2((CV*)ppad[ix], cv);
-	    SvREFCNT_dec(ppad[ix]);
-	    CvCLONE_on(kid);
-	    SvPADMY_on(kid);
-	    PL_curpad[ix] = (SV*)kid;
-	}
-    }
-
-#ifdef DEBUG_CLOSURES
-    PerlIO_printf(Perl_debug_log, "Cloned inside:\n");
-    cv_dump(outside);
-    PerlIO_printf(Perl_debug_log, "  from:\n");
-    cv_dump(proto);
-    PerlIO_printf(Perl_debug_log, "   to:\n");
-    cv_dump(cv);
-#endif
-
-    LEAVE;
-
-    if (CvCONST(cv)) {
-	SV* const_sv = op_const_sv(CvSTART(cv), cv);
-	assert(const_sv);
-	/* constant sub () { $x } closing over $x - see lib/constant.pm */
-	SvREFCNT_dec(cv);
-	cv = newCONSTSUB(CvSTASH(proto), 0, const_sv);
-    }
-
-    return cv;
-}
-
-CV *
-Perl_cv_clone(pTHX_ CV *proto)
-{
-    CV *cv;
-    LOCK_CRED_MUTEX;			/* XXX create separate mutex */
-    cv = cv_clone2(proto, CvOUTSIDE(proto));
-    UNLOCK_CRED_MUTEX;			/* XXX create separate mutex */
-    return cv;
-}
-
 void
 Perl_cv_ckproto(pTHX_ CV *cv, GV *gv, char *p)
 {
@@ -4739,8 +3996,7 @@ Perl_op_const_sv(pTHX_ OP *o, CV *cv)
 	if (type == OP_CONST && cSVOPo->op_sv)
 	    sv = cSVOPo->op_sv;
 	else if ((type == OP_PADSV || type == OP_CONST) && cv) {
-	    AV* padav = (AV*)(AvARRAY(CvPADLIST(cv))[1]);
-	    sv = padav ? AvARRAY(padav)[o->op_targ] : Nullsv;
+	    sv = PAD_BASE_SV(CvPADLIST(cv), o->op_targ);
 	    if (!sv)
 		return Nullsv;
 	    if (CvCONST(cv)) {
@@ -4791,7 +4047,6 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     GV *gv;
     char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, n_a) : Nullch;
     register CV *cv=0;
-    I32 ix;
     SV *const_sv;
 
     name = o ? SvPVx(cSVOPo->op_sv, n_a) : Nullch;
@@ -4956,28 +4211,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	CvPADLIST(cv) = CvPADLIST(PL_compcv);
 	CvPADLIST(PL_compcv) = 0;
 	/* inner references to PL_compcv must be fixed up ... */
-	{
-	    AV *padlist = CvPADLIST(cv);
-	    AV *comppad_name = (AV*)AvARRAY(padlist)[0];
-	    AV *comppad = (AV*)AvARRAY(padlist)[1];
-	    SV **namepad = AvARRAY(comppad_name);
-	    SV **curpad = AvARRAY(comppad);
-	    for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
-		SV *namesv = namepad[ix];
-		if (namesv && namesv != &PL_sv_undef
-		    && *SvPVX(namesv) == '&')
-		{
-		    CV *innercv = (CV*)curpad[ix];
-		    if (CvOUTSIDE(innercv) == PL_compcv) {
-			CvOUTSIDE(innercv) = cv;
-			if (!CvANON(innercv) || CvCLONED(innercv)) {
-			    (void)SvREFCNT_inc(cv);
-			    SvREFCNT_dec(PL_compcv);
-			}
-		    }
-		}
-	    }
-	}
+	pad_fixup_inner_anons(CvPADLIST(cv), PL_compcv, cv);
 	/* ... before we throw it away */
 	SvREFCNT_dec(PL_compcv);
 	if (PERLDB_INTER)/* Advice debugger on the new sub. */
@@ -5027,9 +4261,6 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     if (!block)
 	goto done;
 
-    if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
-	av_store(PL_comppad_name, AvFILLp(PL_comppad), Nullsv);
-
     if (CvLVALUE(cv)) {
 	CvROOT(cv) = newUNOP(OP_LEAVESUBLV, 0,
 			     mod(scalarseq(block), OP_LEAVESUBLV));
@@ -5044,44 +4275,14 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     CALL_PEEP(CvSTART(cv));
 
     /* now that optimizer has done its work, adjust pad values */
-    if (CvCLONE(cv)) {
-	SV **namep = AvARRAY(PL_comppad_name);
-	for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
-	    SV *namesv;
 
-	    if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
-		continue;
-	    /*
-	     * The only things that a clonable function needs in its
-	     * pad are references to outer lexicals and anonymous subs.
-	     * The rest are created anew during cloning.
-	     */
-	    if (!((namesv = namep[ix]) != Nullsv &&
-		  namesv != &PL_sv_undef &&
-		  (SvFAKE(namesv) ||
-		   *SvPVX(namesv) == '&')))
-	    {
-		SvREFCNT_dec(PL_curpad[ix]);
-		PL_curpad[ix] = Nullsv;
-	    }
-	}
+    pad_tidy(CvCLONE(cv) ? padtidy_SUBCLONE : padtidy_SUB);
+
+    if (CvCLONE(cv)) {
 	assert(!CvCONST(cv));
 	if (ps && !*ps && op_const_sv(block, cv))
 	    CvCONST_on(cv);
     }
-    else {
-	AV *av = newAV();			/* Will be @_ */
-	av_extend(av, 0);
-	av_store(PL_comppad, 0, (SV*)av);
-	AvFLAGS(av) = AVf_REIFY;
-
-	for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
-	    if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
-		continue;
-	    if (!SvPADMY(PL_curpad[ix]))
-		SvPADTMP_on(PL_curpad[ix]);
-	}
-    }
 
     /* If a potential closure prototype, don't keep a refcount on outer CV.
      * This is okay as the lifetime of the prototype is tied to the
@@ -5337,7 +4538,6 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
     register CV *cv;
     char *name;
     GV *gv;
-    I32 ix;
     STRLEN n_a;
 
     if (o)
@@ -5366,11 +4566,8 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
     CvGV(cv) = gv;
     CvFILE_set_from_cop(cv, PL_curcop);
 
-    for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
-	if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix]))
-	    SvPADTMP_on(PL_curpad[ix]);
-    }
 
+    pad_tidy(padtidy_FORMAT);
     CvROOT(cv) = newUNOP(OP_LEAVEWRITE, 0, scalarseq(block));
     CvROOT(cv)->op_private |= OPpREFCOUNTED;
     OpREFCNT_set(CvROOT(cv), 1);
@@ -5532,20 +4729,8 @@ Perl_newSVREF(pTHX_ OP *o)
 OP *
 Perl_ck_anoncode(pTHX_ OP *o)
 {
-    PADOFFSET ix;
-    SV* name;
-
-    name = NEWSV(1106,0);
-    sv_upgrade(name, SVt_PVNV);
-    sv_setpvn(name, "&", 1);
-    SvIVX(name) = -1;
-    SvNVX(name) = 1;
-    ix = pad_alloc(o->op_type, SVs_PADMY);
-    av_store(PL_comppad_name, ix, name);
-    av_store(PL_comppad, ix, cSVOPo->op_sv);
-    SvPADMY_on(cSVOPo->op_sv);
+    cSVOPo->op_targ = pad_add_anon(cSVOPo->op_sv, o->op_type);
     cSVOPo->op_sv = Nullsv;
-    cSVOPo->op_targ = ix;
     return o;
 }
 
@@ -5837,9 +5022,9 @@ Perl_ck_rvconst(pTHX_ register OP *o)
 #ifdef USE_ITHREADS
 	    /* XXX hack: dependence on sizeof(PADOP) <= sizeof(SVOP) */
 	    kPADOP->op_padix = pad_alloc(OP_GV, SVs_PADTMP);
-	    SvREFCNT_dec(PL_curpad[kPADOP->op_padix]);
+	    SvREFCNT_dec(PAD_SVl(kPADOP->op_padix));
 	    GvIN_PAD_on(gv);
-	    PL_curpad[kPADOP->op_padix] = SvREFCNT_inc(gv);
+	    PAD_SETSV(kPADOP->op_padix, (SV*) SvREFCNT_inc(gv));
 #else
 	    kid->op_sv = SvREFCNT_inc(gv);
 #endif
@@ -6014,7 +5199,7 @@ Perl_ck_fun(pTHX_ OP *o)
 			/* is this op a FH constructor? */
 			if (is_handle_constructor(o,numargs)) {
 			    char *name = Nullch;
-			    STRLEN len;
+			    STRLEN len = 0;
 
 			    flags = 0;
 			    /* Set a flag to tell rv2gv to vivify
@@ -6023,10 +5208,17 @@ Perl_ck_fun(pTHX_ OP *o)
 			     */
 			    priv = OPpDEREF;
 			    if (kid->op_type == OP_PADSV) {
-				SV **namep = av_fetch(PL_comppad_name,
-						      kid->op_targ, 4);
-				if (namep && *namep)
-				    name = SvPV(*namep, len);
+				/*XXX DAPM 2002.08.25 tmp assert test */
+				/*XXX*/ assert(av_fetch(PL_comppad_name, (kid->op_targ), FALSE));
+				/*XXX*/ assert(*av_fetch(PL_comppad_name, (kid->op_targ), FALSE));
+
+				name = PAD_COMPNAME_PV(kid->op_targ);
+				/* SvCUR of a pad namesv can't be trusted
+				 * (see PL_generation), so calc its length
+				 * manually */
+				if (name)
+				    len = strlen(name);
+
 			    }
 			    else if (kid->op_type == OP_RV2SV
 				     && kUNOP->op_first->op_type == OP_GV)
@@ -6045,7 +5237,7 @@ Perl_ck_fun(pTHX_ OP *o)
 			    if (name) {
 				SV *namesv;
 				targ = pad_alloc(OP_RV2GV, SVs_PADTMP);
-				namesv = PL_curpad[targ];
+				namesv = PAD_SVl(targ);
 				(void)SvUPGRADE(namesv, SVt_PV);
 				if (*name != '$')
 				    sv_setpvn(namesv, "$", 1);
@@ -6501,7 +5693,7 @@ Perl_ck_shift(pTHX_ OP *o)
 #ifdef USE_5005THREADS
 	if (!CvUNIQUE(PL_compcv)) {
 	    argop = newOP(OP_PADAV, OPf_REF);
-	    argop->op_targ = 0;		/* PL_curpad[0] is @_ */
+	    argop->op_targ = 0;		/* PAD_SV(0) is @_ */
 	}
 	else {
 	    argop = newUNOP(OP_RV2AV, 0,
@@ -7013,16 +6205,16 @@ Perl_peep(pTHX_ register OP *o)
 		if (SvPADTMP(cSVOPo->op_sv)) {
 		    /* If op_sv is already a PADTMP then it is being used by
 		     * some pad, so make a copy. */
-		    sv_setsv(PL_curpad[ix],cSVOPo->op_sv);
-		    SvREADONLY_on(PL_curpad[ix]);
+		    sv_setsv(PAD_SVl(ix),cSVOPo->op_sv);
+		    SvREADONLY_on(PAD_SVl(ix));
 		    SvREFCNT_dec(cSVOPo->op_sv);
 		}
 		else {
-		    SvREFCNT_dec(PL_curpad[ix]);
+		    SvREFCNT_dec(PAD_SVl(ix));
 		    SvPADTMP_on(cSVOPo->op_sv);
-		    PL_curpad[ix] = cSVOPo->op_sv;
+		    PAD_SETSV(ix, cSVOPo->op_sv);
 		    /* XXX I don't know how this isn't readonly already. */
-		    SvREADONLY_on(PL_curpad[ix]);
+		    SvREADONLY_on(PAD_SVl(ix));
 		}
 		cSVOPo->op_sv = Nullsv;
 		o->op_targ = ix;