perl 5.8.2 from CPAN

7 files changed, 1107 insertions, 3233 deletions

diff --git a/gnu/usr.bin/perl/META.yml b/gnu/usr.bin/perl/META.yml
index 5dc17d547a3..a2a3fd1d4ed 100644
--- a/gnu/usr.bin/perl/META.yml
+++ b/gnu/usr.bin/perl/META.yml
@@ -1,118 +1,224 @@
----
-abstract: 'The Perl 5 language interpreter'
-author:
-  - perl5-porters@perl.org
-build_requires: {}
-dynamic_config: 1
-generated_by: 'CPAN::Meta version 2.140640, CPAN::Meta::Converter version 2.140640'
-license: perl
-meta-spec:
-  url: http://module-build.sourceforge.net/META-spec-v1.4.html
-  version: '1.4'
 name: perl
-no_index:
+version: 5.008001
+abstract: Practical Extraction and Reporting Language
+author: perl5-porters@perl.org
+license: perl
+distribution_type: core
+private:
   directory:
-    - cpan
-    - dist/Attribute-Handlers
-    - dist/autouse
-    - dist/base
-    - dist/bignum
-    - dist/Carp
-    - dist/constant
-    - dist/Data-Dumper
-    - dist/Devel-SelfStubber
-    - dist/Dumpvalue
-    - dist/Env
-    - dist/Exporter
-    - dist/ExtUtils-CBuilder
-    - dist/ExtUtils-Command
-    - dist/ExtUtils-Install
-    - dist/ExtUtils-Manifest
-    - dist/ExtUtils-ParseXS
-    - dist/Filter-Simple
-    - dist/I18N-Collate
-    - dist/if
-    - dist/IO/
-    - dist/lib/
-    - dist/Locale-Maketext
-    - dist/Math-BigInt
-    - dist/Math-BigInt-FastCalc
-    - dist/Math-BigRat
-    - dist/Module-CoreList
-    - dist/Net-Ping
-    - dist/PathTools
-    - dist/Safe
-    - dist/Search-Dict
-    - dist/SelfLoader
-    - dist/Storable
-    - dist/Term-Complete
-    - dist/Term-ReadLine
-    - dist/Text-Abbrev
-    - dist/Thread-Queue
-    - dist/Thread-Semaphore
-    - dist/threads
-    - dist/threads-shared
-    - dist/Tie-File
-    - dist/XSLoader
-    - mad
-    - win32
+    - ext/Data/Dumper
+    - ext/DB_File
+    - ext/Devel/PPPort
+    - ext/Digest/MD5
+    - ext/Encode
+    - ext/Filter/Util/Call
+    - ext/List/Util
+    - ext/MIME/Base64
+    - ext/PerlIO
+    - ext/Safe
+    - ext/Storable
+    - ext/threads
+    - ext/Time/HiRes
+    - ext/Unicode/Normalize
+    - lib/Attribute/Handlers
+    - lib/bignum
+    - lib/CGI
+    - lib/Class/ISA
+    - lib/CPAN
+    - lib/ExtUtils/t
+    - lib/File/Spec
+    - lib/File/Temp
+    - lib/Filter/Simple
+    - lib/Getopt/Long
+    - lib/I18N/LangTags
+    - lib/Locale/Maketext
+    - lib/Math/BigFloat
+    - lib/Math/BigInt
+    - lib/Math/BigRat
+    - lib/Memoize
+    - lib/Net/FTP
+    - lib/Net/Ping
+    - lib/Net/t
+    - lib/NEXT
+    - lib/Pod/Perldoc
+    - lib/Switch
+    - lib/Term/ANSIColor
+    - lib/Test/Harness
+    - lib/Test/Simple
+    - lib/Test/t
+    - lib/Text/Balanced
+    - lib/Text/TabsWrap
+    - lib/Tie/File
+    - lib/Unicode/Collate
+    - t/lib/Filter/Simple
+    - t/lib/MakeMaker
+    - t/lib/Math
+    - t/lib/sample-tests
+    - t/lib/Test/Simple
+
   file:
-    - autodoc.pl
-    - dist/IO/ChangeLog
-    - dist/IO/hints/sco.pl
-    - dist/IO/IO.pm
-    - dist/IO/IO.xs
-    - dist/IO/lib/IO/Dir.pm
-    - dist/IO/lib/IO/File.pm
-    - dist/IO/lib/IO/Handle.pm
-    - dist/IO/lib/IO/Pipe.pm
-    - dist/IO/lib/IO/Poll.pm
-    - dist/IO/lib/IO/Seekable.pm
-    - dist/IO/lib/IO/Select.pm
-    - dist/IO/lib/IO/Socket.pm
-    - dist/IO/lib/IO/Socket/INET.pm
-    - dist/IO/lib/IO/Socket/UNIX.pm
-    - dist/IO/Makefile.PL
-    - dist/IO/poll.c
-    - dist/IO/poll.h
-    - dist/IO/README
-    - dist/IO/t/cachepropagate-tcp.t
-    - dist/IO/t/cachepropagate-udp.t
-    - dist/IO/t/cachepropagate-unix.t
-    - dist/IO/t/IO.t
-    - dist/IO/t/io_const.t
-    - dist/IO/t/io_dir.t
-    - dist/IO/t/io_dup.t
-    - dist/IO/t/io_file.t
-    - dist/IO/t/io_file_export.t
-    - dist/IO/t/io_linenum.t
-    - dist/IO/t/io_multihomed.t
-    - dist/IO/t/io_pipe.t
-    - dist/IO/t/io_poll.t
-    - dist/IO/t/io_sel.t
-    - dist/IO/t/io_sock.t
-    - dist/IO/t/io_taint.t
-    - dist/IO/t/io_tell.t
-    - dist/IO/t/io_udp.t
-    - dist/IO/t/io_unix.t
-    - dist/IO/t/io_utf8.t
-    - dist/IO/t/io_utf8argv.t
-    - dist/IO/t/io_xs.t
-    - dist/lib/lib_pm.PL
-    - dist/lib/Makefile.PL
-    - dist/lib/t/01lib.t
-    - lib/unicore/mktables
-    - pod/perlfilter.pod
-    - pod/perlpodstyle.pod
-    - Porting/Maintainers.pm
-    - Porting/perldelta_template.pod
-    - TestInit.pm
-    - vutil.c
-    - vutil.h
-    - vxs.inc
-resources:
-  bugtracker: https://rt.perl.org/
-  homepage: http://www.perl.org/
-  license: http://dev.perl.org/licenses/
-  repository: http://perl5.git.perl.org/
-version: '5.020002'
+    - ext/Filter/t/call.t
+    - lib/Attribute/Handlers.pm
+    - lib/bigint.pm
+    - lib/bignum.pm
+    - lib/bigrat.pm
+    - lib/CGI.pm
+    - lib/Class/ISA.pm
+    - lib/CPAN.pm
+    - lib/Digest.pm
+    - lib/Digest.t
+    - lib/ExtUtils/Command
+    - lib/ExtUtils/Command.pm
+    - lib/ExtUtils/Install.pm
+    - lib/ExtUtils/Installed.pm
+    - lib/ExtUtils/Liblist
+    - lib/ExtUtils/Liblist.pm
+    - lib/ExtUtils/MakeMaker
+    - lib/ExtUtils/MakeMaker.pm
+    - lib/ExtUtils/Manifest.pm
+    - lib/ExtUtils/Mkbootstrap.pm
+    - lib/ExtUtils/Mksymlists.pm
+    - lib/ExtUtils/MM.pm
+    - lib/ExtUtils/MM_Any.pm
+    - lib/ExtUtils/MM_BeOS.pm
+    - lib/ExtUtils/MM_Cygwin.pm
+    - lib/ExtUtils/MM_DOS.pm
+    - lib/ExtUtils/MM_MacOS.pm
+    - lib/ExtUtils/MM_NW5.pm
+    - lib/ExtUtils/MM_OS2.pm
+    - lib/ExtUtils/MM_Unix.pm
+    - lib/ExtUtils/MM_UWIN.pm
+    - lib/ExtUtils/MM_VMS.pm
+    - lib/ExtUtils/MM_Win32.pm
+    - lib/ExtUtils/MM_Win95.pm
+    - lib/ExtUtils/MY.pm
+    - lib/ExtUtils/Packlist.pm
+    - lib/ExtUtils/testlib.pm
+    - lib/File/Spec.pm
+    - lib/File/Temp.pm
+    - lib/Filter/Simple.pm
+    - lib/Getopt/Long.pm
+    - lib/I18N/LangTags.pm
+    - lib/if.pm
+    - lib/if.t
+    - lib/Locale/Codes
+    - lib/Locale/Constants.pm
+    - lib/Locale/Constants.pod
+    - lib/Locale/Country.pm
+    - lib/Locale/Country.pod
+    - lib/Locale/Currency.pm
+    - lib/Locale/Currency.pod
+    - lib/Locale/Language.pm
+    - lib/Locale/Language.pod
+    - lib/Locale/Maketext.pm
+    - lib/Locale/Script.pm
+    - lib/Locale/Script.pod
+    - lib/Math/BigFloat.pm
+    - lib/Math/BigInt.pm
+    - lib/Math/BigRat.pm
+    - lib/Memoize.pm
+    - lib/Net/ChangeLog.libnet
+    - lib/Net/Cmd.pm
+    - lib/Net/Config.eg
+    - lib/Net/Config.pm
+    - lib/Net/Domain.pm
+    - lib/Net/FTP.pm
+    - lib/Net/Hostname.eg
+    - lib/Net/libnetFAQ.pod
+    - lib/Net/Netrc.pm
+    - lib/Net/NNTP.pm
+    - lib/Net/Ping.pm
+    - lib/Net/POP3.pm
+    - lib/Net/README.libnet
+    - lib/Net/SMTP.pm
+    - lib/Net/Time.pm
+    - lib/NEXT.pm
+    - lib/PerlIO/via/QuotedPrint.pm
+    - lib/PerlIO/via/t/QuotedPrint.t
+    - lib/Pod/Checker.pm
+    - lib/Pod/Find.pm
+    - lib/Pod/Html.pm
+    - lib/Pod/InputObjects.pm
+    - lib/Pod/LaTeX.pm
+    - lib/Pod/Man.pm
+    - lib/Pod/ParseLink.pm
+    - lib/Pod/Parser.pm
+    - lib/Pod/ParseUtils.pm
+    - lib/Pod/Perldoc.pm
+    - lib/Pod/PlainText.pm
+    - lib/Pod/Select.pm
+    - lib/Pod/t/basic.cap
+    - lib/Pod/t/basic.clr
+    - lib/Pod/t/basic.man
+    - lib/Pod/t/basic.ovr
+    - lib/Pod/t/basic.pod
+    - lib/Pod/t/basic.t
+    - lib/Pod/t/basic.txt
+    - lib/Pod/t/man.t
+    - lib/Pod/t/parselink.t
+    - lib/Pod/t/pod2latex.t
+    - lib/Pod/t/text-errors.t
+    - lib/Pod/t/text-options.t
+    - lib/Pod/t/text.t
+    - lib/Pod/Text.pm
+    - lib/Pod/Text/Color.pm
+    - lib/Pod/Text/Overstrike.pm
+    - lib/Pod/Text/Termcap.pm
+    - lib/Pod/Usage.pm
+    - lib/Switch.pm
+    - lib/Term/ANSIColor.pm
+    - lib/Term/Cap.pm
+    - lib/Term/Cap.t
+    - lib/Test.pm
+    - lib/Test/Builder.pm
+    - lib/Test/Harness.pm
+    - lib/Test/More.pm
+    - lib/Test/Simple.pm
+    - lib/Text/Balanced.pm
+    - lib/Text/Tabs.pm
+    - lib/Text/Wrap.pm
+    - lib/Tie/File.pm
+    - lib/Time/Local.pm
+    - lib/Time/Local.t
+    - lib/Unicode/Collate.pm
+    - pod/pod2man.PL
+    - pod/pod2text.PL
+    - pod/pod2usage.PL
+    - pod/podchecker.PL
+    - pod/podselect.PL
+    - t/lib/filter-util.pl
+    - t/lib/TieIn.pm
+    - t/lib/TieOut.pm
+    - t/pod/emptycmd.t
+    - t/pod/emptycmd.xr
+    - t/pod/find.t
+    - t/pod/for.t
+    - t/pod/for.xr
+    - t/pod/headings.t
+    - t/pod/headings.xr
+    - t/pod/include.t
+    - t/pod/include.xr
+    - t/pod/included.t
+    - t/pod/included.xr
+    - t/pod/lref.t
+    - t/pod/lref.xr
+    - t/pod/multiline_items.t
+    - t/pod/multiline_items.xr
+    - t/pod/nested_items.t
+    - t/pod/nested_items.xr
+    - t/pod/nested_seqs.t
+    - t/pod/nested_seqs.xr
+    - t/pod/oneline_cmds.t
+    - t/pod/oneline_cmds.xr
+    - t/pod/pod2usage.t
+    - t/pod/pod2usage.xr
+    - t/pod/poderrs.t
+    - t/pod/poderrs.xr
+    - t/pod/podselect.t
+    - t/pod/podselect.xr
+    - t/pod/special_seqs.t
+    - t/pod/special_seqs.xr
+    - t/pod/testcmp.pl
+    - t/pod/testp2pt.pl
+    - t/pod/testpchk.pl
+
diff --git a/gnu/usr.bin/perl/Porting/cmpVERSION.pl b/gnu/usr.bin/perl/Porting/cmpVERSION.pl
index f583191ad32..052051c3d21 100644
--- a/gnu/usr.bin/perl/Porting/cmpVERSION.pl
+++ b/gnu/usr.bin/perl/Porting/cmpVERSION.pl
@@ -1,220 +1,53 @@
 #!/usr/bin/perl -w
 
 #
-# cmpVERSION - compare the current Perl source tree and a given tag
-# for modules that have identical version numbers but different contents.
+# cmpVERSION - compare two Perl source trees for modules
+# that have identical version numbers but different contents.
 #
-# with -d option, output the diffs too
-# with -x option, exclude files from modules where blead is not upstream
+# Original by slaven@rezic.de, modified by jhi.
 #
-# (after all, there are tools like core-cpan-diff that can already deal with
-# them)
-#
-# Original by slaven@rezic.de, modified by jhi and matt.w.johnson@gmail.com.
-# Adaptation to produce TAP by Abigail, folded back into this file by Nicholas
 
 use strict;
-use 5.006;
 
 use ExtUtils::MakeMaker;
-use File::Spec::Functions qw(devnull);
-use Getopt::Long;
-
-my ($diffs, $exclude_upstream, $tag_to_compare, $tap);
-unless (GetOptions('diffs' => \$diffs,
-		   'exclude|x' => \$exclude_upstream,
-		   'tag=s' => \$tag_to_compare,
-		   'tap' => \$tap,
-		   ) && @ARGV == 0) {
-    die "usage: $0 [ -d -x --tag TAG --tap]";
-}
-
-die "$0: This does not look like a Perl directory\n"
-    unless -f "perl.h" && -d "Porting";
-die "$0: 'This is a Perl directory but does not look like Git working directory\n"
-    unless (-d ".git" || (exists $ENV{GIT_DIR} && -d $ENV{GIT_DIR}));
-
-my $null = devnull();
-
-unless (defined $tag_to_compare) {
-    my $check = 'HEAD';
-    while(1) {
-        $check = `git describe --abbrev=0 $check 2>$null`;
-        chomp $check;
-        last unless $check =~ /-RC/;
-        $check .= '^';
-    }
-    $tag_to_compare = $check;
-    # Thanks to David Golden for this suggestion.
-
-}
-
-unless (length $tag_to_compare) {
-    die "$0: Git found, but no Git tags found\n"
-	unless $tap;
-    print "1..0 # SKIP: Git found, but no Git tags found\n";
-    exit 0;
-}
-
-my $tag_exists = `git --no-pager tag -l $tag_to_compare 2>$null`;
-chomp $tag_exists;
+use File::Compare;
+use File::Find;
+use File::Spec::Functions qw(rel2abs abs2rel catfile catdir curdir);
 
-unless ($tag_exists eq $tag_to_compare) {
-    die "$0: '$tag_to_compare' is not a known Git tag\n" unless $tap;
-    print "1..0 # SKIP: '$tag_to_compare' is not a known Git tag\n";
-    exit 0;
+for (@ARGV[0, 1]) {
+    die "$0: '$_' does not look like Perl directory\n"
+	unless -f catfile($_, "perl.h") && -d catdir($_, "Porting");
 }
 
-my %upstream_files;
-if ($exclude_upstream) {
-    unshift @INC, 'Porting';
-    require Maintainers;
-
-    for my $m (grep {!defined $Maintainers::Modules{$_}{UPSTREAM}
-			 or $Maintainers::Modules{$_}{UPSTREAM} ne 'blead'}
-	       keys %Maintainers::Modules) {
-	$upstream_files{$_} = 1 for Maintainers::get_module_files($m);
-    }
-}
+my $dir2 = rel2abs($ARGV[1]);
+chdir $ARGV[0] or die "$0: chdir '$ARGV[0]' failed: $!\n";
 
 # Files to skip from the check for one reason or another,
 # usually because they pull in their version from some other file.
 my %skip;
-@skip{
-    'cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/BFD.pm', # just a test module
-    'cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/XS.pm',  # just a test module
-    'cpan/Module-Build/t/lib/DistGen.pm', # just a test module
-    'cpan/Module-Build/t/lib/MBTest.pm',  # just a test module
-    'cpan/Module-Metadata/t/lib/DistGen.pm',    # just a test module
-    'cpan/Module-Metadata/t/lib/MBTest.pm',     # just a test module
-    'cpan/Module-Metadata/t/lib/Tie/CPHash.pm', # just a test module
-    'dist/Attribute-Handlers/demo/MyClass.pm', # it's just demonstration code
-    'dist/Exporter/lib/Exporter/Heavy.pm',
-    'lib/Carp/Heavy.pm',
-    'lib/Config.pm',		# no version number but contents will vary
-    'win32/FindExt.pm',
-} = ();
-
-# Files to skip just for particular version(s),
-# usually due to some # mix-up
-
-my %skip_versions = (
-	   # 'some/sample/file.pm' => [ '1.23', '1.24' ],
-	   'dist/threads/lib/threads.pm' => [ '1.83' ],
-	  );
-
-my $skip_dirs = qr|^t/lib|;
-
-sub pm_file_from_xs {
-    my $xs = shift;
-
-    foreach my $try (sub {
-			 # First try a .pm at the same level as the .xs file
-			 # with the same basename
-			 return shift =~ s/\.xs\z//r;
-		     },
-		     sub {
-			 # Try for a (different) .pm at the same level, based
-			 # on the directory name:
-			 my ($path) = shift =~ m!^(.*)/!;
-			 my ($last) = $path =~ m!([^-/]+)\z!;
-			 return "$path/$last";
-		     },
-		     sub {
-			 # Try to work out the extension's full package, and
-			 # look for a .pm in lib/ based on that:
-			 my ($path) = shift =~ m!^(.*)/!;
-			 my ($last) = $path =~ m!([^/]+)\z!;
-			 $last = 'List-Util' if $last eq 'Scalar-List-Utils';
-			 $last =~ tr !-!/!;
-			 return "$path/lib/$last";
-		     }) {
-	# For all cases, first look to see if the .pm file is generated.
-	my $base = $try->($xs);
-	return "${base}_pm.PL" if -f "${base}_pm.PL";
-	return "${base}.pm" if -f "${base}.pm";
-    }
+@skip{'./lib/Exporter/Heavy.pm'} = ();
+
+my @wanted;
+find(
+     sub { /\.pm$/ &&
+	       ! exists $skip{$File::Find::name}
+	       &&
+	       do { my $file2 =
+			catfile(catdir($dir2, $File::Find::dir), $_);
+		    (my $xs_file1 = $_)     =~ s/\.pm$/.xs/;
+		    (my $xs_file2 = $file2) =~ s/\.pm$/.xs/;
+		    if (-e $xs_file1 && -e $xs_file2) {
+			return if compare($_, $file2) == 0 &&
+			          compare($xs_file1, $xs_file2) == 0;
+		    } else {
+			return if compare($_, $file2) == 0;
+		    }
+		    my $version1 = eval {MM->parse_version($_)};
+		    my $version2 = eval {MM->parse_version($file2)};
+		    push @wanted, $File::Find::name
+			if defined $version1 &&
+			   defined $version2 &&
+                           $version1 eq $version2
+		} }, curdir);
+print map { $_, "\n" } sort @wanted;
 
-    die "No idea which .pm file corresponds to '$xs', so aborting";
-}
-
-# Key is the .pm file from which we check the version.
-# Value is a reference to an array of files to check for differences
-# The trivial case is a pure perl module, where the array holds one element,
-# the perl module's file. The "fun" comes with XS modules, and the real fun
-# with XS modules with more than one XS file, and "interesting" layouts.
-
-my %module_diffs;
-
-foreach (`git --no-pager diff --name-only $tag_to_compare --diff-filter=ACMRTUXB`) {
-    chomp;
-    next unless m/^(.*)\//;
-    my $this_dir = $1;
-    next if $this_dir =~ $skip_dirs || exists $skip{$_};
-    next if exists $upstream_files{$_};
-    if (/\.pm\z/ || m|^lib/.*\.pl\z| || /_pm\.PL\z/) {
-	push @{$module_diffs{$_}}, $_;
-    } elsif (/\.xs\z/ && !/\bt\b/) {
-	push @{$module_diffs{pm_file_from_xs($_)}}, $_;
-    }
-}
-
-unless (%module_diffs) {
-    print "1..1\nok 1 - No difference found\n" if $tap;
-    exit;
-}
-
-printf "1..%d\n" => scalar keys %module_diffs if $tap;
-
-my $count;
-my $diff_cmd = "git --no-pager diff $tag_to_compare ";
-my $q = ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS') ? '"' : "'";
-my (@diff);
-
-foreach my $pm_file (sort keys %module_diffs) {
-    # git has already told us that the files differ, so no need to grab each as
-    # a blob from git, and do the comparison ourselves.
-    my $pm_version = eval {MM->parse_version($pm_file)};
-    my $orig_pm_content = get_file_from_git($pm_file, $tag_to_compare);
-    my $orig_pm_version = eval {MM->parse_version(\$orig_pm_content)};
-    ++$count;
-
-    if (!defined $orig_pm_version || $orig_pm_version eq 'undef') { # sigh
-        print "ok $count - SKIP Can't parse \$VERSION in $pm_file\n"
-          if $tap;
-    } elsif (!defined $pm_version || $pm_version eq 'undef') {
-        print "not ok $count - in $pm_file version was $orig_pm_version, now unparsable\n" if $tap;
-    } elsif ($pm_version ne $orig_pm_version) { # good
-        print "ok $count - $pm_file\n" if $tap;
-    } else {
-	if ($tap) {
-	    foreach (sort @{$module_diffs{$pm_file}}) {
-		print "# $_" for `$diff_cmd $q$_$q`;
-	    }
-	    if (exists $skip_versions{$pm_file}
-		and grep $pm_version eq $_, @{$skip_versions{$pm_file}}) {
-		print "ok $count - SKIP $pm_file version $pm_version\n";
-	    } else {
-		print "not ok $count - $pm_file version $pm_version\n";
-	    }
-	} else {
-	    push @diff, @{$module_diffs{$pm_file}};
-	    print "$pm_file version $pm_version\n";
-	}
-    }
-}
-
-sub get_file_from_git {
-    my ($file, $tag) = @_;
-    local $/;
-
-    use open IN => ':raw';
-    return scalar `git --no-pager show $tag:$file 2>$null`;
-}
-
-if ($diffs) {
-    for (sort @diff) {
-	print "\n";
-	system "$diff_cmd $q$_$q";
-    }
-}
diff --git a/gnu/usr.bin/perl/README.macosx b/gnu/usr.bin/perl/README.macosx
index 5797303db05..2b19bdfea07 100644
--- a/gnu/usr.bin/perl/README.macosx
+++ b/gnu/usr.bin/perl/README.macosx
@@ -4,44 +4,23 @@ designed to be readable as is.
 
 =head1 NAME
 
-perlmacosx - Perl under Mac OS X
+README.macosx - Perl under Mac OS X
 
 =head1 SYNOPSIS
 
-This document briefly describes Perl under Mac OS X.
+This document briefly describes perl under Mac OS X.
 
-  curl -O http://www.cpan.org/src/perl-5.20.2.tar.gz
-  tar -xzf perl-5.20.2.tar.gz
-  cd perl-5.20.2
-  ./Configure -des -Dprefix=/usr/local/
-  make
-  make test
-  sudo make install
 
 =head1 DESCRIPTION
 
-The latest Perl release (5.20.2 as of this writing) builds without changes
-under all versions of Mac OS X from 10.3 "Panther" onwards. 
+The latest Perl (5.8.1-RC3 as of this writing) builds without changes
+under Mac OS X. Under the 10.3 "Panther" release, all self-tests pass,
+and all standard features are supported.
 
-In order to build your own version of Perl you will need 'make',
-which is part of Apple's developer tools - also known as Xcode. From
-Mac OS X 10.7 "Lion" onwards, it can be downloaded separately as the
-'Command Line Tools' bundle directly from L<https://developer.apple.com/downloads/>
-(you will need a free account to log in), or as a part of the Xcode suite,
-freely available at the App Store. Xcode is a pretty big app, so
-unless you already have it or really want it, you are advised to get the
-'Command Line Tools' bundle separately from the link above. If you want
-to do it from within Xcode, go to Xcode -> Preferences -> Downloads and
-select the 'Command Line Tools' option.
-
-Between Mac OS X 10.3 "Panther" and 10.6 "Snow Leopard", the 'Command
-Line Tools' bundle was called 'unix tools', and was usually supplied
-with Mac OS install DVDs.
-
-Earlier Mac OS X releases (10.2 "Jaguar" and older) did not include a
-completely thread-safe libc, so threading is not fully supported. Also,
-earlier releases included a buggy libdb, so some of the DB_File tests
-are known to fail on those releases.
+Earlier Mac OS X releases did not include a completely thread-safe libc,
+so threading is not fully supported. Also, earlier releases included a
+somewhat buggy libdb, so some of the DB_File tests are known to fail on
+those releases.
 
 
 =head2 Installation Prefix
@@ -59,90 +38,6 @@ that mirrors that of Apple's default Perl, with core modules stored in
 on a file server and used by many Macs.
 
 
-=head2 SDK support
-
-First, export the path to the SDK into the build environment:
-
-    export SDK=/Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX10.8.sdk
-
-Please make sure the SDK version (i.e. the numbers right before '.sdk')
-matches your system's (in this case, Mac OS X 10.8 "Mountain Lion"), as it is
-possible to have more than one SDK installed. Also make sure the path exists
-in your system, and if it doesn't please make sure the SDK is properly
-installed, as it should come with the 'Command Line Tools' bundle mentioned
-above. Finally, if you have an older Mac OS X (10.6 "Snow Leopard" and below)
-running Xcode 4.2 or lower, the SDK path might be something like
-C<'/Developer/SDKs/MacOSX10.3.9.sdk'>.
-
-You can use the SDK by exporting some additions to Perl's 'ccflags' and '..flags'
-config variables:
-
-    ./Configure -Accflags="-nostdinc -B$SDK/usr/include/gcc \
-                           -B$SDK/usr/lib/gcc -isystem$SDK/usr/include \
-                           -F$SDK/System/Library/Frameworks" \
-                -Aldflags="-Wl,-syslibroot,$SDK" \
-                -de
-
-=head2 Universal Binary support
-
-Note: From Mac OS X 10.6 "Snow Leopard" onwards, Apple only supports
-Intel-based hardware. This means you can safely skip this section unless
-you have an older Apple computer running on ppc or wish to create a perl
-binary with backwards compatibility.
-
-You can compile perl as a universal binary (built for both ppc and intel).
-In Mac OS X 10.4 "Tiger", you must export the 'u' variant of the SDK:
-
-    export SDK=/Developer/SDKs/MacOSX10.4u.sdk
-
-Mac OS X 10.5 "Leopard" and above do not require the 'u' variant.
-
-In addition to the compiler flags used to select the SDK, also add the flags
-for creating a universal binary:
-
-    ./Configure -Accflags="-arch i686 -arch ppc -nostdinc -B$SDK/usr/include/gcc \
-                           -B$SDK/usr/lib/gcc -isystem$SDK/usr/include \
-                           -F$SDK/System/Library/Frameworks" \
-                -Aldflags="-arch i686 -arch ppc -Wl,-syslibroot,$SDK" \
-                -de
-
-Keep in mind that these compiler and linker settings will also be used when
-building CPAN modules. For XS modules to be compiled as a universal binary, any
-libraries it links to must also be universal binaries. The system libraries that
-Apple includes with the 10.4u SDK are all universal, but user-installed libraries
-may need to be re-installed as universal binaries.
-
-=head2 64-bit PPC support
-
-Follow the instructions in F<INSTALL> to build perl with support for 64-bit 
-integers (C<use64bitint>) or both 64-bit integers and 64-bit addressing
-(C<use64bitall>). In the latter case, the resulting binary will run only
-on G5-based hosts.
-
-Support for 64-bit addressing is experimental: some aspects of Perl may be
-omitted or buggy. Note the messages output by F<Configure> for further 
-information. Please use C<perlbug> to submit a problem report in the
-event that you encounter difficulties.
-
-When building 64-bit modules, it is your responsibility to ensure that linked
-external libraries and frameworks provide 64-bit support: if they do not,
-module building may appear to succeed, but attempts to use the module will
-result in run-time dynamic linking errors, and subsequent test failures.
-You can use C<file> to discover the architectures supported by a library:
-
-    $ file libgdbm.3.0.0.dylib 
-    libgdbm.3.0.0.dylib: Mach-O fat file with 2 architectures
-    libgdbm.3.0.0.dylib (for architecture ppc):      Mach-O dynamically linked shared library ppc
-    libgdbm.3.0.0.dylib (for architecture ppc64):    Mach-O 64-bit dynamically linked shared library ppc64
-
-Note that this issue precludes the building of many Macintosh-specific CPAN
-modules (C<Mac::*>), as the required Apple frameworks do not provide PPC64
-support. Similarly, downloads from Fink or Darwinports are unlikely to provide
-64-bit support; the libraries must be rebuilt from source with the appropriate
-compiler and linker flags. For further information, see Apple's
-I<64-Bit Transition Guide> at 
-L<http://developer.apple.com/documentation/Darwin/Conceptual/64bitPorting/index.html>.
-
 =head2 libperl and Prebinding
 
 Mac OS X ships with a dynamically-loaded libperl, but the default for
@@ -156,28 +51,38 @@ need to go to a great deal of effort to obtain the information needed
 for pre-binding.
 
 You can override the default and build a shared libperl if you wish
-(S<Configure ... -Duseshrplib>).
+(S<Configure ... -Duseshrlib>), but the load time will be
+significantly greater than either the static library, or Apple's
+pre-bound dynamic library.
+
+
+=head2 Updating Panther
 
-With Mac OS X 10.4 "Tiger" and newer, there is almost no performance
-penalty for non-prebound libraries. Earlier releases will suffer a greater
-load time than either the static library, or Apple's pre-bound dynamic library.
+As of this writing, the latest Perl release that has been tested and
+approved for inclusion in the 10.3 "Panther" release of Mac OS X is
+5.8.1 RC3. It is currently unknown whether the final 5.8.1 release will
+be made in time to be tested and included with Panther.
 
-=head2 Updating Apple's Perl
+If the final release of Perl 5.8.1 is not made in time to be included
+with Panther, it is recommended that you wait for an official Apple
+update to the OS, rather than attempting to update it yourself. In most
+cases, if you need a newer Perl, it is preferable to install it in some
+other location, such as /usr/local or /opt, rather than overwriting the
+system Perl.  The default location (no -Dprefix=... specified when running
+Configure) is /usr/local.
 
-In a word - don't, at least not without a *very* good reason. Your scripts
-can just as easily begin with "#!/usr/local/bin/perl" as with
-"#!/usr/bin/perl". Scripts supplied by Apple and other third parties as
-part of installation packages and such have generally only been tested
-with the /usr/bin/perl that's installed by Apple.
+If you find that you do need to update the system Perl, there is one
+potential issue. If you upgrade using the default static libperl, you
+will find that the dynamic libperl supplied by Apple will not be
+deleted. If both libraries are present when an application that links
+against libperl is built, ld will link against the dynamic library by
+default. So, if you need to replace Apple's dynamic libperl with a
+static libperl, you need to be sure to delete the older dynamic library
+after you've installed the update.
 
-If you find that you do need to update the system Perl, one issue worth
-keeping in mind is the question of static vs. dynamic libraries. If you
-upgrade using the default static libperl, you will find that the dynamic
-libperl supplied by Apple will not be deleted. If both libraries are
-present when an application that links against libperl is built, ld will
-link against the dynamic library by default. So, if you need to replace
-Apple's dynamic libperl with a static libperl, you need to be sure to
-delete the older dynamic library after you've installed the update.
+Note that this is only an issue when updating from an older build of the
+same Perl version. If you're updating from (for example) 5.8.1 to 5.8.2,
+this issue won't affect you.
 
 
 =head2 Known problems
@@ -206,11 +111,31 @@ applications like Tk: in that case consider building shared Perl
 but remember that there's a startup cost to pay in that case (see above
 "libperl and Prebinding").
 
