integrate cfgperl changes into mainline

p4raw-id: //depot/perl@3825

24 files changed, 729 insertions, 213 deletions

diff --git a/Configure b/Configure
index fd08f14239..1f9e653275 100755
--- a/Configure
+++ b/Configure
@@ -20,7 +20,7 @@
 
 # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $
 #
-# Generated on Sun Jul 25 17:05:01 EET DST 1999 [metaconfig 3.0 PL70]
+# Generated on Wed Jul 28 20:32:22 EET DST 1999 [metaconfig 3.0 PL70]
 # (with additional metaconfig patches by perlbug@perl.com)
 
 cat >/tmp/c1$$ <<EOF
@@ -12772,10 +12772,10 @@ find_extensions='
                    eval $find_extensions;
                    cd ..;
                    shift;
-               fi
+               fi;
            fi
            ;;
-       esac
+       esac;
     done'
 tdir=`pwd`
 cd $rsrc/ext
diff --git a/Porting/Glossary b/Porting/Glossary
index 4f1cbf4d19..25d6942fc1 100644
--- a/Porting/Glossary
+++ b/Porting/Glossary
@@ -3081,6 +3081,10 @@ usethreads (usethreads.U):
 	This variable conditionally defines the USE_THREADS symbol,
 	and indicates that Perl should be built to use threads.
 
+usevendorprefix (vendorprefix.U):
+	This variable tells whether the vendorprefix
+	and consequently other vendor* paths are in use.
+
 usevfork (d_vfork.U):
 	This variable is set to true when the user accepts to use vfork.
 	It is set to false when no vfork is available or when the user
diff --git a/Porting/config.sh b/Porting/config.sh
index 40e1301b6c..14d1ea2307 100644
--- a/Porting/config.sh
+++ b/Porting/config.sh
@@ -8,7 +8,7 @@
 
 # Package name      : perl5
 # Source directory  : .
-# Configuration time: Sun Jul 25 17:08:22 EET DST 1999
+# Configuration time: Wed Jul 28 20:34:48 EET DST 1999
 # Configured by     : jhi
 # Target system     : osf1 alpha.hut.fi v4.0 878 alpha 
 
@@ -30,10 +30,10 @@ afs='false'
 alignbytes='8'
 ansi2knr=''
 aphostname=''
-apiversion='5.00557'
+apiversion='5.00558'
 ar='ar'
-archlib='/opt/perl/lib/5.00557/alpha-dec_osf-thread'
-archlibexp='/opt/perl/lib/5.00557/alpha-dec_osf-thread'
+archlib='/opt/perl/lib/5.00558/alpha-dec_osf-thread'
+archlibexp='/opt/perl/lib/5.00558/alpha-dec_osf-thread'
 archname64=''
 archname='alpha-dec_osf-thread'
 archobjs=''
@@ -50,12 +50,12 @@ castflags='0'
 cat='cat'
 cc='cc'
 cccdlflags=' '
-ccdlflags='  -Wl,-rpath,/opt/perl/lib/5.00557/alpha-dec_osf-thread/CORE'
+ccdlflags='  -Wl,-rpath,/opt/perl/lib/5.00558/alpha-dec_osf-thread/CORE'
 ccflags='-pthread -std -DLANGUAGE_C'
 ccsymbols='__LANGUAGE_C__=1 _LONGLONG=1 LANGUAGE_C=1 SYSTYPE_BSD=1'
 cf_by='jhi'
 cf_email='yourname@yourhost.yourplace.com'
-cf_time='Sun Jul 25 17:08:22 EET DST 1999'
+cf_time='Wed Jul 28 20:34:48 EET DST 1999'
 chgrp=''
 chmod=''
 chown=''
@@ -483,15 +483,15 @@ i_vfork='undef'
 ignore_versioned_solibs=''
 incpath=''
 inews=''
-installarchlib='/opt/perl/lib/5.00557/alpha-dec_osf-thread'
+installarchlib='/opt/perl/lib/5.00558/alpha-dec_osf-thread'
 installbin='/opt/perl/bin'
 installman1dir='/opt/perl/man/man1'
 installman3dir='/opt/perl/man/man3'
 installprefix='/opt/perl'
 installprefixexp='/opt/perl'
-installprivlib='/opt/perl/lib/5.00557'
+installprivlib='/opt/perl/lib/5.00558'
 installscript='/opt/perl/bin'
-installsitearch='/opt/perl/lib/site_perl/5.00557/alpha-dec_osf-thread'
+installsitearch='/opt/perl/lib/site_perl/5.00558/alpha-dec_osf-thread'
 installsitelib='/opt/perl/lib/site_perl'
 installstyle='lib'
 installusrbinperl='define'
@@ -586,8 +586,8 @@ pmake=''
 pr=''
 prefix='/opt/perl'
 prefixexp='/opt/perl'
-privlib='/opt/perl/lib/5.00557'
-privlibexp='/opt/perl/lib/5.00557'
+privlib='/opt/perl/lib/5.00558'
+privlibexp='/opt/perl/lib/5.00558'
 prototype='define'
 ptrsize='8'
 randbits='48'
@@ -619,8 +619,8 @@ sig_name_init='"ZERO", "HUP", "INT", "QUIT", "ILL", "TRAP", "ABRT", "EMT", "FPE"
 sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 6 6 16 20 23 23 23 29 48 '
 sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 6, 6, 16, 20, 23, 23, 23, 29, 48, 0'
 signal_t='void'
-sitearch='/opt/perl/lib/site_perl/5.00557/alpha-dec_osf-thread'
-sitearchexp='/opt/perl/lib/site_perl/5.00557/alpha-dec_osf-thread'
+sitearch='/opt/perl/lib/site_perl/5.00558/alpha-dec_osf-thread'
+sitearchexp='/opt/perl/lib/site_perl/5.00558/alpha-dec_osf-thread'
 sitelib='/opt/perl/lib/site_perl'
 sitelibexp='/opt/perl/lib/site_perl'
 siteprefix='/opt/perl'
@@ -650,7 +650,7 @@ stdio_ptr='((fp)->_ptr)'
 stdio_stream_array='_iob'
 strings='/usr/include/string.h'
 submit=''
-subversion='57'
+subversion='58'
 sysman='/usr/man/man1'
 tail=''
 tar=''
@@ -686,7 +686,7 @@ vendorlib=''
 vendorlibexp=''
 vendorprefix=''
 vendorprefixexp=''
-version='5.00557'
+version='5.00558'
 vi=''
 voidflags='15'
 xlibpth='/usr/lib/386 /lib/386'
@@ -708,7 +708,7 @@ config_arg9='-Dmyhostname=yourhost'
 config_arg10='-dE'
 PERL_REVISION=5
 PERL_VERSION=5
-PERL_SUBVERSION=57
+PERL_SUBVERSION=58
 CONFIGDOTSH=true
 # Variables propagated from previous config.sh file.
 pp_sys_cflags='ccflags="$ccflags -DNO_EFF_ONLY_OK"'
diff --git a/Porting/config_H b/Porting/config_H
index 43de61d7ed..740e7c7ad9 100644
--- a/Porting/config_H
+++ b/Porting/config_H
@@ -17,7 +17,7 @@
 /*
  * Package name      : perl5
  * Source directory  : .
- * Configuration time: Sun Jul 25 17:08:22 EET DST 1999
+ * Configuration time: Wed Jul 28 20:34:48 EET DST 1999
  * Configured by     : jhi
  * Target system     : osf1 alpha.hut.fi v4.0 878 alpha 
  */
@@ -1423,8 +1423,8 @@
  *	This symbol contains the ~name expanded version of ARCHLIB, to be used
  *	in programs that are not prepared to deal with ~ expansion at run-time.
  */
-#define ARCHLIB "/opt/perl/lib/5.00557/alpha-dec_osf-thread"		/**/
-#define ARCHLIB_EXP "/opt/perl/lib/5.00557/alpha-dec_osf-thread"		/**/
+#define ARCHLIB "/opt/perl/lib/5.00558/alpha-dec_osf-thread"		/**/
+#define ARCHLIB_EXP "/opt/perl/lib/5.00558/alpha-dec_osf-thread"		/**/
 
 /* BIN:
  *	This symbol holds the path of the bin directory where the package will
@@ -1453,8 +1453,8 @@
  *	This symbol contains the ~name expanded version of PRIVLIB, to be used
  *	in programs that are not prepared to deal with ~ expansion at run-time.
  */
-#define PRIVLIB "/opt/perl/lib/5.00557"		/**/
-#define PRIVLIB_EXP "/opt/perl/lib/5.00557"		/**/
+#define PRIVLIB "/opt/perl/lib/5.00558"		/**/
+#define PRIVLIB_EXP "/opt/perl/lib/5.00558"		/**/
 
 /* SITEARCH:
  *	This symbol contains the name of the private library for this package.
@@ -1469,8 +1469,8 @@
  *	This symbol contains the ~name expanded version of SITEARCH, to be used
  *	in programs that are not prepared to deal with ~ expansion at run-time.
  */
