This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
move all pad-related code to its own src file
authorDave Mitchell <davem@fdisolutions.com>
Wed, 25 Sep 2002 23:40:23 +0000 (00:40 +0100)
committerhv <hv@crypt.org>
Wed, 2 Oct 2002 12:55:29 +0000 (12:55 +0000)
Message-ID: <20020925234023.A20044@fdgroup.com>

p4raw-id: //depot/perl@17953

29 files changed:
MANIFEST
Makefile.SH
Makefile.micro
cop.h
cv.h
dump.c
embed.fnc
embed.h
embedvar.h
ext/B/B.xs
ext/Devel/Peek/Peek.t
op.c
op.h
pad.c [new file with mode: 0644]
pad.h [new file with mode: 0644]
perl.c
perl.h
perlapi.h
pod/perlapi.pod
pod/perlintern.pod
pp.c
pp_ctl.c
pp_hot.c
pp_sort.c
pp_sys.c
proto.h
scope.c
sv.c
toke.c

index 7b7201c..ac813c3 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2104,6 +2104,8 @@ os2/os2_base.t                    Additional tests for builtin methods
 os2/perl2cmd.pl                        Corrects installed binaries under OS/2
 os2/perlrexx.c                 Support perl interpreter embedded in REXX
 patchlevel.h                   The current patch level of perl
+pad.c                          Scratchpad functions
+pad.h                          Scratchpad headers
 perl.c                         main()
 perl.h                         Global declarations
 perlapi.c                      Perl API functions
index 7759a28..7416b7e 100644 (file)
@@ -299,20 +299,20 @@ plextract = pod/pod2html pod/pod2latex pod/pod2man pod/pod2text \
 addedbyconf = UU $(shextract) $(plextract) lib/lib.pm pstruct
 
 h1 = EXTERN.h INTERN.h XSUB.h av.h config.h cop.h cv.h dosish.h
-h2 = embed.h form.h gv.h handy.h hv.h keywords.h mg.h op.h
-h3 = opcode.h patchlevel.h perl.h perlapi.h perly.h pp.h proto.h regcomp.h
+h2 = embed.h form.h gv.h handy.h hv.h keywords.h mg.h op.h opcode.h
+h3 = pad.h patchlevel.h perl.h perlapi.h perly.h pp.h proto.h regcomp.h
 h4 = regexp.h scope.h sv.h unixish.h util.h iperlsys.h thread.h
 h5 = utf8.h warnings.h
 h = $(h1) $(h2) $(h3) $(h4) $(h5)
 
 c1 = $(mallocsrc) av.c scope.c op.c doop.c doio.c dump.c hv.c mg.c reentr.c
 c2 = perl.c perly.c pp.c pp_hot.c pp_ctl.c pp_sys.c regcomp.c regexec.c utf8.c
-c3 = gv.c sv.c taint.c toke.c util.c deb.c run.c universal.c xsutils.c
+c3 = gv.c sv.c taint.c toke.c util.c deb.c run.c universal.c xsutils.c pad.c
 c4 = globals.c perlio.c perlapi.c numeric.c locale.c pp_pack.c pp_sort.c
 
 c = $(c1) $(c2) $(c3) $(c4) miniperlmain.c perlmain.c
 
-obj1 = $(mallocobj) gv$(OBJ_EXT) toke$(OBJ_EXT) perly$(OBJ_EXT) op$(OBJ_EXT) regcomp$(OBJ_EXT) dump$(OBJ_EXT) util$(OBJ_EXT) mg$(OBJ_EXT) reentr$(OBJ_EXT)
+obj1 = $(mallocobj) gv$(OBJ_EXT) toke$(OBJ_EXT) perly$(OBJ_EXT) op$(OBJ_EXT) pad$(OBJ_EXT) regcomp$(OBJ_EXT) dump$(OBJ_EXT) util$(OBJ_EXT) mg$(OBJ_EXT) reentr$(OBJ_EXT)
 obj2 = hv$(OBJ_EXT) av$(OBJ_EXT) run$(OBJ_EXT) pp_hot$(OBJ_EXT) sv$(OBJ_EXT) pp$(OBJ_EXT) scope$(OBJ_EXT) pp_ctl$(OBJ_EXT) pp_sys$(OBJ_EXT)
 obj3 = doop$(OBJ_EXT) doio$(OBJ_EXT) regexec$(OBJ_EXT) utf8$(OBJ_EXT) taint$(OBJ_EXT) deb$(OBJ_EXT) universal$(OBJ_EXT) xsutils$(OBJ_EXT) globals$(OBJ_EXT) perlio$(OBJ_EXT) perlapi$(OBJ_EXT) numeric$(OBJ_EXT) locale$(OBJ_EXT) pp_pack$(OBJ_EXT) pp_sort$(OBJ_EXT)
 
index 048dadb..a0daee2 100644 (file)
@@ -9,7 +9,7 @@ all:    microperl
 
 O = uav$(_O) udeb$(_O) udoio$(_O) udoop$(_O) udump$(_O) \
        uglobals$(_O) ugv$(_O) uhv$(_O) \
-       umg$(_O) uperlmain$(_O) uop$(_O) ureentr$(_O) \
+       umg$(_O) uperlmain$(_O) uop$(_O) upad$(_O) ureentr$(_O) \
        uperl$(_O) uperlio$(_O) uperly$(_O) upp$(_O) \
        upp_ctl$(_O) upp_hot$(_O) upp_sys$(_O) upp_pack$(_O) upp_sort$(_O) \
        uregcomp$(_O) uregexec$(_O) urun$(_O) \
@@ -21,10 +21,10 @@ microperl:  $(O)
        $(LD) -o $@ $(O) $(LIBS)
 
 H = av.h uconfig.h cop.h cv.h embed.h embedvar.h form.h gv.h handy.h \
-       hv.h intrpvar.h iperlsys.h mg.h op.h opcode.h opnames.h patchlevel.h \
-       perl.h perlsdio.h perlvars.h perly.h pp.h pp_proto.h proto.h reentr.h \
-       regexp.h scope.h sv.h thrdvar.h thread.h unixish.h utf8.h util.h \
-       warnings.h
+       hv.h intrpvar.h iperlsys.h mg.h op.h opcode.h opnames.h pad.h \
+       patchlevel.h perl.h perlsdio.h perlvars.h perly.h pp.h \
+       pp_proto.h proto.h reentr.h regexp.h scope.h sv.h thrdvar.h \
+       thread.h unixish.h utf8.h util.h warnings.h
 
 HE = $(H) EXTERN.h
 
@@ -82,6 +82,9 @@ uperlmain$(_O):       $(HE) miniperlmain.c
 uop$(_O):      $(HE) op.c keywords.h
        $(CC) -c -o $@ $(CFLAGS) op.c
 
+upad$(_O):     $(HE) pad.c
+       $(CC) -c -o $@ $(CFLAGS) pad.c
+
 ureentr$(_O):  $(HE) reentr.c
        $(CC) -c -o $@ $(CFLAGS) reentr.c
 
diff --git a/cop.h b/cop.h
index 0732a04..5da1cf0 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -114,7 +114,7 @@ struct block_sub {
     long       olddepth;
     U8         hasargs;
     U8         lval;           /* XXX merge lval and hasargs? */
-    SV **      oldcurpad;
+    PAD                oldcurpad;
 };
 
 #define PUSHSUB(cx)                                                    \
