perl 5.000perl-5.000

[editor's note: this commit combines approximate 4 months of furious
releases of Andy Dougherty and Larry Wall - see pod/perlhist.pod for
details.  Andy notes that;
 
Alas neither my "Irwin AccuTrack" nor my DC 600A quarter-inch cartridge 
backup tapes from that era seem to be readable anymore.  I guess 13 years 
exceeds the shelf life for that backup technology :-(.
]

1 files changed, 98 insertions, 74 deletions

diff --git a/pp.h b/pp.h
index 502ced016d..e17c2ebea0 100644
--- a/pp.h
+++ b/pp.h
@@ -1,23 +1,11 @@
-/***********************************************************
+/*    pp.h
  *
- * $Header: /usr/src/local/lwall/perl5/RCS/pp.h,v 4.1 92/08/07 18:26:20 lwall Exp Locker: lwall $
+ *    Copyright (c) 1991-1994, Larry Wall
  *
- * Description:
- *	Push/Pop code defs.
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
  *
- * Standards:
- *
- * Created:
- *	Mon Jun 15 16:47:20 1992
- *
- * Author:
- *	Larry Wall <lwall@netlabs.com>
- *
- * $Log:	pp.h,v $
- * Revision 4.1  92/08/07  18:26:20  lwall
- * 
- *
- **********************************************************/
+ */
 
 #define ARGS
 #define ARGSproto void
@@ -28,12 +16,18 @@
 #define MARK mark
 #define TARG targ
 
+#define PUSHMARK(p) if (++markstack_ptr == markstack_max)	\
+			markstack_grow();			\
+		    *markstack_ptr = (p) - stack_base
+
+#define TOPMARK		(*markstack_ptr)
 #define POPMARK		(*markstack_ptr--)
+
 #define dSP		register SV **sp = stack_sp
 #define dMARK		register SV **mark = stack_base + POPMARK
 #define dORIGMARK	I32 origmark = mark - stack_base
 #define SETORIGMARK	origmark = mark - stack_base
-#define ORIGMARK	stack_base + origmark
+#define ORIGMARK	(stack_base + origmark)
 
 #define SPAGAIN		sp = stack_sp
 #define MSPAGAIN	sp = stack_sp; mark = ORIGMARK
@@ -49,20 +43,8 @@
 
 #define dTARG SV *targ
 
-#define GETavn(a,g,st) \
-	a = sv_2av(cGVOP->op_gv ? (SV*)cGVOP->op_gv : POPs, &st, &g, 1)
-#define GEThvn(h,g,st) \
-	h = sv_2hv(cGVOP->op_gv ? (SV*)cGVOP->op_gv : POPs, &st, &g, 1)
-#define GETav(a,g,st) \
-	a = sv_2av(cGVOP->op_gv ? (SV*)cGVOP->op_gv : POPs, &st, &g, 0)
-#define GEThv(h,g,st) \
-	h = sv_2hv(cGVOP->op_gv ? (SV*)cGVOP->op_gv : POPs, &st, &g, 0)
-#define GETcv(r,g,st) \
-	r = sv_2cv(POPs, &st, &g, 0)
-
 #define NORMAL op->op_next
 #define DIE return die
-#define PROP if (dying) return die("%s", dying);
 
 #define PUTBACK		stack_sp = sp
 #define RETURN		return PUTBACK, NORMAL
@@ -72,69 +54,63 @@
 #define POPs		(*sp--)
 #define POPp		(SvPVx(POPs, na))
 #define POPn		(SvNVx(POPs))
-#define POPi		((int)SvIVx(POPs))
+#define POPi		((IV)SvIVx(POPs))
 #define POPl		((long)SvIVx(POPs))
 
 #define TOPs		(*sp)
 #define TOPp		(SvPV(TOPs, na))
 #define TOPn		(SvNV(TOPs))
-#define TOPi		((int)SvIV(TOPs))
+#define TOPi		((IV)SvIV(TOPs))
 #define TOPl		((long)SvIV(TOPs))
 
 /* Go to some pains in the rare event that we must extend the stack. */
 #define EXTEND(p,n)	do { if (stack_max - p < (n)) {		  	    \
-			    av_fill(stack, (p - stack_base) + (n) + 128);   \
-			    sp = AvARRAY(stack) + (sp - stack_base);	    \
-			    stack_base = AvARRAY(stack);		    \
-			    stack_max = stack_base + AvMAX(stack) - 1;	    \
+			    sp = stack_grow(sp,p, (int) (n));		    \
 			} } while (0)