-#define SITEARCH "/opt/perl/lib/site_perl/5.00557/alpha-dec_osf-thread"		/**/
-#define SITEARCH_EXP "/opt/perl/lib/site_perl/5.00557/alpha-dec_osf-thread"		/**/
+#define SITEARCH "/opt/perl/lib/site_perl/5.00558/alpha-dec_osf-thread"		/**/
+#define SITEARCH_EXP "/opt/perl/lib/site_perl/5.00558/alpha-dec_osf-thread"		/**/
 
 /* SITELIB:
  *	This symbol contains the name of the private library for this package.
diff --git a/README.threads b/README.threads
index 136b156e7f..4ae2f37ae5 100644
--- a/README.threads
+++ b/README.threads
@@ -5,34 +5,62 @@ few race conditions that show up under high contention on SMP
 machines.  Internal implementation is still subject to changes.
 It is not recommended for production use at this time.
 
+---------------------------------------------------------------------------
+
 Building
 
-If you want to build with multi-threading support and you are
-running one of the following:
+If your system is in the following list you should be able to just:
 
-  * Linux 2.x (with the LinuxThreads library installed: that's
-    the linuxthreads and linuxthreads-devel RPMs for RedHat)
+    ./Configure -Dusethreads -des
+    make
 
-  * Digital UNIX 4.x
+and ignore the rest of this "Building" section.  If not, continue
+from the "Problems" section.
 
-  * Digital UNIX 3.x (Formerly DEC OSF/1), see additional note below
+	* Linux 2.* (with the LinuxThreads library installed:
+	  that's the linuxthreads and linuxthreads-devel RPMs
+	  for RedHat)
 
-  * Solaris 2.x for recentish x (2.5 is OK)
+	* Tru64 UNIX (formerly Digital UNIX formerly DEC OSF/1)
+	  (see additional note below)
 
-  * IRIX 6.2 or newer. 6.2 will require a few os patches.
-    IMPORTANT: Without patch 2401, a kernel bug in IRIX 6.2 will
-    cause your machine to panic and crash when running threaded perl.
-    IRIX 6.3 and up should be OK. See lower down for patch details.
+	* Solaris 2.* for recentish x (2.5 is OK)
 
-then you should be able to use
+	* IRIX 6.2 or newer. 6.2 will require a few OS patches.
+	  IMPORTANT: Without patch 2401 (or its replacement),
+	  a kernel bug in IRIX 6.2 will cause your machine to
+	  panic and crash when running threaded perl.
+	  IRIX 6.3 and up should be OK. See lower down for patch details.
 
-    ./Configure -Dusethreads -des
-    make
+	* AIX 4.1.5 or newer.
+
+	* FreeBSD 2.2.8 or newer.
+
+	* OpenBSD
+
+	* NeXTstep, OpenStep (Rhapsody?)
 
-and ignore the rest of this "Building" section. If it doesn't
-work or you are using another platform which you believe supports
-POSIX.1c threads then read on.  Additional information may be in
-a platform-specific "hints" file in the hints/ subdirectory.
+	* OS/2
+
+	* DOS DJGPP
+
+	* VM/ESA
+
+---------------------------------------------------------------------------
+
+Problems
+
+If the simple way doesn't work or you are using another platform which
+you believe supports POSIX.1c threads then read on.  Additional
+information may be in a platform-specific "hints" file in the hints/
+subdirectory.
+
+First of all, because threads are such an experimentral feature
+there's a failsafe in Configure that stops unknown platforms
+from using threads.  Search for "is not known to support threads". 
+About five lines above that is a line that has a list of operating
+system names separated with |-signs.  Append your operating system
+(perl -le 'print $^O') to that list.
 
 On other platforms that use Configure to build perl, omit the -d
 from your ./Configure arguments. For example, use:
@@ -43,11 +71,12 @@ When Configure prompts you for ccflags, insert any other arguments in
 there that your compiler needs to use POSIX threads. When Configure
 prompts you for linking flags, include any flags required for
 threading (usually nothing special is required here).  Finally, when
-COnfigure prompts you for libraries, include any necessary libraries
+Configure prompts you for libraries, include any necessary libraries
 (e.g. -lpthread).  Pay attention to the order of libraries.  It is
 probably necessary to specify your threading library *before* your
 standard C library, e.g.  it might be necessary to have -lpthread -lc,
-instead of -lc -lpthread.
+instead of -lc -lpthread.  You may also need to use -lc_r instead
+of -lc.
 
 Once you have specified all your compiler flags, you can have Configure
 accept all the defaults for the remainder of the session by typing  &-d
@@ -71,7 +100,7 @@ For Digital Unix 4.x:
 
 For Digital Unix 3.x (Formerly DEC OSF/1):
     Add -DOLD_PTHREADS_API to ccflags
-    If compiling with the GNU cc compiler, remove -thread from ccflags
+    If compiling with the GNU cc compiler, remove -threads from ccflags
 
     (The following should be done automatically if you call Configure
       with the -Dusethreads option).
@@ -93,6 +122,7 @@ For IRIX:
     For IRIX 6.3 and 6.4 the pthreads should work out of the box.
     Thanks to Hannu Napari <Hannu.Napari@hut.fi> for the IRIX
     pthreads patches information.
+
 For AIX:
     (This should all be done automatically by the hint file).
     Change cc to xlc_r or cc_r.
@@ -107,6 +137,12 @@ For Win32:
 Now you can do a
     make
 
+When you succeed in compiling and testing ("make test" after your
+build) a threaded Perl in a platform previosuly unknown to support
+threaded perl, please let perlbug@perl.com know about your victory.
+Explain what you did in painful detail.
+
+---------------------------------------------------------------------------
 
 O/S specific bugs
 
@@ -155,6 +191,7 @@ Try running the main perl test suite too. There are known
 failures for some of the DBM/DB extensions (if their underlying
 libraries were not compiled to be thread-aware).
 
+---------------------------------------------------------------------------
 
 Bugs
 
@@ -164,8 +201,7 @@ tested at all in recent times.)
 
 * There may still be races where bugs show up under contention.
 
-* Need to document "lock", Thread.pm, Queue.pm, ...
-
+---------------------------------------------------------------------------
 
 Debugging
 
@@ -178,6 +214,7 @@ have to delete the lines in perl.c which say
         DEBUG_S(signal(SIGSEGV, (void(*)(int))catch_sigsegv););
     #endif
 
+---------------------------------------------------------------------------
 
 Background
 
@@ -287,3 +324,6 @@ Andy Dougherty <doughera@lafayette.edu>
 
 Other minor updates 10 Feb 1999 by
 Gurusamy Sarathy
+
+More platforms added 26 Jul 1999 by
+Jarkko Hietaniemi
diff --git a/ext/IO/lib/IO/Handle.pm b/ext/IO/lib/IO/Handle.pm
index 9b5dd6570e..2205368e96 100644
--- a/ext/IO/lib/IO/Handle.pm
+++ b/ext/IO/lib/IO/Handle.pm
@@ -417,13 +417,15 @@ sub sysread {
 }
 
 sub write {
-    @_ == 3 || @_ == 4 or croak 'usage: $io->write(BUF, LEN [, OFFSET])';
+    @_ >= 2 && @_ <= 4 or croak 'usage: $io->write(BUF [, LEN [, OFFSET]])';
     local($\) = "";
+    $_[2] = length($_[1]) unless defined $_[2];
     print { $_[0] } substr($_[1], $_[3] || 0, $_[2]);
 }
 
 sub syswrite {
-    @_ == 3 || @_ == 4 or croak 'usage: $io->syswrite(BUF, LEN [, OFFSET])';
+    @_ >= 2 && @_ <= 4 or croak 'usage: $io->syswrite(BUF [, LEN [, OFFSET]])';
+    $_[2] = length($_[1]) unless defined $_[2];
     syswrite($_[0], $_[1], $_[2], $_[3] || 0);
 }
 
diff --git a/ext/IO/lib/IO/Socket.pm b/ext/IO/lib/IO/Socket.pm
index 46205a6631..5cf9e72919 100644
--- a/ext/IO/lib/IO/Socket.pm
+++ b/ext/IO/lib/IO/Socket.pm
@@ -279,7 +279,7 @@ sub socktype {
 sub protocol {
     @_ == 1 or croak 'usage: $sock->protocol()';
     my($sock) = @_;
-    ${*$sock}{'io_socket_protocol'};
+    ${*$sock}{'io_socket_proto'};
 }
 
 1;
diff --git a/ext/IO/lib/IO/Socket/INET.pm b/ext/IO/lib/IO/Socket/INET.pm
index 367959565d..c8e3a7694c 100644
--- a/ext/IO/lib/IO/Socket/INET.pm
+++ b/ext/IO/lib/IO/Socket/INET.pm
@@ -147,6 +147,9 @@ sub configure {
 	    last;
 	}
 
+ 	# don't try to connect unless we're given a PeerAddr
+ 	last unless exists($arg->{PeerAddr});
+ 
         $raddr = shift @raddr;
 
 	return _error($sock,'Cannot determine remote port')
diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs
index e4433e0448..8f0c3b781b 100644
--- a/ext/POSIX/POSIX.xs
+++ b/ext/POSIX/POSIX.xs
@@ -358,7 +358,7 @@ not_here(char *s)
 }
 
 static
-#ifdef HAS_LONG_DOUBLE
+#if defined(HAS_LONG_DOUBLE) && (LONG_DOUBLESIZE > DOUBLESIZE)
 long double
 #else
 double
diff --git a/lib/ExtUtils/Install.pm b/lib/ExtUtils/Install.pm
index f75aa55fa8..74bd99b147 100644
--- a/lib/ExtUtils/Install.pm
+++ b/lib/ExtUtils/Install.pm
@@ -85,9 +85,7 @@ sub install {
 	    exists $hash{"blib/arch"} and
 	    directory_not_empty("blib/arch")) {
 	    $targetroot = $hash{"blib/arch"};
-            print "Files found in blib/arch --> Installing files in " 
-	        . "blib/lib into architecture dependend library tree!\n"
-		; #if $verbose>1;
+            print "Files found in blib/arch: installing files in blib/lib into architecture dependent library tree\n";
 	}
 	chdir($source) or next;
 	find(sub {
diff --git a/perl.h b/perl.h
index 9af2e0db44..86657049f6 100644
--- a/perl.h
+++ b/perl.h
@@ -330,7 +330,7 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
 # define STANDARD_C 1
 #endif
 
-#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(OS2) || defined(__DGUX) || defined( EPOC)
+#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(OS2) || defined(__DGUX) || defined( EPOC) || defined(__QNX__)
 # define DONT_DECLARE_STD 1
 #endif
 
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 624b152075..8a4c2d1d4e 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -134,6 +134,10 @@ C<oct()>:
     $answer = 0b101010;
     printf "The answer is: %b\n", oct("0b101010");
 
+=head2 Too large hexadecimal, octal, and binary constants more serious
+
+Too large hexadecimal, octal, and binary constants now cause fatal errors.
+
 =head2 syswrite() ease-of-use
 
 The length argument of C<syswrite()> is now optional.
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 646355fe81..7d27fc29f6 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -467,6 +467,21 @@ already occurred.  Since the intended environment for the C<BEGIN {}>
 could not be guaranteed (due to the errors), and since subsequent code
 likely depends on its correct operation, Perl just gave up.
 
+=item Binary number > 0b11111111111111111111111111111111 non-portable
+
+(W) The binary number you specified is larger than 2**32-1 and
+therefore non-portable between systems.  If you know that your code is
+always going to be used only in systems that have more than 32-bit
+integers (which means that Perl should be able to use such), you can
+silence this warning by
+
+	{
+	    no warning 'unsafe';
+	    .... your code here ...
+	}
+
+See also L<perlport> for writing portable code.
+
 =item bind() on closed fd
 
 (W) You tried to do a bind on a closed socket.  Did you forget to check
@@ -1414,6 +1429,21 @@ an emergency basis to prevent a core dump.
 (D) Really old Perl let you omit the % on hash names in some spots.  This
 is now heavily deprecated.
 
+=item Hexadecimal number > 0xffffffff non-portable
+
+(W) The hexadecimal number you specified is larger than 2**32-1 and
+therefore non-portable between systems.  If you know that your code is
+always going to be used only in systems that have more than 32-bit
+integers (which means that Perl should be able to use such), you can
+silence this warning by
+
+	{
+	    no warning 'unsafe';
+	    .... your code here ...
+	}
+
+See also L<perlport> for writing portable code.
+
 =item Identifier too long
 
 (F) Perl limits identifiers (names for variables, functions, etc.) to
@@ -1483,8 +1513,8 @@ of the octal number stopped before the 8 or 9.
 
 =item Illegal hexadecimal digit %s ignored
 
-(W) You may have tried to use a character other than 0 - 9 or A - F in a
-hexadecimal number.  Interpretation of the hexadecimal number stopped
+(W) You may have tried to use a character other than 0 - 9 or A - F, a - f
+in a hexadecimal number.  Interpretation of the hexadecimal number stopped
 before the illegal character.
 
 =item Illegal switch in PERL5OPT: %s
@@ -1528,14 +1558,18 @@ known value, using trustworthy data.  See L<perlsec>.
 
 =item Integer overflow in %s number
 
-(S) The literal hexadecimal, octal or binary number you have specified
-is too big for your architecture. On a 32-bit architecture the largest
-literal hex, octal or binary number representable without overflow
-is 0xFFFFFFFF, 037777777777, or 0b11111111111111111111111111111111
-respectively.  Note that Perl transparently promotes decimal literals
-to a floating point representation internally--subject to loss of
-precision errors in subsequent operations--so this limit usually
-doesn't apply to decimal literals.
+(F,X) The hexadecimal, octal or binary number you have specified
+either as a literal in your code or as a scalar is too big for your
+architecture. On a 32-bit architecture the largest literal hex, octal
+or binary number representable without overflow is 0xFFFFFFFF,
+037777777777, or 0b11111111111111111111111111111111 respectively.
+Note that Perl transparently promotes decimal literals to a floating
+point representation internally--subject to loss of precision errors
+in subsequent operations--so this limit usually doesn't apply to
+decimal literals.  If the overflow is in a literal of your code, the
+error is untrappable (there is no way the code could work safely in
+your system), if the overflow happens in hex() or oct() the error is
+trappable.
 
 =item Internal inconsistency in tracking vforks
 
@@ -1960,6 +1994,21 @@ about 250 characters.  You've exceeded that length.  Future versions of
 Perl are likely to eliminate this arbitrary limitation.  In the meantime,
 try using scientific notation (e.g. "1e6" instead of "1_000_000").
 
+=item Octal number > 037777777777 non-portable
+
+(W) The octal number you specified is larger than 2**32-1 and
+therefore non-portable between systems.  If you know that your code is
+always going to be used only in systems that have more than 32-bit
+integers (which means that Perl should be able to use such), you can
+silence this warning by
+
+	{
+	    no warning 'unsafe';
+	    .... your code here ...
+	}
+
+See also L<perlport> for writing portable code.
+
 =item Odd number of elements in hash assignment
 
 (S) You specified an odd number of elements to initialize a hash, which
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index 2ced382085..13ada36574 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -396,8 +396,8 @@ undefined, or you might be able to use the C<syscall> interface to
 access setitimer(2) if your system supports it.  The Time::HiRes module
 from CPAN may also prove useful.
 
-It is usually a mistake to intermix C<alarm>
-and C<sleep> calls.
+It is usually a mistake to intermix C<alarm> and C<sleep> calls.
+(C<sleep> may be internally implemented in your system with C<alarm>)
 
 If you want to use C<alarm> to time out a system call you need to use an
 C<eval>/C<die> pair.  You can't rely on the alarm causing the system call to
@@ -2227,11 +2227,13 @@ In scalar context, returns the ctime(3) value:
     $now_string = localtime;  # e.g., "Thu Oct 13 04:54:34 1994"
 
 This scalar value is B<not> locale dependent, see L<perllocale>, but
-instead a Perl builtin.  Also see the C<Time::Local> module, and the
-strftime(3) and mktime(3) function available via the POSIX module.  To
-get somewhat similar but locale dependent date strings, set up your
-locale environment variables appropriately (please see L<perllocale>)
-and try for example:
+instead a Perl builtin.  Also see the C<Time::Local> module
+(to convert the second, minutes, hours, ... back to seconds since the
+stroke of midnight the 1st of January 1970, the value returned by
+time()), and the strftime(3) and mktime(3) function available via the
+POSIX module.  To get somewhat similar but locale dependent date
+strings, set up your locale environment variables appropriately
+(please see L<perllocale>) and try for example:
 
     use POSIX qw(strftime);
     $now_string = strftime "%a %b %e %H:%M:%S %Y", localtime;
@@ -2717,7 +2719,8 @@ follows:
     s	A signed short value.
     S	An unsigned short value.
 	  (This 'short' is _exactly_ 16 bits, which may differ from
-	   what a local C compiler calls 'short'.)
+	   what a local C compiler calls 'short'.  If you want
+	   native-length shorts, use the '!' suffix.)
 
     i	A signed integer value.
     I	An unsigned integer value.
@@ -2729,7 +2732,8 @@ follows:
     l	A signed long value.
     L	An unsigned long value.
 	  (This 'long' is _exactly_ 32 bits, which may differ from
-	   what a local C compiler calls 'long'.)
+	   what a local C compiler calls 'long'.  If you want
+	   native-length longs, use the '!' suffix.)
 
     n	A short in "network" (big-endian) order.
     N	A long in "network" (big-endian) order.
@@ -2740,8 +2744,8 @@ follows:
 
     q	A signed quad (64-bit) value.
     Q	An unsigned quad value.
-	  (Available only if your system supports 64-bit integer values
-	   _and_ if Perl has been compiled to support those.
+	  (Quads are available only if your system supports 64-bit
+	   integer values _and_ if Perl has been compiled to support those.
            Causes a fatal error otherwise.)
 
     f	A single-precision float in the native format.
@@ -2788,7 +2792,8 @@ Likewise, the C<"b"> and C<"B"> fields pack a string that many bits long.
 
 =item *
 
-The C<"h"> and C<"H"> fields pack a string that many nybbles long.
+The C<"h"> and C<"H"> fields pack a string that many nybbles (4-bit groups,
+representable as hexadecimal digits, 0-9a-f) long.
 
 =item *
 
@@ -2831,11 +2836,11 @@ which Perl does not regard as legal in numeric strings.
 =item *
 
 The integer types C<"s">, C<"S">, C<"l">, and C<"L"> may be
-immediately followed by a C<"!"> to signify native shorts or longs--as
-you can see from above for example a bare C<"l"> does mean exactly 32
-bits, the native C<long> (as seen by the local C compiler) may be
-larger.  This is an issue mainly in 64-bit platforms.  You can see
-whether using C<"!"> makes any difference by
+immediately followed by a C<"!"> suffix to signify native shorts or
+longs--as you can see from above for example a bare C<"l"> does mean
+exactly 32 bits, the native C<long> (as seen by the local C compiler)
+may be larger.  This is an issue mainly in 64-bit platforms.  You can
+see whether using C<"!"> makes any difference by
 
 	print length(pack("s")), " ", length(pack("s!")), "\n";
 	print length(pack("l")), " ", length(pack("l!")), "\n";
@@ -2843,9 +2848,6 @@ whether using C<"!"> makes any difference by
 C<"i!"> and C<"I!"> also work but only because of completeness;
 they are identical to C<"i"> and C<"I">.
 
-The actual sizes (in bytes) of native shorts, ints, and longs on
-the platform where Perl was built are also available via L<Config>:
-
 The actual sizes (in bytes) of native shorts, ints, longs, and long
 longs on the platform where Perl was built are also available via
 L<Config>:
@@ -2856,6 +2858,9 @@ L<Config>:
        print $Config{longsize},     "\n";
        print $Config{longlongsize}, "\n";
 
+(The C<$Config{longlongsize}> will be empty if your system does
+not support long longs.) 
+
 =item *
 
 The integer formats C<"s">, C<"S">, C<"i">, C<"I">, C<"l">, and C<"L">
@@ -2898,6 +2903,7 @@ and C<'87654321'> are big-endian.
 
 If you want portable packed integers use the formats C<"n">, C<"N">,
 C<"v">, and C<"V">, their byte endianness and size is known.
+See also L<perlport>.
 
 =item *
 
@@ -2907,13 +2913,21 @@ standard "network" representation, no facility for interchange has been
 made.  This means that packed floating point data written on one machine
 may not be readable on another - even if both use IEEE floating point
 arithmetic (as the endian-ness of the memory representation is not part
-of the IEEE spec).
+of the IEEE spec).  See also L<perlport>.
 
 Note that Perl uses doubles internally for all numeric calculation, and
 converting from double into float and thence back to double again will
 lose precision (i.e., C<unpack("f", pack("f", $foo)>) will not in general
 equal $foo).
 
+=item *
+
+You must yourself do any alignment or padding by inserting for example
+enough C<'x'>es while packing.  There is no way to pack() and unpack()
+could know where the bytes are going to or coming from.  Therefore
+C<pack> (and C<unpack>) handle their output and input as flat
+sequences of bytes.
+
 =back
 
 Examples:
@@ -2928,6 +2942,11 @@ Examples:
     $foo = pack("ccxxcc",65,66,67,68);
     # foo eq "AB\0\0CD"
 
+    # note: the above examples featuring "C" and "c" are true
+    # only on ASCII and ASCII-derived systems such as ISO Latin 1
+    # and UTF-8.  In EBCDIC the first example would be
+    # $foo = pack("CCCC",193,194,195,196);
+
     $foo = pack("s2",1,2);
     # "\1\0\2\0" on little-endian
     # "\0\1\0\2" on big-endian
@@ -2955,6 +2974,12 @@ Examples:
 	unpack("N", pack("B32", substr("0" x 32 . shift, -32)));
     }
 
+    $foo = pack('sx2l', 12, 34);
+    # short 12, two zero bytes padding, long 34
+    $bar = pack('s@4l', 12, 34);
+    # short 12, zero fill to position 4, long 34
+    # $foo eq $bar
+
 The same template may generally also be used in unpack().
 
 =item package 
@@ -3742,8 +3767,9 @@ however, because your process might not be scheduled right away in a
 busy multitasking system.
 
 For delays of finer granularity than one second, you may use Perl's
-C<syscall> interface to access setitimer(2) if your system supports it,
-or else see L</select> above.
+C<syscall> interface to access setitimer(2) if your system supports
+it, or else see L</select> above.  The Time::HiRes module from CPAN
+may also help.
 
 See also the POSIX module's C<sigpause> function.
 
@@ -4610,6 +4636,11 @@ considers to be the epoch (that's 00:00:00, January 1, 1904 for MacOS,
 and 00:00:00 UTC, January 1, 1970 for most other systems).
 Suitable for feeding to C<gmtime> and C<localtime>.
 
+For measuring time in better granularity than one second,
+you may use either the Time::HiRes module from CPAN, or
+if you have gettimeofday(2), you may be able to use the
+C<syscall> interface of Perl, see L<perlfaq8> for details.
+
 =item times
 
 Returns a four-element list giving the user and system times, in
@@ -4771,7 +4802,7 @@ has no way of checking whether the value passed to C<unpack()>
 corresponds to a valid memory location, passing a pointer value that's
 not known to be valid is likely to have disastrous consequences.
 
-See L</pack> for more examples.
+See L</pack> for more examples and notes.
 
 =item untie VARIABLE
 
diff --git a/pod/perllexwarn.pod b/pod/perllexwarn.pod
index 11947550c5..484e211000 100644
--- a/pod/perllexwarn.pod
+++ b/pod/perllexwarn.pod
@@ -50,11 +50,12 @@ warnings: mandatory and optional.
 
 As its name suggests, if your code tripped a mandatory warning, you
 would get a warning whether you wanted it or not.
-For example, the code below would always produce an C<"integer overflow">
-warning.
+For example, the code below would always produce an C<"isn't numeric">
+warning about the "2:".
 
-    my $a = oct "777777777777777777777777777777777777" ;
+    my $a = "2:" + 3;
 
+though the result will be 5.
 
 With the introduction of lexical warnings, mandatory warnings now become
 I<default> warnings. The difference is that although the previously
@@ -63,9 +64,9 @@ subsequently enabled or disabled with the lexical warning pragma. For
 example, in the code below, an C<"integer overflow"> warning will only
 be reported for the C<$a> variable.
 
-    my $a = oct "777777777777777777777777777777777777" ;
+    my $a = "2:" + 3;
     no warning ;
-    my $b = oct "777777777777777777777777777777777777" ;
+    my $b = "2:" + 3;
 
 Note that neither the B<-w> flag or the C<$^W> can be used to
 disable/enable default warnings. They are still mandatory in this case.
@@ -206,7 +207,7 @@ to change.
 
 =head2 Category Hierarchy
  
-A tentative hierarchy of "categories" have been defined to allow groups
+A B<tentative> hierarchy of "categories" have been defined to allow groups
 of warnings to be enabled/disabled in isolation.  The current
 hierarchy is:
 
@@ -312,6 +313,9 @@ The experimental features need bottomed out.
     around the limitations of C<$^W>. Now that those limitations are gone,
     the module should be revisited.
 
+  octal
+    'octal' controls illegal octal characters warning but 'unsafe'
+    illegal hexadecimal and binary characters warning.  
 
 =head1 SEE ALSO
 
diff --git a/pod/perlre.pod b/pod/perlre.pod
index 470c5934ff..6c05efc66f 100644
--- a/pod/perlre.pod
+++ b/pod/perlre.pod
@@ -570,7 +570,7 @@ at run time, at the moment this subexpression may match.  The result
 of evaluation is considered as a regular expression and matched as
 if it were inserted instead of this construct.
 
-C<code> is not interpolated.  As before, the rules to determine
+The C<code> is not interpolated.  As before, the rules to determine
 where the C<code> ends are currently somewhat convoluted.
 
 The following pattern matches a parenthesized group:
diff --git a/pp.c b/pp.c
index 69d3795ee4..770b07d8bb 100644
--- a/pp.c
+++ b/pp.c
@@ -1885,7 +1885,7 @@ PP(pp_hex)
     STRLEN n_a;
 
     tmps = POPpx;
-    XPUSHu(scan_hex(tmps, 99, &argtype));
+    XPUSHu(scan_hex(tmps, sizeof(UV) * 2 + 1, &argtype));
     RETURN;
 }
 
@@ -1900,14 +1900,14 @@ PP(pp_oct)
     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);
+    /* Do not eat the leading 0[bx] because we need them
+     * to detect malformed binary and hexadecimal numbers. */
+    if ((tmps[0] == '0' && tmps[1] == 'x') || tmps[0] == 'x')
+	value = scan_hex(tmps, sizeof(UV) * 2 + 1, &argtype);
+    else if ((tmps[0] == '0' && tmps[1] == 'b') || tmps[0] == 'b')
+	value = scan_bin(tmps, sizeof(UV) * 8 + 1, &argtype);
     else
