INSTALL patches
[p5sagit/p5-mst-13.2.git] / pp.c
diff --git a/pp.c b/pp.c
index cd8c078..e6a2e11 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -1,6 +1,6 @@
 /*    pp.c
  *
- *    Copyright (c) 1991-1997, Larry Wall
+ *    Copyright (c) 1991-1999, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -78,6 +78,13 @@ typedef unsigned UBW;
 #define SIZE16 2
 #define SIZE32 4
 
+/* CROSSCOMPILE and MULTIARCH are going to affect pp_pack() and pp_unpack().
+   --jhi Feb 1999 */
+
+#if SHORTSIZE != SIZE16 || LONGSIZE != SIZE32
+#   define PERL_NATINT_PACK
+#endif
+
 #if BYTEORDER > 0xFFFF && defined(_CRAY) && !defined(_CRAYMPP)
 #  if BYTEORDER == 0x12345678
 #    define OFF16(p)   (char*)(p)
@@ -92,11 +99,13 @@ typedef unsigned UBW;
 #  endif
 #  define COPY16(s,p)  (*(p) = 0, Copy(s, OFF16(p), SIZE16, char))
 #  define COPY32(s,p)  (*(p) = 0, Copy(s, OFF32(p), SIZE32, char))
+#  define COPYNN(s,p,n) (*(p) = 0, Copy(s, (char *)(p), n, char))
 #  define CAT16(sv,p)  sv_catpvn(sv, OFF16(p), SIZE16)
 #  define CAT32(sv,p)  sv_catpvn(sv, OFF32(p), SIZE32)
 #else
 #  define COPY16(s,p)  Copy(s, p, SIZE16, char)
 #  define COPY32(s,p)  Copy(s, p, SIZE32, char)
+#  define COPYNN(s,p,n) Copy(s, (char *)(p), n, char)
 #  define CAT16(sv,p)  sv_catpvn(sv, (char*)(p), SIZE16)
 #  define CAT32(sv,p)  sv_catpvn(sv, (char*)(p), SIZE32)
 #endif
@@ -218,7 +227,8 @@ PP(pp_rv2gv)
            GvIOp(gv) = (IO *)sv;
            (void)SvREFCNT_inc(sv);
            sv = (SV*) gv;
-       } else if (SvTYPE(sv) != SVt_PVGV)
+       }
+       else if (SvTYPE(sv) != SVt_PVGV)
            DIE("Not a GLOB reference");
     }
     else {
@@ -240,9 +250,18 @@ PP(pp_rv2gv)
                RETSETUNDEF;
            }
            sym = SvPV(sv, n_a);
-           if (PL_op->op_private & HINT_STRICT_REFS)
-               DIE(PL_no_symref, sym, "a symbol");
-           sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV);
+           if ((PL_op->op_flags & OPf_SPECIAL) &&
+               !(PL_op->op_flags & OPf_MOD))
+           {
+               sv = (SV*)gv_fetchpv(sym, FALSE, SVt_PVGV);
+               if (!sv)
+                   RETSETUNDEF;
+           }
+           else {
+               if (PL_op->op_private & HINT_STRICT_REFS)
+                   DIE(PL_no_symref, sym, "a symbol");
+               sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV);
+           }
        }
     }
     if (PL_op->op_private & OPpLVAL_INTRO)
@@ -287,9 +306,18 @@ PP(pp_rv2sv)
                RETSETUNDEF;
            }
            sym = SvPV(sv, n_a);
-           if (PL_op->op_private & HINT_STRICT_REFS)
-               DIE(PL_no_symref, sym, "a SCALAR");
-           gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV);
+           if ((PL_op->op_flags & OPf_SPECIAL) &&
+               !(PL_op->op_flags & OPf_MOD))
+           {
+               gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PV);
+               if (!gv)
+                   RETSETUNDEF;
+           }
+           else {
+               if (PL_op->op_private & HINT_STRICT_REFS)
+                   DIE(PL_no_symref, sym, "a SCALAR");
+               gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV);
+           }
        }
        sv = GvSV(gv);
     }
