APIify pad functions
authorZefram <zefram@fysh.org>
Sun, 12 Dec 2010 16:08:14 +0000 (16:08 +0000)
committerFather Chrysostomos <sprout@cpan.org>
Wed, 13 Jul 2011 04:46:51 +0000 (21:46 -0700)
Move several pad functions into the core API.  Document the pad
functions more consistently for perlapi.  Fix the interface issues
around delimitation of lexical variable names, providing _pvn, _pvs,
_pv, and _sv forms of pad_add_name and pad_findmy.

13 files changed:
embed.fnc
embed.h
ext/XS-APItest/APItest.xs
global.sym
op.c
pad.c
pad.h
perly.act
perly.h
perly.tab
perly.y
proto.h
toke.c

index ec97105..efb9d08 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -267,7 +267,6 @@ Afnp        |int    |printf_nocontext|NN const char *format|...
 p      |void   |cv_ckproto_len |NN const CV* cv|NULLOK const GV* gv\
                                |NULLOK const char* p|const STRLEN len
 : Used in pp.c and pp_sys.c
-pd     |CV*    |cv_clone       |NN CV* proto
 ApdR   |SV*    |gv_const_sv    |NN GV* gv
 ApdR   |SV*    |cv_const_sv    |NULLOK const CV *const cv
 : Used in pad.c
@@ -538,7 +537,6 @@ p   |void   |init_debugger
 Ap     |void   |init_stacks
 Ap     |void   |init_tm        |NN struct tm *ptm
 : Used in perly.y
-pd     |U32    |intro_my
 AnpPR  |char*  |instr          |NN const char* big|NN const char* little
 : Used in sv.c
 p      |bool   |io_close       |NN IO* io|bool not_implicit
@@ -900,32 +898,14 @@ p |void   |package        |NN OP* o
 #endif
 : Used in perly.y
 p      |void   |package_version|NN OP* v
-: Used in op.c
-pd     |PADOFFSET|pad_alloc    |I32 optype|U32 tmptype
 : Used in toke.c and perly.y
 p      |PADOFFSET|allocmy      |NN const char *const name|const STRLEN len\
                                |const U32 flags
-: Used in op.c and toke.c
-AMpdR  |PADOFFSET|pad_findmy   |NN const char* name|STRLEN len|U32 flags
-ApD    |PADOFFSET|find_rundefsvoffset  |
-: Used in pp.c
-Ap     |SV*    |find_rundefsv  |
 : Used in perly.y
 pR     |OP*    |oopsAV         |NN OP* o
 : Used in perly.y
 pR     |OP*    |oopsHV         |NN OP* o
-: Defined in pad.c, used only in op.c
-pd     |void   |pad_leavemy
-#ifdef DEBUGGING
-Apd    |SV*    |pad_sv         |PADOFFSET po
-#endif
-: Defined in pad.c, used only in op.c
-pd     |void   |pad_free       |PADOFFSET po
-#if defined(PERL_IN_PAD_C)
-sd     |void   |pad_reset
-#endif
-: Used in op.c
-pd     |void   |pad_swipe      |PADOFFSET po|bool refadjust
+
 : peephole optimiser
 p      |void   |peep           |NULLOK OP* o
 p      |void   |rpeep          |NULLOK OP* o
@@ -2132,51 +2112,67 @@ s       |void   |deb_stack_n    |NN SV** stack_base|I32 stack_min \
                                |I32 stack_max|I32 mark_min|I32 mark_max
 #endif
 
-: Used in perl.c, pp_ctl.c, toke.c
-pda    |PADLIST*|pad_new       |int flags
-: Only used in op.c
-Mpd    |PADOFFSET|pad_add_name |NN const char *name|const STRLEN len\
+: pad API
+#ifdef PERL_MAD
+Mnpd   |void   |pad_peg        |NN const char* s
+#endif
+Apda   |PADLIST*|pad_new       |int flags
+#if defined(PERL_IN_PAD_C)
+s      |PADOFFSET|pad_alloc_name|NN SV *namesv|U32 flags \
+                               |NULLOK HV *typestash|NULLOK HV *ourstash
+#endif
+Apd    |PADOFFSET|pad_add_name_pvn|NN const char *namepv|STRLEN namelen\
                                |const U32 flags|NULLOK HV *typestash\
                                |NULLOK HV *ourstash
-: Only used in op.c
-pd     |PADOFFSET|pad_add_anon |NN SV* sv|OPCODE op_type
+Apd    |PADOFFSET|pad_add_name_pv|NN const char *name\
+                               |const U32 flags|NULLOK HV *typestash\
+                               |NULLOK HV *ourstash
+Apd    |PADOFFSET|pad_add_name_sv|NN SV *name\
+                               |const U32 flags|NULLOK HV *typestash\
+                               |NULLOK HV *ourstash
+AMpd   |PADOFFSET|pad_alloc    |I32 optype|U32 tmptype
+Apd    |PADOFFSET|pad_add_anon |NN CV* func|I32 optype
 #if defined(PERL_IN_PAD_C)
-sd     |void   |pad_check_dup  |NN SV *name|const U32 flags \
-                               |NULLOK const HV *ourstash
+sd     |void   |pad_check_dup  |NN SV *name|U32 flags|NULLOK const HV *ourstash
+#endif
+ApdR   |PADOFFSET|pad_findmy_pvn|NN const char* namepv|STRLEN namelen|U32 flags
+ApdR   |PADOFFSET|pad_findmy_pv|NN const char* name|U32 flags
+ApdR   |PADOFFSET|pad_findmy_sv|NN SV* name|U32 flags
+ApdD   |PADOFFSET|find_rundefsvoffset  |
+Apd    |SV*    |find_rundefsv  |
+#if defined(PERL_IN_PAD_C)
+sd     |PADOFFSET|pad_findlex  |NN const char *namepv|STRLEN namelen\
+                               |NN const CV* cv|U32 seq|int warn \
+                               |NULLOK SV** out_capture|NN SV** out_name_sv \
+                               |NN int *out_flags
 #endif
 #ifdef DEBUGGING
-: Only used PAD_SETSV() in op.c
-pd     |void   |pad_setsv      |PADOFFSET po|NN SV* sv
+Apd    |SV*    |pad_sv         |PADOFFSET po
+Apd    |void   |pad_setsv      |PADOFFSET po|NN SV* sv
 #endif
-: Only used in op.c
 pd     |void   |pad_block_start|int full
-: Only used in op.c
-pd     |void   |pad_tidy       |padtidy_type type
-: Used in dump.c
-pd     |void   |do_dump_pad    |I32 level|NN PerlIO *file|NULLOK PADLIST *padlist|int full
-: Only used in op.c
-pd     |void   |pad_fixup_inner_anons|NN PADLIST *padlist|NN CV *old_cv|NN CV *new_cv
-
-: Used in pp_ctl.c, pp_hot.c, pp_sort.c
-pdX    |void   |pad_push       |NN PADLIST *padlist|int depth
-: Only used in PAD_COMPNAME_TYPE() in op.c
-pR     |HV*    |pad_compname_type|const PADOFFSET po
-: Used in sv.c
-#if defined(USE_ITHREADS)
-pR     |AV*    |padlist_dup    |NULLOK AV *const srcpad \
-                               |NN CLONE_PARAMS *const param
+pd     |U32    |intro_my
+pd     |void   |pad_leavemy
+pd     |void   |pad_swipe      |PADOFFSET po|bool refadjust
+#if defined(PERL_IN_PAD_C)
+sd     |void   |pad_reset
 #endif
-
+AMpd   |void   |pad_tidy       |padtidy_type type
+pd     |void   |pad_free       |PADOFFSET po
+pd     |void   |do_dump_pad    |I32 level|NN PerlIO *file|NULLOK PADLIST *padlist|int full
 #if defined(PERL_IN_PAD_C)
-sd     |PADOFFSET|pad_findlex  |NN const char *name|NN const CV* cv|U32 seq|int warn \
-                               |NULLOK SV** out_capture|NN SV** out_name_sv \
-                               |NN int *out_flags
-s      |PADOFFSET|pad_add_name_sv|NN SV *namesv|const U32 flags \
-                               |NULLOK HV *typestash|NULLOK HV *ourstash
 #  if defined(DEBUGGING)
 sd     |void   |cv_dump        |NN const CV *cv|NN const char *title
 #  endif
 #endif