@@ -161,7 +161,7 @@ struct block_sub {
                cx->blk_sub.argarray = newAV();                         \
                av_extend(cx->blk_sub.argarray, fill);                  \
                AvFLAGS(cx->blk_sub.argarray) = AVf_REIFY;              \
-               cx->blk_sub.oldcurpad[0] = (SV*)cx->blk_sub.argarray;   \
+               CX_CURPAD_SV(cx->blk_sub, 0) = (SV*)cx->blk_sub.argarray;       \
            }                                                           \
            else {                                                      \
                CLEAR_ARGARRAY(cx->blk_sub.argarray);                   \
@@ -220,7 +220,7 @@ struct block_loop {
     OP *       last_op;
 #ifdef USE_ITHREADS
     void *     iterdata;
-    SV **      oldcurpad;
+    PAD                oldcurpad;
 #else
     SV **      itervar;
 #endif
@@ -235,11 +235,12 @@ struct block_loop {
 #  define CxITERVAR(c)                                                 \
        ((c)->blk_loop.iterdata                                         \
         ? (CxPADLOOP(cx)                                               \
-           ? &((c)->blk_loop.oldcurpad)[INT2PTR(PADOFFSET, (c)->blk_loop.iterdata)] \
+           ? &CX_CURPAD_SV( (c)->blk_loop,                             \
+                   INT2PTR(PADOFFSET, (c)->blk_loop.iterdata))         \
            : &GvSV((GV*)(c)->blk_loop.iterdata))                       \
         : (SV**)NULL)
 #  define CX_ITERDATA_SET(cx,idata)                                    \
-       cx->blk_loop.oldcurpad = PL_curpad;                             \
+       CX_CURPAD_SAVE(cx->blk_loop);                                   \
        if ((cx->blk_loop.iterdata = (idata)))                          \
            cx->blk_loop.itersave = SvREFCNT_inc(*CxITERVAR(cx));       \
        else                                                            \
diff --git a/cv.h b/cv.h
index ccbfa43..24dbec0 100644 (file)
--- a/cv.h
+++ b/cv.h
@@ -27,7 +27,7 @@ struct xpvcv {
     GV *       xcv_gv;
     char *     xcv_file;
     long       xcv_depth;      /* >= 2 indicates recursive call */
-    AV *       xcv_padlist;
+    PADLIST *  xcv_padlist;
     CV *       xcv_outside;
 #ifdef USE_5005THREADS
     perl_mutex *xcv_mutexp;
@@ -139,61 +139,3 @@ Returns the stash of the CV.
 #define CvCONST_on(cv)         (CvFLAGS(cv) |= CVf_CONST)
 #define CvCONST_off(cv)                (CvFLAGS(cv) &= ~CVf_CONST)
 
-/*
-=head1 Pad Data Structures
-
-=for apidoc m|AV *|CvPADLIST|CV *cv
-CV's can have CvPADLIST(cv) set to point to an AV.
-
-For these purposes "forms" are a kind-of CV, eval""s are too (except they're
-not callable at will and are always thrown away after the eval"" is done
-executing).
-
-XSUBs don't have CvPADLIST set - dXSTARG fetches values from PL_curpad,
-but that is really the callers pad (a slot of which is allocated by
-every entersub).
-
-The CvPADLIST AV has does not have AvREAL set, so REFCNT of component items
-is managed "manual" (mostly in op.c) rather than normal av.c rules.
-The items in the AV are not SVs as for a normal AV, but other AVs:
-
-0'th Entry of the CvPADLIST is an AV which represents the "names" or rather
-the "static type information" for lexicals.
-
-The CvDEPTH'th entry of CvPADLIST AV is an AV which is the stack frame at that
-depth of recursion into the CV.
-The 0'th slot of a frame AV is an AV which is @_.
-other entries are storage for variables and op targets.
-
-During compilation:
-C<PL_comppad_name> is set the the the names AV.
-C<PL_comppad> is set the the frame AV for the frame CvDEPTH == 1.
-C<PL_curpad> is set the body of the frame AV (i.e. AvARRAY(PL_comppad)).
-
-Itterating over the names AV itterates over all possible pad
-items. Pad slots that are SVs_PADTMP (targets/GVs/constants) end up having
-&PL_sv_undef "names" (see pad_alloc()).
-
-Only my/our variable (SVs_PADMY/SVs_PADOUR) slots get valid names.
-The rest are op targets/GVs/constants which are statically allocated
-or resolved at compile time.  These don't have names by which they
-can be looked up from Perl code at run time through eval"" like
-my/our variables can be.  Since they can't be looked up by "name"
-but only by their index allocated at compile time (which is usually
-in PL_op->op_targ), wasting a name SV for them doesn't make sense.
-
-The SVs in the names AV have their PV being the name of the variable.
-NV+1..IV inclusive is a range of cop_seq numbers for which the name is valid.
-For typed lexicals name SV is SVt_PVMG and SvSTASH points at the type.
-
-If SvFAKE is set on the name SV then slot in the frame AVs are
-a REFCNT'ed references to a lexical from "outside".
-
-If the 'name' is '&' the the corresponding entry in frame AV
-is a CV representing a possible closure.
-(SvFAKE and name of '&' is not a meaningful combination currently but could
-become so if C<my sub foo {}> is implemented.)
-
-=cut
-*/
-
diff --git a/dump.c b/dump.c
index 520b210..df73c53 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -1296,26 +1296,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        if (type == SVt_PVFM)
            Perl_dump_indent(aTHX_ level, file, "  LINES = %"IVdf"\n", (IV)FmLINES(sv));
        Perl_dump_indent(aTHX_ level, file, "  PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv)));
-       if (nest < maxnest && CvPADLIST(sv)) {
-           AV* padlist = CvPADLIST(sv);
-           AV* pad_name = (AV*)*av_fetch(padlist, 0, FALSE);
-           AV* pad = (AV*)*av_fetch(padlist, 1, FALSE);
-           SV** pname = AvARRAY(pad_name);
-           SV** ppad = AvARRAY(pad);
-           I32 ix;
-
-           for (ix = 1; ix <= AvFILL(pad_name); ix++) {
-               if (SvPOK(pname[ix]))
-                   Perl_dump_indent(aTHX_ level,
-                               /* %5d below is enough whitespace. */
-                               file,
-                               "%5d. 0x%"UVxf" (%s\"%s\" %"IVdf"-%"IVdf")\n",
-                               (int)ix, PTR2UV(ppad[ix]),
-                               SvFAKE(pname[ix]) ? "FAKE " : "",
-                               SvPVX(pname[ix]),
-                               (IV)SvNVX(pname[ix]),
-                               (IV)SvIVX(pname[ix]));
-           }
+       if (nest < maxnest) {
+           do_dump_pad(level+1, file, CvPADLIST(sv), 0);
        }
        {
            CV *outside = CvOUTSIDE(sv);
index f99be78..f96728c 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -130,7 +130,7 @@ Afnp        |int    |fprintf_nocontext|PerlIO* stream|const char* fmt|...
 Afnp   |int    |printf_nocontext|const char* fmt|...
 #endif
 p      |void   |cv_ckproto     |CV* cv|GV* gv|char* p
-p      |CV*    |cv_clone       |CV* proto
+pd     |CV*    |cv_clone       |CV* proto
 Apd    |SV*    |cv_const_sv    |CV* cv
 p      |SV*    |op_const_sv    |OP* o|CV* cv
 Ap     |void   |cv_undef       |CV* cv
@@ -294,7 +294,7 @@ p   |void   |init_argv_symbols|int|char **
 p      |void   |init_debugger
 Ap     |void   |init_stacks
 Ap     |void   |init_tm        |struct tm *ptm
-p      |U32    |intro_my
+pd     |U32    |intro_my
 Ap     |char*  |instr          |const char* big|const char* little
 p      |bool   |io_close       |IO* io|bool not_implicit
 p      |OP*    |invert         |OP* cmd
@@ -546,16 +546,16 @@ Ap        |char*  |ninstr         |const char* big|const char* bigend \
 p      |OP*    |oopsCV         |OP* o
 Ap     |void   |op_free        |OP* arg
 p      |void   |package        |OP* o
-p      |PADOFFSET|pad_alloc    |I32 optype|U32 tmptype
-p      |PADOFFSET|pad_allocmy  |char* name
-p      |PADOFFSET|pad_findmy   |char* name
+pd     |PADOFFSET|pad_alloc    |I32 optype|U32 tmptype
+p      |PADOFFSET|allocmy      |char* name
+pd     |PADOFFSET|pad_findmy   |char* name
 p      |OP*    |oopsAV         |OP* o
 p      |OP*    |oopsHV         |OP* o
-p      |void   |pad_leavemy    |I32 fill
-Ap     |SV*    |pad_sv         |PADOFFSET po
-p      |void   |pad_free       |PADOFFSET po
-p      |void   |pad_reset
-p      |void   |pad_swipe      |PADOFFSET po
+pd     |void   |pad_leavemy
+Apd    |SV*    |pad_sv         |PADOFFSET po
+pd     |void   |pad_free       |PADOFFSET po
+pd     |void   |pad_reset
+pd     |void   |pad_swipe      |PADOFFSET po|bool refadjust
 p      |void   |peep           |OP* o
 dopM   |PerlIO*|start_glob     |SV* pattern|IO *io
 #if defined(USE_5005THREADS)
@@ -1010,18 +1010,11 @@ s       |OP*    |no_fh_allowed  |OP *o
 s      |OP*    |scalarboolean  |OP *o
 s      |OP*    |too_few_arguments|OP *o|char* name
 s      |OP*    |too_many_arguments|OP *o|char* name
-s      |PADOFFSET|pad_addlex   |SV* name
-s      |PADOFFSET|pad_findlex  |char* name|PADOFFSET newoff|U32 seq \
-                               |CV* startcv|I32 cx_ix|I32 saweval|U32 flags
 s      |OP*    |newDEFSVOP
 s      |OP*    |new_logop      |I32 type|I32 flags|OP **firstp|OP **otherp
 s      |void   |simplify_sort  |OP *o
 s      |bool   |is_handle_constructor  |OP *o|I32 argnum
 s      |char*  |gv_ename       |GV *gv
-#  if defined(DEBUG_CLOSURES)
-s      |void   |cv_dump        |CV *cv
-#  endif
-s      |CV*    |cv_clone2      |CV *proto|CV *outside
 s      |bool   |scalar_mod_type|OP *o|I32 type
 s      |OP *   |my_kid         |OP *o|OP *attrs|OP **imopsp
 s      |OP *   |dup_attrlist   |OP *o
@@ -1355,6 +1348,34 @@ s        |void   |deb_stack_n    |SV** stack_base|I32 stack_min \
                                |I32 stack_max|I32 mark_min|I32 mark_max
 #endif
 
+pd     |PADLIST*|pad_new       |padnew_flags flags
+pd     |void   |pad_undef      |CV* cv|CV* outercv
+pd     |PADOFFSET|pad_add_name |char *name\
+                               |HV* typestash|HV* ourstash \
+                               |bool clone
+pd     |PADOFFSET|pad_add_anon |SV* sv|OPCODE op_type
+pd     |void   |pad_check_dup  |char* name|bool is_our|HV* ourstash
+#ifdef DEBUGGING
+pd     |void   |pad_setsv      |PADOFFSET po|SV* sv
+#endif
+pd     |void   |pad_block_start|int full
+pd     |void   |pad_tidy       |padtidy_type type
+pd     |void   |do_dump_pad    |I32 level|PerlIO *file \
+                               |PADLIST *padlist|int full
+pd     |void   |pad_fixup_inner_anons|PADLIST *padlist|CV *old_cv|CV *new_cv
+
+pd     |void   |pad_push       |PADLIST *padlist|int depth|int has_args
+
+#if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT)
+sd     |PADOFFSET|pad_findlex  |char* name|PADOFFSET newoff|U32 seq \
+                               |CV* startcv|I32 cx_ix|I32 saweval|U32 flags
+#  if defined(DEBUGGING)
+sd     |void   |cv_dump        |CV *cv|char *title
+#  endif
+s      |CV*    |cv_clone2      |CV *proto|CV *outside
+#endif
+
+
 
 END_EXTERN_C
 
diff --git a/embed.h b/embed.h
index f23f370..fe6c4bb 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define op_free                        Perl_op_free
 #define package                        Perl_package
 #define pad_alloc              Perl_pad_alloc
-#define pad_allocmy            Perl_pad_allocmy
+#define allocmy                        Perl_allocmy
 #define pad_findmy             Perl_pad_findmy
 #define oopsAV                 Perl_oopsAV
 #define oopsHV                 Perl_oopsHV
 #define scalarboolean          S_scalarboolean
 #define too_few_arguments      S_too_few_arguments
 #define too_many_arguments     S_too_many_arguments
-#define pad_addlex             S_pad_addlex
-#define pad_findlex            S_pad_findlex
 #define newDEFSVOP             S_newDEFSVOP
 #define new_logop              S_new_logop
 #define simplify_sort          S_simplify_sort
 #define is_handle_constructor  S_is_handle_constructor
 #define gv_ename               S_gv_ename
-#  if defined(DEBUG_CLOSURES)
-#define cv_dump                        S_cv_dump
-#  endif
-#define cv_clone2              S_cv_clone2
 #define scalar_mod_type                S_scalar_mod_type
 #define my_kid                 S_my_kid
 #define dup_attrlist           S_dup_attrlist
 #ifdef PERL_IN_DEB_C
 #define deb_stack_n            S_deb_stack_n
 #endif
+#define pad_new                        Perl_pad_new
+#define pad_undef              Perl_pad_undef
+#define pad_add_name           Perl_pad_add_name
+#define pad_add_anon           Perl_pad_add_anon
+#define pad_check_dup          Perl_pad_check_dup
+#ifdef DEBUGGING
+#define pad_setsv              Perl_pad_setsv
+#endif
+#define pad_block_start                Perl_pad_block_start
+#define pad_tidy               Perl_pad_tidy
+#define do_dump_pad            Perl_do_dump_pad
+#define pad_fixup_inner_anons  Perl_pad_fixup_inner_anons
+#define pad_push               Perl_pad_push
+#if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT)
+#define pad_findlex            S_pad_findlex
+#  if defined(DEBUGGING)
+#define cv_dump                        S_cv_dump
+#  endif
+#define cv_clone2              S_cv_clone2
+#endif
 #define ck_anoncode            Perl_ck_anoncode
 #define ck_bitop               Perl_ck_bitop
 #define ck_concat              Perl_ck_concat
 #define op_free(a)             Perl_op_free(aTHX_ a)
 #define package(a)             Perl_package(aTHX_ a)
 #define pad_alloc(a,b)         Perl_pad_alloc(aTHX_ a,b)
-#define pad_allocmy(a)         Perl_pad_allocmy(aTHX_ a)
+#define allocmy(a)             Perl_allocmy(aTHX_ a)
 #define pad_findmy(a)          Perl_pad_findmy(aTHX_ a)
 #define oopsAV(a)              Perl_oopsAV(aTHX_ a)
 #define oopsHV(a)              Perl_oopsHV(aTHX_ a)
-#define pad_leavemy(a)         Perl_pad_leavemy(aTHX_ a)
+#define pad_leavemy()          Perl_pad_leavemy(aTHX)
 #define pad_sv(a)              Perl_pad_sv(aTHX_ a)
 #define pad_free(a)            Perl_pad_free(aTHX_ a)
 #define pad_reset()            Perl_pad_reset(aTHX)
-#define pad_swipe(a)           Perl_pad_swipe(aTHX_ a)
+#define pad_swipe(a,b)         Perl_pad_swipe(aTHX_ a,b)
 #define peep(a)                        Perl_peep(aTHX_ a)
 #if defined(USE_5005THREADS)
 #define new_struct_thread(a)   Perl_new_struct_thread(aTHX_ a)
 #define scalarboolean(a)       S_scalarboolean(aTHX_ a)
 #define too_few_arguments(a,b) S_too_few_arguments(aTHX_ a,b)
 #define too_many_arguments(a,b)        S_too_many_arguments(aTHX_ a,b)
-#define pad_addlex(a)          S_pad_addlex(aTHX_ a)
-#define pad_findlex(a,b,c,d,e,f,g)     S_pad_findlex(aTHX_ a,b,c,d,e,f,g)
 #define newDEFSVOP()           S_newDEFSVOP(aTHX)
 #define new_logop(a,b,c,d)     S_new_logop(aTHX_ a,b,c,d)
 #define simplify_sort(a)       S_simplify_sort(aTHX_ a)
 #define is_handle_constructor(a,b)     S_is_handle_constructor(aTHX_ a,b)
 #define gv_ename(a)            S_gv_ename(aTHX_ a)
-#  if defined(DEBUG_CLOSURES)
-#define cv_dump(a)             S_cv_dump(aTHX_ a)
-#  endif
-#define cv_clone2(a,b)         S_cv_clone2(aTHX_ a,b)
 #define scalar_mod_type(a,b)   S_scalar_mod_type(aTHX_ a,b)
 #define my_kid(a,b,c)          S_my_kid(aTHX_ a,b,c)
 #define dup_attrlist(a)                S_dup_attrlist(aTHX_ a)
 #ifdef PERL_IN_DEB_C
 #define deb_stack_n(a,b,c,d,e) S_deb_stack_n(aTHX_ a,b,c,d,e)
 #endif
+#define pad_new(a)             Perl_pad_new(aTHX_ a)
+#define pad_undef(a,b)         Perl_pad_undef(aTHX_ a,b)
+#define pad_add_name(a,b,c,d)  Perl_pad_add_name(aTHX_ a,b,c,d)
+#define pad_add_anon(a,b)      Perl_pad_add_anon(aTHX_ a,b)
+#define pad_check_dup(a,b,c)   Perl_pad_check_dup(aTHX_ a,b,c)
+#ifdef DEBUGGING
+#define pad_setsv(a,b)         Perl_pad_setsv(aTHX_ a,b)
+#endif
+#define pad_block_start(a)     Perl_pad_block_start(aTHX_ a)
+#define pad_tidy(a)            Perl_pad_tidy(aTHX_ a)
+#define do_dump_pad(a,b,c,d)   Perl_do_dump_pad(aTHX_ a,b,c,d)
+#define pad_fixup_inner_anons(a,b,c)   Perl_pad_fixup_inner_anons(aTHX_ a,b,c)
+#define pad_push(a,b,c)                Perl_pad_push(aTHX_ a,b,c)
+#if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT)
+#define pad_findlex(a,b,c,d,e,f,g)     S_pad_findlex(aTHX_ a,b,c,d,e,f,g)
+#  if defined(DEBUGGING)
+#define cv_dump(a,b)           S_cv_dump(aTHX_ a,b)
+#  endif
+#define cv_clone2(a,b)         S_cv_clone2(aTHX_ a,b)
+#endif
 #define ck_anoncode(a)         Perl_ck_anoncode(aTHX_ a)
 #define ck_bitop(a)            Perl_ck_bitop(aTHX_ a)
 #define ck_concat(a)           Perl_ck_concat(aTHX_ a)
index dbc4d18..975ff99 100644 (file)
 #define PL_nomemok             (PERL_GET_INTERP->Inomemok)
 #define PL_nthreads            (PERL_GET_INTERP->Inthreads)
 #define PL_nthreads_cond       (PERL_GET_INTERP->Inthreads_cond)
-#define PL_nullstash           (PERL_GET_INTERP->Inullstash)
 #define PL_numeric_compat1     (PERL_GET_INTERP->Inumeric_compat1)
 #define PL_numeric_local       (PERL_GET_INTERP->Inumeric_local)
 #define PL_numeric_name                (PERL_GET_INTERP->Inumeric_name)
 #define PL_nomemok             (vTHX->Inomemok)
 #define PL_nthreads            (vTHX->Inthreads)
 #define PL_nthreads_cond       (vTHX->Inthreads_cond)
-#define PL_nullstash           (vTHX->Inullstash)
 #define PL_numeric_compat1     (vTHX->Inumeric_compat1)
 #define PL_numeric_local       (vTHX->Inumeric_local)
 #define PL_numeric_name                (vTHX->Inumeric_name)
 #define PL_Inomemok            PL_nomemok
 #define PL_Inthreads           PL_nthreads
 #define PL_Inthreads_cond      PL_nthreads_cond
-#define PL_Inullstash          PL_nullstash
 #define PL_Inumeric_compat1    PL_numeric_compat1
 #define PL_Inumeric_local      PL_numeric_local
 #define PL_Inumeric_name       PL_numeric_name
index c9ce77c..38b36ca 100644 (file)
@@ -826,10 +826,10 @@ SVOP_gv(o)
        B::SVOP o
 
 #define PADOP_padix(o) o->op_padix
-#define PADOP_sv(o)    (o->op_padix ? PL_curpad[o->op_padix] : Nullsv)
+#define PADOP_sv(o)    (o->op_padix ? PAD_SVl(o->op_padix) : Nullsv)
 #define PADOP_gv(o)    ((o->op_padix \
-                         && SvTYPE(PL_curpad[o->op_padix]) == SVt_PVGV) \
-                        ? (GV*)PL_curpad[o->op_padix] : Nullgv)
+                         && SvTYPE(PAD_SVl(o->op_padix)) == SVt_PVGV) \
+                        ? (GV*)PAD_SVl(o->op_padix) : Nullgv)
 
 MODULE = B     PACKAGE = B::PADOP              PREFIX = PADOP_
 
index 80732a4..5b5d738 100644 (file)
@@ -222,6 +222,7 @@ do_test(13,
     OWNER = $ADDR
 )?    FLAGS = 0x4
     PADLIST = $ADDR
+    PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
     OUTSIDE = $ADDR \\(MAIN\\)');
 
 do_test(14,
@@ -247,9 +248,10 @@ do_test(14,
     OWNER = $ADDR
 )?    FLAGS = 0x0
     PADLIST = $ADDR
-      \\d+\\. $ADDR \\("\\$pattern" \\d+-\\d+\\)
-     \\d+\\. $ADDR \\(FAKE "\\$DEBUG" 0-\\d+\\)
-     \\d+\\. $ADDR \\("\\$dump" \\d+-\\d+\\)
+    PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
+       \\d+\\. $ADDR<\\d+>      \\(\\d+,\\d+\\) "\\$pattern"
+      \\d+\\. $ADDR<\\d+> FAKE \\(\\d+,\\d+\\) "\\$DEBUG"
+      \\d+\\. $ADDR<\\d+>      \\(\\d+,\\d+\\) "\\$dump"
     OUTSIDE = $ADDR \\(MAIN\\)');
 
 do_test(15,
diff --git a/op.c b/op.c
index 9b2f205..4804bf1 100644 (file)
--- 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;
diff --git a/op.h b/op.h
index 3b1970c..323a487 100644 (file)
--- a/op.h
+++ b/op.h
  *                     which may or may not check number of children).
  */
 
-#if PTRSIZE == 4
-typedef U32TYPE PADOFFSET;
-#else
-#   if PTRSIZE == 8
-typedef U64TYPE PADOFFSET;
-#   endif
-#endif
-#define NOT_IN_PAD ((PADOFFSET) -1)
-
 #ifdef DEBUGGING_OPS
 #define OPCODE opcode
 #else
@@ -387,13 +378,13 @@ struct loop {
 
 
 #ifdef USE_ITHREADS
-#  define      cGVOPx_gv(o)    ((GV*)PL_curpad[cPADOPx(o)->op_padix])
+#  define      cGVOPx_gv(o)    ((GV*)PAD_SVl(cPADOPx(o)->op_padix))
 #  define      IS_PADGV(v)     (v && SvTYPE(v) == SVt_PVGV && GvIN_PAD(v))
 #  define      IS_PADCONST(v)  (v && SvREADONLY(v))
 #  define      cSVOPx_sv(v)    (cSVOPx(v)->op_sv \
-                                ? cSVOPx(v)->op_sv : PL_curpad[(v)->op_targ])
+                                ? cSVOPx(v)->op_sv : PAD_SVl((v)->op_targ))
 #  define      cSVOPx_svp(v)   (cSVOPx(v)->op_sv \
-                                ? &cSVOPx(v)->op_sv : &PL_curpad[(v)->op_targ])
+                                ? &cSVOPx(v)->op_sv : &PAD_SVl((v)->op_targ))
 #else
 #  define      cGVOPx_gv(o)    ((GV*)cSVOPx(o)->op_sv)
 #  define      IS_PADGV(v)     FALSE
diff --git a/pad.c b/pad.c
new file mode 100644 (file)
index 0000000..96da712
--- /dev/null
+++ b/pad.c
@@ -0,0 +1,1518 @@
+/*    pad.c
+ *
+ *    Copyright (c) 2002, Larry Wall
+ *
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
+ *
+ *  "Anyway: there was this Mr Frodo left an orphan and stranded, as you
+ *  might say, among those queer Bucklanders, being brought up anyhow in
+ *  Brandy Hall. A regular warren, by all accounts. Old Master Gorbadoc
+ *  never had fewer than a couple of hundred relations in the place. Mr
+ *  Bilbo never did a kinder deed than when he brought the lad back to
+ *  live among decent folk." --the Gaffer
+ */
+
+/* XXX DAPM
+ * As of Sept 2002, this file is new and may be in a state of flux for
+ * a while. I've marked things I intent to come back and look at further
+ * with an 'XXX DAPM' comment.
+ */
+
+/*
+=head1 Pad Data Structures
+
+=for apidoc m|AV *|CvPADLIST|CV *cv
+CV's can have CvPADLIST(cv) set to point to an AV.
+
+For these purposes "forms" are a kind-of CV, eval""s are too (except they're
+not callable at will and are always thrown away after the eval"" is done
+executing).
+
+XSUBs don't have CvPADLIST set - dXSTARG fetches values from PL_curpad,
+but that is really the callers pad (a slot of which is allocated by
+every entersub).
+
+The CvPADLIST AV has does not have AvREAL set, so REFCNT of component items
+is managed "manual" (mostly in op.c) rather than normal av.c rules.
+The items in the AV are not SVs as for a normal AV, but other AVs:
+
+0'th Entry of the CvPADLIST is an AV which represents the "names" or rather
+the "static type information" for lexicals.
+
+The CvDEPTH'th entry of CvPADLIST AV is an AV which is the stack frame at that
+depth of recursion into the CV.
+The 0'th slot of a frame AV is an AV which is @_.
+other entries are storage for variables and op targets.
+
+During compilation:
+C<PL_comppad_name> is set the the the names AV.
+C<PL_comppad> is set the the frame AV for the frame CvDEPTH == 1.
+C<PL_curpad> is set the body of the frame AV (i.e. AvARRAY(PL_comppad)).
+
+Itterating over the names AV itterates over all possible pad
+items. Pad slots that are SVs_PADTMP (targets/GVs/constants) end up having
+&PL_sv_undef "names" (see pad_alloc()).
+
+Only my/our variable (SVs_PADMY/SVs_PADOUR) slots get valid names.
+The rest are op targets/GVs/constants which are statically allocated
+or resolved at compile time.  These don't have names by which they
+can be looked up from Perl code at run time through eval"" like
+my/our variables can be.  Since they can't be looked up by "name"
+but only by their index allocated at compile time (which is usually
+in PL_op->op_targ), wasting a name SV for them doesn't make sense.
+
+The SVs in the names AV have their PV being the name of the variable.
+NV+1..IV inclusive is a range of cop_seq numbers for which the name is
+valid.  For typed lexicals name SV is SVt_PVMG and SvSTASH points at the
+type.  For C<our> lexicals, the type is SVt_PVGV, and GvSTASH points at the
+stash of the associated global (so that duplicate C<our> delarations in the
+same package can be detected).  SvCUR is sometimes hijacked to
+store the generation number during compilation.
+
+If SvFAKE is set on the name SV then slot in the frame AVs are
+a REFCNT'ed references to a lexical from "outside".
+
+If the 'name' is '&' the the corresponding entry in frame AV
+is a CV representing a possible closure.
+(SvFAKE and name of '&' is not a meaningful combination currently but could
+become so if C<my sub foo {}> is implemented.)
+
+=cut
+*/
+
+
+#include "EXTERN.h"
+#define PERL_IN_PAD_C
+#include "perl.h"
+
+
+#define PAD_MAX 999999999
+
+
+
+/*
+=for apidoc pad_new
+
+Create a new compiling padlist, saving and updating the various global
+vars at the same time as creating the pad itself. The following flags
+can be OR'ed together:
+
+    padnew_CLONE       this pad is for a cloned CV
+    padnew_SAVE                save old globals
+    padnew_SAVESUB     also save extra stuff for start of sub
+
+=cut
+*/
+
+PADLIST *
+Perl_pad_new(pTHX_ padnew_flags flags)
+{
+    AV *padlist, *padname, *pad, *a0;
+
+    /* XXX DAPM really need a new SAVEt_PAD which restores all or most
+     * vars (based on flags) rather than storing vals + addresses for
+     * each individually. Also see pad_block_start.
+     * XXX DAPM Try to see whether all these conditionals are required
+     */
+
+    /* save existing state, ... */
+
+    if (flags & padnew_SAVE) {
+       SAVEVPTR(PL_curpad);
+       SAVESPTR(PL_comppad);
+       SAVESPTR(PL_comppad_name);
+       if (! (flags & padnew_CLONE)) {
+           SAVEI32(PL_padix);
+           SAVEI32(PL_comppad_name_fill);
+           SAVEI32(PL_min_intro_pending);
+           SAVEI32(PL_max_intro_pending);
+           if (flags & padnew_SAVESUB) {
+               SAVEI32(PL_pad_reset_pending);
+           }
+       }
+    }
+    /* XXX DAPM interestingly, PL_comppad_name_floor never seems to be
+     * saved - check at some pt that this is okay */
+
+    /* ... create new pad ... */
+
+    padlist    = newAV();
+    padname    = newAV();
+    pad                = newAV();
+
+    if (flags & padnew_CLONE) {
+       /* XXX DAPM  I dont know why cv_clone needs it
+        * doing differently yet - perhaps this separate branch can be
+        * dispensed with eventually ???
+        */
+
+       a0 = newAV();                   /* will be @_ */
+       av_extend(a0, 0);
+       av_store(pad, 0, (SV*)a0);
+       AvFLAGS(a0) = AVf_REIFY;
+    }
+    else {
+#ifdef USE_5005THREADS
+       av_store(padname, 0, newSVpvn("@_", 2));
+       a0 = newAV();
+       SvPADMY_on((SV*)a0);            /* XXX Needed? */
+       av_store(pad, 0, (SV*)a0);
+#else
+       av_store(pad, 0, Nullsv);
+#endif /* USE_THREADS */
+    }
+
+    AvREAL_off(padlist);
+    av_store(padlist, 0, (SV*)padname);
+    av_store(padlist, 1, (SV*)pad);
+
+    /* ... then update state variables */
+
+    PL_comppad_name    = (AV*)(*av_fetch(padlist, 0, FALSE));
+    PL_comppad         = (AV*)(*av_fetch(padlist, 1, FALSE));
+    PL_curpad          = AvARRAY(PL_comppad);
+
+    if (! (flags & padnew_CLONE)) {
+       PL_comppad_name_fill = 0;
+       PL_min_intro_pending = 0;
+       PL_padix             = 0;
+    }
+
+    DEBUG_X(PerlIO_printf(Perl_debug_log,
+         "Pad 0x%"UVxf"[0x%"UVxf"] new:       padlist=0x%"UVxf
+             " name=0x%"UVxf" flags=0x%"UVxf"\n",
+         PTR2UV(PL_comppad), PTR2UV(PL_curpad), PTR2UV(padlist),
+             PTR2UV(padname), (UV)flags
+       )
+    );
+
+    return (PADLIST*)padlist;
+}
+
+/*
+=for apidoc pad_undef
+
+Free the padlist associated with a CV.
+If parts of it happen to be current, we null the relevant
+PL_*pad* global vars so that we don't have any dangling references left.
+We also repoint the CvOUTSIDE of any about-to-be-orphaned
+inner subs to outercv.
+
+=cut
+*/
+
+void
+Perl_pad_undef(pTHX_ CV* cv, CV* outercv)
+{
+    I32 ix;
+    PADLIST *padlist = CvPADLIST(cv);
+
+    if (!padlist)
+       return;
+    if (!SvREFCNT(CvPADLIST(cv))) /* may be during global destruction */
+       return;
+
+    DEBUG_X(PerlIO_printf(Perl_debug_log,
+         "Pad undef: padlist=0x%"UVxf"\n" , PTR2UV(padlist))
+    );
+
+    /* pads may be cleared out already during global destruction */
+    if ((CvEVAL(cv) && !CvGV(cv) /* is this eval"" ? */
+           && !PL_dirty) || CvSPECIAL(cv))
+    {
+       /* XXX DAPM the following code is very similar to
+        * pad_fixup_inner_anons(). Merge??? */
+
+       /* inner references to eval's cv must be fixed up */
+       AV *comppad_name = (AV*)AvARRAY(padlist)[0];
+       SV **namepad = AvARRAY(comppad_name);
+       AV *comppad = (AV*)AvARRAY(padlist)[1];
+       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) = outercv;
+                   if (!CvANON(innercv) || CvCLONED(innercv)) {
+                       (void)SvREFCNT_inc(outercv);
+                       if (SvREFCNT(cv))
+                           SvREFCNT_dec(cv);
+                   }
+               }
+           }
+       }
+    }
+    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) = Null(PADLIST*);
+}
+
+
+
+
+/*
+=for apidoc pad_add_name
+
+Create a new name in the current pad at the specified offset.
+If C<typestash> is valid, the name is for a typed lexical; set the
+name's stash to that value.
+If C<ourstash> is valid, it's an our lexical, set the name's
+GvSTASH to that value
+
+Also, if the name is @.. or %.., create a new array or hash for that slot
+
+If fake, it means we're cloning an existing entry
+
+=cut
+*/
+
+/*
+ * XXX DAPM this doesn't seem the right place to create a new array/hash.
+ * Whatever we do, we should be consistent - create scalars too, and
+ * create even if fake. Really need to integrate better the whole entry
+ * creation business - when + where does the name and value get created?
+ */
+
+PADOFFSET
+Perl_pad_add_name(pTHX_ char *name, HV* typestash, HV* ourstash, bool fake)
+{
+    PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
+    SV* namesv = NEWSV(1102, 0);
+    U32 min, max;
+
+    if (fake) {
+       min = PL_curcop->cop_seq;
+       max = PAD_MAX;
+    }
+    else {
+       /* not yet introduced */
+       min = PAD_MAX;
+       max = 0;
+    }
+
+    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+         "Pad addname: %ld \"%s\", (%lu,%lu)%s\n",
+          (long)offset, name, (unsigned long)min, (unsigned long)max,
+         (fake ? " FAKE" : "")
+         )
+    );
+
+    sv_upgrade(namesv, ourstash ? SVt_PVGV : typestash ? SVt_PVMG : SVt_PVNV);
+    sv_setpv(namesv, name);
+
+    if (typestash) {
+       SvFLAGS(namesv) |= SVpad_TYPED;
+       SvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*) typestash);
+    }
+    if (ourstash) {
+       SvFLAGS(namesv) |= SVpad_OUR;
+       GvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*) ourstash);
+    }
+
+    av_store(PL_comppad_name, offset, namesv);
+    SvNVX(namesv) = (NV)min;
+    SvIVX(namesv) = max;
+    if (fake)
+       SvFAKE_on(namesv);
+    else {
+       if (!PL_min_intro_pending)
+           PL_min_intro_pending = offset;
+       PL_max_intro_pending = offset;
+       if (*name == '@')
+           av_store(PL_comppad, offset, (SV*)newAV());
+       else if (*name == '%')
+           av_store(PL_comppad, offset, (SV*)newHV());
+       SvPADMY_on(PL_curpad[offset]);
+    }
+
+    return offset;
+}
+
+
+
+
+/*
+=for apidoc pad_alloc
+
+Allocate a new my or tmp pad entry. For a my, simply push a null SV onto
+the end of PL_comppad, but for a tmp, scan the pad from PL_padix upwards
+for a slot which has no name and and no active value.
+
+=cut
+*/
+
+/* XXX DAPM integrate alloc(), add_name() and add_anon(),
+ * or at least rationalise ??? */
+
+
+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.
+            */
+           /* HVDS why copy to sv here? we don't seem to use it */
+           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);
+
+    DEBUG_X(PerlIO_printf(Perl_debug_log,
+         "Pad 0x%"UVxf"[0x%"UVxf"] alloc:   %ld for %s\n",
+         PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long) retval,
+         PL_op_name[optype]));
+    return (PADOFFSET)retval;
+}
+
+/*
+=for apidoc pad_add_anon
+
+Add an anon code entry to the current compiling pad
+
+=cut
+*/
+
+PADOFFSET
+Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
+{
+    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(op_type, SVs_PADMY);
+    av_store(PL_comppad_name, ix, name);
+    av_store(PL_comppad, ix, sv);
+    SvPADMY_on(sv);
+    return ix;
+}
+
+
+
+/*
+=for apidoc pad_check_dup
+
+Check for duplicate declarations: report any of:
+     * a my in the current scope with the same name;
+     * an our (anywhere in the pad) with the same name and the same stash
+       as C<ourstash>
+C<is_our> indicates that the name to check is an 'our' declaration
+
+=cut
+*/
+
+/* XXX DAPM integrate this into pad_add_name ??? */
+
+void
+Perl_pad_check_dup(pTHX_ char *name, bool is_our, HV *ourstash)
+{
+    SV         **svp, *sv;
+    PADOFFSET  top, off;
+
+    if (!ckWARN(WARN_MISC) || AvFILLp(PL_comppad_name) < 0)
+       return; /* nothing to check */
+
+    svp = AvARRAY(PL_comppad_name);
+    top = AvFILLp(PL_comppad_name);
+    /* check the current scope */
+    /* XXX DAPM - why the (I32) cast - shouldn't we ensure they're the same
+     * type ? */
+    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)
+           && (!is_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",
+               (is_our ? "our" : "my"),
+               name,
+               (SvIVX(sv) == PAD_MAX ? "scope" : "statement"));
+           --off;
+           break;
+       }
+    }
+    /* check the rest of the pad */
+    if (is_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 );
+    }
+}
+
+
+
+/*
+=for apidoc pad_findmy
+
+Given a lexical name, try to find its offset, first in the current pad,
+or failing that, in the pads of any lexically enclosing subs (including
+the complications introduced by eval). If the name is found in an outer pad,
+then a fake entry is added to the current pad.
+Returns the offset in the current pad, or NOT_IN_PAD on failure.
+
+=cut
+*/
+
+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;
+
+    DEBUG_Xv(PerlIO_printf(Perl_debug_log, "Pad findmy:  \"%s\"\n", name));
+
+#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)                  /* pad_findlex returns 0 for failure...*/
+       return NOT_IN_PAD;      /* ...but we return NOT_IN_PAD for failure */
+
+    /* If there is a pending local definition, this new alias must die */
+    if (pendoff)
+       SvIVX(AvARRAY(PL_comppad_name)[off]) = seq;
+    return off;
+}
+
+
+
+/*
+=for apidoc pad_findlex
+
+Find a named lexical anywhere in a chain of nested pads. Add fake entries
+in the inner pads if its found in an outer one.
+
+If flags == FINDLEX_NOSEARCH we don't bother searching outer contexts.
+
+=cut
+*/
+
+#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;
+
+    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+       "Pad findlex: \"%s\" off=%ld seq=%lu cv=0x%"UVxf
+           " ix=%ld saweval=%d flags=%lu\n",
+           name, (long)newoff, (unsigned long)seq, PTR2UV(startcv),
+           (long)cx_ix, (int)saweval, (unsigned long)flags
+       )
+    );
+
+    for (cv = startcv; cv; cv = CvOUTSIDE(cv)) {
+       AV *curlist = CvPADLIST(cv);
+       SV **svp = av_fetch(curlist, 0, FALSE);
+       AV *curname;
+
+       DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+           "             searching: cv=0x%"UVxf"\n", PTR2UV(cv))
+       );
+
+       if (!svp || *svp == &PL_sv_undef)
+           continue;
+       curname = (AV*)*svp;
+       svp = AvARRAY(curname);
+       for (off = AvFILLp(curname); off > 0; off--) {
+           I32 depth;
+           AV *oldpad;
+           SV *oldsv;
+
+           if ( ! (
+                   (sv = svp[off]) &&
+                   sv != &PL_sv_undef &&
+                   seq <= (U32)SvIVX(sv) &&
+                   seq > (U32)I_32(SvNVX(sv)) &&
+                   strEQ(SvPVX(sv), name))
+           )
+               continue;
+
+           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);
+
+           DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+                       "             matched:   offset %ld"
+                           " %s(%lu,%lu), sv=0x%"UVxf"\n",
+                       (long)off,
+                       SvFAKE(sv) ? "FAKE " : "",
+                       (unsigned long)I_32(SvNVX(sv)),
+                       (unsigned long)SvIVX(sv),
+                       PTR2UV(oldsv)
+                   )
+           );
+
+           if (!newoff) {              /* Not a mere clone operation. */
+               newoff = pad_add_name(
+                   SvPVX(sv),
+                   (SvFLAGS(sv) & SVpad_TYPED) ? SvSTASH(sv) : Nullhv,
+                   (SvFLAGS(sv) & SVpad_OUR)   ? GvSTASH(sv) : Nullhv,
+                   1  /* fake */
+               );
+
+               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. */
+                               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_add_name(
+                                   SvPVX(sv),
+                                   (SvFLAGS(sv) & SVpad_TYPED)
+                                       ? SvSTASH(sv) : Nullhv,
+                                   (SvFLAGS(sv) & SVpad_OUR)
+                                       ? GvSTASH(sv) : Nullhv,
+                                   1  /* fake */
+                               );
+
+                               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));
+           DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+                       "Pad findlex: set offset %ld to sv 0x%"UVxf"\n",
+                       (long)newoff, PTR2UV(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.
+     */
+
+    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);
+       }
+    }
+
+    return 0;
+}
+
+
+/*
+=for apidoc pad_sv
+
+Get the value at offset po in the current pad.
+Use macro PAD_SV instead of calling this function directly.
+
+=cut
+*/
+
+
+SV *
+Perl_pad_sv(pTHX_ PADOFFSET po)
+{
+#ifdef DEBUGGING
+    /* for display purposes, try to guess the AV corresponding to
+     * Pl_curpad */
+    AV *cp = PL_comppad;
+    if (cp && AvARRAY(cp) != PL_curpad)
+       cp = Nullav;
+#endif
+
+#ifndef USE_5005THREADS
+    if (!po)
+       Perl_croak(aTHX_ "panic: pad_sv po");
+#endif
+    DEBUG_X(PerlIO_printf(Perl_debug_log,
+       "Pad 0x%"UVxf"[0x%"UVxf"] sv:      %ld sv=0x%"UVxf"\n",
+       PTR2UV(cp), PTR2UV(PL_curpad), (long)po, PTR2UV(PL_curpad[po]))
+    );
+    return PL_curpad[po];
+}
+
+
+/*
+=for apidoc pad_setsv
+
+Set the entry at offset po in the current pad to sv.
+Use the macro PAD_SETSV() rather than calling this function directly.
+
+=cut
+*/
+
+#ifdef DEBUGGING
+void
+Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
+{
+    /* for display purposes, try to guess the AV corresponding to
+     * Pl_curpad */
+    AV *cp = PL_comppad;
+    if (cp && AvARRAY(cp) != PL_curpad)
+       cp = Nullav;
+
+    DEBUG_X(PerlIO_printf(Perl_debug_log,
+       "Pad 0x%"UVxf"[0x%"UVxf"] setsv:   %ld sv=0x%"UVxf"\n",
+       PTR2UV(cp), PTR2UV(PL_curpad), (long)po, PTR2UV(sv))
+    );
+    PL_curpad[po] = sv;
+}
+#endif
+
+
+
+/*
+=for apidoc pad_block_start
+
+Update the pad compilation state variables on entry to a new block
+
+=cut
+*/
+
+/* XXX DAPM perhaps:
+ *     - integrate this in general state-saving routine ???
+ *     - combine with the state-saving going on in pad_new ???
+ *     - introduce a new SAVE type that does all this in one go ?
+ */
+
+void
+Perl_pad_block_start(pTHX_ int full)
+{
+    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;
+}
+
+
+/*
+=for apidoc intro_my
+
+"Introduce" my variables to visible status.
+
+=cut
+*/
+
+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;
+           DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+               "Pad intromy: %ld \"%s\", (%lu,%lu)\n",
+               (long)i, SvPVX(sv),
+               (unsigned long)I_32(SvNVX(sv)), (unsigned long)SvIVX(sv))
+           );
+       }
+    }
+    PL_min_intro_pending = 0;
+    PL_comppad_name_fill = PL_max_intro_pending; /* Needn't search higher */
+    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+               "Pad intromy: seq -> %ld\n", (long)(PL_cop_seqmax+1)));
+
+    return PL_cop_seqmax++;
+}
+
+/*
+=for apidoc pad_leavemy
+
+Cleanup at end of scope during compilation: set the max seq number for
+lexicals in this scope and warn of any lexicals that never got introduced.
+
+=cut
+*/
+
+void
+Perl_pad_leavemy(pTHX)
+{
+    I32 off;
+    SV **svp = AvARRAY(PL_comppad_name);
+    SV *sv;
+
+    PL_pad_reset_pending = FALSE;
+
+    if (PL_min_intro_pending && PL_comppad_name_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 > PL_comppad_name_fill; off--) {
+       if ((sv = svp[off]) && sv != &PL_sv_undef && SvIVX(sv) == PAD_MAX) {
+           SvIVX(sv) = PL_cop_seqmax;
+           DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+               "Pad leavemy: %ld \"%s\", (%lu,%lu)\n",
+               (long)off, SvPVX(sv),
+               (unsigned long)I_32(SvNVX(sv)), (unsigned long)SvIVX(sv))
+           );
+       }
+    }
+    PL_cop_seqmax++;
+    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+           "Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax));
+}
+
+
+/*
+=for apidoc pad_swipe
+
+Abandon the tmp in the current pad at offset po and replace with a
+new one.
+
+=cut
+*/
+
+void
+Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
+{
+    if (!PL_curpad)
+       return;
+    if (AvARRAY(PL_comppad) != PL_curpad)
+       Perl_croak(aTHX_ "panic: pad_swipe curpad");
+    if (!po)
+       Perl_croak(aTHX_ "panic: pad_swipe po");
+
+    DEBUG_X(PerlIO_printf(Perl_debug_log,
+               "Pad 0x%"UVxf"[0x%"UVxf"] swipe:   %ld\n",
+               PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po));
+
+    if (PL_curpad[po])
+       SvPADTMP_off(PL_curpad[po]);
+    if (refadjust)
+       SvREFCNT_dec(PL_curpad[po]);
+
+    PL_curpad[po] = NEWSV(1107,0);
+    SvPADTMP_on(PL_curpad[po]);
+    if ((I32)po < PL_padix)
+       PL_padix = po - 1;
+}
+
+
+/*
+=for apidoc pad_reset
+
+Mark all the current temporaries for reuse
+
+=cut
+*/
+
+/* 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");
+
+    DEBUG_X(PerlIO_printf(Perl_debug_log,
+           "Pad 0x%"UVxf"[0x%"UVxf"] reset:     padix %ld -> %ld",
+           PTR2UV(PL_comppad), PTR2UV(PL_curpad),
+               (long)PL_padix, (long)PL_padix_floor
+           )
+    );
+
+    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;
+}
+
+
+/*
+=for apidoc pad_tidy
+
+Tidy up a pad after we've finished compiling it:
+    * remove most stuff from the pads of anonsub prototypes;
+    * give it a @_;
+    * mark tmps as such.
+
+=cut
+*/
+
+/* XXX DAPM surely most of this stuff should be done properly
+ * at the right time beforehand, rather than going around afterwards
+ * cleaning up our mistakes ???
+ */
+
+void
+Perl_pad_tidy(pTHX_ padtidy_type type)
+{
+    PADOFFSET ix;
+
+    /* extend curpad to match namepad */
+    if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
+       av_store(PL_comppad_name, AvFILLp(PL_comppad), Nullsv);
+
+    if (type == padtidy_SUBCLONE) {
+       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;
+           }
+       }
+    }
+    else if (type == padtidy_SUB) {
+       /* XXX DAPM this same bit of code keeps appearing !!! Rationalise? */
+       AV *av = newAV();                       /* Will be @_ */
+       av_extend(av, 0);
+       av_store(PL_comppad, 0, (SV*)av);
+       AvFLAGS(av) = AVf_REIFY;
+    }
+
+    /* XXX DAPM rationalise these two similar branches */
+
+    if (type == padtidy_SUB) {
+       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]);
+       }
+    }
+    else if (type == padtidy_FORMAT) {
+       for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
+           if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix]))
+               SvPADTMP_on(PL_curpad[ix]);
+       }
+    }
+}
+
+
+/*
+=for apidoc pad_free
+
+Free the SV at offet po in the current pad.
+
+=cut
+*/
+
+/* XXX DAPM integrate with pad_swipe ???? */
+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");
+
+    DEBUG_X(PerlIO_printf(Perl_debug_log,
+           "Pad 0x%"UVxf"[0x%"UVxf"] free:    %ld\n",
+           PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po)
+    );
+
+    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;
+}
+
+
+
+/*
+=for apidoc do_dump_pad
+
+Dump the contents of a padlist
+
+=cut
+*/
+
+void
+Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
+{
+    AV *pad_name;
+    AV *pad;
+    SV **pname;
+    SV **ppad;
+    SV *namesv;
+    I32 ix;
+
+    if (!padlist) {
+       return;
+    }
+    pad_name = (AV*)*av_fetch((AV*)padlist, 0, FALSE);
+    pad = (AV*)*av_fetch((AV*)padlist, 1, FALSE);
+    pname = AvARRAY(pad_name);
+    ppad = AvARRAY(pad);
+    Perl_dump_indent(aTHX_ level, file,
+           "PADNAME = 0x%"UVxf"(0x%"UVxf") PAD = 0x%"UVxf"(0x%"UVxf")\n",
+           PTR2UV(pad_name), PTR2UV(pname), PTR2UV(pad), PTR2UV(ppad)
+    );
+
+    for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
+       namesv = pname[ix];
+       if (namesv && namesv == &PL_sv_undef) {
+           namesv = Nullsv;
+       }
+       if (namesv) {
+           Perl_dump_indent(aTHX_ level+1, file,
+               "%2d. 0x%"UVxf"<%lu> %s (%lu,%lu) \"%s\"\n",
+               (int) ix,
+               PTR2UV(ppad[ix]),
+               (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
+               SvFAKE(namesv) ? "FAKE" : "    ",
+               (unsigned long)I_32(SvNVX(namesv)),
+               (unsigned long)SvIVX(namesv),
+               SvPVX(namesv)
+           );
+       }
+       else if (full) {
+           Perl_dump_indent(aTHX_ level+1, file,
+               "%2d. 0x%"UVxf"<%lu>\n",
+               (int) ix,
+               PTR2UV(ppad[ix]),
+               (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0)
+           );
+       }
+    }
+}
+
+
+
+/*
+=for apidoc cv_dump
+
+dump the contents of a CV
+
+=cut
+*/
+
+#ifdef DEBUGGING
+STATIC void
+S_cv_dump(pTHX_ CV *cv, char *title)
+{
+    CV *outside = CvOUTSIDE(cv);
+    AV* padlist = CvPADLIST(cv);
+
+    PerlIO_printf(Perl_debug_log,
+                 "  %s: CV=0x%"UVxf" (%s), OUTSIDE=0x%"UVxf" (%s)\n",
+                 title,
+                 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"));
+
+    PerlIO_printf(Perl_debug_log,
+                   "    PADLIST = 0x%"UVxf"\n", PTR2UV(padlist));
+    do_dump_pad(1, Perl_debug_log, padlist, 1);
+}
+#endif /* DEBUGGING */
+
+
+
+
+
+/*
+=for apidoc cv_clone
+
+Clone a CV: make a new CV which points to the same code etc, but which
+has a newly-created pad built by copying the prototype pad and capturing
+any outer lexicals.
+
+=cut
+*/
+
+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;
+}
+
+
+/* XXX DAPM separate out cv and paddish bits ???
+ * ideally the CV-related stuff shouldn't be in pad.c - how about
+ * a cv.c? */
+
+STATIC CV *
+S_cv_clone2(pTHX_ CV *proto, CV *outside)
+{
+    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;
+    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));
+
+    CvPADLIST(cv) = comppadlist = pad_new(padnew_CLONE|padnew_SAVE);
+
+    for (ix = fname; ix >= 0; ix--)
+       av_store(PL_comppad_name, ix, SvREFCNT_inc(pname[ix]));
+
+    av_fill(PL_comppad, fpad);
+    PL_curpad = AvARRAY(PL_comppad);
+
+    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;
+       }
+    }
+
+    DEBUG_Xv(
+       PerlIO_printf(Perl_debug_log, "\nPad CV clone\n");
+       cv_dump(outside, "Outside");
+       cv_dump(proto,   "Proto");
+       cv_dump(cv,      "To");
+    );
+
+    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;
+}
+
+
+/*
+=for apidoc pad_fixup_inner_anons
+
+For any anon CVs in the pad, change CvOUTSIDE of that CV from
+old_cv to new_cv if necessary.
+
+=cut
+*/
+
+void
+Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
+{
+    I32 ix;
+    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) == old_cv) {
+               CvOUTSIDE(innercv) = new_cv;
+               if (!CvANON(innercv) || CvCLONED(innercv)) {
+                   (void)SvREFCNT_inc(new_cv);
+                   SvREFCNT_dec(old_cv);
+               }
+           }
+       }
+    }
+}
+
+/*
+=for apidoc pad_push
+
+Push a new pad frame onto the padlist, unless there's already a pad at
+this depth, in which case don't bother creating a new one.
+If has_args is true, give the new pad an @_ in slot zero.
+
+=cut
+*/
+
+void
+Perl_pad_push(pTHX_ PADLIST *padlist, int depth, int has_args)
+{
+    if (depth <= AvFILLp(padlist))
+       return;
+
+    {
+       SV** svp = AvARRAY(padlist);
+       AV *newpad = newAV();
+       SV **oldpad = AvARRAY(svp[depth-1]);
+       I32 ix = AvFILLp((AV*)svp[1]);
+       I32 names_fill = AvFILLp((AV*)svp[0]);
+       SV** names = AvARRAY(svp[0]);
+       SV* sv;
+       for ( ;ix > 0; ix--) {
+           if (names_fill >= ix && names[ix] != &PL_sv_undef) {
+               char *name = SvPVX(names[ix]);
+               if ((SvFLAGS(names[ix]) & SVf_FAKE) || *name == '&') {
+                   /* outer lexical or anon code */
+                   av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]));
+               }
+               else {          /* our own lexical */
+                   if (*name == '@')
+                       av_store(newpad, ix, sv = (SV*)newAV());
+                   else if (*name == '%')
+                       av_store(newpad, ix, sv = (SV*)newHV());
+                   else
+                       av_store(newpad, ix, sv = NEWSV(0, 0));
+                   SvPADMY_on(sv);
+               }
+           }
+           else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
+               av_store(newpad, ix, sv = SvREFCNT_inc(oldpad[ix]));
+           }
+           else {
+               /* save temporaries on recursion? */
+               av_store(newpad, ix, sv = NEWSV(0, 0));
+               SvPADTMP_on(sv);
+           }
+       }
+       if (has_args) {
+           AV* av = newAV();
+           av_extend(av, 0);
+           av_store(newpad, 0, (SV*)av);
+           AvFLAGS(av) = AVf_REIFY;
+       }
+       av_store(padlist, depth, (SV*)newpad);
+       AvFILLp(padlist) = depth;
+    }
+}
diff --git a/pad.h b/pad.h
new file mode 100644 (file)
index 0000000..abefde5
--- /dev/null
+++ b/pad.h
@@ -0,0 +1,214 @@
+/*    pad.h
+ *
+ *    Copyright (c) 2002, Larry Wall
+ *
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
+ *
+ * This file defines the types and macros associated with the API for
+ * manipulating scratchpads, which are used by perl to store lexical
+ * variables, op targets and constants.
+ */
+
+
+
+
+/* a padlist is currently just an AV; but that might change,
+ * so hide the type. Ditto a pad.  */
+
+typedef AV PADLIST;
+typedef SV** PAD;
+
+
+/* offsets within a pad */
+
+#if PTRSIZE == 4
+typedef U32TYPE PADOFFSET;
+#else
+#   if PTRSIZE == 8
+typedef U64TYPE PADOFFSET;
+#   endif
+#endif
+#define NOT_IN_PAD ((PADOFFSET) -1)
+
+/* flags for the pad_new() function */
+
+typedef enum {
+       padnew_CLONE    = 1,    /* this pad is for a cloned CV */
+       padnew_SAVE     = 2,    /* save old globals */
+       padnew_SAVESUB  = 4,    /* also save extra stuff for start of sub */
+} padnew_flags;
+
+/* values for the pad_tidy() function */
+
+typedef enum {
+       padtidy_SUB,            /* tidy up a pad for a sub, */
+       padtidy_SUBCLONE,       /* a cloned sub, */
+       padtidy_FORMAT          /* or a format */
+} padtidy_type;
+
+
+/* Note: the following four macros are actually defined in scope.h, but
+ * they are documented here for completeness, since they directly or
+ * indirectly affect pads.
+
+=for apidoc m|void|SAVEPADSV   |PADOFFSET po
+Save a pad slot (used to restore after an iteration)
+
+=for apidoc m|void|SAVECLEARSV |SV **svp
+Clear the pointed to pad value on scope exit. (ie the runtime action of 'my')
+
+=for apidoc m|void|SAVECOMPPAD
+save PL_comppad and PL_curpad
+
+=for apidoc m|void|SAVEFREEOP  |OP *o
+Free the op on scope exit. At the same time, reset PL_curpad
+
+
+
+
+=for apidoc m|SV *|PAD_SETSV   |PADOFFSET po|SV* sv
+Set the slot at offset C<po> in the current pad to C<sv>
+
+=for apidoc m|void|PAD_SV      |PADOFFSET po
+Get the value at offset C<po> in the current pad
+
+=for apidoc m|SV *|PAD_SVl     |PADOFFSET po
+Lightweight and lvalue version of C<PAD_SV>.
+Get or set the value at offset C<po> in the current pad.
+Unlike C<PAD_SV>, does not print diagnostics with -DX.
+For internal use only.
+
+=for apidoc m|SV *|PAD_BASE_SV |PADLIST padlist|PADOFFSET po
+Get the value from slot C<po> in the base (DEPTH=1) pad of a padlist
+
+=for apidoc m|void|PAD_SET_CUR |PADLIST padlist|I32 n
+Set the current pad to be pad C<n> in the padlist, saving
+the previous current pad.
+
+=for apidoc m|void|PAD_SAVE_SETNULLPAD
+Save the current pad then set it to null.
+
+=for apidoc m|void|PAD_UPDATE_CURPAD
+Set PL_curpad from the value of PL_comppad.
+
+=cut
+*/
+
+#ifdef DEBUGGING
+#  define PAD_SV(po)      pad_sv(po)
+#  define PAD_SETSV(po,sv) pad_setsv(po,sv)
+#else
+#  define PAD_SV(po)       (PL_curpad[po])
+#  define PAD_SETSV(po,sv) PL_curpad[po] = (sv)
+#endif
+
+#define PAD_SVl(po)       (PL_curpad[po])
+
+#define PAD_BASE_SV(padlist, po) \
+       (AvARRAY(padlist)[1])   \
+           ? AvARRAY((AV*)(AvARRAY(padlist)[1]))[po] : Nullsv;
+    
+
+#define PAD_SET_CUR(padlist,n) \
+       SAVEVPTR(PL_curpad);   \
+       PL_curpad = AvARRAY((AV*)*av_fetch((padlist),(n),FALSE))
+
+#define PAD_SAVE_SETNULLPAD    SAVEVPTR(PL_curpad); PL_curpad = 0;
+
+#define PAD_UPDATE_CURPAD \
+    PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : Null(PAD)
+
+
+/*
+=for apidoc m|void|CX_CURPAD_SAVE|struct context
+Save the current pad in the given context block structure.
+
+=for apidoc m|PAD *|CX_CURPAD_SV|struct context|PADOFFSET po
+Access the SV at offset po in the saved current pad in the given
+context block structure (can be used as an lvalue).
+
+=cut
+*/
+
+#define CX_CURPAD_SAVE(block)  (block).oldcurpad = PL_curpad
+#define CX_CURPAD_SV(block,po) ((block).oldcurpad[po])
+
+
+/*
+=for apidoc m|U32|PAD_COMPNAME_FLAGS|PADOFFSET po
+Return the flags for the current compiling pad name
+at offset C<po>. Assumes a valid slot entry.
+
+=for apidoc m|char *|PAD_COMPNAME_PV|PADOFFSET po
+Return the name of the current compiling pad name
+at offset C<po>. Assumes a valid slot entry.
+
+=for apidoc m|HV *|PAD_COMPNAME_TYPE|PADOFFSET po
+Return the type (stash) of the current compiling pad name at offset
+C<po>. Must be a valid name. Returns null if not typed.
+
+=for apidoc m|HV *|PAD_COMPNAME_OURSTASH|PADOFFSET po
+Return the stash associated with an C<our> variable.
+Assumes the slot entry is a valid C<our> lexical.
+
+=for apidoc m|STRLEN|PAD_COMPNAME_GEN|PADOFFSET po
+The generation number of the name at offset C<po> in the current
+compiling pad (lvalue). Note that C<SvCUR> is hijacked for this purpose.
+
+=cut
+*/
+
+#define PAD_COMPNAME_FLAGS(po) SvFLAGS(*av_fetch(PL_comppad_name, (po), FALSE))
+#define PAD_COMPNAME_PV(po) SvPV_nolen(*av_fetch(PL_comppad_name, (po), FALSE))
+
+/* XXX DAPM yuk - using av_fetch twice. Is there a better way? */
+#define PAD_COMPNAME_TYPE(po) \
+    ((SvFLAGS(*av_fetch(PL_comppad_name, (po), FALSE)) & SVpad_TYPED) \
+    ? (SvSTASH(*av_fetch(PL_comppad_name, (po), FALSE))) :  Nullhv)
+
+#define PAD_COMPNAME_OURSTASH(po) \
+    (GvSTASH(*av_fetch(PL_comppad_name, (po), FALSE)))
+
+#define PAD_COMPNAME_GEN(po) SvCUR(AvARRAY(PL_comppad_name)[po])
+
+
+
+
+/*
+=for apidoc m|void|PAD_DUP|PADLIST dstpad|PADLIST srcpad|CLONE_PARAMS* param
+Clone a padlist.
+
+=for apidoc m|void|PAD_CLONE_VARS|PerlInterpreter *proto_perl \
+|CLONE_PARAMS* param
+Clone the state variables associated with running and compiling pads.
+
+=cut
+*/
+
+
+#define PAD_DUP(dstpad, srcpad, param)                         \
+    if ((srcpad) && !AvREAL(srcpad)) {                         \
+       /* XXX padlists are real, but pretend to be not */      \
+       AvREAL_on(srcpad);                                      \
+       (dstpad) = av_dup_inc((srcpad), param);                 \
+       AvREAL_off(srcpad);                                     \
+       AvREAL_off(dstpad);                                     \
+    }                                                          \
+    else                                                       \
+       (dstpad) = av_dup_inc((srcpad), param);                 
+
+#define PAD_CLONE_VARS(proto_perl, param)                              \
+    PL_comppad                 = av_dup(proto_perl->Icomppad, param);  \
+    PL_comppad_name            = av_dup(proto_perl->Icomppad_name, param); \
+    PL_comppad_name_fill       = proto_perl->Icomppad_name_fill;       \
+    PL_comppad_name_floor      = proto_perl->Icomppad_name_floor;      \
+    PL_curpad                  = (SV**)ptr_table_fetch(PL_ptr_table,   \
+                                               proto_perl->Tcurpad);   \
+    PL_min_intro_pending       = proto_perl->Imin_intro_pending;       \
+    PL_max_intro_pending       = proto_perl->Imax_intro_pending;       \
+    PL_padix                   = proto_perl->Ipadix;                   \
+    PL_padix_floor             = proto_perl->Ipadix_floor;             \
+    PL_pad_reset_pending       = proto_perl->Ipad_reset_pending;       \
+    PL_cop_seqmax              = proto_perl->Icop_seqmax;
diff --git a/perl.c b/perl.c
index 4245030..dd459cb 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -462,8 +462,7 @@ perl_destruct(pTHXx)
 
     /* Destroy the main CV and syntax tree */
     if (PL_main_root) {
-        /* If running under -d may not have PL_comppad. */
-        PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : NULL;
+       PAD_UPDATE_CURPAD;
        op_free(PL_main_root);
        PL_main_root = Nullop;
     }