-	value = scan_oct(tmps, 99, &argtype);
+	value = scan_oct(tmps, sizeof(UV) * 4 + 1, &argtype);
     XPUSHu(value);
     RETURN;
 }
diff --git a/pp_sys.c b/pp_sys.c
index a849dbb82e..5b421db636 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -4617,7 +4617,7 @@ PP(pp_gpwent)
     register SV *sv;
     struct passwd *pwent;
     STRLEN n_a;
-#ifdef HAS_GETSPENT
+#if defined(HAS_GETSPENT) || defined(HAS_GETSPNAM)
     struct spwd *spwent = NULL;
 #endif
 
@@ -4639,8 +4639,10 @@ PP(pp_gpwent)
 	    spwent = getspnam(pwent->pw_name);
     }
 #  endif
+#  ifdef HAS_GETSPENT
     else
 	spwent = (struct spwd *)getspent();
+#  endif
 #endif
 
     EXTEND(SP, 10);
@@ -4661,7 +4663,7 @@ PP(pp_gpwent)
 
 	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 #ifdef PWPASSWD
-#   ifdef HAS_GETSPENT
+#   if defined(HAS_GETSPENT) || defined(HAS_GETSPNAM)
       if (spwent)
               sv_setpv(sv, spwent->sp_pwdp);
       else