-Starting with Tiger (Mac OS X 10.4), Apple shipped broken locale files for
-the eu_ES locale (Basque-Spain).  In previous releases of Perl, this resulted in
-failures in the F<lib/locale> test. These failures have been suppressed
-in the current release of Perl by making the test ignore the broken locale.
-If you need to use the eu_ES locale, you should contact Apple support.
+
+=head2 MacPerl
+
+Quite a bit has been written about MacPerl, the Perl distribution for
+"Classic MacOS" - that is, versions 9 and earlier of MacOS. Because it
+runs in environment that's very different from that of UNIX, many things
+are done differently in MacPerl. Modules are installed using a different
+procedure, Perl itself is built differently, path names are different,
+etc.
+
+From the perspective of a Perl programmer, Mac OS X is more like a
+traditional UNIX than Classic MacOS. If you find documentation that
+refers to a special procedure that's needed for MacOS that's drastically
+different from the instructions provided for UNIX, the MacOS
+instructions are quite often intended for MacPerl on Classic MacOS. In
+that case, the correct procedure on Mac OS X is usually to follow the
+UNIX instructions, rather than the MacPerl instructions.
+
+
+=head2 Carbon
+
+MacPerl ships with a number of modules that are used to access the
+classic MacOS toolbox. Many of these modules have been updated to use
+Mac OS X's newer "Carbon" toolbox, and are available from CPAN in the
+"Mac::Carbon" module.
 
 
 =head2 Cocoa
@@ -250,25 +175,20 @@ You can find them for example by
 
     # find /System/Library/Perl /Library/Perl -name '*.bundle' -print
 
-After this you can either copy Perl from your operating system media
+After this you can either copy Perl from your operating system CDs
 (you will need at least the /System/Library/Perl and /usr/bin/perl),
 or rebuild Perl from the source code with C<Configure -Dprefix=/usr
--Duseshrplib> NOTE: the C<-Dprefix=/usr> to replace the system Perl
+-Dusershrplib> NOTE: the C<-Dprefix=/usr> to replace the system Perl
 works much better with Perl 5.8.1 and later, in Perl 5.8.0 the
 settings were not quite right.
 
-"Pacifist" from CharlesSoft (L<http://www.charlessoft.com/>) is a nice
-way to extract the Perl binaries from the OS media, without having to
-reinstall the entire OS.
-
 
 =head1 AUTHOR
 
-This README was written by Sherm Pendley E<lt>sherm@dot-app.orgE<gt>,
-and subsequently updated by Dominic Dunlop E<lt>domo@computer.orgE<gt>
-and Breno G. de Oliveira E<lt>garu@cpan.orgE<gt>. The "Starting From Scratch"
-recipe was contributed by John Montbriand E<lt>montbriand@apple.comE<gt>.
+This README was written by Sherm Pendley E<lt>sherm@dot-app.orgE<gt>.
+The "Starting From Scratch" recipe was contributed by John Montbriand
+E<lt>montbriand@apple.comE<gt>.
 
 =head1 DATE
 
-Last modified 2013-04-29.
+Last modified 2003-09-08.
diff --git a/gnu/usr.bin/perl/pad.c b/gnu/usr.bin/perl/pad.c
index fed28922ed1..3f26d1a4f04 100644
--- a/gnu/usr.bin/perl/pad.c
+++ b/gnu/usr.bin/perl/pad.c
@@ -1,21 +1,16 @@
 /*    pad.c
  *
- *    Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
- *    by Larry Wall and others
+ *    Copyright (C) 2002, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
- */
-
-/*
- *  'Anyway: there was this Mr. Frodo left an orphan and stranded, as you
- *   might say, among those queer Bucklanders, being brought up anyhow in
- *   Brandy Hall.  A regular warren, by all accounts.  Old Master Gorbadoc
- *   never had fewer than a couple of hundred relations in the place.
- *   Mr. Bilbo never did a kinder deed than when he brought the lad back
- *   to live among decent folk.'                           --the Gaffer
  *
- *     [p.23 of _The Lord of the Rings_, I/i: "A Long-Expected Party"]
+ *  "Anyway: there was this Mr Frodo left an orphan and stranded, as you
+ *  might say, among those queer Bucklanders, being brought up anyhow in
+ *  Brandy Hall. A regular warren, by all accounts. Old Master Gorbadoc
+ *  never had fewer than a couple of hundred relations in the place. Mr
+ *  Bilbo never did a kinder deed than when he brought the lad back to
+ *  live among decent folk." --the Gaffer
  */
 
 /* XXX DAPM
@@ -27,113 +22,67 @@
 /*
 =head1 Pad Data Structures
 
-=for apidoc Amx|PADLIST *|CvPADLIST|CV *cv
-
-CV's can have CvPADLIST(cv) set to point to a PADLIST.  This is the CV's
-scratchpad, which stores lexical variables and opcode temporary and
-per-thread values.
+=for apidoc m|AV *|CvPADLIST|CV *cv
+CV's can have CvPADLIST(cv) set to point to an AV.
 
-For these purposes "formats" are a kind-of CV; eval""s are too (except they're
+For these purposes "forms" are a kind-of CV, eval""s are too (except they're
 not callable at will and are always thrown away after the eval"" is done
-executing).  Require'd files are simply evals without any outer lexical
-scope.
+executing).
 
 XSUBs don't have CvPADLIST set - dXSTARG fetches values from PL_curpad,
 but that is really the callers pad (a slot of which is allocated by
 every entersub).
 
-The PADLIST has a C array where pads are stored.
+The CvPADLIST AV has does not have AvREAL set, so REFCNT of component items
+is managed "manual" (mostly in pad.c) rather than normal av.c rules.
+The items in the AV are not SVs as for a normal AV, but other AVs:
 
-The 0th entry of the PADLIST is a PADNAMELIST (which is actually just an
-AV, but that may change) which represents the "names" or rather
-the "static type information" for lexicals.  The individual elements of a
-PADNAMELIST are PADNAMEs (just SVs; but, again, that may change).  Future
-refactorings might stop the PADNAMELIST from being stored in the PADLIST's
-array, so don't rely on it.  See L</PadlistNAMES>.
+0'th Entry of the CvPADLIST is an AV which represents the "names" or rather
+the "static type information" for lexicals.
 
-The CvDEPTH'th entry of a PADLIST is a PAD (an AV) which is the stack frame
-at that depth of recursion into the CV.  The 0th slot of a frame AV is an
-AV which is @_.  Other entries are storage for variables and op targets.
+The CvDEPTH'th entry of CvPADLIST AV is an AV which is the stack frame at that
+depth of recursion into the CV.
+The 0'th slot of a frame AV is an AV which is @_.
+other entries are storage for variables and op targets.
 
-Iterating over the PADNAMELIST iterates over all possible pad
-items.  Pad slots for targets (SVs_PADTMP)
-and GVs end up having &PL_sv_undef
-"names", while slots for constants have &PL_sv_no "names" (see
-pad_alloc()).  That &PL_sv_no is used is an implementation detail subject
-to change.  To test for it, use C<PadnamePV(name) && !PadnameLEN(name)>.
+During compilation:
+C<PL_comppad_name> is set to the names AV.
+C<PL_comppad> is set to the frame AV for the frame CvDEPTH == 1.
+C<PL_curpad> is set to the body of the frame AV (i.e. AvARRAY(PL_comppad)).
 
-Only my/our variable (SvPADMY/PADNAME_isOUR) slots get valid names.
+During execution, C<PL_comppad> and C<PL_curpad> refer to the live
+frame of the currently executing sub.
+
+Iterating over the names AV iterates over all possible pad
+items. Pad slots that are SVs_PADTMP (targets/GVs/constants) end up having
+&PL_sv_undef "names" (see pad_alloc()).
+
+Only my/our variable (SVs_PADMY/SVs_PADOUR) slots get valid names.
 The rest are op targets/GVs/constants which are statically allocated
 or resolved at compile time.  These don't have names by which they
-can be looked up from Perl code at run time through eval"" the way
+can be looked up from Perl code at run time through eval"" like
 my/our variables can be.  Since they can't be looked up by "name"
 but only by their index allocated at compile time (which is usually
 in PL_op->op_targ), wasting a name SV for them doesn't make sense.
 
 The SVs in the names AV have their PV being the name of the variable.
-xlow+1..xhigh inclusive in the NV union is a range of cop_seq numbers for
-which the name is valid (accessed through the macros COP_SEQ_RANGE_LOW and
-_HIGH).  During compilation, these fields may hold the special value
-PERL_PADSEQ_INTRO to indicate various stages:
-
-   COP_SEQ_RANGE_LOW        _HIGH
-   -----------------        -----
-   PERL_PADSEQ_INTRO            0   variable not yet introduced:   { my ($x
-   valid-seq#   PERL_PADSEQ_INTRO   variable in scope:             { my ($x)
-   valid-seq#          valid-seq#   compilation of scope complete: { my ($x) }
-
-For typed lexicals name SV is SVt_PVMG and SvSTASH
-points at the type.  For C<our> lexicals, the type is also SVt_PVMG, with the
-SvOURSTASH slot pointing at the stash of the associated global (so that
-duplicate C<our> declarations in the same package can be detected).  SvUVX is
-sometimes hijacked to store the generation number during compilation.
-
-If PADNAME_OUTER (SvFAKE) is set on the
-name SV, then that slot in the frame AV is
-a REFCNT'ed reference to a lexical from "outside".  In this case,
-the name SV does not use xlow and xhigh to store a cop_seq range, since it is
-in scope throughout.  Instead xhigh stores some flags containing info about
-the real lexical (is it declared in an anon, and is it capable of being
-instantiated multiple times?), and for fake ANONs, xlow contains the index
-within the parent's pad where the lexical's value is stored, to make
-cloning quicker.
-
-If the 'name' is '&' the corresponding entry in the PAD
+NV+1..IV inclusive is a range of cop_seq numbers for which the name is
+valid.  For typed lexicals name SV is SVt_PVMG and SvSTASH points at the
+type.  For C<our> lexicals, the type is SVt_PVGV, and GvSTASH points at the
+stash of the associated global (so that duplicate C<our> delarations in the
+same package can be detected).  SvCUR is sometimes hijacked to
+store the generation number during compilation.
+
+If SvFAKE is set on the name SV then slot in the frame AVs are
+a REFCNT'ed references to a lexical from "outside". In this case,
+the name SV does not have a cop_seq range, since it is in scope
+throughout.
+
+If the 'name' is '&' the corresponding entry in frame AV
 is a CV representing a possible closure.
-(PADNAME_OUTER and name of '&' is not a
-meaningful combination currently but could
+(SvFAKE and name of '&' is not a meaningful combination currently but could
 become so if C<my sub foo {}> is implemented.)
 
-Note that formats are treated as anon subs, and are cloned each time
-write is called (if necessary).
-
-The flag SVs_PADSTALE is cleared on lexicals each time the my() is executed,
-and set on scope exit.  This allows the
-'Variable $x is not available' warning
-to be generated in evals, such as 
-
-    { my $x = 1; sub f { eval '$x'} } f();
-
-For state vars, SVs_PADSTALE is overloaded to mean 'not yet initialised'.
-
-=for apidoc AmxU|PADNAMELIST *|PL_comppad_name
-
-During compilation, this points to the array containing the names part
-of the pad for the currently-compiling code.
-
-=for apidoc AmxU|PAD *|PL_comppad
-
-During compilation, this points to the array containing the values
-part of the pad for the currently-compiling code.  (At runtime a CV may
-have many such value arrays; at compile time just one is constructed.)
-At runtime, this points to the array containing the currently-relevant
-values for the pad for the currently-executing code.
-
-=for apidoc AmxU|SV **|PL_curpad
-
-Points directly to the body of the L</PL_comppad> array.
-(I.e., this is C<PAD_ARRAY(PL_comppad)>.)
-
 =cut
 */
 
@@ -141,90 +90,21 @@ Points directly to the body of the L</PL_comppad> array.
 #include "EXTERN.h"
 #define PERL_IN_PAD_C
 #include "perl.h"
-#include "keywords.h"
 
-#define COP_SEQ_RANGE_LOW_set(sv,val)		\
-  STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xlow = (val); } STMT_END
-#define COP_SEQ_RANGE_HIGH_set(sv,val)		\
-  STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xhigh = (val); } STMT_END
 
-#define PARENT_PAD_INDEX_set(sv,val)		\
-  STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xlow = (val); } STMT_END
-#define PARENT_FAKELEX_FLAGS_set(sv,val)	\
-  STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xhigh = (val); } STMT_END
+#define PAD_MAX 999999999
 
-/*
-=for apidoc mx|void|pad_peg|const char *s
-
-When PERL_MAD is enabled, this is a small no-op function that gets called
-at the start of each pad-related function.  It can be breakpointed to
-track all pad operations.  The parameter is a string indicating the type
-of pad operation being performed.
-
-=cut
-*/
-
-#ifdef PERL_MAD
-void pad_peg(const char* s) {
-    static int pegcnt; /* XXX not threadsafe */
-    PERL_UNUSED_ARG(s);
 
-    PERL_ARGS_ASSERT_PAD_PEG;
-
-    pegcnt++;
-}
-#endif
 
 /*
-This is basically sv_eq_flags() in sv.c, but we avoid the magic
-and bytes checking.
-*/
-
-static bool
-sv_eq_pvn_flags(pTHX_ const SV *sv, const char* pv, const STRLEN pvlen, const U32 flags) {
-    if ( (SvUTF8(sv) & SVf_UTF8 ) != (flags & SVf_UTF8) ) {
-        const char *pv1 = SvPVX_const(sv);
-        STRLEN cur1     = SvCUR(sv);
-        const char *pv2 = pv;
-        STRLEN cur2     = pvlen;
-	if (PL_encoding) {
-              SV* svrecode = NULL;
-	      if (SvUTF8(sv)) {
-		   svrecode = newSVpvn(pv2, cur2);
-		   sv_recode_to_utf8(svrecode, PL_encoding);
-		   pv2      = SvPV_const(svrecode, cur2);
-	      }
-	      else {
-		   svrecode = newSVpvn(pv1, cur1);
-		   sv_recode_to_utf8(svrecode, PL_encoding);
-		   pv1      = SvPV_const(svrecode, cur1);
-	      }
-              SvREFCNT_dec_NN(svrecode);
-        }
-        if (flags & SVf_UTF8)
-            return (bytes_cmp_utf8(
-                        (const U8*)pv1, cur1,
-		        (const U8*)pv2, cur2) == 0);
-        else
-            return (bytes_cmp_utf8(
-                        (const U8*)pv2, cur2,
-		        (const U8*)pv1, cur1) == 0);
-    }
-    else
-        return ((SvPVX_const(sv) == pv)
-                    || memEQ(SvPVX_const(sv), pv, pvlen));
-}
+=for apidoc pad_new
 
-
-/*
-=for apidoc Am|PADLIST *|pad_new|int flags
-
-Create a new padlist, updating the global variables for the
-currently-compiling padlist to point to the new padlist.  The following
-flags can be OR'ed together:
+Create a new compiling padlist, saving and updating the various global
+vars at the same time as creating the pad itself. The following flags
+can be OR'ed together:
 
     padnew_CLONE	this pad is for a cloned CV
-    padnew_SAVE		save old globals on the save stack
+    padnew_SAVE		save old globals
     padnew_SAVESUB	also save extra stuff for start of sub
 
 =cut
@@ -233,10 +113,7 @@ flags can be OR'ed together:
 PADLIST *
 Perl_pad_new(pTHX_ int flags)
 {
-    dVAR;
-    PADLIST *padlist;
-    PAD *padname, *pad;
-    PAD **ary;
+    AV *padlist, *padname, *pad, *a0;
 
     ASSERT_CURPAD_LEGAL("pad_new");
 
@@ -250,15 +127,14 @@ Perl_pad_new(pTHX_ int flags)
 
     if (flags & padnew_SAVE) {
 	SAVECOMPPAD();
+	SAVESPTR(PL_comppad_name);
 	if (! (flags & padnew_CLONE)) {
-	    SAVESPTR(PL_comppad_name);
 	    SAVEI32(PL_padix);
 	    SAVEI32(PL_comppad_name_fill);
 	    SAVEI32(PL_min_intro_pending);
 	    SAVEI32(PL_max_intro_pending);
-	    SAVEBOOL(PL_cv_has_eval);
 	    if (flags & padnew_SAVESUB) {
-		SAVEBOOL(PL_pad_reset_pending);
+		SAVEI32(PL_pad_reset_pending);
 	    }
 	}
     }
@@ -267,7 +143,8 @@ Perl_pad_new(pTHX_ int flags)
 
     /* ... create new pad ... */
 
-    Newxz(padlist, 1, PADLIST);
+    padlist	= newAV();
+    padname	= newAV();
     pad		= newAV();
 
     if (flags & padnew_CLONE) {
@@ -276,46 +153,42 @@ Perl_pad_new(pTHX_ int flags)
 	 * dispensed with eventually ???
 	 */
 
-        AV * const a0 = newAV();			/* will be @_ */
-	av_store(pad, 0, MUTABLE_SV(a0));
-	AvREIFY_only(a0);
-
-	padname = (PAD *)SvREFCNT_inc_simple_NN(PL_comppad_name);
+	a0 = newAV();			/* will be @_ */
+	av_extend(a0, 0);
+	av_store(pad, 0, (SV*)a0);
+	AvFLAGS(a0) = AVf_REIFY;
     }
     else {
-	av_store(pad, 0, NULL);
-	padname = newAV();
-	AvPAD_NAMELIST_on(padname);
-	av_store(padname, 0, &PL_sv_undef);
+#ifdef USE_5005THREADS
+	av_store(padname, 0, newSVpvn("@_", 2));
+	a0 = newAV();
+	SvPADMY_on((SV*)a0);		/* XXX Needed? */
+	av_store(pad, 0, (SV*)a0);
+#else
+	av_store(pad, 0, Nullsv);
+#endif /* USE_THREADS */
     }
 
