[inseparable changes from match from perl-5.003_97e to perl-5.003_97f]

 CORE LANGUAGE CHANGES

Subject: New operator systell()
From: Chip Salzenberg <chip@perl.com>
Files: doio.c ext/Opcode/Opcode.pm keywords.pl opcode.pl pod/perldelta.pod pod/perldiag.pod pod/perlfunc.pod pp_sys.c t/op/sysio.t toke.c

Subject: Allow constant sub to be optimized when called with parens
From: Chip Salzenberg <chip@perl.com>
Files: toke.c

Subject: Make {,un}pack fail on invalid pack types
From: Chip Salzenberg <chip@perl.com>
Files: pod/perldiag.pod pp.c

 CORE PORTABILITY

Subject: Fix bitwise ops and {,un}pack() on Cray CPUs
From: Chip Salzenberg <chip@perl.com>
Files: pp.c

Subject: VMS update
From: Charles Bailey <bailey@hmivax.humgen.upenn.edu>
Files: lib/Cwd.pm lib/File/Path.pm lib/FindBin.pm vms/perly_c.vms vms/vms.c vms/writemain.pl

Subject: Win32 update (three patches)
From: Gurusamy Sarathy <gsar@engin.umich.edu>
Files: lib/Cwd.pm lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MM_Win32.pm lib/File/Basename.pm win32/Makefile win32/makedef.pl win32/perllib.c win32/win32.c win32/win32iop.h

 DOCUMENTATION

Subject: Document size restrictions for packed integers
From: Jarkko Hietaniemi <Jarkko.Hietaniemi@cc.hut.fi>
Files: pod/perlfunc.pod

 LIBRARY AND EXTENSIONS

Subject: Fix bug in Opcode when (maxo & 15) > 8
From: Chip Salzenberg <chip@perl.com>
Files: ext/Opcode/Makefile.PL ext/Opcode/Opcode.pm ext/Opcode/Opcode.xs

1 files changed, 119 insertions, 52 deletions

diff --git a/pp.c b/pp.c
index 4effd286db..34c4ed3e1f 100644
--- a/pp.c
+++ b/pp.c
@@ -23,12 +23,69 @@
  * 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 everywhere, at
- * least today.
+ * 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 BYTEORDER > 0xFFFF && defined(_CRAY) && !defined(_CRAYMPP)
+#  define BWBITS  32
+#  define BWMASK  ((1 << BWBITS) - 1)
+#  define BWSIGN  (1 << (BWBITS - 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,
+ * which for now are all Crays, pack and unpack have to play games.
+ */
+
+/*
+ * These values are required for portability of pack() output.
+ * If they're not right on your machine, then pack() and unpack()
+ * wouldn't work right anyway; you'll need to apply the Cray hack.
+ * (I'd like to check them with #if, but you can't use sizeof() in
+ * the preprocessor.)
+ */
+#define SIZE16 2
+#define SIZE32 4
+
+#if BYTEORDER > 0xFFFF && defined(_CRAY) && !defined(_CRAYMPP)
+#  if BYTEORDER == 0x12345678
+#    define OFF16(p)	(char*)(p)
+#    define OFF32(p)	(char*)(p)
+#  else
+#    if BYTEORDER == 0x87654321
+#      define OFF16(p)	((char*)(p) + (sizeof(U16) - SIZE16))
+#      define OFF32(p)	((char*)(p) + (sizeof(U32) - SIZE32))
+#    else
+       }}}} bad cray byte order
+#    endif
+#  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 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 CAT16(sv,p)  sv_catpvn(sv, (char*)(p), SIZE16)
+#  define CAT32(sv,p)  sv_catpvn(sv, (char*)(p), SIZE32)
+#endif
+
 static void doencodes _((SV* sv, char* s, I32 len));
 static SV* refto _((SV* sv));
 static U32 seed _((void));
