Re: embedded perl and top_env problem

[p5sagit/p5-mst-13.2.git] / pp.c

diff --git a/pp.c b/pp.c
index fe3c675..4ca4b3e 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -198,7 +198,7 @@ PP(pp_rv2sv)
        if (op->op_private & OPpLVAL_INTRO)
            sv = save_scalar((GV*)TOPs);
        else if (op->op_private & OPpDEREF)
-           provide_ref(op, sv);
+           vivify_ref(sv, op->op_private & OPpDEREF);
     }
     SETs(sv);
     RETURN;
@@ -321,9 +321,9 @@ SV* sv;
 
     if (SvTYPE(sv) == SVt_PVLV && LvTYPE(sv) == 'y') {
        if (LvTARGLEN(sv))
-           vivify_itervar(sv);
-       if (LvTARG(sv))
-           sv = LvTARG(sv);
+           vivify_defelem(sv);
+       if (!(sv = LvTARG(sv)))
+           sv = &sv_undef;
     }
     else if (SvPADTMP(sv))
        sv = newSVsv(sv);
@@ -578,7 +578,7 @@ PP(pp_undef)
 PP(pp_predec)
 {
     dSP;
-    if (SvREADONLY(TOPs))
+    if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
        croak(no_modify);
     if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
        SvIVX(TOPs) != IV_MIN)
@@ -595,7 +595,7 @@ PP(pp_predec)
 PP(pp_postinc)
 {
     dSP; dTARGET;
-    if (SvREADONLY(TOPs))
+    if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
        croak(no_modify);
     sv_setsv(TARG, TOPs);
     if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
@@ -616,7 +616,7 @@ PP(pp_postinc)
 PP(pp_postdec)
 {
     dSP; dTARGET;
-    if(SvREADONLY(TOPs))
+    if(SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
        croak(no_modify);
     sv_setsv(TARG, TOPs);
     if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
@@ -686,26 +686,45 @@ PP(pp_modulo)
 {
     dSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
     {
-      register UV right;
+      UV left;
+      UV right;
+      bool left_neg;
+      bool right_neg;
+      UV ans;
 
-      right = POPu;
-      if (!right)
-       DIE("Illegal modulus zero");
+      if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
+       IV i = SvIVX(POPs);
+       right = (right_neg = (i < 0)) ? -i : i;
+      }
+      else {
+       double n = POPn;
+       right = U_V((right_neg = (n < 0)) ? -n : n);
+      }
 
       if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
-       register IV left = SvIVX(TOPs);
-       if (left < 0)
-         SETu( (right - ((UV)(-left) - 1) % right) - 1 );
-       else
-         SETi( left % right );
+       IV i = SvIVX(POPs);
+       left = (left_neg = (i < 0)) ? -i : i;
       }
       else {
-       register double left = TOPn;
-       if (left < 0.0)
-         SETu( (right - (U_V(-left) - 1) % right) - 1 );
+       double n = POPn;
+       left = U_V((left_neg = (n < 0)) ? -n : n);
+      }
+
+      if (!right)
+       DIE("Illegal modulus zero");
+
+      ans = left % right;
+      if ((left_neg != right_neg) && ans)
+       ans = right - ans;
+      if (right_neg) {
+       if (ans <= -(UV)IV_MAX)
+         sv_setiv(TARG, (IV) -ans);
        else
-         SETu( U_V(left) % right );
+         sv_setnv(TARG, -(double)ans);
       }
+      else
+       sv_setuv(TARG, ans);
+      PUSHTARG;
       RETURN;
     }
 }
@@ -1344,28 +1363,50 @@ PP(pp_srand)
 static U32
 seed()
 {
+    /*
+     * This is really just a quick hack which grabs various garbage
+     * values.  It really should be a real hash algorithm which
+     * spreads the effect of every input bit onto every output bit,
+     * if someone who knows about such tings would bother to write it.
+     * Might be a good idea to add that function to CORE as well.
+     * No numbers below come from careful analysis or anyting here,
+     * except they are primes and SEED_C1 > 1E6 to get a full-width
+     * value from (tv_sec * SEED_C1 + tv_usec).  The multipliers should
+     * probably be bigger too.
+     */
+#if RANDBITS > 16
+#  define SEED_C1      1000003
+#define   SEED_C4      73819
+#else
+#  define SEED_C1      25747
+#define   SEED_C4      20639
+#endif
+#define   SEED_C2      3
+#define   SEED_C3      269
+#define   SEED_C5      26107
+
     U32 u;
 #ifdef VMS
 #  include <starlet.h>
     unsigned int when[2];
     _ckvmssts(sys$gettim(when));
-    u = when[0] ^ when[1];
+    /* Please tell us:  Which value is seconds and what is the other here? */
+    u = (U32)SEED_C1 * when[0] + (U32)SEED_C2 * when[1];
 #else
 #  ifdef HAS_GETTIMEOFDAY
     struct timeval when;
     gettimeofday(&when,(struct timezone *) 0);
-    u = when.tv_sec ^ when.tv_usec;
+    u = (U32)SEED_C1 * when.tv_sec + (U32)SEED_C2 * when.tv_usec;
 #  else
     Time_t when;
     (void)time(&when);
-    u = when;
+    u = (U32)SEED_C1 * when;
 #  endif
 #endif
-#ifndef PLAN9          /* XXX Plan9 assembler chokes on this; fix needed  */
-    /* What is a good hashing algorithm here? */
-    u ^= (   (  269 * (U32)getpid())
-          ^ (26107 * (U32)&when)
-          ^ (73819 * (U32)stack_sp));
+    u += SEED_C3 * (U32)getpid();
+    u += SEED_C4 * (U32)stack_sp;
+#ifndef PLAN9           /* XXX Plan9 assembler chokes on this; fix needed  */
+    u += SEED_C5 * (U32)&when;
 #endif
     return u;
 }
@@ -1523,7 +1564,8 @@ PP(pp_substr)
     tmps = SvPV(sv, curlen);
     if (pos < 0) {
        pos += curlen + arybase;
-       if (pos < 0 && MAXARG < 3) pos = 0;
+       if (pos < 0 && MAXARG < 3)
+           pos = 0;
     }
     if (pos < 0 || pos > curlen) {
        if (dowarn || lvalue)