-    /* Most subroutines never recurse, hence only need 2 entries in the padlist
-       array - names, and depth=1.  The default for av_store() is to allocate
-       0..3, and even an explicit call to av_extend() with <3 will be rounded
-       up, so we inline the allocation of the array here.  */
-    Newx(ary, 2, PAD *);
-    PadlistMAX(padlist) = 1;
-    PadlistARRAY(padlist) = ary;
-    ary[0] = padname;
-    ary[1] = pad;
+    AvREAL_off(padlist);
+    av_store(padlist, 0, (SV*)padname);
+    av_store(padlist, 1, (SV*)pad);
 
     /* ... then update state variables */
 
-    PL_comppad		= pad;
-    PL_curpad		= AvARRAY(pad);
+    PL_comppad_name	= (AV*)(*av_fetch(padlist, 0, FALSE));
+    PL_comppad		= (AV*)(*av_fetch(padlist, 1, FALSE));
+    PL_curpad		= AvARRAY(PL_comppad);
 
     if (! (flags & padnew_CLONE)) {
-	PL_comppad_name	     = padname;
 	PL_comppad_name_fill = 0;
 	PL_min_intro_pending = 0;
 	PL_padix	     = 0;
-	PL_cv_has_eval	     = 0;
     }
 
     DEBUG_X(PerlIO_printf(Perl_debug_log,
-	  "Pad 0x%"UVxf"[0x%"UVxf"] new:       compcv=0x%"UVxf
+	  "Pad 0x%"UVxf"[0x%"UVxf"] new:       padlist=0x%"UVxf
 	      " name=0x%"UVxf" flags=0x%"UVxf"\n",
-	  PTR2UV(PL_comppad), PTR2UV(PL_curpad), PTR2UV(PL_compcv),
+	  PTR2UV(PL_comppad), PTR2UV(PL_curpad), PTR2UV(padlist),
 	      PTR2UV(padname), (UV)flags
 	)
     );
@@ -323,411 +196,182 @@ Perl_pad_new(pTHX_ int flags)
     return (PADLIST*)padlist;
 }
 
-
 /*
-=head1 Embedding Functions
+=for apidoc pad_undef
 
-=for apidoc cv_undef
+Free the padlist associated with a CV.
+If parts of it happen to be current, we null the relevant
+PL_*pad* global vars so that we don't have any dangling references left.
+We also repoint the CvOUTSIDE of any about-to-be-orphaned
+inner subs to the outer of this cv.
 
-Clear out all the active components of a CV.  This can happen either
-by an explicit C<undef &foo>, or by the reference count going to zero.
-In the former case, we keep the CvOUTSIDE pointer, so that any anonymous
-children can still follow the full lexical scope chain.
+(This function should really be called pad_free, but the name was already
+taken)
 
 =cut
 */
 
 void
-Perl_cv_undef(pTHX_ CV *cv)
+Perl_pad_undef(pTHX_ CV* cv)
 {
-    dVAR;
-    const PADLIST *padlist = CvPADLIST(cv);
-    bool const slabbed = !!CvSLABBED(cv);
+    I32 ix;
+    PADLIST *padlist = CvPADLIST(cv);
 
-    PERL_ARGS_ASSERT_CV_UNDEF;
+    if (!padlist)
+	return;
+    if (!SvREFCNT(CvPADLIST(cv))) /* may be during global destruction */
+	return;
 
     DEBUG_X(PerlIO_printf(Perl_debug_log,
-	  "CV undef: cv=0x%"UVxf" comppad=0x%"UVxf"\n",
-	    PTR2UV(cv), PTR2UV(PL_comppad))
+	  "Pad undef: padlist=0x%"UVxf"\n" , PTR2UV(padlist))
     );
 
-    if (CvFILE(cv) && CvDYNFILE(cv)) {
-	Safefree(CvFILE(cv));
-    }
-    CvFILE(cv) = NULL;
-
-    CvSLABBED_off(cv);
-    if (!CvISXSUB(cv) && CvROOT(cv)) {
-	if (SvTYPE(cv) == SVt_PVCV && CvDEPTH(cv))
-	    Perl_croak(aTHX_ "Can't undef active subroutine");
-	ENTER;
-
-	PAD_SAVE_SETNULLPAD();
-
-	if (slabbed) OpslabREFCNT_dec_padok(OpSLAB(CvROOT(cv)));
-	op_free(CvROOT(cv));
-	CvROOT(cv) = NULL;
-	CvSTART(cv) = NULL;
-	LEAVE;
-    }
-    else if (slabbed && CvSTART(cv)) {
-	ENTER;
-	PAD_SAVE_SETNULLPAD();
-
-	/* discard any leaked ops */
-	if (PL_parser)
-	    parser_free_nexttoke_ops(PL_parser, (OPSLAB *)CvSTART(cv));
-	opslab_force_free((OPSLAB *)CvSTART(cv));
-	CvSTART(cv) = NULL;
-
-	LEAVE;
-    }
-#ifdef DEBUGGING
-    else if (slabbed) Perl_warn(aTHX_ "Slab leaked from cv %p", cv);
-#endif
-    SvPOK_off(MUTABLE_SV(cv));		/* forget prototype */
-    sv_unmagic((SV *)cv, PERL_MAGIC_checkcall);
-    if (CvNAMED(cv)) CvNAME_HEK_set(cv, NULL);
-    else	     CvGV_set(cv, NULL);
-
-    /* This statement and the subsequence if block was pad_undef().  */
-    pad_peg("pad_undef");
-
-    if (padlist) {
-	I32 ix;
-
-	/* Free the padlist associated with a CV.
-	   If parts of it happen to be current, we null the relevant PL_*pad*
-	   global vars so that we don't have any dangling references left.
-	   We also repoint the CvOUTSIDE of any about-to-be-orphaned inner
-	   subs to the outer of this cv.  */
-
-	DEBUG_X(PerlIO_printf(Perl_debug_log,
-			      "Pad undef: cv=0x%"UVxf" padlist=0x%"UVxf" comppad=0x%"UVxf"\n",
-			      PTR2UV(cv), PTR2UV(padlist), PTR2UV(PL_comppad))
-		);
-
-	/* detach any '&' anon children in the pad; if afterwards they
-	 * are still live, fix up their CvOUTSIDEs to point to our outside,
-	 * bypassing us. */
-	/* XXX DAPM for efficiency, we should only do this if we know we have
-	 * children, or integrate this loop with general cleanup */
-
-	if (PL_phase != PERL_PHASE_DESTRUCT) { /* don't bother during global destruction */
-	    CV * const outercv = CvOUTSIDE(cv);
-	    const U32 seq = CvOUTSIDE_SEQ(cv);
-	    PAD * const comppad_name = PadlistARRAY(padlist)[0];
-	    SV ** const namepad = AvARRAY(comppad_name);
-	    PAD * const comppad = PadlistARRAY(padlist)[1];
-	    SV ** const curpad = AvARRAY(comppad);
-	    for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
-		SV * const namesv = namepad[ix];
-		if (namesv && namesv != &PL_sv_undef
-		    && *SvPVX_const(namesv) == '&')
-		    {
-			CV * const innercv = MUTABLE_CV(curpad[ix]);
-			U32 inner_rc = SvREFCNT(innercv);
-			assert(inner_rc);
-			assert(SvTYPE(innercv) != SVt_PVFM);
-
-			if (SvREFCNT(comppad) < 2) { /* allow for /(?{ sub{} })/  */
-			    curpad[ix] = NULL;
-			    SvREFCNT_dec_NN(innercv);
-			    inner_rc--;
-			}
-
-			/* in use, not just a prototype */
-			if (inner_rc && (CvOUTSIDE(innercv) == cv)) {
-			    assert(CvWEAKOUTSIDE(innercv));
-			    /* don't relink to grandfather if he's being freed */
-			    if (outercv && SvREFCNT(outercv)) {
-				CvWEAKOUTSIDE_off(innercv);
-				CvOUTSIDE(innercv) = outercv;
-				CvOUTSIDE_SEQ(innercv) = seq;
-				SvREFCNT_inc_simple_void_NN(outercv);
-			    }
-			    else {
-				CvOUTSIDE(innercv) = NULL;
-			    }
-			}
+    /* detach any '&' anon children in the pad; if afterwards they
+     * are still live, fix up their CvOUTSIDEs to point to our outside,
+     * bypassing us. */
+    /* XXX DAPM for efficiency, we should only do this if we know we have
+     * children, or integrate this loop with general cleanup */
+
+    if (!PL_dirty) { /* don't bother during global destruction */
+	CV *outercv = CvOUTSIDE(cv);
+	U32 seq = CvOUTSIDE_SEQ(cv);
+	AV *comppad_name = (AV*)AvARRAY(padlist)[0];
+	SV **namepad = AvARRAY(comppad_name);
+	AV *comppad = (AV*)AvARRAY(padlist)[1];
+	SV **curpad = AvARRAY(comppad);
+	for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
+	    SV *namesv = namepad[ix];
+	    if (namesv && namesv != &PL_sv_undef
+		&& *SvPVX(namesv) == '&')
+	    {
+		CV *innercv = (CV*)curpad[ix];
+		namepad[ix] = Nullsv;
+		SvREFCNT_dec(namesv);
+		curpad[ix] = Nullsv;
+		SvREFCNT_dec(innercv);
+		if (SvREFCNT(innercv) /* in use, not just a prototype */
+		    && CvOUTSIDE(innercv) == cv)
+		{
+		    assert(CvWEAKOUTSIDE(innercv));
+		    /* don't relink to grandfather if he's being freed */
+		    if (outercv && SvREFCNT(outercv)) {
+			CvWEAKOUTSIDE_off(innercv);
+			CvOUTSIDE(innercv) = outercv;
+			CvOUTSIDE_SEQ(innercv) = seq;
+			SvREFCNT_inc(outercv);
+		    }
+		    else {
+			CvOUTSIDE(innercv) = Nullcv;
 		    }
-	    }
-	}
 
-	ix = PadlistMAX(padlist);
-	while (ix > 0) {
-	    PAD * const sv = PadlistARRAY(padlist)[ix--];
-	    if (sv) {
-		if (sv == PL_comppad) {
-		    PL_comppad = NULL;
-		    PL_curpad = NULL;
 		}
-		SvREFCNT_dec_NN(sv);
+
 	    }
 	}
-	{
-	    PAD * const sv = PadlistARRAY(padlist)[0];
-	    if (sv == PL_comppad_name && SvREFCNT(sv) == 1)
-		PL_comppad_name = NULL;
-	    SvREFCNT_dec(sv);
-	}
-	if (PadlistARRAY(padlist)) Safefree(PadlistARRAY(padlist));
-	Safefree(padlist);
-	CvPADLIST(cv) = NULL;
     }
 
-
-    /* remove CvOUTSIDE unless this is an undef rather than a free */
-    if (!SvREFCNT(cv) && CvOUTSIDE(cv)) {
-	if (!CvWEAKOUTSIDE(cv))
-	    SvREFCNT_dec(CvOUTSIDE(cv));
-	CvOUTSIDE(cv) = NULL;
-    }
-    if (CvCONST(cv)) {
-	SvREFCNT_dec(MUTABLE_SV(CvXSUBANY(cv).any_ptr));
-	CvCONST_off(cv);
-    }
-    if (CvISXSUB(cv) && CvXSUB(cv)) {
-	CvXSUB(cv) = NULL;
+    ix = AvFILLp(padlist);
+    while (ix >= 0) {
+	SV* sv = AvARRAY(padlist)[ix--];
+	if (!sv)
+	    continue;
+	if (sv == (SV*)PL_comppad_name)
+	    PL_comppad_name = Nullav;
+	else if (sv == (SV*)PL_comppad) {
+	    PL_comppad = Null(PAD*);
+	    PL_curpad = Null(SV**);
+	}
+	SvREFCNT_dec(sv);
     }
-    /* delete all flags except WEAKOUTSIDE and CVGV_RC, which indicate the
-     * ref status of CvOUTSIDE and CvGV, and ANON, which pp_entersub uses
-     * to choose an error message */
-    CvFLAGS(cv) &= (CVf_WEAKOUTSIDE|CVf_CVGV_RC|CVf_ANON);
+    SvREFCNT_dec((SV*)CvPADLIST(cv));
+    CvPADLIST(cv) = Null(PADLIST*);
 }
 
-/*
-=for apidoc cv_forget_slab
-
-When a CV has a reference count on its slab (CvSLABBED), it is responsible
-for making sure it is freed.  (Hence, no two CVs should ever have a
-reference count on the same slab.)  The CV only needs to reference the slab
-during compilation.  Once it is compiled and CvROOT attached, it has
-finished its job, so it can forget the slab.
-
-=cut
-*/
-
-void
-Perl_cv_forget_slab(pTHX_ CV *cv)
-{
-    const bool slabbed = !!CvSLABBED(cv);
-    OPSLAB *slab = NULL;
-
-    PERL_ARGS_ASSERT_CV_FORGET_SLAB;
 
-    if (!slabbed) return;
 
-    CvSLABBED_off(cv);
 
-    if      (CvROOT(cv))  slab = OpSLAB(CvROOT(cv));
-    else if (CvSTART(cv)) slab = (OPSLAB *)CvSTART(cv);
-#ifdef DEBUGGING
-    else if (slabbed)     Perl_warn(aTHX_ "Slab leaked from cv %p", cv);
-#endif
+/*
+=for apidoc pad_add_name
 
-    if (slab) {
-#ifdef PERL_DEBUG_READONLY_OPS
-	const size_t refcnt = slab->opslab_refcnt;
-#endif
-	OpslabREFCNT_dec(slab);
-#ifdef PERL_DEBUG_READONLY_OPS
-	if (refcnt > 1) Slab_to_ro(slab);
-#endif
-    }
-}
+Create a new name in the current pad at the specified offset.
+If C<typestash> is valid, the name is for a typed lexical; set the
+name's stash to that value.
+If C<ourstash> is valid, it's an our lexical, set the name's
+GvSTASH to that value
 
-/*
-=for apidoc m|PADOFFSET|pad_alloc_name|SV *namesv|U32 flags|HV *typestash|HV *ourstash
+Also, if the name is @.. or %.., create a new array or hash for that slot
 
-Allocates a place in the currently-compiling
-pad (via L<perlapi/pad_alloc>) and
-then stores a name for that entry.  I<namesv> is adopted and becomes the
-name entry; it must already contain the name string and be sufficiently
-upgraded.  I<typestash> and I<ourstash> and the C<padadd_STATE> flag get
-added to I<namesv>.  None of the other
-processing of L<perlapi/pad_add_name_pvn>
-is done.  Returns the offset of the allocated pad slot.
+If fake, it means we're cloning an existing entry
 
 =cut
 */
 
-static PADOFFSET
-S_pad_alloc_name(pTHX_ SV *namesv, U32 flags, HV *typestash, HV *ourstash)
-{
-    dVAR;
-    const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
-
-    PERL_ARGS_ASSERT_PAD_ALLOC_NAME;
-
-    ASSERT_CURPAD_ACTIVE("pad_alloc_name");
-
-    if (typestash) {
-	assert(SvTYPE(namesv) == SVt_PVMG);
-	SvPAD_TYPED_on(namesv);
-	SvSTASH_set(namesv, MUTABLE_HV(SvREFCNT_inc_simple_NN(MUTABLE_SV(typestash))));
-    }
-    if (ourstash) {
-	SvPAD_OUR_on(namesv);
-	SvOURSTASH_set(namesv, ourstash);
-	SvREFCNT_inc_simple_void_NN(ourstash);
-    }
-    else if (flags & padadd_STATE) {
-	SvPAD_STATE_on(namesv);
-    }
-
-    av_store(PL_comppad_name, offset, namesv);
-    PadnamelistMAXNAMED(PL_comppad_name) = offset;
-    return offset;
-}
-
 /*
-=for apidoc Am|PADOFFSET|pad_add_name_pvn|const char *namepv|STRLEN namelen|U32 flags|HV *typestash|HV *ourstash
-
-Allocates a place in the currently-compiling pad for a named lexical
-variable.  Stores the name and other metadata in the name part of the
-pad, and makes preparations to manage the variable's lexical scoping.
-Returns the offset of the allocated pad slot.
-
-I<namepv>/I<namelen> specify the variable's name, including leading sigil.
-If I<typestash> is non-null, the name is for a typed lexical, and this
-identifies the type.  If I<ourstash> is non-null, it's a lexical reference
-to a package variable, and this identifies the package.  The following
-flags can be OR'ed together:
-
-    padadd_OUR          redundantly specifies if it's a package var
-    padadd_STATE        variable will retain value persistently
-    padadd_NO_DUP_CHECK skip check for lexical shadowing
-
-=cut
-*/
+ * XXX DAPM this doesn't seem the right place to create a new array/hash.
+ * Whatever we do, we should be consistent - create scalars too, and
+ * create even if fake. Really need to integrate better the whole entry
+ * creation business - when + where does the name and value get created?
+ */
 
 PADOFFSET
-Perl_pad_add_name_pvn(pTHX_ const char *namepv, STRLEN namelen,
-		U32 flags, HV *typestash, HV *ourstash)
+Perl_pad_add_name(pTHX_ char *name, HV* typestash, HV* ourstash, bool fake)
 {
-    dVAR;
-    PADOFFSET offset;
-    SV *namesv;
-    bool is_utf8;
+    PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
+    SV* namesv = NEWSV(1102, 0);
 
-    PERL_ARGS_ASSERT_PAD_ADD_NAME_PVN;
+    ASSERT_CURPAD_ACTIVE("pad_add_name");
 
-    if (flags & ~(padadd_OUR|padadd_STATE|padadd_NO_DUP_CHECK|padadd_UTF8_NAME))
-	Perl_croak(aTHX_ "panic: pad_add_name_pvn illegal flag bits 0x%" UVxf,
-		   (UV)flags);
 
-    namesv = newSV_type((ourstash || typestash) ? SVt_PVMG : SVt_PVNV);
-    
-    if ((is_utf8 = ((flags & padadd_UTF8_NAME) != 0))) {
-        namepv = (const char*)bytes_from_utf8((U8*)namepv, &namelen, &is_utf8);
-    }
+    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+	  "Pad addname: %ld \"%s\"%s\n",
+	   (long)offset, name, (fake ? " FAKE" : "")
+	  )
+    );
 
-    sv_setpvn(namesv, namepv, namelen);
+    sv_upgrade(namesv, ourstash ? SVt_PVGV : typestash ? SVt_PVMG : SVt_PVNV);
+    sv_setpv(namesv, name);
 
-    if (is_utf8) {
-        flags |= padadd_UTF8_NAME;
-        SvUTF8_on(namesv);
+    if (typestash) {
+	SvFLAGS(namesv) |= SVpad_TYPED;
+	SvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*) typestash);
     }
-    else
-        flags &= ~padadd_UTF8_NAME;
-
-    if ((flags & padadd_NO_DUP_CHECK) == 0) {
-	ENTER;
-	SAVEFREESV(namesv); /* in case of fatal warnings */
-	/* check for duplicate declaration */
-	pad_check_dup(namesv, flags & padadd_OUR, ourstash);
-	SvREFCNT_inc_simple_void_NN(namesv);
-	LEAVE;
+    if (ourstash) {
+	SvFLAGS(namesv) |= SVpad_OUR;
+	GvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*) ourstash);
     }
 
-    offset = pad_alloc_name(namesv, flags & ~padadd_UTF8_NAME, typestash, ourstash);
-
-    /* not yet introduced */
-    COP_SEQ_RANGE_LOW_set(namesv, PERL_PADSEQ_INTRO);
-    COP_SEQ_RANGE_HIGH_set(namesv, 0);
-
-    if (!PL_min_intro_pending)
-	PL_min_intro_pending = offset;
-    PL_max_intro_pending = offset;
-    /* if it's not a simple scalar, replace with an AV or HV */
-    assert(SvTYPE(PL_curpad[offset]) == SVt_NULL);
-    assert(SvREFCNT(PL_curpad[offset]) == 1);
-    if (namelen != 0 && *namepv == '@')
-	sv_upgrade(PL_curpad[offset], SVt_PVAV);
-    else if (namelen != 0 && *namepv == '%')
-	sv_upgrade(PL_curpad[offset], SVt_PVHV);
-    else if (namelen != 0 && *namepv == '&')
-	sv_upgrade(PL_curpad[offset], SVt_PVCV);
-    assert(SvPADMY(PL_curpad[offset]));
-    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
-			   "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
-			   (long)offset, SvPVX(namesv),
-			   PTR2UV(PL_curpad[offset])));
+    av_store(PL_comppad_name, offset, namesv);
+    if (fake)
+	SvFAKE_on(namesv);
+    else {
+	/* not yet introduced */
+	SvNVX(namesv) = (NV)PAD_MAX;	/* min */
+	SvIVX(namesv) = 0;		/* max */
+
+	if (!PL_min_intro_pending)
+	    PL_min_intro_pending = offset;
+	PL_max_intro_pending = offset;
+	/* XXX DAPM since slot has been allocated, replace
+	 * av_store with PL_curpad[offset] ? */
+	if (*name == '@')
+	    av_store(PL_comppad, offset, (SV*)newAV());
+	else if (*name == '%')
+	    av_store(PL_comppad, offset, (SV*)newHV());
+	SvPADMY_on(PL_curpad[offset]);
+    }
 
     return offset;
 }
 
-/*
-=for apidoc Am|PADOFFSET|pad_add_name_pv|const char *name|U32 flags|HV *typestash|HV *ourstash
 
-Exactly like L</pad_add_name_pvn>, but takes a nul-terminated string
-instead of a string/length pair.
 
-=cut
-*/
-
-PADOFFSET
-Perl_pad_add_name_pv(pTHX_ const char *name,
-		     const U32 flags, HV *typestash, HV *ourstash)
-{
-    PERL_ARGS_ASSERT_PAD_ADD_NAME_PV;
-    return pad_add_name_pvn(name, strlen(name), flags, typestash, ourstash);
-}
 
 /*
-=for apidoc Am|PADOFFSET|pad_add_name_sv|SV *name|U32 flags|HV *typestash|HV *ourstash
-
-Exactly like L</pad_add_name_pvn>, but takes the name string in the form
-of an SV instead of a string/length pair.
-
-=cut
-*/
-
-PADOFFSET
-Perl_pad_add_name_sv(pTHX_ SV *name, U32 flags, HV *typestash, HV *ourstash)
-{
-    char *namepv;
-    STRLEN namelen;
-    PERL_ARGS_ASSERT_PAD_ADD_NAME_SV;
-    namepv = SvPV(name, namelen);
-    if (SvUTF8(name))
-        flags |= padadd_UTF8_NAME;
-    return pad_add_name_pvn(namepv, namelen, flags, typestash, ourstash);
-}
-
-/*
-=for apidoc Amx|PADOFFSET|pad_alloc|I32 optype|U32 tmptype
-
-Allocates a place in the currently-compiling pad,
-returning the offset of the allocated pad slot.
-No name is initially attached to the pad slot.
-I<tmptype> is a set of flags indicating the kind of pad entry required,
-which will be set in the value SV for the allocated pad entry:
-
-    SVs_PADMY    named lexical variable ("my", "our", "state")
-    SVs_PADTMP   unnamed temporary store
-    SVf_READONLY constant shared between recursion levels
-
-C<SVf_READONLY> has been supported here only since perl 5.20.  To work with
-earlier versions as well, use C<SVf_READONLY|SVs_PADTMP>.  C<SVf_READONLY>
-does not cause the SV in the pad slot to be marked read-only, but simply
-tells C<pad_alloc> that it I<will> be made read-only (by the caller), or at
-least should be treated as such.
+=for apidoc pad_alloc
 
-I<optype> should be an opcode indicating the type of operation that the
-pad entry is to support.  This doesn't affect operational semantics,
-but is used for debugging.
+Allocate a new my or tmp pad entry. For a my, simply push a null SV onto
+the end of PL_comppad, but for a tmp, scan the pad from PL_padix upwards
+for a slot which has no name and and no active value.
 
 =cut
 */
@@ -735,52 +379,43 @@ but is used for debugging.
 /* XXX DAPM integrate alloc(), add_name() and add_anon(),
  * or at least rationalise ??? */
 
+
 PADOFFSET
 Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
 {
-    dVAR;
     SV *sv;
     I32 retval;
 
-    PERL_UNUSED_ARG(optype);
     ASSERT_CURPAD_ACTIVE("pad_alloc");
 
     if (AvARRAY(PL_comppad) != PL_curpad)
-	Perl_croak(aTHX_ "panic: pad_alloc, %p!=%p",
-		   AvARRAY(PL_comppad), PL_curpad);
+	Perl_croak(aTHX_ "panic: pad_alloc");
     if (PL_pad_reset_pending)
 	pad_reset();
     if (tmptype & SVs_PADMY) {
-	/* For a my, simply push a null SV onto the end of PL_comppad. */
-	sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE);
+	do {
+	    sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE);
+	} while (SvPADBUSY(sv));		/* need a fresh one */
 	retval = AvFILLp(PL_comppad);
     }
     else {
-	/* For a tmp, scan the pad from PL_padix upwards
-	 * for a slot which has no name and no active value.
-	 */
-	SV * const * const names = AvARRAY(PL_comppad_name);
-        const SSize_t names_fill = AvFILLp(PL_comppad_name);
+	SV **names = AvARRAY(PL_comppad_name);
+	SSize_t names_fill = AvFILLp(PL_comppad_name);
 	for (;;) {
 	    /*
-	     * Entries that close over unavailable variables
-	     * in outer subs contain values not marked PADMY.
-	     * Thus we must skip, not just pad values that are
+	     * "foreach" index vars temporarily become aliases to non-"my"
+	     * values.  Thus we must skip, not just pad values that are
 	     * marked as current pad values, but also those with names.
 	     */
+	    /* HVDS why copy to sv here? we don't seem to use it */
 	    if (++PL_padix <= names_fill &&
 		   (sv = names[PL_padix]) && sv != &PL_sv_undef)
 		continue;
 	    sv = *av_fetch(PL_comppad, PL_padix, TRUE);
 	    if (!(SvFLAGS(sv) & (SVs_PADTMP | SVs_PADMY)) &&
-		!IS_PADGV(sv))
+		!IS_PADGV(sv) && !IS_PADCONST(sv))
 		break;
 	}