diff --git a/t/lib/io_unix.t b/t/lib/io_unix.t
index e1c89c4ebd..7338861fb4 100644
--- a/t/lib/io_unix.t
+++ b/t/lib/io_unix.t
@@ -27,6 +27,8 @@ BEGIN {
 	    eval {IO::Socket::pack_sockaddr_un('/tmp/foo') || 1}
 	      or $@ !~ /not implemented/ or
 		$reason = 'compiled without TCP/IP stack v4';
+	} elsif ($^O eq 'qnx') {
+	    $reason = 'Not implemented';
 	}
 	undef $reason if $^O eq 'VMS' and $Config{d_socket};
 	if ($reason) {
diff --git a/t/op/oct.t b/t/op/oct.t
index 06bf8db660..1dbb941327 100755
--- a/t/op/oct.t
+++ b/t/op/oct.t
@@ -1,15 +1,38 @@
 #!./perl
 
-print "1..11\n";
-
-print +(oct('01234') == 01234) ? "ok" : "not ok", " 1\n";
-print +(oct('0x1234') == 0x1234) ? "ok" : "not ok", " 2\n";
-print +(hex('01234') == 0x1234) ? "ok" : "not ok", " 3\n";
-print +(oct('20000000000') == 020000000000) ? "ok" : "not ok", " 4\n";
-print +(oct('x80000000') == 0x80000000) ? "ok" : "not ok", " 5\n";
-print +(hex('80000000') == 0x80000000) ? "ok" : "not ok", " 6\n";
-print +(oct('1234') == 668) ? "ok" : "not ok", " 7\n";
-print +(hex('1234') == 4660) ? "ok" : "not ok", " 8\n";
-print +(hex('0x1234') == 0x1234) ? "ok" : "not ok", " 9\n";
-print +(oct('b11100') == 28) ? "ok" : "not ok", " 10\n";
-print +(oct('b101010') == 0b101010) ? "ok" : "not ok", " 11\n";
+print "1..28\n";
+
+print +(oct('0b10101') ==          0b10101) ? "ok" : "not ok", " 1\n";
+print +(oct('0b10101') ==              025) ? "ok" : "not ok", " 2\n";
+print +(oct('0b10101') ==               21) ? "ok" : "not ok", " 3\n";
+print +(oct('0b10101') ==             0x15) ? "ok" : "not ok", " 4\n";
+
+print +(oct('b10101')  ==          0b10101) ? "ok" : "not ok", " 5\n";
+print +(oct('b10101')  ==              025) ? "ok" : "not ok", " 6\n";
+print +(oct('b10101')  ==               21) ? "ok" : "not ok", " 7\n";
+print +(oct('b10101')  ==             0x15) ? "ok" : "not ok", " 8\n";
+
+print +(oct('01234')   ==     0b1010011100) ? "ok" : "not ok", " 9\n";
+print +(oct('01234')   ==            01234) ? "ok" : "not ok", " 10\n";
+print +(oct('01234')   ==              668) ? "ok" : "not ok", " 11\n";
+print +(oct('01234')   ==            0x29c) ? "ok" : "not ok", " 12\n";
+
+print +(oct('0x1234')  ==  0b1001000110100) ? "ok" : "not ok", " 13\n";
+print +(oct('0x1234')  ==           011064) ? "ok" : "not ok", " 14\n";
+print +(oct('0x1234')  ==             4660) ? "ok" : "not ok", " 15\n";
+print +(oct('0x1234')  ==           0x1234) ? "ok" : "not ok", " 16\n";
+
+print +(hex('01234')   ==  0b1001000110100) ? "ok" : "not ok", " 17\n";
+print +(hex('01234')   ==           011064) ? "ok" : "not ok", " 18\n";
+print +(hex('01234')   ==             4660) ? "ok" : "not ok", " 19\n";
+print +(hex('01234')   ==           0x1234) ? "ok" : "not ok", " 20\n";
+
+print +(hex('0x1234')  ==  0b1001000110100) ? "ok" : "not ok", " 21\n";
+print +(hex('0x1234')  ==           011064) ? "ok" : "not ok", " 22\n";
+print +(hex('0x1234')  ==             4660) ? "ok" : "not ok", " 23\n";
+print +(hex('0x1234')  ==           0x1234) ? "ok" : "not ok", " 24\n";
+
+print +(hex('x1234')   ==  0b1001000110100) ? "ok" : "not ok", " 25\n";
+print +(hex('x1234')   ==           011064) ? "ok" : "not ok", " 26\n";
+print +(hex('x1234')   ==             4660) ? "ok" : "not ok", " 27\n";
+print +(hex('x1234')   ==           0x1234) ? "ok" : "not ok", " 28\n";
diff --git a/t/pragma/warn/6default b/t/pragma/warn/6default
index c095b20827..be45c77777 100644
--- a/t/pragma/warn/6default
+++ b/t/pragma/warn/6default
@@ -11,24 +11,23 @@ Integer overflow in octal number at - line 3.
 no warning ;
 my $a = oct "7777777777777777777777777777777777779" ;
 EXPECT
+Integer overflow in octal number at - line 3.
 ########
 # all warning should be displayed 
 use warning ;
-my $a = oct "7777777777777777777777777777777777779" ;
+my $a = oct "77777777797";
 EXPECT
-Integer overflow in octal number at - line 3.
 Illegal octal digit '9' ignored at - line 3.
 ########
 # check scope
 use warning ;
-my $a = oct "7777777777777777777777777777777777779" ;
+my $a = oct "77777777797";
 {
     no warning ;
-    my $a = oct "7777777777777777777777777777777777779" ;
+    my $b = oct "77777777797";
 }    
 my $c = oct "7777777777777777777777777777777777779" ;
 EXPECT
-Integer overflow in octal number at - line 3.
 Illegal octal digit '9' ignored at - line 3.
+Octal number > 037777777777 non-portable at - line 8.
 Integer overflow in octal number at - line 8.
-Illegal octal digit '9' ignored at - line 8.
diff --git a/t/pragma/warn/util b/t/pragma/warn/util
index fc1e6dde3f..87d43e8ffc 100644
--- a/t/pragma/warn/util
+++ b/t/pragma/warn/util
@@ -3,7 +3,7 @@
      Illegal octal digit ignored 
 	my $a = oct "029" ;
 
-     Illegal hex digit ignored 
+     Illegal hexadecimal digit ignored 
 	my $a = hex "0xv9" ;
 
      Illegal binary digit ignored
@@ -21,7 +21,7 @@ __END__
 use warning 'octal' ;
 my $a = oct "029" ;
 no warning 'octal' ;
-my $a = oct "029" ;
+my $b = oct "029" ;
 EXPECT
 Illegal octal digit '9' ignored at - line 3.
 ########
@@ -42,62 +42,47 @@ EXPECT
 Illegal binary digit '9' ignored at - line 3.
 ########
 # util.c
-BEGIN { require Config ; import Config }
-$^W =1 ;
+$^W = 1 ;
 sub make_bin { "1" x $_[0] }
-my $s = $Config{longsize};
-eval { pack "q", 0 }; eval { $s = length pack "q", 0 } unless $@;
-$n = make_bin(8 * $s    ) ;
-$o = make_bin(8 * $s + 1) ;
+$n = make_bin(33);
 {
   use warning 'unsafe' ;
   my $a = oct "0b$n" ;
-  my $b = oct "0b$o" ;
   no warning 'unsafe' ;
-  $b = oct "0b$o" ;
+  my $b = oct "0b$n" ;
 }
-my $b = oct "0b$o" ;
+my $c = oct "0b$n" ;
 EXPECT
-Integer overflow in binary number at - line 12.
-Integer overflow in binary number at - line 16.
+Binary number > 0b11111111111111111111111111111111 non-portable at - line 7.
+Binary number > 0b11111111111111111111111111111111 non-portable at - line 11.
 ########
 # util.c
-BEGIN { require Config ; import Config }
-$^W =1 ;
+$^W = 1 ;
 sub make_oct { ("","1","3")[$_[0]%3] . "7" x int($_[0]/3) }
-my $s = $Config{longsize};
-eval { pack "q", 0 }; eval { $s = length pack "q", 0 } unless $@;
-$n = make_oct(8 * $s    );
-$o = make_oct(8 * $s + 1);
+$n = make_oct(33);
 {
   use warning 'unsafe' ;
   my $a = oct "$n" ;
-  my $b = oct "$o" ;
   no warning 'unsafe' ;
-  $b = oct "$o" ;
+  my $b = oct "$n" ;
 }
-my $b = oct "$o" ;
+my $c = oct "$n" ;
 EXPECT
-Integer overflow in octal number at - line 12.
-Integer overflow in octal number at - line 16.
+Octal number > 037777777777 non-portable at - line 7.
+Octal number > 037777777777 non-portable at - line 11.
 ########
 # util.c
-BEGIN { require Config ; import Config }
-$^W =1 ;
+$^W = 1 ;
 sub make_hex { ("","1","3","7")[$_[0]%4] . "f" x int($_[0]/4) }
-my $s = $Config{longsize};
-eval { pack "q", 0 }; eval { $s = length pack "q", 0 } unless $@;
-$n = make_hex(8 * $s    ) ;
-$o = make_hex(8 * $s + 1) ;
+$n = make_hex(33);
 {
   use warning 'unsafe' ;
   my $a = hex "$n" ;
-  my $b = hex "$o" ;
   no warning 'unsafe' ;
-  $b = hex "$o" ;
+  my $b = hex "$n" ;
 }
-my $b = hex "$o" ;
+my $c = hex "$n" ;
 EXPECT
-Integer overflow in hexadecimal number at - line 12.
-Integer overflow in hexadecimal number at - line 16.
+Hexadecimal number > 0xffffffff non-portable at - line 7.
+Hexadecimal number > 0xffffffff non-portable at - line 11.
 
diff --git a/toke.c b/toke.c
index 3dbdf8371d..6f792f21d5 100644
--- a/toke.c
+++ b/toke.c
@@ -11,6 +11,14 @@
  *   "It all comes from here, the stench and the peril."  --Frodo
  */
 
+/* toke.c
+ *
+ * This file is the tokenizer for Perl.  It's closely linked to the
+ * parser, perly.y.  
+ *
+ * The main routine is yylex(), which returns the next token.
+ */
+
 #include "EXTERN.h"
 #define PERL_IN_TOKE_C
 #include "perl.h"
@@ -42,7 +50,8 @@ static void restore_lex_expect(pTHXo_ void *e);
  * 1999-02-27 mjd-perl-patch@plover.com */
 #define isCONTROLVAR(x) (isUPPER(x) || strchr("[\\]^_?", (x)))
 
-/* The following are arranged oddly so that the guard on the switch statement
+/* LEX_* are values for PL_lex_state, the state of the lexer.
+ * They are arranged oddly so that the guard on the switch statement
  * can get by with a single comparison (if the compiler is smart enough).
  */
 
@@ -91,11 +100,41 @@ int* yychar_pointer = NULL;
 
 #include "keywords.h"
 
+/* CLINE is a macro that ensures PL_copline has a sane value */
+
 #ifdef CLINE
 #undef CLINE
 #endif
 #define CLINE (PL_copline = (PL_curcop->cop_line < PL_copline ? PL_curcop->cop_line : PL_copline))
 
+/*
+ * Convenience functions to return different tokens and prime the
+ * tokenizer for the next token.  They all take an argument.
+ *
+ * TOKEN        : generic token (used for '(', DOLSHARP, etc)
+ * OPERATOR     : generic operator
+ * AOPERATOR    : assignment operator
+ * PREBLOCK     : beginning the block after an if, while, foreach, ...
+ * PRETERMBLOCK : beginning a non-code-defining {} block (eg, hash ref)
+ * PREREF       : *EXPR where EXPR is not a simple identifier
+ * TERM         : expression term
+ * LOOPX        : loop exiting command (goto, last, dump, etc)
+ * FTST         : file test operator
+ * FUN0         : zero-argument function
+ * FUN1         : not used
+ * BOop         : bitwise or or xor
+ * BAop         : bitwise and
+ * SHop         : shift operator
+ * PWop         : power operator
+ * PMop         : matching operator
+ * Aop          : addition-level operator
+ * Mop          : multiplication-level operator
+ * Eop          : equality-testing operator
+ * Rop        : relational operator <= != gt
+ *
+ * Also see LOP and lop() below.
+ */
+
 #define TOKEN(retval) return (PL_bufptr = s,(int)retval)
 #define OPERATOR(retval) return (PL_expect = XTERM,PL_bufptr = s,(int)retval)
 #define AOPERATOR(retval) return ao((PL_expect = XTERM,PL_bufptr = s,(int)retval))
@@ -135,6 +174,13 @@ int* yychar_pointer = NULL;
 /* grandfather return to old style */
 #define OLDLOP(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)LSTOP)
 
+/*
+ * S_ao
+ *
+ * This subroutine detects &&= and ||= and turns an ANDAND or OROR
+ * into an OP_ANDASSIGN or OP_ORASSIGN
+ */
+
 STATIC int
 S_ao(pTHX_ int toketype)
 {
@@ -149,6 +195,19 @@ S_ao(pTHX_ int toketype)
     return toketype;
 }
 
+/*
+ * S_no_op
+ * When Perl expects an operator and finds something else, no_op
+ * prints the warning.  It always prints "<something> found where
+ * operator expected.  It prints "Missing semicolon on previous line?"
+ * if the surprise occurs at the start of the line.  "do you need to
+ * predeclare ..." is printed out for code like "sub bar; foo bar $x"
+ * where the compiler doesn't know if foo is a method call or a function.
+ * It prints "Missing operator before end of line" if there's nothing
+ * after the missing operator, or "... before <...>" if there is something
+ * after the missing operator.
+ */
+
 STATIC void
 S_no_op(pTHX_ char *what, char *s)
 {
@@ -172,6 +231,15 @@ S_no_op(pTHX_ char *what, char *s)
     PL_bufptr = oldbp;
 }
 
+/*
+ * S_missingterm
+ * Complain about missing quote/regexp/heredoc terminator.
+ * If it's called with (char *)NULL then it cauterizes the line buffer.
+ * If we're in a delimited string and the delimiter is a control
+ * character, it's reformatted into a two-char sequence like ^C.
+ * This is fatal.
+ */
+
 STATIC void
 S_missingterm(pTHX_ char *s)
 {
@@ -204,6 +272,11 @@ S_missingterm(pTHX_ char *s)
     Perl_croak(aTHX_ "Can't find string terminator %c%s%c anywhere before EOF",q,s,q);
 }
 
+/*
+ * Perl_deprecate
+ * Warns that something is deprecated.  Duh.
+ */
+
 void
 Perl_deprecate(pTHX_ char *s)
 {
@@ -212,12 +285,23 @@ Perl_deprecate(pTHX_ char *s)
 	Perl_warner(aTHX_ WARN_DEPRECATED, "Use of %s is deprecated", s);
 }
 
+/*
+ * depcom
+ * Deprecate a comma-less variable list.  Called from three places
+ * in the tokenizer.
+ */
+
 STATIC void
 S_depcom(pTHX)
 {
     deprecate("comma-less variable list");
 }
 
+/*
+ * text filters for win32 carriage-returns, utf16-to-utf8 and
+ * utf16-to-utf8-reversed, whatever that is.
+ */
+
 #ifdef WIN32
 
 STATIC I32
@@ -260,6 +344,12 @@ S_utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen)
     return count;
 }
 