@@ -1040,7 +1039,7 @@ setuid perl scripts securely.\n");
     }
 
     if (PL_main_root) {
-       PL_curpad = AvARRAY(PL_comppad);
+       PAD_UPDATE_CURPAD;
        op_free(PL_main_root);
        PL_main_root = Nullop;
     }
@@ -1108,7 +1107,6 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     int fdscript = -1;
     VOL bool dosearch = FALSE;
     char *validarg = "";
-    AV* comppadlist;
     register SV *sv;
     register char *s;
     char *cddir = Nullch;
@@ -1450,28 +1448,13 @@ print \"  \\@INC:\\n    @INC\\n\";");
     sv_upgrade((SV *)PL_compcv, SVt_PVCV);
     CvUNIQUE_on(PL_compcv);
 
-    PL_comppad = newAV();
-    av_push(PL_comppad, Nullsv);
-    PL_curpad = AvARRAY(PL_comppad);
-    PL_comppad_name = newAV();
-    PL_comppad_name_fill = 0;
-    PL_min_intro_pending = 0;
-    PL_padix = 0;
+    CvPADLIST(PL_compcv) = pad_new(0);
 #ifdef USE_5005THREADS
-    av_store(PL_comppad_name, 0, newSVpvn("@_", 2));
-    PL_curpad[0] = (SV*)newAV();
-    SvPADMY_on(PL_curpad[0]);  /* XXX Needed? */
     CvOWNER(PL_compcv) = 0;
     New(666, CvMUTEXP(PL_compcv), 1, perl_mutex);
     MUTEX_INIT(CvMUTEXP(PL_compcv));
 #endif /* USE_5005THREADS */
 