-	if (tmptype & SVf_READONLY) {
-	    av_store(PL_comppad_name, PL_padix, &PL_sv_no);
-	    tmptype &= ~SVf_READONLY;
-	    tmptype |= SVs_PADTMP;
-	}
 	retval = PL_padix;
     }
     SvFLAGS(sv) |= tmptype;
@@ -790,98 +425,68 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
 	  "Pad 0x%"UVxf"[0x%"UVxf"] alloc:   %ld for %s\n",
 	  PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long) retval,
 	  PL_op_name[optype]));
-#ifdef DEBUG_LEAKING_SCALARS
-    sv->sv_debug_optype = optype;
-    sv->sv_debug_inpad = 1;
-#endif
     return (PADOFFSET)retval;
 }
 
 /*
-=for apidoc Am|PADOFFSET|pad_add_anon|CV *func|I32 optype
+=for apidoc pad_add_anon
 
-Allocates a place in the currently-compiling pad (via L</pad_alloc>)
-for an anonymous function that is lexically scoped inside the
-currently-compiling function.
-The function I<func> is linked into the pad, and its C<CvOUTSIDE> link
-to the outer scope is weakened to avoid a reference loop.
-
-One reference count is stolen, so you may need to do C<SvREFCNT_inc(func)>.
-
-I<optype> should be an opcode indicating the type of operation that the
-pad entry is to support.  This doesn't affect operational semantics,
-but is used for debugging.
+Add an anon code entry to the current compiling pad
 
 =cut
 */
 
 PADOFFSET
-Perl_pad_add_anon(pTHX_ CV* func, I32 optype)
+Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
 {
-    dVAR;
     PADOFFSET ix;
-    SV* const name = newSV_type(SVt_PVNV);
-
-    PERL_ARGS_ASSERT_PAD_ADD_ANON;
-
-    pad_peg("add_anon");
-    sv_setpvs(name, "&");
-    /* These two aren't used; just make sure they're not equal to
-     * PERL_PADSEQ_INTRO */
-    COP_SEQ_RANGE_LOW_set(name, 0);
-    COP_SEQ_RANGE_HIGH_set(name, 0);
-    ix = pad_alloc(optype, SVs_PADMY);
+    SV* name;
+
+    name = NEWSV(1106, 0);
+    sv_upgrade(name, SVt_PVNV);
+    sv_setpvn(name, "&", 1);
+    SvIVX(name) = -1;
+    SvNVX(name) = 1;
+    ix = pad_alloc(op_type, SVs_PADMY);
     av_store(PL_comppad_name, ix, name);
     /* XXX DAPM use PL_curpad[] ? */
-    if (SvTYPE(func) == SVt_PVCV || !CvOUTSIDE(func))
-	av_store(PL_comppad, ix, (SV*)func);
-    else {
-	SV *rv = newRV_noinc((SV *)func);
-	sv_rvweaken(rv);
-	assert (SvTYPE(func) == SVt_PVFM);
-	av_store(PL_comppad, ix, rv);
-    }
-    SvPADMY_on((SV*)func);
+    av_store(PL_comppad, ix, sv);
+    SvPADMY_on(sv);
 
     /* to avoid ref loops, we never have parent + child referencing each
      * other simultaneously */
-    if (CvOUTSIDE(func) && SvTYPE(func) == SVt_PVCV) {
-	assert(!CvWEAKOUTSIDE(func));
-	CvWEAKOUTSIDE_on(func);
-	SvREFCNT_dec_NN(CvOUTSIDE(func));
+    if (CvOUTSIDE((CV*)sv)) {
+	assert(!CvWEAKOUTSIDE((CV*)sv));
+	CvWEAKOUTSIDE_on((CV*)sv);
+	SvREFCNT_dec(CvOUTSIDE((CV*)sv));
     }
     return ix;
 }
 
+
+
 /*
 =for apidoc pad_check_dup
 
 Check for duplicate declarations: report any of:
-
      * a my in the current scope with the same name;
-     * an our (anywhere in the pad) with the same name and the
-       same stash as C<ourstash>
-
-C<is_our> indicates that the name to check is an 'our' declaration.
+     * an our (anywhere in the pad) with the same name and the same stash
+       as C<ourstash>
+C<is_our> indicates that the name to check is an 'our' declaration
 
 =cut
 */
 
-STATIC void
-S_pad_check_dup(pTHX_ SV *name, U32 flags, const HV *ourstash)
+/* XXX DAPM integrate this into pad_add_name ??? */
+
+void
+Perl_pad_check_dup(pTHX_ char *name, bool is_our, HV *ourstash)
 {
-    dVAR;
-    SV		**svp;
+    SV		**svp, *sv;
     PADOFFSET	top, off;
-    const U32	is_our = flags & padadd_OUR;
-
-    PERL_ARGS_ASSERT_PAD_CHECK_DUP;
 
     ASSERT_CURPAD_ACTIVE("pad_check_dup");
-
-    assert((flags & ~padadd_OUR) == 0);
-
-    if (AvFILLp(PL_comppad_name) < 0 || !ckWARN(WARN_MISC))
+    if (!ckWARN(WARN_MISC) || AvFILLp(PL_comppad_name) < 0)
 	return; /* nothing to check */
 
     svp = AvARRAY(PL_comppad_name);
@@ -890,556 +495,331 @@ S_pad_check_dup(pTHX_ SV *name, U32 flags, const HV *ourstash)
     /* XXX DAPM - why the (I32) cast - shouldn't we ensure they're the same
      * type ? */
     for (off = top; (I32)off > PL_comppad_name_floor; off--) {
-	SV * const sv = svp[off];
-	if (sv
-	    && PadnameLEN(sv)
+	if ((sv = svp[off])
+	    && sv != &PL_sv_undef
 	    && !SvFAKE(sv)
-	    && (   COP_SEQ_RANGE_LOW(sv)  == PERL_PADSEQ_INTRO
-		|| COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
-	    && sv_eq(name, sv))
+	    && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
+	    && (!is_our
+		|| ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash))
+	    && strEQ(name, SvPVX(sv)))
 	{
-	    if (is_our && (SvPAD_OUR(sv)))
-		break; /* "our" masking "our" */
-	    /* diag_listed_as: "%s" variable %s masks earlier declaration in same %s */
 	    Perl_warner(aTHX_ packWARN(WARN_MISC),
-		"\"%s\" %s %"SVf" masks earlier declaration in same %s",
-		(is_our ? "our" : PL_parser->in_my == KEY_my ? "my" : "state"),
-		*SvPVX(sv) == '&' ? "subroutine" : "variable",
-		sv,
-		(COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO
-		    ? "scope" : "statement"));
+		"\"%s\" variable %s masks earlier declaration in same %s",
+		(is_our ? "our" : "my"),
+		name,
+		(SvIVX(sv) == PAD_MAX ? "scope" : "statement"));
 	    --off;
 	    break;
 	}
     }
     /* check the rest of the pad */
     if (is_our) {
-	while (off > 0) {
-	    SV * const sv = svp[off];
-	    if (sv
-		&& PadnameLEN(sv)
+	do {
+	    if ((sv = svp[off])
+		&& sv != &PL_sv_undef
 		&& !SvFAKE(sv)
-		&& (   COP_SEQ_RANGE_LOW(sv)  == PERL_PADSEQ_INTRO
-		    || COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
-		&& SvOURSTASH(sv) == ourstash
-		&& sv_eq(name, sv))
+		&& (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
+		&& ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash)
+		&& strEQ(name, SvPVX(sv)))
 	    {
 		Perl_warner(aTHX_ packWARN(WARN_MISC),
-		    "\"our\" variable %"SVf" redeclared", sv);
-		if ((I32)off <= PL_comppad_name_floor)
-		    Perl_warner(aTHX_ packWARN(WARN_MISC),
-			"\t(Did you mean \"local\" instead of \"our\"?)\n");
+		    "\"our\" variable %s redeclared", name);
+		Perl_warner(aTHX_ packWARN(WARN_MISC),
+		    "\t(Did you mean \"local\" instead of \"our\"?)\n");
 		break;
 	    }
-	    --off;
-	}
+	} while ( off-- > 0 );
     }
 }
 
 
-/*
-=for apidoc Am|PADOFFSET|pad_findmy_pvn|const char *namepv|STRLEN namelen|U32 flags
-
-Given the name of a lexical variable, find its position in the
-currently-compiling pad.
-I<namepv>/I<namelen> specify the variable's name, including leading sigil.
-I<flags> is reserved and must be zero.
-If it is not in the current pad but appears in the pad of any lexically
-enclosing scope, then a pseudo-entry for it is added in the current pad.
-Returns the offset in the current pad,
-or C<NOT_IN_PAD> if no such lexical is in scope.
-
-=cut
-*/
-
-PADOFFSET
-Perl_pad_findmy_pvn(pTHX_ const char *namepv, STRLEN namelen, U32 flags)
-{
-    dVAR;
-    SV *out_sv;
-    int out_flags;
-    I32 offset;
-    const AV *nameav;
-    SV **name_svp;
-
-    PERL_ARGS_ASSERT_PAD_FINDMY_PVN;
-
-    pad_peg("pad_findmy_pvn");
-
-    if (flags & ~padadd_UTF8_NAME)
-	Perl_croak(aTHX_ "panic: pad_findmy_pvn illegal flag bits 0x%" UVxf,
-		   (UV)flags);
-
-    if (flags & padadd_UTF8_NAME) {
-        bool is_utf8 = TRUE;
-        namepv = (const char*)bytes_from_utf8((U8*)namepv, &namelen, &is_utf8);
-
-        if (is_utf8)
-            flags |= padadd_UTF8_NAME;
-        else
-            flags &= ~padadd_UTF8_NAME;
-    }
-
-    offset = pad_findlex(namepv, namelen, flags,
-                PL_compcv, PL_cop_seqmax, 1, NULL, &out_sv, &out_flags);
-    if ((PADOFFSET)offset != NOT_IN_PAD) 
-	return offset;
-
-    /* look for an our that's being introduced; this allows
-     *    our $foo = 0 unless defined $foo;
-     * to not give a warning. (Yes, this is a hack) */
-
-    nameav = PadlistARRAY(CvPADLIST(PL_compcv))[0];
-    name_svp = AvARRAY(nameav);
-    for (offset = AvFILLp(nameav); offset > 0; offset--) {
-        const SV * const namesv = name_svp[offset];
-	if (namesv && PadnameLEN(namesv) == namelen
-	    && !SvFAKE(namesv)
-	    && (SvPAD_OUR(namesv))
-            && sv_eq_pvn_flags(aTHX_ namesv, namepv, namelen,
-                                flags & padadd_UTF8_NAME ? SVf_UTF8 : 0 )
-	    && COP_SEQ_RANGE_LOW(namesv) == PERL_PADSEQ_INTRO
-	)
-	    return offset;
-    }
-    return NOT_IN_PAD;
-}
 
 /*
-=for apidoc Am|PADOFFSET|pad_findmy_pv|const char *name|U32 flags
+=for apidoc pad_findmy
 
-Exactly like L</pad_findmy_pvn>, but takes a nul-terminated string
-instead of a string/length pair.
+Given a lexical name, try to find its offset, first in the current pad,
+or failing that, in the pads of any lexically enclosing subs (including
+the complications introduced by eval). If the name is found in an outer pad,
+then a fake entry is added to the current pad.
+Returns the offset in the current pad, or NOT_IN_PAD on failure.
 
 =cut
 */
 
 PADOFFSET
-Perl_pad_findmy_pv(pTHX_ const char *name, U32 flags)
+Perl_pad_findmy(pTHX_ char *name)
 {
-    PERL_ARGS_ASSERT_PAD_FINDMY_PV;
-    return pad_findmy_pvn(name, strlen(name), flags);
-}
-
-/*
-=for apidoc Am|PADOFFSET|pad_findmy_sv|SV *name|U32 flags
-
-Exactly like L</pad_findmy_pvn>, but takes the name string in the form
-of an SV instead of a string/length pair.
+    I32 off;
+    I32 fake_off = 0;
+    I32 our_off = 0;
+    SV *sv;
+    SV **svp = AvARRAY(PL_comppad_name);
+    U32 seq = PL_cop_seqmax;
+
+    ASSERT_CURPAD_ACTIVE("pad_findmy");
+    DEBUG_Xv(PerlIO_printf(Perl_debug_log, "Pad findmy:  \"%s\"\n", name));
+
+#ifdef USE_5005THREADS
+    /*
+     * Special case to get lexical (and hence per-thread) @_.
+     * XXX I need to find out how to tell at parse-time whether use
+     * of @_ should refer to a lexical (from a sub) or defgv (global
+     * scope and maybe weird sub-ish things like formats). See
+     * startsub in perly.y.  It's possible that @_ could be lexical
+     * (at least from subs) even in non-threaded perl.
+     */
+    if (strEQ(name, "@_"))
+	return 0;		/* success. (NOT_IN_PAD indicates failure) */
+#endif /* USE_5005THREADS */
+
+    /* The one we're looking for is probably just before comppad_name_fill. */
+    for (off = AvFILLp(PL_comppad_name); off > 0; off--) {
+	sv = svp[off];
+	if (!sv || sv == &PL_sv_undef || !strEQ(SvPVX(sv), name))
+	    continue;
+	if (SvFAKE(sv)) {
+	    /* we'll use this later if we don't find a real entry */
+	    fake_off = off;
+	    continue;
+	}
+	else {
+	    if (   seq >  U_32(SvNVX(sv))	/* min */
+		&& seq <= (U32)SvIVX(sv))	/* max */
+		return off;
+	    else if ((SvFLAGS(sv) & SVpad_OUR)
+		    && U_32(SvNVX(sv)) == PAD_MAX) /* min */
+	    {
+		/* look for an our that's being introduced; this allows
+		 *    our $foo = 0 unless defined $foo;
+		 * to not give a warning. (Yes, this is a hack) */
+		our_off = off;
+	    }
+	}
+    }
+    if (fake_off)
+	return fake_off;
 
-=cut
-*/
+    /* See if it's in a nested scope */
+    off = pad_findlex(name, 0, PL_compcv);
+    if (off)			/* pad_findlex returns 0 for failure...*/
+	return off;
+    if (our_off)
+	return our_off;
+    return NOT_IN_PAD;		/* ...but we return NOT_IN_PAD for failure */
 
-PADOFFSET
-Perl_pad_findmy_sv(pTHX_ SV *name, U32 flags)
-{
-    char *namepv;
-    STRLEN namelen;
-    PERL_ARGS_ASSERT_PAD_FINDMY_SV;
-    namepv = SvPV(name, namelen);
-    if (SvUTF8(name))
-        flags |= padadd_UTF8_NAME;
-    return pad_findmy_pvn(namepv, namelen, flags);
 }
 
-/*
-=for apidoc Amp|PADOFFSET|find_rundefsvoffset
-
-Find the position of the lexical C<$_> in the pad of the
-currently-executing function.  Returns the offset in the current pad,
-or C<NOT_IN_PAD> if there is no lexical C<$_> in scope (in which case
-the global one should be used instead).
-L</find_rundefsv> is likely to be more convenient.
 
-=cut
-*/
-
-PADOFFSET
-Perl_find_rundefsvoffset(pTHX)
-{
-    dVAR;
-    SV *out_sv;
-    int out_flags;
-    return pad_findlex("$_", 2, 0, find_runcv(NULL), PL_curcop->cop_seq, 1,
-	    NULL, &out_sv, &out_flags);
-}
 
 /*
-=for apidoc Am|SV *|find_rundefsv
-
-Find and return the variable that is named C<$_> in the lexical scope
-of the currently-executing function.  This may be a lexical C<$_>,
-or will otherwise be the global one.
-
-=cut
-*/
-
-SV *
-Perl_find_rundefsv(pTHX)
-{
-    SV *namesv;
-    int flags;
-    PADOFFSET po;
-
-    po = pad_findlex("$_", 2, 0, find_runcv(NULL), PL_curcop->cop_seq, 1,
-	    NULL, &namesv, &flags);
+=for apidoc pad_findlex
 
-    if (po == NOT_IN_PAD || SvPAD_OUR(namesv))
-	return DEFSV;
-
-    return PAD_SVl(po);
-}
-
-SV *
-Perl_find_rundefsv2(pTHX_ CV *cv, U32 seq)
-{
-    SV *namesv;
-    int flags;
-    PADOFFSET po;
-
-    PERL_ARGS_ASSERT_FIND_RUNDEFSV2;
-
-    po = pad_findlex("$_", 2, 0, cv, seq, 1,
-	    NULL, &namesv, &flags);
-
-    if (po == NOT_IN_PAD || SvPAD_OUR(namesv))
-	return DEFSV;
-
-    return AvARRAY(PadlistARRAY(CvPADLIST(cv))[CvDEPTH(cv)])[po];
-}
-
-/*
-=for apidoc m|PADOFFSET|pad_findlex|const char *namepv|STRLEN namelen|U32 flags|const CV* cv|U32 seq|int warn|SV** out_capture|SV** out_name_sv|int *out_flags
-
-Find a named lexical anywhere in a chain of nested pads.  Add fake entries
-in the inner pads if it's found in an outer one.
-
-Returns the offset in the bottom pad of the lex or the fake lex.
-cv is the CV in which to start the search, and seq is the current cop_seq
-to match against.  If warn is true, print appropriate warnings.  The out_*
-vars return values, and so are pointers to where the returned values
-should be stored.  out_capture, if non-null, requests that the innermost
-instance of the lexical is captured; out_name_sv is set to the innermost
-matched namesv or fake namesv; out_flags returns the flags normally
-associated with the IVX field of a fake namesv.
-
-Note that pad_findlex() is recursive; it recurses up the chain of CVs,
-then comes back down, adding fake entries
-as it goes.  It has to be this way
-because fake namesvs in anon protoypes have to store in xlow the index into
-the parent pad.
+Find a named lexical anywhere in a chain of nested pads. Add fake entries
+in the inner pads if it's found in an outer one. innercv is the CV *inside*
+the chain of outer CVs to be searched. If newoff is non-null, this is a
+run-time cloning: don't add fake entries, just find the lexical and add a
+ref to it at newoff in the current pad.
 
 =cut
 */
 
-/* the CV has finished being compiled. This is not a sufficient test for
- * all CVs (eg XSUBs), but suffices for the CVs found in a lexical chain */
-#define CvCOMPILED(cv)	CvROOT(cv)
-
-/* the CV does late binding of its lexicals */
-#define CvLATE(cv) (CvANON(cv) || CvCLONE(cv) || SvTYPE(cv) == SVt_PVFM)
-
-static void
-S_unavailable(pTHX_ SV *namesv)
-{
-    /* diag_listed_as: Variable "%s" is not available */
-    Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
-			"%se \"%"SVf"\" is not available",
-			 *SvPVX_const(namesv) == '&'
-					 ? "Subroutin"
-					 : "Variabl",
-			 namesv);
-}
-
 STATIC PADOFFSET
-S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv, U32 seq,
-	int warn, SV** out_capture, SV** out_name_sv, int *out_flags)
+S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, CV* innercv)
 {
-    dVAR;
-    I32 offset, new_offset;
-    SV *new_capture;
-    SV **new_capturep;
-    const PADLIST * const padlist = CvPADLIST(cv);
-    const bool staleok = !!(flags & padadd_STALEOK);
+    CV *cv;
+    I32 off = 0;
+    SV *sv;
+    CV* startcv;
+    U32 seq;
+    I32 depth;
+    AV *oldpad;
+    SV *oldsv;
+    AV *curlist;
 
-    PERL_ARGS_ASSERT_PAD_FINDLEX;
+    ASSERT_CURPAD_ACTIVE("pad_findlex");
+    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+	"Pad findlex: \"%s\" off=%ld startcv=0x%"UVxf"\n",
+	    name, (long)newoff, PTR2UV(innercv))
+    );
 
-    if (flags & ~(padadd_UTF8_NAME|padadd_STALEOK))
-	Perl_croak(aTHX_ "panic: pad_findlex illegal flag bits 0x%" UVxf,
-		   (UV)flags);
-    flags &= ~ padadd_STALEOK; /* one-shot flag */
+    seq = CvOUTSIDE_SEQ(innercv);
+    startcv = CvOUTSIDE(innercv);
 
