X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/1b38c28e639da91d4507d4d1cebac12fec9e82ef..fa01018c102d8360898153b9f4b062716ad06702:/pp.h

diff --git a/pp.h b/pp.h
index 27f948c..63b2234 100644
--- a/pp.h
+++ b/pp.h
@@ -345,33 +345,21 @@ Does not use C<TARG>.  See also C<XPUSHu>, C<mPUSHu> and C<PUSHu>.
 #define dPOPXiirl(X)	IV right = POPi; IV left = CAT2(X,i)
 
 #define USE_LEFT(sv) \
-	(SvOK(sv) || SvGMAGICAL(sv) || !(PL_op->op_flags & OPf_STACKED))
-#define dPOPXnnrl_ul(X)	\
-    NV right = POPn;				\
-    SV *leftsv = CAT2(X,s);				\
-    NV left = USE_LEFT(leftsv) ? SvNV(leftsv) : 0.0
-#define dPOPXiirl_ul(X) \
-    IV right = POPi;					\
-    SV *leftsv = CAT2(X,s);				\
-    IV left = USE_LEFT(leftsv) ? SvIV(leftsv) : 0
+	(SvOK(sv) || !(PL_op->op_flags & OPf_STACKED))
 #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
 
 #define dPOPPOPssrl	dPOPXssrl(POP)
 #define dPOPPOPnnrl	dPOPXnnrl(POP)
-#define dPOPPOPnnrl_ul	dPOPXnnrl_ul(POP)
 #define dPOPPOPiirl	dPOPXiirl(POP)
-#define dPOPPOPiirl_ul	dPOPXiirl_ul(POP)
 
 #define dPOPTOPssrl	dPOPXssrl(TOP)
 #define dPOPTOPnnrl	dPOPXnnrl(TOP)
-#define dPOPTOPnnrl_ul	dPOPXnnrl_ul(TOP)
 #define dPOPTOPnnrl_nomg \
     NV right = SvNV_nomg(TOPs); NV left = (sp--, SvNV_nomg(TOPs))
 #define dPOPTOPiirl	dPOPXiirl(TOP)
-#define dPOPTOPiirl_ul	dPOPXiirl_ul(TOP)
 #define dPOPTOPiirl_ul_nomg dPOPXiirl_ul_nomg(TOP)
 #define dPOPTOPiirl_nomg \
     IV right = SvIV_nomg(TOPs); IV left = (sp--, SvIV_nomg(TOPs))
@@ -425,51 +413,48 @@ Does not use C<TARG>.  See also C<XPUSHu>, C<mPUSHu> and C<PUSHu>.
 	    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)
 
-#define tryAMAGICunTARGET(meth, shift)				\
+/* No longer used in core. Use AMG_CALLunary instead */
+#define AMG_CALLun(sv,meth) AMG_CALLunary(sv, CAT2(meth,_amg))
+
+#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 {					\
@@ -498,6 +483,31 @@ 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