X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=cc2ef0b0e9ce1b1598e1a2dc741073beea0ce91f;hb=8966fa011b808a24fc07394abb66cc70f27edc7e;hp=54433af292592387e8465ff5081ea21593f3b4ea;hpb=a5f75d667838e8e7bb037880391f5c44476d33b4;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp.c b/pp.c
index 54433af..cc2ef0b 100644
--- a/pp.c
+++ b/pp.c
@@ -98,7 +98,13 @@ PP(pp_rv2gv)
     if (SvROK(sv)) {
       wasref:
 	sv = SvRV(sv);
-	if (SvTYPE(sv) != SVt_PVGV)
+	if (SvTYPE(sv) == SVt_PVIO) {
+	    GV *gv = (GV*) sv_newmortal();
+	    gv_init(gv, 0, "", 0, 0);
+	    GvIOp(gv) = (IO *)sv;
+	    SvREFCNT_inc(sv);
+	    sv = (SV*) gv;
+	} else if (SvTYPE(sv) != SVt_PVGV)
 	    DIE("Not a GLOB reference");
     }
     else {
@@ -141,7 +147,7 @@ PP(pp_rv2gv)
 	    GvREFCNT(sv) = 1;
 	    GvSV(sv) = NEWSV(72,0);
 	    GvLINE(sv) = curcop->cop_line;
-	    GvEGV(sv) = sv;
+	    GvEGV(sv) = (GV*)sv;
 	}
     }
     SETs(sv);
@@ -163,7 +169,7 @@ PP(pp_rv2sv)
 	}
     }
     else {
-	GV *gv = sv;
+	GV *gv = (GV*)sv;
 	char *sym;
 
 	if (SvTYPE(gv) != SVt_PVGV) {
@@ -181,7 +187,7 @@ PP(pp_rv2sv)
 	    sym = SvPV(sv, na);
 	    if (op->op_private & HINT_STRICT_REFS)
 		DIE(no_symref, sym, "a SCALAR");
-	    gv = (SV*)gv_fetchpv(sym, TRUE, SVt_PV);
+	    gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV);
 	}
 	sv = GvSV(gv);
     }
@@ -331,6 +337,10 @@ PP(pp_ref)
     char *pv;
 
     sv = POPs;
+
+    if (sv && SvGMAGICAL(sv))
+	mg_get(sv);     
+
     if (!sv || !SvROK(sv))
 	RETPUSHNO;
 