-    comppadlist = newAV();
-    AvREAL_off(comppadlist);
-    av_store(comppadlist, 0, (SV*)PL_comppad_name);
-    av_store(comppadlist, 1, (SV*)PL_comppad);
-    CvPADLIST(PL_compcv) = comppadlist;
-
     boot_core_PerlIO();
     boot_core_UNIVERSAL();
 #ifndef PERL_MICRO
diff --git a/perl.h b/perl.h
index ef08cce..5391919 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -2264,6 +2264,7 @@ typedef        struct crypt_data {     /* straight from /usr/include/crypt.h */
 #include "util.h"
 #include "form.h"
 #include "gv.h"
+#include "pad.h"
 #include "cv.h"
 #include "opnames.h"
 #include "op.h"
@@ -2512,6 +2513,7 @@ Gid_t getegid (void);
 #  define DEBUG_J_TEST_ (PL_debug & DEBUG_J_FLAG)
 #  define DEBUG_v_TEST_ (PL_debug & DEBUG_v_FLAG)
 #  define DEBUG_C_TEST_ (PL_debug & DEBUG_C_FLAG)
+#  define DEBUG_Xv_TEST_ (DEBUG_X_TEST_ && DEBUG_v_TEST_)
 
 #ifdef DEBUGGING
 
@@ -2532,6 +2534,7 @@ Gid_t getegid (void);
 #  define DEBUG_u_TEST DEBUG_u_TEST_
 #  define DEBUG_H_TEST DEBUG_H_TEST_
 #  define DEBUG_X_TEST DEBUG_X_TEST_
+#  define DEBUG_Xv_TEST DEBUG_Xv_TEST_
 #  define DEBUG_D_TEST DEBUG_D_TEST_
 #  define DEBUG_S_TEST DEBUG_S_TEST_
 #  define DEBUG_T_TEST DEBUG_T_TEST_
@@ -2568,6 +2571,7 @@ Gid_t getegid (void);
 #  define DEBUG_u(a) DEBUG__(DEBUG_u_TEST, a)
 #  define DEBUG_H(a) DEBUG__(DEBUG_H_TEST, a)
 #  define DEBUG_X(a) DEBUG__(DEBUG_X_TEST, a)
+#  define DEBUG_Xv(a) DEBUG__(DEBUG_Xv_TEST, a)
 #  define DEBUG_D(a) DEBUG__(DEBUG_D_TEST, a)
 
 #  ifdef USE_5005THREADS
@@ -2597,6 +2601,7 @@ Gid_t getegid (void);
 #  define DEBUG_u_TEST (0)
 #  define DEBUG_H_TEST (0)
 #  define DEBUG_X_TEST (0)
+#  define DEBUG_Xv_TEST (0)
 #  define DEBUG_D_TEST (0)
 #  define DEBUG_S_TEST (0)
 #  define DEBUG_T_TEST (0)
@@ -2621,6 +2626,7 @@ Gid_t getegid (void);
 #  define DEBUG_u(a)
 #  define DEBUG_H(a)
 #  define DEBUG_X(a)
+#  define DEBUG_Xv(a)
 #  define DEBUG_D(a)
 #  define DEBUG_S(a)
 #  define DEBUG_T(a)
@@ -2889,10 +2895,8 @@ typedef Sighandler_t Sigsave_t;
 # ifndef register
 #  define register
 # endif
-# define PAD_SV(po) pad_sv(po)
 # define RUNOPS_DEFAULT Perl_runops_debug
 #else
-# define PAD_SV(po) PL_curpad[po]
 # define RUNOPS_DEFAULT Perl_runops_standard
 #endif
 
index 7aa9592..b9822a6 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -412,8 +412,6 @@ END_EXTERN_C
 #define PL_nthreads            (*Perl_Inthreads_ptr(aTHX))
 #undef  PL_nthreads_cond
 #define PL_nthreads_cond       (*Perl_Inthreads_cond_ptr(aTHX))
-#undef  PL_nullstash
-#define PL_nullstash           (*Perl_Inullstash_ptr(aTHX))
 #undef  PL_numeric_compat1
 #define PL_numeric_compat1     (*Perl_Inumeric_compat1_ptr(aTHX))
 #undef  PL_numeric_local
index b83571c..78e1044 100644 (file)
@@ -871,7 +871,7 @@ is to be expected. (For information only--not to be used).
 =for hackers
 Found in file hv.h
 
-=item Nullch 
+=item Nullch
 
 Null character pointer.
 =for hackers
@@ -1885,6 +1885,23 @@ Found in file op.c
 
 =back
 
+=head1 Pad Data Structures
+
+=over 8
+
+=item pad_sv
+
+Get the value at offset po in the current pad.
+Use macro PAD_SV instead of calling this function directly.
+
+       SV*     pad_sv(PADOFFSET po)
+
+=for hackers
+Found in file pad.c
+
+
+=back
+
 =head1 Stack Manipulation Macros
 
 =over 8
index c9cb5e7..d256e7e 100644 (file)
@@ -11,6 +11,208 @@ format but are not marked as part of the Perl API. In other words,
 B<they are not for use in extensions>!
 
 
+=head1 Functions in file pad.h
+
+
+=over 8
+
+=item CX_CURPAD_SAVE
+
+Save the current pad in the given context block structure.
+
+       void    CX_CURPAD_SAVE(struct context)
+
+=for hackers
+Found in file pad.h
+
+=item CX_CURPAD_SV
+
+Access the SV at offset po in the saved current pad in the given
+context block structure (can be used as an lvalue).
+
+       PAD *   CX_CURPAD_SV(struct context, PADOFFSET po)
+
+=for hackers
+Found in file pad.h
+
+=item PAD_BASE_SV      
+
+Get the value from slot C<po> in the base (DEPTH=1) pad of a padlist
+
+       SV *    PAD_BASE_SV     (PADLIST padlist, PADOFFSET po)
+
+=for hackers
+Found in file pad.h
+
+=item PAD_CLONE_VARS
+
+|CLONE_PARAMS* param
+Clone the state variables associated with running and compiling pads.
+
+       void    PAD_CLONE_VARS(PerlInterpreter *proto_perl \)
+
+=for hackers
+Found in file pad.h
+
+=item PAD_COMPNAME_FLAGS
+
+Return the flags for the current compiling pad name
+at offset C<po>. Assumes a valid slot entry.
+
+       U32     PAD_COMPNAME_FLAGS(PADOFFSET po)
+
+=for hackers
+Found in file pad.h
+
+=item PAD_COMPNAME_GEN
+
+The generation number of the name at offset C<po> in the current
+compiling pad (lvalue). Note that C<SvCUR> is hijacked for this purpose.
+
+       STRLEN  PAD_COMPNAME_GEN(PADOFFSET po)
+
+=for hackers
+Found in file pad.h
+
+=item PAD_COMPNAME_OURSTASH
+
+Return the stash associated with an C<our> variable.
+Assumes the slot entry is a valid C<our> lexical.
+
+       HV *    PAD_COMPNAME_OURSTASH(PADOFFSET po)
+
+=for hackers
+Found in file pad.h
+
+=item PAD_COMPNAME_PV
+
+Return the name of the current compiling pad name
+at offset C<po>. Assumes a valid slot entry.
+
+       char *  PAD_COMPNAME_PV(PADOFFSET po)
+
+=for hackers
+Found in file pad.h
+
+=item PAD_COMPNAME_TYPE
+
+Return the type (stash) of the current compiling pad name at offset
+C<po>. Must be a valid name. Returns null if not typed.
+
+       HV *    PAD_COMPNAME_TYPE(PADOFFSET po)
+
+=for hackers
+Found in file pad.h
+
+=item PAD_DUP
+
+Clone a padlist.
+
+       void    PAD_DUP(PADLIST dstpad, PADLIST srcpad, CLONE_PARAMS* param)
+
+=for hackers
+Found in file pad.h
+
+=item PAD_SAVE_SETNULLPAD
+
+Save the current pad then set it to null.
+
+       void    PAD_SAVE_SETNULLPAD()
+
+=for hackers
+Found in file pad.h
+
+=item PAD_SETSV        
+
+Set the slot at offset C<po> in the current pad to C<sv>
+
+       SV *    PAD_SETSV       (PADOFFSET po, SV* sv)
+
+=for hackers
+Found in file pad.h
+
+=item PAD_SET_CUR      
+
+Set the current pad to be pad C<n> in the padlist, saving
+the previous current pad.
+
+       void    PAD_SET_CUR     (PADLIST padlist, I32 n)
+
+=for hackers
+Found in file pad.h
+
+=item PAD_SV   
+
+Get the value at offset C<po> in the current pad
+
+       void    PAD_SV  (PADOFFSET po)
+
+=for hackers
+Found in file pad.h
+
+=item PAD_SVl  
+
+Lightweight and lvalue version of C<PAD_SV>.
+Get or set the value at offset C<po> in the current pad.
+Unlike C<PAD_SV>, does not print diagnostics with -DX.
+For internal use only.
+
+       SV *    PAD_SVl (PADOFFSET po)
+
+=for hackers
+Found in file pad.h
+
+=item PAD_UPDATE_CURPAD
+
+Set PL_curpad from the value of PL_comppad.
+
+       void    PAD_UPDATE_CURPAD()
+
+=for hackers
+Found in file pad.h
+
+=item SAVECLEARSV      
+
+Clear the pointed to pad value on scope exit. (ie the runtime action of 'my')
+
+       void    SAVECLEARSV     (SV **svp)
+
+=for hackers
+Found in file pad.h
+
+=item SAVECOMPPAD
+
+save PL_comppad and PL_curpad
+
+       void    SAVECOMPPAD()
+
+=for hackers
+Found in file pad.h
+
+=item SAVEFREEOP       
+
+Free the op on scope exit. At the same time, reset PL_curpad
+
+
+
+
+       void    SAVEFREEOP      (OP *o)
+
+=for hackers
+Found in file pad.h
+
+=item SAVEPADSV        
+
+Save a pad slot (used to restore after an iteration)
+
+       void    SAVEPADSV       (PADOFFSET po)
+
+=for hackers
+Found in file pad.h
+
+
+=back
+
 =head1 Global Variables
 
 =over 8
@@ -177,8 +379,12 @@ but only by their index allocated at compile time (which is usually
 in PL_op->op_targ), wasting a name SV for them doesn't make sense.
 
 The SVs in the names AV have their PV being the name of the variable.
-NV+1..IV inclusive is a range of cop_seq numbers for which the name is valid.
-For typed lexicals name SV is SVt_PVMG and SvSTASH points at the type.
+NV+1..IV inclusive is a range of cop_seq numbers for which the name is
+valid.  For typed lexicals name SV is SVt_PVMG and SvSTASH points at the
+type.  For C<our> lexicals, the type is SVt_PVGV, and GvSTASH points at the
+stash of the associated global (so that duplicate C<our> delarations in the
+same package can be detected).  SvCUR is sometimes hijacked to
+store the generation number during compilation.
 
 If SvFAKE is set on the name SV then slot in the frame AVs are
 a REFCNT'ed references to a lexical from "outside".
@@ -191,7 +397,238 @@ become so if C<my sub foo {}> is implemented.)
        AV *    CvPADLIST(CV *cv)
 
 =for hackers