+/*
+ * Perl_lex_start
+ * Initialize variables.  Called by perl.c.  It uses the Perl stack
+ * to save its state (for recursive calls to the parser).
+ */
+
 void
 Perl_lex_start(pTHX_ SV *line)
 {
@@ -325,12 +415,28 @@ Perl_lex_start(pTHX_ SV *line)
     PL_rsfp = 0;
 }
 
+/*
+ * Perl_lex_end
+ * Tidy up.  Called from pp_ctl.c in the sv_compile_2op(), doeval(),
+ * and pp_leaveeval() subroutines.
+ */
+
 void
 Perl_lex_end(pTHX)
 {
     PL_doextract = FALSE;
 }
 
+/*
+ * S_incline
+ * This subroutine has nothing to do with tilting, whether at windmills
+ * or pinball tables.  Its name is short for "increment line".  It
+ * increments the current line number in PL_curcop->cop_line and checks
+ * to see whether the line starts with a comment of the form
+ *    # line 500
+ * If so, it sets the current line number to the number in the comment.
+ */
+
 STATIC void
 S_incline(pTHX_ char *s)
 {
@@ -372,6 +478,12 @@ S_incline(pTHX_ char *s)
     PL_curcop->cop_line = atoi(n)-1;
 }
 
+/*
+ * S_skipspace
+ * Called to gobble the appropriate amount and type of whitespace.
+ * Skips comments as well.
+ */
+
 STATIC char *
 S_skipspace(pTHX_ register char *s)
 {
@@ -387,6 +499,8 @@ S_skipspace(pTHX_ register char *s)
 	    if (*s++ == '\n' && PL_in_eval && !PL_rsfp)
 		incline(s);
 	}
