X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=a9ced1183b85973d5c71b9c41daa81e4ab54e6a1;hb=c67712b2e649d3ea6de971bd2e9efe6087948fc1;hp=07b83dba3d9d7899956f66e12a60e8958a97135e;hpb=a3f914c54a06647534c0855205d45eb950aebdd4;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp.c b/pp.c index 07b83db..a9ced11 100644 --- a/pp.c +++ b/pp.c @@ -78,6 +78,10 @@ typedef unsigned UBW; #define SIZE16 2 #define SIZE32 4 +#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 +96,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 @@ -107,8 +113,6 @@ static SV* refto _((SV* sv)); static U32 seed _((void)); #endif -static bool srand_called = FALSE; - /* variations on pp_null */ #ifdef I_UNISTD @@ -220,12 +224,14 @@ 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 { if (SvTYPE(sv) != SVt_PVGV) { char *sym; + STRLEN n_a; if (SvGMAGICAL(sv)) { mg_get(sv); @@ -240,10 +246,19 @@ PP(pp_rv2gv) warner(WARN_UNINITIALIZED, PL_warn_uninit); RETSETUNDEF; } - sym = SvPV(sv, PL_na); - if (PL_op->op_private & HINT_STRICT_REFS) - DIE(PL_no_symref, sym, "a symbol"); - sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV); + sym = SvPV(sv, n_a); + 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) @@ -271,6 +286,7 @@ PP(pp_rv2sv) else { GV *gv = (GV*)sv; char *sym; + STRLEN n_a; if (SvTYPE(gv) != SVt_PVGV) { if (SvGMAGICAL(sv)) { @@ -286,10 +302,19 @@ PP(pp_rv2sv) warner(WARN_UNINITIALIZED, PL_warn_uninit); RETSETUNDEF; } - sym = SvPV(sv, PL_na); - if (PL_op->op_private & HINT_STRICT_REFS) - DIE(PL_no_symref, sym, "a SCALAR"); - gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV); + sym = SvPV(sv, n_a); + 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 +433,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) { @@ -420,7 +446,8 @@ PP(pp_prototype) } str[n++] = '\0'; ret = sv_2mortal(newSVpv(str, n - 1)); - } else if (code) /* Non-Overridable */ + } + else if (code) /* Non-Overridable */ goto set; else { /* None such */ nonesuch: @@ -544,9 +571,10 @@ PP(pp_gelem) SV *tmpRef; char *elem; djSP; - + STRLEN n_a; + sv = POPs; - elem = SvPV(sv, PL_na); + elem = SvPV(sv, n_a); gv = (GV*)POPs; tmpRef = Nullsv; sv = Nullsv; @@ -727,11 +755,11 @@ PP(pp_defined) RETPUSHNO; switch (SvTYPE(sv)) { case SVt_PVAV: - if (AvMAX(sv) >= 0 || SvGMAGICAL(sv)) + if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv,'P'))) RETPUSHYES; break; case SVt_PVHV: - if (HvARRAY(sv) || SvGMAGICAL(sv)) + if (HvARRAY(sv) || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv,'P'))) RETPUSHYES; break; case SVt_PVCV: @@ -913,7 +941,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; } } @@ -1342,9 +1371,7 @@ PP(pp_negate) PP(pp_not) { -#ifdef OVERLOAD djSP; tryAMAGICunSET(not); -#endif /* OVERLOAD */ *PL_stack_sp = boolSV(!SvTRUE(*PL_stack_sp)); return NORMAL; } @@ -1593,9 +1620,9 @@ PP(pp_rand) value = POPn; if (value == 0.0) value = 1.0; - if (!srand_called) { + if (!PL_srand_called) { (void)seedDrand01((Rand_seed_t)seed()); - srand_called = TRUE; + PL_srand_called = TRUE; } value *= Drand01(); XPUSHn(value); @@ -1611,7 +1638,7 @@ PP(pp_srand) else anum = POPu; (void)seedDrand01((Rand_seed_t)anum); - srand_called = TRUE; + PL_srand_called = TRUE; EXTEND(SP, 1); RETPUSHYES; } @@ -1797,8 +1824,9 @@ PP(pp_hex) djSP; dTARGET; char *tmps; I32 argtype; + STRLEN n_a; - tmps = POPp; + tmps = POPpx; XPUSHu(scan_hex(tmps, 99, &argtype)); RETURN; } @@ -1809,14 +1837,17 @@ PP(pp_oct) UV value; I32 argtype; char *tmps; + STRLEN n_a; - tmps = POPp; + tmps = POPpx; while (*tmps && isSPACE(*tmps)) tmps++; if (*tmps == '0') tmps++; if (*tmps == 'x') value = scan_hex(++tmps, 99, &argtype); + else if (*tmps == 'b') + value = scan_bin(++tmps, 99, &argtype); else value = scan_oct(tmps, 99, &argtype); XPUSHu(value); @@ -1922,7 +1953,8 @@ PP(pp_substr) if (lvalue) { /* it's an lvalue! */ if (!SvGMAGICAL(sv)) { if (SvROK(sv)) { - SvPV_force(sv,PL_na); + STRLEN n_a; + SvPV_force(sv,n_a); if (ckWARN(WARN_SUBSTR)) warner(WARN_SUBSTR, "Attempt to use reference as lvalue in substr"); @@ -2131,7 +2163,8 @@ PP(pp_ord) { djSP; dTARGET; UV value; - U8 *tmps = (U8*)POPp; + STRLEN n_a; + U8 *tmps = (U8*)POPpx; I32 retlen; if (IN_UTF8 && (*tmps & 0x80)) @@ -2174,12 +2207,13 @@ PP(pp_chr) PP(pp_crypt) { djSP; dTARGET; dPOPTOPssrl; + STRLEN n_a; #ifdef HAS_CRYPT - char *tmps = SvPV(left, PL_na); + char *tmps = SvPV(left, n_a); #ifdef FCRYPT - sv_setpv(TARG, fcrypt(tmps, SvPV(right, PL_na))); + sv_setpv(TARG, fcrypt(tmps, SvPV(right, n_a))); #else - sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, PL_na))); + sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, n_a))); #endif #else DIE( @@ -2231,7 +2265,7 @@ PP(pp_ucfirst) sv = TARG; SETs(sv); } - s = (U8*)SvPV_force(sv, PL_na); + s = (U8*)SvPV_force(sv, slen); if (*s) { if (PL_op->op_private & OPpLOCALE) { TAINT; @@ -2287,7 +2321,7 @@ PP(pp_lcfirst) sv = TARG; SETs(sv); } - s = (U8*)SvPV_force(sv, PL_na); + s = (U8*)SvPV_force(sv, slen); if (*s) { if (PL_op->op_private & OPpLOCALE) { TAINT; @@ -2628,10 +2662,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; @@ -2654,12 +2690,15 @@ 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) { - if (!svp || *svp == &PL_sv_undef) - DIE(PL_no_helem, SvPV(keysv, PL_na)); + if (!svp || *svp == &PL_sv_undef) { + STRLEN n_a; + DIE(PL_no_helem, SvPV(keysv, n_a)); + } if (PL_op->op_private & OPpLVAL_INTRO) save_helem(hv, keysv, svp); } @@ -2841,12 +2880,8 @@ PP(pp_splice) newlen = SP - MARK; diff = newlen - length; - if (newlen && !AvREAL(ary)) { - if (AvREIFY(ary)) - av_reify(ary); - else - assert(AvREAL(ary)); /* would leak, so croak */ - } + if (newlen && !AvREAL(ary) && AvREIFY(ary)) + av_reify(ary); if (diff < 0) { /* shrinking the area */ if (newlen) { @@ -3163,9 +3198,6 @@ mul128(SV *sv, U8 m) /* Explosives and implosives. */ -static const char uuemap[] = - "`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_"; -static char uudmap[256]; /* Initialised on first use */ #if 'I' == 73 && 'J' == 74 /* On an ASCII/ISO kind of system */ #define ISUUCHAR(ch) ((ch) >= ' ' && (ch) < 'a') @@ -3174,7 +3206,7 @@ static char uudmap[256]; /* Initialised on first use */ Some other sort of character set - use memchr() so we don't match the null byte. */ -#define ISUUCHAR(ch) (memchr(uuemap, (ch), sizeof(uuemap)-1) || (ch) == ' ') +#define ISUUCHAR(ch) (memchr(PL_uuemap, (ch), sizeof(PL_uuemap)-1) || (ch) == ' ') #endif PP(pp_unpack) @@ -3214,13 +3246,16 @@ PP(pp_unpack) I32 checksum = 0; register U32 culong; double cdouble; - static char* bitcount = 0; 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++; @@ -3231,8 +3266,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 == '*') { @@ -3278,6 +3328,7 @@ PP(pp_unpack) s += len; break; case 'A': + case 'Z': case 'a': if (len > strend - s) len = strend - s; @@ -3286,12 +3337,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 */ } @@ -3302,21 +3360,21 @@ PP(pp_unpack) if (pat[-1] == '*' || len > (strend - s) * 8) len = (strend - s) * 8; if (checksum) { - if (!bitcount) { - Newz(601, bitcount, 256, char); + if (!PL_bitcount) { + Newz(601, PL_bitcount, 256, char); for (bits = 1; bits < 256; bits++) { - if (bits & 1) bitcount[bits]++; - if (bits & 2) bitcount[bits]++; - if (bits & 4) bitcount[bits]++; - if (bits & 8) bitcount[bits]++; - if (bits & 16) bitcount[bits]++; - if (bits & 32) bitcount[bits]++; - if (bits & 64) bitcount[bits]++; - if (bits & 128) bitcount[bits]++; + if (bits & 1) PL_bitcount[bits]++; + if (bits & 2) PL_bitcount[bits]++; + if (bits & 4) PL_bitcount[bits]++; + if (bits & 8) PL_bitcount[bits]++; + if (bits & 16) PL_bitcount[bits]++; + if (bits & 32) PL_bitcount[bits]++; + if (bits & 64) PL_bitcount[bits]++; + if (bits & 128) PL_bitcount[bits]++; } } while (len >= 8) { - culong += bitcount[*(unsigned char*)s++]; + culong += PL_bitcount[*(unsigned char*)s++]; len -= 8; } if (len) { @@ -3469,66 +3527,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; @@ -3586,78 +3714,164 @@ PP(pp_unpack) Copy(s, &auint, 1, unsigned int); s += sizeof(unsigned int); 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) + */ + (auint) ? + sv_setuv(sv, (UV)auint) : +#endif sv_setuv(sv, (UV)auint); PUSHs(sv_2mortal(sv)); } } 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; @@ -3699,6 +3913,7 @@ PP(pp_unpack) } else if (++bytes >= sizeof(UV)) { /* promote to string */ char *t; + STRLEN n_a; sv = newSVpvf("%.*Vu", (int)TYPE_DIGITS(UV), auv); while (s < strend) { @@ -3708,7 +3923,7 @@ PP(pp_unpack) break; } } - t = SvPV(sv, PL_na); + t = SvPV(sv, n_a); while (*t == '0') t++; sv_chop(sv, t); @@ -3833,16 +4048,16 @@ PP(pp_unpack) * algorithm, the code will be character-set independent * (and just as fast as doing character arithmetic) */ - if (uudmap['M'] == 0) { + if (PL_uudmap['M'] == 0) { int i; - for (i = 0; i < sizeof(uuemap); i += 1) - uudmap[uuemap[i]] = i; + for (i = 0; i < sizeof(PL_uuemap); i += 1) + PL_uudmap[PL_uuemap[i]] = i; /* * Because ' ' and '`' map to the same value, * we need to decode them both the same. */ - uudmap[' '] = 0; + PL_uudmap[' '] = 0; } along = (strend - s) * 3 / 4; @@ -3854,22 +4069,22 @@ PP(pp_unpack) char hunk[4]; hunk[3] = '\0'; - len = uudmap[*s++] & 077; + len = PL_uudmap[*s++] & 077; while (len > 0) { if (s < strend && ISUUCHAR(*s)) - a = uudmap[*s++] & 077; + a = PL_uudmap[*s++] & 077; else a = 0; if (s < strend && ISUUCHAR(*s)) - b = uudmap[*s++] & 077; + b = PL_uudmap[*s++] & 077; else b = 0; if (s < strend && ISUUCHAR(*s)) - c = uudmap[*s++] & 077; + c = PL_uudmap[*s++] & 077; else c = 0; if (s < strend && ISUUCHAR(*s)) - d = uudmap[*s++] & 077; + d = PL_uudmap[*s++] & 077; else d = 0; hunk[0] = (a << 2) | (b >> 4); @@ -3930,24 +4145,24 @@ doencodes(register SV *sv, register char *s, register I32 len) { char hunk[5]; - *hunk = uuemap[len]; + *hunk = PL_uuemap[len]; sv_catpvn(sv, hunk, 1); hunk[4] = '\0'; while (len > 2) { - hunk[0] = uuemap[(077 & (*s >> 2))]; - hunk[1] = uuemap[(077 & (((*s << 4) & 060) | ((s[1] >> 4) & 017)))]; - hunk[2] = uuemap[(077 & (((s[1] << 2) & 074) | ((s[2] >> 6) & 03)))]; - hunk[3] = uuemap[(077 & (s[2] & 077))]; + hunk[0] = PL_uuemap[(077 & (*s >> 2))]; + hunk[1] = PL_uuemap[(077 & (((*s << 4) & 060) | ((s[1] >> 4) & 017)))]; + hunk[2] = PL_uuemap[(077 & (((s[1] << 2) & 074) | ((s[2] >> 6) & 03)))]; + hunk[3] = PL_uuemap[(077 & (s[2] & 077))]; sv_catpvn(sv, hunk, 4); s += 3; len -= 3; } if (len > 0) { char r = (len > 1 ? s[1] : '\0'); - hunk[0] = uuemap[(077 & (*s >> 2))]; - hunk[1] = uuemap[(077 & (((*s << 4) & 060) | ((r >> 4) & 017)))]; - hunk[2] = uuemap[(077 & ((r << 2) & 074))]; - hunk[3] = uuemap[0]; + hunk[0] = PL_uuemap[(077 & (*s >> 2))]; + hunk[1] = PL_uuemap[(077 & (((*s << 4) & 060) | ((r >> 4) & 017)))]; + hunk[2] = PL_uuemap[(077 & ((r << 2) & 074))]; + hunk[3] = PL_uuemap[0]; sv_catpvn(sv, hunk, 4); } sv_catpvn(sv, "\n", 1); @@ -3956,8 +4171,9 @@ doencodes(register SV *sv, register char *s, register I32 len) STATIC SV * is_an_int(char *s, STRLEN l) { + STRLEN n_a; SV *result = newSVpv("", l); - char *result_c = SvPV(result, PL_na); /* convenience */ + char *result_c = SvPV(result, n_a); /* convenience */ char *out = result_c; bool skip = 1; bool ignore = 0; @@ -4060,6 +4276,9 @@ PP(pp_pack) float afloat; double adouble; int commas = 0; +#ifdef PERL_NATINT_PACK + int natint; /* native integer */ +#endif items = SP - MARK; MARK++; @@ -4067,8 +4286,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++; @@ -4113,6 +4347,7 @@ PP(pp_pack) sv_catpvn(cat, null10, len); break; case 'A': + case 'Z': case 'a': fromstr = NEXTFROM; aptr = SvPV(fromstr, fromlen); @@ -4312,11 +4547,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': @@ -4424,17 +4694,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 @@ -4462,6 +4756,7 @@ PP(pp_pack) if (fromstr == &PL_sv_undef) aptr = NULL; else { + STRLEN n_a; /* XXX better yet, could spirit away the string to * a safe spot and hang on to it until the result * of pack() (and all copies of the result) are @@ -4471,9 +4766,9 @@ PP(pp_pack) warner(WARN_UNSAFE, "Attempt to pack pointer to temporary value"); if (SvPOK(fromstr) || SvNIOK(fromstr)) - aptr = SvPV(fromstr,PL_na); + aptr = SvPV(fromstr,n_a); else - aptr = SvPV_force(fromstr,PL_na); + aptr = SvPV_force(fromstr,n_a); } sv_catpvn(cat, (char*)&aptr, sizeof(char*)); } @@ -4672,7 +4967,7 @@ PP(pp_split) else { maxiters += (strend - s) * rx->nparens; while (s < strend && --limit && - CALLREGEXEC(rx, s, strend, orig, 1, Nullsv, NULL, 0)) + CALLREGEXEC(rx, s, strend, orig, 1, sv, NULL, 0)) { TAINT_IF(RX_MATCH_TAINTED(rx)); if (rx->subbase