X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=aeaca4c607a93bcde7caafc333c96a6a29dfa20b;hb=e91177edb0beae74fd07fb1ec08a528ab1fb63c2;hp=b266cb2579f6a4e168dd5c44e4a167bc7115b4c6;hpb=bb13cb927b2b56cd314cd059be1c58034bedcc3b;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp.c b/pp.c
index b266cb2..aeaca4c 100644
--- a/pp.c
+++ b/pp.c
@@ -46,7 +46,7 @@ typedef unsigned UBW;
  * have an integral type (except char) small enough to be represented
  * in a double without loss; that is, it has no 32-bit type.
  */
-#if BYTEORDER > 0xFFFF && defined(_CRAY) && !defined(_CRAYMPP)
+#if LONGSIZE > 4  && defined(_CRAY) && !defined(_CRAYMPP)
 #  define BW_BITS  32
 #  define BW_MASK  ((1 << BW_BITS) - 1)
 #  define BW_SIGN  (1 << (BW_BITS - 1))
@@ -69,7 +69,11 @@ typedef unsigned UBW;
  * If they're not right on your machine, then pack() and unpack()
  * wouldn't work right anyway; you'll need to apply the Cray hack.
  * (I'd like to check them with #if, but you can't use sizeof() in
- * the preprocessor.)
+ * the preprocessor.)  --???
+ */
+/*
+    The appropriate SHORTSIZE, INTSIZE, LONGSIZE, and LONGLONGSIZE
+    defines are now in config.h.  --Andy Dougherty  April 1998
  */
 #define SIZE16 2
 #define SIZE32 4
@@ -97,9 +101,11 @@ typedef unsigned UBW;
 #  define CAT32(sv,p)  sv_catpvn(sv, (char*)(p), SIZE32)
 #endif
 
+#ifndef PERL_OBJECT
 static void doencodes _((SV* sv, char* s, I32 len));
 static SV* refto _((SV* sv));
 static U32 seed _((void));
+#endif
 
 static bool srand_called = FALSE;
 
@@ -318,7 +324,11 @@ PP(pp_pos)
 	}
 
 	LvTYPE(TARG) = '.';
-	LvTARG(TARG) = sv;
+	if (LvTARG(TARG) != sv) {
+	    if (LvTARG(TARG))
+		SvREFCNT_dec(LvTARG(TARG));
+	    LvTARG(TARG) = SvREFCNT_inc(sv);
+	}
 	PUSHs(TARG);	/* no SvSETMAGIC */
 	RETURN;
     }
@@ -438,8 +448,13 @@ PP(pp_refgen)
 {
     djSP; dMARK;
     if (GIMME != G_ARRAY) {
-	MARK[1] = *SP;
-	SP = MARK + 1;
+	if (++MARK <= SP)
+	    *MARK = *SP;
+	else
+	    *MARK = &sv_undef;
+	*MARK = refto(*MARK);
+	SP = MARK;
+	RETURN;
     }
     EXTEND_MORTAL(SP - MARK);
     while (++MARK <= SP)
@@ -447,7 +462,7 @@ PP(pp_refgen)
     RETURN;
 }
 