+Apd    |CV*    |cv_clone       |NN CV* proto
+pd     |void   |pad_fixup_inner_anons|NN PADLIST *padlist|NN CV *old_cv|NN CV *new_cv
+pdX    |void   |pad_push       |NN PADLIST *padlist|int depth
+ApdR   |HV*    |pad_compname_type|const PADOFFSET po
+#if defined(USE_ITHREADS)
+pdR    |AV*    |padlist_dup    |NULLOK AV *srcpad|NN CLONE_PARAMS *param
+#endif
+
 ApdR   |CV*    |find_runcv     |NULLOK U32 *db_seqp
 : Only used in perl.c
 p      |void   |free_tied_hv_pool
@@ -2361,7 +2357,6 @@ Apno     |Size_t |my_strlcpy     |NULLOK char *dst|NULLOK const char *src|Size_t
 #endif
 
 #ifdef PERL_MAD
-Mnp    |void   |pad_peg        |NN const char* s
 #if defined(PERL_IN_DUMP_C)
 sf     |void   |xmldump_attr   |I32 level|NN PerlIO *file|NN const char* pat \
                                |...
diff --git a/embed.h b/embed.h
index a812200..6a828db 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -78,6 +78,7 @@
 #define croak_xs_usage(a,b)    Perl_croak_xs_usage(aTHX_ a,b)
 #define custom_op_desc(a)      Perl_custom_op_desc(aTHX_ a)
 #define custom_op_name(a)      Perl_custom_op_name(aTHX_ a)
+#define cv_clone(a)            Perl_cv_clone(aTHX_ a)
 #define cv_const_sv(a)         Perl_cv_const_sv(aTHX_ a)
 #define cv_get_call_checker(a,b,c)     Perl_cv_get_call_checker(aTHX_ a,b,c)
 #define cv_set_call_checker(a,b,c)     Perl_cv_set_call_checker(aTHX_ a,b,c)
 #define op_scope(a)            Perl_op_scope(aTHX_ a)
 #define pack_cat(a,b,c,d,e,f,g)        Perl_pack_cat(aTHX_ a,b,c,d,e,f,g)
 #define packlist(a,b,c,d,e)    Perl_packlist(aTHX_ a,b,c,d,e)
-#define pad_findmy(a,b,c)      Perl_pad_findmy(aTHX_ a,b,c)
+#define pad_add_anon(a,b)      Perl_pad_add_anon(aTHX_ a,b)
+#define pad_add_name_pv(a,b,c,d)       Perl_pad_add_name_pv(aTHX_ a,b,c,d)
+#define pad_add_name_pvn(a,b,c,d,e)    Perl_pad_add_name_pvn(aTHX_ a,b,c,d,e)
+#define pad_add_name_sv(a,b,c,d)       Perl_pad_add_name_sv(aTHX_ a,b,c,d)
+#define pad_alloc(a,b)         Perl_pad_alloc(aTHX_ a,b)
+#define pad_compname_type(a)   Perl_pad_compname_type(aTHX_ a)
+#define pad_findmy_pv(a,b)     Perl_pad_findmy_pv(aTHX_ a,b)
+#define pad_findmy_pvn(a,b,c)  Perl_pad_findmy_pvn(aTHX_ a,b,c)
+#define pad_findmy_sv(a,b)     Perl_pad_findmy_sv(aTHX_ a,b)
+#define pad_new(a)             Perl_pad_new(aTHX_ a)
+#define pad_tidy(a)            Perl_pad_tidy(aTHX_ a)
 #define parse_arithexpr(a)     Perl_parse_arithexpr(aTHX_ a)
 #define parse_barestmt(a)      Perl_parse_barestmt(aTHX_ a)
 #define parse_block(a)         Perl_parse_block(aTHX_ a)
 #define my_bcopy               Perl_my_bcopy
 #endif
 #if defined(DEBUGGING)
+#define pad_setsv(a,b)         Perl_pad_setsv(aTHX_ a,b)
 #define pad_sv(a)              Perl_pad_sv(aTHX_ a)
 #endif
 #if defined(DUMP_FDS)
 #define convert(a,b,c)         Perl_convert(aTHX_ a,b,c)
 #define create_eval_scope(a)   Perl_create_eval_scope(aTHX_ a)
 #define cv_ckproto_len(a,b,c,d)        Perl_cv_ckproto_len(aTHX_ a,b,c,d)
-#define cv_clone(a)            Perl_cv_clone(aTHX_ a)
 #define cvgv_set(a,b)          Perl_cvgv_set(aTHX_ a,b)
 #define cvstash_set(a,b)       Perl_cvstash_set(aTHX_ a,b)
 #define deb_stack_all()                Perl_deb_stack_all(aTHX)
 #define oopsHV(a)              Perl_oopsHV(aTHX_ a)
 #define op_const_sv(a,b)       Perl_op_const_sv(aTHX_ a,b)
 #define package_version(a)     Perl_package_version(aTHX_ a)
-#define pad_add_anon(a,b)      Perl_pad_add_anon(aTHX_ a,b)
-#define pad_add_name(a,b,c,d,e)        Perl_pad_add_name(aTHX_ a,b,c,d,e)
-#define pad_alloc(a,b)         Perl_pad_alloc(aTHX_ a,b)
 #define pad_block_start(a)     Perl_pad_block_start(aTHX_ a)
-#define pad_compname_type(a)   Perl_pad_compname_type(aTHX_ a)
 #define pad_fixup_inner_anons(a,b,c)   Perl_pad_fixup_inner_anons(aTHX_ a,b,c)
 #define pad_free(a)            Perl_pad_free(aTHX_ a)
 #define pad_leavemy()          Perl_pad_leavemy(aTHX)
-#define pad_new(a)             Perl_pad_new(aTHX_ a)
 #define pad_push(a,b)          Perl_pad_push(aTHX_ a,b)
 #define pad_swipe(a,b)         Perl_pad_swipe(aTHX_ a,b)
-#define pad_tidy(a)            Perl_pad_tidy(aTHX_ a)
 #define parse_unicode_opts(a)  Perl_parse_unicode_opts(aTHX_ a)
 #define parser_free(a)         Perl_parser_free(aTHX_ a)
 #define peep(a)                        Perl_peep(aTHX_ a)
 #  endif
 #  if defined(DEBUGGING)
 #define get_debug_opts(a,b)    Perl_get_debug_opts(aTHX_ a,b)
-#define pad_setsv(a,b)         Perl_pad_setsv(aTHX_ a,b)
 #    if defined(PERL_IN_PAD_C)
 #define cv_dump(a,b)           S_cv_dump(aTHX_ a,b)
 #    endif
 #define too_many_arguments(a,b)        S_too_many_arguments(aTHX_ a,b)
 #  endif
 #  if defined(PERL_IN_PAD_C)
-#define pad_add_name_sv(a,b,c,d)       S_pad_add_name_sv(aTHX_ a,b,c,d)
+#define pad_alloc_name(a,b,c,d)        S_pad_alloc_name(aTHX_ a,b,c,d)
 #define pad_check_dup(a,b,c)   S_pad_check_dup(aTHX_ a,b,c)
-#define pad_findlex(a,b,c,d,e,f,g)     S_pad_findlex(aTHX_ a,b,c,d,e,f,g)
+#define pad_findlex(a,b,c,d,e,f,g,h)   S_pad_findlex(aTHX_ a,b,c,d,e,f,g,h)
 #define pad_reset()            S_pad_reset(aTHX)
 #  endif
 #  if defined(PERL_IN_PERL_C)
index 68533da..0b3a6cb 100644 (file)
@@ -627,11 +627,7 @@ static OP *THX_parse_var(pTHX)
     }
     if(s-start < 2) croak("RPN syntax error");
     lex_read_to(s);