+
+	/* comment */
 	if (s < PL_bufend && *s == '#') {
 	    while (s < PL_bufend && *s != '\n')
 		s++;
@@ -398,9 +512,17 @@ S_skipspace(pTHX_ register char *s)
 		}
 	    }
 	}
+
+	/* only continue to recharge the buffer if we're at the end
+	 * of the buffer, we're not reading from a source filter, and
+	 * we're in normal lexing mode
+	 */
 	if (s < PL_bufend || !PL_rsfp || PL_lex_state != LEX_NORMAL)
 	    return s;
+
+	/* try to recharge the buffer */
 	if ((s = filter_gets(PL_linestr, PL_rsfp, (prevlen = SvCUR(PL_linestr)))) == Nullch) {
+	  /* end of file.  Add on the -p or -n magic */
 	    if (PL_minus_n || PL_minus_p) {
 		sv_setpv(PL_linestr,PL_minus_p ?
 			 ";}continue{print or die qq(-p destination: $!\\n)" :
@@ -410,8 +532,18 @@ S_skipspace(pTHX_ register char *s)
 	    }
 	    else
 		sv_setpv(PL_linestr,";");
+
+	    /* reset variables for next time we lex */
 	    PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = s = PL_linestart = SvPVX(PL_linestr);
 	    PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
+
+	    /* Close the filehandle.  Could be from -P preprocessor,
+	     * STDIN, or a regular file.  If we were reading code from
+	     * STDIN (because the commandline held no -e or filename)
+	     * then we don't close it, we reset it so the code can
+	     * read from STDIN too.
+	     */
+
 	    if (PL_preprocess && !PL_in_eval)
 		(void)PerlProc_pclose(PL_rsfp);
 	    else if ((PerlIO*)PL_rsfp == PerlIO_stdin())
@@ -421,10 +553,16 @@ S_skipspace(pTHX_ register char *s)
 	    PL_rsfp = Nullfp;
 	    return s;
 	}
+
+	/* not at end of file, so we only read another line */
 	PL_linestart = PL_bufptr = s + prevlen;
 	PL_bufend = s + SvCUR(PL_linestr);
 	s = PL_bufptr;
 	incline(s);
+
+	/* debugger active and we're not compiling the debugger code,
+	 * so store the line into the debugger's array of lines
+	 */
 	if (PERLDB_LINE && PL_curstash != PL_debstash) {
 	    SV *sv = NEWSV(85,0);
 
@@ -435,6 +573,15 @@ S_skipspace(pTHX_ register char *s)
     }
 }
 
+/*
+ * S_check_uni
+ * Check the unary operators to ensure there's no ambiguity in how they're
+ * used.  An ambiguous piece of code would be:
+ *     rand + 5
+ * This doesn't mean rand() + 5.  Because rand() is a unary operator,
+ * the +5 is its argument.
+ */
+
 STATIC void
 S_check_uni(pTHX)
 {
@@ -459,6 +606,11 @@ S_check_uni(pTHX)
     }
 }
 
+/* workaround to replace the UNI() macro with a function.  Only the
+ * hints/uts.sh file mentions this.  Other comments elsewhere in the
+ * source indicate Microport Unix might need it too.
+ */
+
 #ifdef CRIPPLED_CC
 
 #undef UNI
@@ -483,8 +635,21 @@ S_uni(pTHX_ I32 f, char *s)
 
 #endif /* CRIPPLED_CC */
 
+/*
+ * LOP : macro to build a list operator.  Its behaviour has been replaced
+ * with a subroutine, S_lop() for which LOP is just another name.
+ */
+
 #define LOP(f,x) return lop(f,x,s)
 