+
 /* Same thing, but update mark register too. */
 #define MEXTEND(p,n)	do {if (stack_max - p < (n)) {			    \
-			    av_fill(stack, (p - stack_base) + (n) + 128);   \
-			    sp   = AvARRAY(stack) + (sp   - stack_base);    \
-			    mark = AvARRAY(stack) + (mark - stack_base);    \
-			    stack_base = AvARRAY(stack);		    \
-			    stack_max = stack_base + AvMAX(stack) - 1;	    \
+			    int markoff = mark - stack_base;		    \
+			    sp = stack_grow(sp,p,(int) (n));		    \
+			    mark = stack_base + markoff;		    \
 			} } while (0)
 
 #define PUSHs(s)	(*++sp = (s))
 #define PUSHTARG	do { SvSETMAGIC(TARG); PUSHs(TARG); } while (0)
 #define PUSHp(p,l)	do { sv_setpvn(TARG, (p), (l)); PUSHTARG; } while (0)
-#define PUSHn(n)	do { sv_setnv(TARG, (n)); PUSHTARG; } while (0)
-#define PUSHi(i)	do { sv_setiv(TARG, (i)); PUSHTARG; } while (0)
+#define PUSHn(n)	do { sv_setnv(TARG, (double)(n)); PUSHTARG; } while (0)
+#define PUSHi(i)	do { sv_setiv(TARG, (IV)(i)); PUSHTARG; } while (0)
 
 #define XPUSHs(s)	do { EXTEND(sp,1); (*++sp = (s)); } while (0)
 #define XPUSHTARG	do { SvSETMAGIC(TARG); XPUSHs(TARG); } while (0)
 #define XPUSHp(p,l)	do { sv_setpvn(TARG, (p), (l)); XPUSHTARG; } while (0)
-#define XPUSHn(n)	do { sv_setnv(TARG, (n)); XPUSHTARG; } while (0)
-#define XPUSHi(i)	do { sv_setiv(TARG, (i)); XPUSHTARG; } while (0)
-
-#define MXPUSHs(s)	do { MEXTEND(sp,1); (*++sp = (s)); } while (0)
-#define MXPUSHTARG	do { SvSETMAGIC(TARG); XPUSHs(TARG); } while (0)
-#define MXPUSHp(p,l)	do { sv_setpvn(TARG, (p), (l)); XPUSHTARG; } while (0)
-#define MXPUSHn(n)	do { sv_setnv(TARG, (n)); XPUSHTARG; } while (0)
-#define MXPUSHi(i)	do { sv_setiv(TARG, (i)); XPUSHTARG; } while (0)
+#define XPUSHn(n)	do { sv_setnv(TARG, (double)(n)); XPUSHTARG; } while (0)
+#define XPUSHi(i)	do { sv_setiv(TARG, (IV)(i)); XPUSHTARG; } while (0)
 
 #define SETs(s)		(*sp = s)
 #define SETTARG		do { SvSETMAGIC(TARG); SETs(TARG); } while (0)
 #define SETp(p,l)	do { sv_setpvn(TARG, (p), (l)); SETTARG; } while (0)
-#define SETn(n)		do { sv_setnv(TARG, (n)); SETTARG; } while (0)
-#define SETi(i)		do { sv_setiv(TARG, (i)); SETTARG; } while (0)
+#define SETn(n)		do { sv_setnv(TARG, (double)(n)); SETTARG; } while (0)
+#define SETi(i)		do { sv_setiv(TARG, (IV)(i)); SETTARG; } while (0)
+
+#ifdef OVERLOAD
+#define SETsv(sv)	do { sv_setsv(TARG, (sv)); SETTARG; } while (0)
+#endif /* OVERLOAD */
 
 #define dTOPss		SV *sv = TOPs
 #define dPOPss		SV *sv = POPs
 #define dTOPnv		double value = TOPn
 #define dPOPnv		double value = POPn
-#define dTOPiv		I32 value = TOPi
-#define dPOPiv		I32 value = POPi
+#define dTOPiv		IV value = TOPi
+#define dPOPiv		IV value = POPi
 
-#define dPOPPOPssrl	SV *rstr = POPs; SV *lstr = POPs
+#define dPOPPOPssrl	SV *right = POPs; SV *left = POPs
 #define dPOPPOPnnrl	double right = POPn; double left = POPn
-#define dPOPPOPiirl	I32 right = POPi; I32 left = POPi
+#define dPOPPOPiirl	IV right = POPi; IV left = POPi
 