-static SV*
+STATIC SV*
 refto(SV *sv)
 {
     SV* rv;
@@ -498,8 +513,14 @@ PP(pp_bless)
 
     if (MAXARG == 1)
 	stash = curcop->cop_stash;
-    else
-	stash = gv_stashsv(POPs, TRUE);
+    else {
+	SV *ssv = POPs;
+	STRLEN len;
+	char *ptr = SvPV(ssv,len);
+	if (dowarn && len == 0)
+	    warn("Explicit blessing to '' (assuming package main)");
+	stash = gv_stashpvn(ptr, len, TRUE);
+    }
 
     (void)sv_bless(TOPs, stash);
     RETURN;
@@ -509,40 +530,40 @@ PP(pp_gelem)
 {
     GV *gv;
     SV *sv;
-    SV *ref;
+    SV *tmpRef;
     char *elem;
     djSP;
 
     sv = POPs;
     elem = SvPV(sv, na);
     gv = (GV*)POPs;
-    ref = Nullsv;
+    tmpRef = Nullsv;
     sv = Nullsv;
     switch (elem ? *elem : '\0')
     {
     case 'A':
 	if (strEQ(elem, "ARRAY"))
-	    ref = (SV*)GvAV(gv);
+	    tmpRef = (SV*)GvAV(gv);
 	break;
     case 'C':
 	if (strEQ(elem, "CODE"))
-	    ref = (SV*)GvCVu(gv);
+	    tmpRef = (SV*)GvCVu(gv);
 	break;
     case 'F':
 	if (strEQ(elem, "FILEHANDLE")) /* XXX deprecate in 5.005 */
-	    ref = (SV*)GvIOp(gv);
+	    tmpRef = (SV*)GvIOp(gv);
 	break;
     case 'G':
 	if (strEQ(elem, "GLOB"))
-	    ref = (SV*)gv;
+	    tmpRef = (SV*)gv;
 	break;
     case 'H':
 	if (strEQ(elem, "HASH"))
-	    ref = (SV*)GvHV(gv);
+	    tmpRef = (SV*)GvHV(gv);
 	break;
     case 'I':
 	if (strEQ(elem, "IO"))
-	    ref = (SV*)GvIOp(gv);
+	    tmpRef = (SV*)GvIOp(gv);
 	break;
     case 'N':
 	if (strEQ(elem, "NAME"))
@@ -554,11 +575,11 @@ PP(pp_gelem)
 	break;
     case 'S':
 	if (strEQ(elem, "SCALAR"))
-	    ref = GvSV(gv);
+	    tmpRef = GvSV(gv);
 	break;
     }
-    if (ref)
-	sv = newRV(ref);
+    if (tmpRef)
+	sv = newRV(tmpRef);
     if (sv)
 	sv_2mortal(sv);
     else
@@ -754,7 +775,7 @@ PP(pp_undef)
 	hv_undef((HV*)sv);
 	break;
     case SVt_PVCV:
-	if (cv_const_sv((CV*)sv))
+	if (dowarn && cv_const_sv((CV*)sv))
 	    warn("Constant subroutine %s undefined",
 		 CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv)));
 	/* FALL THROUGH */
@@ -765,7 +786,17 @@ PP(pp_undef)
 	break;
     case SVt_PVGV:
 	if (SvFAKE(sv))
