LC_COLLATE.

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

diff --git a/pp_hot.c b/pp_hot.c
index 9945dd4..bf33ab8 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -252,8 +252,13 @@ PP(pp_preinc)
 {
     dSP;
     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);
@@ -315,16 +320,31 @@ PP(pp_print)
     dSP; dMARK; dORIGMARK;
     GV *gv;
     IO *io;
-    register FILE *fp;
+    register PerlIO *fp;
+    MAGIC *mg;
 
     if (op->op_flags & OPf_STACKED)
        gv = (GV*)*++MARK;
     else
        gv = defoutgv;
+    if (SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
+       SV *sv;
+
+       PUSHMARK(MARK-1);
+       *MARK = mg->mg_obj;
+       ENTER;
+       perl_call_method("PRINT", G_SCALAR);
+       LEAVE;
+       SPAGAIN;
+       sv = POPs;
+       SP = ORIGMARK;
+       PUSHs(sv);
+       RETURN;
+    }
     if (!(io = GvIO(gv))) {
        if (dowarn) {
            SV* sv = sv_newmortal();
-            gv_fullname(sv,gv);
+            gv_fullname(sv, gv, Nullch);
             warn("Filehandle %s never opened", SvPV(sv,na));
         }
 
@@ -334,7 +354,7 @@ PP(pp_print)
     else if (!(fp = IoOFP(io))) {
        if (dowarn)  {
            SV* sv = sv_newmortal();
-            gv_fullname(sv,gv);
+            gv_fullname(sv, gv, Nullch);
            if (IoIFP(io))
                warn("Filehandle %s opened only for input", SvPV(sv,na));
            else
@@ -351,7 +371,7 @@ PP(pp_print)
                    break;
                MARK++;
                if (MARK <= SP) {
-                   if (fwrite1(ofs, 1, ofslen, fp) == 0 || ferror(fp)) {
+                   if (PerlIO_write(fp, ofs, ofslen) == 0 || PerlIO_error(fp)) {
                        MARK--;
                        break;
                    }
@@ -369,11 +389,11 @@ PP(pp_print)
            goto just_say_no;
        else {
            if (orslen)
-               if (fwrite1(ors, 1, orslen, fp) == 0 || ferror(fp))
+               if (PerlIO_write(fp, ors, orslen) == 0 || PerlIO_error(fp))
                    goto just_say_no;
 
            if (IoFLAGS(io) & IOf_FLUSH)
-               if (Fflush(fp) == EOF)
+               if (PerlIO_flush(fp) == EOF)
                    goto just_say_no;
        }
     }
@@ -603,7 +623,6 @@ PP(pp_aassign)
            }
            break;
        case SVt_PVHV: {
-               char *tmps;
                SV *tmpstr;
 
                hash = (HV*)sv;
@@ -616,16 +635,17 @@ PP(pp_aassign)
                        sv = *(relem++);
                    else
                        sv = &sv_no, relem++;
-                   tmps = SvPV(sv, len);
                    tmpstr = NEWSV(29,0);
                    if (*relem)
                        sv_setsv(tmpstr,*relem);        /* value */
                    *(relem++) = tmpstr;
-                   (void)hv_store(hash,tmps,len,tmpstr,0);
+                   (void)hv_store_ent(hash,sv,tmpstr,0);
                    if (magic)
                        mg_set(tmpstr);
                    tainted = 0;
                }
+               if (relem == lastrelem)
+                   warn("Odd number of elements in hash list");
            }
            break;
        default:
@@ -817,7 +837,7 @@ play_it_again:
        }
        else if (!multiline) {
            if (*SvPVX(pm->op_pmshort) != *s ||
-             bcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen) ) {
+             memcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen) ) {
                if (pm->op_pmflags & PMf_FOLD) {
                    if (ibcmp((U8*)SvPVX(pm->op_pmshort), (U8*)s, pm->op_pmslen) )
                        goto nope;
@@ -944,10 +964,22 @@ do_readline()
     register SV *sv;
     STRLEN tmplen = 0;
     STRLEN offset;
-    FILE *fp;
+    PerlIO *fp;
     register IO *io = GvIO(last_in_gv);
     register I32 type = op->op_type;
+    MAGIC *mg;
 
+    if (SvMAGICAL(last_in_gv) && (mg = mg_find((SV*)last_in_gv, 'q'))) {
+       PUSHMARK(SP);
+       XPUSHs(mg->mg_obj);
+       PUTBACK;
+       ENTER;
+       perl_call_method("READLINE", GIMME);
+       LEAVE;
+       SPAGAIN;
+       if (GIMME == G_SCALAR) sv_setsv(TARG, TOPs);
+       RETURN;
+    }
     fp = Nullfp;
     if (io) {
        fp = IoIFP(io);
@@ -984,7 +1016,7 @@ do_readline()
                    char *rstr = rslt + sizeof(unsigned short int), *begin, *end, *cp;
                    char tmpfnam[L_tmpnam] = "SYS$SCRATCH:";
                    $DESCRIPTOR(dfltdsc,"SYS$DISK:[]*.*;");
-                   FILE *tmpfp;
+                   PerlIO *tmpfp;
                    STRLEN i;
                    struct dsc$descriptor_s wilddsc
                       = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
@@ -1014,7 +1046,7 @@ do_readline()
                           break;
                       }
                    }
-                   if ((tmpfp = fopen(tmpfnam,"w+","fop=dlt")) != NULL) {
+                   if ((tmpfp = PerlIO_open(tmpfnam,"w+","fop=dlt")) != NULL) {
                        ok = ((wilddsc.dsc$a_pointer = tovmsspec(SvPVX(tmpglob),vmsspec)) != NULL);
                        if (ok) wilddsc.dsc$w_length = (unsigned short int) strlen(wilddsc.dsc$a_pointer);
                        while (ok && ((sts = lib$find_file(&wilddsc,&rsdsc,&cxt,
@@ -1032,7 +1064,7 @@ do_readline()
                                while (*(--begin) != ']' && *begin != '>') ;
                                ++begin;
                            }
-                           ok = (fputs(begin,tmpfp) != EOF);
+                           ok = (PerlIO_puts(tmpfp,begin) != EOF);
                        }
                        if (cxt) (void)lib$find_file_end(&cxt);
                        if (ok && sts != RMS$_NMF &&
@@ -1041,11 +1073,11 @@ do_readline()
                            if (!(sts & 1)) {
                              SETERRNO((sts == RMS$_SYN ? EINVAL : EVMSERR),sts);
                            }
-                           fclose(tmpfp);
+                           PerlIO_close(tmpfp);
                            fp = NULL;
                        }
                        else {
-                          rewind(tmpfp);
+                          PerlIO_rewind(tmpfp);
                           IoTYPE(io) = '<';
                           IoIFP(io) = fp = tmpfp;
                        }
@@ -1114,7 +1146,7 @@ do_readline()
     }
     for (;;) {
        if (!sv_gets(sv, fp, offset)) {
-           clearerr(fp);
+           PerlIO_clearerr(fp);
            if (IoFLAGS(io) & IOf_ARGV) {
                fp = nextargv(last_in_gv);
                if (fp)
@@ -1205,25 +1237,23 @@ PP(pp_enter)
 PP(pp_helem)
 {
     dSP;
-    SV** svp;
+    HE* he;
     SV *keysv = POPs;
-    STRLEN keylen;
-    char *key = SvPV(keysv, keylen);
     HV *hv = (HV*)POPs;
     I32 lval = op->op_flags & OPf_MOD;
 
     if (SvTYPE(hv) != SVt_PVHV)
        RETPUSHUNDEF;
-    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));
        else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV))
-           provide_ref(op, *svp);
+           provide_ref(op, HeVAL(he));
     }
-    PUSHs(svp ? *svp : &sv_undef);
+    PUSHs(he ? HeVAL(he) : &sv_undef);
     RETURN;
 }
 
@@ -1382,7 +1412,7 @@ PP(pp_subst)
        }
        else if (!multiline) {
            if (*SvPVX(pm->op_pmshort) != *s ||
-             bcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen) ) {
+             memcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen) ) {
                if (pm->op_pmflags & PMf_FOLD) {
                    if (ibcmp((U8*)SvPVX(pm->op_pmshort), (U8*)s, pm->op_pmslen) )
                        goto nope;
@@ -1716,7 +1746,7 @@ PP(pp_entersub)
                goto retry;
            }
            tmpstr = sv_newmortal();
-           gv_efullname(tmpstr, gv);
+           gv_efullname(tmpstr, gv, Nullch);
            ngv = gv_fetchmethod(GvESTASH(gv), "AUTOLOAD");
            if (ngv && ngv != gv && (cv = GvCV(ngv))) { /* One more chance... */
                gv = ngv;
@@ -1742,7 +1772,7 @@ PP(pp_entersub)
            sv_setsv(sv, newRV((SV*)cv));
        }
        else {
-           gv_efullname(sv,gv);
+           gv_efullname(sv, gv, Nullch);
        }
        cv = GvCV(DBsub);
        if (CvXSUB(cv)) curcopdb = curcop;