LC_COLLATE.
[p5sagit/p5-mst-13.2.git] / pp.c
diff --git a/pp.c b/pp.c
index 048af2e..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,21 +147,13 @@ 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);
     RETURN;
 }
 
-PP(pp_sv2len)
-{
-    dSP; dTARGET;
-    dPOPss;
-    PUSHi(sv_len(sv));
-    RETURN;
-}
-
 PP(pp_rv2sv)
 {
     dSP; dTOPss;
@@ -171,7 +169,7 @@ PP(pp_rv2sv)
        }
     }
     else {
-       GV *gv = sv;
+       GV *gv = (GV*)sv;
        char *sym;
 
        if (SvTYPE(gv) != SVt_PVGV) {
@@ -189,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;
@@ -268,15 +255,32 @@ PP(pp_rv2cv)
     RETURN;
 }
 
+PP(pp_prototype)
+{
+    dSP;
+    CV *cv;
+    HV *stash;
+    GV *gv;
+    SV *ret;
+
+    ret = &sv_undef;
+    cv = sv_2cv(TOPs, &stash, &gv, FALSE);
+    if (cv && SvPOK(cv)) {
+       char *p = SvPVX(cv);
+       ret = sv_2mortal(newSVpv(p ? p : "", SvLEN(cv)));
+    }
+    SETs(ret);
+    RETURN;
+}
+
 PP(pp_anoncode)
 {
     dSP;
     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;
@@ -333,6 +337,10 @@ PP(pp_ref)
     char *pv;
 
     sv = POPs;
+
+    if (sv && SvGMAGICAL(sv))
+       mg_get(sv);     
+
     if (!sv || !SvROK(sv))
        RETPUSHNO;
 
@@ -360,7 +368,7 @@ PP(pp_bless)
 
 PP(pp_study)
 {
-    dSP; dTARGET;
+    dSP; dPOPss;
     register unsigned char *s;
     register I32 pos;
     register I32 ch;
@@ -369,11 +377,17 @@ PP(pp_study)
     I32 retval;
     STRLEN len;
 
-    s = (unsigned char*)(SvPV(TARG, len));
+    s = (unsigned char*)(SvPV(sv, len));
     pos = len;
-    if (lastscream)
-       SvSCREAM_off(lastscream);
-    lastscream = TARG;
+    if (sv == lastscream)
+       SvSCREAM_off(sv);
+    else {
+       if (lastscream) {
+           SvSCREAM_off(lastscream);
+           SvREFCNT_dec(lastscream);
+       }
+       lastscream = SvREFCNT_inc(sv);
+    }
     if (pos <= 0) {
        retval = 0;
        goto ret;
@@ -416,7 +430,8 @@ PP(pp_study)
            sfirst[fold[ch]] = pos;
     }
 
-    SvSCREAM_on(TARG);
+    SvSCREAM_on(sv);
+    sv_magic(sv, Nullsv, 'g', Nullch, 0);      /* piggyback on m//g magic */
     retval = 1;
   ret:
     XPUSHs(sv_2mortal(newSViv((I32)retval)));
@@ -561,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);
@@ -575,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);
@@ -592,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);
@@ -657,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;
@@ -896,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);
@@ -914,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);
@@ -932,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);
@@ -989,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;
@@ -1227,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;
@@ -1314,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;
 }
 
@@ -1386,7 +1453,17 @@ PP(pp_substr)
            rem = len;
        sv_setpvn(TARG, tmps, rem);
        if (lvalue) {                   /* it's an lvalue! */
-           (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);
@@ -1704,7 +1781,7 @@ PP(pp_quotemeta)
 
     if (len) {
        (void)SvUPGRADE(TARG, SVt_PV);
-       SvGROW(TARG, len * 2);
+       SvGROW(TARG, (len * 2) + 1);
        d = SvPVX(TARG);
        while (len--) {
            if (!isALNUM(*s))
@@ -1772,18 +1849,19 @@ PP(pp_each)
 {
     dSP; dTARGET;
     HV *hash = (HV*)POPs;
-    HE *entry = hv_iternext(hash);
-    I32 i;
-    char *tmps;
+    HE *entry;
+    
+    PUTBACK;
+    entry = hv_iternext(hash);                        /* might clobber stack_sp */
+    SPAGAIN;
 
     EXTEND(SP, 2);
     if (entry) {
-       tmps = hv_iterkey(entry, &i);
-       if (!i)
-           tmps = "";
-       PUSHs(sv_2mortal(newSVpv(tmps, i)));
+       PUSHs(hv_iterkeysv(entry));                   /* won't clobber stack_sp */
        if (GIMME == G_ARRAY) {
-           sv_setsv(TARG, hv_iterval(hash, entry));
+           PUTBACK;
+           sv_setsv(TARG, hv_iterval(hash, entry));  /* might clobber stack_sp */
+           SPAGAIN;
            PUSHs(TARG);
        }
     }
@@ -1809,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);
@@ -1828,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;
 }
@@ -1842,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) {
@@ -1959,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);
@@ -2623,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));
                }
            }
@@ -2807,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];
@@ -3302,9 +3378,10 @@ 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;
 
     if (!pm || !s)
        DIE("panic: do_split");
@@ -3324,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;
@@ -3332,6 +3409,11 @@ PP(pp_split)
        while (isSPACE(*s))
            s++;
     }
+    if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
+       SAVEINT(multiline);
+       multiline = pm->op_pmflags & PMf_MULTILINE;
+    }
+
     if (!limit)
        limit = maxiters + 2;
     if (pm->op_pmflags & PMf_WHITE) {
@@ -3443,6 +3525,7 @@ PP(pp_split)
            s = rx->endp[0];
        }
     }
+    LEAVE_SCOPE(oldsave);
     iters = (SP - stack_base) - base;
     if (iters > maxiters)
        DIE("Split loop");
@@ -3457,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) {