-#define dPOPTOPssrl	SV *rstr = POPs; SV *lstr = TOPs
+#define dPOPTOPssrl	SV *right = POPs; SV *left = TOPs
 #define dPOPTOPnnrl	double right = POPn; double left = TOPn
-#define dPOPTOPiirl	I32 right = POPi; I32 left = TOPi
+#define dPOPTOPiirl	IV right = POPi; IV left = TOPi
 
 #define RETPUSHYES	RETURNX(PUSHs(&sv_yes))
 #define RETPUSHNO	RETURNX(PUSHs(&sv_no))
@@ -150,20 +126,68 @@
 #define SWITCHSTACK(f,t)	AvFILL(f) = sp - stack_base;		\
 				stack_base = AvARRAY(t);		\
 				stack_max = stack_base + AvMAX(t);	\
-				sp = stack_base + AvFILL(t);		\
+				sp = stack_sp = stack_base + AvFILL(t);	\
 				stack = t;
 
-#define ENTER push_scope()
-#define LEAVE pop_scope()
-
-#define SAVEINT(i) save_int((int*)(&i));
-#define SAVEI32(i) save_I32((I32*)(&i));
-#define SAVELONG(l) save_long((long*)(&l));
-#define SAVESPTR(s) save_sptr((SV**)(&s))
-#define SAVEPPTR(s) save_pptr((char**)(&s))
-#define SAVETMPS save_int(&tmps_floor), tmps_floor = tmps_ix
-#define SAVEFREESV(s) save_freesv((SV*)(s))
-#define SAVEFREEOP(o) save_freeop((OP*)(o))
-#define SAVEFREEPV(p) save_freepv((char*)(p))
-#define SAVECLEARSV(sv) save_clearsv((SV**)(&sv))
-#define SAVEDELETE(h,k,l) save_delete((HV*)(h), (char*)(k), (I32)l)
+#ifdef OVERLOAD
+
+#define AMGf_noright	1
+#define AMGf_noleft	2
+#define AMGf_assign	4
+#define AMGf_unary	8
+
+#define tryAMAGICbinW(meth,assign,set) do { \
+          if (amagic_generation) { \
+	    SV* tmpsv; \
+	    SV* right= *(sp); SV* left= *(sp-1);\
+	    if ((SvAMAGIC(left)||SvAMAGIC(right))&&\
+		(tmpsv=amagic_call(left, \
+				   right, \
+				   CAT2(meth,_amg), \
+				   (assign)? AMGf_assign: 0))) {\
+	       SPAGAIN;	\
+	       (void)POPs; set(tmpsv); RETURN; } \
+	  } \
+	} while (0)
+
+#define tryAMAGICbin(meth,assign) tryAMAGICbinW(meth,assign,SETsv)
+#define tryAMAGICbinSET(meth,assign) tryAMAGICbinW(meth,assign,SETs)
+
+#define AMG_CALLun(sv,meth) amagic_call(sv,&sv_undef,  \
+					CAT2(meth,_amg),AMGf_noright | AMGf_unary)
+#define AMG_CALLbinL(left,right,meth) \
+            amagic_call(left,right,CAT2(meth,_amg),AMGf_noright)
+
+#define tryAMAGICunW(meth,set) do { \
+          if (amagic_generation) { \
+	    SV* tmpsv; \
+	    SV* arg= *(sp); \
+	    if ((SvAMAGIC(arg))&&\
+		(tmpsv=AMG_CALLun(arg,meth))) {\
+	       SPAGAIN;	\
+	       set(tmpsv); RETURN; } \
+	  } \
+	} while (0)
+
+#define tryAMAGICun(meth) tryAMAGICunW(meth,SETsv)
+#define tryAMAGICunSET(meth) tryAMAGICunW(meth,SETs)
+
+#define opASSIGN (op->op_flags & OPf_STACKED)
+
+/* newSVsv does not behave as advertised, so we copy missing
+ * information by hand */
+
+
+#define RvDEEPCP(rv) do { SV* ref=SvRV(rv);      \
+  if (SvREFCNT(ref)>1) {                 \
+    SvREFCNT_dec(ref);                   \
+    SvRV(rv)=newSVsv(ref);               \
+  } } while (0)
+#else
+
+#define tryAMAGICbin(a,b)
+#define tryAMAGICbinSET(a,b)
+#define tryAMAGICun(a)
+#define tryAMAGICunSET(a)
+
+#endif /* OVERLOAD */