-    *out_flags = 0;
+    for (cv = startcv; cv; seq = CvOUTSIDE_SEQ(cv), cv = CvOUTSIDE(cv)) {
+	SV **svp;
+	AV *curname;
+	I32 fake_off = 0;
 
-    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
-	"Pad findlex cv=0x%"UVxf" searching \"%.*s\" seq=%d%s\n",
-			   PTR2UV(cv), (int)namelen, namepv, (int)seq,
-	out_capture ? " capturing" : "" ));
-
-    /* first, search this pad */
-
-    if (padlist) { /* not an undef CV */
-	I32 fake_offset = 0;
-        const AV * const nameav = PadlistARRAY(padlist)[0];
-	SV * const * const name_svp = AvARRAY(nameav);
-
-	for (offset = PadnamelistMAXNAMED(nameav); offset > 0; offset--) {
-            const SV * const namesv = name_svp[offset];
-	    if (namesv && PadnameLEN(namesv) == namelen
-                    && sv_eq_pvn_flags(aTHX_ namesv, namepv, namelen,
-                                    flags & padadd_UTF8_NAME ? SVf_UTF8 : 0))
-	    {
-		if (SvFAKE(namesv)) {
-		    fake_offset = offset; /* in case we don't find a real one */
-		    continue;
-		}
-		/* is seq within the range _LOW to _HIGH ?
-		 * This is complicated by the fact that PL_cop_seqmax
-		 * may have wrapped around at some point */
-		if (COP_SEQ_RANGE_LOW(namesv) == PERL_PADSEQ_INTRO)
-		    continue; /* not yet introduced */
-
-		if (COP_SEQ_RANGE_HIGH(namesv) == PERL_PADSEQ_INTRO) {
-		    /* in compiling scope */
-		    if (
-			(seq >  COP_SEQ_RANGE_LOW(namesv))
-			? (seq - COP_SEQ_RANGE_LOW(namesv) < (U32_MAX >> 1))
-			: (COP_SEQ_RANGE_LOW(namesv) - seq > (U32_MAX >> 1))
-		    )
-		       break;
-		}
-		else if (
-		    (COP_SEQ_RANGE_LOW(namesv) > COP_SEQ_RANGE_HIGH(namesv))
-		    ?
-			(  seq >  COP_SEQ_RANGE_LOW(namesv)
-			|| seq <= COP_SEQ_RANGE_HIGH(namesv))
-
-		    :    (  seq >  COP_SEQ_RANGE_LOW(namesv)
-			 && seq <= COP_SEQ_RANGE_HIGH(namesv))
+	DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+	    "             searching: cv=0x%"UVxf" seq=%d\n",
+	    PTR2UV(cv), (int) seq )
+	);
+
+	curlist = CvPADLIST(cv);
+	if (!curlist)
+	    continue; /* an undef CV */
+	svp = av_fetch(curlist, 0, FALSE);
+	if (!svp || *svp == &PL_sv_undef)
+	    continue;
+	curname = (AV*)*svp;
+	svp = AvARRAY(curname);
+
+	depth = CvDEPTH(cv);
+	for (off = AvFILLp(curname); off > 0; off--) {
+	    sv = svp[off];
+	    if (!sv || sv == &PL_sv_undef || !strEQ(SvPVX(sv), name))
+		continue;
+	    if (SvFAKE(sv)) {
+		/* we'll use this later if we don't find a real entry */
+		fake_off = off;
+		continue;
+	    }
+	    else {
+		if (   seq >  U_32(SvNVX(sv))	/* min */
+		    && seq <= (U32)SvIVX(sv)	/* max */
+		    && !(newoff && !depth) /* ignore inactive when cloning */
 		)
-		break;
+		    goto found;
 	    }
 	}
 
-	if (offset > 0 || fake_offset > 0 ) { /* a match! */
-	    if (offset > 0) { /* not fake */
-		fake_offset = 0;
-		*out_name_sv = name_svp[offset]; /* return the namesv */
-
-		/* set PAD_FAKELEX_MULTI if this lex can have multiple
-		 * instances. For now, we just test !CvUNIQUE(cv), but
-		 * ideally, we should detect my's declared within loops
-		 * etc - this would allow a wider range of 'not stayed
-		 * shared' warnings. We also treated already-compiled
-		 * lexes as not multi as viewed from evals. */
-
-		*out_flags = CvANON(cv) ?
-			PAD_FAKELEX_ANON :
-			    (!CvUNIQUE(cv) && ! CvCOMPILED(cv))
-				? PAD_FAKELEX_MULTI : 0;
-
-		DEBUG_Xv(PerlIO_printf(Perl_debug_log,
-		    "Pad findlex cv=0x%"UVxf" matched: offset=%ld (%lu,%lu)\n",
-		    PTR2UV(cv), (long)offset,
-		    (unsigned long)COP_SEQ_RANGE_LOW(*out_name_sv),
-		    (unsigned long)COP_SEQ_RANGE_HIGH(*out_name_sv)));
-	    }
-	    else { /* fake match */
-		offset = fake_offset;
-		*out_name_sv = name_svp[offset]; /* return the namesv */
-		*out_flags = PARENT_FAKELEX_FLAGS(*out_name_sv);
-		DEBUG_Xv(PerlIO_printf(Perl_debug_log,
-		    "Pad findlex cv=0x%"UVxf" matched: offset=%ld flags=0x%lx index=%lu\n",
-		    PTR2UV(cv), (long)offset, (unsigned long)*out_flags,
-		    (unsigned long) PARENT_PAD_INDEX(*out_name_sv) 
-		));
-	    }
-
-	    /* return the lex? */
+	/* no real entry - but did we find a fake one? */
+	if (fake_off) {
+	    if (newoff && !depth)
+		return 0; /* don't clone from inactive stack frame */
+	    off = fake_off;
+	    sv = svp[off];
+	    goto found;
+	}
+    }
+    return 0;
 
-	    if (out_capture) {
+found:
 
-		/* our ? */
-		if (SvPAD_OUR(*out_name_sv)) {
-		    *out_capture = NULL;
-		    return offset;
-		}
+    if (!depth) 
+	depth = 1;
 
-		/* trying to capture from an anon prototype? */
-		if (CvCOMPILED(cv)
-			? CvANON(cv) && CvCLONE(cv) && !CvCLONED(cv)
-			: *out_flags & PAD_FAKELEX_ANON)
-		{
-		    if (warn)
-			S_unavailable(aTHX_
-                                       newSVpvn_flags(namepv, namelen,
-                                           SVs_TEMP |
-                                           (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
+    oldpad = (AV*)AvARRAY(curlist)[depth];
+    oldsv = *av_fetch(oldpad, off, TRUE);
 
-		    *out_capture = NULL;
-		}
+#ifdef DEBUGGING
+    if (SvFAKE(sv))
+	DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+		"             matched:   offset %ld"
+		    " FAKE, sv=0x%"UVxf"\n",
+		(long)off,
+		PTR2UV(oldsv)
+	    )
+	);
+    else
+	DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+		"             matched:   offset %ld"
+		    " (%lu,%lu), sv=0x%"UVxf"\n",
+		(long)off,
+		(unsigned long)U_32(SvNVX(sv)),
+		(unsigned long)SvIVX(sv),
+		PTR2UV(oldsv)
+	    )
+	);
+#endif
 
-		/* real value */
-		else {
-		    int newwarn = warn;
-		    if (!CvCOMPILED(cv) && (*out_flags & PAD_FAKELEX_MULTI)
-			 && !SvPAD_STATE(name_svp[offset])
-			 && warn && ckWARN(WARN_CLOSURE)) {
-			newwarn = 0;
-			Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
-			    "Variable \"%"SVf"\" will not stay shared",
-                            newSVpvn_flags(namepv, namelen,
-                                SVs_TEMP |
-                                (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
-		    }
+    if (!newoff) {		/* Not a mere clone operation. */
+	newoff = pad_add_name(
+	    SvPVX(sv),
+	    (SvFLAGS(sv) & SVpad_TYPED) ? SvSTASH(sv) : Nullhv,
+	    (SvFLAGS(sv) & SVpad_OUR)   ? GvSTASH(sv) : Nullhv,
+	    1  /* fake */
+	);
+
+	if (CvANON(PL_compcv) || SvTYPE(PL_compcv) == SVt_PVFM) {
+	    /* "It's closures all the way down." */
+	    CvCLONE_on(PL_compcv);
+	    if (cv == startcv) {
+		if (CvANON(PL_compcv))
+		    oldsv = Nullsv; /* no need to keep ref */
+	    }
+	    else {
+		CV *bcv;
+		for (bcv = startcv;
+		     bcv && bcv != cv && !CvCLONE(bcv);
+		     bcv = CvOUTSIDE(bcv))
+		{
+		    if (CvANON(bcv)) {
+			/* install the missing pad entry in intervening
+			 * nested subs and mark them cloneable. */
+			AV *ocomppad_name = PL_comppad_name;
+			PAD *ocomppad = PL_comppad;
+			AV *padlist = CvPADLIST(bcv);
+			PL_comppad_name = (AV*)AvARRAY(padlist)[0];
+			PL_comppad = (AV*)AvARRAY(padlist)[1];
+			PL_curpad = AvARRAY(PL_comppad);
+			pad_add_name(
+			    SvPVX(sv),
+			    (SvFLAGS(sv) & SVpad_TYPED)
+				? SvSTASH(sv) : Nullhv,
+			    (SvFLAGS(sv) & SVpad_OUR)
+				? GvSTASH(sv) : Nullhv,
+			    1  /* fake */
+			);
 
-		    if (fake_offset && CvANON(cv)
-			    && CvCLONE(cv) &&!CvCLONED(cv))
-		    {
-			SV *n;
-			/* not yet caught - look further up */
-			DEBUG_Xv(PerlIO_printf(Perl_debug_log,
-			    "Pad findlex cv=0x%"UVxf" chasing lex in outer pad\n",
-			    PTR2UV(cv)));
-			n = *out_name_sv;
-			(void) pad_findlex(namepv, namelen, flags, CvOUTSIDE(cv),
-			    CvOUTSIDE_SEQ(cv),
-			    newwarn, out_capture, out_name_sv, out_flags);
-			*out_name_sv = n;
-			return offset;
+			PL_comppad_name = ocomppad_name;
+			PL_comppad = ocomppad;
+			PL_curpad = ocomppad ?
+				AvARRAY(ocomppad) : Null(SV **);
+			CvCLONE_on(bcv);
 		    }
-
-		    *out_capture = AvARRAY(PadlistARRAY(padlist)[
-				    CvDEPTH(cv) ? CvDEPTH(cv) : 1])[offset];
-		    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
-			"Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n",
-			PTR2UV(cv), PTR2UV(*out_capture)));
-
-		    if (SvPADSTALE(*out_capture)
-			&& (!CvDEPTH(cv) || !staleok)
-			&& !SvPAD_STATE(name_svp[offset]))
-		    {
-			S_unavailable(aTHX_
-                                       newSVpvn_flags(namepv, namelen,
-                                           SVs_TEMP |
-                                           (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
-			*out_capture = NULL;
+		    else {
+			if (ckWARN(WARN_CLOSURE)
+			    && !CvUNIQUE(bcv) && !CvUNIQUE(cv))
+			{
+			    Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
+			      "Variable \"%s\" may be unavailable",
+				 name);
+			}
+			break;
 		    }
 		}
-		if (!*out_capture) {
-		    if (namelen != 0 && *namepv == '@')
-			*out_capture = sv_2mortal(MUTABLE_SV(newAV()));
-		    else if (namelen != 0 && *namepv == '%')
-			*out_capture = sv_2mortal(MUTABLE_SV(newHV()));
-		    else if (namelen != 0 && *namepv == '&')
-			*out_capture = sv_2mortal(newSV_type(SVt_PVCV));
-		    else
-			*out_capture = sv_newmortal();
-		}
 	    }
-
-	    return offset;
 	}
-    }
-
-    /* it's not in this pad - try above */
-
-    if (!CvOUTSIDE(cv))
-	return NOT_IN_PAD;
-
-    /* out_capture non-null means caller wants us to capture lex; in
-     * addition we capture ourselves unless it's an ANON/format */
-    new_capturep = out_capture ? out_capture :
-		CvLATE(cv) ? NULL : &new_capture;
-
-    offset = pad_findlex(namepv, namelen,
-		flags | padadd_STALEOK*(new_capturep == &new_capture),
-		CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1,
-		new_capturep, out_name_sv, out_flags);
-    if ((PADOFFSET)offset == NOT_IN_PAD)
-	return NOT_IN_PAD;
-
-    /* found in an outer CV. Add appropriate fake entry to this pad */
-
-    /* don't add new fake entries (via eval) to CVs that we have already
-     * finished compiling, or to undef CVs */
-    if (CvCOMPILED(cv) || !padlist)
-	return 0; /* this dummy (and invalid) value isnt used by the caller */
-
-    {
-	/* This relies on sv_setsv_flags() upgrading the destination to the same
-	   type as the source, independent of the flags set, and on it being
-	   "good" and only copying flag bits and pointers that it understands.
-	*/
-	SV *new_namesv = newSVsv(*out_name_sv);
-	AV *  const ocomppad_name = PL_comppad_name;
-	PAD * const ocomppad = PL_comppad;
-	PL_comppad_name = PadlistARRAY(padlist)[0];
-	PL_comppad = PadlistARRAY(padlist)[1];
-	PL_curpad = AvARRAY(PL_comppad);
-
-	new_offset
-	    = pad_alloc_name(new_namesv,
-			      (SvPAD_STATE(*out_name_sv) ? padadd_STATE : 0),
-			      SvPAD_TYPED(*out_name_sv)
-			      ? SvSTASH(*out_name_sv) : NULL,
-			      SvOURSTASH(*out_name_sv)
-			      );
-
-	SvFAKE_on(new_namesv);
-	DEBUG_Xv(PerlIO_printf(Perl_debug_log,
-			       "Pad addname: %ld \"%.*s\" FAKE\n",
-			       (long)new_offset,
-			       (int) SvCUR(new_namesv), SvPVX(new_namesv)));
-	PARENT_FAKELEX_FLAGS_set(new_namesv, *out_flags);
-
-	PARENT_PAD_INDEX_set(new_namesv, 0);
-	if (SvPAD_OUR(new_namesv)) {
-	    NOOP;   /* do nothing */
-	}
-	else if (CvLATE(cv)) {
-	    /* delayed creation - just note the offset within parent pad */
-	    PARENT_PAD_INDEX_set(new_namesv, offset);
-	    CvCLONE_on(cv);
-	}
-	else {
-	    /* immediate creation - capture outer value right now */
-	    av_store(PL_comppad, new_offset, SvREFCNT_inc(*new_capturep));
-	    /* But also note the offset, as newMYSUB needs it */
-	    PARENT_PAD_INDEX_set(new_namesv, offset);
-	    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
-		"Pad findlex cv=0x%"UVxf" saved captured sv 0x%"UVxf" at offset %ld\n",
-		PTR2UV(cv), PTR2UV(*new_capturep), (long)new_offset));
+	else if (!CvUNIQUE(PL_compcv)) {
+	    if (ckWARN(WARN_CLOSURE) && !SvFAKE(sv) && !CvUNIQUE(cv)
+		&& !(SvFLAGS(sv) & SVpad_OUR))
+	    {
+		Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
+		    "Variable \"%s\" will not stay shared", name);
+	    }
 	}
-	*out_name_sv = new_namesv;
-	*out_flags = PARENT_FAKELEX_FLAGS(new_namesv);
-
-	PL_comppad_name = ocomppad_name;
-	PL_comppad = ocomppad;
-	PL_curpad = ocomppad ? AvARRAY(ocomppad) : NULL;
     }
-    return new_offset;
+    av_store(PL_comppad, newoff, SvREFCNT_inc(oldsv));
+    ASSERT_CURPAD_ACTIVE("pad_findlex 2");
+    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+		"Pad findlex: set offset %ld to sv 0x%"UVxf"\n",
+		(long)newoff, PTR2UV(oldsv)
+	    )
+    );
+    return newoff;
 }
 
-#ifdef DEBUGGING
 
 /*
-=for apidoc Am|SV *|pad_sv|PADOFFSET po
+=for apidoc pad_sv
 
-Get the value at offset I<po> in the current (compiling or executing) pad.
+Get the value at offset po in the current pad.
 Use macro PAD_SV instead of calling this function directly.
 
 =cut
 */
 
+
 SV *
 Perl_pad_sv(pTHX_ PADOFFSET po)
 {
-    dVAR;
     ASSERT_CURPAD_ACTIVE("pad_sv");
 
+#ifndef USE_5005THREADS
     if (!po)
 	Perl_croak(aTHX_ "panic: pad_sv po");
+#endif
     DEBUG_X(PerlIO_printf(Perl_debug_log,
 	"Pad 0x%"UVxf"[0x%"UVxf"] sv:      %ld sv=0x%"UVxf"\n",
 	PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(PL_curpad[po]))
@@ -1447,22 +827,20 @@ Perl_pad_sv(pTHX_ PADOFFSET po)
     return PL_curpad[po];
 }
 
+
 /*
-=for apidoc Am|void|pad_setsv|PADOFFSET po|SV *sv
+=for apidoc pad_setsv
 
-Set the value at offset I<po> in the current (compiling or executing) pad.
+Set the entry at offset po in the current pad to sv.
 Use the macro PAD_SETSV() rather than calling this function directly.
 
 =cut
 */
 
+#ifdef DEBUGGING
 void
 Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
 {
-    dVAR;
-
-    PERL_ARGS_ASSERT_PAD_SETSV;
-
     ASSERT_CURPAD_ACTIVE("pad_setsv");
 
     DEBUG_X(PerlIO_printf(Perl_debug_log,
@@ -1471,13 +849,14 @@ Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
     );
     PL_curpad[po] = sv;
 }
+#endif
+
 
-#endif /* DEBUGGING */
 
 /*
-=for apidoc m|void|pad_block_start|int full
+=for apidoc pad_block_start
 
-Update the pad compilation state variables on entry to a new block.
+Update the pad compilation state variables on entry to a new block
 
 =cut
 */
@@ -1491,7 +870,6 @@ Update the pad compilation state variables on entry to a new block.
 void
 Perl_pad_block_start(pTHX_ int full)
 {
-    dVAR;
     ASSERT_CURPAD_ACTIVE("pad_block_start");
     SAVEI32(PL_comppad_name_floor);
     PL_comppad_name_floor = AvFILLp(PL_comppad_name);
@@ -1508,12 +886,11 @@ Perl_pad_block_start(pTHX_ int full)
     PL_pad_reset_pending = FALSE;
 }
 
+
 /*
-=for apidoc m|U32|intro_my
+=for apidoc intro_my
 
-"Introduce" my variables to visible status.  This is called during parsing
-at the end of each statement to make lexical variables visible to
-subsequent statements.
+"Introduce" my variables to visible status.
 
 =cut
 */
@@ -1521,10 +898,9 @@ subsequent statements.
 U32
 Perl_intro_my(pTHX)
 {
-    dVAR;
     SV **svp;
+    SV *sv;
     I32 i;
-    U32 seq;
 
     ASSERT_CURPAD_ACTIVE("intro_my");
     if (! PL_min_intro_pending)
@@ -1532,35 +908,28 @@ Perl_intro_my(pTHX)
 
     svp = AvARRAY(PL_comppad_name);
     for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
-	SV * const sv = svp[i];
-
-	if (sv && PadnameLEN(sv) && !SvFAKE(sv)
-	    && COP_SEQ_RANGE_LOW(sv) == PERL_PADSEQ_INTRO)
+	if ((sv = svp[i]) && sv != &PL_sv_undef
+		&& !SvFAKE(sv) && !SvIVX(sv))
 	{
-	    COP_SEQ_RANGE_HIGH_set(sv, PERL_PADSEQ_INTRO); /* Don't know scope end yet. */
-	    COP_SEQ_RANGE_LOW_set(sv, PL_cop_seqmax);
+	    SvIVX(sv) = PAD_MAX;	/* Don't know scope end yet. */
+	    SvNVX(sv) = (NV)PL_cop_seqmax;
 	    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
 		"Pad intromy: %ld \"%s\", (%lu,%lu)\n",
-		(long)i, SvPVX_const(sv),
-		(unsigned long)COP_SEQ_RANGE_LOW(sv),
-		(unsigned long)COP_SEQ_RANGE_HIGH(sv))
+		(long)i, SvPVX(sv),
+		(unsigned long)U_32(SvNVX(sv)), (unsigned long)SvIVX(sv))
 	    );
 	}
     }
-    seq = PL_cop_seqmax;
-    PL_cop_seqmax++;
-    if (PL_cop_seqmax == PERL_PADSEQ_INTRO) /* not a legal value */
-	PL_cop_seqmax++;
     PL_min_intro_pending = 0;
     PL_comppad_name_fill = PL_max_intro_pending; /* Needn't search higher */
     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
-		"Pad intromy: seq -> %ld\n", (long)(PL_cop_seqmax)));
+		"Pad intromy: seq -> %ld\n", (long)(PL_cop_seqmax+1)));
 
-    return seq;
+    return PL_cop_seqmax++;
 }
 
 /*
-=for apidoc m|void|pad_leavemy
+=for apidoc pad_leavemy
 
 Cleanup at end of scope during compilation: set the max seq number for
 lexicals in this scope and warn of any lexicals that never got introduced.
@@ -1568,57 +937,45 @@ lexicals in this scope and warn of any lexicals that never got introduced.
 =cut
 */
 
-OP *
+void
 Perl_pad_leavemy(pTHX)
 {
-    dVAR;
     I32 off;
-    OP *o = NULL;
-    SV * const * const svp = AvARRAY(PL_comppad_name);
+    SV **svp = AvARRAY(PL_comppad_name);
+    SV *sv;
 
     PL_pad_reset_pending = FALSE;
 
     ASSERT_CURPAD_ACTIVE("pad_leavemy");
     if (PL_min_intro_pending && PL_comppad_name_fill < PL_min_intro_pending) {
 	for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
-	    const SV * const sv = svp[off];
-	    if (sv && PadnameLEN(sv) && !SvFAKE(sv))
-		Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
-				 "%"SVf" never introduced",
-				 SVfARG(sv));
+	    if ((sv = svp[off]) && sv != &PL_sv_undef
+		    && !SvFAKE(sv) && ckWARN_d(WARN_INTERNAL))
+		Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
+					"%"SVf" never introduced", sv);
 	}
     }
     /* "Deintroduce" my variables that are leaving with this scope. */
     for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_fill; off--) {
-	SV * const sv = svp[off];
-	if (sv && PadnameLEN(sv) && !SvFAKE(sv)
-	    && COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
+	if ((sv = svp[off]) && sv != &PL_sv_undef
+		&& !SvFAKE(sv) && SvIVX(sv) == PAD_MAX)
 	{
-	    COP_SEQ_RANGE_HIGH_set(sv, PL_cop_seqmax);
+	    SvIVX(sv) = PL_cop_seqmax;
 	    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
 		"Pad leavemy: %ld \"%s\", (%lu,%lu)\n",
-		(long)off, SvPVX_const(sv),
-		(unsigned long)COP_SEQ_RANGE_LOW(sv),
-		(unsigned long)COP_SEQ_RANGE_HIGH(sv))
+		(long)off, SvPVX(sv),
+		(unsigned long)U_32(SvNVX(sv)), (unsigned long)SvIVX(sv))
 	    );
-	    if (!PadnameIsSTATE(sv) && !PadnameIsOUR(sv)
-	     && *PadnamePV(sv) == '&' && PadnameLEN(sv) > 1) {
-		OP *kid = newOP(OP_INTROCV, 0);
-		kid->op_targ = off;
-		o = op_prepend_elem(OP_LINESEQ, kid, o);
-	    }
 	}
     }
     PL_cop_seqmax++;
-    if (PL_cop_seqmax == PERL_PADSEQ_INTRO) /* not a legal value */
-	PL_cop_seqmax++;
     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
 	    "Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax));
-    return o;
 }
 
+
 /*
-=for apidoc m|void|pad_swipe|PADOFFSET po|bool refadjust
+=for apidoc pad_swipe
 
 Abandon the tmp in the current pad at offset po and replace with a
 new one.
@@ -1629,46 +986,32 @@ new one.
 void
 Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
 {
-    dVAR;
     ASSERT_CURPAD_LEGAL("pad_swipe");
     if (!PL_curpad)
 	return;
     if (AvARRAY(PL_comppad) != PL_curpad)
-	Perl_croak(aTHX_ "panic: pad_swipe curpad, %p!=%p",
-		   AvARRAY(PL_comppad), PL_curpad);
-    if (!po || ((SSize_t)po) > AvFILLp(PL_comppad))
-	Perl_croak(aTHX_ "panic: pad_swipe po=%ld, fill=%ld",
-		   (long)po, (long)AvFILLp(PL_comppad));
+	Perl_croak(aTHX_ "panic: pad_swipe curpad");
+    if (!po)
+	Perl_croak(aTHX_ "panic: pad_swipe po");
 
     DEBUG_X(PerlIO_printf(Perl_debug_log,
 		"Pad 0x%"UVxf"[0x%"UVxf"] swipe:   %ld\n",
 		PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po));
 
+    if (PL_curpad[po])
+	SvPADTMP_off(PL_curpad[po]);
     if (refadjust)
 	SvREFCNT_dec(PL_curpad[po]);
 
-
-    /* if pad tmps aren't shared between ops, then there's no need to
-     * create a new tmp when an existing op is freed */
-#ifdef USE_BROKEN_PAD_RESET
-    PL_curpad[po] = newSV(0);
+    PL_curpad[po] = NEWSV(1107,0);
     SvPADTMP_on(PL_curpad[po]);
-#else
-    PL_curpad[po] = NULL;
-#endif
-    if (PadnamelistMAX(PL_comppad_name) != -1
-     && (PADOFFSET)PadnamelistMAX(PL_comppad_name) >= po) {
-	if (PadnamelistARRAY(PL_comppad_name)[po]) {
-	    assert(!PadnameLEN(PadnamelistARRAY(PL_comppad_name)[po]));
-	}
-	PadnamelistARRAY(PL_comppad_name)[po] = &PL_sv_undef;
-    }
     if ((I32)po < PL_padix)
 	PL_padix = po - 1;
 }
 
+
 /*
-=for apidoc m|void|pad_reset
+=for apidoc pad_reset
 
 Mark all the current temporaries for reuse
 
@@ -1681,14 +1024,14 @@ Mark all the current temporaries for reuse
  * to  a shared TARG.  Such an alias will change randomly and unpredictably.
  * We avoid doing this until we can think of a Better Way.
  * GSAR 97-10-29 */