@@ -408,7 +436,8 @@ PP(pp_prototype)
                    if (oa & OA_OPTIONAL) {
                        seen_question = 1;
                        str[n++] = ';';
-                   } else if (seen_question) 
+                   }
+                   else if (seen_question) 
                        goto set;       /* XXXX system, exec */
                    if ((oa & (OA_OPTIONAL - 1)) >= OA_AVREF 
                        && (oa & (OA_OPTIONAL - 1)) <= OA_HVREF) {
@@ -419,8 +448,9 @@ PP(pp_prototype)
                    oa = oa >> 4;
                }
                str[n++] = '\0';
-               ret = sv_2mortal(newSVpv(str, n - 1));
-           } else if (code)            /* Non-Overridable */
+               ret = sv_2mortal(newSVpvn(str, n - 1));
+           }
+           else if (code)              /* Non-Overridable */
                goto set;
            else {                      /* None such */
              nonesuch:
@@ -430,7 +460,7 @@ PP(pp_prototype)
     }
     cv = sv_2cv(TOPs, &stash, &gv, FALSE);
     if (cv && SvPOK(cv))
-       ret = sv_2mortal(newSVpv(SvPVX(cv), SvCUR(cv)));
+       ret = sv_2mortal(newSVpvn(SvPVX(cv), SvCUR(cv)));
   set:
     SETs(ret);
     RETURN;
@@ -482,6 +512,8 @@ refto(SV *sv)
            vivify_defelem(sv);
        if (!(sv = LvTARG(sv)))
            sv = &PL_sv_undef;
+       else
+           SvREFCNT_inc(sv);
     }
     else if (SvPADTMP(sv))
        sv = newSVsv(sv);
@@ -579,7 +611,7 @@ PP(pp_gelem)
        break;
     case 'N':
        if (strEQ(elem, "NAME"))
-           sv = newSVpv(GvNAME(gv), GvNAMELEN(gv));
+           sv = newSVpvn(GvNAME(gv), GvNAMELEN(gv));
        break;
     case 'P':
        if (strEQ(elem, "PACKAGE"))
@@ -762,15 +794,8 @@ PP(pp_undef)
     if (!sv)
        RETPUSHUNDEF;
 
-    if (SvTHINKFIRST(sv)) {
-       if (SvREADONLY(sv)) {
-           dTHR;
-           if (PL_curcop != &PL_compiling)
-               croak(PL_no_modify);
-       }
-       if (SvROK(sv))
-           sv_unref(sv);
-    }
+    if (SvTHINKFIRST(sv))
+       sv_force_normal(sv);
 
     switch (SvTYPE(sv)) {
     case SVt_NULL:
@@ -787,9 +812,12 @@ PP(pp_undef)
                 CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv)));
        /* FALL THROUGH */
     case SVt_PVFM:
-       { GV* gv = (GV*)SvREFCNT_inc(CvGV((CV*)sv));
-         cv_undef((CV*)sv);
-         CvGV((CV*)sv) = gv; }   /* let user-undef'd sub keep its identity */
+       {
+           /* let user-undef'd sub keep its identity */
+           GV* gv = (GV*)SvREFCNT_inc(CvGV((CV*)sv));
+           cv_undef((CV*)sv);
+           CvGV((CV*)sv) = gv;
+       }
        break;
     case SVt_PVGV:
        if (SvFAKE(sv))
@@ -914,7 +942,8 @@ PP(pp_divide)
            (double)I_V(right) == right &&
            (k = I_V(left)/I_V(right))*I_V(right) == I_V(left)) {
            value = k;
-       } else {
+       }
+       else {
            value = left / right;
        }
       }
@@ -1006,12 +1035,6 @@ PP(pp_repeat)
        STRLEN len;
 
        tmpstr = POPs;
