Change core_prototype to take a keyword num

This refactoring requires the caller to provide the keyword
number to core_prototype.  Consequently, it speeds up the code in
gv.c:gv_fetchpvn_flags by allowing it to avoid an extra call to
keyword().

This takes the place of the len parameter, which is no longer used.
It used to be used only as an argument to keyword().  Since the code
that uses strEQ is only reached if the keyword has already been veri-
fied by keyword(), the name simply cannot have embedded nulls, so len
is not necessary.

diff --git a/embed.fnc b/embed.fnc
index 0cdaf5a..5502c32 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -265,7 +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 STRLEN len|NULLOK int * const opnum\
+                               |const int code|NULLOK int * const opnum\
                                |const bool croak
 : Used in sv.c
 p      |void   |cv_ckproto_len |NN const CV* cv|NULLOK const GV* gv\

diff --git a/gv.c b/gv.c
index 8c2c1f1..d009850 100644 (file)
--- 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, len, &opnum, 0);
+           (void)core_prototype((SV *)cv, name, code, &opnum, 0);
            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 981655d..4cc0f70 100644 (file)
--- a/op.c
+++ b/op.c
@@ -10342,10 +10342,9 @@ returns NULL if C<croak> is false.
 */
 
 SV *
-Perl_core_prototype(pTHX_ SV *sv, const char *name, const STRLEN len,
+Perl_core_prototype(pTHX_ SV *sv, const char *name, const int code,
                           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)

diff --git a/pp.c b/pp.c
index a32d0c0..c6f8eac 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -438,8 +438,9 @@ PP(pp_prototype)
     if (SvPOK(TOPs) && SvCUR(TOPs) >= 7) {
        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, SvCUR(TOPs) - 6, NULL, 1);
+               core_prototype(NULL, s + 6, code, NULL, 1);
            if (sv) ret = sv;
            goto set;
        }

diff --git a/proto.h b/proto.h
index b5c2faa..398df4c 100644 (file)
--- 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 STRLEN len, int * const opnum, const bool croak)
+PERL_CALLCONV SV *     Perl_core_prototype(pTHX_ SV *sv, const char *name, const int code, int * const opnum, const bool croak)
                        __attribute__nonnull__(pTHX_2);
 #define PERL_ARGS_ASSERT_CORE_PROTOTYPE        \
        assert(name)