Move pp_-specific code out of core_prototype

Commit b8c38f0a2a65 refactored pp_prototype by moving much of its
code to a new function in op.c, called core_prototype.  This served
two purposes: (1) to allow the code to be simplified, which required
the use of static functions in op.c, and (2) to allow the &CORE::subs
feature to share the same code.

But some code was moved to core_prototype which, in hindsight, did not
need to be moved, such as the ‘Can’t find an opnumber’ message.

This commit moves that code back to pp_prototype, resulting in a sim-
pler (and possibly faster, at least for &CORE::subs) core_prototype.

6 files changed, 12 insertions, 18 deletions

diff --git a/embed.fnc b/embed.fnc
index 5502c3290a..e7041b1042 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -265,8 +265,7 @@ 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 int code|NULLOK int * const opnum\
-				|const bool croak
+				|const int code|NULLOK int * const opnum
 : 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 1646565e22..7fc3b211b8 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,e)	Perl_core_prototype(aTHX_ a,b,c,d,e)
+#define core_prototype(a,b,c,d)	Perl_core_prototype(aTHX_ a,b,c,d)
 #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/gv.c b/gv.c
index d009850341..1741bda79d 100644
--- a/gv.c
+++ b/gv.c
@@ -1361,7 +1361,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
 	    CvFILE(cv) = (char *)file;
 	    CvISXSUB_on(cv);
 	    CvXSUB(cv) = core_xsub;
-	    (void)core_prototype((SV *)cv, name, code, &opnum, 0);
+	    (void)core_prototype((SV *)cv, name, code, &opnum);
 	    opnumsv = opnum ? newSVuv((UV)opnum) : (SV *)NULL;
 	    cv_set_call_checker(
 	       cv, Perl_ck_entersub_args_core, opnumsv ? opnumsv : (SV *)cv
diff --git a/op.c b/op.c
index 4cc0f7063f..d4d89e4c59 100644
--- a/op.c
+++ b/op.c
@@ -10343,7 +10343,7 @@ returns NULL if C<croak> is false.
 
 SV *
 Perl_core_prototype(pTHX_ SV *sv, const char *name, const int code,
-                          int * const opnum, const bool croak)
+                          int * const opnum)
 {
     int i = 0, n = 0, seen_question = 0, defgv = 0;
     I32 oa;
@@ -10353,15 +10353,7 @@ Perl_core_prototype(pTHX_ SV *sv, const char *name, const int code,
 
     PERL_ARGS_ASSERT_CORE_PROTOTYPE;
 
-    if (!code || code == -KEY_CORE) {
-	if (croak)
-	    return (SV *)Perl_die(aTHX_
-		"Can't find an opnumber for \"%s\"", name
-	    );
-	return NULL;
-    }
-
-    if (code > 0) return NULL; /* Not overridable */
+    assert (code < 0 && code != -KEY_CORE);
 
     if (!sv) sv = sv_newmortal();
 
diff --git a/pp.c b/pp.c
index c6f8eac347..ca94935c30 100644
--- a/pp.c
+++ b/pp.c
@@ -439,9 +439,12 @@ PP(pp_prototype)
 	const char * s = SvPVX_const(TOPs);
 	if (strnEQ(s, "CORE::", 6)) {
 	    const int code = keyword(s + 6, SvCUR(TOPs) - 6, 1);
-	    SV *const sv =
-		core_prototype(NULL, s + 6, code, NULL, 1);
-	    if (sv) ret = sv;
+	    if (!code || code == -KEY_CORE)
+		DIE(aTHX_ "Can't find an opnumber for \"%s\"", s+6);
+	    if (code < 0) {	/* Overridable. */
+		SV * const sv = core_prototype(NULL, s + 6, code, NULL);
+		if (sv) ret = sv;
+	    }
 	    goto set;
 	}
     }
diff --git a/proto.h b/proto.h
index 398df4c31c..814b710f1b 100644
--- a/proto.h
+++ b/proto.h
@@ -578,7 +578,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 int code, int * const opnum, const bool croak)
+PERL_CALLCONV SV *	Perl_core_prototype(pTHX_ SV *sv, const char *name, const int code, int * const opnum)
 			__attribute__nonnull__(pTHX_2);
 #define PERL_ARGS_ASSERT_CORE_PROTOTYPE	\
 	assert(name)