diff options
| -rw-r--r-- | embed.fnc | 3 | ||||
| -rw-r--r-- | embed.h | 2 | ||||
| -rw-r--r-- | op.c | 27 | ||||
| -rw-r--r-- | pp.c | 3 | ||||
| -rw-r--r-- | proto.h | 2 |
5 files changed, 22 insertions, 15 deletions
@@ -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 @@ -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) @@ -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; } @@ -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; } @@ -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) |