@@ -806,11 +863,13 @@ PP(pp_left_shift)
       IBW shift = POPi;
       if (op->op_private & HINT_INTEGER) {
 	IBW i = TOPi;
-	SETi( i << shift );
+	i <<= shift;
+	SETi(BWi(i));
       }
       else {
 	UBW u = TOPu;
-	SETu( u << shift );
+	u <<= shift;
+	SETu(BWu(u));
       }
       RETURN;
     }
@@ -823,11 +882,13 @@ PP(pp_right_shift)
       IBW shift = POPi;
       if (op->op_private & HINT_INTEGER) {
 	IBW i = TOPi;
-	SETi( i >> shift );
+	i >>= shift;
+	SETi(BWi(i));
       }
       else {
 	UBW u = TOPu;
-	SETu( u >> shift );
+	u >>= shift;
+	SETu(BWu(u));
       }
       RETURN;
     }
@@ -998,11 +1059,11 @@ PP(pp_bit_and)
       if (SvNIOKp(left) || SvNIOKp(right)) {
 	if (op->op_private & HINT_INTEGER) {
 	  IBW value = SvIV(left) & SvIV(right); 
-	  SETi( value );
+	  SETi(BWi(value));
 	}
 	else {
 	  UBW value = SvUV(left) & SvUV(right); 
-	  SETu( value );
+	  SETu(BWu(value));
 	}
       }
       else {
@@ -1021,11 +1082,11 @@ PP(pp_bit_xor)
       if (SvNIOKp(left) || SvNIOKp(right)) {
 	if (op->op_private & HINT_INTEGER) {
 	  IBW value = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right); 
-	  SETi( value );
+	  SETi(BWi(value));
 	}
 	else {
 	  UBW value = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right); 
-	  SETu( value );
+	  SETu(BWu(value));
 	}
       }
       else {
@@ -1044,11 +1105,11 @@ PP(pp_bit_or)
       if (SvNIOKp(left) || SvNIOKp(right)) {
 	if (op->op_private & HINT_INTEGER) {
 	  IBW value = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right); 
-	  SETi( value );
+	  SETi(BWi(value));
 	}
 	else {
 	  UBW value = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right); 
-	  SETu( value );
+	  SETu(BWu(value));
 	}
       }
       else {
@@ -1108,11 +1169,11 @@ PP(pp_complement)
       if (SvNIOKp(sv)) {
 	if (op->op_private & HINT_INTEGER) {
 	  IBW value = ~SvIV(sv);
-	  SETi( value );
+	  SETi(BWi(value));
 	}
 	else {
 	  UBW value = ~SvUV(sv);
-	  SETu( value );
+	  SETu(BWu(value));
 	}
       }
       else {
@@ -2637,7 +2698,7 @@ PP(pp_unpack)
 	    len = (datumtype != '@');
 	switch(datumtype) {
 	default:
-	    break;
+	    croak("Invalid type in unpack: '%c'", datumtype);
 	case '%':
 	    if (len == 1 && pat[-1] != '1')
 		len = 16;
@@ -2829,13 +2890,13 @@ PP(pp_unpack)
 	    }
 	    break;
 	case 's':
-	    along = (strend - s) / sizeof(I16);
+	    along = (strend - s) / SIZE16;
 	    if (len > along)
 		len = along;
 	    if (checksum) {
 		while (len-- > 0) {
-		    Copy(s, &ashort, 1, I16);
-		    s += sizeof(I16);
+		    COPY16(s, &ashort);
+		    s += SIZE16;
 		    culong += ashort;
 		}
 	    }
@@ -2843,8 +2904,8 @@ PP(pp_unpack)
 		EXTEND(SP, len);
 		EXTEND_MORTAL(len);
 		while (len-- > 0) {
-		    Copy(s, &ashort, 1, I16);
-		    s += sizeof(I16);
+		    COPY16(s, &ashort);
+		    s += SIZE16;
 		    sv = NEWSV(38, 0);
 		    sv_setiv(sv, (IV)ashort);
 		    PUSHs(sv_2mortal(sv));
@@ -2854,13 +2915,13 @@ PP(pp_unpack)
 	case 'v':
 	case 'n':
 	case 'S':
-	    along = (strend - s) / sizeof(U16);
+	    along = (strend - s) / SIZE16;
 	    if (len > along)
 		len = along;
 	    if (checksum) {
 		while (len-- > 0) {
-		    Copy(s, &aushort, 1, U16);
-		    s += sizeof(U16);
+		    COPY16(s, &aushort);
+		    s += SIZE16;
 #ifdef HAS_NTOHS
 		    if (datumtype == 'n')
 			aushort = ntohs(aushort);
@@ -2876,8 +2937,8 @@ PP(pp_unpack)
 		EXTEND(SP, len);
 		EXTEND_MORTAL(len);
 		while (len-- > 0) {
-		    Copy(s, &aushort, 1, U16);
-		    s += sizeof(U16);
+		    COPY16(s, &aushort);
+		    s += SIZE16;
 		    sv = NEWSV(39, 0);
 #ifdef HAS_NTOHS
 		    if (datumtype == 'n')
@@ -2945,13 +3006,13 @@ PP(pp_unpack)
 	    }
 	    break;
 	case 'l':
-	    along = (strend - s) / sizeof(I32);
+	    along = (strend - s) / SIZE32;
 	    if (len > along)
 		len = along;
 	    if (checksum) {
 		while (len-- > 0) {
-		    Copy(s, &along, 1, I32);
-		    s += sizeof(I32);
+		    COPY32(s, &along);
+		    s += SIZE32;
 		    if (checksum > 32)
 			cdouble += (double)along;
 		    else
@@ -2962,8 +3023,8 @@ PP(pp_unpack)
 		EXTEND(SP, len);
 		EXTEND_MORTAL(len);
 		while (len-- > 0) {
-		    Copy(s, &along, 1, I32);
-		    s += sizeof(I32);
+		    COPY32(s, &along);
+		    s += SIZE32;
 		    sv = NEWSV(42, 0);
 		    sv_setiv(sv, (IV)along);
 		    PUSHs(sv_2mortal(sv));
@@ -2973,13 +3034,13 @@ PP(pp_unpack)
 	case 'V':
 	case 'N':
 	case 'L':
-	    along = (strend - s) / sizeof(U32);
+	    along = (strend - s) / SIZE32;
 	    if (len > along)
 		len = along;
 	    if (checksum) {
 		while (len-- > 0) {
-		    Copy(s, &aulong, 1, U32);
-		    s += sizeof(U32);
+		    COPY32(s, &aulong);
+		    s += SIZE32;
 #ifdef HAS_NTOHL
 		    if (datumtype == 'N')
 			aulong = ntohl(aulong);
@@ -2998,8 +3059,8 @@ PP(pp_unpack)
 		EXTEND(SP, len);
 		EXTEND_MORTAL(len);
 		while (len-- > 0) {
-		    Copy(s, &aulong, 1, U32);
-		    s += sizeof(U32);
+		    COPY32(s, &aulong);
+		    s += SIZE32;
 #ifdef HAS_NTOHL
 		    if (datumtype == 'N')
 			aulong = ntohl(aulong);
@@ -3102,7 +3163,10 @@ PP(pp_unpack)
 		    s += sizeof(Quad_t);
 		}
 		sv = NEWSV(42, 0);
-		sv_setiv(sv, (IV)aquad);
+		if (aquad >= IV_MIN && aquad <= IV_MAX)
+		    sv_setiv(sv, (IV)aquad);
+		else
+		    sv_setnv(sv, (double)aquad);
 		PUSHs(sv_2mortal(sv));
 	    }
 	    break;
@@ -3117,7 +3181,10 @@ PP(pp_unpack)
 		    s += sizeof(unsigned Quad_t);
 		}
 		sv = NEWSV(43, 0);
-		sv_setuv(sv, (UV)auquad);
+		if (aquad <= UV_MAX)
+		    sv_setuv(sv, (UV)auquad);
+		else
+		    sv_setnv(sv, (double)auquad);
 		PUSHs(sv_2mortal(sv));
 	    }
 	    break;
@@ -3238,10 +3305,10 @@ PP(pp_unpack)
 	    }
 	    else {
 		if (checksum < 32) {
-		    along = (1 << checksum) - 1;
-		    culong &= (U32)along;
+		    aulong = (1 << checksum) - 1;
+		    culong &= aulong;
 		}
-		sv_setnv(sv, (double)culong);
+		sv_setuv(sv, (UV)culong);
 	    }
 	    XPUSHs(sv_2mortal(sv));
 	    checksum = 0;
@@ -3407,7 +3474,7 @@ PP(pp_pack)
 	    len = 1;
 	switch(datumtype) {
 	default:
-	    break;
+	    croak("Invalid type in pack: '%c'", datumtype);
 	case '%':
 	    DIE("%% may only be used in unpack");
 	case '@':
@@ -3609,7 +3676,7 @@ PP(pp_pack)
 #ifdef HAS_HTONS
 		ashort = htons(ashort);
 #endif
-		sv_catpvn(cat, (char*)&ashort, sizeof(I16));
+		CAT16(cat, &ashort);
 	    }
 	    break;
 	case 'v':
@@ -3619,7 +3686,7 @@ PP(pp_pack)
 #ifdef HAS_HTOVS
 		ashort = htovs(ashort);
 #endif
-		sv_catpvn(cat, (char*)&ashort, sizeof(I16));
+		CAT16(cat, &ashort);
 	    }
 	    break;
 	case 'S':
@@ -3627,13 +3694,13 @@ PP(pp_pack)
 	    while (len-- > 0) {
 		fromstr = NEXTFROM;
 		ashort = (I16)SvIV(fromstr);
-		sv_catpvn(cat, (char*)&ashort, sizeof(I16));
+		CAT16(cat, &ashort);
 	    }
 	    break;
 	case 'I':
 	    while (len-- > 0) {
 		fromstr = NEXTFROM;
-		auint = U_I(SvNV(fromstr));
+		auint = SvUV(fromstr);
 		sv_catpvn(cat, (char*)&auint, sizeof(unsigned int));
 	    }
 	    break;
@@ -3706,35 +3773,35 @@ PP(pp_pack)
 	case 'N':
 	    while (len-- > 0) {
 		fromstr = NEXTFROM;
-		aulong = U_L(SvNV(fromstr));
+		aulong = SvUV(fromstr);
 #ifdef HAS_HTONL
 		aulong = htonl(aulong);
 #endif
-		sv_catpvn(cat, (char*)&aulong, sizeof(U32));
+		CAT32(cat, &aulong);
 	    }
 	    break;
 	case 'V':
 	    while (len-- > 0) {
 		fromstr = NEXTFROM;
-		aulong = U_L(SvNV(fromstr));
+		aulong = SvUV(fromstr);
 #ifdef HAS_HTOVL
 		aulong = htovl(aulong);
 #endif
-		sv_catpvn(cat, (char*)&aulong, sizeof(U32));
+		CAT32(cat, &aulong);
 	    }
 	    break;
 	case 'L':
 	    while (len-- > 0) {
 		fromstr = NEXTFROM;
-		aulong = U_L(SvNV(fromstr));
-		sv_catpvn(cat, (char*)&aulong, sizeof(U32));
+		aulong = SvUV(fromstr);
+		CAT32(cat, &aulong);
 	    }
 	    break;
 	case 'l':
 	    while (len-- > 0) {
 		fromstr = NEXTFROM;
 		along = SvIV(fromstr);
-		sv_catpvn(cat, (char*)&along, sizeof(I32));
+		CAT32(cat, &along);
 	    }
 	    break;
 #ifdef HAS_QUAD