-Found in file cv.h
+Found in file pad.c
+
+=item cv_clone
+
+Clone a CV: make a new CV which points to the same code etc, but which
+has a newly-created pad done by copying the prototype pad and capturing
+any outer lexicals.
+
+       CV*     cv_clone(CV* proto)
+
+=for hackers
+Found in file pad.c
+
+=item cv_dump
+
+dump the contents of a CV
+
+       void    cv_dump(CV *cv, char *title)
+
+=for hackers
+Found in file pad.c
+
+=item do_dump_pad
+
+Dump the contents of a padlist
+
+       void    do_dump_pad(I32 level, PerlIO *file, PADLIST *padlist, int full)
+
+=for hackers
+Found in file pad.c
+
+=item intro_my
+
+"Introduce" my variables to visible status.
+
+       U32     intro_my()
+
+=for hackers
+Found in file pad.c
+
+=item pad_add_anon
+
+Add an anon code entry to the current compiling pad
+
+       PADOFFSET       pad_add_anon(SV* sv, OPCODE op_type)
+
+=for hackers
+Found in file pad.c
+
+=item pad_add_name
+
+Create a new name in the current pad at the specified offset.
+If C<typestash> is valid, the name is for a typed lexical; set the
+name's stash to that value.
+If C<ourstash> is valid, it's an our lexical, set the name's
+GvSTASH to that value
+
+Also, if the name is @.. or %.., create a new array or hash for that slot
+
+If fake, it means we're cloning an existing entry
+
+       PADOFFSET       pad_add_name(char *name, HV* typestash, HV* ourstash, bool clone)
+
+=for hackers
+Found in file pad.c
+
+=item pad_alloc
+
+Allocate a new my or tmp pad entry. For a my, simply push a null SV onto
+the end of PL_comppad, but for a tmp, scan the pad from PL_padix upwards
+for a slot which has no name and and no active value.
+
+       PADOFFSET       pad_alloc(I32 optype, U32 tmptype)
+
+=for hackers
+Found in file pad.c
+
+=item pad_block_start
+
+Update the pad compilation state variables on entry to a new block
+
+       void    pad_block_start(int full)
+
+=for hackers
+Found in file pad.c
+
+=item pad_check_dup
+
+Check for duplicate declarations: report any of:
+     * a my in the current scope with the same name;
+     * an our (anywhere in the pad) with the same name and the same stash
+       as C<ourstash>
+C<is_our> indicates that the name to check is an 'our' declaration
+
+
+       void    pad_check_dup(char* name, bool is_our, HV* ourstash)
+
+=for hackers
+Found in file pad.c
+
+=item pad_findlex
+
+Find a named lexical anywhere in a chain of nested pads. Add fake entries
+in the inner pads if its found in an outer one.
+
+If flags == FINDLEX_NOSEARCH we don't bother searching outer contexts.
+
+       PADOFFSET       pad_findlex(char* name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix, I32 saweval, U32 flags)
+
+=for hackers
+Found in file pad.c
+
+=item pad_findmy
+
+Given a lexical name, try to find it's offset, first in the current pad,
+or failing that, in the pads of any lexically enclosing subs (including
+the complications introduced by eval). If the name is found in an outer pad, then a fake entry is added to the current pad.
+Returns the offset in the current pad, or NOT_IN_PAD on failure.
+
+       PADOFFSET       pad_findmy(char* name)
+
+=for hackers
+Found in file pad.c
+
+=item pad_fixup_inner_anons
+
+For any anon CVs in the pad, change CvOUTSIDE of that CV from
+old_cv to new_cv if necessary.
+
+       void    pad_fixup_inner_anons(PADLIST *padlist, CV *old_cv, CV *new_cv)
+
+=for hackers
+Found in file pad.c
+
+=item pad_free
+
+Free the SV at offet po in the current pad.
+
+       void    pad_free(PADOFFSET po)
+
+=for hackers
+Found in file pad.c
+
+=item pad_leavemy
+
+Cleanup at end of scope during compilation: set the max seq number for
+lexicals in this scope and warn of any lexicals that never got introduced.
+
+       void    pad_leavemy()
+
+=for hackers
+Found in file pad.c
+
+=item pad_new
+
+Create a new comnpiling padlist, saving and updating the various global
+vars at the same time as creating the pad itself. The following flags
+can be OR'ed together:
+
+    padnew_CLONE       this pad is for a cloned CV
+    padnew_SAVE                save old globals
+    padnew_SAVESUB     also save extra stuff for start of sub
+
+       PADLIST*        pad_new(padnew_flags flags)
+
+=for hackers
+Found in file pad.c
+
+=item pad_push
+
+Push a new pad frame onto the padlist, unless there's already a pad at
+this depth, in which case don't bother creating a new one.
+If has_args is true, give the new pad an @_ in slot zero.
+
+       void    pad_push(PADLIST *padlist, int depth, int has_args)
+
+=for hackers
+Found in file pad.c
+
+=item pad_reset
+
+Mark all the current temporaries for reuse
+
+       void    pad_reset()
+
+=for hackers
+Found in file pad.c
+
+=item pad_setsv
+
+Set the entry at offset po in the current pad to sv.
+Use the macro PAD_SETSV() rather than calling this function directly.
+
+       void    pad_setsv(PADOFFSET po, SV* sv)
+
+=for hackers
+Found in file pad.c
+
+=item pad_swipe
+
+Abandon the tmp in the current pad at offset po and replace with a
+new one.
+
+       void    pad_swipe(PADOFFSET po, bool refadjust)
+
+=for hackers
+Found in file pad.c
+
+=item pad_tidy
+
+Tidy up a pad after we've finished compiling it:
+    * remove most stuff from the pads of anonsub prototypes;
+    * give it a @_;
+    * mark tmps as such.
+
+       void    pad_tidy(padtidy_type type)
+
+=for hackers
+Found in file pad.c
+
+=item pad_undef
+
+Free the padlist associated with a CV.
+If parts of it happen to be current, we null the relevant
+PL_*pad* global vars so that we don't have any dangling references left.
+We also repoint the CvOUTSIDE of any about-to-be-orphaned
+inner subs to outercv.
+
+       void    pad_undef(CV* cv, CV* outercv)
+
+=for hackers
+Found in file pad.c
 
 
 =back