-    {
-       /* because pad_findmy() doesn't really use length yet */
-       SV *namesv = sv_2mortal(newSVpvn(start, s-start));
-       varpos = pad_findmy(SvPVX(namesv), s-start, 0);
-    }
+    varpos = pad_findmy_pvn(start, s-start, 0);
     if(varpos == NOT_IN_PAD || PAD_COMPNAME_FLAGS_isOUR(varpos))
        croak("RPN only supports \"my\" variables");
     padop = newOP(OP_PADSV, 0);
index 3d52f63..6e60f38 100644 (file)
@@ -73,6 +73,7 @@ Perl_custom_op_desc
 Perl_custom_op_name
 Perl_custom_op_register
 Perl_custom_op_xop
+Perl_cv_clone
 Perl_cv_const_sv
 Perl_cv_get_call_checker
 Perl_cv_set_call_checker
@@ -430,8 +431,18 @@ Perl_op_refcnt_unlock
 Perl_op_scope
 Perl_pack_cat
 Perl_packlist
-Perl_pad_findmy
+Perl_pad_add_anon
+Perl_pad_add_name_pv
+Perl_pad_add_name_pvn
+Perl_pad_add_name_sv
+Perl_pad_alloc
+Perl_pad_compname_type
+Perl_pad_findmy_pv
+Perl_pad_findmy_pvn
+Perl_pad_findmy_sv
+Perl_pad_new
 Perl_pad_push
+Perl_pad_tidy
 Perl_parse_arithexpr
 Perl_parse_barestmt
 Perl_parse_block
@@ -797,6 +808,7 @@ Perl_my_chsize
 Perl_my_sprintf
 Perl_my_bcopy
 Perl_hv_assert
+Perl_pad_setsv
 Perl_pad_sv
 Perl_dump_fds
 Perl_sys_intern_clear
diff --git a/op.c b/op.c
index 47ca0b2..c7743ed 100644 (file)
--- a/op.c
+++ b/op.c
@@ -415,7 +415,7 @@ Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags)
 
     /* allocate a spare slot and store the name in that slot */
 
-    off = pad_add_name(name, len,
+    off = pad_add_name_pvn(name, len,
                       is_our ? padadd_OUR :
                       PL_parser->in_my == KEY_state ? padadd_STATE : 0,
                    PL_parser->in_my_stash,
@@ -2450,7 +2450,7 @@ STATIC OP *
 S_newDEFSVOP(pTHX)
 {
     dVAR;
-    const PADOFFSET offset = Perl_pad_findmy(aTHX_ STR_WITH_LEN("$_"), 0);
+    const PADOFFSET offset = pad_findmy_pvs("$_", 0);
     if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS_isOUR(offset)) {
        return newSVREF(newGVOP(OP_GV, 0, PL_defgv));
     }
@@ -5589,7 +5589,7 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont)
        }
     }
     else {
-        const PADOFFSET offset = Perl_pad_findmy(aTHX_ STR_WITH_LEN("$_"), 0);
+        const PADOFFSET offset = pad_findmy_pvs("$_", 0);
        if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS_isOUR(offset)) {
            sv = newGVOP(OP_GV, 0, PL_defgv);
        }