-	    sv_setsv(sv, &sv_undef);
+	    SvSetMagicSV(sv, &sv_undef);
+	else {
+	    GP *gp;
+	    gp_free((GV*)sv);
+	    Newz(602, gp, 1, GP);
+	    GvGP(sv) = gp_ref(gp);
+	    GvSV(sv) = NEWSV(72,0);
+	    GvLINE(sv) = curcop->cop_line;
+	    GvEGV(sv) = (GV*)sv;
+	    GvMULTI_on(sv);
+	}
 	break;
     default:
 	if (SvTYPE(sv) >= SVt_PV && SvPVX(sv) && SvLEN(sv)) {
@@ -890,7 +921,7 @@ PP(pp_divide)
 
 PP(pp_modulo)
 {
-    djSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
+    djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
     {
       UV left;
       UV right;
@@ -1376,7 +1407,7 @@ PP(pp_i_divide)
 
 PP(pp_i_modulo)
 {
-    djSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
+    djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); 
     {
       dPOPTOPiirl;
       if (!right)
@@ -1572,7 +1603,7 @@ PP(pp_srand)
     RETPUSHYES;
 }
 
-static U32
+STATIC U32
 seed(void)
 {
     /*
@@ -1764,6 +1795,7 @@ PP(pp_substr)
     djSP; dTARGET;
     SV *sv;
     I32 len;
+    I32 len_ok = 0;
     STRLEN curlen;
     I32 pos;
     I32 rem;
@@ -1771,17 +1803,34 @@ PP(pp_substr)
     I32 lvalue = op->op_flags & OPf_MOD;
     char *tmps;
     I32 arybase = curcop->cop_arybase;
+    char *repl = 0;
+    STRLEN repl_len;
 
-    if (MAXARG > 2)
+    SvTAINTED_off(TARG);			/* decontaminate */
+    if (MAXARG > 3) {
+	/* pop off replacement string */
+	sv = POPs;
+	repl = SvPV(sv, repl_len);
+	/* pop off length */
+	sv = POPs;
+	if (SvOK(sv)) {
+	    len = SvIV(sv);
+	    len_ok++;
+	}
+    } else if (MAXARG == 3) {
 	len = POPi;
+	len_ok++;
+    }  
+
     pos = POPi;
     sv = POPs;
+    PUTBACK;
     tmps = SvPV(sv, curlen);
     if (pos >= arybase) {
 	pos -= arybase;
 	rem = curlen-pos;
 	fail = rem;
-        if (MAXARG > 2) {
+        if (len_ok) {
             if (len < 0) {
 	        rem += len;
                 if (rem < 0)
@@ -1793,7 +1842,7 @@ PP(pp_substr)
     }
     else {
         pos += curlen;
-        if (MAXARG < 3)
+        if (!len_ok)
             rem = curlen;
         else if (len >= 0) {
             rem = pos+len;
@@ -1811,7 +1860,7 @@ PP(pp_substr)
         rem -= pos;
     }
     if (fail < 0) {
-	if (dowarn || lvalue)
+	if (dowarn || lvalue || repl)
 	    warn("substr outside of string");
 	RETPUSHUNDEF;
     }
@@ -1837,11 +1886,18 @@ PP(pp_substr)
 	    }
 
 	    LvTYPE(TARG) = 'x';
-	    LvTARG(TARG) = sv;
+	    if (LvTARG(TARG) != sv) {
+		if (LvTARG(TARG))
+		    SvREFCNT_dec(LvTARG(TARG));
+		LvTARG(TARG) = SvREFCNT_inc(sv);
+	    }
 	    LvTARGOFF(TARG) = pos;
 	    LvTARGLEN(TARG) = rem;
 	}
+        else if (repl)
+	    sv_insert(sv, pos, rem, repl, repl_len);
     }
+    SPAGAIN;
     PUSHs(TARG);		/* avoid SvSETMAGIC here */
     RETURN;
 }
@@ -1858,6 +1914,7 @@ PP(pp_vec)
     unsigned long retnum;
     I32 len;
 
+    SvTAINTED_off(TARG);			/* decontaminate */
     offset *= size;		/* turn into bit offset */
     len = (offset + size + 7) / 8;
     if (offset < 0 || size < 1)
@@ -1870,7 +1927,11 @@ PP(pp_vec)
 	    }
 
 	    LvTYPE(TARG) = 'v';
-	    LvTARG(TARG) = src;
+	    if (LvTARG(TARG) != src) {
+		if (LvTARG(TARG))
+		    SvREFCNT_dec(LvTARG(TARG));
+		LvTARG(TARG) = SvREFCNT_inc(src);
+	    }
 	    LvTARGOFF(TARG) = offset;
 	    LvTARGLEN(TARG) = size;
 	}
@@ -2483,7 +2544,7 @@ PP(pp_anonhash)
 	if (MARK < SP)
 	    sv_setsv(val, *++MARK);
 	else if (dowarn)
-	    warn("Odd number of elements in hash list");
+	    warn("Odd number of elements in hash assignment");
 	(void)hv_store_ent(hv,key,val,0);
     }
     SP = ORIGMARK;
@@ -2825,7 +2886,7 @@ PP(pp_reverse)
     RETURN;
 }
 
-static SV      *
+STATIC SV      *
 mul128(SV *sv, U8 m)
 {
   STRLEN          len;
@@ -3205,6 +3266,13 @@ PP(pp_unpack)
 		    Copy(s, &aint, 1, int);
 		    s += sizeof(int);
 		    sv = NEWSV(40, 0);
+#ifdef __osf__
+                    /* Without the dummy below unpack("i", pack("i",-1))
+                     * return 0xFFffFFff instead of -1 for Digital Unix V4.0
+                     * cc with optimization turned on */
+                    (aint) ?
+		    	sv_setiv(sv, (IV)aint) :
+#endif
 		    sv_setiv(sv, (IV)aint);
 		    PUSHs(sv_2mortal(sv));
 		}
@@ -3547,7 +3615,7 @@ PP(pp_unpack)
     RETURN;
 }
 
-static void
+STATIC void
 doencodes(register SV *sv, register char *s, register I32 len)
 {
     char hunk[5];
@@ -3571,7 +3639,7 @@ doencodes(register SV *sv, register char *s, register I32 len)
     sv_catpvn(sv, "\n", 1);
 }
 
-static SV      *
+STATIC SV      *
 is_an_int(char *s, STRLEN l)
 {
   SV             *result = newSVpv("", l);
@@ -3619,7 +3687,7 @@ is_an_int(char *s, STRLEN l)
   return (result);
 }
 
-static int
+STATIC int
 div128(SV *pnum, bool *done)
                           		    /* must be '\0' terminated */