@@ -566,8 +576,13 @@ PP(pp_predec)
 {
     dSP;
     if (SvIOK(TOPs)) {
-	--SvIVX(TOPs);
-	SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
+    	if (SvIVX(TOPs) == IV_MIN) {
+    	    sv_setnv(TOPs, (double)SvIVX(TOPs) - 1.0);
+    	}
+    	else {
+    	    --SvIVX(TOPs);
+	    SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
+	}
     }
     else
 	sv_dec(TOPs);
@@ -580,8 +595,13 @@ PP(pp_postinc)
     dSP; dTARGET;
     sv_setsv(TARG, TOPs);
     if (SvIOK(TOPs)) {
-	++SvIVX(TOPs);
-	SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
+    	if (SvIVX(TOPs) == IV_MAX) {
+    	    sv_setnv(TOPs, (double)SvIVX(TOPs) + 1.0);
+    	}
+    	else {
+	    ++SvIVX(TOPs);
+	    SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
+	}
     }
     else
 	sv_inc(TOPs);
@@ -597,8 +617,13 @@ PP(pp_postdec)
     dSP; dTARGET;
     sv_setsv(TARG, TOPs);
     if (SvIOK(TOPs)) {
-	--SvIVX(TOPs);
-	SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
+    	if (SvIVX(TOPs) == IV_MIN) {
+    	    sv_setnv(TOPs, (double)SvIVX(TOPs) - 1.0);
+    	}
+    	else {
+	    --SvIVX(TOPs);
+	    SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
+	}
     }
     else
 	sv_dec(TOPs);
@@ -662,19 +687,17 @@ PP(pp_modulo)
 {
     dSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
     {
-      register unsigned long tmpulong;
-      register long tmplong;
-      I32 value;
+      register IV value;
+      register UV uval;
 
-      tmpulong = (unsigned long) POPn;
-      if (tmpulong == 0L)
+      uval = POPn;
+      if (!uval)
 	DIE("Illegal modulus zero");
       value = TOPn;
-      if (value >= 0.0)
-	value = (I32)(((unsigned long)value) % tmpulong);
+      if (value >= 0)
+	value = (UV)value % uval;
       else {
-	tmplong = (long)value;
-	value = (I32)(tmpulong - ((-tmplong - 1) % tmpulong)) - 1;
+	value = (uval - ((UV)(-value - 1) % uval)) - 1;
       }
       SETi(value);
       RETURN;
@@ -901,7 +924,10 @@ PP(pp_bit_and) {
       if (SvNIOKp(left) || SvNIOKp(right)) {
 	unsigned long value = U_L(SvNV(left));
 	value = value & U_L(SvNV(right));
-	SETn((double)value);
+	if ((IV)value == value)
+	    SETi(value);
+	else
+	    SETn((double)value);
       }
       else {
 	do_vop(op->op_type, TARG, left, right);
@@ -919,7 +945,10 @@ PP(pp_bit_xor)
       if (SvNIOKp(left) || SvNIOKp(right)) {
 	unsigned long value = U_L(SvNV(left));
 	value = value ^ U_L(SvNV(right));
-	SETn((double)value);
+	if ((IV)value == value)
+	    SETi(value);
+	else
+	    SETn((double)value);
       }
       else {
 	do_vop(op->op_type, TARG, left, right);
@@ -937,7 +966,10 @@ PP(pp_bit_or)
       if (SvNIOKp(left) || SvNIOKp(right)) {
 	unsigned long value = U_L(SvNV(left));
 	value = value | U_L(SvNV(right));
-	SETn((double)value);
+	if ((IV)value == value)
+	    SETi(value);
+	else
+	    SETn((double)value);
       }
       else {
 	do_vop(op->op_type, TARG, left, right);
@@ -994,11 +1026,11 @@ PP(pp_complement)
       register I32 anum;
 
       if (SvNIOKp(sv)) {
-	IV iv = ~SvIV(sv);
-	if (iv < 0)
-	    SETn( (double) ~U_L(SvNV(sv)) );
+	UV value = ~SvIV(sv);
+	if ((IV)value == value)
+	    SETi(value);
 	else
-	    SETi( iv );
+	    SETn((double)value);
       }
       else {
 	register char *tmps;
@@ -1232,11 +1264,31 @@ PP(pp_srand)
 {
     dSP;
     I32 anum;
-    Time_t when;
 
     if (MAXARG < 1) {
+#ifdef VMS
+#  include <starlet.h>
+	unsigned int when[2];
+	_ckvmssts(sys$gettim(when));
+	anum = when[0] ^ when[1];
+#else
+#  if defined(I_SYS_TIME) && !defined(PLAN9)
+	struct timeval when;
+	gettimeofday(&when,(struct timezone *) 0);
+	anum = when.tv_sec ^ when.tv_usec;
+#  else
+	Time_t when;
 	(void)time(&when);
 	anum = when;
+#  endif
+#endif
+#if !defined(PLAN9) /* XXX Plan9 assembler chokes on this; fix coming soon  */
+                    /*     17-Jul-1996  bailey@genetics.upenn.edu           */
+	/* What is a good hashing algorithm here? */
+	anum ^= (  (  269 * (U32)getpid())
+	         ^ (26107 * (U32)&when)
+	         ^ (73819 * (U32)stack_sp));
+#endif
     }
     else
 	anum = POPi;
@@ -1401,8 +1453,17 @@ PP(pp_substr)
 	    rem = len;
 	sv_setpvn(TARG, tmps, rem);
 	if (lvalue) {			/* it's an lvalue! */
-	    if (!SvGMAGICAL(sv))
-		(void)SvPOK_only(sv);
+	    if (!SvGMAGICAL(sv)) {
+		if (SvROK(sv)) {
+		    SvPV_force(sv,na);
+		    if (dowarn)
+			warn("Attempt to use reference as lvalue in substr");
+		}
+		if (SvOK(sv))		/* is it defined ? */
+		    (void)SvPOK_only(sv);
+		else
+		    sv_setpvn(sv,"",0);	/* avoid lexical reincarnation */
+	    }
 	    if (SvTYPE(TARG) < SVt_PVLV) {
 		sv_upgrade(TARG, SVt_PVLV);
 		sv_magic(TARG, Nullsv, 'x', Nullch, 0);
@@ -1789,8 +1850,6 @@ PP(pp_each)
     dSP; dTARGET;
     HV *hash = (HV*)POPs;
     HE *entry;
-    I32 i;
-    char *tmps;
     
     PUTBACK;
     entry = hv_iternext(hash);                        /* might clobber stack_sp */
@@ -1798,10 +1857,7 @@ PP(pp_each)
 
     EXTEND(SP, 2);
     if (entry) {
-	tmps = hv_iterkey(entry, &i);	              /* won't clobber stack_sp */
-	if (!i)
-	    tmps = "";
-	PUSHs(sv_2mortal(newSVpv(tmps, i)));
+	PUSHs(hv_iterkeysv(entry));	              /* won't clobber stack_sp */
 	if (GIMME == G_ARRAY) {
 	    PUTBACK;
 	    sv_setsv(TARG, hv_iterval(hash, entry));  /* might clobber stack_sp */
@@ -1831,14 +1887,12 @@ PP(pp_delete)
     SV *sv;
     SV *tmpsv = POPs;
     HV *hv = (HV*)POPs;
-    char *tmps;
     STRLEN len;
     if (SvTYPE(hv) != SVt_PVHV) {
 	DIE("Not a HASH reference");
     }
-    tmps = SvPV(tmpsv, len);
-    sv = hv_delete(hv, tmps, len,
-	op->op_private & OPpLEAVE_VOID ? G_DISCARD : 0);
+    sv = hv_delete_ent(hv, tmpsv,
+	(op->op_private & OPpLEAVE_VOID ? G_DISCARD : 0), 0);
     if (!sv)
 	RETPUSHUNDEF;
     PUSHs(sv);
@@ -1850,13 +1904,11 @@ PP(pp_exists)
     dSP;
     SV *tmpsv = POPs;
     HV *hv = (HV*)POPs;
-    char *tmps;
     STRLEN len;
     if (SvTYPE(hv) != SVt_PVHV) {
 	DIE("Not a HASH reference");
     }
-    tmps = SvPV(tmpsv, len);
-    if (hv_exists(hv, tmps, len))
+    if (hv_exists_ent(hv, tmpsv, 0))
 	RETPUSHYES;
     RETPUSHNO;
 }
@@ -1864,23 +1916,22 @@ PP(pp_exists)
 PP(pp_hslice)
 {
     dSP; dMARK; dORIGMARK;
-    register SV **svp;
+    register HE *he;
     register HV *hv = (HV*)POPs;
     register I32 lval = op->op_flags & OPf_MOD;
 
     if (SvTYPE(hv) == SVt_PVHV) {
 	while (++MARK <= SP) {
-	    STRLEN keylen;
-	    char *key = SvPV(*MARK, keylen);
+	    SV *keysv = *MARK;
 
-	    svp = hv_fetch(hv, key, keylen, lval);
+	    he = hv_fetch_ent(hv, keysv, lval, 0);
 	    if (lval) {
-		if (!svp || *svp == &sv_undef)
-		    DIE(no_helem, key);
+		if (!he || HeVAL(he) == &sv_undef)
+		    DIE(no_helem, SvPV(keysv, na));
 		if (op->op_private & OPpLVAL_INTRO)
-		    save_svref(svp);
+		    save_svref(&HeVAL(he));
 	    }
-	    *MARK = svp ? *svp : &sv_undef;
+	    *MARK = he ? HeVAL(he) : &sv_undef;
 	}
     }
     if (GIMME != G_ARRAY) {
@@ -1981,14 +2032,12 @@ PP(pp_anonhash)
 
     while (MARK < SP) {
 	SV* key = *++MARK;
-	char *tmps;
 	SV *val = NEWSV(46, 0);
 	if (MARK < SP)
 	    sv_setsv(val, *++MARK);
 	else
 	    warn("Odd number of elements in hash list");
-	tmps = SvPV(key,len);
-	(void)hv_store(hv,tmps,len,val,0);
+	(void)hv_store_ent(hv,key,val,0);
     }
     SP = ORIGMARK;
     XPUSHs((SV*)hv);
@@ -2645,7 +2694,10 @@ PP(pp_unpack)
 		    Copy(s, &auint, 1, unsigned int);
 		    s += sizeof(unsigned int);
 		    sv = NEWSV(41, 0);
-		    sv_setiv(sv, (I32)auint);
+		    if (auint <= I32_MAX)
+		    	sv_setiv(sv, (I32)auint);
+		    else
+		    	sv_setnv(sv, (double)auint);
 		    PUSHs(sv_2mortal(sv));
 		}
 	    }
@@ -2829,6 +2881,8 @@ PP(pp_unpack)
 	case 'u':
 	    along = (strend - s) * 3 / 4;
 	    sv = NEWSV(42, along);
+	    if (along)
+		SvPOK_on(sv);
 	    while (s < strend && *s > ' ' && *s < 'a') {
 		I32 a, b, c, d;
 		char hunk[4];
@@ -3324,7 +3378,7 @@ PP(pp_split)
     I32 origlimit = limit;
     I32 realarray = 0;
     I32 base;
-    AV *oldstack = stack;
+    AV *oldstack = curstack;
     register REGEXP *rx = pm->op_pmregexp;
     I32 gimme = GIMME;
     I32 oldsave = savestack_ix;
@@ -3347,7 +3401,7 @@ PP(pp_split)
 	av_extend(ary,0);
 	av_clear(ary);
 	/* temporarily switch stacks */
-	SWITCHSTACK(stack, ary);
+	SWITCHSTACK(curstack, ary);
     }
     base = SP - stack_base;
     orig = s;
@@ -3486,7 +3540,7 @@ PP(pp_split)
 	iters++;
     }
     else if (!origlimit) {
-	while (iters > 0 && SvCUR(TOPs) == 0)
+	while (iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0))
 	    iters--, SP--;
     }
     if (realarray) {