+/*
+ * S_lop
+ * Build a list operator (or something that might be one).  The rules:
+ *  - if we have a next token, then it's a list operator [why?]
+ *  - if the next thing is an opening paren, then it's a function
+ *  - else it's a list operator
+ */
+
 STATIC I32
 S_lop(pTHX_ I32 f, expectation x, char *s)
 {
@@ -506,6 +671,15 @@ S_lop(pTHX_ I32 f, expectation x, char *s)
 	return LSTOP;
 }
 
+/*
+ * S_force_next
+ * When the tokenizer realizes it knows the next token (for instance,
+ * it is reordering tokens for the parser) then it can call S_force_next
+ * to make the current token be the next one.  It will also set 
+ * PL_nextval, and possibly PL_expect to ensure the lexer handles the
+ * token correctly.
+ */
+
 STATIC void 
 S_force_next(pTHX_ I32 type)
 {
@@ -518,6 +692,22 @@ S_force_next(pTHX_ I32 type)
     }
 }
 
+/*
+ * S_force_word
+ * When the lexer knows the next thing is a word (for instance, it has
+ * just seen -> and it knows that the next char is a word char, then
+ * it calls S_force_word to stick the next word into the PL_next lookahead.
+ *
+ * Arguments:
+ *   char *start : start of the buffer
+ *   int token   : PL_next will be this type of bare word (e.g., METHOD,WORD)
+ *   int check_keyword : if true, Perl checks to make sure the word isn't
+ *       a keyword (do this if the word is a label, e.g. goto FOO)
+ *   int allow_pack : if true, : characters will also be allowed (require,
+ *       use, etc. do this)
+ *   int allow_initial_tick : used by the "sub" tokenizer only.
+ */
+
 STATIC char *
 S_force_word(pTHX_ register char *start, int token, int check_keyword, int allow_pack, int allow_initial_tick)
 {
@@ -548,6 +738,16 @@ S_force_word(pTHX_ register char *start, int token, int check_keyword, int allow
     return s;
 }
 
+/*
+ * S_force_ident
+ * Called when the tokenizer wants $foo *foo &foo etc, but the program
+ * text only contains the "foo" portion.  The first argument is a pointer
+ * to the "foo", and the second argument is the type symbol to prefix.
+ * Forces the next token to be a "WORD".
+ * Creates the symbol if it didn't already exist (through the gv_fetchpv
+ * call).
+ */
+
 STATIC void
 S_force_ident(pTHX_ register char *s, int kind)
 {
@@ -571,6 +771,11 @@ S_force_ident(pTHX_ register char *s, int kind)
     }
 }
 
+/* 
+ * S_force_version
+ * Forces the next token to be a version number.
+ */
+
 STATIC char *
 S_force_version(pTHX_ char *s)
 {
@@ -598,6 +803,14 @@ S_force_version(pTHX_ char *s)
     return (s);
 }
 
+/*
+ * S_tokeq
+ * Tokenize a quoted string passed in as an SV.  It finds the next
+ * chunk, up to end of string or a backslash.  It may make a new
+ * SV containing that chunk (if HINT_NEW_STRING is on).  It also
+ * turns \\ into \.
+ */
+
 STATIC SV *
 S_tokeq(pTHX_ SV *sv)
 {
@@ -636,6 +849,38 @@ S_tokeq(pTHX_ SV *sv)
     return sv;
 }
 
+/*
+ * Now come three functions related to double-quote context,
+ * S_sublex_start, S_sublex_push, and S_sublex_done.  They're used when
+ * converting things like "\u\Lgnat" into ucfirst(lc("gnat")).  They
+ * interact with PL_lex_state, and create fake ( ... ) argument lists
+ * to handle functions and concatenation.
+ * They assume that whoever calls them will be setting up a fake
+ * join call, because each subthing puts a ',' after it.  This lets
+ *   "lower \luPpEr"
+ * become
+ *  join($, , 'lower ', lcfirst( 'uPpEr', ) ,)
+ *
+ * (I'm not sure whether the spurious commas at the end of lcfirst's
+ * arguments and join's arguments are created or not).
+ */
+
+/*
+ * S_sublex_start
+ * Assumes that yylval.ival is the op we're creating (e.g. OP_LCFIRST).
+ *
+ * Pattern matching will set PL_lex_op to the pattern-matching op to
+ * make (we return THING if yylval.ival is OP_NULL, PMFUNC otherwise).
+ *
+ * OP_CONST and OP_READLINE are easy--just make the new op and return.
+ *
+ * Everything else becomes a FUNC.
+ *
+ * Sets PL_lex_state to LEX_INTERPPUSH unless (ival was OP_NULL or we
+ * had an OP_CONST or OP_READLINE).  This just sets us up for a
+ * call to S_sublex_push().
+ */
+
 STATIC I32
 S_sublex_start(pTHX)
 {
@@ -680,6 +925,14 @@ S_sublex_start(pTHX)
 	return FUNC;
 }
 
+/*
+ * S_sublex_push
+ * Create a new scope to save the lexing state.  The scope will be
+ * ended in S_sublex_done.  Returns a '(', starting the function arguments
+ * to the uc, lc, etc. found before.
+ * Sets PL_lex_state to LEX_INTERPCONCAT.
+ */
+
 STATIC I32
 S_sublex_push(pTHX)
 {
@@ -733,6 +986,11 @@ S_sublex_push(pTHX)
     return '(';
 }
 
+/*
+ * S_sublex_done
+ * Restores lexer state after a S_sublex_push.
+ */
+
 STATIC I32
 S_sublex_done(pTHX)
 {
@@ -747,7 +1005,7 @@ S_sublex_done(pTHX)
 	return yylex();
     }
 
-    /* Is there a right-hand side to take care of? */
+    /* Is there a right-hand side to take care of? (s//RHS/ or tr//RHS/) */
     if (PL_lex_repl && (PL_lex_inwhat == OP_SUBST || PL_lex_inwhat == OP_TRANS)) {
 	PL_linestr = PL_lex_repl;
 	PL_lex_inpat = 0;
@@ -871,7 +1129,6 @@ S_scan_const(pTHX_ char *start)
     I32 thisutf = (PL_lex_inwhat == OP_TRANS && PL_sublex_info.sub_op)
 	? (PL_sublex_info.sub_op->op_private & (PL_lex_repl ? OPpTRANS_FROM_UTF : OPpTRANS_TO_UTF))
 	: UTF;
-
     /* leaveit is the set of acceptably-backslashed characters */
     char *leaveit =
 	PL_lex_inpat
@@ -1074,7 +1331,6 @@ S_scan_const(pTHX_ char *start)
 		    d = (char*)uv_to_utf8((U8*)d,
 					  scan_hex(s + 1, e - s - 1, &len));
 		    s = e + 1;
-			
 		}
 		else {
 		    UV uv = (UV)scan_hex(s, 2, &len);
@@ -1178,7 +1434,26 @@ S_scan_const(pTHX_ char *start)
     return s;
 }
 