-       if (TARG == tmpstr && SvTHINKFIRST(tmpstr)) {
-           if (SvREADONLY(tmpstr) && PL_curcop != &PL_compiling)
-               DIE("Can't x= to readonly value");
-           if (SvROK(tmpstr))
-               sv_unref(tmpstr);
-       }
        SvSetSV(TARG, tmpstr);
        SvPV_force(TARG, len);
        if (count != 1) {
@@ -1343,9 +1366,7 @@ PP(pp_negate)
 
 PP(pp_not)
 {
-#ifdef OVERLOAD
     djSP; tryAMAGICunSET(not);
-#endif /* OVERLOAD */
     *PL_stack_sp = boolSV(!SvTRUE(*PL_stack_sp));
     return NORMAL;
 }
@@ -2636,10 +2657,12 @@ PP(pp_exists)
     if (SvTYPE(hv) == SVt_PVHV) {
        if (hv_exists_ent(hv, tmpsv, 0))
            RETPUSHYES;
-    } else if (SvTYPE(hv) == SVt_PVAV) {
+    }
+    else if (SvTYPE(hv) == SVt_PVAV) {
        if (avhv_exists_ent((AV*)hv, tmpsv, 0))
            RETPUSHYES;
-    } else {
+    }
+    else {
        DIE("Not a HASH reference");
     }
     RETPUSHNO;
@@ -2662,7 +2685,8 @@ PP(pp_hslice)
            if (realhv) {
                HE *he = hv_fetch_ent(hv, keysv, lval, 0);
                svp = he ? &HeVAL(he) : 0;
-           } else {
+           }
+           else {
                svp = avhv_fetch_ent((AV*)hv, keysv, lval, 0);
            }
            if (lval) {
@@ -3149,7 +3173,7 @@ mul128(SV *sv, U8 m)
   U32             i = 0;
 
   if (!strnEQ(s, "0000", 4)) {  /* need to grow sv */
-    SV             *tmpNew = newSVpv("0000000000", 10);
+    SV             *tmpNew = newSVpvn("0000000000", 10);
 
     sv_catsv(tmpNew, sv);
     SvREFCNT_dec(sv);          /* free old sv */
@@ -3218,11 +3242,15 @@ PP(pp_unpack)
     register U32 culong;
     double cdouble;
     int commas = 0;
+#ifdef PERL_NATINT_PACK
+    int natint;                /* native integer */
+    int unatint;       /* unsigned native integer */
+#endif
 
     if (gimme != G_ARRAY) {            /* arrange to do first one only */
        /*SUPPRESS 530*/
        for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ;
-       if (strchr("aAbBhHP", *patend) || *pat == '%') {
+       if (strchr("aAZbBhHP", *patend) || *pat == '%') {
            patend++;
            while (isDIGIT(*patend) || *patend == '*')
                patend++;
@@ -3233,8 +3261,23 @@ PP(pp_unpack)
     while (pat < patend) {
       reparse:
        datumtype = *pat++ & 0xFF;
+#ifdef PERL_NATINT_PACK
+       natint = 0;
+#endif
        if (isSPACE(datumtype))
            continue;
+       if (*pat == '!') {
+           char *natstr = "sSiIlL";
+
+           if (strchr(natstr, datumtype)) {
+#ifdef PERL_NATINT_PACK
+               natint = 1;
+#endif
+               pat++;
+           }
+           else
+               croak("'!' allowed only after types %s", natstr);
+       }
        if (pat >= patend)
            len = 1;
        else if (*pat == '*') {
@@ -3280,6 +3323,7 @@ PP(pp_unpack)
            s += len;
            break;
        case 'A':
+       case 'Z':
        case 'a':
            if (len > strend - s)
                len = strend - s;
@@ -3288,12 +3332,19 @@ PP(pp_unpack)
            sv = NEWSV(35, len);
            sv_setpvn(sv, s, len);
            s += len;
-           if (datumtype == 'A') {
+           if (datumtype == 'A' || datumtype == 'Z') {
                aptr = s;       /* borrow register */
-               s = SvPVX(sv) + len - 1;
-               while (s >= SvPVX(sv) && (!*s || isSPACE(*s)))
-                   s--;
-               *++s = '\0';
+               if (datumtype == 'Z') { /* 'Z' strips stuff after first null */
+                   s = SvPVX(sv);
+                   while (*s)
+                       s++;
+               }
+               else {          /* 'A' strips both nulls and spaces */
+                   s = SvPVX(sv) + len - 1;
+                   while (s >= SvPVX(sv) && (!*s || isSPACE(*s)))
+                       s--;
+                   *++s = '\0';
+               }
                SvCUR_set(sv, s - SvPVX(sv));
                s = aptr;       /* unborrow register */
            }
@@ -3471,66 +3522,136 @@ PP(pp_unpack)
            }
            break;
        case 's':
+#if SHORTSIZE == SIZE16
            along = (strend - s) / SIZE16;
+#else
+           along = (strend - s) / (natint ? sizeof(short) : SIZE16);
+#endif
            if (len > along)
                len = along;
            if (checksum) {
-               while (len-- > 0) {
-                   COPY16(s, &ashort);
-                   s += SIZE16;
-                   culong += ashort;
+#if SHORTSIZE != SIZE16
+               if (natint) {
+                   while (len-- > 0) {
+                       COPYNN(s, &ashort, sizeof(short));
+                       s += sizeof(short);
+                       culong += ashort;
+
+                   }
+               }
+               else
+#endif
+                {
+                   while (len-- > 0) {
+                       COPY16(s, &ashort);
+#if SHORTSIZE > SIZE16
+                       if (ashort > 32767)
+                         ashort -= 65536;
+#endif
+                       s += SIZE16;
+                       culong += ashort;
+                   }
                }
            }
            else {
                EXTEND(SP, len);
                EXTEND_MORTAL(len);
-               while (len-- > 0) {
-                   COPY16(s, &ashort);
-                   s += SIZE16;
-                   sv = NEWSV(38, 0);
-                   sv_setiv(sv, (IV)ashort);
-                   PUSHs(sv_2mortal(sv));
+#if SHORTSIZE != SIZE16
+               if (natint) {
+                   while (len-- > 0) {
+                       COPYNN(s, &ashort, sizeof(short));
+                       s += sizeof(short);
+                       sv = NEWSV(38, 0);
+                       sv_setiv(sv, (IV)ashort);
+                       PUSHs(sv_2mortal(sv));
+                   }
+               }
+               else
+#endif
+                {
+                   while (len-- > 0) {
+                       COPY16(s, &ashort);
+#if SHORTSIZE > SIZE16
+                       if (ashort > 32767)
+                         ashort -= 65536;
+#endif
+                       s += SIZE16;
+                       sv = NEWSV(38, 0);
+                       sv_setiv(sv, (IV)ashort);
+                       PUSHs(sv_2mortal(sv));
+                   }
                }
            }
            break;
        case 'v':
        case 'n':
        case 'S':
+#if SHORTSIZE == SIZE16
            along = (strend - s) / SIZE16;
+#else
+           unatint = natint && datumtype == 'S';
+           along = (strend - s) / (unatint ? sizeof(unsigned short) : SIZE16);
+#endif
            if (len > along)
                len = along;
            if (checksum) {
-               while (len-- > 0) {
-                   COPY16(s, &aushort);
-                   s += SIZE16;
+#if SHORTSIZE != SIZE16
+               if (unatint) {
+                   while (len-- > 0) {
+                       COPYNN(s, &aushort, sizeof(unsigned short));
+                       s += sizeof(unsigned short);
+                       culong += aushort;
+                   }
+               }
+               else
+#endif
+                {
+                   while (len-- > 0) {
+                       COPY16(s, &aushort);
+                       s += SIZE16;
 #ifdef HAS_NTOHS
-                   if (datumtype == 'n')
-                       aushort = PerlSock_ntohs(aushort);
+                       if (datumtype == 'n')
+                           aushort = PerlSock_ntohs(aushort);
 #endif
 #ifdef HAS_VTOHS
-                   if (datumtype == 'v')
-                       aushort = vtohs(aushort);
+                       if (datumtype == 'v')
+                           aushort = vtohs(aushort);
 #endif
-                   culong += aushort;
+                       culong += aushort;
+                   }
                }
            }
            else {
                EXTEND(SP, len);
                EXTEND_MORTAL(len);
-               while (len-- > 0) {
-                   COPY16(s, &aushort);
-                   s += SIZE16;
-                   sv = NEWSV(39, 0);
+#if SHORTSIZE != SIZE16
+               if (unatint) {
+                   while (len-- > 0) {
+                       COPYNN(s, &aushort, sizeof(unsigned short));
+                       s += sizeof(unsigned short);
+                       sv = NEWSV(39, 0);
+                       sv_setiv(sv, (UV)aushort);
+                       PUSHs(sv_2mortal(sv));
+                   }
+               }
+               else
+#endif
+                {
+                   while (len-- > 0) {
+                       COPY16(s, &aushort);
+                       s += SIZE16;
+                       sv = NEWSV(39, 0);
 #ifdef HAS_NTOHS
-                   if (datumtype == 'n')
-                       aushort = PerlSock_ntohs(aushort);
+                       if (datumtype == 'n')
+                           aushort = PerlSock_ntohs(aushort);
 #endif
 #ifdef HAS_VTOHS
-                   if (datumtype == 'v')
-                       aushort = vtohs(aushort);
+                       if (datumtype == 'v')
+                           aushort = vtohs(aushort);
 #endif
-                   sv_setiv(sv, (IV)aushort);
-                   PUSHs(sv_2mortal(sv));
+                       sv_setiv(sv, (UV)aushort);
+                       PUSHs(sv_2mortal(sv));
+                   }
                }
            }
            break;
@@ -3558,7 +3679,25 @@ PP(pp_unpack)
 #ifdef __osf__
                     /* Without the dummy below unpack("i", pack("i",-1))
                      * return 0xFFffFFff instead of -1 for Digital Unix V4.0
-                     * cc with optimization turned on */
+                     * cc with optimization turned on.
+                    *
+                    * The bug was detected in
+                    * DEC C V5.8-009 on Digital UNIX V4.0 (Rev. 1091) (V4.0E)
+                    * with optimization (-O4) turned on.
+                    * DEC C V5.2-040 on Digital UNIX V4.0 (Rev. 564) (V4.0B)
+                    * does not have this problem even with -O4.
+                    *
+                    * This bug was reported as DECC_BUGS 1431
+                    * and tracked internally as GEM_BUGS 7775.
+                    *
+                    * The bug is fixed in
+                    * Tru64 UNIX V5.0:      Compaq C V6.1-006 or later
+                    * UNIX V4.0F support:   DEC C V5.9-006 or later
+                    * UNIX V4.0E support:   DEC C V5.8-011 or later
+                    * and also in DTK.
+                    *
+                    * See also few lines later for the same bug.
+                    */
                     (aint) ?
                        sv_setiv(sv, (IV)aint) :
 #endif
@@ -3590,12 +3729,8 @@ PP(pp_unpack)
                    sv = NEWSV(41, 0);
 #ifdef __osf__
                     /* Without the dummy below unpack("I", pack("I",0xFFFFFFFF))
-                     * returns 1.84467440737096e+19 instead of 0xFFFFFFFF for
-                    * DEC C V5.8-009 on Digital UNIX V4.0 (Rev. 1091) (aka V4.0D)
-                    * with optimization turned on.
-                    * (DEC C V5.2-040 on Digital UNIX V4.0 (Rev. 564) (aka V4.0B)
-                    * does not have this problem even with -O4)
-                    */
+                     * returns 1.84467440737096e+19 instead of 0xFFFFFFFF.
+                    * See details few lines earlier. */
                     (auint) ?
                        sv_setuv(sv, (UV)auint) :
 #endif
@@ -3605,72 +3740,147 @@ PP(pp_unpack)
            }
            break;
        case 'l':
+#if LONGSIZE == SIZE32
            along = (strend - s) / SIZE32;
+#else
+           along = (strend - s) / (natint ? sizeof(long) : SIZE32);
+#endif
            if (len > along)
                len = along;
            if (checksum) {
-               while (len-- > 0) {
-                   COPY32(s, &along);
-                   s += SIZE32;
-                   if (checksum > 32)
-                       cdouble += (double)along;
-                   else
-                       culong += along;
+#if LONGSIZE != SIZE32
+               if (natint) {
+                   while (len-- > 0) {
+                       COPYNN(s, &along, sizeof(long));
+                       s += sizeof(long);
+                       if (checksum > 32)
+                           cdouble += (double)along;
+                       else
+                           culong += along;
+                   }
+               }
+               else
+#endif
+                {
+                   while (len-- > 0) {
+                       COPY32(s, &along);
+#if LONGSIZE > SIZE32
+                       if (along > 2147483647)
+                         along -= 4294967296;
+#endif
+                       s += SIZE32;
+                       if (checksum > 32)
+                           cdouble += (double)along;
+                       else
+                           culong += along;
+                   }
                }
            }
            else {
                EXTEND(SP, len);
                EXTEND_MORTAL(len);
-               while (len-- > 0) {
-                   COPY32(s, &along);
-                   s += SIZE32;
-                   sv = NEWSV(42, 0);
-                   sv_setiv(sv, (IV)along);
-                   PUSHs(sv_2mortal(sv));
+#if LONGSIZE != SIZE32
+               if (natint) {
+                   while (len-- > 0) {
+                       COPYNN(s, &along, sizeof(long));
+                       s += sizeof(long);
+                       sv = NEWSV(42, 0);
+                       sv_setiv(sv, (IV)along);
+                       PUSHs(sv_2mortal(sv));
+                   }
+               }
+               else
+#endif
+                {
+                   while (len-- > 0) {
+                       COPY32(s, &along);
+#if LONGSIZE > SIZE32
+                       if (along > 2147483647)
+                         along -= 4294967296;
+#endif
+                       s += SIZE32;
+                       sv = NEWSV(42, 0);
+                       sv_setiv(sv, (IV)along);
+                       PUSHs(sv_2mortal(sv));
+                   }
                }
            }
            break;
        case 'V':
        case 'N':
        case 'L':
+#if LONGSIZE == SIZE32
            along = (strend - s) / SIZE32;
+#else
+           unatint = natint && datumtype == 'L';
+           along = (strend - s) / (unatint ? sizeof(unsigned long) : SIZE32);
+#endif
            if (len > along)
                len = along;
            if (checksum) {
-               while (len-- > 0) {
-                   COPY32(s, &aulong);
-                   s += SIZE32;
+#if LONGSIZE != SIZE32
+               if (unatint) {
+                   while (len-- > 0) {
+                       COPYNN(s, &aulong, sizeof(unsigned long));
+                       s += sizeof(unsigned long);
+                       if (checksum > 32)
+                           cdouble += (double)aulong;
+                       else
+                           culong += aulong;
+                   }
+               }
+               else
+#endif
+                {
+                   while (len-- > 0) {
+                       COPY32(s, &aulong);
+                       s += SIZE32;
 #ifdef HAS_NTOHL
-                   if (datumtype == 'N')
-                       aulong = PerlSock_ntohl(aulong);
+                       if (datumtype == 'N')
+                           aulong = PerlSock_ntohl(aulong);
 #endif
 #ifdef HAS_VTOHL
-                   if (datumtype == 'V')
-                       aulong = vtohl(aulong);
+                       if (datumtype == 'V')
+                           aulong = vtohl(aulong);
 #endif
-                   if (checksum > 32)
-                       cdouble += (double)aulong;
-                   else
-                       culong += aulong;
+                       if (checksum > 32)
+                           cdouble += (double)aulong;
+                       else
+                           culong += aulong;
+                   }
                }
            }
            else {
                EXTEND(SP, len);
                EXTEND_MORTAL(len);
-               while (len-- > 0) {
-                   COPY32(s, &aulong);
-                   s += SIZE32;
+#if LONGSIZE != SIZE32
+               if (unatint) {
+                   while (len-- > 0) {
+                       COPYNN(s, &aulong, sizeof(unsigned long));
+                       s += sizeof(unsigned long);
+                       sv = NEWSV(43, 0);
+                       sv_setuv(sv, (UV)aulong);
+                       PUSHs(sv_2mortal(sv));
+                   }
+               }
+               else
+#endif
+                {
+                   while (len-- > 0) {
+                       COPY32(s, &aulong);
+                       s += SIZE32;
 #ifdef HAS_NTOHL
-                   if (datumtype == 'N')
-                       aulong = PerlSock_ntohl(aulong);
+                       if (datumtype == 'N')
+                           aulong = PerlSock_ntohl(aulong);
 #endif
 #ifdef HAS_VTOHL
-                   if (datumtype == 'V')
-                       aulong = vtohl(aulong);
+                       if (datumtype == 'V')
+                           aulong = vtohl(aulong);
 #endif
-                   sv = NEWSV(43, 0);
-                   sv_setuv(sv, (UV)aulong);
-                   PUSHs(sv_2mortal(sv));
+                       sv = NEWSV(43, 0);
+                       sv_setuv(sv, (UV)aulong);
+                       PUSHs(sv_2mortal(sv));
+                   }
                }
            }
            break;
@@ -3967,11 +4177,11 @@ doencodes(register SV *sv, register char *s, register I32 len)
     sv_catpvn(sv, "\n", 1);
 }
 
-STATIC SV      *
+STATIC SV *
 is_an_int(char *s, STRLEN l)
 {
   STRLEN        n_a;
-  SV             *result = newSVpv("", l);
+  SV             *result = newSVpvn(s, l);
   char           *result_c = SvPV(result, n_a);        /* convenience */
   char           *out = result_c;
   bool            skip = 1;
@@ -4075,6 +4285,9 @@ PP(pp_pack)
     float afloat;
     double adouble;
     int commas = 0;
+#ifdef PERL_NATINT_PACK
+    int natint;                /* native integer */
+#endif
 
     items = SP - MARK;
     MARK++;
@@ -4082,8 +4295,23 @@ PP(pp_pack)
     while (pat < patend) {
 #define NEXTFROM (items-- > 0 ? *MARK++ : &PL_sv_no)
        datumtype = *pat++ & 0xFF;
+#ifdef PERL_NATINT_PACK
+       natint = 0;
+#endif
        if (isSPACE(datumtype))
            continue;
+        if (*pat == '!') {
+           char *natstr = "sSiIlL";
+
+           if (strchr(natstr, datumtype)) {
+#ifdef PERL_NATINT_PACK
+               natint = 1;
+#endif
+               pat++;
+           }
+           else
+               croak("'!' allowed only after types %s", natstr);
+       }
        if (*pat == '*') {
            len = strchr("@Xxu", datumtype) ? 0 : items;
            pat++;
@@ -4128,6 +4356,7 @@ PP(pp_pack)
            sv_catpvn(cat, null10, len);
            break;
        case 'A':
+       case 'Z':
        case 'a':
            fromstr = NEXTFROM;
            aptr = SvPV(fromstr, fromlen);
@@ -4327,11 +4556,46 @@ PP(pp_pack)
            }
            break;
        case 'S':
+#if SHORTSIZE != SIZE16
+           if (natint) {
+               unsigned short aushort;
+
+               while (len-- > 0) {
+                   fromstr = NEXTFROM;
+                   aushort = SvUV(fromstr);
+                   sv_catpvn(cat, (char *)&aushort, sizeof(unsigned short));
+               }
+           }
+           else
+#endif
+            {
+               U16 aushort;
+
+               while (len-- > 0) {
+                   fromstr = NEXTFROM;
+                   aushort = (U16)SvUV(fromstr);
+                   CAT16(cat, &aushort);
+               }
+
+           }
+           break;
        case 's':
-           while (len-- > 0) {
-               fromstr = NEXTFROM;
-               ashort = (I16)SvIV(fromstr);
-               CAT16(cat, &ashort);
+#if SHORTSIZE != SIZE16
+           if (natint) {
+               while (len-- > 0) {
+                   fromstr = NEXTFROM;
+                   ashort = SvIV(fromstr);
+                   sv_catpvn(cat, (char *)&ashort, sizeof(short));
+               }
+           }
+           else
+#endif
+            {
+               while (len-- > 0) {
+                   fromstr = NEXTFROM;
+                   ashort = (I16)SvIV(fromstr);
+                   CAT16(cat, &ashort);
+               }
            }
            break;
        case 'I':
@@ -4439,17 +4703,41 @@ PP(pp_pack)
            }
            break;
        case 'L':
-           while (len-- > 0) {
-               fromstr = NEXTFROM;
-               aulong = SvUV(fromstr);
-               CAT32(cat, &aulong);
+#if LONGSIZE != SIZE32
+           if (natint) {
+               while (len-- > 0) {
+                   fromstr = NEXTFROM;
+                   aulong = SvUV(fromstr);
+                   sv_catpvn(cat, (char *)&aulong, sizeof(unsigned long));
+               }
+           }
+           else
+#endif
+            {
+               while (len-- > 0) {
+                   fromstr = NEXTFROM;
+                   aulong = SvUV(fromstr);
+                   CAT32(cat, &aulong);
+               }
            }
            break;
        case 'l':
-           while (len-- > 0) {
-               fromstr = NEXTFROM;
-               along = SvIV(fromstr);
-               CAT32(cat, &along);
+#if LONGSIZE != SIZE32
+           if (natint) {
+               while (len-- > 0) {
+                   fromstr = NEXTFROM;
+                   along = SvIV(fromstr);
+                   sv_catpvn(cat, (char *)&along, sizeof(long));
+               }
+           }
+           else
+#endif
+            {
+               while (len-- > 0) {
+                   fromstr = NEXTFROM;
+                   along = SvIV(fromstr);
+                   CAT32(cat, &along);
+               }
            }
            break;
 #ifdef HAS_QUAD