@@ -6923,7 +6923,7 @@ Perl_ck_anoncode(pTHX_ OP *o)
 {
     PERL_ARGS_ASSERT_CK_ANONCODE;
 
-    cSVOPo->op_targ = pad_add_anon(cSVOPo->op_sv, o->op_type);
+    cSVOPo->op_targ = pad_add_anon((CV*)cSVOPo->op_sv, o->op_type);
     if (!PL_madskills)
        cSVOPo->op_sv = NULL;
     return o;
@@ -7761,7 +7761,7 @@ Perl_ck_grep(pTHX_ OP *o)
     gwop->op_flags |= OPf_KIDS;
     gwop->op_other = LINKLIST(kid);
     kid->op_next = (OP*)gwop;
-    offset = Perl_pad_findmy(aTHX_ STR_WITH_LEN("$_"), 0);
+    offset = pad_findmy_pvs("$_", 0);
     if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS_isOUR(offset)) {
        o->op_private = gwop->op_private = 0;
        gwop->op_targ = pad_alloc(type, SVs_PADTMP);
@@ -8011,7 +8011,7 @@ Perl_ck_match(pTHX_ OP *o)
     PERL_ARGS_ASSERT_CK_MATCH;
 
     if (o->op_type != OP_QR && PL_compcv) {
-       const PADOFFSET offset = Perl_pad_findmy(aTHX_ STR_WITH_LEN("$_"), 0);
+       const PADOFFSET offset = pad_findmy_pvs("$_", 0);
        if (offset != NOT_IN_PAD && !(PAD_COMPNAME_FLAGS_isOUR(offset))) {
            o->op_targ = offset;
            o->op_private |= OPpTARGET_MY;
diff --git a/pad.c b/pad.c
index b5ee2bf..c35d0a6 100644 (file)
--- a/pad.c
+++ b/pad.c
 /*
 =head1 Pad Data Structures
 
-This file contains the functions that create and manipulate scratchpads,
-which are array-of-array data structures attached to a CV (ie a sub)
-and which store lexical variables and opcode temporary and per-thread
-values.
+=for apidoc Amx|PADLIST *|CvPADLIST|CV *cv
 
-=for apidoc m|AV *|CvPADLIST|CV *cv
-CV's can have CvPADLIST(cv) set to point to an AV.
+CV's can have CvPADLIST(cv) set to point to an AV.  This is the CV's
+scratchpad, which stores lexical variables and opcode temporary and
+per-thread values.
 
 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
@@ -56,14 +54,6 @@ 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 to the names AV.
-C<PL_comppad> is set to the frame AV for the frame CvDEPTH == 1.
-C<PL_curpad> is set to the body of the frame AV (i.e. AvARRAY(PL_comppad)).
-
-During execution, C<PL_comppad> and C<PL_curpad> refer to the live
-frame of the currently executing sub.
-
 Iterating over the names AV iterates over all possible pad
 items. Pad slots that are SVs_PADTMP (targets/GVs/constants) end up having
 &PL_sv_undef "names" (see pad_alloc()).
@@ -119,6 +109,24 @@ to be generated in evals, such as
 
 For state vars, SVs_PADSTALE is overloaded to mean 'not yet initialised'
 
+=for apidoc AmxU|AV *|PL_comppad_name
+
+During compilation, this points to the array containing the names part
+of the pad for the currently-compiling code.
+
+=for apidoc AmxU|AV *|PL_comppad
+
+During compilation, this points to the array containing the values
+part of the pad for the currently-compiling code.  (At runtime a CV may
+have many such value arrays; at compile time just one is constructed.)
+At runtime, this points to the array containing the currently-relevant
+values for the pad for the currently-executing code.
+
+=for apidoc AmxU|SV **|PL_curpad
+
+Points directly to the body of the L</PL_comppad> array.
+(I.e., this is C<AvARRAY(PL_comppad)>.)
+
 =cut
 */
 
@@ -138,6 +146,17 @@ For state vars, SVs_PADSTALE is overloaded to mean 'not yet initialised'
 #define PARENT_FAKELEX_FLAGS_set(sv,val)       \
   STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xhigh = (val); } STMT_END
 
+/*
+=for apidoc mx|void|pad_peg|const char *s
+
+When PERL_MAD is enabled, this is a small no-op function that gets called
+at the start of each pad-related function.  It can be breakpointed to
+track all pad operations.  The parameter is a string indicating the type
+of pad operation being performed.
+
+=cut
+*/
+
 #ifdef PERL_MAD
 void pad_peg(const char* s) {
     static int pegcnt; /* XXX not threadsafe */
@@ -150,14 +169,14 @@ void pad_peg(const char* s) {
 #endif
 
 /*
-=for apidoc pad_new
+=for apidoc Am|PADLIST *|pad_new|int flags
 
-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:
+Create a new padlist, updating the global variables for the
+currently-compiling padlist to point to the new padlist.  The following
+flags can be OR'ed together:
 
     padnew_CLONE       this pad is for a cloned CV
-    padnew_SAVE                save old globals
+    padnew_SAVE                save old globals on the save stack
     padnew_SAVESUB     also save extra stuff for start of sub
 
 =cut
@@ -410,16 +429,28 @@ Perl_cv_undef(pTHX_ CV *cv)
     CvFLAGS(cv) &= (CVf_WEAKOUTSIDE|CVf_CVGV_RC);
 }
 
+/*
+=for apidoc m|PADOFFSET|pad_alloc_name|SV *namesv|U32 flags|HV *typestash|HV *ourstash
+
+Allocates a place in the currently-compiling pad (via L</pad_alloc>) and
+then stores a name for that entry.  I<namesv> is adopted and becomes the
+name entry; it must already contain the name string and be sufficiently
+upgraded.  I<typestash> and I<ourstash> and the C<padadd_STATE> flag get
+added to I<namesv>.  None of the other processing of L</pad_add_name_pvn>
+is done.  Returns the offset of the allocated pad slot.
+
+=cut
+*/
+
 static PADOFFSET
-S_pad_add_name_sv(pTHX_ SV *namesv, const U32 flags, HV *typestash,
-                 HV *ourstash)
+S_pad_alloc_name(pTHX_ SV *namesv, U32 flags, HV *typestash, HV *ourstash)
 {
     dVAR;
     const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
 
-    PERL_ARGS_ASSERT_PAD_ADD_NAME_SV;
+    PERL_ARGS_ASSERT_PAD_ALLOC_NAME;
 
-    ASSERT_CURPAD_ACTIVE("pad_add_name");
+    ASSERT_CURPAD_ACTIVE("pad_alloc_name");
 
     if (typestash) {
        assert(SvTYPE(namesv) == SVt_PVMG);
@@ -440,49 +471,49 @@ S_pad_add_name_sv(pTHX_ SV *namesv, const U32 flags, HV *typestash,
 }
 
 /*
-=for apidoc pad_add_name
+=for apidoc Am|PADOFFSET|pad_add_name_pvn|const char *namepv|STRLEN namelen|U32 flags|HV *typestash|HV *ourstash
 
-Create a new name and associated PADMY SV in the current pad; return the
-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
-SvOURSTASH to that value
+Allocates a place in the currently-compiling pad for a named lexical
+variable.  Stores the name and other metadata in the name part of the
+pad, and makes preparations to manage the variable's lexical scoping.
+Returns the offset of the allocated pad slot.
 
-If fake, it means we're cloning an existing entry
+I<namepv>/I<namelen> specify the variable's name, including leading sigil.
+If I<typestash> is non-null, the name is for a typed lexical, and this
+identifies the type.  If I<ourstash> is non-null, it's a lexical reference
+to a package variable, and this identifies the package.  The following
+flags can be OR'ed together:
+
+    padadd_OUR          redundantly specifies if it's a package var
+    padadd_STATE        variable will retain value persistently
+    padadd_NO_DUP_CHECK skip check for lexical shadowing
 
 =cut
 */
 
 PADOFFSET
-Perl_pad_add_name(pTHX_ const char *name, const STRLEN len, const U32 flags,
-                 HV *typestash, HV *ourstash)
+Perl_pad_add_name_pvn(pTHX_ const char *namepv, STRLEN namelen,
+               U32 flags, HV *typestash, HV *ourstash)
 {
     dVAR;
     PADOFFSET offset;
     SV *namesv;
 
-    PERL_ARGS_ASSERT_PAD_ADD_NAME;
+    PERL_ARGS_ASSERT_PAD_ADD_NAME_PVN;
 
     if (flags & ~(padadd_OUR|padadd_STATE|padadd_NO_DUP_CHECK))
-       Perl_croak(aTHX_ "panic: pad_add_name illegal flag bits 0x%" UVxf,
+       Perl_croak(aTHX_ "panic: pad_add_name_pvn illegal flag bits 0x%" UVxf,
                   (UV)flags);
 
     namesv = newSV_type((ourstash || typestash) ? SVt_PVMG : SVt_PVNV);
-
-    /* Until we're using the length for real, cross check that we're being told
-       the truth.  */
-    PERL_UNUSED_ARG(len);
-    assert(strlen(name) == len);
-
-    sv_setpv(namesv, name);
+    sv_setpvn(namesv, namepv, namelen);
 
     if ((flags & padadd_NO_DUP_CHECK) == 0) {
        /* check for duplicate declaration */
        pad_check_dup(namesv, flags & padadd_OUR, ourstash);
     }
 
-    offset = pad_add_name_sv(namesv, flags, typestash, ourstash);
+    offset = pad_alloc_name(namesv, flags, typestash, ourstash);
 
     /* not yet introduced */
     COP_SEQ_RANGE_LOW_set(namesv, PERL_PADSEQ_INTRO);
@@ -494,27 +525,70 @@ Perl_pad_add_name(pTHX_ const char *name, const STRLEN len, const U32 flags,
     /* if it's not a simple scalar, replace with an AV or HV */
     assert(SvTYPE(PL_curpad[offset]) == SVt_NULL);
     assert(SvREFCNT(PL_curpad[offset]) == 1);
-    if (*name == '@')
+    if (namelen != 0 && *namepv == '@')
        sv_upgrade(PL_curpad[offset], SVt_PVAV);
-    else if (*name == '%')
+    else if (namelen != 0 && *namepv == '%')
        sv_upgrade(PL_curpad[offset], SVt_PVHV);
     assert(SvPADMY(PL_curpad[offset]));
     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
                           "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
-                          (long)offset, name, PTR2UV(PL_curpad[offset])));
+                          (long)offset, SvPVX(namesv),
+                          PTR2UV(PL_curpad[offset])));
 
     return offset;
 }
 
+/*
+=for apidoc Am|PADOFFSET|pad_add_name_pv|const char *name|U32 flags|HV *typestash|HV *ourstash
 
+Exactly like L</pad_add_name_pvn>, but takes a nul-terminated string
+instead of a string/length pair.
 
+=cut
+*/
+
+PADOFFSET
+Perl_pad_add_name_pv(pTHX_ const char *name,
+               U32 flags, HV *typestash, HV *ourstash)
+{
+    PERL_ARGS_ASSERT_PAD_ADD_NAME_PV;
+    return pad_add_name_pvn(name, strlen(name), flags, typestash, ourstash);
+}
 
 /*
-=for apidoc pad_alloc
+=for apidoc Am|PADOFFSET|pad_add_name_sv|SV *name|U32 flags|HV *typestash|HV *ourstash
 
-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 no active value.
+Exactly like L</pad_add_name_pvn>, but takes the name string in the form
+of an SV instead of a string/length pair.
+
+=cut
+*/
+
+PADOFFSET
+Perl_pad_add_name_sv(pTHX_ SV *name, U32 flags, HV *typestash, HV *ourstash)
+{
+    char *namepv;
+    STRLEN namelen;
+    PERL_ARGS_ASSERT_PAD_ADD_NAME_SV;
+    namepv = SvPV(name, namelen);
+    return pad_add_name_pvn(namepv, namelen, flags, typestash, ourstash);
+}
+
+/*
+=for apidoc Amx|PADOFFSET|pad_alloc|I32 optype|U32 tmptype
+
+Allocates a place in the currently-compiling pad,
+returning the offset of the allocated pad slot.
+No name is initially attached to the pad slot.
+I<tmptype> is a set of flags indicating the kind of pad entry required,
+which will be set in the value SV for the allocated pad entry:
+
+    SVs_PADMY    named lexical variable ("my", "our", "state")
+    SVs_PADTMP   unnamed temporary store
+
+I<optype> should be an opcode indicating the type of operation that the
+pad entry is to support.  This doesn't affect operational semantics,
+but is used for debugging.
 
 =cut
 */
@@ -542,10 +616,14 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
     if (PL_pad_reset_pending)
        pad_reset();
     if (tmptype & SVs_PADMY) {
+       /* For a my, simply push a null SV onto the end of PL_comppad. */
        sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE);
        retval = AvFILLp(PL_comppad);
     }
     else {
+       /* For a tmp, scan the pad from PL_padix upwards
+        * for a slot which has no name and no active value.
+        */
        SV * const * const names = AvARRAY(PL_comppad_name);
         const SSize_t names_fill = AvFILLp(PL_comppad_name);
        for (;;) {
@@ -580,15 +658,23 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
 }
 
 /*
-=for apidoc pad_add_anon
+=for apidoc Am|PADOFFSET|pad_add_anon|CV *func|I32 optype
 
-Add an anon code entry to the current compiling pad
+Allocates a place in the currently-compiling pad (via L</pad_alloc>)
+for an anonymous function that is lexically scoped inside the
+currently-compiling function.
+The function I<func> is linked into the pad, and its C<CvOUTSIDE> link
+to the outer scope is weakened to avoid a reference loop.
+
+I<optype> should be an opcode indicating the type of operation that the
+pad entry is to support.  This doesn't affect operational semantics,
+but is used for debugging.
 
 =cut
 */
 
 PADOFFSET
-Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
+Perl_pad_add_anon(pTHX_ CV* func, I32 optype)
 {
     dVAR;
     PADOFFSET ix;
@@ -602,26 +688,24 @@ Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
      * PERL_PADSEQ_INTRO */
     COP_SEQ_RANGE_LOW_set(name, 0);
     COP_SEQ_RANGE_HIGH_set(name, 0);
-    ix = pad_alloc(op_type, SVs_PADMY);
+    ix = pad_alloc(optype, SVs_PADMY);
     av_store(PL_comppad_name, ix, name);
     /* XXX DAPM use PL_curpad[] ? */
-    av_store(PL_comppad, ix, sv);
-    SvPADMY_on(sv);
+    av_store(PL_comppad, ix, (SV*)func);
+    SvPADMY_on((SV*)func);
 
     /* to avoid ref loops, we never have parent + child referencing each
      * other simultaneously */
-    if (CvOUTSIDE((const CV *)sv)) {
-       assert(!CvWEAKOUTSIDE((const CV *)sv));
-       CvWEAKOUTSIDE_on(MUTABLE_CV(sv));
-       SvREFCNT_dec(CvOUTSIDE(MUTABLE_CV(sv)));
+    if (CvOUTSIDE(func)) {
+       assert(!CvWEAKOUTSIDE(func));
+       CvWEAKOUTSIDE_on(func);
+       SvREFCNT_dec(CvOUTSIDE(func));
     }
     return ix;
 }
 
-
-
 /*
-=for apidoc pad_check_dup
+=for apidoc m|pad_check_dup|SV *name|U32 flags|const HV *ourstash
 
 Check for duplicate declarations: report any of:
      * a my in the current scope with the same name;
@@ -633,7 +717,7 @@ C<is_our> indicates that the name to check is an 'our' declaration
 */
 
 STATIC void
-S_pad_check_dup(pTHX_ SV *name, const U32 flags, const HV *ourstash)
+S_pad_check_dup(pTHX_ SV *name, U32 flags, const HV *ourstash)
 {
     dVAR;
     SV         **svp;
@@ -701,19 +785,22 @@ S_pad_check_dup(pTHX_ SV *name, const U32 flags, const HV *ourstash)
 
 
 /*
-=for apidoc pad_findmy
+=for apidoc Am|PADOFFSET|pad_findmy_pvn|const char *namepv|STRLEN namelen|U32 flags
 
-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.
+Given the name of a lexical variable, find its position in the
+currently-compiling pad.
+I<namepv>/I<namelen> specify the variable's name, including leading sigil.
+I<flags> is reserved and must be zero.
+If it is not in the current pad but appears in the pad of any lexically
+enclosing scope, then a pseudo-entry for it is added in the current pad.
+Returns the offset in the current pad,
+or C<NOT_IN_PAD> if no such lexical is in scope.
 
 =cut
 */
 
 PADOFFSET
-Perl_pad_findmy(pTHX_ const char *name, STRLEN len, U32 flags)
+Perl_pad_findmy_pvn(pTHX_ const char *namepv, STRLEN namelen, U32 flags)
 {
     dVAR;
     SV *out_sv;
@@ -722,26 +809,15 @@ Perl_pad_findmy(pTHX_ const char *name, STRLEN len, U32 flags)
     const AV *nameav;
     SV **name_svp;
 
-    PERL_ARGS_ASSERT_PAD_FINDMY;
+    PERL_ARGS_ASSERT_PAD_FINDMY_PVN;
 
-    pad_peg("pad_findmy");
+    pad_peg("pad_findmy_pvn");
 
     if (flags)
-       Perl_croak(aTHX_ "panic: pad_findmy illegal flag bits 0x%" UVxf,
+       Perl_croak(aTHX_ "panic: pad_findmy_pvn illegal flag bits 0x%" UVxf,
                   (UV)flags);
 
-    /* Yes, it is a bug (read work in progress) that we're not really using this
-       length parameter, and instead relying on strlen() later on. But I'm not
-       comfortable about changing the pad API piecemeal to use and rely on
-       lengths. This only exists to avoid an "unused parameter" warning.  */
-    if (len < 2) 
-       return NOT_IN_PAD;
-
-    /* But until we're using the length for real, cross check that we're being
-       told the truth.  */
-    assert(strlen(name) == len);
-
-    offset = pad_findlex(name, PL_compcv, PL_cop_seqmax, 1,
+    offset = pad_findlex(namepv, namelen, PL_compcv, PL_cop_seqmax, 1,
                NULL, &out_sv, &out_flags);
     if ((PADOFFSET)offset != NOT_IN_PAD) 
        return offset;
@@ -757,7 +833,8 @@ Perl_pad_findmy(pTHX_ const char *name, STRLEN len, U32 flags)
        if (namesv && namesv != &PL_sv_undef
            && !SvFAKE(namesv)
            && (SvPAD_OUR(namesv))
-           && strEQ(SvPVX_const(namesv), name)
+           && SvCUR(namesv) == namelen
+           && memEQ(SvPVX_const(namesv), namepv, namelen)
            && COP_SEQ_RANGE_LOW(namesv) == PERL_PADSEQ_INTRO
        )
            return offset;
@@ -766,9 +843,51 @@ Perl_pad_findmy(pTHX_ const char *name, STRLEN len, U32 flags)
 }
 
 /*
- * Returns the offset of a lexical $_, if there is one, at run time.
- * Used by the UNDERBAR XS macro.
- */
+=for apidoc Am|PADOFFSET|pad_findmy_pv|const char *name|U32 flags
+
+Exactly like L</pad_findmy_pvn>, but takes a nul-terminated string
+instead of a string/length pair.
+
+=cut
+*/
+
+PADOFFSET
+Perl_pad_findmy_pv(pTHX_ const char *name, U32 flags)
+{
+    PERL_ARGS_ASSERT_PAD_FINDMY_PV;
+    return pad_findmy_pvn(name, strlen(name), flags);
+}
+
+/*
+=for apidoc Am|PADOFFSET|pad_findmy_sv|SV *name|U32 flags
+
+Exactly like L</pad_findmy_pvn>, but takes the name string in the form
+of an SV instead of a string/length pair.
+
+=cut
+*/
+
+PADOFFSET
+Perl_pad_findmy_sv(pTHX_ SV *name, U32 flags)
+{
+    char *namepv;
+    STRLEN namelen;
+    PERL_ARGS_ASSERT_PAD_FINDMY_SV;
+    namepv = SvPV(name, namelen);
+    return pad_findmy_pvn(namepv, namelen, flags);
+}
+
+/*
+=for apidoc Amp|PADOFFSET|find_rundefsvoffset
+
+Find the position of the lexical C<$_> in the pad of the
+currently-executing function.  Returns the offset in the current pad,
+or C<NOT_IN_PAD> if there is no lexical C<$_> in scope (in which case
+the global one should be used instead).
+L</find_rundefsv> is likely to be more convenient.
+
+=cut
+*/
 
 PADOFFSET
 Perl_find_rundefsvoffset(pTHX)
@@ -776,14 +895,19 @@ Perl_find_rundefsvoffset(pTHX)
     dVAR;
     SV *out_sv;
     int out_flags;
-    return pad_findlex("$_", find_runcv(NULL), PL_curcop->cop_seq, 1,
+    return pad_findlex("$_", 2, find_runcv(NULL), PL_curcop->cop_seq, 1,
            NULL, &out_sv, &out_flags);
 }
 
 /*
- * Returns a lexical $_, if there is one, at run time ; or the global one
- * otherwise.
- */
+=for apidoc Am|SV *|find_rundefsv
+
+Find and return the variable that is named C<$_> in the lexical scope
+of the currently-executing function.  This may be a lexical C<$_>,
+or will otherwise be the global one.
+
+=cut
+*/
 
 SV *
 Perl_find_rundefsv(pTHX)
@@ -792,7 +916,7 @@ Perl_find_rundefsv(pTHX)
     int flags;
     PADOFFSET po;
 
-    po = pad_findlex("$_", find_runcv(NULL), PL_curcop->cop_seq, 1,
+    po = pad_findlex("$_", 2, find_runcv(NULL), PL_curcop->cop_seq, 1,
            NULL, &namesv, &flags);
 
     if (po == NOT_IN_PAD || SvPAD_OUR(namesv))
@@ -802,7 +926,7 @@ Perl_find_rundefsv(pTHX)
 }
 
 /*
-=for apidoc pad_findlex
+=for apidoc m|PADOFFSET|pad_findlex|const char *namepv|STRLEN namelen|const CV* cv|U32 seq|int warn|SV** out_capture|SV** out_name_sv|int *out_flags
 
 Find a named lexical anywhere in a chain of nested pads. Add fake entries
 in the inner pads if it's found in an outer one.
@@ -833,8 +957,8 @@ the parent pad.
 
 
 STATIC PADOFFSET
-S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
-       SV** out_capture, SV** out_name_sv, int *out_flags)
+S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, const CV* cv, U32 seq,
+       int warn, SV** out_capture, SV** out_name_sv, int *out_flags)
 {
     dVAR;
     I32 offset, new_offset;
@@ -847,8 +971,9 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
     *out_flags = 0;
 
     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
-       "Pad findlex cv=0x%"UVxf" searching \"%s\" seq=%d%s\n",
-       PTR2UV(cv), name, (int)seq, out_capture ? " capturing" : "" ));
+       "Pad findlex cv=0x%"UVxf" searching \"%.*s\" seq=%d%s\n",
+       PTR2UV(cv), namelen, namepv, (int)seq,
+       out_capture ? " capturing" : "" ));
 
     /* first, search this pad */
 
@@ -860,7 +985,8 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
        for (offset = AvFILLp(nameav); offset > 0; offset--) {
             const SV * const namesv = name_svp[offset];
            if (namesv && namesv != &PL_sv_undef
-                   && strEQ(SvPVX_const(namesv), name))
+                   && SvCUR(namesv) == namelen
+                   && memEQ(SvPVX_const(namesv), namepv, namelen))
            {
                if (SvFAKE(namesv)) {
                    fake_offset = offset; /* in case we don't find a real one */
@@ -945,7 +1071,8 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
                {
                    if (warn)
                        Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
-                                      "Variable \"%s\" is not available", name);
+                                      "Variable \"%.*s\" is not available",
+                                      namelen, namepv);
                    *out_capture = NULL;
                }
 
@@ -957,7 +1084,8 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
                         && warn && ckWARN(WARN_CLOSURE)) {
                        newwarn = 0;
                        Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
-                           "Variable \"%s\" will not stay shared", name);
+                           "Variable \"%.*s\" will not stay shared",
+                           namelen, namepv);
                    }
 
                    if (fake_offset && CvANON(cv)
@@ -969,7 +1097,7 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
                            "Pad findlex cv=0x%"UVxf" chasing lex in outer pad\n",
                            PTR2UV(cv)));
                        n = *out_name_sv;
-                       (void) pad_findlex(name, CvOUTSIDE(cv),
+                       (void) pad_findlex(namepv, namelen, CvOUTSIDE(cv),
                            CvOUTSIDE_SEQ(cv),
                            newwarn, out_capture, out_name_sv, out_flags);
                        *out_name_sv = n;
@@ -986,14 +1114,15 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
                        && !SvPAD_STATE(name_svp[offset]))
                    {
                        Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
-                                      "Variable \"%s\" is not available", name);
+                                      "Variable \"%.*s\" is not available",
+                                      namelen, namepv);
                        *out_capture = NULL;
                    }
                }
                if (!*out_capture) {
-                   if (*name == '@')
+                   if (namelen != 0 && *namepv == '@')
                        *out_capture = sv_2mortal(MUTABLE_SV(newAV()));
-                   else if (*name == '%')
+                   else if (namelen != 0 && *namepv == '%')
                        *out_capture = sv_2mortal(MUTABLE_SV(newHV()));
                    else
                        *out_capture = sv_newmortal();
@@ -1014,7 +1143,7 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
     new_capturep = out_capture ? out_capture :
                CvLATE(cv) ? NULL : &new_capture;
 
-    offset = pad_findlex(name, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1,
+    offset = pad_findlex(namepv, namelen, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1,
                new_capturep, out_name_sv, out_flags);
     if ((PADOFFSET)offset == NOT_IN_PAD)
        return NOT_IN_PAD;
@@ -1039,7 +1168,7 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
        PL_curpad = AvARRAY(PL_comppad);
 
        new_offset
-           = pad_add_name_sv(new_namesv,
+           = pad_alloc_name(new_namesv,
                              (SvPAD_STATE(*out_name_sv) ? padadd_STATE : 0),
                              SvPAD_TYPED(*out_name_sv)
                              ? SvSTASH(*out_name_sv) : NULL,
@@ -1079,18 +1208,17 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
     return new_offset;
 }
 
-
 #ifdef DEBUGGING
+
 /*
-=for apidoc pad_sv
+=for apidoc Am|SV *|pad_sv|PADOFFSET po
 
-Get the value at offset po in the current pad.
+Get the value at offset I<po> in the current (compiling or executing) pad.
 Use macro PAD_SV instead of calling this function directly.
 
 =cut
 */
 
-
 SV *
 Perl_pad_sv(pTHX_ PADOFFSET po)
 {
@@ -1106,11 +1234,10 @@ Perl_pad_sv(pTHX_ PADOFFSET po)
     return PL_curpad[po];
 }
 
-
 /*
-=for apidoc pad_setsv
+=for apidoc Am|void|pad_setsv|PADOFFSET po|SV *sv
 
-Set the entry at offset po in the current pad to sv.
+Set the value at offset I<po> in the current (compiling or executing) pad.
 Use the macro PAD_SETSV() rather than calling this function directly.
 
 =cut
@@ -1131,12 +1258,11 @@ Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
     );
     PL_curpad[po] = sv;
 }
-#endif
-
 
+#endif /* DEBUGGING */
 
 /*
-=for apidoc pad_block_start
+=for apidoc m|void|pad_block_start|int full
 
 Update the pad compilation state variables on entry to a new block
 
@@ -1169,9 +1295,8 @@ Perl_pad_block_start(pTHX_ int full)
     PL_pad_reset_pending = FALSE;
 }
 
-
 /*
-=for apidoc intro_my
+=for apidoc m|U32|intro_my
 
 "Introduce" my variables to visible status.
 
@@ -1220,7 +1345,7 @@ Perl_intro_my(pTHX)
 }
 
 /*
-=for apidoc pad_leavemy
+=for apidoc m|void|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.
@@ -1269,9 +1394,8 @@ Perl_pad_leavemy(pTHX)
            "Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax));
 }
 
-
 /*
-=for apidoc pad_swipe
+=for apidoc m|void|pad_swipe|PADOFFSET po|bool refadjust
 
 Abandon the tmp in the current pad at offset po and replace with a
 new one.
@@ -1313,9 +1437,8 @@ Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
        PL_padix = po - 1;
 }
 
-
 /*
-=for apidoc pad_reset
+=for apidoc m|void|pad_reset
 
 Mark all the current temporaries for reuse
 
@@ -1355,14 +1478,17 @@ S_pad_reset(pTHX)
     PL_pad_reset_pending = FALSE;
 }
 
-
 /*
-=for apidoc pad_tidy
+=for apidoc Amx|void|pad_tidy|padtidy_type type
+
+Tidy up a pad at the end of compilation of the code to which it belongs.
+Jobs performed here are: remove most stuff from the pads of anonsub
+prototypes; give it a @_; mark temporaries as such.  I<type> indicates
+the kind of subroutine:
 
-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.
+    padtidy_SUB        ordinary subroutine
+    padtidy_SUBCLONE   prototype for lexical closure
+    padtidy_FORMAT     format
 
 =cut
 */
@@ -1467,9 +1593,8 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
     PL_curpad = AvARRAY(PL_comppad);
 }
 
-
 /*
-=for apidoc pad_free
+=for apidoc m|void|pad_free|PADOFFSET po
 
 Free the SV at offset po in the current pad.
 
@@ -1501,10 +1626,8 @@ Perl_pad_free(pTHX_ PADOFFSET po)
        PL_padix = po - 1;
 }
 
-
-
 /*
-=for apidoc do_dump_pad
+=for apidoc m|void|do_dump_pad|I32 level|PerlIO *file|PADLIST *padlist|int full
 
 Dump the contents of a padlist
 
@@ -1574,17 +1697,16 @@ Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
     }
 }
 
-
+#ifdef DEBUGGING
 
 /*
-=for apidoc cv_dump
+=for apidoc m|void|cv_dump|CV *cv|const char *title
 
 dump the contents of a CV
 
 =cut
 */
 
-#ifdef DEBUGGING
 STATIC void
 S_cv_dump(pTHX_ const CV *cv, const char *title)
 {
@@ -1614,18 +1736,17 @@ S_cv_dump(pTHX_ const CV *cv, const char *title)
                    "    PADLIST = 0x%"UVxf"\n", PTR2UV(padlist));
     do_dump_pad(1, Perl_debug_log, padlist, 1);
 }
-#endif /* DEBUGGING */
-
-
-
 
+#endif /* DEBUGGING */
 
 /*
-=for apidoc cv_clone
+=for apidoc Am|CV *|cv_clone|CV *proto
 
-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.
+Clone a CV, making a lexical closure.  I<proto> supplies the prototype
+of the function: its code, pad structure, and other attributes.
+The prototype is combined with a capture of outer lexicals to which the
+code refers, which are taken from the currently-executing instance of
+the immediately surrounding code.
 
 =cut
 */
@@ -1771,9 +1892,8 @@ Perl_cv_clone(pTHX_ CV *proto)
     return cv;
 }
 
-
 /*
-=for apidoc pad_fixup_inner_anons
+=for apidoc m|void|pad_fixup_inner_anons|PADLIST *padlist|CV *old_cv|CV *new_cv
 
 For any anon CVs in the pad, change CvOUTSIDE of that CV from
 old_cv to new_cv if necessary. Needed when a newly-compiled CV has to be
@@ -1808,9 +1928,8 @@ Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
     }
 }
 
-
 /*
-=for apidoc pad_push
+=for apidoc m|void|pad_push|PADLIST *padlist|int depth
 
 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.  Then give
@@ -1876,6 +1995,15 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
     }
 }
 
+/*
+=for apidoc Am|HV *|pad_compname_type|PADOFFSET po
+
+Looks up the type of the lexical variable at position I<po> in the
+currently-compiling pad.  If the variable is typed, the stash of the
+class to which it is typed is returned.  If not, C<NULL> is returned.
+
+=cut
+*/
 
 HV *
 Perl_pad_compname_type(pTHX_ const PADOFFSET po)
@@ -1892,8 +2020,16 @@ Perl_pad_compname_type(pTHX_ const PADOFFSET po)
 
 #  define av_dup_inc(s,t)      MUTABLE_AV(sv_dup_inc((const SV *)s,t))
 
+/*
+=for apidoc m|AV *|padlist_dup|AV *srcpad|CLONE_PARAMS *param
+
+Duplicates a pad.
+
+=cut
+*/
+
 AV *
-Perl_padlist_dup(pTHX_ AV *const srcpad, CLONE_PARAMS *const param)
+Perl_padlist_dup(pTHX_ AV *srcpad, CLONE_PARAMS *param)
 {
     AV *dstpad;
     PERL_ARGS_ASSERT_PADLIST_DUP;
@@ -2009,7 +2145,7 @@ Perl_padlist_dup(pTHX_ AV *const srcpad, CLONE_PARAMS *const param)
     return dstpad;
 }
 
-#endif
+#endif /* USE_ITHREADS */
 
 /*
  * Local variables:
diff --git a/pad.h b/pad.h
index 7e130d8..8c3d76d 100644 (file)
--- a/pad.h
+++ b/pad.h
@@ -10,7 +10,9 @@
  * variables, op targets and constants.
  */
 
-
+/*
+=head1 Pad Data Structures
+*/
 
 
 /* a padlist is currently just an AV; but that might change,
@@ -118,15 +120,11 @@ typedef enum {
        padtidy_FORMAT          /* or a format */
 } padtidy_type;
 