diff --git a/pp.c b/pp.c
index b3a6eed..d2c462e 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -48,7 +48,7 @@ PP(pp_padav)
 {
     dSP; dTARGET;
     if (PL_op->op_private & OPpLVAL_INTRO)
-       SAVECLEARSV(PL_curpad[PL_op->op_targ]);
+       SAVECLEARSV(PAD_SVl(PL_op->op_targ));
     EXTEND(SP, 1);
     if (PL_op->op_flags & OPf_REF) {
        PUSHs(TARG);
@@ -90,7 +90,7 @@ PP(pp_padhv)
 
     XPUSHs(TARG);
     if (PL_op->op_private & OPpLVAL_INTRO)
-       SAVECLEARSV(PL_curpad[PL_op->op_targ]);
+       SAVECLEARSV(PAD_SVl(PL_op->op_targ));
     if (PL_op->op_flags & OPf_REF)
        RETURN;
     else if (LVRET) {
@@ -159,7 +159,7 @@ PP(pp_rv2gv)
                    GV *gv;
                    if (cUNOP->op_targ) {
                        STRLEN len;
-                       SV *namesv = PL_curpad[cUNOP->op_targ];
+                       SV *namesv = PAD_SV(cUNOP->op_targ);
                        name = SvPV(namesv, len);
                        gv = (GV*)NEWSV(0,0);
                        gv_init(gv, CopSTASH(PL_curcop), name, len, 0);
@@ -420,7 +420,7 @@ PP(pp_prototype)
 PP(pp_anoncode)
 {
     dSP;
-    CV* cv = (CV*)PL_curpad[PL_op->op_targ];
+    CV* cv = (CV*)PAD_SV(PL_op->op_targ);
     if (CvCLONE(cv))
        cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
     EXTEND(SP,1);
@@ -4372,14 +4372,14 @@ PP(pp_split)
 
     if (pm->op_pmreplroot) {
 #ifdef USE_ITHREADS
-       ary = GvAVn((GV*)PL_curpad[INT2PTR(PADOFFSET, pm->op_pmreplroot)]);
+       ary = GvAVn((GV*)PAD_SVl(INT2PTR(PADOFFSET, pm->op_pmreplroot)));
 #else
        ary = GvAVn((GV*)pm->op_pmreplroot);
 #endif
     }
     else if (gimme != G_ARRAY)
 #ifdef USE_5005THREADS
-       ary = (AV*)PL_curpad[0];
+       ary = (AV*)PAD_SVl(0);
 #else
        ary = GvAVn(PL_defgv);
 #endif /* USE_5005THREADS */
index 67fcbf2..b6393de 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1587,6 +1587,8 @@ PP(pp_lineseq)
     return NORMAL;
 }
 
+/* like pp_nextstate, but used instead when the debugger is active */
+
 PP(pp_dbstate)
 {
     PL_curcop = (COP*)PL_op;
@@ -1626,8 +1628,7 @@ PP(pp_dbstate)
        PUSHSUB(cx);
        CvDEPTH(cv)++;
        (void)SvREFCNT_inc(cv);
-       SAVEVPTR(PL_curpad);
-       PL_curpad = AvARRAY((AV*)*av_fetch(CvPADLIST(cv),1,FALSE));
+       PAD_SET_CUR(CvPADLIST(cv),1);
        RETURNOP(CvSTART(cv));
     }
     else
@@ -1663,7 +1664,7 @@ PP(pp_enteriter)
 #endif /* USE_5005THREADS */
     if (PL_op->op_targ) {
 #ifndef USE_ITHREADS
-       svp = &PL_curpad[PL_op->op_targ];               /* "my" variable */
+       svp = &PAD_SVl(PL_op->op_targ);         /* "my" variable */
        SAVESPTR(*svp);
 #else
        SAVEPADSV(PL_op->op_targ);
@@ -2145,13 +2146,13 @@ PP(pp_goto)
                    av = newAV();
                    av_extend(av, items-1);
                    AvFLAGS(av) = AVf_REIFY;
-                   PL_curpad[0] = (SV*)(cx->blk_sub.argarray = av);
+                   PAD_SVl(0) = (SV*)(cx->blk_sub.argarray = av);
                }
            }
            else if (CvXSUB(cv)) {      /* put GvAV(defgv) back onto stack */
                AV* av;
 #ifdef USE_5005THREADS
-               av = (AV*)PL_curpad[0];
+               av = (AV*)PAD_SVl(0);
 #else
                av = GvAV(PL_defgv);
 #endif
@@ -2202,7 +2203,6 @@ PP(pp_goto)
            }
            else {
                AV* padlist = CvPADLIST(cv);
-               SV** svp = AvARRAY(padlist);
                if (CxTYPE(cx) == CXt_EVAL) {
                    PL_in_eval = cx->blk_eval.old_in_eval;
                    PL_eval_root = cx->blk_eval.old_eval_root;
@@ -2211,60 +2211,18 @@ PP(pp_goto)
                }
                cx->blk_sub.cv = cv;
                cx->blk_sub.olddepth = (U16)CvDEPTH(cv);
+
                CvDEPTH(cv)++;
                if (CvDEPTH(cv) < 2)
                    (void)SvREFCNT_inc(cv);
-               else {  /* save temporaries on recursion? */
+               else {
                    if (CvDEPTH(cv) == 100 && ckWARN(WARN_RECURSION))
                        sub_crush_depth(cv);
-                   if (CvDEPTH(cv) > AvFILLp(padlist)) {
-                       AV *newpad = newAV();
-                       SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]);
-                       I32 ix = AvFILLp((AV*)svp[1]);
-                       I32 names_fill = AvFILLp((AV*)svp[0]);
-                       svp = AvARRAY(svp[0]);
-                       for ( ;ix > 0; ix--) {
-                           if (names_fill >= ix && svp[ix] != &PL_sv_undef) {
-                               char *name = SvPVX(svp[ix]);
-                               if ((SvFLAGS(svp[ix]) & SVf_FAKE)
-                                   || *name == '&')
-                               {
-                                   /* outer lexical or anon code */
-                                   av_store(newpad, ix,
-                                       SvREFCNT_inc(oldpad[ix]) );
-                               }
-                               else {          /* our own lexical */
-                                   if (*name == '@')
-                                       av_store(newpad, ix, sv = (SV*)newAV());
-                                   else if (*name == '%')
-                                       av_store(newpad, ix, sv = (SV*)newHV());
-                                   else
-                                       av_store(newpad, ix, sv = NEWSV(0,0));
-                                   SvPADMY_on(sv);
-                               }
-                           }
-                           else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
-                               av_store(newpad, ix, sv = SvREFCNT_inc(oldpad[ix]));
-                           }
-                           else {
-                               av_store(newpad, ix, sv = NEWSV(0,0));
-                               SvPADTMP_on(sv);
-                           }
-                       }
-                       if (cx->blk_sub.hasargs) {
-                           AV* av = newAV();
-                           av_extend(av, 0);
-                           av_store(newpad, 0, (SV*)av);
-                           AvFLAGS(av) = AVf_REIFY;
-                       }
-                       av_store(padlist, CvDEPTH(cv), (SV*)newpad);
-                       AvFILLp(padlist) = CvDEPTH(cv);
-                       svp = AvARRAY(padlist);
-                   }
+                   pad_push(padlist, CvDEPTH(cv), cx->blk_sub.hasargs);
                }
 #ifdef USE_5005THREADS
                if (!cx->blk_sub.hasargs) {
-                   AV* av = (AV*)PL_curpad[0];
+                   AV* av = (AV*)PAD_SVl(0);
                
                    items = AvFILLp(av) + 1;
                    if (items) {
@@ -2275,21 +2233,20 @@ PP(pp_goto)
                        PUTBACK ;               
                    }
                }
-#endif /* USE_5005THREADS */           
-               SAVEVPTR(PL_curpad);
-               PL_curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
+#endif /* USE_5005THREADS */
+               PAD_SET_CUR(padlist, CvDEPTH(cv));
 #ifndef USE_5005THREADS
                if (cx->blk_sub.hasargs)
 #endif /* USE_5005THREADS */
                {
-                   AV* av = (AV*)PL_curpad[0];
+                   AV* av = (AV*)PAD_SVl(0);
                    SV** ary;
 
 #ifndef USE_5005THREADS
                    cx->blk_sub.savearray = GvAV(PL_defgv);
                    GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);
 #endif /* USE_5005THREADS */
-                   cx->blk_sub.oldcurpad = PL_curpad;
+                   CX_CURPAD_SAVE(cx->blk_sub);
                    cx->blk_sub.argarray = av;
                    ++mark;
 
@@ -2710,7 +2667,6 @@ S_doeval(pTHX_ int gimme, OP** startop)
     dSP;
     OP *saveop = PL_op;
     CV *caller;
-    AV* comppadlist;
     I32 i;
 
     PL_in_eval = ((saveop && saveop->op_type == OP_REQUIRE)
@@ -2719,16 +2675,6 @@ S_doeval(pTHX_ int gimme, OP** startop)
 
     PUSHMARK(SP);
 
-    /* set up a scratch pad */
-
-    SAVEI32(PL_padix);
-    SAVEVPTR(PL_curpad);
-    SAVESPTR(PL_comppad);
-    SAVESPTR(PL_comppad_name);
-    SAVEI32(PL_comppad_name_fill);
-    SAVEI32(PL_min_intro_pending);
-    SAVEI32(PL_max_intro_pending);
-
     caller = PL_compcv;
     for (i = cxstack_ix - 1; i >= 0; i--) {
        PERL_CONTEXT *cx = &cxstack[i];
@@ -2753,24 +2699,9 @@ S_doeval(pTHX_ int gimme, OP** startop)
     MUTEX_INIT(CvMUTEXP(PL_compcv));
 #endif /* USE_5005THREADS */
 
-    PL_comppad = newAV();
-    av_push(PL_comppad, Nullsv);
-    PL_curpad = AvARRAY(PL_comppad);
-    PL_comppad_name = newAV();
-    PL_comppad_name_fill = 0;
-    PL_min_intro_pending = 0;
-    PL_padix = 0;
-#ifdef USE_5005THREADS
-    av_store(PL_comppad_name, 0, newSVpvn("@_", 2));
-    PL_curpad[0] = (SV*)newAV();
-    SvPADMY_on(PL_curpad[0]);  /* XXX Needed? */
-#endif /* USE_5005THREADS */
+    /* set up a scratch pad */
 
-    comppadlist = newAV();
-    AvREAL_off(comppadlist);
-    av_store(comppadlist, 0, (SV*)PL_comppad_name);
-    av_store(comppadlist, 1, (SV*)PL_comppad);
-    CvPADLIST(PL_compcv) = comppadlist;
+    CvPADLIST(PL_compcv) = pad_new(padnew_SAVE);
 
     if (!saveop ||
        (saveop->op_type != OP_REQUIRE && saveop->op_type != OP_DOFILE))
index 98b9b44..cc301ba 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -197,10 +197,10 @@ PP(pp_padsv)
     XPUSHs(TARG);
     if (PL_op->op_flags & OPf_MOD) {
        if (PL_op->op_private & OPpLVAL_INTRO)
-           SAVECLEARSV(PL_curpad[PL_op->op_targ]);
+           SAVECLEARSV(PAD_SVl(PL_op->op_targ));
         else if (PL_op->op_private & OPpDEREF) {
            PUTBACK;
-           vivify_ref(PL_curpad[PL_op->op_targ], PL_op->op_private & OPpDEREF);
+           vivify_ref(PAD_SVl(PL_op->op_targ), PL_op->op_private & OPpDEREF);
            SPAGAIN;
        }
     }
@@ -2572,7 +2572,7 @@ try_autoload:
            if (SP > PL_stack_base + TOPMARK)
                sv = *(PL_stack_base + TOPMARK + 1);
            else {
-               AV *av = (AV*)PL_curpad[0];
+               AV *av = (AV*)PAD_SVl(0);
                if (hasargs || !av || AvFILLp(av) < 0
                    || !(sv = AvARRAY(av)[0]))
                {
@@ -2723,7 +2723,7 @@ try_autoload:
                AV* av;
                I32 items;
 #ifdef USE_5005THREADS
-               av = (AV*)PL_curpad[0];
+               av = (AV*)PAD_SVl(0);
 #else
                av = GvAV(PL_defgv);
 #endif /* USE_5005THREADS */           
@@ -2762,7 +2762,6 @@ try_autoload:
        dMARK;
        register I32 items = SP - MARK;
        AV* padlist = CvPADLIST(cv);
-       SV** svp = AvARRAY(padlist);
        push_return(PL_op->op_next);
        PUSHBLOCK(cx, CXt_SUB, MARK);
        PUSHSUB(cx);
@@ -2774,53 +2773,13 @@ try_autoload:
         */
        if (CvDEPTH(cv) < 2)
            (void)SvREFCNT_inc(cv);
-       else {  /* save temporaries on recursion? */
+       else {
            PERL_STACK_OVERFLOW_CHECK();
-           if (CvDEPTH(cv) > AvFILLp(padlist)) {
-               AV *av;
-               AV *newpad = newAV();
-               SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]);
-               I32 ix = AvFILLp((AV*)svp[1]);
-               I32 names_fill = AvFILLp((AV*)svp[0]);
-               svp = AvARRAY(svp[0]);
-               for ( ;ix > 0; ix--) {
-                   if (names_fill >= ix && svp[ix] != &PL_sv_undef) {
-                       char *name = SvPVX(svp[ix]);
-                       if ((SvFLAGS(svp[ix]) & SVf_FAKE) /* outer lexical? */
-                           || *name == '&')              /* anonymous code? */
-                       {
-                           av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]));
-                       }
-                       else {                          /* our own lexical */
-                           if (*name == '@')
-                               av_store(newpad, ix, sv = (SV*)newAV());
-                           else if (*name == '%')
-                               av_store(newpad, ix, sv = (SV*)newHV());
-                           else
-                               av_store(newpad, ix, sv = NEWSV(0,0));
-                           SvPADMY_on(sv);
-                       }
-                   }
-                   else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
-                       av_store(newpad, ix, sv = SvREFCNT_inc(oldpad[ix]));
-                   }
-                   else {
-                       av_store(newpad, ix, sv = NEWSV(0,0));
-                       SvPADTMP_on(sv);
-                   }
-               }
-               av = newAV();           /* will be @_ */
-               av_extend(av, 0);
-               av_store(newpad, 0, (SV*)av);
-               AvFLAGS(av) = AVf_REIFY;
-               av_store(padlist, CvDEPTH(cv), (SV*)newpad);
-               AvFILLp(padlist) = CvDEPTH(cv);
-               svp = AvARRAY(padlist);
-           }
+           pad_push(padlist, CvDEPTH(cv), 1);
        }
 #ifdef USE_5005THREADS
        if (!hasargs) {
-           AV* av = (AV*)PL_curpad[0];
+           AV* av = (AV*)PAD_SVl(0);
 
            items = AvFILLp(av) + 1;
            if (items) {
@@ -2832,8 +2791,7 @@ try_autoload:
            }
        }
 #endif /* USE_5005THREADS */           
-       SAVEVPTR(PL_curpad);
-       PL_curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
+       PAD_SET_CUR(padlist, CvDEPTH(cv));
 #ifndef USE_5005THREADS
        if (hasargs)
 #endif /* USE_5005THREADS */
@@ -2845,7 +2803,7 @@ try_autoload:
            DEBUG_S(PerlIO_printf(Perl_debug_log,
                                  "%p entersub preparing @_\n", thr));
 #endif
-           av = (AV*)PL_curpad[0];
+           av = (AV*)PAD_SVl(0);
            if (AvREAL(av)) {
                /* @_ is normally not REAL--this should only ever
                 * happen when DB::sub() calls things that modify @_ */
@@ -2857,7 +2815,7 @@ try_autoload:
            cx->blk_sub.savearray = GvAV(PL_defgv);
            GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);
 #endif /* USE_5005THREADS */
-           cx->blk_sub.oldcurpad = PL_curpad;
+           CX_CURPAD_SAVE(cx->blk_sub);
            cx->blk_sub.argarray = av;
            ++MARK;
 
index d2d4bde..db886c2 100644 (file)
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1470,8 +1470,7 @@ PP(pp_sort)
                SAVEVPTR(CvROOT(cv)->op_ppaddr);
                CvROOT(cv)->op_ppaddr = PL_ppaddr[OP_NULL];
 
-               SAVEVPTR(PL_curpad);
-               PL_curpad = AvARRAY((AV*)AvARRAY(CvPADLIST(cv))[1]);
+               PAD_SET_CUR(CvPADLIST(cv), 1);
             }
        }
     }
