&HUGE_VAL is not defined, it exists.
[p5sagit/p5-mst-13.2.git] / pp.c
diff --git a/pp.c b/pp.c
index b6275dd..17824bd 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -28,37 +28,6 @@ static double UV_MAX_cxux = ((double)UV_MAX);
 #endif
 
 /*
- * Types used in bitwise operations.
- *
- * Normally we'd just use IV and UV.  However, some hardware and
- * software combinations (e.g. Alpha and current OSF/1) don't have a
- * floating-point type to use for NV that has adequate bits to fully
- * hold an IV/UV.  (In other words, sizeof(long) == sizeof(double).)
- *
- * It just so happens that "int" is the right size almost everywhere.
- */
-typedef int IBW;
-typedef unsigned UBW;
-
-/*
- * Mask used after bitwise operations.
- *
- * There is at least one realm (Cray word machines) that doesn't
- * have an integral type (except char) small enough to be represented
- * in a double without loss; that is, it has no 32-bit type.
- */
-#if LONGSIZE > 4  && defined(_CRAY)
-#  define BW_BITS  32
-#  define BW_MASK  ((1 << BW_BITS) - 1)
-#  define BW_SIGN  (1 << (BW_BITS - 1))
-#  define BWi(i)  (((i) & BW_SIGN) ? ((i) | ~BW_MASK) : ((i) & BW_MASK))
-#  define BWu(u)  ((u) & BW_MASK)
-#else
-#  define BWi(i)  (i)
-#  define BWu(u)  (u)
-#endif
-
-/*
  * Offset for integer pack/unpack.
  *
  * On architectures where I16 and I32 aren't really 16 and 32 bits,
@@ -236,7 +205,7 @@ PP(pp_rv2gv)
                if (SvROK(sv))
                    goto wasref;
            }
-           if (!SvOK(sv)) {
+           if (!SvOK(sv) && sv != &PL_sv_undef) {
                /* If this is a 'my' scalar and flag is set then vivify 
                 * NI-S 1999/05/07
                 */ 
@@ -457,7 +426,7 @@ PP(pp_prototype)
                        seen_question = 1;
                        str[n++] = ';';
                    }
-                   else if (seen_question) 
+                   else if (n && str[0] == ';' && seen_question) 
                        goto set;       /* XXXX system, exec */
                    if ((oa & (OA_OPTIONAL - 1)) >= OA_AVREF 
                        && (oa & (OA_OPTIONAL - 1)) <= OA_HVREF) {
@@ -936,7 +905,7 @@ PP(pp_pow)
     djSP; dATARGET; tryAMAGICbin(pow,opASSIGN);
     {
       dPOPTOPnnrl;
-      SETn( pow( left, right) );
+      SETn( Perl_pow( left, right) );
       RETURN;
     }
 }
@@ -1041,8 +1010,8 @@ PP(pp_modulo)
 #endif
 
            /* Backward-compatibility clause: */
-           dright = floor(dright + 0.5);
-           dleft  = floor(dleft + 0.5);
+           dright = Perl_floor(dright + 0.5);
+           dleft  = Perl_floor(dleft + 0.5);
 
            if (!dright)
                DIE(aTHX_ "Illegal modulus zero");
@@ -1144,16 +1113,14 @@ PP(pp_left_shift)
 {
     djSP; dATARGET; tryAMAGICbin(lshift,opASSIGN);
     {
-      IBW shift = POPi;
+      IV shift = POPi;
       if (PL_op->op_private & HINT_INTEGER) {
-       IBW i = TOPi;
-       i = BWi(i) << shift;
-       SETi(BWi(i));
+       IV i = TOPi;
+       SETi(i << shift);
       }
       else {
-       UBW u = TOPu;
-       u <<= shift;
-       SETu(BWu(u));
+       UV u = TOPu;
+       SETu(u << shift);
       }
       RETURN;
     }
@@ -1163,16 +1130,14 @@ PP(pp_right_shift)
 {
     djSP; dATARGET; tryAMAGICbin(rshift,opASSIGN);
     {
-      IBW shift = POPi;
+      IV shift = POPi;
       if (PL_op->op_private & HINT_INTEGER) {
-       IBW i = TOPi;
-       i = BWi(i) >> shift;
-       SETi(BWi(i));
+       IV i = TOPi;
+       SETi(i >> shift);
       }
       else {
-       UBW u = TOPu;
-       u >>= shift;
-       SETu(BWu(u));
+       UV u = TOPu;
+       SETu(u >> shift);
       }
       RETURN;
     }
@@ -1235,6 +1200,13 @@ PP(pp_ncmp)
       dPOPTOPnnrl;
       I32 value;
 
+#ifdef Perl_isnan
+      if (Perl_isnan(left) || Perl_isnan(right)) {
+         SETs(&PL_sv_undef);
+         RETURN;
+       }
+      value = (left > right) - (left < right);
+#else
       if (left == right)
        value = 0;
       else if (left < right)
@@ -1245,6 +1217,7 @@ PP(pp_ncmp)
        SETs(&PL_sv_undef);
        RETURN;
       }
+#endif
       SETi(value);
       RETURN;
     }
