SV *leftsv = CAT2(X,s); \
IV left = USE_LEFT(leftsv) ? SvIV(leftsv) : 0
#define dPOPXiirl_ul_nomg(X) \
- IV right = POPi; \
+ IV right = (sp--, SvIV_nomg(TOPp1s)); \
SV *leftsv = CAT2(X,s); \
IV left = USE_LEFT(leftsv) ? SvIV_nomg(leftsv) : 0
return NORMAL; \
} STMT_END
-#define AMG_CALLun(sv,meth) \
- amagic_call(sv,&PL_sv_undef, CAT2(meth,_amg), AMGf_noright | AMGf_unary)
+#define AMG_CALLunary(sv,meth) \
+ amagic_call(sv,&PL_sv_undef, meth, AMGf_noright | AMGf_unary)
+
+/* No longer used in core. Use AMG_CALLunary instead */
+#define AMG_CALLun(sv,meth) AMG_CALLunary(sv, CAT2(meth,_amg))
-#define tryAMAGICunTARGET(meth, shift) \
+#define tryAMAGICunTARGET(meth, shift, jump) \
STMT_START { \
+ dATARGET; \
dSP; \
- sp--; /* get TARGET from below PL_stack_sp */ \
- { \
- dTARGETSTACKED; \
- dSP; \
- SV *tmpsv; \
- SV *arg= sp[shift]; \
- if (SvAMAGIC(arg) && \
- (tmpsv = amagic_call(arg, &PL_sv_undef, CAT2(meth,_amg), \
- AMGf_noright | AMGf_unary))) { \
- SPAGAIN; \
- sp += shift; \
- sv_setsv(TARG, tmpsv); \
- SETTARG; \
- RETURN; \
+ SV *tmpsv; \
+ SV *arg= sp[shift]; \
+ if (SvAMAGIC(arg) && \
+ (tmpsv = amagic_call(arg, &PL_sv_undef, meth, \
+ AMGf_noright | AMGf_unary))) { \
+ SPAGAIN; \
+ sp += shift; \
+ sv_setsv(TARG, tmpsv); \
+ if (opASSIGN) \
+ sp--; \
+ SETTARG; \
+ PUTBACK; \
+ if (jump) { \
+ OP *jump_o = NORMAL->op_next; \
+ while (jump_o->op_type == OP_NULL) \
+ jump_o = jump_o->op_next; \
+ assert(jump_o->op_type == OP_ENTERSUB); \
+ PL_markstack_ptr--; \
+ return jump_o->op_next; \
} \
+ return NORMAL; \
} \
} STMT_END
-#define tryAMAGICunDEREF_var(meth_enum) \
+/* This is no longer used anywhere in the core. You might wish to consider
+ calling amagic_deref_call() directly, as it has a cleaner interface. */
+#define tryAMAGICunDEREF(meth) \
STMT_START { \
- SV *tmpsv; \
- SV *arg = *sp; \
- while (SvAMAGIC(arg) && \
- (tmpsv = amagic_call(arg, &PL_sv_undef, meth_enum, \
- AMGf_noright | AMGf_unary))) { \
- SPAGAIN; \
- sv = tmpsv; \
- if (!SvROK(tmpsv)) \
- Perl_croak(aTHX_ "Overloaded dereference did not return a reference"); \
- if (tmpsv == arg || SvRV(tmpsv) == SvRV(arg)) { \
- /* Bail out if it returns us the same reference. */ \
- break; \
- } \
- arg = tmpsv; \
- } \
+ sv = amagic_deref_call(*sp, CAT2(meth,_amg)); \
+ SPAGAIN; \
} STMT_END
-#define tryAMAGICunDEREF(meth) tryAMAGICunDEREF_var(CAT2(meth,_amg))
-
#define opASSIGN (PL_op->op_flags & OPf_STACKED)
#define SETsv(sv) STMT_START { \
{ sv_setsv(TARG, (sv)); SETTARG; } \
else SETs(sv); } STMT_END
-/* newSVsv does not behave as advertised, so we copy missing
- * information by hand */
-
-/* SV* ref causes confusion with the member variable
- changed SV* ref to SV* tmpRef */
-#define RvDEEPCP(rv) STMT_START { SV* tmpRef=SvRV(rv); SV* rv_copy; \
- if (SvREFCNT(tmpRef)>1 && (rv_copy = AMG_CALLun(rv,copy))) { \
- SvRV_set(rv, rv_copy); \
- SvSETMAGIC(rv); \
- SvREFCNT_dec(tmpRef); \
- } } STMT_END
-
/*
=for apidoc mU||LVRET
True if this op will be the return value of an lvalue subroutine
) \
)
+#ifdef PERL_CORE
+
+/* These are just for Perl_tied_method(), which is not part of the public API.
+ Use 0x04 rather than the next available bit, to help the compiler if the
+ architecture can generate more efficient instructions. */
+# define TIED_METHOD_MORTALIZE_NOT_NEEDED 0x04
+# define TIED_METHOD_ARGUMENTS_ON_STACK 0x08
+# define TIED_METHOD_SAY 0x10
+
+/* Used in various places that need to dereference a glob or globref */
+# define MAYBE_DEREF_GV_flags(sv,phlags) \
+ ( \
+ (void)(phlags & SV_GMAGIC && (SvGETMAGIC(sv),0)), \
+ isGV_with_GP(sv) \
+ ? (GV *)sv \
+ : SvROK(sv) && SvTYPE(SvRV(sv)) <= SVt_PVLV && \
+ (SvGETMAGIC(SvRV(sv)), isGV_with_GP(SvRV(sv))) \
+ ? (GV *)SvRV(sv) \
+ : NULL \
+ )
+# define MAYBE_DEREF_GV(sv) MAYBE_DEREF_GV_flags(sv,SV_GMAGIC)
+# define MAYBE_DEREF_GV_nomg(sv) MAYBE_DEREF_GV_flags(sv,0)
+
+#endif
+
/*
* Local variables:
* c-indentation-style: bsd
https://perl5.git.perl.org / perl5.git / blobdiff