@@ -1535,13 +1534,13 @@ PP(pp_sort)
 
            if (hasargs && !is_xsub) {
                /* This is mostly copied from pp_entersub */
-               AV *av = (AV*)PL_curpad[0];
+               AV *av = (AV*)PAD_SVl(0);
 
 #ifndef USE_5005THREADS
                cx->blk_sub.savearray = GvAV(PL_defgv);
                GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);
 #endif /* USE_5005THREADS */
-               cx->blk_sub.oldcurpad = PL_curpad;
+               CX_CURPAD_SAVE(cx->blk_sub);
                cx->blk_sub.argarray = av;
            }
            sortsv((myorigmark+1), max,
@@ -1614,7 +1613,7 @@ sortcv_stacked(pTHX_ SV *a, SV *b)
     AV *av;
 
 #ifdef USE_5005THREADS
-    av = (AV*)PL_curpad[0];
+    av = (AV*)PAD_SVl(0);
 #else
     av = GvAV(PL_defgv);
 #endif
index d1dacdd..0245a35 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1206,8 +1206,6 @@ S_doform(pTHX_ CV *cv, GV *gv, OP *retop)
 {
     register PERL_CONTEXT *cx;
     I32 gimme = GIMME_V;
-    AV* padlist = CvPADLIST(cv);
-    SV** svp = AvARRAY(padlist);
 
     ENTER;
     SAVETMPS;
@@ -1215,8 +1213,7 @@ S_doform(pTHX_ CV *cv, GV *gv, OP *retop)
     push_return(retop);
     PUSHBLOCK(cx, CXt_FORMAT, PL_stack_sp);
     PUSHFORMAT(cx);
-    SAVEVPTR(PL_curpad);
-    PL_curpad = AvARRAY((AV*)svp[1]);
+    PAD_SET_CUR(CvPADLIST(cv), 1);
 
     setdefout(gv);         /* locally select filehandle so $% et al work */
     return CvSTART(cv);
diff --git a/proto.h b/proto.h
index cf5efbd..6dc54a4 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -587,15 +587,15 @@ PERL_CALLCONV OP* Perl_oopsCV(pTHX_ OP* o);
 PERL_CALLCONV void     Perl_op_free(pTHX_ OP* arg);
 PERL_CALLCONV void     Perl_package(pTHX_ OP* o);
 PERL_CALLCONV PADOFFSET        Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype);
-PERL_CALLCONV PADOFFSET        Perl_pad_allocmy(pTHX_ char* name);
+PERL_CALLCONV PADOFFSET        Perl_allocmy(pTHX_ char* name);
 PERL_CALLCONV PADOFFSET        Perl_pad_findmy(pTHX_ char* name);
 PERL_CALLCONV OP*      Perl_oopsAV(pTHX_ OP* o);
 PERL_CALLCONV OP*      Perl_oopsHV(pTHX_ OP* o);
-PERL_CALLCONV void     Perl_pad_leavemy(pTHX_ I32 fill);
+PERL_CALLCONV void     Perl_pad_leavemy(pTHX);
 PERL_CALLCONV SV*      Perl_pad_sv(pTHX_ PADOFFSET po);
 PERL_CALLCONV void     Perl_pad_free(pTHX_ PADOFFSET po);
 PERL_CALLCONV void     Perl_pad_reset(pTHX);
-PERL_CALLCONV void     Perl_pad_swipe(pTHX_ PADOFFSET po);
+PERL_CALLCONV void     Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust);
 PERL_CALLCONV void     Perl_peep(pTHX_ OP* o);
 PERL_CALLCONV PerlIO*  Perl_start_glob(pTHX_ SV* pattern, IO *io);
 #if defined(USE_5005THREADS)