-static void
-S_pad_reset(pTHX)
+void
+Perl_pad_reset(pTHX)
 {
-    dVAR;
 #ifdef USE_BROKEN_PAD_RESET
+    register I32 po;
+
     if (AvARRAY(PL_comppad) != PL_curpad)
-	Perl_croak(aTHX_ "panic: pad_reset curpad, %p!=%p",
-		   AvARRAY(PL_comppad), PL_curpad);
+	Perl_croak(aTHX_ "panic: pad_reset curpad");
 
     DEBUG_X(PerlIO_printf(Perl_debug_log,
 	    "Pad 0x%"UVxf"[0x%"UVxf"] reset:     padix %ld -> %ld",
@@ -1697,8 +1040,7 @@ S_pad_reset(pTHX)
 	    )
     );
 
-    if (!TAINTING_get) {	/* Can't mix tainted and non-tainted temporaries. */
-        I32 po;
+    if (!PL_tainting) {	/* Can't mix tainted and non-tainted temporaries. */
 	for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
 	    if (PL_curpad[po] && !SvIMMORTAL(PL_curpad[po]))
 		SvPADTMP_off(PL_curpad[po]);
@@ -1709,17 +1051,14 @@ S_pad_reset(pTHX)
     PL_pad_reset_pending = FALSE;
 }
 
-/*
-=for apidoc Amx|void|pad_tidy|padtidy_type type
 
-Tidy up a pad at the end of compilation of the code to which it belongs.
-Jobs performed here are: remove most stuff from the pads of anonsub
-prototypes; give it a @_; mark temporaries as such.  I<type> indicates
-the kind of subroutine:
+/*
+=for apidoc pad_tidy
 
-    padtidy_SUB        ordinary subroutine
-    padtidy_SUBCLONE   prototype for lexical closure
-    padtidy_FORMAT     format
+Tidy up a pad after we've finished compiling it:
+    * remove most stuff from the pads of anonsub prototypes;
+    * give it a @_;
+    * mark tmps as such.
 
 =cut
 */
@@ -1732,115 +1071,67 @@ the kind of subroutine:
 void
 Perl_pad_tidy(pTHX_ padtidy_type type)
 {
-    dVAR;
+    PADOFFSET ix;
 
     ASSERT_CURPAD_ACTIVE("pad_tidy");
-
-    /* If this CV has had any 'eval-capable' ops planted in it:
-     * i.e. it contains any of:
-     *
-     *     * eval '...',
-     *     * //ee,
-     *     * use re 'eval'; /$var/
-     *     * /(?{..})/),
-     *
-     * Then any anon prototypes in the chain of CVs should be marked as
-     * cloneable, so that for example the eval's CV in
-     *
-     *    sub { eval '$x' }
-     *
-     * gets the right CvOUTSIDE.  If running with -d, *any* sub may
-     * potentially have an eval executed within it.
-     */
-
-    if (PL_cv_has_eval || PL_perldb) {
-        const CV *cv;
-	for (cv = PL_compcv ;cv; cv = CvOUTSIDE(cv)) {
-	    if (cv != PL_compcv && CvCOMPILED(cv))
-		break; /* no need to mark already-compiled code */
-	    if (CvANON(cv)) {
-		DEBUG_Xv(PerlIO_printf(Perl_debug_log,
-		    "Pad clone on cv=0x%"UVxf"\n", PTR2UV(cv)));
-		CvCLONE_on(cv);
-	    }
-	    CvHASEVAL_on(cv);
-	}
-    }
-
-    /* extend namepad to match curpad */
+    /* extend curpad to match namepad */
     if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
-	av_store(PL_comppad_name, AvFILLp(PL_comppad), NULL);
+	av_store(PL_comppad_name, AvFILLp(PL_comppad), Nullsv);
 
     if (type == padtidy_SUBCLONE) {
-	SV ** const namep = AvARRAY(PL_comppad_name);
-	PADOFFSET ix;
-
+	SV **namep = AvARRAY(PL_comppad_name);
 	for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
 	    SV *namesv;
-	    if (!namep[ix]) namep[ix] = &PL_sv_undef;
 
+	    if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
+		continue;
 	    /*
 	     * The only things that a clonable function needs in its
-	     * pad are anonymous subs, constants and GVs.
+	     * pad are references to outer lexicals and anonymous subs.
 	     * The rest are created anew during cloning.
 	     */
-	    if (!PL_curpad[ix] || SvIMMORTAL(PL_curpad[ix])
-		 || IS_PADGV(PL_curpad[ix]))
-		continue;
-	    namesv = namep[ix];
-	    if (!(PadnamePV(namesv) &&
-		   (!PadnameLEN(namesv) || *SvPVX_const(namesv) == '&')))
+	    if (!((namesv = namep[ix]) != Nullsv &&
+		  namesv != &PL_sv_undef &&
+		  (SvFAKE(namesv) ||
+		   *SvPVX(namesv) == '&')))
 	    {
 		SvREFCNT_dec(PL_curpad[ix]);
-		PL_curpad[ix] = NULL;
+		PL_curpad[ix] = Nullsv;
 	    }
 	}
     }
     else if (type == padtidy_SUB) {
 	/* XXX DAPM this same bit of code keeps appearing !!! Rationalise? */
-	AV * const av = newAV();			/* Will be @_ */
-	av_store(PL_comppad, 0, MUTABLE_SV(av));
-	AvREIFY_only(av);
+	AV *av = newAV();			/* Will be @_ */
+	av_extend(av, 0);
+	av_store(PL_comppad, 0, (SV*)av);
+	AvFLAGS(av) = AVf_REIFY;
     }
 
-    if (type == padtidy_SUB || type == padtidy_FORMAT) {
-	SV ** const namep = AvARRAY(PL_comppad_name);
-	PADOFFSET ix;
+    /* XXX DAPM rationalise these two similar branches */
+
+    if (type == padtidy_SUB) {
 	for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
-	    if (!namep[ix]) namep[ix] = &PL_sv_undef;
-	    if (!PL_curpad[ix] || SvIMMORTAL(PL_curpad[ix])
-		 || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
+	    if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
 		continue;
-	    if (!SvPADMY(PL_curpad[ix])) {
+	    if (!SvPADMY(PL_curpad[ix]))
+		SvPADTMP_on(PL_curpad[ix]);
+	}
+    }
+    else if (type == padtidy_FORMAT) {
+	for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
+	    if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix]))
 		SvPADTMP_on(PL_curpad[ix]);
-	    } else if (!SvFAKE(namep[ix])) {
-		/* This is a work around for how the current implementation of
-		   ?{ } blocks in regexps interacts with lexicals.
-
-		   One of our lexicals.
-		   Can't do this on all lexicals, otherwise sub baz() won't
-		   compile in
-
-		   my $foo;
-
-		   sub bar { ++$foo; }
-
-		   sub baz { ++$foo; }
-
-		   because completion of compiling &bar calling pad_tidy()
-		   would cause (top level) $foo to be marked as stale, and
-		   "no longer available".  */
-		SvPADSTALE_on(PL_curpad[ix]);
-	    }
 	}
     }
     PL_curpad = AvARRAY(PL_comppad);
 }
 
+
 /*
-=for apidoc m|void|pad_free|PADOFFSET po
+=for apidoc pad_free
 
-Free the SV at offset po in the current pad.
+Free the SV at offet po in the current pad.
 
 =cut
 */
@@ -1849,14 +1140,11 @@ Free the SV at offset po in the current pad.
 void
 Perl_pad_free(pTHX_ PADOFFSET po)
 {
-    dVAR;
-    SV *sv;
     ASSERT_CURPAD_LEGAL("pad_free");
     if (!PL_curpad)
 	return;
     if (AvARRAY(PL_comppad) != PL_curpad)
-	Perl_croak(aTHX_ "panic: pad_free curpad, %p!=%p",
-		   AvARRAY(PL_comppad), PL_curpad);
+	Perl_croak(aTHX_ "panic: pad_free curpad");
     if (!po)
 	Perl_croak(aTHX_ "panic: pad_free po");
 
@@ -1865,17 +1153,23 @@ Perl_pad_free(pTHX_ PADOFFSET po)
 	    PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po)
     );
 
+    if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
+	SvPADTMP_off(PL_curpad[po]);
+#ifdef USE_ITHREADS
+	/* SV could be a shared hash key (eg bugid #19022) */
+	if (!SvFAKE(PL_curpad[po]))
+	    SvREADONLY_off(PL_curpad[po]);	/* could be a freed constant */
+#endif
 
-    sv = PL_curpad[po];
-    if (sv && sv != &PL_sv_undef && !SvPADMY(sv))
-	SvFLAGS(sv) &= ~SVs_PADTMP;
-
+    }
     if ((I32)po < PL_padix)
 	PL_padix = po - 1;
 }
 
+
+
 /*
-=for apidoc m|void|do_dump_pad|I32 level|PerlIO *file|PADLIST *padlist|int full
+=for apidoc do_dump_pad
 
 Dump the contents of a padlist
 
@@ -1885,20 +1179,18 @@ Dump the contents of a padlist
 void
 Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
 {
-    dVAR;
-    const AV *pad_name;
-    const AV *pad;
+    AV *pad_name;
+    AV *pad;
     SV **pname;
     SV **ppad;
+    SV *namesv;
     I32 ix;
 
-    PERL_ARGS_ASSERT_DO_DUMP_PAD;
-
     if (!padlist) {
 	return;
     }
-    pad_name = *PadlistARRAY(padlist);
-    pad = PadlistARRAY(padlist)[1];
+    pad_name = (AV*)*av_fetch((AV*)padlist, 0, FALSE);
+    pad = (AV*)*av_fetch((AV*)padlist, 1, FALSE);
     pname = AvARRAY(pad_name);
     ppad = AvARRAY(pad);
     Perl_dump_indent(aTHX_ level, file,
@@ -1907,21 +1199,18 @@ Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
     );
 
     for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
-        const SV *namesv = pname[ix];
-	if (namesv && !PadnameLEN(namesv)) {
-	    namesv = NULL;
+	namesv = pname[ix];
+	if (namesv && namesv == &PL_sv_undef) {
+	    namesv = Nullsv;
 	}
 	if (namesv) {
 	    if (SvFAKE(namesv))
 		Perl_dump_indent(aTHX_ level+1, file,
-		    "%2d. 0x%"UVxf"<%lu> FAKE \"%s\" flags=0x%lx index=%lu\n",
+		    "%2d. 0x%"UVxf"<%lu> FAKE \"%s\"\n",
 		    (int) ix,
 		    PTR2UV(ppad[ix]),
 		    (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
-		    SvPVX_const(namesv),
-		    (unsigned long)PARENT_FAKELEX_FLAGS(namesv),
-		    (unsigned long)PARENT_PAD_INDEX(namesv)
-
+		    SvPVX(namesv)
 		);
 	    else
 		Perl_dump_indent(aTHX_ level+1, file,
@@ -1929,9 +1218,9 @@ Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
 		    (int) ix,
 		    PTR2UV(ppad[ix]),
 		    (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
-		    (unsigned long)COP_SEQ_RANGE_LOW(namesv),
-		    (unsigned long)COP_SEQ_RANGE_HIGH(namesv),
-		    SvPVX_const(namesv)
+		    (unsigned long)U_32(SvNVX(namesv)),
+		    (unsigned long)SvIVX(namesv),
+		    SvPVX(namesv)
 		);
 	}
 	else if (full) {
@@ -1945,31 +1234,28 @@ Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
     }
 }
 
-#ifdef DEBUGGING
+
 
 /*
-=for apidoc m|void|cv_dump|CV *cv|const char *title
+=for apidoc cv_dump
 
 dump the contents of a CV
 
 =cut
 */
 
+#ifdef DEBUGGING
 STATIC void
-S_cv_dump(pTHX_ const CV *cv, const char *title)
+S_cv_dump(pTHX_ CV *cv, char *title)
 {
-    dVAR;
-    const CV * const outside = CvOUTSIDE(cv);
-    PADLIST* const padlist = CvPADLIST(cv);
-
-    PERL_ARGS_ASSERT_CV_DUMP;
+    CV *outside = CvOUTSIDE(cv);
+    AV* padlist = CvPADLIST(cv);
 
     PerlIO_printf(Perl_debug_log,
 		  "  %s: CV=0x%"UVxf" (%s), OUTSIDE=0x%"UVxf" (%s)\n",
 		  title,
 		  PTR2UV(cv),
 		  (CvANON(cv) ? "ANON"
-		   : (SvTYPE(cv) == SVt_PVFM) ? "FORMAT"
 		   : (cv == PL_main_cv) ? "MAIN"
 		   : CvUNIQUE(cv) ? "UNIQUE"
 		   : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
@@ -1984,265 +1270,178 @@ S_cv_dump(pTHX_ const CV *cv, const char *title)
 		    "    PADLIST = 0x%"UVxf"\n", PTR2UV(padlist));
     do_dump_pad(1, Perl_debug_log, padlist, 1);
 }
-
 #endif /* DEBUGGING */
 
+
+
+
+
 /*
-=for apidoc Am|CV *|cv_clone|CV *proto
+=for apidoc cv_clone
 
-Clone a CV, making a lexical closure.  I<proto> supplies the prototype
-of the function: its code, pad structure, and other attributes.
-The prototype is combined with a capture of outer lexicals to which the
-code refers, which are taken from the currently-executing instance of
-the immediately surrounding code.
+Clone a CV: make a new CV which points to the same code etc, but which
+has a newly-created pad built by copying the prototype pad and capturing
+any outer lexicals.
 
 =cut
 */
 
-static CV *S_cv_clone(pTHX_ CV *proto, CV *cv, CV *outside);
+CV *
+Perl_cv_clone(pTHX_ CV *proto)
+{
+    CV *cv;
+
+    LOCK_CRED_MUTEX;			/* XXX create separate mutex */
+    cv = cv_clone2(proto, CvOUTSIDE(proto));
+    UNLOCK_CRED_MUTEX;			/* XXX create separate mutex */
+    return cv;
+}
+
+
+/* XXX DAPM separate out cv and paddish bits ???
+ * ideally the CV-related stuff shouldn't be in pad.c - how about
+ * a cv.c? */
 
-static void
-S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, bool newcv)
+STATIC CV *
+S_cv_clone2(pTHX_ CV *proto, CV *outside)
 {
-    dVAR;
     I32 ix;
-    PADLIST* const protopadlist = CvPADLIST(proto);
-    PAD *const protopad_name = *PadlistARRAY(protopadlist);
-    const PAD *const protopad = PadlistARRAY(protopadlist)[1];
-    SV** const pname = AvARRAY(protopad_name);
-    SV** const ppad = AvARRAY(protopad);
-    const I32 fname = AvFILLp(protopad_name);
-    const I32 fpad = AvFILLp(protopad);
-    SV** outpad;
-    long depth;
-    bool subclones = FALSE;
+    AV* protopadlist = CvPADLIST(proto);
+    AV* protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
+    AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
+    SV** pname = AvARRAY(protopad_name);
+    SV** ppad = AvARRAY(protopad);
+    I32 fname = AvFILLp(protopad_name);
+    I32 fpad = AvFILLp(protopad);
+    AV* comppadlist;
+    CV* cv;
 
     assert(!CvUNIQUE(proto));
 
-    /* Anonymous subs have a weak CvOUTSIDE pointer, so its value is not
-     * reliable.  The currently-running sub is always the one we need to
-     * close over.
-     * For my subs, the currently-running sub may not be the one we want.
-     * We have to check whether it is a clone of CvOUTSIDE.
-     * Note that in general for formats, CvOUTSIDE != find_runcv.
-     * Since formats may be nested inside closures, CvOUTSIDE may point
-     * to a prototype; we instead want the cloned parent who called us.
-     */
+    ENTER;
+    SAVESPTR(PL_compcv);
 
-    if (!outside) {
-      if (CvWEAKOUTSIDE(proto))
-	outside = find_runcv(NULL);
-      else {
-	outside = CvOUTSIDE(proto);
-	if ((CvCLONE(outside) && ! CvCLONED(outside))
-	    || !CvPADLIST(outside)
-	    || PadlistNAMES(CvPADLIST(outside))
-		 != protopadlist->xpadl_outid) {
-	    outside = find_runcv_where(
-		FIND_RUNCV_padid_eq, PTR2IV(protopadlist->xpadl_outid), NULL
-	    );
-	    /* outside could be null */
-	}
-      }
+    cv = PL_compcv = (CV*)NEWSV(1104, 0);
+    sv_upgrade((SV *)cv, SvTYPE(proto));
+    CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE);
+    CvCLONED_on(cv);
+
+#ifdef USE_5005THREADS
+    New(666, CvMUTEXP(cv), 1, perl_mutex);
+    MUTEX_INIT(CvMUTEXP(cv));
+    CvOWNER(cv)		= 0;
+#endif /* USE_5005THREADS */
+#ifdef USE_ITHREADS
+    CvFILE(cv)		= CvXSUB(proto) ? CvFILE(proto)
+					: savepv(CvFILE(proto));
+#else
+    CvFILE(cv)		= CvFILE(proto);
+#endif
+    CvGV(cv)		= CvGV(proto);
+    CvSTASH(cv)		= CvSTASH(proto);
+    CvROOT(cv)		= OpREFCNT_inc(CvROOT(proto));
+    CvSTART(cv)		= CvSTART(proto);
+    if (outside) {
+	CvOUTSIDE(cv)	= (CV*)SvREFCNT_inc(outside);
+	CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
     }
-    depth = outside ? CvDEPTH(outside) : 0;
-    if (!depth)
-	depth = 1;
 
-    ENTER;
-    SAVESPTR(PL_compcv);
-    PL_compcv = cv;
-    if (newcv) SAVEFREESV(cv); /* in case of fatal warnings */
+    if (SvPOK(proto))
+	sv_setpvn((SV*)cv, SvPVX(proto), SvCUR(proto));
 
-    if (CvHASEVAL(cv))
-	CvOUTSIDE(cv)	= MUTABLE_CV(SvREFCNT_inc_simple(outside));
+    CvPADLIST(cv) = comppadlist = pad_new(padnew_CLONE|padnew_SAVE);
 
-    SAVESPTR(PL_comppad_name);
-    PL_comppad_name = protopad_name;
-    CvPADLIST(cv) = pad_new(padnew_CLONE|padnew_SAVE);
+    for (ix = fname; ix >= 0; ix--)
+	av_store(PL_comppad_name, ix, SvREFCNT_inc(pname[ix]));
 
     av_fill(PL_comppad, fpad);
-
     PL_curpad = AvARRAY(PL_comppad);
 
-    outpad = outside && CvPADLIST(outside)
-	? AvARRAY(PadlistARRAY(CvPADLIST(outside))[depth])
-	: NULL;
-    if (outpad)
-	CvPADLIST(cv)->xpadl_outid = PadlistNAMES(CvPADLIST(outside));
-
     for (ix = fpad; ix > 0; ix--) {
-	SV* const namesv = (ix <= fname) ? pname[ix] : NULL;
-	SV *sv = NULL;
-	if (namesv && PadnameLEN(namesv)) { /* lexical */
-	  if (PadnameIsOUR(namesv)) { /* or maybe not so lexical */
-		NOOP;
-	  }
-	  else {
-	    if (SvFAKE(namesv)) {   /* lexical from outside? */
-		/* formats may have an inactive, or even undefined, parent;
-		   but state vars are always available. */
-		if (!outpad || !(sv = outpad[PARENT_PAD_INDEX(namesv)])
-		 || (  SvPADSTALE(sv) && !SvPAD_STATE(namesv)
-		    && (!outside || !CvDEPTH(outside)))  ) {
-		    S_unavailable(aTHX_ namesv);
-		    sv = NULL;
-		}
-		else 
-		    SvREFCNT_inc_simple_void_NN(sv);
+	SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
+	if (namesv && namesv != &PL_sv_undef) {
+	    char *name = SvPVX(namesv);    /* XXX */
+	    if (SvFLAGS(namesv) & SVf_FAKE) {   /* lexical from outside? */
+		I32 off = pad_findlex(name, ix, cv);
+		if (!off)
+		    PL_curpad[ix] = SvREFCNT_inc(ppad[ix]);
+		else if (off != ix)
+		    Perl_croak(aTHX_ "panic: cv_clone: %s", name);
 	    }
-	    if (!sv) {
-                const char sigil = SvPVX_const(namesv)[0];
-                if (sigil == '&')
-		    /* If there are state subs, we need to clone them, too.
-		       But they may need to close over variables we have
-		       not cloned yet.  So we will have to do a second
-		       pass.  Furthermore, there may be state subs clos-
-		       ing over other state subs’ entries, so we have
-		       to put a stub here and then clone into it on the
-		       second pass. */
-		    if (SvPAD_STATE(namesv) && !CvCLONED(ppad[ix])) {
-			assert(SvTYPE(ppad[ix]) == SVt_PVCV);
-			subclones = 1;
-			sv = newSV_type(SVt_PVCV);
-		    }
-		    else if (PadnameLEN(namesv)>1 && !PadnameIsOUR(namesv))
-		    {
-			/* my sub */
-			/* Just provide a stub, but name it.  It will be
-			   upgrade to the real thing on scope entry. */
-			sv = newSV_type(SVt_PVCV);
-			CvNAME_HEK_set(
-			    sv,
-			    share_hek(SvPVX_const(namesv)+1,
-				      SvCUR(namesv) - 1
-					 * (SvUTF8(namesv) ? -1 : 1),
-				      0)
-			);
-		    }
-		    else sv = SvREFCNT_inc(ppad[ix]);
-                else if (sigil == '@')
-		    sv = MUTABLE_SV(newAV());
-                else if (sigil == '%')
-		    sv = MUTABLE_SV(newHV());
+	    else {				/* our own lexical */
+		SV* sv;
+		if (*name == '&') {
+		    /* anon code -- we'll come back for it */
+		    sv = SvREFCNT_inc(ppad[ix]);
+		}
+		else if (*name == '@')
+		    sv = (SV*)newAV();
+		else if (*name == '%')
+		    sv = (SV*)newHV();
 		else
-		    sv = newSV(0);
-		SvPADMY_on(sv);
-		/* reset the 'assign only once' flag on each state var */
-		if (sigil != '&' && SvPAD_STATE(namesv))
-		    SvPADSTALE_on(sv);
+		    sv = NEWSV(0, 0);
+		if (!SvPADBUSY(sv))
+		    SvPADMY_on(sv);
+		PL_curpad[ix] = sv;
 	    }
-	  }
 	}
-	else if (IS_PADGV(ppad[ix]) || (namesv && PadnamePV(namesv))) {
-	    sv = SvREFCNT_inc_NN(ppad[ix]);
+	else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) {
+	    PL_curpad[ix] = SvREFCNT_inc(ppad[ix]);
 	}
 	else {
-	    sv = newSV(0);
+	    SV* sv = NEWSV(0, 0);
 	    SvPADTMP_on(sv);
+	    PL_curpad[ix] = sv;
 	}
-	PL_curpad[ix] = sv;
     }
 
-    if (subclones)
-	for (ix = fpad; ix > 0; ix--) {
-	    SV* const namesv = (ix <= fname) ? pname[ix] : NULL;
-	    if (namesv && namesv != &PL_sv_undef && !SvFAKE(namesv)
-	     && SvPVX_const(namesv)[0] == '&' && SvPAD_STATE(namesv))
-		S_cv_clone(aTHX_ (CV *)ppad[ix], (CV *)PL_curpad[ix], cv);
-	}
-
-    if (newcv) SvREFCNT_inc_simple_void_NN(cv);
-    LEAVE;
-}
-
-static CV *
-S_cv_clone(pTHX_ CV *proto, CV *cv, CV *outside)
-{
-    dVAR;
-    const bool newcv = !cv;
-
-    assert(!CvUNIQUE(proto));
+    /* Now that vars are all in place, clone nested closures. */
 
-    if (!cv) cv = MUTABLE_CV(newSV_type(SvTYPE(proto)));
-    CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE|CVf_CVGV_RC
-				    |CVf_SLABBED);
-    CvCLONED_on(cv);
-
-    CvFILE(cv)		= CvDYNFILE(proto) ? savepv(CvFILE(proto))
-					   : CvFILE(proto);
-    if (CvNAMED(proto))
-	 CvNAME_HEK_set(cv, share_hek_hek(CvNAME_HEK(proto)));
-    else CvGV_set(cv,CvGV(proto));
-    CvSTASH_set(cv, CvSTASH(proto));
-    OP_REFCNT_LOCK;
-    CvROOT(cv)		= OpREFCNT_inc(CvROOT(proto));
-    OP_REFCNT_UNLOCK;
-    CvSTART(cv)		= CvSTART(proto);
-    CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
-
-    if (SvPOK(proto)) {
-	sv_setpvn(MUTABLE_SV(cv), SvPVX_const(proto), SvCUR(proto));
-        if (SvUTF8(proto))
-           SvUTF8_on(MUTABLE_SV(cv));
+    for (ix = fpad; ix > 0; ix--) {
+	SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
+	if (namesv
+	    && namesv != &PL_sv_undef
+	    && !(SvFLAGS(namesv) & SVf_FAKE)
+	    && *SvPVX(namesv) == '&'
+	    && CvCLONE(ppad[ix]))
+	{
+	    CV *kid = cv_clone2((CV*)ppad[ix], cv);
+	    SvREFCNT_dec(ppad[ix]);
+	    CvCLONE_on(kid);
+	    SvPADMY_on(kid);
+	    PL_curpad[ix] = (SV*)kid;
+	    /* '&' entry points to child, so child mustn't refcnt parent */
+	    CvWEAKOUTSIDE_on(kid);
+	    SvREFCNT_dec(cv);
+	}
     }
-    if (SvMAGIC(proto))
-	mg_copy((SV *)proto, (SV *)cv, 0, 0);
-
-    if (CvPADLIST(proto)) S_cv_clone_pad(aTHX_ proto, cv, outside, newcv);
 
     DEBUG_Xv(
 	PerlIO_printf(Perl_debug_log, "\nPad CV clone\n");
-	if (CvOUTSIDE(cv)) cv_dump(CvOUTSIDE(cv), "Outside");
+	cv_dump(outside, "Outside");
 	cv_dump(proto,	 "Proto");
 	cv_dump(cv,	 "To");
     );
 
+    LEAVE;
+
     if (CvCONST(cv)) {
-	/* Constant sub () { $x } closing over $x - see lib/constant.pm:
-	 * The prototype was marked as a candiate for const-ization,
-	 * so try to grab the current const value, and if successful,
-	 * turn into a const sub:
-	 */
-	SV* const const_sv = op_const_sv(CvSTART(cv), cv);
-	if (const_sv) {
-	    SvREFCNT_dec_NN(cv);
-            /* For this calling case, op_const_sv returns a *copy*, which we
-               donate to newCONSTSUB. Yes, this is ugly, and should be killed.
-               Need to fix how lib/constant.pm works to eliminate this.  */
-	    cv = newCONSTSUB(CvSTASH(proto), NULL, const_sv);
-	}
-	else {
-	    CvCONST_off(cv);
-	}
+	SV* const_sv = op_const_sv(CvSTART(cv), cv);
+	assert(const_sv);
+	/* constant sub () { $x } closing over $x - see lib/constant.pm */
+	SvREFCNT_dec(cv);
+	cv = newCONSTSUB(CvSTASH(proto), 0, const_sv);
     }
 
     return cv;
 }
 
-CV *
-Perl_cv_clone(pTHX_ CV *proto)
-{
-    PERL_ARGS_ASSERT_CV_CLONE;
-
-    if (!CvPADLIST(proto)) Perl_croak(aTHX_ "panic: no pad in cv_clone");
-    return S_cv_clone(aTHX_ proto, NULL, NULL);
-}
-
-/* Called only by pp_clonecv */
-CV *
-Perl_cv_clone_into(pTHX_ CV *proto, CV *target)
-{
-    PERL_ARGS_ASSERT_CV_CLONE_INTO;
-    cv_undef(target);
-    return S_cv_clone(aTHX_ proto, target, NULL);
-}
 
 /*
-=for apidoc m|void|pad_fixup_inner_anons|PADLIST *padlist|CV *old_cv|CV *new_cv
+=for apidoc pad_fixup_inner_anons
 
 For any anon CVs in the pad, change CvOUTSIDE of that CV from
-old_cv to new_cv if necessary.  Needed when a newly-compiled CV has to be
+old_cv to new_cv if necessary. Needed when a newly-compiled CV has to be
 moved to a pre-existing CV struct.
 
 =cut
@@ -2251,298 +1450,82 @@ moved to a pre-existing CV struct.
 void
 Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
 {
-    dVAR;
     I32 ix;
-    AV * const comppad_name = PadlistARRAY(padlist)[0];
-    AV * const comppad = PadlistARRAY(padlist)[1];
-    SV ** const namepad = AvARRAY(comppad_name);
-    SV ** const curpad = AvARRAY(comppad);
-
-    PERL_ARGS_ASSERT_PAD_FIXUP_INNER_ANONS;
-    PERL_UNUSED_ARG(old_cv);
-
+    AV *comppad_name = (AV*)AvARRAY(padlist)[0];
+    AV *comppad = (AV*)AvARRAY(padlist)[1];
+    SV **namepad = AvARRAY(comppad_name);
+    SV **curpad = AvARRAY(comppad);
     for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
-        const SV * const namesv = namepad[ix];
-	if (namesv && namesv != &PL_sv_undef && !SvPAD_STATE(namesv)
-	    && *SvPVX_const(namesv) == '&')
+	SV *namesv = namepad[ix];
+	if (namesv && namesv != &PL_sv_undef
+	    && *SvPVX(namesv) == '&')
 	{
-	  if (SvTYPE(curpad[ix]) == SVt_PVCV) {
-	    MAGIC * const mg =
-		SvMAGICAL(curpad[ix])
-		    ? mg_find(curpad[ix], PERL_MAGIC_proto)
-		    : NULL;
-	    CV * const innercv = MUTABLE_CV(mg ? mg->mg_obj : curpad[ix]);
-	    if (CvOUTSIDE(innercv) == old_cv) {
-		if (!CvWEAKOUTSIDE(innercv)) {
-		    SvREFCNT_dec(old_cv);
-		    SvREFCNT_inc_simple_void_NN(new_cv);
-		}
-		CvOUTSIDE(innercv) = new_cv;
-	    }
-	  }
-	  else { /* format reference */
-	    SV * const rv = curpad[ix];
-	    CV *innercv;
-	    if (!SvOK(rv)) continue;
-	    assert(SvROK(rv));
-	    assert(SvWEAKREF(rv));
-	    innercv = (CV *)SvRV(rv);
-	    assert(!CvWEAKOUTSIDE(innercv));
-	    SvREFCNT_dec(CvOUTSIDE(innercv));
-	    CvOUTSIDE(innercv) = (CV *)SvREFCNT_inc_simple_NN(new_cv);
-	  }
+	    CV *innercv = (CV*)curpad[ix];
+	    assert(CvWEAKOUTSIDE(innercv));
+	    assert(CvOUTSIDE(innercv) == old_cv);
+	    CvOUTSIDE(innercv) = new_cv;
 	}
     }
 }
 
