From: Father Chrysostomos <sprout@cpan.org>
Date: Tue, 2 Aug 2011 22:04:47 +0000 (-0700)
Subject: Make core_prototype provide the op number as well
X-Git-Tag: accepted/trunk/20130322.191538~3148^2~16
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=9927957a90b2fe6bdb0e2be889b2edcddadea174;p=platform%2Fupstream%2Fperl.git

Make core_prototype provide the op number as well

Since it has to calculate it, it might as well provide it, so callers
do not have to go through that while(i < MAXO) loop yet again.

(The &CORE::foo feature will use this.)
---

diff --git a/embed.fnc b/embed.fnc
index 4da1d75..04f8551 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -265,7 +265,8 @@ Afnp	|int	|printf_nocontext|NN const char *format|...
 #endif
 : Used in pp.c
 p	|SV *	|core_prototype	|NULLOK SV *sv|NN const char *name \
-				|const STRLEN len|const bool croak
+				|const STRLEN len|NULLOK int * const opnum\
+				|const bool croak
 : Used in sv.c
 p	|void	|cv_ckproto_len	|NN const CV* cv|NULLOK const GV* gv\
 				|NULLOK const char* p|const STRLEN len
diff --git a/embed.h b/embed.h
index 7fc3b21..1646565 100644
--- a/embed.h
+++ b/embed.h
@@ -1008,7 +1008,7 @@
 #define ck_trunc(a)		Perl_ck_trunc(aTHX_ a)
 #define ck_unpack(a)		Perl_ck_unpack(aTHX_ a)
 #define convert(a,b,c)		Perl_convert(aTHX_ a,b,c)
-#define core_prototype(a,b,c,d)	Perl_core_prototype(aTHX_ a,b,c,d)
+#define core_prototype(a,b,c,d,e)	Perl_core_prototype(aTHX_ a,b,c,d,e)
 #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 cvgv_set(a,b)		Perl_cvgv_set(aTHX_ a,b)
diff --git a/op.c b/op.c
index 1f6743d..3f8f7c4 100644
--- a/op.c
+++ b/op.c
@@ -10254,13 +10254,14 @@ returns NULL if C<croak> is false.
 
 SV *
 Perl_core_prototype(pTHX_ SV *sv, const char *name, const STRLEN len,
-                          const bool croak)
+                          int * const opnum, const bool croak)
 {
     const int code = keyword(name, len, 1);
     int i = 0, n = 0, seen_question = 0, defgv = 0;
     I32 oa;
 #define MAX_ARGS_OP ((sizeof(I32) - 1) * 2)
     char str[ MAX_ARGS_OP * 2 + 2 ]; /* One ';', one '\0' */
+    bool nullret = FALSE;
 
     PERL_ARGS_ASSERT_CORE_PROTOTYPE;
 
@@ -10276,7 +10277,7 @@ Perl_core_prototype(pTHX_ SV *sv, const char *name, const STRLEN len,
 
     if (!sv) sv = sv_newmortal();
 
-#define retsetpvs(x) sv_setpvs(sv, x); return sv
+#define retsetpvs(x,y) sv_setpvs(sv, x); if(opnum) *opnum=(y); return sv
 
     switch (-code) {
     case KEY_and   : case KEY_chop: case KEY_chomp:
@@ -10284,27 +10285,30 @@ Perl_core_prototype(pTHX_ SV *sv, const char *name, const STRLEN len,
     case KEY_ge    : case KEY_gt  : case KEY_le   :
     case KEY_lt    : case KEY_ne  : case KEY_or   :
     case KEY_select: case KEY_system: case KEY_x  : case KEY_xor:
-	return NULL;
-    case KEY_keys: case KEY_values: case KEY_each:
-	retsetpvs("+");
-    case KEY_push: case KEY_unshift:
-	retsetpvs("+@");
-    case KEY_pop: case KEY_shift:
-	retsetpvs(";+");
+	if (!opnum) return NULL; nullret = TRUE; goto findopnum;
+    case KEY_keys:    retsetpvs("+", OP_KEYS);
+    case KEY_values:  retsetpvs("+", OP_VALUES);
+    case KEY_each:    retsetpvs("+", OP_EACH);
+    case KEY_push:    retsetpvs("+@", OP_PUSH);
+    case KEY_unshift: retsetpvs("+@", OP_UNSHIFT);
+    case KEY_pop:     retsetpvs(";+", OP_POP);
+    case KEY_shift:   retsetpvs(";+", OP_SHIFT);
     case KEY_splice:
-	retsetpvs("+;$$@");
+	retsetpvs("+;$$@", OP_SPLICE);
     case KEY___FILE__: case KEY___LINE__: case KEY___PACKAGE__:
-	retsetpvs("");
+	retsetpvs("", 0);
     case KEY_readpipe:
 	name = "backtick";
     }
 
 #undef retsetpvs
 
+  findopnum:
     while (i < MAXO) {	/* The slow way. */
 	if (strEQ(name, PL_op_name[i])
 	    || strEQ(name, PL_op_desc[i]))
 	{
+	    if (nullret) { assert(opnum); *opnum = i; return NULL; }
 	    goto found;
 	}
 	i++;
@@ -10343,6 +10347,7 @@ Perl_core_prototype(pTHX_ SV *sv, const char *name, const STRLEN len,
 	str[0] = '_';
     str[n++] = '\0';
     sv_setpvn(sv, str, n - 1);
+    if (opnum) *opnum = i;
     return sv;
 }
 
diff --git a/pp.c b/pp.c
index 8649bec..a32d0c0 100644
--- a/pp.c
+++ b/pp.c
@@ -438,7 +438,8 @@ PP(pp_prototype)
     if (SvPOK(TOPs) && SvCUR(TOPs) >= 7) {
 	const char * s = SvPVX_const(TOPs);
 	if (strnEQ(s, "CORE::", 6)) {
-	    SV *const sv = core_prototype(NULL, s + 6, SvCUR(TOPs) - 6, 1);
+	    SV *const sv =
+		core_prototype(NULL, s + 6, SvCUR(TOPs) - 6, NULL, 1);
 	    if (sv) ret = sv;
 	    goto set;
 	}
diff --git a/proto.h b/proto.h
index b267253..735f0cb 100644
--- a/proto.h
+++ b/proto.h
@@ -571,7 +571,7 @@ PERL_CALLCONV void	Perl_cop_store_label(pTHX_ COP *const cop, const char *label,
 #define PERL_ARGS_ASSERT_COP_STORE_LABEL	\
 	assert(cop); assert(label)
 
-PERL_CALLCONV SV *	Perl_core_prototype(pTHX_ SV *sv, const char *name, const STRLEN len, const bool croak)
+PERL_CALLCONV SV *	Perl_core_prototype(pTHX_ SV *sv, const char *name, const STRLEN len, int * const opnum, const bool croak)
 			__attribute__nonnull__(pTHX_2);
 #define PERL_ARGS_ASSERT_CORE_PROTOTYPE	\
 	assert(name)