-#ifdef PERL_CORE
-
-/* flags for pad_add_name. SVf_UTF8 will also be valid in the future.  */
-
-#  define padadd_OUR           0x01    /* our declaration. */
-#  define padadd_STATE         0x02    /* state declaration. */
-#  define padadd_NO_DUP_CHECK  0x04    /* skip warning on dups. */
+/* flags for pad_add_name_pvn. SVf_UTF8 will also be valid in the future.  */
 
-#endif
+#define padadd_OUR             0x01    /* our declaration. */
+#define padadd_STATE           0x02    /* state declaration. */
+#define padadd_NO_DUP_CHECK    0x04    /* skip warning on dups. */
 
 /* ASSERT_CURPAD_LEGAL and ASSERT_CURPAD_ACTIVE respectively determine
  * whether PL_comppad and PL_curpad are consistent and whether they have
@@ -365,6 +363,30 @@ Clone the state variables associated with running and compiling pads.
     PL_pad_reset_pending       = proto_perl->Ipad_reset_pending;       \
     PL_cop_seqmax              = proto_perl->Icop_seqmax;
 
+/*
+=for apidoc Am|PADOFFSET|pad_add_name_pvs|const char *name|U32 flags|HV *typestash|HV *ourstash
+
+Exactly like L</pad_add_name_pvn>, but takes a literal string instead
+of a string/length pair.
+
+=cut
+*/
+
+#define pad_add_name_pvs(name,flags,typestash,ourstash) \
+    Perl_pad_add_name_pvn(aTHX_ STR_WITH_LEN(name), flags, typestash, ourstash)
+
+/*
+=for apidoc Am|PADOFFSET|pad_findmy_pvs|const char *name|U32 flags
+
+Exactly like L</pad_findmy_pvn>, but takes a literal string instead
+of a string/length pair.
+
+=cut
+*/
+
+#define pad_findmy_pvs(name,flags) \
+    Perl_pad_findmy_pvn(aTHX_ STR_WITH_LEN(name), flags)
+
 /*
  * Local variables:
  * c-indentation-style: bsd
index 32f9b82..bd3cffb 100644 (file)
--- a/perly.act
+++ b/perly.act
@@ -214,7 +214,7 @@ case 2:
 #endif
                          if (CvOUTSIDE(fmtcv) && !CvUNIQUE(CvOUTSIDE(fmtcv))) {
                              SvREFCNT_inc_simple_void(fmtcv);
-                             pad_add_anon((SV*)fmtcv, OP_NULL);
+                             pad_add_anon(fmtcv, OP_NULL);
                          }
                        ;}
     break;
@@ -1710,6 +1710,6 @@ case 2:
     
 
 /* Generated from:
- * dbb2439b7793bc662fb61a937ef279c1e367658eb7b8755c88b0e9c61116ed55 perly.y
+ * 8bdd3d69bab2a9d77e0557f3b46a8845e8de190fafce0bc37841a105bbcacaa5 perly.y
  * 738ca60a0b4cb075902435e976a2f393d438e8e6e32ba81e037dd773b75c87b5 regen_perly.pl
  * ex: set ro: */
