LC_COLLATE.
[p5sagit/p5-mst-13.2.git] / pp.c
diff --git a/pp.c b/pp.c
index 159091f..cc2ef0b 100644 (file)
--- 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 {
@@ -132,7 +138,7 @@ PP(pp_rv2gv)
 
        if (op->op_flags & OPf_SPECIAL) {
            GvGP(sv)->gp_refcnt++;              /* will soon be assigned */
-           GvFLAGS(sv) |= GVf_INTRO;
+           GvINTRO_on(sv);
        }
        else {
            GP *gp;
@@ -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,26 +187,15 @@ 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);
     }
     if (op->op_flags & OPf_MOD) {
        if (op->op_private & OPpLVAL_INTRO)
            sv = save_scalar((GV*)TOPs);
-       else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV)) {
-           if (SvGMAGICAL(sv))
-               mg_get(sv);
-           if (!SvOK(sv)) {
-               if (SvREADONLY(sv))
-                   croak(no_modify);
-               (void)SvUPGRADE(sv, SVt_RV);
-               SvRV(sv) = (op->op_private & OPpDEREF_HV ?
-                           (SV*)newHV() : (SV*)newAV());
-               SvROK_on(sv);
-               SvSETMAGIC(sv);
-           }
-       }
+       else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV))
+           provide_ref(op, sv);
     }
     SETs(sv);
     RETURN;
@@ -284,9 +279,8 @@ PP(pp_anoncode)
     CV* cv = (CV*)cSVOP->op_sv;
     EXTEND(SP,1);
 
-    if (SvFLAGS(cv) & SVpcv_CLONE) {
+    if (CvCLONE(cv))
        cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
-    }
 
     PUSHs((SV*)cv);
     RETURN;
@@ -343,6 +337,10 @@ PP(pp_ref)
     char *pv;
 
     sv = POPs;
+
+    if (sv && SvGMAGICAL(sv))
+       mg_get(sv);     
+
     if (!sv || !SvROK(sv))
        RETPUSHNO;
 
@@ -433,6 +431,7 @@ PP(pp_study)
     }
 
     SvSCREAM_on(sv);
+    sv_magic(sv, Nullsv, 'g', Nullch, 0);      /* piggyback on m//g magic */
     retval = 1;
   ret:
     XPUSHs(sv_2mortal(newSViv((I32)retval)));
@@ -577,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);
@@ -591,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);
@@ -608,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);
@@ -673,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;
@@ -912,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);
@@ -930,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);
@@ -948,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);
@@ -1005,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;
@@ -1243,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;
@@ -1330,28 +1371,38 @@ PP(pp_hex)
 {
     dSP; dTARGET;
     char *tmps;
+    unsigned long value;
     I32 argtype;
 
     tmps = POPp;
-    XPUSHi( scan_hex(tmps, 99, &argtype) );
+    value = scan_hex(tmps, 99, &argtype);
+    if ((IV)value >= 0)
+       XPUSHi(value);
+    else
+       XPUSHn(U_V(value));
     RETURN;
 }
 
 PP(pp_oct)
 {
     dSP; dTARGET;
-    I32 value;
+    unsigned long value;
     I32 argtype;
     char *tmps;
 
     tmps = POPp;
-    while (*tmps && (isSPACE(*tmps) || *tmps == '0'))
+    while (*tmps && isSPACE(*tmps))
+       tmps++;
+    if (*tmps == '0')
        tmps++;
     if (*tmps == 'x')
-       value = (I32)scan_hex(++tmps, 99, &argtype);
+       value = scan_hex(++tmps, 99, &argtype);
     else
-       value = (I32)scan_oct(tmps, 99, &argtype);
-    XPUSHi(value);
+       value = scan_oct(tmps, 99, &argtype);
+    if ((IV)value >= 0)
+       XPUSHi(value);
+    else
+       XPUSHn(U_V(value));
     RETURN;
 }
 
@@ -1402,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);
@@ -1790,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 */
@@ -1799,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 */
@@ -1832,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);
@@ -1851,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;
 }
@@ -1865,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) {
@@ -1982,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);
@@ -2646,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));
                }
            }
@@ -2830,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];
@@ -3325,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;
@@ -3348,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;
@@ -3487,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) {