@@ -1050,17 +1050,11 @@ STATIC OP*      S_no_fh_allowed(pTHX_ OP *o);
 STATIC OP*     S_scalarboolean(pTHX_ OP *o);
 STATIC OP*     S_too_few_arguments(pTHX_ OP *o, char* name);
 STATIC OP*     S_too_many_arguments(pTHX_ OP *o, char* name);
-STATIC PADOFFSET       S_pad_addlex(pTHX_ SV* name);
-STATIC PADOFFSET       S_pad_findlex(pTHX_ char* name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix, I32 saweval, U32 flags);
 STATIC OP*     S_newDEFSVOP(pTHX);
 STATIC OP*     S_new_logop(pTHX_ I32 type, I32 flags, OP **firstp, OP **otherp);
 STATIC void    S_simplify_sort(pTHX_ OP *o);
 STATIC bool    S_is_handle_constructor(pTHX_ OP *o, I32 argnum);
 STATIC char*   S_gv_ename(pTHX_ GV *gv);
-#  if defined(DEBUG_CLOSURES)
-STATIC void    S_cv_dump(pTHX_ CV *cv);
-#  endif
-STATIC CV*     S_cv_clone2(pTHX_ CV *proto, CV *outside);
 STATIC bool    S_scalar_mod_type(pTHX_ OP *o, I32 type);
 STATIC OP *    S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp);
 STATIC OP *    S_dup_attrlist(pTHX_ OP *o);
@@ -1383,6 +1377,30 @@ PERL_CALLCONV void       Perl_deb_stack_all(pTHX);
 STATIC void    S_deb_stack_n(pTHX_ SV** stack_base, I32 stack_min, I32 stack_max, I32 mark_min, I32 mark_max);
 #endif
 
+PERL_CALLCONV PADLIST* Perl_pad_new(pTHX_ padnew_flags flags);
+PERL_CALLCONV void     Perl_pad_undef(pTHX_ CV* cv, CV* outercv);
+PERL_CALLCONV PADOFFSET        Perl_pad_add_name(pTHX_ char *name, HV* typestash, HV* ourstash, bool clone);
+PERL_CALLCONV PADOFFSET        Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type);
+PERL_CALLCONV void     Perl_pad_check_dup(pTHX_ char* name, bool is_our, HV* ourstash);
+#ifdef DEBUGGING
+PERL_CALLCONV void     Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv);
+#endif
+PERL_CALLCONV void     Perl_pad_block_start(pTHX_ int full);
+PERL_CALLCONV void     Perl_pad_tidy(pTHX_ padtidy_type type);
+PERL_CALLCONV void     Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full);
+PERL_CALLCONV void     Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv);
+
+PERL_CALLCONV void     Perl_pad_push(pTHX_ PADLIST *padlist, int depth, int has_args);
+
+#if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT)
+STATIC PADOFFSET       S_pad_findlex(pTHX_ char* name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix, I32 saweval, U32 flags);
+#  if defined(DEBUGGING)
+STATIC void    S_cv_dump(pTHX_ CV *cv, char *title);
+#  endif
+STATIC CV*     S_cv_clone2(pTHX_ CV *proto, CV *outside);
+#endif
+
+
 
 END_EXTERN_C
 
diff --git a/scope.c b/scope.c
index 673b64c..a53c1c5 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -868,6 +868,15 @@ Perl_leave_scope(pTHX_ I32 base)
        case SAVEt_CLEARSV:
            ptr = (void*)&PL_curpad[SSPOPLONG];
            sv = *(SV**)ptr;
+
+           DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+               "Pad [0x%"UVxf"] clearsv: %ld sv=0x%"UVxf"<%"IVdf"> %s\n",
+               PTR2UV(PL_curpad), (long)((SV **)ptr-PL_curpad),
+               PTR2UV(sv),
+               (IV)SvREFCNT(sv),
+               (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) ? "clear" : "abandon"
+           ));
+
            /* Can clear pad variable in place? */
            if (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) {
                /*
@@ -1000,7 +1009,7 @@ Perl_leave_scope(pTHX_ I32 base)
                PADOFFSET off = (PADOFFSET)SSPOPLONG;
                ptr = SSPOPPTR;
                if (ptr)
-                   ((SV**)ptr)[off] = (SV*)SSPOPPTR;
+                   ((PAD)ptr)[off] = (SV*)SSPOPPTR;
            }
            break;
        default:
diff --git a/sv.c b/sv.c
index 78048c0..2017045 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -9573,15 +9573,7 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
        } else {
          CvDEPTH(dstr) = 0;
        }
-       if (CvPADLIST(sstr) && !AvREAL(CvPADLIST(sstr))) {
-           /* XXX padlists are real, but pretend to be not */
-           AvREAL_on(CvPADLIST(sstr));
-           CvPADLIST(dstr)     = av_dup_inc(CvPADLIST(sstr), param);
-           AvREAL_off(CvPADLIST(sstr));
-           AvREAL_off(CvPADLIST(dstr));
-       }
-       else
-           CvPADLIST(dstr)     = av_dup_inc(CvPADLIST(sstr), param);
+       PAD_DUP(CvPADLIST(dstr), CvPADLIST(sstr), param);
        if (!CvANON(sstr) || CvCLONED(sstr))
            CvOUTSIDE(dstr)     = cv_dup_inc(CvOUTSIDE(sstr), param);
        else
@@ -10390,12 +10382,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_rsfp_filters    = av_dup_inc(proto_perl->Irsfp_filters, param);
 
     PL_compcv                  = cv_dup(proto_perl->Icompcv, param);
-    PL_comppad                 = av_dup(proto_perl->Icomppad, param);
-    PL_comppad_name            = av_dup(proto_perl->Icomppad_name, param);
-    PL_comppad_name_fill       = proto_perl->Icomppad_name_fill;
-    PL_comppad_name_floor      = proto_perl->Icomppad_name_floor;
-    PL_curpad                  = (SV**)ptr_table_fetch(PL_ptr_table,
-                                                       proto_perl->Tcurpad);
+
+    PAD_CLONE_VARS(proto_perl, param);
 
 #ifdef HAVE_INTERP_INTERN
     sys_intern_dup(&proto_perl->Isys_intern, &PL_sys_intern);
@@ -10414,7 +10402,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_egid            = proto_perl->Iegid;
     PL_nomemok         = proto_perl->Inomemok;
     PL_an              = proto_perl->Ian;
-    PL_cop_seqmax      = proto_perl->Icop_seqmax;
     PL_op_seqmax       = proto_perl->Iop_seqmax;
     PL_evalseq         = proto_perl->Ievalseq;
     PL_origenviron     = proto_perl->Iorigenviron;     /* XXX not quite right */
@@ -10493,12 +10480,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_subline         = proto_perl->Isubline;
     PL_subname         = sv_dup_inc(proto_perl->Isubname, param);
 
-    PL_min_intro_pending       = proto_perl->Imin_intro_pending;
-    PL_max_intro_pending       = proto_perl->Imax_intro_pending;
-    PL_padix                   = proto_perl->Ipadix;
-    PL_padix_floor             = proto_perl->Ipadix_floor;
-    PL_pad_reset_pending       = proto_perl->Ipad_reset_pending;
-
     /* XXX See comment on SvANY(proto_perl->Ilinestr) above */
     if (SvANY(proto_perl->Ilinestr)) {
        i = proto_perl->Ilast_uni - SvPVX(proto_perl->Ilinestr);
diff --git a/toke.c b/toke.c
index c60a929..e747a2d 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -5257,14 +5257,14 @@ S_pending_ident(pTHX)
                 yyerror(Perl_form(aTHX_ "No package name allowed for "
                                   "variable %s in \"our\"",
                                   PL_tokenbuf));
-            tmp = pad_allocmy(PL_tokenbuf);
+            tmp = allocmy(PL_tokenbuf);
         }
         else {
             if (strchr(PL_tokenbuf,':'))
                 yyerror(Perl_form(aTHX_ PL_no_myglob,PL_tokenbuf));
 
             yylval.opval = newOP(OP_PADANY, 0);
-            yylval.opval->op_targ = pad_allocmy(PL_tokenbuf);
+            yylval.opval->op_targ = allocmy(PL_tokenbuf);
             return PRIVATEREF;
         }
     }
@@ -5294,11 +5294,10 @@ S_pending_ident(pTHX)
         }
 #endif /* USE_5005THREADS */
         if ((tmp = pad_findmy(PL_tokenbuf)) != NOT_IN_PAD) {
-            SV *namesv = AvARRAY(PL_comppad_name)[tmp];
             /* might be an "our" variable" */
-            if (SvFLAGS(namesv) & SVpad_OUR) {
+            if (PAD_COMPNAME_FLAGS(tmp) & SVpad_OUR) {
                 /* build ops for a bareword */
-                SV *sym = newSVpv(HvNAME(GvSTASH(namesv)),0);
+                SV *sym = newSVpv(HvNAME(PAD_COMPNAME_OURSTASH(tmp)), 0);
                 sv_catpvn(sym, "::", 2);
                 sv_catpv(sym, PL_tokenbuf+1);
                 yylval.opval = (OP*)newSVOP(OP_CONST, 0, sym);
@@ -6777,9 +6776,9 @@ S_scan_inputsymbol(pTHX_ char *start)
               add symbol table ops
            */
            if ((tmp = pad_findmy(d)) != NOT_IN_PAD) {
-               SV *namesv = AvARRAY(PL_comppad_name)[tmp];
-               if (SvFLAGS(namesv) & SVpad_OUR) {
-                   SV *sym = sv_2mortal(newSVpv(HvNAME(GvSTASH(namesv)),0));
+               if (PAD_COMPNAME_FLAGS(tmp) & SVpad_OUR) {
+                   SV *sym = sv_2mortal(
+                           newSVpv(HvNAME(PAD_COMPNAME_OURSTASH(tmp)),0));
                    sv_catpvn(sym, "::", 2);
                    sv_catpv(sym, d+1);
                    d = SvPVX(sym);
@@ -7557,46 +7556,20 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
 {
     I32 oldsavestack_ix = PL_savestack_ix;
     CV* outsidecv = PL_compcv;
-    AV* comppadlist;
 
     if (PL_compcv) {
        assert(SvTYPE(PL_compcv) == SVt_PVCV);
     }
     SAVEI32(PL_subline);
     save_item(PL_subname);
-    SAVEI32(PL_padix);
-    SAVECOMPPAD();
-    SAVESPTR(PL_comppad_name);
     SAVESPTR(PL_compcv);
-    SAVEI32(PL_comppad_name_fill);
-    SAVEI32(PL_min_intro_pending);
-    SAVEI32(PL_max_intro_pending);
-    SAVEI32(PL_pad_reset_pending);
 
     PL_compcv = (CV*)NEWSV(1104,0);
     sv_upgrade((SV *)PL_compcv, is_format ? SVt_PVFM : SVt_PVCV);
     CvFLAGS(PL_compcv) |= flags;
 
-    PL_comppad = newAV();
-    av_push(PL_comppad, Nullsv);
-    PL_curpad = AvARRAY(PL_comppad);
-    PL_comppad_name = newAV();
-    PL_comppad_name_fill = 0;
-    PL_min_intro_pending = 0;
-    PL_padix = 0;
     PL_subline = CopLINE(PL_curcop);
-#ifdef USE_5005THREADS
-    av_store(PL_comppad_name, 0, newSVpvn("@_", 2));
-    PL_curpad[0] = (SV*)newAV();
-    SvPADMY_on(PL_curpad[0]);  /* XXX Needed? */
-#endif /* USE_5005THREADS */
-
-    comppadlist = newAV();
-    AvREAL_off(comppadlist);
-    av_store(comppadlist, 0, (SV*)PL_comppad_name);
-    av_store(comppadlist, 1, (SV*)PL_comppad);
-
-    CvPADLIST(PL_compcv) = comppadlist;
+    CvPADLIST(PL_compcv) = pad_new(padnew_SAVE|padnew_SAVESUB);
     CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc(outsidecv);
 #ifdef USE_5005THREADS
     CvOWNER(PL_compcv) = 0;