In perl.git, the branch doy/subroutine-signatures has been updated <http://perl5.git.perl.org/perl.git/commitdiff/1e8152d6ac38b588f1613ecf819152c6f2135de3?hp=33db431570166eef70666e098b8edf1f8ded6c20>
- Log ----------------------------------------------------------------- commit 1e8152d6ac38b588f1613ecf819152c6f2135de3 Author: Peter Martini <[email protected]> Date: Sun Sep 16 18:05:16 2012 -0400 Properly lexicalize arguments. Inlines important pieces of SAVECLEARSV ----------------------------------------------------------------------- Summary of changes: pad.c | 2 +- pad.h | 4 ++-- pp_hot.c | 31 +++++++++++++++++++------------ toke.c | 23 +++++++++++------------ 4 files changed, 33 insertions(+), 27 deletions(-) diff --git a/pad.c b/pad.c index 232f83e..fd0c5d4 100644 --- a/pad.c +++ b/pad.c @@ -292,7 +292,7 @@ Perl_pad_new(pTHX_ int flags) Newx(ary, 2, PAD *); PadlistMAX(padlist) = 1; PadlistARRAY(padlist) = ary; - PadlistNAMEDPARAMS(padlist) = NULL; + PadlistNAMECNT(padlist) = 0; ary[0] = padname; ary[1] = pad; diff --git a/pad.h b/pad.h index 338a135..f75f112 100644 --- a/pad.h +++ b/pad.h @@ -33,7 +33,7 @@ struct padlist { PAD ** xpadl_alloc; /* pointer to beginning of array of AVs */ U32 xpadl_id; /* Semi-unique ID, shared between clones */ U32 xpadl_outid; /* ID of outer pad */ - AV * xpadl_names; /* Named parameters in the sub */ + I32 xpadl_namecnt; /* The first N pad entries are assigned on sub entry */ }; @@ -283,7 +283,7 @@ Restore the old pad saved into the local variable opad by PAD_SAVE_LOCAL() #define PadlistNAMES(pl) (*PadlistARRAY(pl)) #define PadlistNAMESARRAY(pl) PadnamelistARRAY(PadlistNAMES(pl)) #define PadlistNAMESMAX(pl) PadnamelistMAX(PadlistNAMES(pl)) -#define PadlistNAMEDPARAMS(pl) (pl)->xpadl_names +#define PadlistNAMECNT(pl) (pl)->xpadl_namecnt #define PadlistREFCNT(pl) 1 /* reserved for future use */ #define PadnamelistARRAY(pnl) AvARRAY(pnl) diff --git a/pp_hot.c b/pp_hot.c index 06bfeb8..7ae21e6 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -2675,7 +2675,7 @@ try_autoload: dMARK; I32 items = SP - MARK; PADLIST * const padlist = CvPADLIST(cv); - AV * namedargs = PadlistNAMEDPARAMS(padlist); + I32 namecnt = PadlistNAMECNT(padlist); PUSHBLOCK(cx, CXt_SUB, MARK); PUSHSUB(cx); cx->blk_sub.retop = PL_op->op_next; @@ -2686,7 +2686,7 @@ try_autoload: } SAVECOMPPAD(); PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv)); - if (hasargs || namedargs) { + if (hasargs || namecnt) { AV *const av = MUTABLE_AV(PAD_SVl(0)); if (AvREAL(av)) { /* @_ is normally not REAL--this should only ever @@ -2717,19 +2717,26 @@ try_autoload: Copy(MARK,AvARRAY(av),items,SV*); AvFILLp(av) = items - 1; - if (namedargs) { + /* If we're using subroutine signatures, and there's something to copy, do it */ + if (namecnt) { /* XXX TODO: Handle mismatched parameters */ - int i; - int named_count = AvFILLp(namedargs) + 1; - int max = items < named_count ? items : named_count; - for (i = 0; i < max; i++) { - SV * name = AvARRAY(namedargs)[i]; - SV * value = newSVsv(AvARRAY(av)[i]); - PAD_SETSV(SvIV(name), value); - SvPADTMP_on(value); - SvREADONLY_on(value); + I32 max = items < namecnt ? items : namecnt; + SV ** source = AvARRAY(av); + UV saveclearval = SAVEt_CLEARSV; + while (namecnt > max) { + PL_curpad[namecnt] = &PL_sv_undef; + --namecnt; + } + SSCHECK(max); + while (max) { + PAD_SVl(max) = newSVsv(source[max-1]); + SvPADMY_on(PAD_SVl(max)); + saveclearval += (1 << SAVE_TIGHT_SHIFT); + SSPUSHUV(saveclearval); + --max; } } + while (items--) { if (*MARK) diff --git a/toke.c b/toke.c index 570cbb7..1ee7886 100644 --- a/toke.c +++ b/toke.c @@ -8798,7 +8798,7 @@ S_scan_named_proto (pTHX_ SV *sv, bool * bad) char token[sizeof PL_tokenbuf]; /* XXX TODO: Greedy named parameters are currently invalid */ AV *protolist; - int arg_count = 0; + int argcount, index; PERL_ARGS_ASSERT_SCAN_NAMED_PROTO; @@ -8812,7 +8812,6 @@ S_scan_named_proto (pTHX_ SV *sv, bool * bad) proto = scan_word(proto, token+1, sizeof(token) - 1, FALSE, &len); if (len) { /* XXX TODO: Disallow globals like '$1' */ - arg_count++; av_push(protolist, newSVpvn_flags(token, len + 1, UTF)); while (isSPACE(*proto)) proto++; if (*proto == ',') @@ -8839,20 +8838,20 @@ S_scan_named_proto (pTHX_ SV *sv, bool * bad) return true; } - PadlistNAMEDPARAMS(CvPADLIST(PL_compcv)) = protolist; - while (arg_count--) { + argcount = AvFILL(protolist) + 1; + PadlistNAMECNT(CvPADLIST(PL_compcv)) = argcount; + for (index = 0; index < argcount; index++) { SV * pad_name; - SV * proto_name = AvARRAY(protolist)[arg_count]; - /* Add the pad entry, and mark it as visible */ - int ix = pad_add_name_pv(SvPV_nolen(proto_name), 0, NULL, NULL); - pad_name = AvARRAY(PL_comppad_name)[ix]; + SV * proto_name = AvARRAY(protolist)[index]; + const int pad_ix = pad_add_name_pv(SvPV_nolen(proto_name), 0, NULL, NULL); + /* The named parameters must be the first entries in the pad */ + assert(pad_ix == index + 1); + pad_name = AvARRAY(PL_comppad_name)[pad_ix]; + /* Mark the entries as in scope */ ((XPVNV*)SvANY(pad_name))->xnv_u.xpad_cop_seq.xlow = PL_cop_seqmax; ((XPVNV*)SvANY(pad_name))->xnv_u.xpad_cop_seq.xhigh = PERL_PADSEQ_INTRO; - /* Mark the prototype entry with a pointer into the pad */ - sv_upgrade(proto_name, SVt_PVIV); - SvIV_set(proto_name, ix); - SvIOK_on(proto_name); } + sv_free(MUTABLE_SV(protolist)); PL_cop_seqmax++; return false; } -- Perl5 Master Repository