@@ -1342,12 +1315,12 @@ PP(pp_bit_and)
       dPOPTOPssrl;
       if (SvNIOKp(left) || SvNIOKp(right)) {
        if (PL_op->op_private & HINT_INTEGER) {
-         IBW value = SvIV(left) & SvIV(right);
-         SETi(BWi(value));
+         IV i = SvIV(left) & SvIV(right);
+         SETi(i);
        }
        else {
-         UBW value = SvUV(left) & SvUV(right);
-         SETu(BWu(value));
+         UV u = SvUV(left) & SvUV(right);
+         SETu(u);
        }
       }
       else {
@@ -1365,12 +1338,12 @@ PP(pp_bit_xor)
       dPOPTOPssrl;
       if (SvNIOKp(left) || SvNIOKp(right)) {
        if (PL_op->op_private & HINT_INTEGER) {
-         IBW value = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right);
-         SETi(BWi(value));
+         IV i = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right);
+         SETi(i);
        }
        else {
-         UBW value = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right);
-         SETu(BWu(value));
+         UV u = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right);
+         SETu(u);
        }
       }
       else {
@@ -1388,12 +1361,12 @@ PP(pp_bit_or)
       dPOPTOPssrl;
       if (SvNIOKp(left) || SvNIOKp(right)) {
        if (PL_op->op_private & HINT_INTEGER) {
-         IBW value = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right);
-         SETi(BWi(value));
+         IV i = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right);
+         SETi(i);
        }
        else {
-         UBW value = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right);
-         SETu(BWu(value));
+         UV u = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right);
+         SETu(u);
        }
       }
       else {
@@ -1411,9 +1384,23 @@ PP(pp_negate)
        dTOPss;
        if (SvGMAGICAL(sv))
            mg_get(sv);
-       if (SvIOKp(sv) && !SvNOKp(sv) && !SvPOKp(sv) && SvIVX(sv) != IV_MIN)
-           SETi(-SvIVX(sv));
-       else if (SvNIOKp(sv))
+       if (SvIOKp(sv) && !SvNOKp(sv) && !SvPOKp(sv)) {
+           if (SvIsUV(sv)) {
+               if (SvIVX(sv) == IV_MIN) {
+                   SETi(SvIVX(sv));    /* special case: -((UV)IV_MAX+1) == IV_MIN */
+                   RETURN;
+               }
+               else if (SvUVX(sv) <= IV_MAX) {
+                   SETi(-SvIVX(sv));
+                   RETURN;
+               }
+           }
+           else if (SvIVX(sv) != IV_MIN) {
+               SETi(-SvIVX(sv));
+               RETURN;
+           }
+       }
+       if (SvNIOKp(sv))
            SETn(-SvNV(sv));
        else if (SvPOKp(sv)) {
            STRLEN len;
@@ -1454,12 +1441,12 @@ PP(pp_complement)
       dTOPss;
       if (SvNIOKp(sv)) {
        if (PL_op->op_private & HINT_INTEGER) {
-         IBW value = ~SvIV(sv);
-         SETi(BWi(value));
+         IV i = ~SvIV(sv);
+         SETi(i);
        }
        else {
-         UBW value = ~SvUV(sv);
-         SETu(BWu(value));
+         UV u = ~SvUV(sv);
+         SETu(u);
        }
       }
       else {
@@ -2254,7 +2241,7 @@ PP(pp_ucfirst)
 
     if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && (*s & 0xc0) == 0xc0) {
        I32 ulen;
-       U8 tmpbuf[10];
+       U8 tmpbuf[UTF8_MAXLEN];
        U8 *tend;
        UV uv = utf8_to_uv(s, &ulen);
 
@@ -2313,7 +2300,7 @@ PP(pp_lcfirst)
 
     if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && (*s & 0xc0) == 0xc0) {
        I32 ulen;
-       U8 tmpbuf[10];
+       U8 tmpbuf[UTF8_MAXLEN];
        U8 *tend;
        UV uv = utf8_to_uv(s, &ulen);
 
@@ -2907,7 +2894,7 @@ PP(pp_splice)
     SV **tmparyval = 0;
     MAGIC *mg;
 
-    if (mg = SvTIED_mg((SV*)ary, 'P')) {
+    if ((mg = SvTIED_mg((SV*)ary, 'P'))) {
        *MARK-- = SvTIED_obj((SV*)ary, mg);
        PUSHMARK(MARK);
        PUTBACK;
@@ -3101,7 +3088,7 @@ PP(pp_push)
     register SV *sv = &PL_sv_undef;
     MAGIC *mg;
 
-    if (mg = SvTIED_mg((SV*)ary, 'P')) {
+    if ((mg = SvTIED_mg((SV*)ary, 'P'))) {
        *MARK-- = SvTIED_obj((SV*)ary, mg);
        PUSHMARK(MARK);
        PUTBACK;
@@ -3157,7 +3144,7 @@ PP(pp_unshift)
     register I32 i = 0;
     MAGIC *mg;
 
-    if (mg = SvTIED_mg((SV*)ary, 'P')) {
+    if ((mg = SvTIED_mg((SV*)ary, 'P'))) {
        *MARK-- = SvTIED_obj((SV*)ary, mg);
        PUSHMARK(MARK);
        PUTBACK;
@@ -4176,7 +4163,7 @@ PP(pp_unpack)
                 int i;
  
                 for (i = 0; i < sizeof(PL_uuemap); i += 1)
-                    PL_uudmap[PL_uuemap[i]] = i;
+                    PL_uudmap[(U8)PL_uuemap[i]] = i;
                 /*
                  * Because ' ' and '`' map to the same value,
                  * we need to decode them both the same.
@@ -4193,22 +4180,22 @@ PP(pp_unpack)
                char hunk[4];
 
                hunk[3] = '\0';
-               len = PL_uudmap[*s++] & 077;
+               len = PL_uudmap[*(U8*)s++] & 077;
                while (len > 0) {
                    if (s < strend && ISUUCHAR(*s))
-                       a = PL_uudmap[*s++] & 077;
+                       a = PL_uudmap[*(U8*)s++] & 077;
                    else
                        a = 0;
                    if (s < strend && ISUUCHAR(*s))
-                       b = PL_uudmap[*s++] & 077;
+                       b = PL_uudmap[*(U8*)s++] & 077;
                    else
                        b = 0;
                    if (s < strend && ISUUCHAR(*s))
-                       c = PL_uudmap[*s++] & 077;
+                       c = PL_uudmap[*(U8*)s++] & 077;
                    else
                        c = 0;
                    if (s < strend && ISUUCHAR(*s))
-                       d = PL_uudmap[*s++] & 077;
+                       d = PL_uudmap[*(U8*)s++] & 077;
                    else
                        d = 0;
                    hunk[0] = (a << 2) | (b >> 4);
@@ -4448,10 +4435,11 @@ PP(pp_pack)
            len = 1;
        if (*pat == '/') {
            ++pat;
-           if (*pat != 'a' && *pat != 'A' && *pat != 'Z' || pat[1] != '*')
+           if ((*pat != 'a' && *pat != 'A' && *pat != 'Z') || pat[1] != '*')
                DIE(aTHX_ "/ must be followed by a*, A* or Z*");
            lengthcode = sv_2mortal(newSViv(sv_len(items > 0
-                                                  ? *MARK : &PL_sv_no)));
+                                                  ? *MARK : &PL_sv_no)
+                                            + (*pat == 'Z' ? 1 : 0)));
        }
        switch(datumtype) {
        default:
@@ -4645,7 +4633,7 @@ PP(pp_pack)
            while (len-- > 0) {
                fromstr = NEXTFROM;
                auint = SvUV(fromstr);
-               SvGROW(cat, SvCUR(cat) + 10);
+               SvGROW(cat, SvCUR(cat) + UTF8_MAXLEN);
                SvCUR_set(cat, (char*)uv_to_utf8((U8*)SvEND(cat),auint)
                               - SvPVX(cat));
            }
@@ -4749,14 +4737,14 @@ PP(pp_pack)
                    DIE(aTHX_ "Cannot compress negative numbers");
 
                if (
-#ifdef BW_BITS
-                   adouble <= BW_MASK
+#if UVSIZE > 4 && UVSIZE >= NVSIZE
+                   adouble <= 0xffffffff
 #else
-#ifdef CXUX_BROKEN_CONSTANT_CONVERT
+#   ifdef CXUX_BROKEN_CONSTANT_CONVERT
                    adouble <= UV_MAX_cxux
-#else
+#   else
                    adouble <= UV_MAX
-#endif
+#   endif
 #endif
                    )
                {
@@ -5014,7 +5002,7 @@ PP(pp_split)
        av_extend(ary,0);
        av_clear(ary);
        SPAGAIN;
-       if (mg = SvTIED_mg((SV*)ary, 'P')) {
+       if ((mg = SvTIED_mg((SV*)ary, 'P'))) {
            PUSHMARK(SP);
            XPUSHs(SvTIED_obj((SV*)ary, mg));
        }
@@ -5286,8 +5274,8 @@ PP(pp_lock)
 
 PP(pp_threadsv)
 {
-    djSP;
 #ifdef USE_THREADS
+    djSP;
     EXTEND(SP, 1);
     if (PL_op->op_private & OPpLVAL_INTRO)
        PUSHs(*save_threadsv(PL_op->op_targ));