-/* This is the one truly awful dwimmer necessary to conflate C and sed. */
+/* S_intuit_more
+ * Returns TRUE if there's more to the expression (e.g., a subscript),
+ * FALSE otherwise.
+ * This is the one truly awful dwimmer necessary to conflate C and sed.
+ *
+ * It deals with "$foo[3]" and /$foo[3]/ and /$foo[0123456789$]+/
+ *
+ * ->[ and ->{ return TRUE
+ * { and [ outside a pattern are always subscripts, so return TRUE
+ * if we're outside a pattern and it's not { or [, then return FALSE
+ * if we're in a pattern and the first char is a {
+ *   {4,5} (any digits around the comma) returns FALSE
+ * if we're in a pattern and the first char is a [
+ *   [] returns FALSE
+ *   [SOMETHING] has a funky algorithm to decide whether it's a
+ *      character class or not.  It has to deal with things like
+ *      /$foo[-3]/ and /$foo[$bar]/ as well as /$foo[$\d]+/
+ * anything else returns TRUE
+ */
+
 STATIC int
 S_intuit_more(pTHX_ register char *s)
 {
@@ -1214,6 +1489,7 @@ S_intuit_more(pTHX_ register char *s)
     if (*s == ']' || *s == '^')
 	return FALSE;
     else {
+        /* this is terrifying, and it works */
 	int weight = 2;		/* let's weigh the evidence */
 	char seen[256];
 	unsigned char un_char = 255, last_un_char;
@@ -1309,6 +1585,27 @@ S_intuit_more(pTHX_ register char *s)
     return TRUE;
 }
 
+/*
+ * S_intuit_method
+ *
+ * Does all the checking to disambiguate
+ *   foo bar
+ * between foo(bar) and bar->foo.  Returns 0 if not a method, otherwise
+ * FUNCMETH (bar->foo(args)) or METHOD (bar->foo args).
+ *
+ * First argument is the stuff after the first token, e.g. "bar".
+ *
+ * Not a method if bar is a filehandle.
+ * Not a method if foo is a subroutine prototyped to take a filehandle.
+ * Not a method if it's really "Foo $bar"
+ * Method if it's "foo $bar"
+ * Not a method if it's really "print foo $bar"
+ * Method if it's really "foo package::" (interpreted as package->foo)
+ * Not a method if bar is known to be a subroutne ("sub bar; foo bar")
+ * Not a method if bar is a filehandle or package, but is quotd with
+ *   =>
+ */
+
 STATIC int
 S_intuit_method(pTHX_ char *start, GV *gv)
 {
@@ -1333,6 +1630,11 @@ S_intuit_method(pTHX_ char *start, GV *gv)
 	    gv = 0;
     }
     s = scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
+    /* start is the beginning of the possible filehandle/object,
+     * and s is the end of it
+     * tmpbuf is a copy of it
+     */
+
     if (*start == '$') {
 	if (gv || PL_last_lop_op == OP_PRINT || isUPPER(*PL_tokenbuf))
 	    return 0;
@@ -1368,6 +1670,13 @@ S_intuit_method(pTHX_ char *start, GV *gv)
     return 0;
 }
 
+/*
+ * S_incl_perldb
+ * Return a string of Perl code to load the debugger.  If PERL5DB
+ * is set, it will return the contents of that, otherwise a
+ * compile-time require of perl5db.pl.
+ */
+
 STATIC char*
 S_incl_perldb(pTHX)
 {
@@ -5978,7 +6287,6 @@ Perl_scan_num(pTHX_ char *start)
     	    dTHR;
 	    UV u;
 	    I32 shift;
-	    bool overflowed = FALSE;
 
 	    /* check for hex */
 	    if (s[1] == 'x') {
@@ -6045,15 +6353,13 @@ Perl_scan_num(pTHX_ char *start)
 
 		  digit:
 		    n = u << shift;	/* make room for the digit */
-		    if (!overflowed && (n >> shift) != u
+		    if ((n >> shift) != u
 			&& !(PL_hints & HINT_NEW_BINARY))
 		    {
-			if (ckWARN_d(WARN_UNSAFE))
-			    Perl_warner(aTHX_ WARN_UNSAFE,
-					"Integer overflow in %s number",
-					(shift == 4) ? "hex"
-					    : ((shift == 3) ? "octal" : "binary"));
-			overflowed = TRUE;
+			Perl_croak(aTHX_
+				   "Integer overflow in %s number",
+				   (shift == 4) ? "hexadecimal"
+				   : ((shift == 3) ? "octal" : "binary"));
 		    }
 		    u = n | b;		/* add the digit to the end */
 		    break;
@@ -6414,6 +6720,11 @@ Perl_yyerror(pTHX_ char *s)
 #include "XSUB.h"
 #endif
 
+/*
+ * restore_rsfp
+ * Restore a source filter.
+ */
+
 static void
 restore_rsfp(pTHXo_ void *f)
 {
@@ -6426,6 +6737,12 @@ restore_rsfp(pTHXo_ void *f)
     PL_rsfp = fp;
 }
 
+/*
+ * restore_expect
+ * Restores the state of PL_expect when the lexing that begun with a
+ * start_lex() call has ended.
+ */ 
+
 static void
 restore_expect(pTHXo_ void *e)
 {
@@ -6433,10 +6750,15 @@ restore_expect(pTHXo_ void *e)
     PL_expect = (expectation)((char *)e - PL_tokenbuf);
 }
 
+/*
+ * restore_lex_expect
+ * Restores the state of PL_lex_expect when the lexing that begun with a
+ * start_lex() call has ended.
+ */ 
+
 static void
 restore_lex_expect(pTHXo_ void *e)
 {
     /* a safe way to store a small integer in a pointer */
     PL_lex_expect = (expectation)((char *)e - PL_tokenbuf);
 }
-
diff --git a/util.c b/util.c
index 7c83d03d70..6fc3d8ff2e 100644
--- a/util.c
+++ b/util.c
@@ -2781,23 +2781,42 @@ Perl_scan_bin(pTHX_ char *start, I32 len, I32 *retlen)
 {
     register char *s = start;
     register UV retval = 0;
-    bool overflowed = FALSE;
-    while (len && *s >= '0' && *s <= '1') {
-	register UV n = retval << 1;
-	if (!overflowed && (n >> 1) != retval) {
-	    dTHR;
-	    if (ckWARN_d(WARN_UNSAFE))
-		Perl_warner(aTHX_ WARN_UNSAFE, "Integer overflow in binary number");
-	    overflowed = TRUE;
+    register UV n;
+    register I32 d = 0;
+    register bool seenb = FALSE;
+    register bool overflow = FALSE;
+
+    for (; len-- && *s; s++) {
+	if (!(*s == '0' || *s == '1')) {
+	    if (*s == '_')
+		continue;
+	    if (seenb == FALSE && *s == 'b' && retval == 0) {
+		/* Disallow 0bbb0b0bbb... */
+		seenb = TRUE;
+		d = 0; /* Forget any leading zeros before the 'b'. */
+		continue;
+	    }
+	    else {
+		dTHR;
+		if (ckWARN(WARN_UNSAFE))
+		    Perl_warner(aTHX_ WARN_UNSAFE,
+				"Illegal binary digit '%c' ignored", *s);
+		break;
+	    }
 	}
-	retval = n | (*s++ - '0');
-	len--;
+	n = retval << 1;
+	overflow |= (n >> 1) != retval;
+	retval = n | (*s - '0');
+	d++;
     }
-    if (len && (*s >= '2' && *s <= '9')) {
-      dTHR;
-      if (ckWARN(WARN_UNSAFE))
-          Perl_warner(aTHX_ WARN_UNSAFE, "Illegal binary digit '%c' ignored", *s);
+    if (sizeof(UV) > 4 && d > 32) {
+	dTHR;
+	if (ckWARN(WARN_UNSAFE))
+	    Perl_warner(aTHX_ WARN_UNSAFE,
+			"Binary number > 0b11111111111111111111111111111111 non-portable");
     }
+    if (overflow)
+	Perl_croak(aTHX_ "Integer overflow in binary number");
     *retlen = s - start;
     return retval;
 }
@@ -2806,24 +2825,40 @@ Perl_scan_oct(pTHX_ char *start, I32 len, I32 *retlen)
 {
     register char *s = start;
     register UV retval = 0;
-    bool overflowed = FALSE;
-
-    while (len && *s >= '0' && *s <= '7') {
-	register UV n = retval << 3;
-	if (!overflowed && (n >> 3) != retval) {
-	    dTHR;
-	    if (ckWARN_d(WARN_UNSAFE))
-		Perl_warner(aTHX_ WARN_UNSAFE, "Integer overflow in octal number");
-	    overflowed = TRUE;
+    register UV n;
+    register I32 d = 0;
+    register bool overflow = FALSE;
+
+    for (; len-- && *s; s++) {
+	if (!(*s >= '0' && *s <= '7')) {
+	    if (*s == '_')
+		continue;
+	    else {
+		/* Allow \octal to work the DWIM way (that is, stop scanning
+		 * as soon as non-octal characters are seen, complain only iff
+		 * someone seems to want to use the digits eight and nine). */
+		if (*s == '8' || *s == '9') {
+		    dTHR;
+		    if (ckWARN(WARN_OCTAL))
+			Perl_warner(aTHX_ WARN_OCTAL,
+				    "Illegal octal digit '%c' ignored", *s);
+		}
+		break;
+	    }
 	}
-	retval = n | (*s++ - '0');
-	len--;
+	n = retval << 3;
+	overflow |= (n >> 3) != retval;
+	retval = n | (*s - '0');
+	d++;
     }
-    if (len && (*s == '8' || *s == '9')) {
+    if (sizeof(UV) > 4 && d > 10 && (retval >> 30) > 3) {
 	dTHR;
-	if (ckWARN(WARN_OCTAL))
-	    Perl_warner(aTHX_ WARN_OCTAL, "Illegal octal digit '%c' ignored", *s);
+	if (ckWARN(WARN_UNSAFE))
+	    Perl_warner(aTHX_ WARN_UNSAFE,
+			"Octal number > 037777777777 non-portable");
     }
+    if (overflow)
+	Perl_croak(aTHX_ "Integer overflow in octal number");
     *retlen = s - start;
     return retval;
 }
@@ -2833,32 +2868,45 @@ Perl_scan_hex(pTHX_ char *start, I32 len, I32 *retlen)
 {
     register char *s = start;
     register UV retval = 0;
-    bool overflowed = FALSE;
     char *tmp = s;
     register UV n;
+    register I32 d = 0;
+    register bool seenx = FALSE;
+    register bool overflow = FALSE;
 
     while (len-- && *s) {
 	tmp = strchr((char *) PL_hexdigit, *s++);
 	if (!tmp) {
-	    if (*(s-1) == '_' || (*(s-1) == 'x' && retval == 0))
+	    if (*(s-1) == '_')
 		continue;
+	    if (seenx == FALSE && *(s-1) == 'x' && retval == 0) {
+		/* Disallow 0xxx0x0xxx... */
+		seenx = TRUE;
+		d = 0; /* Forget any leading zeros before the 'x'. */
+		continue;
+	    }
 	    else {
 		dTHR;
 		--s;
 		if (ckWARN(WARN_UNSAFE))
-		    Perl_warner(aTHX_ WARN_UNSAFE,"Illegal hexadecimal digit '%c' ignored", *s);
+		    Perl_warner(aTHX_ WARN_UNSAFE,
+				"Illegal hexadecimal digit '%c' ignored", *s);
 		break;
 	    }
 	}
+	d++;
 	n = retval << 4;
-	if (!overflowed && (n >> 4) != retval) {
-	    dTHR;
-	    if (ckWARN_d(WARN_UNSAFE))
-		Perl_warner(aTHX_ WARN_UNSAFE, "Integer overflow in hexadecimal number");
-	    overflowed = TRUE;
-	}
+	overflow |= (n >> 4) != retval;
 	retval = n | ((tmp - PL_hexdigit) & 15);
     }
+    if (sizeof(UV) > 4 && d > 8) {
+	dTHR;
+	if (ckWARN(WARN_UNSAFE))
+	    Perl_warner(aTHX_ WARN_UNSAFE,
+			"Hexadecimal number > 0xffffffff non-portable");
+    }
+    if (overflow)
+	Perl_croak(aTHX_ "Integer overflow in hexadecimal number");
     *retlen = s - start;
     return retval;
 }