diff --git a/perly.h b/perly.h
index 63dedf7..49a325e 100644 (file)
--- a/perly.h
+++ b/perly.h
@@ -240,6 +240,6 @@ typedef union YYSTYPE
 
 
 /* Generated from:
- * dbb2439b7793bc662fb61a937ef279c1e367658eb7b8755c88b0e9c61116ed55 perly.y
+ * 8bdd3d69bab2a9d77e0557f3b46a8845e8de190fafce0bc37841a105bbcacaa5 perly.y
  * 738ca60a0b4cb075902435e976a2f393d438e8e6e32ba81e037dd773b75c87b5 regen_perly.pl
  * ex: set ro: */
index 171faf8..ae983ba 100644 (file)
--- a/perly.tab
+++ b/perly.tab
@@ -1074,6 +1074,6 @@ static const toketypes yy_type_tab[] =
 };
 
 /* Generated from:
- * dbb2439b7793bc662fb61a937ef279c1e367658eb7b8755c88b0e9c61116ed55 perly.y
+ * 8bdd3d69bab2a9d77e0557f3b46a8845e8de190fafce0bc37841a105bbcacaa5 perly.y
  * 738ca60a0b4cb075902435e976a2f393d438e8e6e32ba81e037dd773b75c87b5 regen_perly.pl
  * ex: set ro: */
