develooper Front page | perl.perl5.porters | Postings from September 2012

Another patch for the doy/subroutine-signatures branch

Thread Next
From:
Peter Martini
Date:
September 16, 2012 17:52
Subject:
Another patch for the doy/subroutine-signatures branch
Message ID:
CAFyW6MQUPqK5M+ZL12eGKP9X=N2sXA_WxvrZxO5C6rFkgNXkjg@mail.gmail.com
From 77a76207568a565f275578b227ce2e28225e5be9 Mon Sep 17 00:00:00 2001
From: Peter Martini <PeterCMartini@GMail.com>
Date: Sun, 16 Sep 2012 18:05:16 -0400
Subject: [PATCH] Properly lexicalize arguments.
 Inlines important pieces of SAVECLEARSV

---
 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;
 }
-- 
1.7.1


Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About