diff options
| -rw-r--r-- | embed.fnc | 103 | ||||
| -rw-r--r-- | embed.h | 26 | ||||
| -rw-r--r-- | ext/XS-APItest/APItest.xs | 6 | ||||
| -rw-r--r-- | global.sym | 14 | ||||
| -rw-r--r-- | op.c | 12 | ||||
| -rw-r--r-- | pad.c | 444 | ||||
| -rw-r--r-- | pad.h | 40 | ||||
| -rw-r--r-- | perly.act | 4 | ||||
| -rw-r--r-- | perly.h | 2 | ||||
| -rw-r--r-- | perly.tab | 2 | ||||
| -rw-r--r-- | perly.y | 2 | ||||
| -rw-r--r-- | proto.h | 52 | ||||
| -rw-r--r-- | toke.c | 4 |
13 files changed, 449 insertions, 262 deletions
@@ -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 \ |... @@ -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) @@ -382,7 +383,17 @@ #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) @@ -697,6 +708,7 @@ #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) @@ -998,7 +1010,6 @@ #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) @@ -1106,18 +1117,12 @@ #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) @@ -1213,7 +1218,6 @@ # 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 @@ -1362,9 +1366,9 @@ #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) diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index 68533da58b..0b3a6cba3d 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -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); diff --git a/global.sym b/global.sym index 3d52f63eb3..6e60f38bd3 100644 --- a/global.sym +++ b/global.sym @@ -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 @@ -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; @@ -27,13 +27,11 @@ /* =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: @@ -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 @@ -366,6 +364,30 @@ Clone the state variables associated with running and compiling pads. 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 * c-basic-offset: 4 @@ -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: */ @@ -240,6 +240,6 @@ typedef union YYSTYPE /* Generated from: - * dbb2439b7793bc662fb61a937ef279c1e367658eb7b8755c88b0e9c61116ed55 perly.y + * 8bdd3d69bab2a9d77e0557f3b46a8845e8de190fafce0bc37841a105bbcacaa5 perly.y * 738ca60a0b4cb075902435e976a2f393d438e8e6e32ba81e037dd773b75c87b5 regen_perly.pl * ex: set ro: */ @@ -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: */ @@ -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 @@ -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 \ @@ -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); |