diff --git a/perly.y b/perly.y
index a8adefb..9c308a3 100644 (file)
--- a/perly.y
+++ b/perly.y
@@ -294,7 +294,7 @@ barestmt:   PLUGSTMT
 #endif
                          if (CvOUTSIDE(fmtcv) && !CvUNIQUE(CvOUTSIDE(fmtcv))) {
                              SvREFCNT_inc_simple_void(fmtcv);
-                             pad_add_anon((SV*)fmtcv, OP_NULL);
+                             pad_add_anon(fmtcv, OP_NULL);
                          }
                        }
        |       SUB startsub subname proto subattrlist subbody
diff --git a/proto.h b/proto.h
index 2e9a45a..343d9a7 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -2787,14 +2787,24 @@ PERL_CALLCONV void      Perl_packlist(pTHX_ SV *cat, const char *pat, const char *pat
 #define PERL_ARGS_ASSERT_PACKLIST      \
        assert(cat); assert(pat); assert(patend); assert(beglist); assert(endlist)
 
-PERL_CALLCONV PADOFFSET        Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
+PERL_CALLCONV PADOFFSET        Perl_pad_add_anon(pTHX_ CV* func, I32 optype)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_PAD_ADD_ANON  \
-       assert(sv)
+       assert(func)
 
-PERL_CALLCONV PADOFFSET        Perl_pad_add_name(pTHX_ const char *name, const STRLEN len, const U32 flags, HV *typestash, HV *ourstash)
+PERL_CALLCONV PADOFFSET        Perl_pad_add_name_pv(pTHX_ const char *name, const U32 flags, HV *typestash, HV *ourstash)
                        __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_PAD_ADD_NAME  \
+#define PERL_ARGS_ASSERT_PAD_ADD_NAME_PV       \
+       assert(name)
+
+PERL_CALLCONV PADOFFSET        Perl_pad_add_name_pvn(pTHX_ const char *namepv, STRLEN namelen, const U32 flags, HV *typestash, HV *ourstash)
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_PAD_ADD_NAME_PVN      \
+       assert(namepv)
+
+PERL_CALLCONV PADOFFSET        Perl_pad_add_name_sv(pTHX_ SV *name, const U32 flags, HV *typestash, HV *ourstash)
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_PAD_ADD_NAME_SV       \
        assert(name)
 
 PERL_CALLCONV PADOFFSET        Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype);