+
 /*
-=for apidoc m|void|pad_push|PADLIST *padlist|int depth
+=for apidoc pad_push
 
 Push a new pad frame onto the padlist, unless there's already a pad at
-this depth, in which case don't bother creating a new one.  Then give
-the new pad an @_ in slot zero.
+this depth, in which case don't bother creating a new one.
+If has_args is true, give the new pad an @_ in slot zero.
 
 =cut
 */
 
 void
-Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
+Perl_pad_push(pTHX_ PADLIST *padlist, int depth, int has_args)
 {
-    dVAR;
-
-    PERL_ARGS_ASSERT_PAD_PUSH;
-
-    if (depth > PadlistMAX(padlist) || !PadlistARRAY(padlist)[depth]) {
-	PAD** const svp = PadlistARRAY(padlist);
-	AV* const newpad = newAV();
-	SV** const oldpad = AvARRAY(svp[depth-1]);
-	I32 ix = AvFILLp((const AV *)svp[1]);
-        const I32 names_fill = AvFILLp((const AV *)svp[0]);
-	SV** const names = AvARRAY(svp[0]);
-	AV *av;
+    if (depth <= AvFILLp(padlist))
+	return;
 
+    {
+	SV** svp = AvARRAY(padlist);
+	AV *newpad = newAV();
+	SV **oldpad = AvARRAY(svp[depth-1]);
+	I32 ix = AvFILLp((AV*)svp[1]);
+	I32 names_fill = AvFILLp((AV*)svp[0]);
+	SV** names = AvARRAY(svp[0]);
+	SV* sv;
 	for ( ;ix > 0; ix--) {
-	    if (names_fill >= ix && PadnameLEN(names[ix])) {
-		const char sigil = SvPVX_const(names[ix])[0];
-		if ((SvFLAGS(names[ix]) & SVf_FAKE)
-			|| (SvFLAGS(names[ix]) & SVpad_STATE)
-			|| sigil == '&')
-		{
+	    if (names_fill >= ix && names[ix] != &PL_sv_undef) {
+		char *name = SvPVX(names[ix]);
+		if ((SvFLAGS(names[ix]) & SVf_FAKE) || *name == '&') {
 		    /* outer lexical or anon code */
 		    av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]));
 		}
 		else {		/* our own lexical */
-		    SV *sv; 
-		    if (sigil == '@')
-			sv = MUTABLE_SV(newAV());
-		    else if (sigil == '%')
-			sv = MUTABLE_SV(newHV());
+		    if (*name == '@')
+			av_store(newpad, ix, sv = (SV*)newAV());
+		    else if (*name == '%')
+			av_store(newpad, ix, sv = (SV*)newHV());
 		    else
-			sv = newSV(0);
-		    av_store(newpad, ix, sv);
+			av_store(newpad, ix, sv = NEWSV(0, 0));
 		    SvPADMY_on(sv);
 		}
 	    }
-	    else if (IS_PADGV(oldpad[ix]) || PadnamePV(names[ix])) {
-		av_store(newpad, ix, SvREFCNT_inc_NN(oldpad[ix]));
+	    else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
+		av_store(newpad, ix, sv = SvREFCNT_inc(oldpad[ix]));
 	    }
 	    else {
 		/* save temporaries on recursion? */
-		SV * const sv = newSV(0);
-		av_store(newpad, ix, sv);
+		av_store(newpad, ix, sv = NEWSV(0, 0));
 		SvPADTMP_on(sv);
 	    }
 	}
-	av = newAV();
-	av_store(newpad, 0, MUTABLE_SV(av));
-	AvREIFY_only(av);
-
-	padlist_store(padlist, depth, newpad);
-    }
-}
-
-/*
-=for apidoc Am|HV *|pad_compname_type|PADOFFSET po
-
-Looks up the type of the lexical variable at position I<po> in the
-currently-compiling pad.  If the variable is typed, the stash of the
-class to which it is typed is returned.  If not, C<NULL> is returned.
-
-=cut
-*/
-
-HV *
-Perl_pad_compname_type(pTHX_ const PADOFFSET po)
-{
-    dVAR;
-    SV* const * const av = av_fetch(PL_comppad_name, po, FALSE);
-    if ( SvPAD_TYPED(*av) ) {
-        return SvSTASH(*av);
-    }
-    return NULL;
-}
-
-#if defined(USE_ITHREADS)
-
-#  define av_dup_inc(s,t)	MUTABLE_AV(sv_dup_inc((const SV *)s,t))
-
-/*
-=for apidoc padlist_dup
-
-Duplicates a pad.
-
-=cut
-*/
-
-PADLIST *
-Perl_padlist_dup(pTHX_ PADLIST *srcpad, CLONE_PARAMS *param)
-{
-    PADLIST *dstpad;
-    bool cloneall;
-    PADOFFSET max;
-
-    PERL_ARGS_ASSERT_PADLIST_DUP;
-
-    if (!srcpad)
-	return NULL;
-
-    cloneall = param->flags & CLONEf_COPY_STACKS
-	|| SvREFCNT(PadlistARRAY(srcpad)[1]) > 1;
-    assert (SvREFCNT(PadlistARRAY(srcpad)[1]) == 1);
-
-    max = cloneall ? PadlistMAX(srcpad) : 1;
-
-    Newx(dstpad, 1, PADLIST);
-    ptr_table_store(PL_ptr_table, srcpad, dstpad);
-    PadlistMAX(dstpad) = max;
-    Newx(PadlistARRAY(dstpad), max + 1, PAD *);
-
-    if (cloneall) {
-	PADOFFSET depth;
-	for (depth = 0; depth <= max; ++depth)
-	    PadlistARRAY(dstpad)[depth] =
-		av_dup_inc(PadlistARRAY(srcpad)[depth], param);
-    } else {
-	/* CvDEPTH() on our subroutine will be set to 0, so there's no need
-	   to build anything other than the first level of pads.  */
-	I32 ix = AvFILLp(PadlistARRAY(srcpad)[1]);
-	AV *pad1;
-	const I32 names_fill = AvFILLp(PadlistARRAY(srcpad)[0]);
-	const PAD *const srcpad1 = PadlistARRAY(srcpad)[1];
-	SV **oldpad = AvARRAY(srcpad1);
-	SV **names;
-	SV **pad1a;
-	AV *args;
-
-	PadlistARRAY(dstpad)[0] =
-	    av_dup_inc(PadlistARRAY(srcpad)[0], param);
-	names = AvARRAY(PadlistARRAY(dstpad)[0]);
-
-	pad1 = newAV();
-
-	av_extend(pad1, ix);
-	PadlistARRAY(dstpad)[1] = pad1;
-	pad1a = AvARRAY(pad1);
-
-	if (ix > -1) {
-	    AvFILLp(pad1) = ix;
-
-	    for ( ;ix > 0; ix--) {
-		if (!oldpad[ix]) {
-		    pad1a[ix] = NULL;
-		} else if (names_fill >= ix && names[ix] &&
-			   PadnameLEN(names[ix])) {
-		    const char sigil = SvPVX_const(names[ix])[0];
-		    if ((SvFLAGS(names[ix]) & SVf_FAKE)
-			|| (SvFLAGS(names[ix]) & SVpad_STATE)
-			|| sigil == '&')
-			{
-			    /* outer lexical or anon code */
-			    pad1a[ix] = sv_dup_inc(oldpad[ix], param);
-			}
-		    else {		/* our own lexical */
-			if(SvPADSTALE(oldpad[ix]) && SvREFCNT(oldpad[ix]) > 1) {
-			    /* This is a work around for how the current
-			       implementation of ?{ } blocks in regexps
-			       interacts with lexicals.  */
-			    pad1a[ix] = sv_dup_inc(oldpad[ix], param);
-			} else {
-			    SV *sv; 
-			    
-			    if (sigil == '@')
-				sv = MUTABLE_SV(newAV());
-			    else if (sigil == '%')
-				sv = MUTABLE_SV(newHV());
-			    else
-				sv = newSV(0);
-			    pad1a[ix] = sv;
-			    SvPADMY_on(sv);
-			}
-		    }
-		}
-		else if (IS_PADGV(oldpad[ix])
-		      || (  names_fill >= ix && names[ix]
-			 && PadnamePV(names[ix])  )) {
-		    pad1a[ix] = sv_dup_inc(oldpad[ix], param);
-		}
-		else {
-		    /* save temporaries on recursion? */
-		    SV * const sv = newSV(0);
-		    pad1a[ix] = sv;
-
-		    /* SvREFCNT(oldpad[ix]) != 1 for some code in threads.xs
-		       FIXTHAT before merging this branch.
-		       (And I know how to) */
-		    if (SvPADMY(oldpad[ix]))
-			SvPADMY_on(sv);
-		    else
-			SvPADTMP_on(sv);
-		}
-	    }
-
-	    if (oldpad[0]) {
-		args = newAV();			/* Will be @_ */
-		AvREIFY_only(args);
-		pad1a[0] = (SV *)args;
-	    }
+	if (has_args) {
+	    AV* av = newAV();
+	    av_extend(av, 0);
+	    av_store(newpad, 0, (SV*)av);
+	    AvFLAGS(av) = AVf_REIFY;
 	}
+	av_store(padlist, depth, (SV*)newpad);
+	AvFILLp(padlist) = depth;
     }
-
-    return dstpad;
 }
-
-#endif /* USE_ITHREADS */
-
-PAD **
-Perl_padlist_store(pTHX_ PADLIST *padlist, I32 key, PAD *val)
-{
-    dVAR;
-    PAD **ary;
-    SSize_t const oldmax = PadlistMAX(padlist);
-
-    PERL_ARGS_ASSERT_PADLIST_STORE;
-
-    assert(key >= 0);
-
-    if (key > PadlistMAX(padlist)) {
-	av_extend_guts(NULL,key,&PadlistMAX(padlist),
-		       (SV ***)&PadlistARRAY(padlist),
-		       (SV ***)&PadlistARRAY(padlist));
-	Zero(PadlistARRAY(padlist)+oldmax+1, PadlistMAX(padlist)-oldmax,
-	     PAD *);
-    }
-    ary = PadlistARRAY(padlist);
-    SvREFCNT_dec(ary[key]);
-    ary[key] = val;
-    return &ary[key];
-}
-
-/*
- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: nil
- * End:
- *
- * ex: set ts=8 sts=4 sw=4 et:
- */
diff --git a/gnu/usr.bin/perl/t/comp/parser.t b/gnu/usr.bin/perl/t/comp/parser.t
index 584a473f62b..ca191c2de06 100644
--- a/gnu/usr.bin/perl/t/comp/parser.t
+++ b/gnu/usr.bin/perl/t/comp/parser.t
@@ -4,56 +4,12 @@
 # (including weird syntax errors)
 
 BEGIN {
-    @INC = qw(. ../lib);
-    chdir 't';
+    chdir 't' if -d 't';
+    @INC = '../lib';
 }
 
-print "1..169\n";
-
-sub failed {
-    my ($got, $expected, $name) = @_;
-
-    print "not ok $test - $name\n";
-    my @caller = caller(1);
-    print "# Failed test at $caller[1] line $caller[2]\n";
-    if (defined $got) {
-	print "# Got '$got'\n";
-    } else {
-	print "# Got undef\n";
-    }
-    print "# Expected $expected\n";
-    return;
-}
-
-sub like {
-    my ($got, $pattern, $name) = @_;
-    $test = $test + 1;
-    if (defined $got && $got =~ $pattern) {
-	print "ok $test - $name\n";
-	# Principle of least surprise - maintain the expected interface, even
-	# though we aren't using it here (yet).
-	return 1;
-    }
-    failed($got, $pattern, $name);
-}
-
-sub is {
-    my ($got, $expect, $name) = @_;
-    $test = $test + 1;
-    if (defined $expect) {
-	if (defined $got && $got eq $expect) {
-	    print "ok $test - $name\n";
-	    return 1;
-	}
-	failed($got, "'$expect'", $name);
-    } else {
-	if (!defined $got) {
-	    print "ok $test - $name\n";
-	    return 1;
-	}
-	failed($got, 'undef', $name);
-    }
-}
+require "./test.pl";
+plan( tests => 41 );
 
 eval '%@x=0;';
 like( $@, qr/^Can't modify hash dereference in repeat \(x\)/, '%@x=0' );
@@ -67,20 +23,6 @@ eval q/"\x{"/;
 like( $@, qr/^Missing right brace on \\x/,
     'syntax error in string, used to dump core' );
 
-eval q/"\N{"/;
-like( $@, qr/^Missing right brace on \\N/,
-    'syntax error in string with incomplete \N' );
-eval q/"\Nfoo"/;
-like( $@, qr/^Missing braces on \\N/,
-    'syntax error in string with incomplete \N' );
-
-eval q/"\o{"/;
-like( $@, qr/^Missing right brace on \\o/,
-    'syntax error in string with incomplete \o' );
-eval q/"\ofoo"/;
-like( $@, qr/^Missing braces on \\o/,
-    'syntax error in string with incomplete \o' );
-
 eval "a.b.c.d.e.f;sub";
 like( $@, qr/^Illegal declaration of anonymous subroutine/,
     'found by Markov chain stress testing' );
@@ -137,11 +79,11 @@ is( $@, '', 'PL_lex_brackstack' );
     is("${a}[", "A[", "interpolation, qq//");
     my @b=("B");
     is("@{b}{", "B{", "interpolation, qq//");
-    is(qr/${a}\{/, '(?^:A\{)', "interpolation, qr//");
+    is(qr/${a}{/, '(?-xism:A{)', "interpolation, qr//");
     my $c = "A{";
-    $c =~ /${a}\{/;
+    $c =~ /${a}{/;
     is($&, 'A{', "interpolation, m//");
-    $c =~ s/${a}\{/foo/;
+    $c =~ s/${a}{/foo/;
     is($c, 'foo', "interpolation, s/...//");
     $c =~ s/foo/${a}{/;
     is($c, 'A{', "interpolation, s//.../");
@@ -160,8 +102,7 @@ my %data = ( foo => "\n" );
 print "#";
 print(
 $data{foo});
-$test = $test + 1;
-print "ok $test\n";
+pass();
 
 # Bug #21875
 # { q.* => ... } should be interpreted as hash, not block
@@ -179,7 +120,7 @@ EOF
 {
     my ($expect, $eval) = split / /, $line, 2;
     my $result = eval $eval;
-    is($@, '', "eval $eval");
+    ok($@ eq  '', "eval $eval");
     is(ref $result, $expect ? 'HASH' : '', $eval);
 }
 
@@ -187,467 +128,10 @@ EOF
 {
     local $SIG{__WARN__} = sub { }; # silence mandatory warning
     eval q{ my $x = -F 1; };
-    like( $@, qr/(?i:syntax|parse) error .* near "F 1"/, "unknown filetest operators" );
+    like( $@, qr/syntax error .* near "F 1"/, "unknown filetest operators" );
     is(
         eval q{ sub F { 42 } -F 1 },
 	'-42',
 	'-F calls the F function'
     );
 }
-
-# Bug #24762
-{
-    eval q{ *foo{CODE} ? 1 : 0 };
-    is( $@, '', "glob subscript in conditional" );
-}
-
-# Bug #25824
-{
-    eval q{ sub f { @a=@b=@c;  {use} } };
-    like( $@, qr/syntax error/, "use without body" );
-}
-
-# [perl #2738] perl segfautls on input
-{
-    eval q{ sub _ <> {} };
-    like($@, qr/Illegal declaration of subroutine main::_/, "readline operator as prototype");
-
-    eval q{ $s = sub <> {} };
-    like($@, qr/Illegal declaration of anonymous subroutine/, "readline operator as prototype");
-
-    eval q{ sub _ __FILE__ {} };
-    like($@, qr/Illegal declaration of subroutine main::_/, "__FILE__ as prototype");
-}
-
-# tests for "Bad name"
-eval q{ foo::$bar };
-like( $@, qr/Bad name after foo::/, 'Bad name after foo::' );
-eval q{ foo''bar };
-like( $@, qr/Bad name after foo'/, 'Bad name after foo\'' );
-
-# test for ?: context error
-eval q{($a ? $x : ($y)) = 5};
-like( $@, qr/Assignment to both a list and a scalar/, 'Assignment to both a list and a scalar' );
-
-eval q{ s/x/#/e };
-is( $@, '', 'comments in s///e' );
-
-# these five used to coredump because the op cleanup on parse error could
-# be to the wrong pad
-
-eval q[
-    sub { our $a= 1;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;
-	    sub { my $z
-];
-
-like($@, qr/Missing right curly/, 'nested sub syntax error' );
-
-eval q[
-    sub { my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$r);
-	    sub { my $z
-];
-like($@, qr/Missing right curly/, 'nested sub syntax error 2' );
-
-eval q[
-    sub { our $a= 1;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;
-	    use DieDieDie;
-];
-
-like($@, qr/Can't locate DieDieDie.pm/, 'croak cleanup' );
-
-eval q[
-    sub { my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$r);
-	    use DieDieDie;
-];
-
-like($@, qr/Can't locate DieDieDie.pm/, 'croak cleanup 2' );
-
-
-eval q[
-    my @a;
-    my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$r);
-    @a =~ s/a/b/; # compile-time error
-    use DieDieDie;
-];
-
-like($@, qr/Can't modify/, 'croak cleanup 3' );
-
-# these might leak, or have duplicate frees, depending on the bugginess of
-# the parser stack 'fail in reduce' cleanup code. They're here mainly as
-# something to be run under valgrind, with PERL_DESTRUCT_LEVEL=1.
-
-eval q[ BEGIN { } ] for 1..10;
-is($@, "", 'BEGIN 1' );
-
-eval q[ BEGIN { my $x; $x = 1 } ] for 1..10;
-is($@, "", 'BEGIN 2' );
-
-eval q[ BEGIN { \&foo1 } ] for 1..10;
-is($@, "", 'BEGIN 3' );
-
-eval q[ sub foo2 { } ] for 1..10;
-is($@, "", 'BEGIN 4' );
-
-eval q[ sub foo3 { my $x; $x=1 } ] for 1..10;
-is($@, "", 'BEGIN 5' );
-
-eval q[ BEGIN { die } ] for 1..10;
-like($@, qr/BEGIN failed--compilation aborted/, 'BEGIN 6' );
-
-eval q[ BEGIN {\&foo4; die } ] for 1..10;
-like($@, qr/BEGIN failed--compilation aborted/, 'BEGIN 7' );
-
-{
-  # RT #70934
-  # check both the specific case in the ticket, and a few other paths into
-  # S_scan_ident()
-  # simplify long ids
-  my $x100 = "x" x 256;
-  my $xFE = "x" x 254;
-  my $xFD = "x" x 253;
-  my $xFC = "x" x 252;
-  my $xFB = "x" x 251;
-
-  eval qq[ \$#$xFB ];
-  is($@, "", "251 character \$# sigil ident ok");
-  eval qq[ \$#$xFC ];
-  like($@, qr/Identifier too long/, "too long id in \$# sigil ctx");
-
-  eval qq[ \$$xFB ];
-  is($@, "", "251 character \$ sigil ident ok");
-  eval qq[ \$$xFC ];
-  like($@, qr/Identifier too long/, "too long id in \$ sigil ctx");
-
-  eval qq[ %$xFB ];
-  is($@, "", "251 character % sigil ident ok");
-  eval qq[ %$xFC ];
-  like($@, qr/Identifier too long/, "too long id in % sigil ctx");
-
-  eval qq[ \\&$xFB ]; # take a ref since I don't want to call it
-  is($@, "", "251 character & sigil ident ok");
-  eval qq[ \\&$xFC ];
-  like($@, qr/Identifier too long/, "too long id in & sigil ctx");
-
-  eval qq[ *$xFC ];
-  is($@, "", "252 character glob ident ok");
-  eval qq[ *$xFD ];
-  like($@, qr/Identifier too long/, "too long id in glob ctx");
-
-  eval qq[ for $xFC ];
-  like($@, qr/Missing \$ on loop variable/,
-       "252 char id ok, but a different error");
-  eval qq[ for $xFD; ];
-  like($@, qr/Identifier too long/, "too long id in for ctx");
-
-  # the specific case from the ticket
-  my $x = "x" x 257;
-  eval qq[ for $x ];
-  like($@, qr/Identifier too long/, "too long id ticket case");
-}
-
-{
-  is(exists &zlonk, '', 'sub not present');
-  eval qq[ {sub zlonk} ];
-  is($@, '', 'sub declaration followed by a closing curly');
-  is(exists &zlonk, 1, 'sub now stubbed');
-  is(defined &zlonk, '', 'but no body defined');
-}
-
-# [perl #113016] CORE::print::foo
-sub CORE'print'foo { 43 } # apostrophes intentional; do not tempt fate
-sub CORE'foo'bar { 43 }
-is CORE::print::foo, 43, 'CORE::print::foo is not CORE::print ::foo';
-is scalar eval "CORE::foo'bar", 43, "CORE::foo'bar is not an error";
-
-# bug #71748
-eval q{
-	$_ = "";
-	s/(.)/
-	{
-	    #
-	}->{$1};
-	/e;
-	1;
-};
-is($@, "", "multiline whitespace inside substitute expression");
-
-eval '@A =~ s/a/b/; # compilation error
-      sub tahi {}
-      sub rua;
-      sub toru ($);
-      sub wha :lvalue;
-      sub rima ($%&*$&*\$%\*&$%*&) :method;
-      sub ono :lvalue { die }
-      sub whitu (_) { die }
-      sub waru ($;) :method { die }
-      sub iwa { die }
-      BEGIN { }';
-is $::{tahi}, undef, 'empty sub decl ignored after compilation error';
-is $::{rua}, undef, 'stub decl ignored after compilation error';
-is $::{toru}, undef, 'stub+proto decl ignored after compilation error';
-is $::{wha}, undef, 'stub+attr decl ignored after compilation error';
-is $::{rima}, undef, 'stub+proto+attr ignored after compilation error';
-is $::{ono}, undef, 'sub decl with attr ignored after compilation error';
-is $::{whitu}, undef, 'sub decl w proto ignored after compilation error';
-is $::{waru}, undef, 'sub w attr+proto ignored after compilation error';
-is $::{iwa}, undef, 'non-empty sub decl ignored after compilation error';
-is *BEGIN{CODE}, undef, 'BEGIN leaves no stub after compilation error';
-
-$test = $test + 1;
-"ok $test - format inside re-eval" =~ /(?{
-    format =
-@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-$_
-.
-write
-}).*/;
-
-eval '
-"${;
-
-=pod
-
-=cut
-
-}";
-';
-is $@, "", 'pod inside string in string eval';
-"${;
-
-=pod
-
-=cut
-
-}";
-print "ok ", ++$test, " - pod inside string outside of string eval\n";
-
-like "blah blah blah\n", qr/${\ <<END
-blah blah blah
-END
- }/, 'here docs in multiline quoted construct';
-like "blah blah blah\n", eval q|qr/${\ <<END
-blah blah blah
-END
- }/|, 'here docs in multiline quoted construct in string eval';
-
-# Unterminated here-docs in subst in eval; used to crash
-eval 's/${<<END}//';
-eval 's//${<<END}/';
-print "ok ", ++$test, " - unterminated here-docs in s/// in string eval\n";
-
-sub 'Hello'_he_said (_);
-is prototype "Hello::_he_said", '_', 'initial tick in sub declaration';
-
-{
-    my @x = 'string';
-    is(eval q{ "$x[0]->strung" }, 'string->strung',
-	'literal -> after an array subscript within ""');
-    @x = ['string'];
-    # this used to give "string"
-    like("$x[0]-> [0]", qr/^ARRAY\([^)]*\)-> \[0]\z/,
-	'literal -> [0] after an array subscript within ""');
-}
-
-eval 'no if $] >= 5.17.4 warnings => "deprecated"';
-is 1,1, ' no crash for "no ... syntax error"';
-
-for my $pkg(()){}
-$pkg = 3;
-is $pkg, 3, '[perl #114942] for my $foo()){} $foo';
-
-# Check that format 'Foo still works after removing the hack from
-# force_word
-$test++;
-format 'one =
-ok @<< - format 'foo still works
-$test
-.
-{
-    local $~ = "one";
-    write();
-}
-
-$test++;
-format ::two =
-ok @<< - format ::foo still works
-$test
-.
-{
-    local $~ = "two";
-    write();
-}
-
-for(__PACKAGE__) {
-    eval '$_=42';
-    is $_, 'main', '__PACKAGE__ is read-only';
-}
-
-$file = __FILE__;
-BEGIN{ ${"_<".__FILE__} = \1 }
-is __FILE__, $file,
-    'no __FILE__ corruption when setting CopFILESV to a ref';
-
-eval 'Fooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo'
-    .'oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo'
-    .'oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo'
-    .'oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo'
-    .'oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo'
-    .'ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo';
-like $@, "^Identifier too long at ", 'ident buffer overflow';
-
-eval 'for my a1b $i (1) {}';
-# ng: 'Missing $ on loop variable'
-like $@, "^No such class a1b at ", 'TYPE of my of for statement';
-
-# Used to crash [perl #123542]
-eval 's /${<>{}) //';
-
-# Add new tests HERE (above this line)
-
-# bug #74022: Loop on characters in \p{OtherIDContinue}
-# This test hangs if it fails.
-eval chr 0x387;   # forces loading of utf8.pm
-is(1,1, '[perl #74022] Parser looping on OtherIDContinue chars');
-
-# More awkward tests for #line. Keep these at the end, as they will screw
-# with sane line reporting for any other test failures
-
-sub check ($$$) {
-    my ($file, $line, $name) =  @_;
-    my (undef, $got_file, $got_line) = caller;
-    like ($got_file, $file, "file of $name");
-    is ($got_line, $line, "line of $name");
-}
-
-my $this_file = qr/parser\.t(?:\.[bl]eb?)?$/;
-#line 3
-1 unless
-1;
-check($this_file, 5, "[perl #118931]");
-
-#line 3
-check($this_file, 3, "bare line");
-
-# line 5
-check($this_file, 5, "bare line with leading space");
-
-#line 7 
-check($this_file, 7, "trailing space still valid");
-
-# line 11 
-check($this_file, 11, "leading and trailing");
-
-#	line 13
-check($this_file, 13, "leading tab");
-
-#line	17
-check($this_file, 17, "middle tab");
-
-#line                                                                        19
-check($this_file, 19, "loadsaspaces");
-
-#line 23 KASHPRITZA
-check(qr/^KASHPRITZA$/, 23, "bare filename");
-
-#line 29 "KAHEEEE"
-check(qr/^KAHEEEE$/, 29, "filename in quotes");
-
-#line 31 "CLINK CLOINK BZZT"
-check(qr/^CLINK CLOINK BZZT$/, 31, "filename with spaces in quotes");
-
-#line 37 "THOOM	THOOM"
-check(qr/^THOOM	THOOM$/, 37, "filename with tabs in quotes");
-
-#line 41 "GLINK PLINK GLUNK DINK" 
-check(qr/^GLINK PLINK GLUNK DINK$/, 41, "a space after the quotes");
-
-#line 43 "BBFRPRAFPGHPP
-check(qr/^"BBFRPRAFPGHPP$/, 43, "actually missing a quote is still valid");
-
-#line 47 bang eth
-check(qr/^"BBFRPRAFPGHPP$/, 46, "but spaces aren't allowed without quotes");
-
-#line 77sevenseven
-check(qr/^"BBFRPRAFPGHPP$/, 49, "need a space after the line number");
-
-eval <<'EOSTANZA'; die $@ if $@;
-#line 51 "With wonderful deathless ditties|We build up the world's great cities,|And out of a fabulous story|We fashion an empire's glory:|One man with a dream, at pleasure,|Shall go forth and conquer a crown;|And three with a new song's measure|Can trample a kingdom down."
-check(qr/^With.*down\.$/, 51, "Overflow the second small buffer check");
-EOSTANZA
-
-# And now, turn on the debugger flag for long names
-$^P = 0x100;
-
-#line 53 "For we are afar with the dawning|And the suns that are not yet high,|And out of the infinite morning|Intrepid you hear us cry-|How, spite of your human scorning,|Once more God's future draws nigh,|And already goes forth the warning|That ye of the past must die."
-check(qr/^For we.*must die\.$/, 53, "Our long line is set up");
-
-eval <<'EOT'; die $@ if $@;
-#line 59 " "
-check(qr/^ $/, 59, "Overflow the first small buffer check only");
-EOT
-
-eval <<'EOSTANZA'; die $@ if $@;
-#line 61 "Great hail! we cry to the comers|From the dazzling unknown shore;|Bring us hither your sun and your summers;|And renew our world as of yore;|You shall teach us your song's new numbers,|And things that we dreamed not before:|Yea, in spite of a dreamer who slumbers,|And a singer who sings no more."
-check(qr/^Great hail!.*no more\.$/, 61, "Overflow both small buffer checks");
-EOSTANZA
-
-sub check_line ($$) {
-    my ($line, $name) =  @_;
-    my (undef, undef, $got_line) = caller;
-    is ($got_line, $line, $name);
-}
-
-#line 531 parser.t
-<<EOU; check_line(531, 'on same line as heredoc');
-EOU
-s//<<EOV/e if 0;
-EOV
-check_line(535, 'after here-doc in quotes');
-<<EOW; <<EOX;
-${check_line(537, 'first line of interp in here-doc');;
-  check_line(538, 'second line of interp in here-doc');}
-EOW
-${check_line(540, 'first line of interp in second here-doc on same line');;
-  check_line(541, 'second line of interp in second heredoc on same line');}
-EOX
-eval <<'EVAL';
-#line 545
-"${<<EOY; <<EOZ}";
-${check_line(546, 'first line of interp in here-doc in quotes in eval');;
-  check_line(547, 'second line of interp in here-doc in quotes in eval');}
-EOY
-${check_line(549, '1st line of interp in 2nd hd, same line in q in eval');;
-  check_line(550, '2nd line of interp in 2nd hd, same line in q in eval');}
-EOZ
-EVAL
-
-time
-#line 42
-;check_line(42, 'line number after "nullary\n#line"');
-
-"${
-#line 53
-_}";
-check_line(54, 'line number after qq"${#line}"');
-
-#line 24
-"
-${check_line(25, 'line number inside qq/<newline>${...}/')}";
-
-<<"END";
-${;
-#line 625
-}
-END
-check_line(627, 'line number after heredoc containing #line');
-
-#line 638
-<<ENE . ${
-
-ENE
-"bar"};
-check_line(642, 'line number after ${expr} surrounding heredoc body');
-
-
-__END__
-# Don't add new tests HERE. See note above
diff --git a/gnu/usr.bin/perl/t/op/sub.t b/gnu/usr.bin/perl/t/op/sub.t
index 7df8f49aaba..b6f90f48955 100644
--- a/gnu/usr.bin/perl/t/op/sub.t
+++ b/gnu/usr.bin/perl/t/op/sub.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan( tests => 33 );
+plan( tests => 4 );
 
 sub empty_sub {}
 
@@ -17,208 +17,3 @@ is(scalar(@test), 0, 'Didnt return anything');
 @test = empty_sub(1,2,3);
 is(scalar(@test), 0, 'Didnt return anything');
 
-# RT #63790:  calling PL_sv_yes as a sub is special-cased to silently
-# return (so Foo->import() silently fails if import() doesn't exist),
-# But make sure it correctly pops the stack and mark stack before returning.
-
-{
-    my @a;
-    push @a, 4, 5, main->import(6,7);
-    ok(eq_array(\@a, [4,5]), "import with args");
-
-    @a = ();
-    push @a, 14, 15, main->import;
-    ok(eq_array(\@a, [14,15]), "import without args");
-
-    my $x = 1;
-
-    @a = ();
-    push @a, 24, 25, &{$x == $x}(26,27);
-    ok(eq_array(\@a, [24,25]), "yes with args");
-
-    @a = ();
-    push @a, 34, 35, &{$x == $x};
-    ok(eq_array(\@a, [34,35]), "yes without args");
-}
-
-# [perl #81944] return should always copy
-{
-    $foo{bar} = 7;
-    for my $x ($foo{bar}) {
-	# Pity test.pl doesnt have isn't.
-	isnt \sub { delete $foo{bar} }->(), \$x,
-	   'result of delete(helem) is copied when returned';
-    }
-    $foo{bar} = 7;
-    for my $x ($foo{bar}) {
-	isnt \sub { return delete $foo{bar} }->(), \$x,
-	   'result of delete(helem) is copied when explicitly returned';
-    }
-    my $x;
-    isnt \sub { delete $_[0] }->($x), \$x,
-      'result of delete(aelem) is copied when returned';
-    isnt \sub { return delete $_[0] }->($x), \$x,
-      'result of delete(aelem) is copied when explicitly returned';
-    isnt \sub { ()=\@_; shift }->($x), \$x,
-      'result of shift is copied when returned';
-    isnt \sub { ()=\@_; return shift }->($x), \$x,
-      'result of shift is copied when explicitly returned';
-}
-
-fresh_perl_is
-  <<'end', "main::foo\n", {}, 'sub redefinition sets CvGV';
-*foo = \&baz;
-*bar = *foo;
-eval 'sub bar { print +(caller 0)[3], "\n" }';
-bar();
-end
-
-fresh_perl_is
-  <<'end', "main::foo\nok\n", {}, 'no double free redefining anon stub';
-my $sub = sub { 4 };
-*foo = $sub;
-*bar = *foo;
-undef &$sub;
-eval 'sub bar { print +(caller 0)[3], "\n" }';
-&$sub;
-undef *foo;
-undef *bar;
-print "ok\n";
-end
-
-# The outer call sets the scalar returned by ${\""}.${\""} to the current
-# package name.
-# The inner call sets it to "road".
-# Each call records the value twice, the outer call surrounding the inner
-# call.  In 5.10-5.18 under ithreads, what gets pushed is
-# qw(main road road road) because the inner call is clobbering the same
-# scalar.  If __PACKAGE__ is changed to "main", it works, the last element
-# becoming "main".
-my @scratch;
-sub a {
-  for (${\""}.${\""}) {
-    $_ = $_[0];
-    push @scratch, $_;
-    a("road",1) unless $_[1];
-    push @scratch, $_;
-  }
-}
-a(__PACKAGE__);
-require Config;
-is "@scratch", "main road road main",
-   'recursive calls do not share shared-hash-key TARGs';
-
-# Another test for the same bug, that does not rely on foreach.  It depends
-# on ref returning a shared hash key TARG.
-undef @scratch;
-sub b {
-    my ($pack, $depth) = @_;
-    my $o = bless[], $pack;
-    $pack++;
-    push @scratch, (ref $o, $depth||b($pack,$depth+1))[0];
-}
-b('n',0);
-is "@scratch", "o n", 
-   'recursive calls do not share shared-hash-key TARGs (2)';
-
-# [perl #78194] @_ aliasing op return values
-sub { is \$_[0], \$_[0],
-        '[perl #78194] \$_[0] == \$_[0] when @_ aliases "$x"' }
- ->("${\''}");
-
-# The return statement should make no difference in this case:
-sub not_constant () {        42 }
-sub not_constantr() { return 42 }
-use feature 'lexical_subs'; no warnings 'experimental::lexical_subs';
-my sub not_constantm () {        42 }
-my sub not_constantmr() { return 42 }
-eval { ${\not_constant}++ };
-is $@, "", 'sub (){42} returns a mutable value';
-eval { ${\not_constantr}++ };
-is $@, "", 'sub (){ return 42 } returns a mutable value';
-eval { ${\not_constantm}++ };
-is $@, "", 'my sub (){42} returns a mutable value';
-eval { ${\not_constantmr}++ };
-is $@, "", 'my sub (){ return 42 } returns a mutable value';
-is eval {
-    sub Crunchy () { 1 }
-    sub Munchy { $_[0] = 2 }
-    eval "Crunchy"; # test that freeing this op does not turn off PADTMP
-    Munchy(Crunchy);
-} || $@, 2, 'freeing ops does not make sub(){42} immutable';
-
-# [perl #79908]
-{
-    my $x = 5;
-    *_79908 = sub (){$x};
-    $x = 7;
-    TODO: {
-        local $TODO = "Should be fixed with a deprecation cycle, see 'How about having a recommended way to add constant subs dynamically?' on p5p";
-        is eval "_79908", 7, 'sub(){$x} does not break closures';
-    }
-    isnt eval '\_79908', \$x, 'sub(){$x} returns a copy';
-
-    # Test another thing that was broken by $x inlinement
-    my $y;
-    no warnings 'once';
-    local *time = sub():method{$y};
-    my $w;
-    local $SIG{__WARN__} = sub { $w .= shift };
-    eval "()=time";
-    TODO: {
-        local $TODO = "Should be fixed with a deprecation cycle, see 'How about having a recommended way to add constant subs dynamically?' on p5p";
-        is $w, undef,
-          '*keyword = sub():method{$y} does not cause ambiguity warnings';
-    }
-}
-
-# &xsub when @_ has nonexistent elements
-{
-    no warnings "uninitialized";
-    local @_ = ();
-    $#_++;
-    &utf8::encode;
-    is @_, 1, 'num of elems in @_ after &xsub with nonexistent $_[0]';
-    is $_[0], "", 'content of nonexistent $_[0] is modified by &xsub';
-}
-
-# &xsub when @_ itself does not exist
-undef *_;
-eval { &utf8::encode };
-# The main thing we are testing is that it did not crash.  But make sure 
-# *_{ARRAY} was untouched, too.
-is *_{ARRAY}, undef, 'goto &xsub when @_ does not exist';
-
-# We do not want re.pm loaded at this point.  Move this test up or find
-# another XSUB if this fails.
-ok !exists $INC{"re.pm"}, 're.pm not loaded yet';
-{
-    sub re::regmust{}
-    bless \&re::regmust;
-    DESTROY {
-        no warnings 'redefine', 'prototype';
-        my $str1 = "$_[0]";
-        *re::regmust = sub{}; # GvSV had no refcount, so this freed it
-        my $str2 = "$_[0]";   # used to be UNKNOWN(0x7fdda29310e0)
-        @str = ($str1, $str2);
-    }
-    local $^W; # Suppress redef warnings in XSLoader
-    require re;
-    is $str[1], $str[0],
-      'XSUB clobbering sub whose DESTROY assigns to the glob';
-}
-{
-    no warnings 'redefine';
-    sub foo {}
-    bless \&foo, 'newATTRSUBbug';
-    sub newATTRSUBbug::DESTROY {
-        my $str1 = "$_[0]";
-        *foo = sub{}; # GvSV had no refcount, so this freed it
-        my $str2 = "$_[0]";   # used to be UNKNOWN(0x7fdda29310e0)
-        @str = ($str1, $str2);
-    }
-    splice @str;
-    eval "sub foo{}";
-    is $str[1], $str[0],
-      'Pure-Perl sub clobbering sub whose DESTROY assigns to the glob';
-}
diff --git a/gnu/usr.bin/perl/t/run/switchd.t b/gnu/usr.bin/perl/t/run/switchd.t
index d24d98b54b8..160ea9970df 100644
--- a/gnu/usr.bin/perl/t/run/switchd.t
+++ b/gnu/usr.bin/perl/t/run/switchd.t
@@ -5,15 +5,15 @@ BEGIN {
     @INC = qw(../lib lib);
 }
 
-BEGIN { require "./test.pl"; }
+require "./test.pl";
 
-# This test depends on t/lib/Devel/switchd*.pm.
-
-plan(tests => 19);
+plan(tests => 1);
 
 my $r;
+my @tmpfiles = ();
+END { unlink @tmpfiles }
 
-my $filename = tempfile();
+my $filename = 'swdtest.tmp';
 SKIP: {
 	open my $f, ">$filename"
 	    or skip( "Can't write temp file $filename: $!" );
@@ -29,259 +29,12 @@ package main;
 Foo::foo(3);
 __SWDTEST__
     close $f;
+    push @tmpfiles, $filename;
     $| = 1; # Unbufferize.
     $r = runperl(
-		 switches => [ '-Ilib', '-f', '-d:switchd' ],
-		 progfile => $filename,
-		 args => ['3'],
-		);
-    like($r,
-qr/^sub<Devel::switchd::import>;import<Devel::switchd>;DB<main,$::tempfile_regexp,9>;sub<Foo::foo>;DB<Foo,$::tempfile_regexp,5>;DB<Foo,$::tempfile_regexp,6>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;$/,
-    'Got debugging output: 1');
-    $r = runperl(
-		 switches => [ '-Ilib', '-f', '-d:switchd=a,42' ],
+		 switches => [ '-Ilib', '-d:switchd' ],
 		 progfile => $filename,
-		 args => ['4'],
 		);
-    like($r,
-qr/^sub<Devel::switchd::import>;import<Devel::switchd a 42>;DB<main,$::tempfile_regexp,9>;sub<Foo::foo>;DB<Foo,$::tempfile_regexp,5>;DB<Foo,$::tempfile_regexp,6>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;$/,
-    'Got debugging output: 2');
-    $r = runperl(
-		 switches => [ '-Ilib', '-f', '-d:-switchd=a,42' ],
-		 progfile => $filename,
-		 args => ['4'],
-		);
-    like($r,
-qr/^sub<Devel::switchd::unimport>;unimport<Devel::switchd a 42>;DB<main,$::tempfile_regexp,9>;sub<Foo::foo>;DB<Foo,$::tempfile_regexp,5>;DB<Foo,$::tempfile_regexp,6>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;$/,
-    'Got debugging output: 3');
+    like($r, qr/^main,swdtest.tmp,9;Foo,swdtest.tmp,5;Foo,swdtest.tmp,6;Foo,swdtest.tmp,6;Bar,swdtest.tmp,2;Bar,swdtest.tmp,2;Bar,swdtest.tmp,2;$/i);
 }
 
-# [perl #71806]
-cmp_ok(
-  runperl(       # less is useful for something :-)
-   switches => [ '"-Mless ++INC->{q-Devel/_.pm-}"' ],
-   progs    => [
-    '#!perl -d:_',
-    'sub DB::DB{} print scalar @{q/_</.__FILE__}',
-   ],
-  ),
- '>',
-  0,
- 'The debugger can see the lines of the main program under #!perl -d',
-);
-
-like
-  runperl(
-   switches => [ '"-Mless ++INC->{q-Devel/_.pm-}"' ],
-   progs    => [
-    '#!perl -d:_',
-    'sub DB::DB{} print line=>__LINE__',
-   ],
-  ),
-  qr/line2/,
- '#!perl -d:whatever does not throw line numbers off';
-
-# [perl #48332]
-like(
-  runperl(
-   switches => [ '-Ilib', '-d:switchd_empty' ],
-   progs    => [
-    'sub foo { print qq _1\n_ }',
-    '*old_foo = \&foo;',
-    '*foo = sub { print qq _2\n_ };',
-    'old_foo(); foo();',
-   ],
-  ),
-  qr "1\r?\n2\r?\n",
- 'Subroutine redefinition works in the debugger [perl #48332]',
-);
-
-# [rt.cpan.org #69862]
-like(
-  runperl(
-   switches => [ '-Ilib', '-d:switchd_empty' ],
-   progs    => [
-    'sub DB::sub { goto &$DB::sub }',
-    'sub foo { print qq _1\n_ }',
-    'sub bar { print qq _2\n_ }',
-    'delete $::{foo}; eval { foo() };',
-    'my $bar = *bar; undef *bar; eval { &$bar };',
-   ],
-  ),
-  qr "1\r?\n2\r?\n",
- 'Subroutines no longer found under their names can be called',
-);
-
-# [rt.cpan.org #69862]
-like(
-  runperl(
-   switches => [ '-Ilib', '-d:switchd_empty' ],
-   progs    => [
-    'sub DB::sub { goto &$DB::sub }',
-    'sub foo { goto &bar::baz; }',
-    'sub bar::baz { print qq _ok\n_ }',
-    'delete $::{bar::::};',
-    'foo();',
-   ],
-  ),
-  qr "ok\r?\n",
- 'No crash when calling orphaned subroutine via goto &',
-);
-
-# test when DB::DB is seen but not defined [perl #114990]
-like(
-  runperl(
-    switches => [ '-Ilib', '-d:nodb' ],
-    prog     => [ '1' ],
-    stderr   => 1,
-  ),
-  qr/^No DB::DB routine defined/,
-  "No crash when *DB::DB exists but not &DB::DB",
-);
-like(
-  runperl(
-    switches => [ '-Ilib' ],
-    prog     => 'sub DB::DB; BEGIN { $^P = 0x22; } for(0..9){ warn }',
-    stderr   => 1,
-  ),
-  qr/^No DB::DB routine defined/,
-  "No crash when &DB::DB exists but isn't actually defined",
-);
-# or seen and defined later
-is(
-  runperl(
-    switches => [ '-Ilib', '-d:nodb' ], # nodb.pm contains *DB::DB...if 0
-    prog     => 'warn; sub DB::DB { print qq-ok\n-; exit }',
-    stderr   => 1,
-  ),
-  "ok\n",
-  "DB::DB works after '*DB::DB if 0'",
-);
-
-# [perl #115742] Recursive DB::DB clobbering its own pad
-like(
-  runperl(
-    switches => [ '-Ilib' ],
-    progs    => [ split "\n", <<'='
-     BEGIN {
-      $^P = 0x22;
-     }
-     package DB;
-     sub DB {
-      my $x = 42;
-      return if $__++;
-      $^D |= 1 << 30; # allow recursive calls
-      main::foo();
-      print $x//q-u-, qq-\n-;
-     }
-     package main;
-     chop;
-     sub foo { chop; }
-=
-    ],
-    stderr   => 1,
-  ),
-  qr/42/,
-  "Recursive DB::DB does not clobber its own pad",
-);
-
-# [perl #118627]
-like(
-  runperl(
-   switches => [ '-Ilib', '-d:switchd_empty' ],
-   prog     => 'print @{q|_<-e|}',
-  ),
-  qr "use Devel::switchd_empty;(?:BEGIN|\r?\nprint)",
-                         # miniperl tacks a BEGIN block on to the same line
- 'Copy on write does not mangle ${"_<-e"}[0] [perl #118627]',
-);
-
-# PERL5DB with embedded newlines
-{
-    local $ENV{PERL5DB} = "sub DB::DB{}\nwarn";
-    is(
-      runperl(
-       switches => [ '-Ilib', '-ld' ],
-       prog     => 'warn',
-       stderr   => 1
-      ),
-      "Warning: something's wrong.\n"
-     ."Warning: something's wrong at -e line 1.\n",
-     'PERL5DB with embedded newlines',
-    );
-}
-
-# test that DB::goto works
-is(
-  runperl(
-   switches => [ '-Ilib', '-d:switchd_goto' ],
-   prog => 'sub baz { print qq|hello;\n| } sub foo { goto &baz } foo()',
-   stderr => 1,
-  ),
-  "goto<main::baz>;hello;\n",
-  "DB::goto"
-);
-
-# Test that %DB::lsub is not vivified
-is(
-  runperl(
-   switches => [ '-Ilib', '-d:switchd_empty' ],
-   progs => ['sub DB::sub {} sub foo : lvalue {} foo();',
-             'print qq-ok\n- unless defined *DB::lsub{HASH}'],
-  ),
-  "ok\n",
-  "%DB::lsub is not vivified"
-);
-
-# Test setting of breakpoints without *DB::dbline aliased
-is(
-  runperl(
-   switches => [ '-Ilib', '-d:nodb' ],
-   progs => [ split "\n",
-    'sub DB::DB {
-      $DB::single = 0, return if $DB::single; print qq[ok\n]; exit
-     }
-     ${q(_<).__FILE__}{6} = 1; # set a breakpoint
-     sub foo {
-         die; # line 6
-     }
-     foo();
-    '
-   ],
-   stderr => 1
-  ),
-  "ok\n",
-  "setting breakpoints without *DB::dbline aliased"
-);
-
-# [perl #121255]
-# Check that utf8 caches are flushed when $DB::sub is set
-is(
-  runperl(
-   switches => [ '-Ilib', '-d:switchd_empty' ],
-   progs => [ split "\n",
-    'sub DB::sub{length($DB::sub); goto &$DB::sub}
-     ${^UTF8CACHE}=-1;
-     print
-       eval qq|sub oo\x{25f} { 42 }
-               sub ooooo\x{25f} { oo\x{25f}() }
-               ooooo\x{25f}()| 
-        || $@,
-       qq|\n|;
-    '
-   ],
-   stderr => 1
-  ),
-  "42\n",
-  'UTF8 length caches on $DB::sub are flushed'
-);
-
-# [perl #122771] -d conflicting with sort optimisations
-is(
-  runperl(
-   switches => [ '-Ilib', '-d:switchd_empty' ],
-   prog => 'BEGIN { $^P &= ~0x4 } sort { $$b <=> $$a } (); print qq-42\n-',
-  ),
-  "42\n",
-  '-d does not conflict with sort optimisations'
-);