: Used in pp.c
p |SV * |core_prototype |NULLOK SV *sv|NN const char *name \
|const int code|NULLOK int * const opnum
+: Used in gv.c
+p |OP * |coresub_op |NN SV *coreargssv|const int code \
+ |const int 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
#define ck_trunc(a) Perl_ck_trunc(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 coresub_op(a,b,c) Perl_coresub_op(aTHX_ a,b,c)
#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)
int opnum = 0;
SV *opnumsv;
bool ampable = FALSE; /* &{}-able */
- OP *o;
COP *oldcurcop;
yy_parser *oldparser;
I32 oldsavestack_ix;
new ATTRSUB. */
(void)core_prototype((SV *)cv, name, code, &opnum);
if (ampable) {
- OP * const argop =
- newSVOP(OP_COREARGS,0,
- opnum ? newSVuv((UV)opnum) : newSVpvn(name,len));
- switch(opnum) {
- case 0:
- {
- IV index = 0;
- switch(-code) {
- case KEY___FILE__ : index = 1; break;
- case KEY___LINE__ : index = 2; break;
- }
- o = op_append_elem(OP_LINESEQ,
- argop,
- newSLICEOP(0,
- newSVOP(OP_CONST, 0,
- newSViv(index)
- ),
- newOP(OP_CALLER,0)
- )
- );
- break;
- }
- default:
- switch (PL_opargs[opnum] & OA_CLASS_MASK) {
- case OA_BASEOP:
- o = op_append_elem(
- OP_LINESEQ, argop,
- newOP(opnum,
- opnum == OP_WANTARRAY
- ? OPpOFFBYONE << 8
- : 0
- )
- );
- break;
- default:
- o = newUNOP(opnum,0,argop);
- }
- }
newATTRSUB(oldsavestack_ix,
newSVOP(
OP_CONST, 0,
newSVpvn_share(nambeg,full_len,0)
),
- NULL,NULL,o
+ NULL,NULL,
+ coresub_op(
+ opnum
+ ? newSVuv((UV)opnum)
+ : newSVpvn(name,len),
+ code, opnum
+ )
);
assert(GvCV(gv) == cv);
LEAVE;
return sv;
}
+OP *
+Perl_coresub_op(pTHX_ SV * const coreargssv, const int code,
+ const int opnum)
+{
+ OP * const argop = newSVOP(OP_COREARGS,0,coreargssv);
+
+ PERL_ARGS_ASSERT_CORESUB_OP;
+
+ switch(opnum) {
+ case 0:
+ {
+ IV index = 0;
+ switch(-code) {
+ case KEY___FILE__ : index = 1; break;
+ case KEY___LINE__ : index = 2; break;
+ }
+ return op_append_elem(OP_LINESEQ,
+ argop,
+ newSLICEOP(0,
+ newSVOP(OP_CONST, 0, newSViv(index)),
+ newOP(OP_CALLER,0)
+ )
+ );
+ }
+ default:
+ switch (PL_opargs[opnum] & OA_CLASS_MASK) {
+ case OA_BASEOP:
+ return op_append_elem(
+ OP_LINESEQ, argop,
+ newOP(opnum,
+ opnum == OP_WANTARRAY ? OPpOFFBYONE << 8 : 0)
+ );
+ default:
+ return newUNOP(opnum,0,argop);
+ }
+ }
+}
+
#include "XSUB.h"
/* Efficient sub that returns a constant scalar value. */
#define PERL_ARGS_ASSERT_CORE_PROTOTYPE \
assert(name)
+PERL_CALLCONV OP * Perl_coresub_op(pTHX_ SV *coreargssv, const int code, const int opnum)
+ __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_CORESUB_OP \
+ assert(coreargssv)
+
PERL_CALLCONV PERL_CONTEXT* Perl_create_eval_scope(pTHX_ U32 flags);
PERL_CALLCONV void Perl_croak(pTHX_ const char* pat, ...)
__attribute__noreturn__