Integrate mainline

p4raw-id: //depot/perlio@19894

37 files changed, 404 insertions, 265 deletions

diff --git a/cop.h b/cop.h
index 44305da95a..04eb7c0c97 100644
--- a/cop.h
+++ b/cop.h
@@ -334,6 +334,7 @@ struct block {
 	PL_retstack_ix	 = cx->blk_oldretsp,				\
 	pm		 = cx->blk_oldpm,				\
 	gimme		 = cx->blk_gimme;				\
+	DEBUG_SCOPE("POPBLOCK");					\
 	DEBUG_l( PerlIO_printf(Perl_debug_log, "Leaving block %ld, type %s\n",		\
 		    (long)cxstack_ix+1,PL_block_type[CxTYPE(cx)]); )
 
@@ -343,7 +344,8 @@ struct block {
 	PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp,		\
 	PL_scopestack_ix = cx->blk_oldscopesp,				\
 	PL_retstack_ix	 = cx->blk_oldretsp,				\
-	PL_curpm         = cx->blk_oldpm
+	PL_curpm         = cx->blk_oldpm;				\
+	DEBUG_SCOPE("TOPBLOCK");
 
 /* substitution context */
 struct subst {
diff --git a/dosish.h b/dosish.h
index e606bebc66..7a9e9c49f6 100644
--- a/dosish.h
+++ b/dosish.h
@@ -16,7 +16,7 @@
 #ifdef DJGPP
 #  define BIT_BUCKET "nul"
 #  define OP_BINARY O_BINARY
-#  define PERL_SYS_INIT(c,v) MALLOC_CHECK_TAINT2(*c,*v) Perl_DJGPP_init(c,v)
+#  define PERL_SYS_INIT(c,v) EARLY_INIT2(*c,*v) MALLOC_CHECK_TAINT2(*c,*v) Perl_DJGPP_init(c,v)
 #  define init_os_extras Perl_init_os_extras
 #  include <signal.h>
 #  define HAS_UTIME
@@ -29,15 +29,15 @@
 #  define PERL_FS_VER_FMT	"%d_%d_%d"
 #else	/* DJGPP */
 #  ifdef WIN32
-#    define PERL_SYS_INIT(c,v)	MALLOC_CHECK_TAINT2(*c,*v) Perl_win32_init(c,v)
+#    define PERL_SYS_INIT(c,v)	EARLY_INIT2(*c,*v) MALLOC_CHECK_TAINT2(*c,*v) Perl_win32_init(c,v)
 #    define PERL_SYS_TERM()	Perl_win32_term()
 #    define BIT_BUCKET "nul"
 #  else
 #	 ifdef NETWARE
-#      define PERL_SYS_INIT(c,v)	MALLOC_CHECK_TAINT2(*c,*v) Perl_nw5_init(c,v)
+#      define PERL_SYS_INIT(c,v)	EARLY_INIT2(*c,*v) MALLOC_CHECK_TAINT2(*c,*v) Perl_nw5_init(c,v)
 #      define BIT_BUCKET "nwnul"
 #    else
-#      define PERL_SYS_INIT(c,v)	MALLOC_CHECK_TAINT2(*c,*v)
+#      define PERL_SYS_INIT(c,v)	EARLY_INIT2(*c,*v) MALLOC_CHECK_TAINT2(*c,*v)
 #      define BIT_BUCKET "\\dev\\nul" /* "wanna be like, umm, Newlined, or somethin?" */
 #    endif /* NETWARE */
 #  endif
diff --git a/embed.fnc b/embed.fnc
index 15647d0278..b8b3252294 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -45,7 +45,7 @@ Anod	|void	|perl_free	|PerlInterpreter* interp
 Anod	|int	|perl_run	|PerlInterpreter* interp
 Anod	|int	|perl_parse	|PerlInterpreter* interp|XSINIT_t xsinit \
 				|int argc|char** argv|char** env
-np	|bool	|doing_taint	|int argc|char** argv|char** env
+Anp	|bool	|doing_taint	|int argc|char** argv|char** env
 #if defined(USE_ITHREADS)
 Anod	|PerlInterpreter*|perl_clone|PerlInterpreter* interp, UV flags
 #  if defined(PERL_IMPLICIT_SYS)
@@ -1386,6 +1386,9 @@ sd	|void	|cv_dump	|CV *cv|char *title
 #endif
 pd 	|CV*	|find_runcv	|U32 *db_seqp
 p	|void	|free_tied_hv_pool
+#if defined(DEBUGGING)
+p	|int	|get_debug_opts	|char **s
+#endif
 
 
 
diff --git a/embed.h b/embed.h
index b89d17359a..e872a31d74 100644
--- a/embed.h
+++ b/embed.h
@@ -29,9 +29,7 @@
 
 #if defined(PERL_IMPLICIT_SYS)
 #endif
-#ifdef PERL_CORE
 #define doing_taint		Perl_doing_taint
-#endif
 #if defined(USE_ITHREADS)
 #  if defined(PERL_IMPLICIT_SYS)
 #  endif
@@ -2141,6 +2139,11 @@
 #ifdef PERL_CORE
 #define free_tied_hv_pool	Perl_free_tied_hv_pool
 #endif
+#if defined(DEBUGGING)
+#ifdef PERL_CORE
+#define get_debug_opts		Perl_get_debug_opts
+#endif
+#endif
 #define ck_anoncode		Perl_ck_anoncode
 #define ck_bitop		Perl_ck_bitop
 #define ck_concat		Perl_ck_concat
@@ -2534,9 +2537,7 @@
 
 #if defined(PERL_IMPLICIT_SYS)
 #endif
-#ifdef PERL_CORE
 #define doing_taint		Perl_doing_taint
-#endif
 #if defined(USE_ITHREADS)
 #  if defined(PERL_IMPLICIT_SYS)
 #  endif
@@ -4618,6 +4619,11 @@
 #ifdef PERL_CORE
 #define free_tied_hv_pool()	Perl_free_tied_hv_pool(aTHX)
 #endif
+#if defined(DEBUGGING)
+#ifdef PERL_CORE
+#define get_debug_opts(a)	Perl_get_debug_opts(aTHX_ a)
+#endif
+#endif
 #define ck_anoncode(a)		Perl_ck_anoncode(aTHX_ a)
 #define ck_bitop(a)		Perl_ck_bitop(aTHX_ a)
 #define ck_concat(a)		Perl_ck_concat(aTHX_ a)
diff --git a/epoc/epocish.h b/epoc/epocish.h
index a971a8e6c7..f7d38443d8 100644
--- a/epoc/epocish.h
+++ b/epoc/epocish.h
@@ -108,7 +108,7 @@
 
 /* epocemx setenv bug workaround */
 #ifndef PERL_SYS_INIT
-#    define PERL_SYS_INIT(c,v)    MALLOC_CHECK_TAINT2(*c,*v) putenv(".dummy=foo"); putenv(".dummy"); MALLOC_INIT
+#    define PERL_SYS_INIT(c,v)    EARLY_INIT2(*c,*v) MALLOC_CHECK_TAINT2(*c,*v) putenv(".dummy=foo"); putenv(".dummy"); MALLOC_INIT
 #endif
 
 #ifndef PERL_SYS_TERM
diff --git a/ext/B/B.pm b/ext/B/B.pm
index ad53e9d135..3dfb2c9902 100644
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -370,7 +370,7 @@ which can then be followed with the other access methods.
 
 Returns the SV object corresponding to the C variable C<amagic_generation>.
 
-=item C<init_av>
+=item init_av
 
 Returns the AV object (i.e. in class B::AV) representing INIT blocks.
 
@@ -394,7 +394,7 @@ Returns the AV object (i.e. in class B::AV) of the global comppadlist.
 
 Only when perl was compiled with ithreads.
 
-=item C<main_cv>
+=item main_cv
 
 Return the (faked) CV corresponding to the main part of the Perl
 program.
diff --git a/ext/Encode/Changes b/ext/Encode/Changes
index 18f5788e92..7251f5d365 100644
--- a/ext/Encode/Changes
+++ b/ext/Encode/Changes
@@ -3,6 +3,16 @@
 # $Id: Changes,v 1.96 2003/06/18 09:29:02 dankogai Exp $
 #
 $Revision: 1.96 $ $Date: 2003/06/18 09:29:02 $
+! lib/Encode/Guess.pm
+  $Encode::Guess::NoUTFAutoGuess is added so you can turn off
+  automatic  utf(8|16|32) guessing -- originally by Autrijus
+  Message-Id: <20030626162731.GA2077@not.autrijus.org>
+! Encode.pm
+  Addressed the following;
+  Subject: [perl #22835] FB_QUIET doesn't work with Encode::encode 
+  Message-Id: <rt-22835-59975.6.8650775354304@rt.perl.org>
+
+1.96 2003/06/18 09:29:02
 ! lib/Encode/JP/JP.pm t/guess.t
   m/(...)/ in void context then $1 is considered a Bad Thing
   Message-Id: <B5AB34D0-A019-11D7-AF03-000393AE4244@dan.co.jp>
diff --git a/ext/Encode/Encode.pm b/ext/Encode/Encode.pm
index 57bcc2b0d2..db74b6a194 100644
--- a/ext/Encode/Encode.pm
+++ b/ext/Encode/Encode.pm
@@ -147,7 +147,7 @@ sub encode($$;$)
 	Carp::croak("Unknown encoding '$name'");
     }
     my $octets = $enc->encode($string,$check);
-    return undef if ($check && length($string));
+    $_[1] = $string if $check;
     return $octets;
 }
 
diff --git a/ext/Encode/lib/Encode/Alias.pm b/ext/Encode/lib/Encode/Alias.pm
index d684ced9ac..70b3dd8714 100644
--- a/ext/Encode/lib/Encode/Alias.pm
+++ b/ext/Encode/lib/Encode/Alias.pm
@@ -204,7 +204,7 @@ sub init_aliases
 	# CP936 doesn't have vendor-addon for GBK, so they're identical.
 	define_alias( qr/^gbk$/i => '"cp936"');
 	# This fixes gb2312 vs. euc-cn confusion, practically
-	define_alias( qr/\bGB[-_ ]?2312(?:\D.*$|$)/i => '"euc-cn"' );
+	define_alias( qr/\bGB[-_ ]?2312(?!-?raw)/i => '"euc-cn"' );
 	# for Encode::JP
 	define_alias( qr/\bjis$/i            => '"7bit-jis"' );
 	define_alias( qr/\beuc.*jp$/i        => '"euc-jp"' );
diff --git a/ext/Encode/lib/Encode/Guess.pm b/ext/Encode/lib/Encode/Guess.pm
index fc8d267d02..5858f819cd 100644
--- a/ext/Encode/lib/Encode/Guess.pm
+++ b/ext/Encode/lib/Encode/Guess.pm
@@ -18,6 +18,7 @@ sub needs_lines { 1 }
 sub perlio_ok { 0 }
 
 our @EXPORT = qw(guess_encoding);
+our $NoUTFAutoGuess = 0;
 
 sub import { # Exporter not used so we do it on our own
     my $callpkg = caller;
@@ -70,75 +71,80 @@ sub guess {
     return unless defined $octet and length $octet;
 
     # cheat 0: utf8 flag;
-    Encode::is_utf8($octet) and return find_encoding('utf8');
+    if ( Encode::is_utf8($octet) ) {
+	return find_encoding('utf8') unless $NoUTFAutoGuess;
+	Encode::_utf8_off($octet);
+    }
     # cheat 1: BOM
     use Encode::Unicode;
-    my $BOM = unpack('n', $octet);
-    return find_encoding('UTF-16') 
-	if (defined $BOM and ($BOM == 0xFeFF or $BOM == 0xFFFe));
-    $BOM = unpack('N', $octet);
-    return find_encoding('UTF-32') 
-	if (defined $BOM and ($BOM == 0xFeFF or $BOM == 0xFFFe0000));
+    unless ($NoUTFAutoGuess) {
+	my $BOM = unpack('n', $octet);
+	return find_encoding('UTF-16')
+	    if (defined $BOM and ($BOM == 0xFeFF or $BOM == 0xFFFe));
+	$BOM = unpack('N', $octet);
+	return find_encoding('UTF-32')
+	    if (defined $BOM and ($BOM == 0xFeFF or $BOM == 0xFFFe0000));
+	if ($octet =~ /\x00/o){ # if \x00 found, we assume UTF-(16|32)(BE|LE)
+	    my $utf;
+	    my ($be, $le) = (0, 0);
+	    if ($octet =~ /\x00\x00/o){ # UTF-32(BE|LE) assumed
+		$utf = "UTF-32";
+		for my $char (unpack('N*', $octet)){
+		    $char & 0x0000ffff and $be++;
+		    $char & 0xffff0000 and $le++;
+		}
+	    }else{ # UTF-16(BE|LE) assumed
+		$utf = "UTF-16";
+		for my $char (unpack('n*', $octet)){
+		    $char & 0x00ff and $be++;
+		    $char & 0xff00 and $le++;
+		}
+	    }
+	    $DEBUG and warn "$utf, be == $be, le == $le";
+	    $be == $le 
+		and return
+		    "Encodings ambiguous between $utf BE and LE ($be, $le)";
+	    $utf .= ($be > $le) ? 'BE' : 'LE';
+	    return find_encoding($utf);
+	}
+    }
     my %try =  %{$obj->{Suspects}};
     for my $c (@_){
 	my $e = find_encoding($c) or die "Unknown encoding: $c";
 	$try{$e->name} = $e;
 	$DEBUG and warn "Added: ", $e->name;
     }
-    if ($octet =~ /\x00/o){ # if \x00 found, we assume UTF-(16|32)(BE|LE)
-	my $utf;
-	my ($be, $le) = (0, 0);
-	if ($octet =~ /\x00\x00/o){ # UTF-32(BE|LE) assumed
-	    $utf = "UTF-32";
-	    for my $char (unpack('N*', $octet)){
-		$char & 0x0000ffff and $be++;
-		$char & 0xffff0000 and $le++;
-	    }
-	}else{ # UTF-16(BE|LE) assumed
-	    $utf = "UTF-16";
-	    for my $char (unpack('n*', $octet)){
-		$char & 0x00ff and $be++;
-		$char & 0xff00 and $le++;
+    my $nline = 1;
+    for my $line (split /\r\n?|\n/, $octet){
+	# cheat 2 -- \e in the string
+	if ($line =~ /\e/o){
+	    my @keys = keys %try;
+	    delete @try{qw/utf8 ascii/};
+	    for my $k (@keys){
+		ref($try{$k}) eq 'Encode::XS' and delete $try{$k};
 	    }
 	}
-	$DEBUG and warn "$utf, be == $be, le == $le";
-	$be == $le 
-	    and return "Encodings ambiguous between $utf BE and LE ($be, $le)";
-	$utf .= ($be > $le) ? 'BE' : 'LE';
-	return find_encoding($utf);
-    }else{
-	my $nline = 1;
-	for my $line (split /\r\n?|\n/, $octet){
-	    # cheat 2 -- \e in the string
-	    if ($line =~ /\e/o){
-		my @keys = keys %try;
-		delete @try{qw/utf8 ascii/};
-		for my $k (@keys){
-		    ref($try{$k}) eq 'Encode::XS' and delete $try{$k};
-		}
-	    }
-	    my %ok = %try;
-	    # warn join(",", keys %try);
-	    for my $k (keys %try){
-		my $scratch = $line;
-		$try{$k}->decode($scratch, FB_QUIET);
-		if ($scratch eq ''){
-		    $DEBUG and warn sprintf("%4d:%-24s ok\n", $nline, $k);
-		}else{
-		    use bytes ();
-		    $DEBUG and 
-			warn sprintf("%4d:%-24s not ok; %d bytes left\n", 
-				     $nline, $k, bytes::length($scratch));
-		    delete $ok{$k};
-		}
+	my %ok = %try;
+	# warn join(",", keys %try);
+	for my $k (keys %try){
+	    my $scratch = $line;
+	    $try{$k}->decode($scratch, FB_QUIET);
+	    if ($scratch eq ''){
+		$DEBUG and warn sprintf("%4d:%-24s ok\n", $nline, $k);
+	    }else{
+		use bytes ();
+		$DEBUG and 
+		    warn sprintf("%4d:%-24s not ok; %d bytes left\n", 
+				 $nline, $k, bytes::length($scratch));
+		delete $ok{$k};
 	    }
-	    %ok or return "No appropriate encodings found!";
-	    if (scalar(keys(%ok)) == 1){
-		my ($retval) = values(%ok);
-		return $retval;
-	    }
-	    %try = %ok; $nline++;
 	}
+	%ok or return "No appropriate encodings found!";
+	if (scalar(keys(%ok)) == 1){
+	    my ($retval) = values(%ok);
+	    return $retval;
+	}
+	%try = %ok; $nline++;
     }
     $try{ascii} or 
 	return  "Encodings too ambiguous: ", join(" or ", keys %try);
@@ -189,6 +195,10 @@ canonical names or aliases.
  # tries all major Japanese Encodings as well
   use Encode::Guess qw/euc-jp shiftjis 7bit-jis/;
 
+If the C<$Encode::Guess::NoUTFAutoGuess> variable is set to a true
+value, no heuristics will be applied to UTF8/16/32, and the result
+will be limited to the suspects and C<ascii>.
+
 =over 4
 
 =item Encode::Guess->set_suspects
diff --git a/ext/threads/t/join.t b/ext/threads/t/join.t
index 3818e49358..0761a5f976 100644
--- a/ext/threads/t/join.t
+++ b/ext/threads/t/join.t
@@ -91,7 +91,8 @@ ok(1,"");
     ok(1,"");
 }
 
-if ($^O eq 'linux') { # We parse ps output so this is OS-dependent.
+# We parse ps output so this is OS-dependent.
+if ($^O =~ /^(linux|dec_osf)$/) {
   # First modify $0 in a subthread.
   print "# mainthread: \$0 = $0\n";
   threads->new( sub {
@@ -100,20 +101,20 @@ if ($^O eq 'linux') { # We parse ps output so this is OS-dependent.
 		  print "# subthread: \$0 = $0\n" } )->join;
   print "# mainthread: \$0 = $0\n";
   print "# pid = $$\n";
-  if (open PS, "ps -f |") { # Note: must work in (all) Linux(es).
+  if (open PS, "ps -f |") { # Note: must work in (all) systems.
     my ($sawpid, $sawexe);
     while (<PS>) {
-      s/\s+$//; # there seems to be extra whitespace at the end by ps(1)?
-      print "# $_\n";
+      chomp;
+      print "# [$_]\n";
       if (/^\S+\s+$$\s/) {
 	$sawpid++;
-	if (/\sfoobar\b/) {
+	if (/\sfoobar$/) {
 	  $sawexe++;
         }
 	last;
       }
     }
-    close PS;
+    close PS or die;
     if ($sawpid) {
       ok($sawpid && $sawexe, 'altering $0 is effective');
     } else {
diff --git a/global.sym b/global.sym
index dca38103c7..1ac204be6c 100644
--- a/global.sym
+++ b/global.sym
@@ -21,6 +21,7 @@ perl_destruct
 perl_free
 perl_run
 perl_parse
+Perl_doing_taint
 perl_clone
 perl_clone_using
 Perl_malloc
diff --git a/hints/dec_osf.sh b/hints/dec_osf.sh
index db4b147c9e..f08c318b89 100644
--- a/hints/dec_osf.sh
+++ b/hints/dec_osf.sh
@@ -341,13 +341,8 @@ EOF
 	esac
 
 	case "$usemymalloc" in
-	''|'n')	usemymalloc='n'
-		;;
-	*)	# The FILLCHECK_DEADBEEF() are failing.
-		case "$ccflags" in
-		*-DFILL_CHECK_DEFAULT=*) ;;
-		*) ccflags="$ccflags -DFILL_CHECK_DEFAULT=0" ;;
-		esac
+	'')
+		usemymalloc='n'
 		;;
 	esac
 	# These symbols are renamed in <time.h> so
diff --git a/hv.c b/hv.c
index 6f6eca1b33..0bbebc6aeb 100644
--- a/hv.c
+++ b/hv.c
@@ -1707,27 +1707,25 @@ Perl_hv_clear(pTHX_ HV *hv)
 
     if (SvREADONLY(hv)) {
 	/* restricted hash: convert all keys to placeholders */
-	HE* he;
-
-	hv_iterinit(hv);
-	while ((he = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))) {
-	    SV *val;
-	    
-	    val = hv_iterval(hv, he);
-	    if (val != &PL_sv_undef) { /* not already placeholder */
-		 if (val && SvREADONLY(val)) {
-		      SV* keysv = hv_iterkeysv(he);
-
-		      Perl_croak(aTHX_
-				 "Attempt to delete readonly key '%"SVf"' from a restricted hash",
-				 keysv);
-		 }
-		 SvREFCNT_dec(val);
-		 HeVAL(he) = &PL_sv_undef;
-		 xhv->xhv_placeholders++; /* HvPLACEHOLDERS(hv)++ */
+	I32 i;
+	HE* entry;
+	for (i = 0; i <= (I32) xhv->xhv_max; i++) {
+	    entry = ((HE**)xhv->xhv_array)[i];
+	    for (; entry; entry = HeNEXT(entry)) {
+		/* not already placeholder */
+		if (HeVAL(entry) != &PL_sv_undef) {
+		    if (HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
+			SV* keysv = hv_iterkeysv(entry);
+			Perl_croak(aTHX_
+	"Attempt to delete readonly key '%"SVf"' from a restricted hash",
+				   keysv);
+		    }
+		    SvREFCNT_dec(HeVAL(entry));
+		    HeVAL(entry) = &PL_sv_undef;
+		    xhv->xhv_placeholders++; /* HvPLACEHOLDERS(hv)++ */
+		}
 	    }
 	}
-	hv_iterinit(hv);
 	return;
     }
 
diff --git a/lib/FileCache/t/01open.t b/lib/FileCache/t/01open.t
index d516aea2d0..dfbb7b0a0b 100644
--- a/lib/FileCache/t/01open.t
+++ b/lib/FileCache/t/01open.t
@@ -2,7 +2,7 @@
 use FileCache;
 use vars qw(@files);
 BEGIN {
-    @files = qw(foo bar baz quux Foo'Bar);
+    @files = qw(foo bar baz quux Foo_Bar);
     chdir 't' if -d 't';
 
     #For tests within the perl distribution
diff --git a/lib/FileCache/t/03append.t b/lib/FileCache/t/03append.t
index 5a08a1e779..07edb7aa79 100644
--- a/lib/FileCache/t/03append.t
+++ b/lib/FileCache/t/03append.t
@@ -2,7 +2,7 @@
 use FileCache maxopen=>2;
 use vars qw(@files);
 BEGIN {
-    @files = qw(foo bar baz quux Foo'Bar);
+    @files = qw(foo bar baz quux Foo_Bar);
     chdir 't' if -d 't';
 
     #For tests within the perl distribution
diff --git a/lib/FileCache/t/05override.t b/lib/FileCache/t/05override.t
index 6fdf873600..a807c25640 100644
--- a/lib/FileCache/t/05override.t
+++ b/lib/FileCache/t/05override.t
@@ -8,12 +8,12 @@ BEGIN {
     END;
 }
 END{
-  unlink("Foo'Bar");
+  unlink("Foo_Bar");
 }
 print "1..1\n";
 
 {# Test 5: that close is overridden properly within the caller
-     cacheout local $_ = "Foo'Bar";
+     cacheout local $_ = "Foo_Bar";
      print $_ "Hello World\n";
      close($_);
      print 'not ' if fileno($_);
diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm
index 7534a34663..40232792c8 100644
--- a/lib/Test/Harness.pm
+++ b/lib/Test/Harness.pm
@@ -523,7 +523,7 @@ sub _run_all_tests {
                 $failedtests{$tfile}{name} = $tfile;
             }
             elsif($results{seen}) {
-                if (@{$test{failed}}) {
+                if (@{$test{failed}} and $test{max}) {
                     my ($txt, $canon) = canonfailed($test{max},$test{skipped},
                                                     @{$test{failed}});
                     print "$test{ml}$txt";
diff --git a/malloc.c b/malloc.c
index 409eed5ac7..e3c144957b 100644
--- a/malloc.c
+++ b/malloc.c
@@ -576,6 +576,7 @@ union	overhead {
 		u_char	ovu_index;	/* bucket # */
 		u_char	ovu_magic;	/* magic number */
 #ifdef RCHECK
+	    /* Subtract one to fit into u_short for an extra bucket */
 		u_short	ovu_size;	/* block size (requested + overhead - 1) */
 		u_int	ovu_rmagic;	/* range magic number */
 #endif
@@ -591,14 +592,14 @@ union	overhead {
 #define RMAGIC_C	0x55		/* magic # on range info */
 
 #ifdef RCHECK
-#  define	RSLOP		sizeof (u_int)
+#  define	RMAGIC_SZ	sizeof (u_int) /* Overhead at end of bucket */
 #  ifdef TWO_POT_OPTIMIZE
 #    define MAX_SHORT_BUCKET (12 * BUCKETS_PER_POW2) /* size-1 fits in short */
 #  else
 #    define MAX_SHORT_BUCKET (13 * BUCKETS_PER_POW2)
 #  endif 
 #else
-#  define	RSLOP		0
+#  define	RMAGIC_SZ	0
 #endif
 
 #if !defined(PACK_MALLOC) && defined(BUCKETS_ROOT2)
@@ -634,15 +635,16 @@ static u_short buck_size[MAX_BUCKET_BY_TABLE + 1] =
   { 
       0, 0, 0, 0, 4, 4, 8, 12, 16, 24, 32, 48, 64, 80,
   };
-#  define BUCKET_SIZE(i) ((i) % 2 ? buck_size[i] : (1 << ((i) >> BUCKET_POW2_SHIFT)))
+#  define BUCKET_SIZE_NO_SURPLUS(i) ((i) % 2 ? buck_size[i] : (1 << ((i) >> BUCKET_POW2_SHIFT)))
 #  define BUCKET_SIZE_REAL(i) ((i) <= MAX_BUCKET_BY_TABLE		\
 			       ? buck_size[i] 				\
 			       : ((1 << ((i) >> BUCKET_POW2_SHIFT))	\
 				  - MEM_OVERHEAD(i)			\
 				  + POW2_OPTIMIZE_SURPLUS(i)))
 #else
-#  define BUCKET_SIZE(i) (1 << ((i) >> BUCKET_POW2_SHIFT))
-#  define BUCKET_SIZE_REAL(i) (BUCKET_SIZE(i) - MEM_OVERHEAD(i) + POW2_OPTIMIZE_SURPLUS(i))
+#  define BUCKET_SIZE_NO_SURPLUS(i) (1 << ((i) >> BUCKET_POW2_SHIFT))
+#  define BUCKET_SIZE(i) (BUCKET_SIZE_NO_SURPLUS(i) + POW2_OPTIMIZE_SURPLUS(i))
+#  define BUCKET_SIZE_REAL(i) (BUCKET_SIZE(i) - MEM_OVERHEAD(i))
 #endif 
 
 
@@ -787,7 +789,7 @@ static u_short buck_size[MAX_BUCKET_BY_TABLE + 1] =
 #ifdef IGNORE_SMALL_BAD_FREE
 #define FIRST_BUCKET_WITH_CHECK (6 * BUCKETS_PER_POW2) /* 64 */
 #  define N_BLKS(bucket) ( (bucket) < FIRST_BUCKET_WITH_CHECK 		\
-			 ? ((1<<LOG_OF_MIN_ARENA) - 1)/BUCKET_SIZE(bucket) \
+			 ? ((1<<LOG_OF_MIN_ARENA) - 1)/BUCKET_SIZE_NO_SURPLUS(bucket) \
 			 : n_blks[bucket] )
 #else
 #  define N_BLKS(bucket) n_blks[bucket]
@@ -810,7 +812,7 @@ static u_short n_blks[LOG_OF_MIN_ARENA * BUCKETS_PER_POW2] =
 #ifdef IGNORE_SMALL_BAD_FREE
 #  define BLK_SHIFT(bucket) ( (bucket) < FIRST_BUCKET_WITH_CHECK 	\
 			      ? ((1<<LOG_OF_MIN_ARENA)			\
-				 - BUCKET_SIZE(bucket) * N_BLKS(bucket)) \
+				 - BUCKET_SIZE_NO_SURPLUS(bucket) * N_BLKS(bucket)) \
 			      : blk_shift[bucket])
 #else
 #  define BLK_SHIFT(bucket) blk_shift[bucket]
@@ -851,7 +853,7 @@ static u_short blk_shift[LOG_OF_MIN_ARENA * BUCKETS_PER_POW2] =
 
 #endif /* !PACK_MALLOC */
 
-#define M_OVERHEAD (sizeof(union overhead) + RSLOP)
+#define M_OVERHEAD (sizeof(union overhead) + RMAGIC_SZ) /* overhead at start+end */
 
 #ifdef PACK_MALLOC
 #  define MEM_OVERHEAD(bucket) \
@@ -1510,7 +1512,7 @@ Perl_malloc(register size_t nbytes)
 			      (long)size));
 
 	FILLCHECK_DEADBEEF((unsigned char*)(p + CHUNK_SHIFT),
-			   BUCKET_SIZE_REAL(bucket));
+			   BUCKET_SIZE_REAL(bucket) + RMAGIC_SZ);
 
 #ifdef IGNORE_SMALL_BAD_FREE
 	if (bucket >= FIRST_BUCKET_WITH_CHECK)
@@ -1530,13 +1532,14 @@ Perl_malloc(register size_t nbytes)
 	    
 	    nbytes = size + M_OVERHEAD; 
 	    p->ov_size = nbytes - 1;
-	    if ((i = nbytes & 3)) {
-		i = 4 - i;
-		while (i--)
-		    *((char *)((caddr_t)p + nbytes - RSLOP + i)) = RMAGIC_C;
+	    if ((i = nbytes & (RMAGIC_SZ-1))) {
+		i = RMAGIC_SZ - i;
+		while (i--) /* nbytes - RMAGIC_SZ is end of alloced area */
+		    ((caddr_t)p + nbytes - RMAGIC_SZ)[i] = RMAGIC_C;
 	    }
-	    nbytes = (nbytes + 3) &~ 3; 
-	    *((u_int *)((caddr_t)p + nbytes - RSLOP)) = RMAGIC;
+	    /* Same at RMAGIC_SZ-aligned RMAGIC */
+	    nbytes = (nbytes + RMAGIC_SZ - 1) & ~(RMAGIC_SZ - 1);
+	    ((u_int *)((caddr_t)p + nbytes))[-1] = RMAGIC;
 	}
 	FILL_FEEDADAD((unsigned char *)(p + CHUNK_SHIFT), size);
 #endif
@@ -1631,7 +1634,7 @@ get_from_bigger_buckets(int bucket, MEM_SIZE size)
 	    nmalloc[bucket]--;
 	    start_slack -= M_OVERHEAD;
 #endif 
-	    add_to_chain(ret, (BUCKET_SIZE(bucket) +
+	    add_to_chain(ret, (BUCKET_SIZE_NO_SURPLUS(bucket) +
 			       POW2_OPTIMIZE_SURPLUS(bucket)), 
 			 size);
 	    return ret;
@@ -1936,7 +1939,7 @@ morecore(register int bucket)
 	 * Add new memory allocated to that on
 	 * free list for this hash bucket.
 	 */
-  	siz = BUCKET_SIZE(bucket);
+  	siz = BUCKET_SIZE_NO_SURPLUS(bucket); /* No surplus if nblks > 1 */
 #ifdef PACK_MALLOC
 	*(u_char*)ovp = bucket;	/* Fill index. */
 	if (bucket <= MAX_PACKED) {
@@ -2047,19 +2050,22 @@ Perl_mfree(void *mp)
 	    int i;
 	    MEM_SIZE nbytes = ovp->ov_size + 1;
 
-	    if ((i = nbytes & 3)) {
-		i = 4 - i;
-		while (i--) {
-		    ASSERT(*((char *)((caddr_t)ovp + nbytes - RSLOP + i))
-			   == RMAGIC_C, "chunk's tail overwrite");
+	    if ((i = nbytes & (RMAGIC_SZ-1))) {
+		i = RMAGIC_SZ - i;
+		while (i--) {	/* nbytes - RMAGIC_SZ is end of alloced area */
+		    ASSERT(((caddr_t)ovp + nbytes - RMAGIC_SZ)[i] == RMAGIC_C,
+			   "chunk's tail overwrite");
 		}
 	    }
-	    nbytes = (nbytes + 3) &~ 3; 
-	    ASSERT(*(u_int *)((caddr_t)ovp + nbytes - RSLOP) == RMAGIC, "chunk's tail overwrite");	    
-	    FILLCHECK_DEADBEEF((unsigned char*)((caddr_t)ovp + nbytes - RSLOP + sizeof(u_int)),
-			       BUCKET_SIZE_REAL(OV_INDEX(ovp)) - (nbytes - RSLOP + sizeof(u_int)));
+	    /* Same at RMAGIC_SZ-aligned RMAGIC */
+	    nbytes = (nbytes + (RMAGIC_SZ-1)) & ~(RMAGIC_SZ-1);
+	    ASSERT(((u_int *)((caddr_t)ovp + nbytes))[-1] == RMAGIC,
+		   "chunk's tail overwrite");	    
+	    FILLCHECK_DEADBEEF((unsigned char*)((caddr_t)ovp + nbytes),
+			       BUCKET_SIZE(OV_INDEX(ovp)) - nbytes);
 	}
-	FILL_DEADBEEF((unsigned char*)(ovp+1), BUCKET_SIZE_REAL(OV_INDEX(ovp)));
+	FILL_DEADBEEF((unsigned char*)(ovp+CHUNK_SHIFT),
+		      BUCKET_SIZE_REAL(OV_INDEX(ovp)) + RMAGIC_SZ);
 	ovp->ov_rmagic = RMAGIC - 1;
 #endif
   	ASSERT(OV_INDEX(ovp) < NBUCKETS, "chunk's head overwrite");
@@ -2189,22 +2195,24 @@ Perl_realloc(void *mp, size_t nbytes)
 		if (OV_INDEX(ovp) <= MAX_SHORT_BUCKET) {
 		       int i, nb = ovp->ov_size + 1;
 
-		       if ((i = nb & 3)) {
-			   i = 4 - i;
-			   while (i--) {
-			       ASSERT(*((char *)((caddr_t)ovp + nb - RSLOP + i)) == RMAGIC_C, "chunk's tail overwrite");
+		       if ((i = nb & (RMAGIC_SZ-1))) {
+			   i = RMAGIC_SZ - i;
+			   while (i--) { /* nb - RMAGIC_SZ is end of alloced area */
+			       ASSERT(((caddr_t)ovp + nb - RMAGIC_SZ)[i] == RMAGIC_C, "chunk's tail overwrite");
 			   }
 		       }
-		       nb = (nb + 3) &~ 3; 
-		       ASSERT(*(u_int *)((caddr_t)ovp + nb - RSLOP) == RMAGIC, "chunk's tail overwrite");
-		       FILLCHECK_DEADBEEF((unsigned char*)((caddr_t)ovp + nb - RSLOP + sizeof(u_int)),
-			       BUCKET_SIZE_REAL(OV_INDEX(ovp)) - (nb - RSLOP + sizeof(u_int)));
+		       /* Same at RMAGIC_SZ-aligned RMAGIC */
+		       nb = (nb + (RMAGIC_SZ-1)) & ~(RMAGIC_SZ-1);
+		       ASSERT(((u_int *)((caddr_t)ovp + nb))[-1] == RMAGIC,
+			      "chunk's tail overwrite");
+		       FILLCHECK_DEADBEEF((unsigned char*)((caddr_t)ovp + nb),
+					  BUCKET_SIZE(OV_INDEX(ovp)) - nb);
 		       if (nbytes > ovp->ov_size + 1 - M_OVERHEAD)
 			   FILL_FEEDADAD((unsigned char*)cp + ovp->ov_size + 1 - M_OVERHEAD,
 				     nbytes - (ovp->ov_size + 1 - M_OVERHEAD));
 		       else
 			   FILL_DEADBEEF((unsigned char*)cp + nbytes,
-					 nb - M_OVERHEAD + RSLOP - nbytes);
+					 nb - M_OVERHEAD + RMAGIC_SZ - nbytes);
 			/*
 			 * Convert amount of memory requested into
 			 * closest block size stored in hash buckets
@@ -2213,14 +2221,15 @@ Perl_realloc(void *mp, size_t nbytes)
 			 */
 			nbytes += M_OVERHEAD;
 			ovp->ov_size = nbytes - 1;
-			if ((i = nbytes & 3)) {
-			    i = 4 - i;
-			    while (i--)
-				*((char *)((caddr_t)ovp + nbytes - RSLOP + i))
+			if ((i = nbytes & (RMAGIC_SZ-1))) {
+			    i = RMAGIC_SZ - i;
+			    while (i--)	/* nbytes - RMAGIC_SZ is end of alloced area */
+				((caddr_t)ovp + nbytes - RMAGIC_SZ)[i]
 				    = RMAGIC_C;
 			}
-			nbytes = (nbytes + 3) &~ 3; 
-			*((u_int *)((caddr_t)ovp + nbytes - RSLOP)) = RMAGIC;
+			/* Same at RMAGIC_SZ-aligned RMAGIC */
+			nbytes = (nbytes + (RMAGIC_SZ-1)) & ~(RMAGIC_SZ - 1);
+			((u_int *)((caddr_t)ovp + nbytes))[-1] = RMAGIC;
 		}
 #endif
 		res = cp;
@@ -2337,7 +2346,7 @@ Perl_malloced_size(void *p)
     if (bucket <= MAX_SHORT_BUCKET) {
 	MEM_SIZE size = BUCKET_SIZE_REAL(bucket);
 	ovp->ov_size = size + M_OVERHEAD - 1;
-	*((u_int *)((caddr_t)ovp + size + M_OVERHEAD - RSLOP)) = RMAGIC;
+	*((u_int *)((caddr_t)ovp + size + M_OVERHEAD - RMAGIC_SZ)) = RMAGIC;
     }
 #endif
     return BUCKET_SIZE_REAL(bucket);
@@ -2393,7 +2402,7 @@ Perl_get_mstats(pTHX_ perl_mstats_t *buf, int buflen, int level)
 	    for (i = MIN_BUCKET ; i < NBUCKETS; i++) {
 		if (i >= buflen)
 		    break;
-		buf->bucket_mem_size[i] = BUCKET_SIZE(i);
+		buf->bucket_mem_size[i] = BUCKET_SIZE_NO_SURPLUS(i);
 		buf->bucket_available_size[i] = BUCKET_SIZE_REAL(i);
 	    }
 	}
@@ -2425,9 +2434,9 @@ Perl_dump_mstats(pTHX_ char *s)
 			  "Memory allocation statistics %s (buckets %"IVdf"(%"IVdf")..%"IVdf"(%"IVdf")\n",
 			  s, 
 			  (IV)BUCKET_SIZE_REAL(MIN_BUCKET), 
-			  (IV)BUCKET_SIZE(MIN_BUCKET),
+			  (IV)BUCKET_SIZE_NO_SURPLUS(MIN_BUCKET),
 			  (IV)BUCKET_SIZE_REAL(buffer.topbucket), 
-			  (IV)BUCKET_SIZE(buffer.topbucket));
+			  (IV)BUCKET_SIZE_NO_SURPLUS(buffer.topbucket));
   	PerlIO_printf(Perl_error_log, "%8"IVdf" free:", buffer.totfree);
   	for (i = MIN_EVEN_REPORT; i <= buffer.topbucket; i += BUCKETS_PER_POW2) {
   		PerlIO_printf(Perl_error_log, 
diff --git a/mg.c b/mg.c
index ba576c3707..1990b96250 100644
--- a/mg.c
+++ b/mg.c
@@ -1975,8 +1975,13 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	break;
 
     case '\004':	/* ^D */
-	PL_debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | DEBUG_TOP_FLAG;
+#ifdef DEBUGGING
+	s = SvPV_nolen(sv);
+	PL_debug = get_debug_opts(&s) | DEBUG_TOP_FLAG;
 	DEBUG_x(dump_all());
+#else
+	PL_debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | DEBUG_TOP_FLAG;
+#endif
 	break;
     case '\005':  /* ^E */
 	if (*(mg->mg_ptr+1) == '\0') {
@@ -2367,60 +2372,26 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	     pstat(PSTAT_SETCMD, un, len, 0, 0);
 	}
 #endif
-	if (!PL_origalen) {
-	    s = PL_origargv[0];
-	    s += strlen(s);
-	    /* See if all the arguments are contiguous in memory */
-	    for (i = 1; i < PL_origargc; i++) {
-		if (PL_origargv[i] == s + 1
-#ifdef OS2
-		    || PL_origargv[i] == s + 2
-#endif
-		   )
-		{
-		    ++s;
-		    s += strlen(s);	/* this one is ok too */
-		}
-		else
-		    break;
-	    }
-	    /* can grab env area too? */
-	    if (PL_origenviron
-#ifdef USE_ITHREADS
-		&& PL_curinterp == aTHX
-#endif
-		&& (PL_origenviron[0] == s + 1))
-	    {
-		my_setenv("NoNe  SuCh", Nullch);
-					    /* force copy of environment */
-		for (i = 0; PL_origenviron[i]; i++)
-		    if (PL_origenviron[i] == s + 1) {
-			++s;
-			s += strlen(s);
-		    }
-		    else
-			break;
-	    }
-	    PL_origalen = s - PL_origargv[0];
-	}
+	/* PL_origalen is set in perl_parse(). */
 	s = SvPV_force(sv,len);
-	i = len;
-	if (i >= (I32)PL_origalen) {
-	    i = PL_origalen;
-	    /* don't allow system to limit $0 seen by script */
-	    /* SvCUR_set(sv, i); *SvEND(sv) = '\0'; */
-	    Copy(s, PL_origargv[0], i, char);
-	    s = PL_origargv[0]+i;
-	    *s = '\0';
+	if (len >= (I32)PL_origalen) {
+	    /* Longer than original, will be truncated. */
+	    Copy(s, PL_origargv[0], PL_origalen, char);
+	    PL_origargv[0][PL_origalen - 1] = 0;
 	}
 	else {
-	    Copy(s, PL_origargv[0], i, char);
-	    s = PL_origargv[0]+i;
-	    *s++ = '\0';
-	    while (++i < (I32)PL_origalen)
-		*s++ = '\0';
+	    /* Shorter than original, will be padded. */
+	    Copy(s, PL_origargv[0], len, char);
+	    PL_origargv[0][len] = 0;
+	    memset(PL_origargv[0] + len + 1,
+		   /* Is the space counterintuitive?  Yes.
+		    * (You were expecting \0?)  
+		    * Does it work?  Seems to.  (In Linux 2.4.20 at least.)
+		    * --jhi */
+		   (int)' ',
+		   PL_origalen - len - 1);
 	    for (i = 1; i < PL_origargc; i++)
-		PL_origargv[i] = Nullch;
+		 PL_origargv[i] = 0;
 	}
 	UNLOCK_DOLLARZERO_MUTEX;
 	break;
diff --git a/miniperlmain.c b/miniperlmain.c
index ec9604eae6..4e9e5e889e 100644
--- a/miniperlmain.c
+++ b/miniperlmain.c
@@ -56,9 +56,6 @@ main(int argc, char **argv, char **env)
     /* noop unless Configure is given -Accflags=-DPERL_GPROF_CONTROL */
     PERL_GPROF_MONCONTROL(0);
 
-    /* To be used instead PL_taining before perl_parse() */
-    PL_earlytaint = doing_taint(argc, argv, env);
-
     PERL_SYS_INIT3(&argc,&argv,&env);
 
 #if defined(USE_ITHREADS)
diff --git a/mpeix/mpeixish.h b/mpeix/mpeixish.h
index 92c588352d..2ed9faf332 100644
--- a/mpeix/mpeixish.h
+++ b/mpeix/mpeixish.h
@@ -113,7 +113,7 @@
 #define Mkdir(path,mode)   mkdir((path),(mode))
 
 #ifndef PERL_SYS_INIT
-#  define PERL_SYS_INIT(c,v) PERL_FPU_INIT MALLOC_INIT
+#  define PERL_SYS_INIT(c,v) EARLY_INIT2(*c,*v) PERL_FPU_INIT MALLOC_INIT
 #endif
 
 #ifndef PERL_SYS_TERM
diff --git a/os2/os2ish.h b/os2/os2ish.h
index 225d271236..45e80b5208 100644
--- a/os2/os2ish.h
+++ b/os2/os2ish.h
@@ -218,6 +218,7 @@ void Perl_OS2_term(void **excH, int exitstatus, int flags);
 
 #  define PERL_SYS_INIT3(argcp, argvp, envp)	\
   { void *xreg[2];				\
+    EARLY_INIT3(argcp, argvp, envp) 		\
     MALLOC_CHECK_TAINT(*argcp, *argvp, *envp)	\
     _response(argcp, argvp);			\
     _wildcard(argcp, argvp);			\
@@ -225,6 +226,7 @@ void Perl_OS2_term(void **excH, int exitstatus, int flags);
 
 #  define PERL_SYS_INIT(argcp, argvp)  {	\
   { void *xreg[2];				\
+    EARLY_INIT2(argcp, argvp)			\
     _response(argcp, argvp);			\
     _wildcard(argcp, argvp);			\
     Perl_OS2_init3(NULL, xreg, 0)
@@ -233,9 +235,11 @@ void Perl_OS2_term(void **excH, int exitstatus, int flags);
 
 #  define PERL_SYS_INIT3(argcp, argvp, envp)	\
   { void *xreg[2];				\
+    EARLY_INIT3(argcp, argvp, envp) 		\
     Perl_OS2_init3(*envp, xreg, 0)
 #  define PERL_SYS_INIT(argcp, argvp)	{	\
   { void *xreg[2];				\
+    EARLY_INIT2(argcp, argvp) 			\
     Perl_OS2_init3(NULL, xreg, 0)
 #endif
 
diff --git a/perl.c b/perl.c
index 69d7084096..9e8d5ea443 100644
--- a/perl.c
+++ b/perl.c
@@ -933,6 +933,60 @@ setuid perl scripts securely.\n");
     PL_origargc = argc;
     PL_origargv = argv;
 
+    {
+	/* Set PL_origalen be the sum of the contiguous argv[]
+	 * elements plus the size of the env in case that it is
+	 * contiguous with the argv[].  This is used in mg.c:mg_set()
+	 * as the maximum modifiable length of $0.  In the worst case
+	 * the area we are able to modify is limited to the size of
+	 * the original argv[0].
+	 * --jhi */
+	 char *s;
+	 int i;
+	 UV mask =
+	   ~(UV)(PTRSIZE == 4 ? 3 : PTRSIZE == 8 ? 7 : PTRSIZE == 16 ? 15 : 0);
+
+	 /* See if all the arguments are contiguous in memory.
+	  * Note that 'contiguous' is a loose term because some
+	  * platforms align the argv[] and the envp[].  We just check
+	  * that they are within aligned PTRSIZE bytes.  As long as no
+	  * system has something bizarre like the argv[] interleaved
+	  * with some other data, we are fine.  (Did I just evoke
+	  * Murphy's Law?) --jhi */
+	 s = PL_origargv[0];
+	 while (*s) s++;
+	 for (i = 1; i < PL_origargc; i++) {
+	      if (PL_origargv[i] >  s &&
+		  PL_origargv[i] <=
+		  INT2PTR(char *, PTR2UV(s + PTRSIZE) & mask)) {
+		   s = PL_origargv[i];
+		   while (*s) s++;
+	      }
+	      else
+		   break;
+	 }
+	 /* Can we grab env area too to be used as the area for $0? */
+	 if (PL_origenviron &&
+	     PL_origenviron[0] >  s &&
+	     PL_origenviron[0] <=
+	     INT2PTR(char *, PTR2UV(s + PTRSIZE) & mask)) {
+	      s = PL_origenviron[0];
+	      while (*s) s++;
+	      my_setenv("NoNe  SuCh", Nullch);
+	      /* Force copy of environment. */
+	      for (i = 1; PL_origenviron[i]; i++)
+		   if (PL_origenviron[i] >  s &&
+		       PL_origenviron[i] <=
+		       INT2PTR(char *, PTR2UV(s + PTRSIZE) & mask)) {
+			s = PL_origenviron[i];
+			while (*s) s++;
+		   }
+		   else
+			break;
+	 }
+	 PL_origalen = s - PL_origargv[0];
+    }
+
     if (PL_do_undump) {
 
 	/* Come here if running an undumped a.out. */
@@ -2196,6 +2250,40 @@ NULL
 	PerlIO_printf(PerlIO_stdout(), "\n  %s", *p++);
 }
 
+/* convert a string of -D options (or digits) into an int.
+ * sets *s to point to the char after the options */
+
+#ifdef DEBUGGING
+int
+Perl_get_debug_opts(pTHX_ char **s)
+{
+    int i = 0;
+    if (isALPHA(**s)) {
+	/* if adding extra options, remember to update DEBUG_MASK */
+	static char debopts[] = "psltocPmfrxu HXDSTRJvC";
+
+	for (; isALNUM(**s); (*s)++) {
+	    char *d = strchr(debopts,**s);
+	    if (d)
+		i |= 1 << (d - debopts);
+	    else if (ckWARN_d(WARN_DEBUGGING))
+		Perl_warner(aTHX_ packWARN(WARN_DEBUGGING),
+		    "invalid option -D%c\n", **s);
+	}
+    }
+    else {
+	i = atoi(*s);
+	for (; isALNUM(**s); (*s)++) ;
+    }
+#  ifdef EBCDIC
+    if ((i & DEBUG_p_FLAG) && ckWARN_d(WARN_DEBUGGING))
+	Perl_warner(aTHX_ packWARN(WARN_DEBUGGING),
+		"-Dp not implemented on this platform\n");
+#  endif
+    return i;
+}
+#endif
+
 /* This routine handles any switches that can be given during run */
 
 char *
@@ -2295,24 +2383,8 @@ Perl_moreswitches(pTHX_ char *s)
     {	
 #ifdef DEBUGGING
 	forbid_setid("-D");
-	if (isALPHA(s[1])) {
-	    /* if adding extra options, remember to update DEBUG_MASK */
-	    static char debopts[] = "psltocPmfrxu HXDSTRJvC";
-	    char *d;
-
-	    for (s++; *s && (d = strchr(debopts,*s)); s++)
-		PL_debug |= 1 << (d - debopts);
-	}
-	else {
-	    PL_debug = atoi(s+1);
-	    for (s++; isDIGIT(*s); s++) ;
-	}
-#ifdef EBCDIC
-	if (DEBUG_p_TEST_ && ckWARN_d(WARN_DEBUGGING))
-	    Perl_warner(aTHX_ packWARN(WARN_DEBUGGING),
-		    "-Dp not implemented on this platform\n");
-#endif
-	PL_debug |= DEBUG_TOP_FLAG;
+	s++;
+	PL_debug = get_debug_opts(&s) | DEBUG_TOP_FLAG;
 #else /* !DEBUGGING */
 	if (ckWARN_d(WARN_DEBUGGING))
 	    Perl_warner(aTHX_ packWARN(WARN_DEBUGGING),
diff --git a/perl.h b/perl.h
index ea55630132..66e6a67494 100644
--- a/perl.h
+++ b/perl.h
@@ -499,7 +499,7 @@ int usleep(unsigned int);
 		  panic_write2("panic: tainting with $ENV{PERL_MALLOC_OPT}\n");\
 		  exit(1); })
 #  define MALLOC_CHECK_TAINT(argc,argv,env)	STMT_START {	\
-	if (PL_earlytaint)) {					\
+	if (PL_earlytaint) {					\
 		MallocCfg_ptr[MallocCfg_skip_cfg_env] = 1;	\
     }} STMT_END;
 #else  /* MYMALLOC */
@@ -1942,6 +1942,23 @@ typedef struct clone_params CLONE_PARAMS;
 #  endif
 #endif
 
+/* The PL_earlytaint is to be used instead PL_tainting before
+ * perl_parse() has had the chance to set up PL_tainting. */
+
+#ifndef EARLY_INIT3
+#  define EARLY_INIT3(argcp,argvp,envp) \
+	STMT_START {		\
+		PL_earlytaint = doing_taint(argcp, argvp, envp); \
+	} STMT_END;
+#endif
+
+#ifndef EARLY_INIT2
+#  define EARLY_INIT2(argcp,argvp) \
+	STMT_START {		\
+		PL_earlytaint = doing_taint(argcp, argvp, 0); \
+	} STMT_END;
+#endif
+
 #ifndef PERL_SYS_INIT3
 #  define PERL_SYS_INIT3(argvp,argcp,envp) PERL_SYS_INIT(argvp,argcp)
 #endif
@@ -2628,6 +2645,13 @@ Gid_t getegid (void);
 #endif /* DEBUGGING */
 
 
+#define DEBUG_SCOPE(where) \
+    DEBUG_l(WITH_THR(Perl_deb(aTHX_ "%s scope %ld at %s:%d\n",	\
+		    where, PL_scopestack_ix, __FILE__, __LINE__)));
+
+
+
+
 /* These constants should be used in preference to raw characters
  * when using magic. Note that some perl guts still assume
  * certain character properties of these constants, namely that
diff --git a/plan9/plan9ish.h b/plan9/plan9ish.h
index 5c922cf0ba..dd32f69f5a 100644
--- a/plan9/plan9ish.h
+++ b/plan9/plan9ish.h
@@ -106,7 +106,7 @@
 #define ABORT() kill(PerlProc_getpid(),SIGABRT);
 
 #define BIT_BUCKET "/dev/null"
-#define PERL_SYS_INIT(c,v)	MALLOC_CHECK_TAINT2(*c,*v) MALLOC_INIT
+#define PERL_SYS_INIT(c,v)	EARLY_INIT2(*c,*v) MALLOC_CHECK_TAINT2(*c,*v) MALLOC_INIT
 #define dXSUB_SYS
 #define PERL_SYS_TERM()		MALLOC_TERM
 
diff --git a/pod/perlhack.pod b/pod/perlhack.pod
index 60653e1fe4..01692806ad 100644
--- a/pod/perlhack.pod
+++ b/pod/perlhack.pod
@@ -1216,6 +1216,14 @@ important ones are explained in L<perlxs> as well. Pay special attention
 to L<perlguts/Background and PERL_IMPLICIT_CONTEXT> for information on
 the C<[pad]THX_?> macros.
 
+=head2 The .i Targets
+
+You can expand the macros in a F<foo.c> file by saying
+
+    make foo.i
+
+which will expand the macros using cpp.  Don't be scared by the results.
+
 =head2 Poking at Perl
 
 To really poke around with Perl, you'll probably want to build Perl for
@@ -1309,8 +1317,11 @@ blessing when stepping through miles of source code.
 =item print
 
 Execute the given C code and print its results. B<WARNING>: Perl makes
-heavy use of macros, and F<gdb> is not aware of macros. You'll have to
-substitute them yourself. So, for instance, you can't say
+heavy use of macros, and F<gdb> does not necessarily support macros
+(see later L</"gdb macro support">).  You'll have to substitute them
+yourself, or to invoke cpp on the source code files
+(see L</"The .i Targets">)
+So, for instance, you can't say
 
     print SvPV_nolen(sv)
 
@@ -1320,9 +1331,11 @@ but you have to say
 
 You may find it helpful to have a "macro dictionary", which you can
 produce by saying C<cpp -dM perl.c | sort>. Even then, F<cpp> won't
-recursively apply the macros for you. 
+recursively apply those macros for you. 
+
+=head2 gdb macro support
 
-B<NOTE>: Recent versions of F<gdb> have fairly good macro support, but
+Recent versions of F<gdb> have fairly good macro support, but
 in order to use it you'll need to compile perl with macro definitions
 included in the debugging information.  Using F<gcc> version 3.1, this
 means configuring with C<-Doptimize=-g3>.  Other compilers might use a
diff --git a/pod/perlmod.pod b/pod/perlmod.pod
index 6cbdce3f9b..c03862d64d 100644
--- a/pod/perlmod.pod
+++ b/pod/perlmod.pod
@@ -283,15 +283,17 @@ going to pass to C<exit()>.  You can modify C<$?> to change the exit
 value of the program.  Beware of changing C<$?> by accident (e.g. by
 running something via C<system>).
 
-Similar to C<BEGIN> blocks, C<INIT> blocks are run just before the
-Perl runtime begins execution, in "first in, first out" (FIFO) order.
-For example, the code generators documented in L<perlcc> make use of
-C<INIT> blocks to initialize and resolve pointers to XSUBs.
-
-Similar to C<END> blocks, C<CHECK> blocks are run just after the
-Perl compile phase ends and before the run time begins, in
-LIFO order.  C<CHECK> blocks are again useful in the Perl compiler
-suite to save the compiled state of the program.
+C<CHECK> and C<INIT> blocks are useful to catch the transition between
+the compilation phase and the execution phase of the main program.
+
+C<CHECK> blocks are run just after the Perl compile phase ends and before
+the run time begins, in LIFO order.  C<CHECK> blocks are used in
+the Perl compiler suite to save the compiled state of the program.
+
+C<INIT> blocks are run just before the Perl runtime begins execution, in
+"first in, first out" (FIFO) order. For example, the code generators
+documented in L<perlcc> make use of C<INIT> blocks to initialize and
+resolve pointers to XSUBs.
 
 When you use the B<-n> and B<-p> switches to Perl, C<BEGIN> and
 C<END> work just as they do in B<awk>, as a degenerate case.
diff --git a/pod/perlretut.pod b/pod/perlretut.pod
index 57fc772df7..6e06f19291 100644
--- a/pod/perlretut.pod
+++ b/pod/perlretut.pod
@@ -689,10 +689,11 @@ inside goes into the special variables C<$1>, C<$2>, etc.  They can be
 used just as ordinary variables:
 
     # extract hours, minutes, seconds
-    $time =~ /(\d\d):(\d\d):(\d\d)/;  # match hh:mm:ss format
-    $hours = $1;
-    $minutes = $2;
-    $seconds = $3;
+    if ($time =~ /(\d\d):(\d\d):(\d\d)/) {    # match hh:mm:ss format
+	$hours = $1;
+	$minutes = $2;
+	$seconds = $3;
+    }
 
 Now, we know that in scalar context,
 S<C<$time =~ /(\d\d):(\d\d):(\d\d)/> > returns a true or false
diff --git a/pod/perlrun.pod b/pod/perlrun.pod
index 324bd8cdb7..6b01d6c6e7 100644
--- a/pod/perlrun.pod
+++ b/pod/perlrun.pod
@@ -1116,13 +1116,13 @@ order as 5.8.0).  "Pre-5.8.1" means, among other things, that hash
 keys will be ordered the same between different runs of Perl.
 
 The default behaviour is to randomise unless the PERL_HASH_SEED is set.
-If Perl has been compiled with the -DUSE_HASH_SEED_EXPLICIT the default
+If Perl has been compiled with C<-DUSE_HASH_SEED_EXPLICIT>, the default
 behaviour is B<not> to randomise unless the PERL_HASH_SEED is set.
 
 If PERL_HASH_SEED is unset or set to a non-numeric string, Perl uses
 the pseudorandom seed supplied by the operating system and libraries.
 If unset, each different run of Perl will have different ordering of
-the outputs of keys(), values, and each().
+the outputs of keys(), values(), and each().
 
 See L<perlsec/"Algorithmic Complexity Attacks"> for more information.
 
diff --git a/pod/perlvar.pod b/pod/perlvar.pod
index 6e2a853007..af50613fd3 100644
--- a/pod/perlvar.pod
+++ b/pod/perlvar.pod
@@ -838,16 +838,21 @@ and C<$)> can be swapped only on machines supporting setregid().
 
 =item $0
 
-Contains the name of the program being executed.  On some operating
-systems assigning to C<$0> modifies the argument area that the B<ps>
-program sees.  This is more useful as a way of indicating the current
+Contains the name of the program being executed.  On some (read: not
+all) operating systems assigning to C<$0> modifies the argument area
+that the C<ps> program sees.  On some platforms you may have to use
+special C<ps> options or a different C<ps> to see the changes.
+Modifying the $0 is more useful as a way of indicating thecurrent
 program state than it is for hiding the program you're running.
 (Mnemonic: same as B<sh> and B<ksh>.)
 
+Note that there are platform specific limitations on the the maximum
+length of C<$0>.  In the most extreme case it may be limited to the
+space occupied by the original C<$0>.
+
 Note for BSD users: setting C<$0> does not completely remove "perl"
 from the ps(1) output.  For example, setting C<$0> to C<"foobar"> will
-result in C<"perl: foobar (perl)">.  This is an operating system
-feature.
+result in C<"perl: foobar (perl)">.  This is an operating system feature.
 
 In multithreaded scripts Perl coordinates the threads so that any
 thread may modify its copy of the C<$0> and the change becomes visible
@@ -902,7 +907,8 @@ C<$^C = 1> is similar to calling C<B::minus_c>.
 =item $^D
 
 The current value of the debugging flags.  (Mnemonic: value of B<-D>
-switch.)
+switch.) May be read or set. Like its command-line equivalent, you can use
+numeric or symbolic values, eg C<$^D = 10> or C<$^D = "st">.
 
 =item $SYSTEM_FD_MAX
 
diff --git a/proto.h b/proto.h
index 96e32cbc45..54882c1ebb 100644
--- a/proto.h
+++ b/proto.h
@@ -1326,6 +1326,9 @@ STATIC void	S_cv_dump(pTHX_ CV *cv, char *title);
 #endif
 PERL_CALLCONV CV*	Perl_find_runcv(pTHX_ U32 *db_seqp);
 PERL_CALLCONV void	Perl_free_tied_hv_pool(pTHX);
+#if defined(DEBUGGING)
+PERL_CALLCONV int	Perl_get_debug_opts(pTHX_ char **s);
+#endif
 
 
 
diff --git a/scope.h b/scope.h
index e2150e87c0..25c7bc5f49 100644
--- a/scope.h
+++ b/scope.h
@@ -96,13 +96,11 @@ Closing bracket on a callback.  See C<ENTER> and L<perlcall>.
 #define ENTER							\
     STMT_START {						\
 	push_scope();						\
-	DEBUG_l(WITH_THR(Perl_deb(aTHX_ "ENTER scope %ld at %s:%d\n",	\
-		    PL_scopestack_ix, __FILE__, __LINE__)));	\
+	DEBUG_SCOPE("ENTER")					\
     } STMT_END
 #define LEAVE							\
     STMT_START {						\
-	DEBUG_l(WITH_THR(Perl_deb(aTHX_ "LEAVE scope %ld at %s:%d\n",	\
-		    PL_scopestack_ix, __FILE__, __LINE__)));	\
+	DEBUG_SCOPE("LEAVE")					\
 	pop_scope();						\
     } STMT_END
 #else
diff --git a/t/comp/require.t b/t/comp/require.t
index 7d1b24010c..c82d535400 100755
--- a/t/comp/require.t
+++ b/t/comp/require.t
@@ -12,7 +12,7 @@ $i = 1;
 my $Is_EBCDIC = (ord('A') == 193) ? 1 : 0;
 my $Is_UTF8   = (${^OPEN} || "") =~ /:utf8/;
 my $total_tests = 30;
-if ($Is_EBCDIC || $Is_UTF8) { $total_tests = 26; }
+if ($Is_EBCDIC || $Is_UTF8) { $total_tests = 27; }
 print "1..$total_tests\n";
 
 sub do_require {
diff --git a/t/op/magic.t b/t/op/magic.t
index f48422b2e3..611a01b9e1 100755
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -36,7 +36,7 @@ sub skip {
     return 1;
 }
 
-print "1..52\n";
+print "1..53\n";
 
 $Is_MSWin32 = $^O eq 'MSWin32';
 $Is_NetWare = $^O eq 'NetWare';
@@ -286,10 +286,23 @@ else {
 	    open CMDLINE, "/proc/$$/cmdline") {
 	    chomp(my $line = scalar <CMDLINE>);
 	    my $me = (split /\0/, $line)[0];
-	    ok($me eq $0, 'altering $0 is effective');
+	    ok($me eq $0, 'altering $0 is effective (testing with /proc/)');
 	    close CMDLINE;
+            # perlbug #22811
+            my $mydollarzero = sub {
+              my($arg) = shift;
+              $0 = $arg if defined $arg;
+              my $ps = `ps -o command= -p $$`;
+              return if $?;
+              chomp $ps;
+              printf "# 0[%s]ps[%s]\n", $0, $ps;
+              $ps;
+            };
+            my $ps = $mydollarzero->("x");
+            ok(!$ps ||   # we allow that something goes wrong with the ps command
+               $ps eq "x", 'altering $0 is effective (testing with `ps`)');
 	} else {
-	    skip("\$0 check only on Linux and FreeBSD with /proc");
+	    skip("\$0 check only on Linux and FreeBSD") for 0,1;
 	}
 }
 
diff --git a/unixish.h b/unixish.h
index 4bf37095a0..5994a8395b 100644
--- a/unixish.h
+++ b/unixish.h
@@ -129,7 +129,7 @@
 #define Mkdir(path,mode)   mkdir((path),(mode))
 
 #ifndef PERL_SYS_INIT
-#  define PERL_SYS_INIT(c,v) MALLOC_CHECK_TAINT2(*c,*v) PERL_FPU_INIT MALLOC_INIT
+#  define PERL_SYS_INIT(c,v) EARLY_INIT2(*c,*v) MALLOC_CHECK_TAINT2(*c,*v) PERL_FPU_INIT MALLOC_INIT
 #endif
 
 #ifndef PERL_SYS_TERM
diff --git a/vms/vmsish.h b/vms/vmsish.h
index 076a6967f6..1ab2df09e0 100644
--- a/vms/vmsish.h
+++ b/vms/vmsish.h
@@ -331,7 +331,7 @@ struct interp_intern {
 #endif
 
 #define BIT_BUCKET "_NLA0:"
-#define PERL_SYS_INIT(c,v)	MALLOC_CHECK_TAINT2(*c,*v) vms_image_init((c),(v)); MALLOC_INIT
+#define PERL_SYS_INIT(c,v)	EARLY_INIT2(*c,*v) MALLOC_CHECK_TAINT2(*c,*v) vms_image_init((c),(v)); MALLOC_INIT
 #define PERL_SYS_TERM()		OP_REFCNT_TERM; MALLOC_TERM
 #define dXSUB_SYS
 #define HAS_KILL