@@ -2802,10 +2812,22 @@ PERL_CALLCONV void      Perl_pad_block_start(pTHX_ int full);
 PERL_CALLCONV HV*      Perl_pad_compname_type(pTHX_ const PADOFFSET po)
                        __attribute__warn_unused_result__;
 
-PERL_CALLCONV PADOFFSET        Perl_pad_findmy(pTHX_ const char* name, STRLEN len, U32 flags)
+PERL_CALLCONV PADOFFSET        Perl_pad_findmy_pv(pTHX_ const char* name, U32 flags)
+                       __attribute__warn_unused_result__
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_PAD_FINDMY_PV \
+       assert(name)
+
+PERL_CALLCONV PADOFFSET        Perl_pad_findmy_pvn(pTHX_ const char* namepv, STRLEN namelen, U32 flags)
+                       __attribute__warn_unused_result__
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_PAD_FINDMY_PVN        \
+       assert(namepv)
+
+PERL_CALLCONV PADOFFSET        Perl_pad_findmy_sv(pTHX_ SV* name, U32 flags)
                        __attribute__warn_unused_result__
                        __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_PAD_FINDMY    \
+#define PERL_ARGS_ASSERT_PAD_FINDMY_SV \
        assert(name)
 
 PERL_CALLCONV void     Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
@@ -5594,23 +5616,23 @@ STATIC void     S_forget_pmop(pTHX_ PMOP *const o, U32 flags)
 #  endif
 #endif
 #if defined(PERL_IN_PAD_C)
-STATIC PADOFFSET       S_pad_add_name_sv(pTHX_ SV *namesv, const U32 flags, HV *typestash, HV *ourstash)
+STATIC PADOFFSET       S_pad_alloc_name(pTHX_ SV *namesv, U32 flags, HV *typestash, HV *ourstash)
                        __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_PAD_ADD_NAME_SV       \
+#define PERL_ARGS_ASSERT_PAD_ALLOC_NAME        \
        assert(namesv)
 
-STATIC void    S_pad_check_dup(pTHX_ SV *name, const U32 flags, const HV *ourstash)
+STATIC void    S_pad_check_dup(pTHX_ SV *name, U32 flags, const HV *ourstash)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_PAD_CHECK_DUP \
        assert(name)
 
-STATIC PADOFFSET       S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn, SV** out_capture, SV** out_name_sv, int *out_flags)
+STATIC PADOFFSET       S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, const CV* cv, U32 seq, int warn, SV** out_capture, SV** out_name_sv, int *out_flags)
                        __attribute__nonnull__(pTHX_1)
-                       __attribute__nonnull__(pTHX_2)
-                       __attribute__nonnull__(pTHX_6)
-                       __attribute__nonnull__(pTHX_7);
+                       __attribute__nonnull__(pTHX_3)
+                       __attribute__nonnull__(pTHX_7)
+                       __attribute__nonnull__(pTHX_8);
 #define PERL_ARGS_ASSERT_PAD_FINDLEX   \
-       assert(name); assert(cv); assert(out_name_sv); assert(out_flags)
+       assert(namepv); assert(cv); assert(out_name_sv); assert(out_flags)
 
 STATIC void    S_pad_reset(pTHX);
 #endif
@@ -7128,7 +7150,7 @@ PERL_CALLCONV OP* Perl_newPADOP(pTHX_ I32 type, I32 flags, SV* sv)
 #define PERL_ARGS_ASSERT_NEWPADOP      \
        assert(sv)
 
-PERL_CALLCONV AV*      Perl_padlist_dup(pTHX_ AV *const srcpad, CLONE_PARAMS *const param)
+PERL_CALLCONV AV*      Perl_padlist_dup(pTHX_ AV *srcpad, CLONE_PARAMS *param)
                        __attribute__warn_unused_result__
                        __attribute__nonnull__(pTHX_2);
 #define PERL_ARGS_ASSERT_PADLIST_DUP   \
diff --git a/toke.c b/toke.c
index db03f9a..6ba2682 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -8342,7 +8342,7 @@ S_pending_ident(pTHX)
 
     if (!has_colon) {
        if (!PL_in_my)
-           tmp = pad_findmy(PL_tokenbuf, tokenbuf_len, 0);
+           tmp = pad_findmy_pvn(PL_tokenbuf, tokenbuf_len, 0);
         if (tmp != NOT_IN_PAD) {
             /* might be an "our" variable" */
             if (PAD_COMPNAME_FLAGS_isOUR(tmp)) {
@@ -9562,7 +9562,7 @@ S_scan_inputsymbol(pTHX_ char *start)
            /* try to find it in the pad for this block, otherwise find
               add symbol table ops
            */
-           const PADOFFSET tmp = pad_findmy(d, len, 0);
+           const PADOFFSET tmp = pad_findmy_pvn(d, len, 0);
            if (tmp != NOT_IN_PAD) {
                if (PAD_COMPNAME_FLAGS_isOUR(tmp)) {
                    HV * const stash = PAD_COMPNAME_OURSTASH(tmp);