virgin perl 5.6.0

9 files changed, 687 insertions, 736 deletions

diff --git a/gnu/usr.bin/perl/emacs/e2ctags.pl b/gnu/usr.bin/perl/emacs/e2ctags.pl
index 34e3e14b54d..ef7a8d8539a 100644
--- a/gnu/usr.bin/perl/emacs/e2ctags.pl
+++ b/gnu/usr.bin/perl/emacs/e2ctags.pl
@@ -16,7 +16,6 @@ use strict;
 my $filename;
 my ($tag,$line_no,$line);
 my %tags = ();
-my %filetags = ();
 my %files = ();
 my @lines = ();
 
@@ -35,17 +34,21 @@ while (<>) {
   next if /struct/;
   if (/\x01/) {
     ($tag,$line_no) = /\x7F(\w+)\x01(\d+)/;
+    next unless $tag;
+    ##Take only the first entry per tag
+    next if defined($tags{$tag});
+    $tags{$tag}{FILE} = $filename;
+    $tags{$tag}{LINE_NO} = $line_no;
   }
   else {
     tr/(//d;
     ($tag,$line_no) = /(\w+)\s*\x7F(\d+),/;
+    next unless $tag;
+    ##Take only the first entry per tag
+    next if defined($tags{$tag});
+    $tags{$tag}{FILE} = $filename;
+    $tags{$tag}{LINE_NO} = $line_no;
   }
-  next unless $tag;
-  ##Take only the first entry per tag
-  next if defined($tags{$tag});
-  $tags{$tag}{FILE} = $filename;
-  $tags{$tag}{LINE_NO} = $line_no;
-  push @{$filetags{$filename}}, $tag;
 }
 
 foreach $filename (keys %files) {
@@ -53,7 +56,8 @@ foreach $filename (keys %files) {
   @lines = <FILE>;
   close FILE;
   chomp @lines;
-  foreach $tag ( @{$filetags{$filename}} ) {
+  foreach $tag ( keys %tags ) {
+    next unless $filename eq $tags{$tag}{FILE};
     $line = $lines[$tags{$tag}{LINE_NO}-1];
     if (length($line) >= 50) {
       $line = substr($line,0,50);
diff --git a/gnu/usr.bin/perl/ext/B/defsubs_h.PL b/gnu/usr.bin/perl/ext/B/defsubs_h.PL
index 684ca26fb07..80ef936fcec 100644
--- a/gnu/usr.bin/perl/ext/B/defsubs_h.PL
+++ b/gnu/usr.bin/perl/ext/B/defsubs_h.PL
@@ -1,86 +1,24 @@
 # Do not remove the following line; MakeMaker relies on it to identify
 # this file as a template for defsubs.h
 # Extracting defsubs.h (with variable substitutions)
-#!perl -w
-use File::Spec;
-my (undef, $headerpath) = @ARGV;
+#!perl
 my ($out) = __FILE__ =~ /(^.*)\.PL/i;
 $out =~ s/_h$/.h/;
-unlink $out if -l $out;
 open(OUT,">$out") || die "Cannot open $file:$!";
 print "Extracting $out...\n";
-print OUT <<"END";
-/*
- !!! Don't modify this file - it's autogenerated from $0 !!!
- */
-END
-
-foreach my $const (qw(
-		      CVf_ANON
-		      CVf_CLONE
-		      CVf_CLONED
-		      CVf_CONST
-		      CVf_LVALUE
-		      CVf_METHOD
-		      CVf_NODEBUG
-		      CVf_UNIQUE
-		      CVf_WEAKOUTSIDE
-		      GVf_IMPORTED_AV
-		      GVf_IMPORTED_CV
-		      GVf_IMPORTED_HV
-		      GVf_IMPORTED_SV
+foreach my $const (qw(AVf_REAL 
 		      HEf_SVKEY
-		      SVTYPEMASK
-		      SVf_FAKE
-		      SVf_IOK
-		      SVf_IVisUV
-		      SVf_NOK
-		      SVf_POK
-		      SVf_READONLY
-		      SVf_ROK
-		      SVp_IOK
-		      SVp_NOK
-		      SVp_POK
-		      SVpad_OUR
-		      SVs_RMG
-		      SVs_SMG
-		      SVt_PVGV
-		      SVt_PVHV
-		      PAD_FAKELEX_ANON
-		      PAD_FAKELEX_MULTI
-		      ))
+                      SVf_IOK SVf_IVisUV SVf_NOK SVf_POK 
+		      SVf_ROK SVp_IOK SVp_POK ))
  {
   doconst($const);
  }
-
-if ($] < 5.009) {
-    # This is only present in 5.10, but it's useful to B::Deparse to be able
-    # to import a dummy value from B
-    doconst(OPpPAD_STATE);
-}
-
-if ($] >= 5.009) {
-    # Constant not present in 5.8.x
-    doconst(CVf_ISXSUB);
-} else {
-    # Constant not present after 5.8.x
-    doconst(AVf_REAL);
-}  
-
-if ($] < 5.011) {
-    # Constant not present after 5.10.x
-    doconst(CVf_LOCKED);
-}
-
-foreach my $tuple (['op.h'],['cop.h'],['regexp.h','RXf_'])
+foreach my $file (qw(op.h cop.h))
  {
-  my $file = $tuple->[0];
-  my $pfx = $tuple->[1] || '';
-  my $path = File::Spec->catfile($headerpath, $file);
-  open(OPH,"$path") || die "Cannot open $path:$!";
+  open(OPH,"../../$file") || die "Cannot open ../../$file:$!";
   while (<OPH>)
    {  
-    doconst($1) if (/#define\s+($pfx\w+)\s+([\(\)\|\dx]+)\s*(?:$|\/\*)/);
+    doconst($1) if (/#define\s+(\w+)\s+([\(\)\|\dx]+)\s*(?:$|\/\*)/);
    }  
   close(OPH);
  }
diff --git a/gnu/usr.bin/perl/lib/Carp/Heavy.pm b/gnu/usr.bin/perl/lib/Carp/Heavy.pm
index 38f95d8a5aa..5e3de49418b 100644
--- a/gnu/usr.bin/perl/lib/Carp/Heavy.pm
+++ b/gnu/usr.bin/perl/lib/Carp/Heavy.pm
@@ -1,10 +1,253 @@
 package Carp;
 
-# On one line so MakeMaker will see it.
-use Carp;  our $VERSION = $Carp::VERSION;
+=head1 NAME
 
-1;
+Carp::Heavy - Carp guts
+
+=head1 SYNOPIS
+
+(internal use only)
+
+=head1 DESCRIPTION
+
+No user-serviceable parts inside.
+
+=cut
+
+# This package is heavily used. Be small. Be fast. Be good.
+
+# Comments added by Andy Wardley <abw@kfs.org> 09-Apr-98, based on an
+# _almost_ complete understanding of the package.  Corrections and
+# comments are welcome.
+
+# longmess() crawls all the way up the stack reporting on all the function
+# calls made.  The error string, $error, is originally constructed from the
+# arguments passed into longmess() via confess(), cluck() or shortmess().
+# This gets appended with the stack trace messages which are generated for
+# each function call on the stack.
+
+sub longmess_heavy {
+    return @_ if ref $_[0];
+    my $error = join '', @_;
+    my $mess = "";
+    my $i = 1 + $CarpLevel;
+    my ($pack,$file,$line,$sub,$hargs,$eval,$require);
+    my (@a);
+    #
+    # crawl up the stack....
+    #
+    while (do { { package DB; @a = caller($i++) } } ) {
+	# get copies of the variables returned from caller()
+	($pack,$file,$line,$sub,$hargs,undef,$eval,$require) = @a;
+	#
+	# if the $error error string is newline terminated then it
+	# is copied into $mess.  Otherwise, $mess gets set (at the end of
+	# the 'else {' section below) to one of two things.  The first time
+	# through, it is set to the "$error at $file line $line" message.
+	# $error is then set to 'called' which triggers subsequent loop
+	# iterations to append $sub to $mess before appending the "$error
+	# at $file line $line" which now actually reads "called at $file line
+	# $line".  Thus, the stack trace message is constructed:
+	#
+	#        first time: $mess  = $error at $file line $line
+	#  subsequent times: $mess .= $sub $error at $file line $line
+	#                                  ^^^^^^
+	#                                 "called"
+	if ($error =~ m/\n$/) {
+	    $mess .= $error;
+	} else {
+	    # Build a string, $sub, which names the sub-routine called.
+	    # This may also be "require ...", "eval '...' or "eval {...}"
+	    if (defined $eval) {
+		if ($require) {
+		    $sub = "require $eval";
+		} else {
+		    $eval =~ s/([\\\'])/\\$1/g;
+		    if ($MaxEvalLen && length($eval) > $MaxEvalLen) {
+			substr($eval,$MaxEvalLen) = '...';
+		    }
+		    $sub = "eval '$eval'";
+		}
+	    } elsif ($sub eq '(eval)') {
+		$sub = 'eval {...}';
+	    }
+	    # if there are any arguments in the sub-routine call, format
+	    # them according to the format variables defined earlier in
+	    # this file and join them onto the $sub sub-routine string
+	    if ($hargs) {
+		# we may trash some of the args so we take a copy
+		@a = @DB::args;	# must get local copy of args
+		# don't print any more than $MaxArgNums
+		if ($MaxArgNums and @a > $MaxArgNums) {
+		    # cap the length of $#a and set the last element to '...'
+		    $#a = $MaxArgNums;
+		    $a[$#a] = "...";
+		}
+		for (@a) {
+		    # set args to the string "undef" if undefined
+		    $_ = "undef", next unless defined $_;
+		    if (ref $_) {
+			# force reference to string representation
+			$_ .= '';
+			s/'/\\'/g;
+		    }
+		    else {
+			s/'/\\'/g;
+			# terminate the string early with '...' if too long
+			substr($_,$MaxArgLen) = '...'
+			    if $MaxArgLen and $MaxArgLen < length;
+		    }
+		    # 'quote' arg unless it looks like a number
+		    $_ = "'$_'" unless /^-?[\d.]+$/;
+		    # print high-end chars as 'M-<char>'
+		    s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
+		    # print remaining control chars as ^<char>
+		    s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
+		}
+		# append ('all', 'the', 'arguments') to the $sub string
+		$sub .= '(' . join(', ', @a) . ')';
+	    }
+	    # here's where the error message, $mess, gets constructed
+	    $mess .= "\t$sub " if $error eq "called";
+	    $mess .= "$error at $file line $line";
+	    if (defined &Thread::tid) {
+		my $tid = Thread->self->tid;
+		$mess .= " thread $tid" if $tid;
+	    }
+	    $mess .= "\n";
+	}
+	# we don't need to print the actual error message again so we can
+	# change this to "called" so that the string "$error at $file line
+	# $line" makes sense as "called at $file line $line".
+	$error = "called";
+    }
+    # this kludge circumvents die's incorrect handling of NUL
+    my $msg = \($mess || $error);
+    $$msg =~ tr/\0//d;
+    $$msg;
+}
+
+
+# ancestors() returns the complete set of ancestors of a module
+
+sub ancestors($$);
 
-# Most of the machinery of Carp used to be there.
-# It has been moved in Carp.pm now, but this placeholder remains for
-# the benefit of modules that like to preload Carp::Heavy directly.
+sub ancestors($$){
+    my( $pack, $href ) = @_;
+    if( @{"${pack}::ISA"} ){
+	my $risa = \@{"${pack}::ISA"};
+	my %tree  = ();
+	@tree{@$risa} = ();
+	foreach my $mod ( @$risa ){
+	    # visit ancestors - if not already in the gallery
+	    if( ! defined( $$href{$mod} ) ){
+		my @ancs = ancestors( $mod, $href );
+		@tree{@ancs} = ();
+	    }
+	}
+	return ( keys( %tree ) );
+    } else {
+	return ();
+    }
+}
+
+
+# shortmess() is called by carp() and croak() to skip all the way up to
+# the top-level caller's package and report the error from there.  confess()
+# and cluck() generate a full stack trace so they call longmess() to
+# generate that.  In verbose mode shortmess() calls longmess() so
+# you always get a stack trace
+
+sub shortmess_heavy {	# Short-circuit &longmess if called via multiple packages
+    goto &longmess_heavy if $Verbose;
+    return @_ if ref $_[0];
+    my $error = join '', @_;
+    my ($prevpack) = caller(1);
+    my $extra = $CarpLevel;
+
+    my @Clans = ( $prevpack );
+    my $i = 2;
+    my ($pack,$file,$line);
+    # when reporting an error, we want to report it from the context of the
+    # calling package.  So what is the calling package?  Within a module,
+    # there may be many calls between methods and perhaps between sub-classes
+    # and super-classes, but the user isn't interested in what happens
+    # inside the package.  We start by building a hash array which keeps
+    # track of all the packages to which the calling package belongs.  We
+    # do this by examining its @ISA variable.  Any call from a base class
+    # method (one of our caller's @ISA packages) can be ignored
+    my %isa;
+
+    # merge all the caller's @ISA packages and ancestors into %isa.
+    my @pars = ancestors( $prevpack, \%isa );
+    @isa{@pars} = () if @pars;
+    $isa{$prevpack} = 1;
+
+    # now we crawl up the calling stack and look at all the packages in
+    # there.  For each package, we look to see if it has an @ISA and then
+    # we see if our caller features in that list.  That would imply that
+    # our caller is a derived class of that package and its calls can also
+    # be ignored
+CALLER:
+    while (($pack,$file,$line) = caller($i++)) {
+
+        # Chances are, the caller's caller (or its caller...) is already
+        # in the gallery - if so, ignore this caller.
+        next if exists( $isa{$pack} );
+
+        # no: collect this module's ancestors.
+        my @i = ancestors( $pack, \%isa );
+        my %i;
+        if( @i ){
+ 	    @i{@i} = ();
+            # check whether our representative of one of the clans is
+            # in this family tree.
+	    foreach my $cl (@Clans){
+                if( exists( $i{$cl} ) ){
+    	            # yes: merge all of the family tree into %isa
+	            @isa{@i,$pack} = ();
+		    # and here's where we do some more ignoring...
+		    # if the package in question is one of our caller's
+		    # base or derived packages then we can ignore it (skip it)
+		    # and go onto the next.
+		    next CALLER if exists( $isa{$pack} );
+		    last;
+		}
+            }
+	}
+
+	# Hey!  We've found a package that isn't one of our caller's
+	# clan....but wait, $extra refers to the number of 'extra' levels
+	# we should skip up.  If $extra > 0 then this is a false alarm.
+	# We must merge the package into the %isa hash (so we can ignore it
+	# if it pops up again), decrement $extra, and continue.
+	if ($extra-- > 0) {
+	    push( @Clans, $pack );
+	    @isa{@i,$pack} = ();
+	}
+	else {
+	    # OK!  We've got a candidate package.  Time to construct the
+	    # relevant error message and return it.   die() doesn't like
+	    # to be given NUL characters (which $msg may contain) so we
+	    # remove them first.
+	    my $msg;
+	    $msg = "$error at $file line $line";
+	    if (defined &Thread::tid) {
+		my $tid = Thread->self->tid;
+		$mess .= " thread $tid" if $tid;
+	    }
+	    $msg .= "\n";
+	    $msg =~ tr/\0//d;
+	    return $msg;
+	}
+    }
+
+    # uh-oh!  It looks like we crawled all the way up the stack and
+    # never found a candidate package.  Oh well, let's call longmess
+    # to generate a full stack trace.  We use the magical form of 'goto'
+    # so that this shortmess() function doesn't appear on the stack
+    # to further confuse longmess() about it's calling package.
+    goto &longmess_heavy;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/pod/perlcompile.pod b/gnu/usr.bin/perl/pod/perlcompile.pod
index 505ce68384f..697cb80d409 100644
--- a/gnu/usr.bin/perl/pod/perlcompile.pod
+++ b/gnu/usr.bin/perl/pod/perlcompile.pod
@@ -9,16 +9,17 @@ internal form (a parse tree) which is then optimized before being
 run.  Since version 5.005, Perl has shipped with a module
 capable of inspecting the optimized parse tree (C<B>), and this has
 been used to write many useful utilities, including a module that lets
-you turn your Perl into C source code that can be compiled into a
+you turn your Perl into C source code that can be compiled into an
 native executable.
 
 The C<B> module provides access to the parse tree, and other modules
 ("back ends") do things with the tree.  Some write it out as
-semi-human-readable text.  Another traverses the parse tree to build a
-cross-reference of which subroutines, formats, and variables are used
-where.  Another checks your code for dubious constructs.  Yet another back
-end dumps the parse tree back out as Perl source, acting as a source code
-beautifier or deobfuscator.
+bytecode, C source code, or a semi-human-readable text.  Another
+traverses the parse tree to build a cross-reference of which
+subroutines, formats, and variables are used where.  Another checks
+your code for dubious constructs.  Yet another back end dumps the
+parse tree back out as Perl source, acting as a source code beautifier
+or deobfuscator.
 
 Because its original purpose was to be a way to produce C code
 corresponding to a Perl program, and in turn a native executable, the
@@ -36,7 +37,8 @@ what problems there are, and how to work around them.
 
 The compiler back ends are in the C<B::> hierarchy, and the front-end
 (the module that you, the user of the compiler, will sometimes
-interact with) is the O module.
+interact with) is the O module.  Some back ends (e.g., C<B::C>) have
+programs (e.g., I<perlcc>) to hide the modules' complexity.
 
 Here are the important back ends to know about, with their status
 expressed as a number from 0 (outline for later implementation) to
@@ -44,6 +46,30 @@ expressed as a number from 0 (outline for later implementation) to
 
 =over 4
 
+=item B::Bytecode
+
+Stores the parse tree in a machine-independent format, suitable
+for later reloading through the ByteLoader module.  Status: 5 (some
+things work, some things don't, some things are untested).
+
+=item B::C
+
+Creates a C source file containing code to rebuild the parse tree
+and resume the interpreter.  Status: 6 (many things work adequately,
+including programs using Tk).
+
+=item B::CC
+
+Creates a C source file corresponding to the run time code path in
+the parse tree.  This is the closest to a Perl-to-C translator there
+is, but the code it generates is almost incomprehensible because it
+translates the parse tree into a giant switch structure that
+manipulates Perl structures.  Eventual goal is to reduce (given
+sufficient type information in the Perl program) some of the
+Perl data structure manipulations into manipulations of C-level
+ints, floats, etc.  Status: 5 (some things work, including
+uncomplicated Tk examples).
+
 =item B::Lint
 
 Complains if it finds dubious constructs in your source code.  Status:
@@ -134,7 +160,7 @@ I<myperlprogram> to the file I<report>:
 =head2 The Decompiling Back End
 
 The Deparse back end turns your Perl source back into Perl source.  It
-can reformat along the way, making it useful as a deobfuscator.  The
+can reformat along the way, making it useful as a de-obfuscator.  The
 most basic way to use it is:
 
   $ perl -MO=Deparse myperlprogram
@@ -157,6 +183,9 @@ one-liners:
       rename $was, $_ unless $was eq $_;
   }
 
+(this is the I<rename> program that comes in the I<eg/> directory
+of the Perl source distribution).
+
 The decompiler has several options for the code it generates.  For
 instance, you can set the size of each indent from 4 (as above) to
 2 with:
@@ -190,7 +219,57 @@ To disable context checks and undefined subroutines:
 
 See L<B::Lint> for information on the options.
 
-=head1 Module List for the Compiler Suite
+=head2 The Simple C Back End
+
+This module saves the internal compiled state of your Perl program
+to a C source file, which can be turned into a native executable
+for that particular platform using a C compiler.  The resulting
+program links against the Perl interpreter library, so it
+will not save you disk space (unless you build Perl with a shared
+library) or program size.  It may, however, save you startup time.
+
+The C<perlcc> tool generates such executables by default.
+
+  perlcc myperlprogram.pl
+
+=head2 The Bytecode Back End
+
+This back end is only useful if you also have a way to load and
+execute the bytecode that it produces.  The ByteLoader module provides
+this functionality.
+
+To turn a Perl program into executable byte code, you can use C<perlcc>
+with the C<-b> switch:
+
+  perlcc -b myperlprogram.pl
+
+The byte code is machine independent, so once you have a compiled
+module or program, it is as portable as Perl source (assuming that
+the user of the module or program has a modern-enough Perl interpreter
+to decode the byte code).
+
+See B<B::Bytecode> for information on options to control the
+optimization and nature of the code generated by the Bytecode module.
+
+=head2 The Optimized C Back End
+
+The optimized C back end will turn your Perl program's run time
+code-path into an equivalent (but optimized) C program that manipulates
+the Perl data structures directly.  The program will still link against
+the Perl interpreter library, to allow for eval(), C<s///e>,
+C<require>, etc.
+
+The C<perlcc> tool generates such executables when using the -opt
+switch.  To compile a Perl program (ending in C<.pl>
+or C<.p>):
+
+  perlcc -opt myperlprogram.pl
+
+To produce a shared library from a Perl module (ending in C<.pm>):
+
+  perlcc -opt Myperlmodule.pm
+
+For more information, see L<perlcc> and L<B::CC>.
 
 =over 4
 
@@ -211,13 +290,53 @@ called something like this:
 
 This is like saying C<use O 'Deparse'> in your Perl program.
 
-=item B::Concise
+=item B::Asmdata
+
+This module is used by the B::Assembler module, which is in turn used
+by the B::Bytecode module, which stores a parse-tree as
+bytecode for later loading.  It's not a back end itself, but rather a
+component of a back end.
+
+=item B::Assembler
+
+This module turns a parse-tree into data suitable for storing
+and later decoding back into a parse-tree.  It's not a back end
+itself, but rather a component of a back end.  It's used by the
+I<assemble> program that produces bytecode.
+
+=item B::Bblock
+
+This module is used by the B::CC back end.  It walks "basic blocks".
+A basic block is a series of operations which is known to execute from
+start to finish, with no possiblity of branching or halting.
+
+=item B::Bytecode
+
+This module is a back end that generates bytecode from a
+program's parse tree.  This bytecode is written to a file, from where
+it can later be reconstructed back into a parse tree.  The goal is to
+do the expensive program compilation once, save the interpreter's
+state into a file, and then restore the state from the file when the
+program is to be executed.  See L</"The Bytecode Back End">
+for details about usage.
 
-This module prints a concise (but complete) version of the Perl parse
-tree.  Its output is more customizable than the one of B::Terse or
-B::Debug (and it can emulate them). This module useful for people who
-are writing their own back end, or who are learning about the Perl
-internals.  It's not useful to the average programmer.
+=item B::C
+
+This module writes out C code corresponding to the parse tree and
+other interpreter internal structures.  You compile the corresponding
+C file, and get an executable file that will restore the internal
+structures and the Perl interpreter will begin running the
+program.  See L</"The Simple C Back End"> for details about usage.
+
+=item B::CC
+
+This module writes out C code corresponding to your program's
+operations.  Unlike the B::C module, which merely stores the
+interpreter and its state in a C program, the B::CC module makes a
+C program that does not involve the interpreter.  As a consequence,
+programs translated into C by B::CC can execute faster than normal
+interpreted programs.  See L</"The Optimized C Back End"> for
+details about usage.
 
 =item B::Debug
 
@@ -233,6 +352,12 @@ It is useful in debugging and deconstructing other people's code,
 also as a pretty-printer for your own source.  See
 L</"The Decompiling Back End"> for details about usage.
 
+=item B::Disassembler
+
+This module turns bytecode back into a parse tree.  It's not a back
+end itself, but rather a component of a back end.  It's used by the
+I<disassemble> program that comes with the bytecode.
+
 =item B::Lint
 
 This module inspects the compiled form of your source code for things
@@ -244,17 +369,30 @@ can identify.  See L</"The Lint Back End"> for details about usage.
 =item B::Showlex
 
 This module prints out the my() variables used in a function or a
-file.  To get a list of the my() variables used in the subroutine
+file.  To gt a list of the my() variables used in the subroutine
 mysub() defined in the file myperlprogram:
 
   $ perl -MO=Showlex,mysub myperlprogram
 
-To get a list of the my() variables used in the file myperlprogram:
+To gt a list of the my() variables used in the file myperlprogram:
 
   $ perl -MO=Showlex myperlprogram
 
 [BROKEN]
 
+=item B::Stackobj
+
+This module is used by the B::CC module.  It's not a back end itself,
+but rather a component of a back end.
+
+=item B::Stash
+
+This module is used by the L<perlcc> program, which compiles a module
+into an executable.  B::Stash prints the symbol tables in use by a
+program, and is used to prevent B::CC from producing C code for the
+B::* and O modules.  It's not a back end itself, but rather a
+component of a back end.
+
 =item B::Terse
 
 This module prints the contents of the parse tree, but without as much
@@ -276,6 +414,19 @@ usage.
 
 =head1 KNOWN PROBLEMS
 
+The simple C backend currently only saves typeglobs with alphanumeric
+names.
+
+The optimized C backend outputs code for more modules than it should
+(e.g., DirHandle).  It also has little hope of properly handling
+C<goto LABEL> outside the running subroutine (C<goto &sub> is ok).
+C<goto LABEL> currently does not work at all in this backend.
+It also creates a huge initialization function that gives
+C compilers headaches.  Splitting the initialization function gives
+better results.  Other problems include: unsigned math does not
+work correctly; some opcodes are handled incorrectly by default
+opcode handling mechanism.
+
 BEGIN{} blocks are executed while compiling your code.  Any external
 state that is initialized in BEGIN{}, such as opening files, initiating
 database connections etc., do not behave properly.  To work around
diff --git a/gnu/usr.bin/perl/pod/podchecker.PL b/gnu/usr.bin/perl/pod/podchecker.PL
index 75c316d26ed..a7f96434ca6 100644
--- a/gnu/usr.bin/perl/pod/podchecker.PL
+++ b/gnu/usr.bin/perl/pod/podchecker.PL
@@ -39,7 +39,7 @@ print OUT <<'!NO!SUBS!';
 #############################################################################
 # podchecker -- command to invoke the podchecker function in Pod::Checker
 #
-# Copyright (c) 1998-2000 by Bradford Appleton. All rights reserved.
+# Copyright (c) 1998-1999 by Bradford Appleton. All rights reserved.
 # This file is part of "PodParser". PodParser is free software;
 # you can redistribute it and/or modify it under the same terms
 # as Perl itself.
@@ -70,9 +70,7 @@ Print the manual page and exit.
 
 =item B<-warnings> B<-nowarnings>
 
-Turn on/off printing of warnings. Repeating B<-warnings> increases the
-warning level, i.e. more warnings are printed. Currently increasing to
-level two causes flagging of unescaped "E<lt>,E<gt>" characters.
+Turn on/off printing of warnings.
 
 =item I<file>
 
@@ -87,8 +85,6 @@ syntax errors in the POD documentation and will print any errors
 it find to STDERR. At the end, it will print a status message
 indicating the number of errors found.
 
-Directories are ignored, an appropriate warning message is printed.
-
 B<podchecker> invokes the B<podchecker()> function exported by B<Pod::Checker>
 Please see L<Pod::Checker/podchecker()> for more details.
 
@@ -105,7 +101,7 @@ the given POD files has syntax errors.
 The status 2 indicates that at least one of the specified 
 files does not contain I<any> POD commands.
 
-Status 1 overrides status 2. If you want unambiguous
+Status 1 overrides status 2. If you want unambigouus
 results, call B<podchecker> with one single argument only.
 
 =head1 SEE ALSO
@@ -114,10 +110,8 @@ L<Pod::Parser> and L<Pod::Checker>
 
 =head1 AUTHORS
 
-Please report bugs using L<http://rt.cpan.org>.
-
 Brad Appleton E<lt>bradapp@enteract.comE<gt>,
-Marek Rouchal E<lt>marekr@cpan.orgE<gt>
+Marek Rouchal E<lt>marek@saftsack.fs.uni-bayreuth.deE<gt>
 
 Based on code for B<Pod::Text::pod2text(1)> written by
 Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
@@ -130,50 +124,32 @@ use Pod::Usage;
 use Getopt::Long;
 
 ## Define options
-my %options;
+my %options = (
+        "help"     => 0,
+        "man"      => 0,
+        "warnings" => 1,
+);
 
 ## Parse options
-GetOptions(\%options, qw(help man warnings+ nowarnings))  ||  pod2usage(2);
+GetOptions(\%options, "help", "man", "warnings!")  ||  pod2usage(2);
 pod2usage(1)  if ($options{help});
 pod2usage(-verbose => 2)  if ($options{man});
 
-if($options{nowarnings}) {
-  $options{warnings} = 0;
-}
-elsif(!defined $options{warnings}) {
-  $options{warnings} = 1; # default is warnings on
-}
-
 ## Dont default to STDIN if connected to a terminal
 pod2usage(2) if ((@ARGV == 0) && (-t STDIN));
 
 ## Invoke podchecker()
 my $status = 0;
-@ARGV = qw(-) unless(@ARGV);
-for my $podfile (@ARGV) {
-    if($podfile eq '-') {
-      $podfile = '<&STDIN';
-    }
-    elsif(-d $podfile) {
-      warn "podchecker: Warning: Ignoring directory '$podfile'\n";
-      next;
-    }
-    my $errors =
-      podchecker($podfile, undef, '-warnings' => $options{warnings});
-    if($errors > 0) {
+@ARGV = ("<&STDIN") unless(@ARGV);
+for (@ARGV) {
+    my $s = podchecker($_, undef, '-warnings' => $options{warnings});
+    if($s > 0) {
         # errors occurred
         $status = 1;
-        printf STDERR ("%s has %d pod syntax %s.\n",
-          $podfile, $errors,
-          ($errors == 1) ? 'error' : 'errors');
     }
-    elsif($errors < 0) {
+    elsif($s < 0) {
         # no pod found
         $status = 2 unless($status);
-        print STDERR "$podfile does not contain any pod commands.\n";
-    }
-    else {
-        print STDERR "$podfile pod syntax OK.\n";
     }
 }
 exit $status;
diff --git a/gnu/usr.bin/perl/pod/podselect.PL b/gnu/usr.bin/perl/pod/podselect.PL
index 7fadd7366cb..f2ba80a73b5 100644
--- a/gnu/usr.bin/perl/pod/podselect.PL
+++ b/gnu/usr.bin/perl/pod/podselect.PL
@@ -15,8 +15,9 @@ use Cwd;
 # This is so that make depend always knows where to find PL derivatives.
 $origdir = cwd;
 chdir(dirname($0));
-$file = basename($0, '.PL');
-$file .= '.com' if $^O eq 'VMS';
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$// if ($^O eq 'os2' or $^O eq 'dos');  # "case-forgiving"
+$file =~ s/\.pl$/.com/ if ($^O eq 'VMS');              # "case-forgiving"
 
 open OUT,">$file" or die "Can't create $file: $!";
 
@@ -38,14 +39,14 @@ print OUT <<'!NO!SUBS!';
 #############################################################################
 # podselect -- command to invoke the podselect function in Pod::Select
 #
-# Copyright (c) 1996-2000 by Bradford Appleton. All rights reserved.
+# Copyright (c) 1996-1999 by Bradford Appleton. All rights reserved.
 # This file is part of "PodParser". PodParser is free software;
 # you can redistribute it and/or modify it under the same terms
 # as Perl itself.
 #############################################################################
 
 use strict;
-#use diagnostics;
+use diagnostics;
 
 =head1 NAME
 
@@ -98,8 +99,6 @@ L<Pod::Parser> and L<Pod::Select>
 
 =head1 AUTHOR
 
-Please report bugs using L<http://rt.cpan.org>.
-
 Brad Appleton E<lt>bradapp@enteract.comE<gt>
 
 Based on code for B<Pod::Text::pod2text(1)> written by
@@ -113,13 +112,13 @@ use Getopt::Long;
 
 ## Define options
 my %options = (
-        'help'     => 0,
-        'man'      => 0,
-        'sections' => [],
+        "help"     => 0,
+        "man"      => 0,
+        "sections" => [],
 );
 
 ## Parse options
-GetOptions(\%options, 'help', 'man', 'sections|select=s@')  ||  pod2usage(2);
+GetOptions(\%options, "help", "man", "sections|select=s@")  ||  pod2usage(2);
 pod2usage(1)  if ($options{help});
 pod2usage(-verbose => 2)  if ($options{man});
 
@@ -127,8 +126,8 @@ pod2usage(-verbose => 2)  if ($options{man});
 pod2usage(2) if ((@ARGV == 0) && (-t STDIN));
 
 ## Invoke podselect().
-if (@{ $options{'sections'} } > 0) {
-    podselect({ -sections => $options{'sections'} }, @ARGV);
+if (@{ $options{"sections"} } > 0) {
+    podselect({ -sections => $options{"sections"} }, @ARGV);
 }
 else {
     podselect(@ARGV);
diff --git a/gnu/usr.bin/perl/pp.sym b/gnu/usr.bin/perl/pp.sym
index 9d4d7540682..0e6c056611a 100644
--- a/gnu/usr.bin/perl/pp.sym
+++ b/gnu/usr.bin/perl/pp.sym
@@ -1,18 +1,14 @@
-# -*- buffer-read-only: t -*-
 #
-# !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
+# !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
 #   This file is built by opcode.pl from its data.  Any changes made here
 #   will be lost!
 #
 
 Perl_ck_anoncode
 Perl_ck_bitop
-Perl_ck_chdir
 Perl_ck_concat
 Perl_ck_defined
 Perl_ck_delete
-Perl_ck_die
-Perl_ck_each
 Perl_ck_eof
 Perl_ck_eval
 Perl_ck_exec
@@ -20,34 +16,32 @@ Perl_ck_exists
 Perl_ck_exit
 Perl_ck_ftst
 Perl_ck_fun
+Perl_ck_fun_locale
 Perl_ck_glob
 Perl_ck_grep
 Perl_ck_index
 Perl_ck_join
+Perl_ck_lengthconst
 Perl_ck_lfun
 Perl_ck_listiob
 Perl_ck_match
 Perl_ck_method
 Perl_ck_null
 Perl_ck_open
-Perl_ck_readline
 Perl_ck_repeat
 Perl_ck_require
-Perl_ck_return
 Perl_ck_rfun
 Perl_ck_rvconst
 Perl_ck_sassign
+Perl_ck_scmp
 Perl_ck_select
 Perl_ck_shift
-Perl_ck_smartmatch
 Perl_ck_sort
 Perl_ck_spair
 Perl_ck_split
 Perl_ck_subr
-Perl_ck_substr
 Perl_ck_svconst
 Perl_ck_trunc
-Perl_ck_unpack
 Perl_pp_null
 Perl_pp_stub
 Perl_pp_scalar
@@ -142,7 +136,6 @@ Perl_pp_negate
 Perl_pp_i_negate
 Perl_pp_not
 Perl_pp_complement
-Perl_pp_smartmatch
 Perl_pp_atan2
 Perl_pp_sin
 Perl_pp_cos
@@ -174,9 +167,6 @@ Perl_pp_rv2av
 Perl_pp_aelemfast
 Perl_pp_aelem
 Perl_pp_aslice
-Perl_pp_aeach
-Perl_pp_akeys
-Perl_pp_avalues
 Perl_pp_each
 Perl_pp_values
 Perl_pp_keys
@@ -185,7 +175,6 @@ Perl_pp_exists
 Perl_pp_rv2hv
 Perl_pp_helem
 Perl_pp_hslice
-Perl_pp_boolkeys
 Perl_pp_unpack
 Perl_pp_pack
 Perl_pp_split
@@ -211,11 +200,9 @@ Perl_pp_flop
 Perl_pp_and
 Perl_pp_or
 Perl_pp_xor
-Perl_pp_dor
 Perl_pp_cond_expr
 Perl_pp_andassign
 Perl_pp_orassign
-Perl_pp_dorassign
 Perl_pp_method
 Perl_pp_entersub
 Perl_pp_leavesub
@@ -242,13 +229,6 @@ Perl_pp_redo
 Perl_pp_dump
 Perl_pp_goto
 Perl_pp_exit
-Perl_pp_method_named
-Perl_pp_entergiven
-Perl_pp_leavegiven
-Perl_pp_enterwhen
-Perl_pp_leavewhen
-Perl_pp_break
-Perl_pp_continue
 Perl_pp_open
 Perl_pp_close
 Perl_pp_pipe_op
@@ -268,11 +248,12 @@ Perl_pp_enterwrite
 Perl_pp_leavewrite
 Perl_pp_prtf
 Perl_pp_print
-Perl_pp_say
 Perl_pp_sysopen
 Perl_pp_sysseek
 Perl_pp_sysread
 Perl_pp_syswrite
+Perl_pp_send
+Perl_pp_recv
 Perl_pp_eof
 Perl_pp_tell
 Perl_pp_seek
@@ -280,8 +261,6 @@ Perl_pp_truncate
 Perl_pp_fcntl
 Perl_pp_ioctl
 Perl_pp_flock
-Perl_pp_send
-Perl_pp_recv
 Perl_pp_socket
 Perl_pp_sockpair
 Perl_pp_bind
@@ -302,23 +281,23 @@ Perl_pp_fteread
 Perl_pp_ftewrite
 Perl_pp_fteexec
 Perl_pp_ftis
+Perl_pp_fteowned
+Perl_pp_ftrowned
+Perl_pp_ftzero
 Perl_pp_ftsize
 Perl_pp_ftmtime
 Perl_pp_ftatime
 Perl_pp_ftctime
-Perl_pp_ftrowned
-Perl_pp_fteowned
-Perl_pp_ftzero
 Perl_pp_ftsock
 Perl_pp_ftchr
 Perl_pp_ftblk
 Perl_pp_ftfile
 Perl_pp_ftdir
 Perl_pp_ftpipe
+Perl_pp_ftlink
 Perl_pp_ftsuid
 Perl_pp_ftsgid
 Perl_pp_ftsvtx
-Perl_pp_ftlink
 Perl_pp_fttty
 Perl_pp_fttext
 Perl_pp_ftbinary
@@ -365,12 +344,11 @@ Perl_pp_msgget
 Perl_pp_msgctl
 Perl_pp_msgsnd
 Perl_pp_msgrcv
-Perl_pp_semop
 Perl_pp_semget
 Perl_pp_semctl
+Perl_pp_semop
 Perl_pp_require
 Perl_pp_dofile
-Perl_pp_hintseval
 Perl_pp_entereval
 Perl_pp_leaveeval
 Perl_pp_entertry
@@ -408,6 +386,6 @@ Perl_pp_egrent
 Perl_pp_getlogin
 Perl_pp_syscall
 Perl_pp_lock
-Perl_pp_once
-
-# ex: set ro:
+Perl_pp_threadsv
+Perl_pp_setstate
+Perl_pp_method_named
diff --git a/gnu/usr.bin/perl/warnings.pl b/gnu/usr.bin/perl/warnings.pl
index 514ccd7ef5d..61602d5608a 100644
--- a/gnu/usr.bin/perl/warnings.pl
+++ b/gnu/usr.bin/perl/warnings.pl
@@ -1,23 +1,7 @@
 #!/usr/bin/perl
-# 
-# Regenerate (overwriting only if changed):
-#
-#    lib/warnings.pm
-#    warnings.h
-#
-# from information hardcoded into this script (the $tree hash), plus the
-# template for warnings.pm in the DATA section.
-#
-# With an argument of 'tree', just dump the contents of $tree and exits.
-# Also accepts the standard regen_lib -q and -v args.
-#
-# This script is normally invoked from regen.pl.
-
-$VERSION = '1.02_03';
 
 BEGIN {
-    require 'regen_lib.pl';
-    push @INC, './lib';
+  push @INC, './lib';
 }
 use strict ;
 
@@ -26,62 +10,58 @@ sub DEFAULT_OFF () { 2 }
 
 my $tree = {
 
-'all' => [ 5.008, {
-	'io'		=> [ 5.008, { 	
-				'pipe' 		=> [ 5.008, DEFAULT_OFF],
-       				'unopened'	=> [ 5.008, DEFAULT_OFF],
-       				'closed'	=> [ 5.008, DEFAULT_OFF],
-       				'newline'	=> [ 5.008, DEFAULT_OFF],
-       				'exec'		=> [ 5.008, DEFAULT_OFF],
-       				'layer'		=> [ 5.008, DEFAULT_OFF],
-			   }],
-     	'syntax'	=> [ 5.008, { 	
-				'ambiguous'	=> [ 5.008, DEFAULT_OFF],
-			     	'semicolon'	=> [ 5.008, DEFAULT_OFF],
-			     	'precedence'	=> [ 5.008, DEFAULT_OFF],
-			     	'bareword'	=> [ 5.008, DEFAULT_OFF],
-			     	'reserved'	=> [ 5.008, DEFAULT_OFF],
-				'digit'		=> [ 5.008, DEFAULT_OFF],
-			     	'parenthesis'	=> [ 5.008, DEFAULT_OFF],
-       	 			'printf'	=> [ 5.008, DEFAULT_OFF],
-       	 			'prototype'	=> [ 5.008, DEFAULT_OFF],
-       	 			'qw'		=> [ 5.008, DEFAULT_OFF],
-                                'illegalproto'  => [ 5.011, DEFAULT_OFF],
-			   }],
-       	'severe'	=> [ 5.008, { 	
-				'inplace'	=> [ 5.008, DEFAULT_ON],
-	 			'internal'	=> [ 5.008, DEFAULT_ON],
-         			'debugging'	=> [ 5.008, DEFAULT_ON],
-         			'malloc'	=> [ 5.008, DEFAULT_ON],
-	 		   }],
-        'deprecated'	=> [ 5.008, DEFAULT_OFF],
-       	'void'		=> [ 5.008, DEFAULT_OFF],
-       	'recursion'	=> [ 5.008, DEFAULT_OFF],
-       	'redefine'	=> [ 5.008, DEFAULT_OFF],
-       	'numeric'	=> [ 5.008, DEFAULT_OFF],
-        'uninitialized'	=> [ 5.008, DEFAULT_OFF],
-       	'once'		=> [ 5.008, DEFAULT_OFF],
-       	'misc'		=> [ 5.008, DEFAULT_OFF],
-       	'regexp'	=> [ 5.008, DEFAULT_OFF],
-       	'glob'		=> [ 5.008, DEFAULT_OFF],
-       	'untie'		=> [ 5.008, DEFAULT_OFF],
-	'substr'	=> [ 5.008, DEFAULT_OFF],
-	'taint'		=> [ 5.008, DEFAULT_OFF],
-	'signal'	=> [ 5.008, DEFAULT_OFF],
-	'closure'	=> [ 5.008, DEFAULT_OFF],
-	'overflow'	=> [ 5.008, DEFAULT_OFF],
-	'portable'	=> [ 5.008, DEFAULT_OFF],
-	'utf8'		=> [ 5.008, DEFAULT_OFF],
-       	'exiting'	=> [ 5.008, DEFAULT_OFF],
-       	'pack'		=> [ 5.008, DEFAULT_OFF],
-       	'unpack'	=> [ 5.008, DEFAULT_OFF],
-       	'threads'	=> [ 5.008, DEFAULT_OFF],
-       	'imprecision'	=> [ 5.011, DEFAULT_OFF],
-
-       	 #'default'	=> [ 5.008, DEFAULT_ON ],
-  	}],
+'all' => {
+       	'io'  		=> { 	'pipe' 		=> DEFAULT_OFF,
+       				'unopened'	=> DEFAULT_OFF,
+       				'closed'	=> DEFAULT_OFF,
+       				'newline'	=> DEFAULT_OFF,
+       				'exec'		=> DEFAULT_OFF,
+			   },
+       	'syntax'	=> { 	'ambiguous'	=> DEFAULT_OFF,
+			     	'semicolon'	=> DEFAULT_OFF,
+			     	'precedence'	=> DEFAULT_OFF,
+			     	'bareword'	=> DEFAULT_OFF,
+			     	'reserved'	=> DEFAULT_OFF,
+				'digit'		=> DEFAULT_OFF,
+			     	'parenthesis'	=> DEFAULT_OFF,
+       	 			'deprecated'	=> DEFAULT_OFF,
+       	 			'printf'	=> DEFAULT_OFF,
+       	 			'prototype'	=> DEFAULT_OFF,
+       	 			'qw'		=> DEFAULT_OFF,
+			   },
+       	'severe'	=> { 	'inplace'	=> DEFAULT_ON,
+	 			'internal'	=> DEFAULT_ON,
+         			'debugging'	=> DEFAULT_ON,
+         			'malloc'	=> DEFAULT_ON,
+	 		   },
+       	'void'		=> DEFAULT_OFF,
+       	'recursion'	=> DEFAULT_OFF,
+       	'redefine'	=> DEFAULT_OFF,
+       	'numeric'	=> DEFAULT_OFF,
+        'uninitialized'	=> DEFAULT_OFF,
+       	'once'		=> DEFAULT_OFF,
+       	'misc'		=> DEFAULT_OFF,
+       	'regexp'	=> DEFAULT_OFF,
+       	'glob'		=> DEFAULT_OFF,
+       	'y2k'		=> DEFAULT_OFF,
+       	'chmod'		=> DEFAULT_OFF,
+       	'umask'		=> DEFAULT_OFF,
+       	'untie'		=> DEFAULT_OFF,
+	'substr'	=> DEFAULT_OFF,
+	'taint'		=> DEFAULT_OFF,
+	'signal'	=> DEFAULT_OFF,
+	'closure'	=> DEFAULT_OFF,
+	'overflow'	=> DEFAULT_OFF,
+	'portable'	=> DEFAULT_OFF,
+	'utf8'		=> DEFAULT_OFF,
+       	'exiting'	=> DEFAULT_OFF,
+       	'pack'		=> DEFAULT_OFF,
+       	'unpack'	=> DEFAULT_OFF,
+       	 #'default'	=> DEFAULT_ON,
+  	}
 } ;
 
+
 ###########################################################################
 sub tab {
     my($l, $t) = @_;
@@ -93,49 +73,8 @@ sub tab {
 
 my %list ;
 my %Value ;
-my %ValueToName ;
-my %NameToValue ;
 my $index ;
 
-my %v_list = () ;
-
-sub valueWalk
-{
-    my $tre = shift ;
-    my @list = () ;
-    my ($k, $v) ;
-
-    foreach $k (sort keys %$tre) {
-	$v = $tre->{$k};
-	die "duplicate key $k\n" if defined $list{$k} ;
-	die "Value associated with key '$k' is not an ARRAY reference"
-	    if !ref $v || ref $v ne 'ARRAY' ;
-
-	my ($ver, $rest) = @{ $v } ;
-	push @{ $v_list{$ver} }, $k;
-	
-	if (ref $rest)
-	  { valueWalk ($rest) }
-
-    }
-
-}
-
-sub orderValues
-{
-    my $index = 0;
-    foreach my $ver ( sort { $a <=> $b } keys %v_list ) {
-        foreach my $name (@{ $v_list{$ver} } ) {
-	    $ValueToName{ $index } = [ uc $name, $ver ] ;
-	    $NameToValue{ uc $name } = $index ++ ;
-        }
-    }
-
-    return $index ;
-}
-
-###########################################################################
-
 sub walk
 {
     my $tre = shift ;
@@ -145,17 +84,10 @@ sub walk
     foreach $k (sort keys %$tre) {
 	$v = $tre->{$k};
 	die "duplicate key $k\n" if defined $list{$k} ;
-	#$Value{$index} = uc $k ;
-	die "Can't find key '$k'"
-	    if ! defined $NameToValue{uc $k} ;
-        push @{ $list{$k} }, $NameToValue{uc $k} ;
-	die "Value associated with key '$k' is not an ARRAY reference"
-	    if !ref $v || ref $v ne 'ARRAY' ;
-	
-	my ($ver, $rest) = @{ $v } ;
-	if (ref $rest)
-	  { push (@{ $list{$k} }, walk ($rest)) }
-
+	$Value{$index} = uc $k ;
+        push @{ $list{$k} }, $index ++ ;
+	if (ref $v)
+	  { push (@{ $list{$k} }, walk ($v)) }
 	push @list, @{ $list{$k} } ;
     }
 
@@ -172,7 +104,7 @@ sub mkRange
 
 
     for ($i = 1 ; $i < @a; ++ $i) {
-      	$out[$i] = ".."
+      	$out[$i] = ".." 
           if $a[$i] == $a[$i - 1] + 1 && $a[$i] + 1 == $a[$i + 1] ;
     }
 
@@ -187,33 +119,20 @@ sub printTree
 {
     my $tre = shift ;
     my $prefix = shift ;
+    my $indent = shift ;
     my ($k, $v) ;
 
     my $max = (sort {$a <=> $b} map { length $_ } keys %$tre)[-1] ;
-    my @keys = sort keys %$tre ;
 
-    while ($k = shift @keys) {
+    $prefix .= " " x $indent ;
+    foreach $k (sort keys %$tre) {
 	$v = $tre->{$k};
-	die "Value associated with key '$k' is not an ARRAY reference"
-	    if !ref $v || ref $v ne 'ARRAY' ;
-	
-        my $offset ;
-	if ($tre ne $tree) {
-	    print $prefix . "|\n" ;
-	    print $prefix . "+- $k" ;
-	    $offset = ' ' x ($max + 4) ;
-	}
-	else {
-	    print $prefix . "$k" ;
-	    $offset = ' ' x ($max + 1) ;
-	}
-
-	my ($ver, $rest) = @{ $v } ;
-	if (ref $rest)
-	{
-	    my $bar = @keys ? "|" : " ";
-	    print " -" . "-" x ($max - length $k ) . "+\n" ;
-	    printTree ($rest, $prefix . $bar . $offset )
+	print $prefix . "|\n" ;
+	print $prefix . "+- $k" ;
+	if (ref $v)
+	{ 
+	    print " " . "-" x ($max - length $k ) . "+\n" ;
+	    printTree ($v, $prefix . "|" , $max + $indent - 1) 
 	}
 	else
 	  { print "\n" }
@@ -223,9 +142,9 @@ sub printTree
 
 ###########################################################################
 
-sub mkHexOct
+sub mkHex
 {
-    my ($f, $max, @a) = @_ ;
+    my ($max, @a) = @_ ;
     my $mask = "\x00" x $max ;
     my $string = "" ;
 
@@ -233,43 +152,30 @@ sub mkHexOct
 	vec($mask, $_, 1) = 1 ;
     }
 
+    #$string = unpack("H$max", $mask) ;
+    #$string =~ s/(..)/\x$1/g;
     foreach (unpack("C*", $mask)) {
-        if ($f eq 'x') {
-            $string .= '\x' . sprintf("%2.2x", $_)
-        }
-        else {
-            $string .= '\\' . sprintf("%o", $_)
-        }
+	$string .= '\x' . sprintf("%2.2x", $_) ;
     }
     return $string ;
 }
 
-sub mkHex
-{
-    my($max, @a) = @_;
-    return mkHexOct("x", $max, @a);
-}
-
-sub mkOct
-{
-    my($max, @a) = @_;
-    return mkHexOct("o", $max, @a);
-}
-
 ###########################################################################
 
 if (@ARGV && $ARGV[0] eq "tree")
 {
-    printTree($tree, "    ") ;
+    #print "  all -+\n" ;
+    printTree($tree, "   ", 4) ;
     exit ;
 }
 
-my $warn = safer_open("warnings.h-new");
-my $pm = safer_open("lib/warnings.pm-new");
+#unlink "warnings.h";
+#unlink "lib/warnings.pm";
+open(WARN, ">warnings.h") || die "Can't create warnings.h: $!\n";
+open(PM, ">lib/warnings.pm") || die "Can't create lib/warnings.pm: $!\n";
 
-print $warn <<'EOM' ;
-/* -*- buffer-read-only: t -*-
-   !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
+print WARN <<'EOM' ;
+/* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
    This file is built by warnings.pl
    Any changes made here will be lost!
 */
@@ -287,180 +193,144 @@ print $warn <<'EOM' ;
 #define G_WARN_ONCE		8	/* set if 'once' ever enabled */
 #define G_WARN_ALL_MASK		(G_WARN_ALL_ON|G_WARN_ALL_OFF)
 
-#define pWARN_STD		NULL
-#define pWARN_ALL		(((STRLEN*)0)+1)    /* use warnings 'all' */
-#define pWARN_NONE		(((STRLEN*)0)+2)    /* no  warnings 'all' */
+#define pWARN_STD		Nullsv
+#define pWARN_ALL		(Nullsv+1)	/* use warnings 'all' */
+#define pWARN_NONE		(Nullsv+2)	/* no  warnings 'all' */
 
 #define specialWARN(x)		((x) == pWARN_STD || (x) == pWARN_ALL ||	\
 				 (x) == pWARN_NONE)
 
-/* if PL_warnhook is set to this value, then warnings die */
-#define PERL_WARNHOOK_FATAL	(&PL_sv_placeholder)
+#define ckDEAD(x)							\
+	   ( ! specialWARN(PL_curcop->cop_warnings) &&			\
+	    IsSet(SvPVX(PL_curcop->cop_warnings), 2*x+1))
+
+#define ckWARN(x)							\
+	( (PL_curcop->cop_warnings != pWARN_STD &&			\
+	   PL_curcop->cop_warnings != pWARN_NONE &&			\
+	      (PL_curcop->cop_warnings == pWARN_ALL ||			\
+	       IsSet(SvPVX(PL_curcop->cop_warnings), 2*x) ) )		\
+	  || (PL_curcop->cop_warnings == pWARN_STD && PL_dowarn & G_WARN_ON) )
+
+#define ckWARN2(x,y)							\
+	  ( (PL_curcop->cop_warnings != pWARN_STD  &&			\
+	     PL_curcop->cop_warnings != pWARN_NONE &&			\
+	      (PL_curcop->cop_warnings == pWARN_ALL ||			\
+	        IsSet(SvPVX(PL_curcop->cop_warnings), 2*x)  ||		\
+	        IsSet(SvPVX(PL_curcop->cop_warnings), 2*y) ) ) 		\
+	    ||	(PL_curcop->cop_warnings == pWARN_STD && PL_dowarn & G_WARN_ON) )
+
+#define ckWARN_d(x)							\
+	  (PL_curcop->cop_warnings == pWARN_STD ||			\
+	   PL_curcop->cop_warnings == pWARN_ALL ||			\
+	     (PL_curcop->cop_warnings != pWARN_NONE &&			\
+	      IsSet(SvPVX(PL_curcop->cop_warnings), 2*x) ) )
+
+#define ckWARN2_d(x,y)							\
+	  (PL_curcop->cop_warnings == pWARN_STD ||			\
+	   PL_curcop->cop_warnings == pWARN_ALL ||			\
+	     (PL_curcop->cop_warnings != pWARN_NONE &&			\
+	        (IsSet(SvPVX(PL_curcop->cop_warnings), 2*x)  ||		\
+	         IsSet(SvPVX(PL_curcop->cop_warnings), 2*y) ) ) )
+
+
+#define isLEXWARN_on 	(PL_curcop->cop_warnings != pWARN_STD)
+#define isLEXWARN_off	(PL_curcop->cop_warnings == pWARN_STD)
+#define isWARN_ONCE	(PL_dowarn & (G_WARN_ON|G_WARN_ONCE))
+#define isWARN_on(c,x)	(IsSet(SvPVX(c), 2*(x)))
+
 EOM
 
 my $offset = 0 ;
 
 $index = $offset ;
 #@{ $list{"all"} } = walk ($tree) ;
-valueWalk ($tree) ;
-my $index = orderValues();
-
-die <<EOM if $index > 255 ;
-Too many warnings categories -- max is 255
-    rewrite packWARN* & unpackWARN* macros 
-EOM
-
 walk ($tree) ;
 
+
 $index *= 2 ;
 my $warn_size = int($index / 8) + ($index % 8 != 0) ;
 
 my $k ;
-my $last_ver = 0;
-foreach $k (sort { $a <=> $b } keys %ValueToName) {
-    my ($name, $version) = @{ $ValueToName{$k} };
-    print $warn "\n/* Warnings Categories added in Perl $version */\n\n"
-        if $last_ver != $version ;
-    print $warn tab(5, "#define WARN_$name"), "$k\n" ;
-    $last_ver = $version ;
+foreach $k (sort { $a <=> $b } keys %Value) {
+    print WARN tab(5, "#define WARN_$Value{$k}"), "$k\n" ;
 }
-print $warn "\n" ;
+print WARN "\n" ;
 
-print $warn tab(5, '#define WARNsize'),	"$warn_size\n" ;
+print WARN tab(5, '#define WARNsize'),	"$warn_size\n" ;
 #print WARN tab(5, '#define WARN_ALLstring'), '"', ('\377' x $warn_size) , "\"\n" ;
-print $warn tab(5, '#define WARN_ALLstring'), '"', ('\125' x $warn_size) , "\"\n" ;
-print $warn tab(5, '#define WARN_NONEstring'), '"', ('\0' x $warn_size) , "\"\n" ;
-
-print $warn <<'EOM';
-
-#define isLEXWARN_on 	(PL_curcop->cop_warnings != pWARN_STD)
-#define isLEXWARN_off	(PL_curcop->cop_warnings == pWARN_STD)
-#define isWARN_ONCE	(PL_dowarn & (G_WARN_ON|G_WARN_ONCE))
-#define isWARN_on(c,x)	(IsSet((U8 *)(c + 1), 2*(x)))
-#define isWARNf_on(c,x)	(IsSet((U8 *)(c + 1), 2*(x)+1))
-
-#define DUP_WARNINGS(p)		\
-    (specialWARN(p) ? (STRLEN*)(p)	\
-    : (STRLEN*)CopyD(p, PerlMemShared_malloc(sizeof(*p)+*p), sizeof(*p)+*p, \
-		     			     char))
-
-#define ckWARN(w)		Perl_ckwarn(aTHX_ packWARN(w))
-#define ckWARN2(w1,w2)		Perl_ckwarn(aTHX_ packWARN2(w1,w2))
-#define ckWARN3(w1,w2,w3)	Perl_ckwarn(aTHX_ packWARN3(w1,w2,w3))
-#define ckWARN4(w1,w2,w3,w4)	Perl_ckwarn(aTHX_ packWARN4(w1,w2,w3,w4))
+print WARN tab(5, '#define WARN_ALLstring'), '"', ('\125' x $warn_size) , "\"\n" ;
+print WARN tab(5, '#define WARN_NONEstring'), '"', ('\0' x $warn_size) , "\"\n" ;
 
-#define ckWARN_d(w)		Perl_ckwarn_d(aTHX_ packWARN(w))
-#define ckWARN2_d(w1,w2)	Perl_ckwarn_d(aTHX_ packWARN2(w1,w2))
-#define ckWARN3_d(w1,w2,w3)	Perl_ckwarn_d(aTHX_ packWARN3(w1,w2,w3))
-#define ckWARN4_d(w1,w2,w3,w4)	Perl_ckwarn_d(aTHX_ packWARN4(w1,w2,w3,w4))
-
-#define WARNshift		8
-
-#define packWARN(a)		(a                                      )
-#define packWARN2(a,b)		((a) | ((b)<<8)                         )
-#define packWARN3(a,b,c)	((a) | ((b)<<8) | ((c)<<16)             )
-#define packWARN4(a,b,c,d)	((a) | ((b)<<8) | ((c)<<16) | ((d) <<24))
-
-#define unpackWARN1(x)		((x)        & 0xFF)
-#define unpackWARN2(x)		(((x) >>8)  & 0xFF)
-#define unpackWARN3(x)		(((x) >>16) & 0xFF)
-#define unpackWARN4(x)		(((x) >>24) & 0xFF)
-
-#define ckDEAD(x)							\
-	   ( ! specialWARN(PL_curcop->cop_warnings) &&			\
-	    ( isWARNf_on(PL_curcop->cop_warnings, WARN_ALL) || 		\
-	      isWARNf_on(PL_curcop->cop_warnings, unpackWARN1(x)) ||	\
-	      isWARNf_on(PL_curcop->cop_warnings, unpackWARN2(x)) ||	\
-	      isWARNf_on(PL_curcop->cop_warnings, unpackWARN3(x)) ||	\
-	      isWARNf_on(PL_curcop->cop_warnings, unpackWARN4(x))))
+print WARN <<'EOM';
 
 /* end of file warnings.h */
-/* ex: set ro: */
+
 EOM
 
-safer_close $warn;
-rename_if_different("warnings.h-new", "warnings.h");
+close WARN ;
 
 while (<DATA>) {
     last if /^KEYWORDS$/ ;
-    print $pm $_ ;
+    print PM $_ ;
 }
 
 #$list{'all'} = [ $offset .. 8 * ($warn_size/2) - 1 ] ;
 
-$last_ver = 0;
-print $pm "our %Offsets = (\n" ;
-foreach my $k (sort { $a <=> $b } keys %ValueToName) {
-    my ($name, $version) = @{ $ValueToName{$k} };
-    $name = lc $name;
+#my %Keys = map {lc $Value{$_}, $_} keys %Value ;
+
+print PM "%Offsets = (\n" ;
+foreach my $k (sort { $a <=> $b } keys %Value) {
+    my $v = lc $Value{$k} ;
     $k *= 2 ;
-    if ( $last_ver != $version ) {
-        print $pm "\n";
-        print $pm tab(4, "    # Warnings Categories added in Perl $version");
-        print $pm "\n\n";
-    }
-    print $pm tab(4, "    '$name'"), "=> $k,\n" ;
-    $last_ver = $version;
+    print PM tab(4, "    '$v'"), "=> $k,\n" ;
 }
 
-print $pm "  );\n\n" ;
+print PM "  );\n\n" ;
 
-print $pm "our %Bits = (\n" ;
+print PM "%Bits = (\n" ;
 foreach $k (sort keys  %list) {
 
     my $v = $list{$k} ;
     my @list = sort { $a <=> $b } @$v ;
 
-    print $pm tab(4, "    '$k'"), '=> "',
-		# mkHex($warn_size, @list),
-		mkHex($warn_size, map $_ * 2 , @list),
+    print PM tab(4, "    '$k'"), '=> "', 
+		# mkHex($warn_size, @list), 
+		mkHex($warn_size, map $_ * 2 , @list), 
 		'", # [', mkRange(@list), "]\n" ;
 }
 
-print $pm "  );\n\n" ;
+print PM "  );\n\n" ;
 
-print $pm "our %DeadBits = (\n" ;
+print PM "%DeadBits = (\n" ;
 foreach $k (sort keys  %list) {
 
     my $v = $list{$k} ;
     my @list = sort { $a <=> $b } @$v ;
 
-    print $pm tab(4, "    '$k'"), '=> "',
-		# mkHex($warn_size, @list),
-		mkHex($warn_size, map $_ * 2 + 1 , @list),
+    print PM tab(4, "    '$k'"), '=> "', 
+		# mkHex($warn_size, @list), 
+		mkHex($warn_size, map $_ * 2 + 1 , @list), 
 		'", # [', mkRange(@list), "]\n" ;
 }
 
-print $pm "  );\n\n" ;
-print $pm '$NONE     = "', ('\0' x $warn_size) , "\";\n" ;
-print $pm '$LAST_BIT = ' . "$index ;\n" ;
-print $pm '$BYTES    = ' . "$warn_size ;\n" ;
+print PM "  );\n\n" ;
+print PM '$NONE     = "', ('\0' x $warn_size) , "\";\n" ;
+print PM '$LAST_BIT = ' . "$index ;\n" ;
+print PM '$BYTES    = ' . "$warn_size ;\n" ;
 while (<DATA>) {
-    print $pm $_ ;
+    print PM $_ ;
 }
 
-print $pm "# ex: set ro:\n";
-safer_close $pm;
-rename_if_different("lib/warnings.pm-new", "lib/warnings.pm");
+close PM ;
 
 __END__
-# -*- buffer-read-only: t -*-
-# !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
+
 # This file was created by warnings.pl
 # Any changes made here will be lost.
 #
 
 package warnings;
 
-our $VERSION = '1.09';
-
-# Verify that we're called correctly so that warnings will work.
-# see also strict.pm.
-unless ( __FILE__ =~ /(^|[\/\\])\Q${\__PACKAGE__}\E\.pmc?$/ ) {
-    my (undef, $f, $l) = caller;
-    die("Incorrect use of pragma '${\__PACKAGE__}' at $f line $l.\n");
-}
-
 =head1 NAME
 
 warnings - Perl pragma to control optional warnings
@@ -482,347 +352,141 @@ warnings - Perl pragma to control optional warnings
         warnings::warn("void", "some warning");
     }
 
-    if (warnings::enabled($object)) {
-        warnings::warn($object, "some warning");
-    }
-
-    warnings::warnif("some warning");
-    warnings::warnif("void", "some warning");
-    warnings::warnif($object, "some warning");
-
 =head1 DESCRIPTION
 
-The C<warnings> pragma is a replacement for the command line flag C<-w>,
-but the pragma is limited to the enclosing block, while the flag is global.
-See L<perllexwarn> for more information.
-
 If no import list is supplied, all possible warnings are either enabled
 or disabled.
 
-A number of functions are provided to assist module authors.
+A number of functions are provided to assist module authors. 
 
 =over 4
 
 =item use warnings::register
 
-Creates a new warnings category with the same name as the package where
-the call to the pragma is used.
-
-=item warnings::enabled()
-
-Use the warnings category with the same name as the current package.
-
-Return TRUE if that warnings category is enabled in the calling module.
-Otherwise returns FALSE.
-
-=item warnings::enabled($category)
-
-Return TRUE if the warnings category, C<$category>, is enabled in the
-calling module.
-Otherwise returns FALSE.
-
-=item warnings::enabled($object)
-
-Use the name of the class for the object reference, C<$object>, as the
-warnings category.
-
-Return TRUE if that warnings category is enabled in the first scope
-where the object is used.
-Otherwise returns FALSE.
-
-=item warnings::fatal_enabled()
-
-Return TRUE if the warnings category with the same name as the current
-package has been set to FATAL in the calling module.
-Otherwise returns FALSE.
-
-=item warnings::fatal_enabled($category)
-
-Return TRUE if the warnings category C<$category> has been set to FATAL in
-the calling module.
-Otherwise returns FALSE.
-
-=item warnings::fatal_enabled($object)
-
-Use the name of the class for the object reference, C<$object>, as the
-warnings category.
-
-Return TRUE if that warnings category has been set to FATAL in the first
-scope where the object is used.
-Otherwise returns FALSE.
-
-=item warnings::warn($message)
-
-Print C<$message> to STDERR.
-
-Use the warnings category with the same name as the current package.
-
-If that warnings category has been set to "FATAL" in the calling module
-then die. Otherwise return.
+Creates a new warnings category which has the same name as the module
+where the call to the pragma is used.
 
-=item warnings::warn($category, $message)
+=item warnings::enabled([$category])
 
-Print C<$message> to STDERR.
+Returns TRUE if the warnings category C<$category> is enabled in the
+calling module.  Otherwise returns FALSE.
 
-If the warnings category, C<$category>, has been set to "FATAL" in the
-calling module then die. Otherwise return.
+If the parameter, C<$category>, isn't supplied, the current package name
+will be used.
 
-=item warnings::warn($object, $message)
+=item warnings::warn([$category,] $message)
 
-Print C<$message> to STDERR.
+If the calling module has I<not> set C<$category> to "FATAL", print
+C<$message> to STDERR.
+If the calling module has set C<$category> to "FATAL", print C<$message>
+STDERR then die.
 
-Use the name of the class for the object reference, C<$object>, as the
-warnings category.
-
-If that warnings category has been set to "FATAL" in the scope where C<$object>
-is first used then die. Otherwise return.
-
-
-=item warnings::warnif($message)
-
-Equivalent to:
-
-    if (warnings::enabled())
-      { warnings::warn($message) }
-
-=item warnings::warnif($category, $message)
-
-Equivalent to:
-
-    if (warnings::enabled($category))
-      { warnings::warn($category, $message) }
-
-=item warnings::warnif($object, $message)
-
-Equivalent to:
-
-    if (warnings::enabled($object))
-      { warnings::warn($object, $message) }
+If the parameter, C<$category>, isn't supplied, the current package name
+will be used.
 
 =back
 
-See L<perlmodlib/Pragmatic Modules> and L<perllexwarn>.
+See L<perlmod/Pragmatic Modules> and L<perllexwarn>.
 
 =cut
 
+use Carp ;
+
 KEYWORDS
 
 $All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
 
-sub Croaker
-{
-    require Carp; # this initializes %CarpInternal
-    local $Carp::CarpInternal{'warnings'};
-    delete $Carp::CarpInternal{'warnings'};
-    Carp::croak(@_);
-}
-
-sub bits
-{
-    # called from B::Deparse.pm
-
-    push @_, 'all' unless @_;
-
-    my $mask;
+sub bits {
+    my $mask ;
     my $catmask ;
     my $fatal = 0 ;
-    my $no_fatal = 0 ;
-
-    foreach my $word ( @_ ) {
-	if ($word eq 'FATAL') {
+    foreach my $word (@_) {
+	if  ($word eq 'FATAL') {
 	    $fatal = 1;
-	    $no_fatal = 0;
-	}
-	elsif ($word eq 'NONFATAL') {
-	    $fatal = 0;
-	    $no_fatal = 1;
 	}
 	elsif ($catmask = $Bits{$word}) {
 	    $mask |= $catmask ;
 	    $mask |= $DeadBits{$word} if $fatal ;
-	    $mask &= ~($DeadBits{$word}|$All) if $no_fatal ;
 	}
 	else
-          { Croaker("Unknown warnings category '$word'")}
+          { croak("unknown warnings category '$word'")}  
     }
 
     return $mask ;
 }
 
-sub import 
-{
+sub import {
     shift;
-
-    my $catmask ;
-    my $fatal = 0 ;
-    my $no_fatal = 0 ;
-
-    my $mask = ${^WARNING_BITS} ;
-
-    if (vec($mask, $Offsets{'all'}, 1)) {
-        $mask |= $Bits{'all'} ;
-        $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
-    }
-    
-    push @_, 'all' unless @_;
-
-    foreach my $word ( @_ ) {
-	if ($word eq 'FATAL') {
-	    $fatal = 1;
-	    $no_fatal = 0;
-	}
-	elsif ($word eq 'NONFATAL') {
-	    $fatal = 0;
-	    $no_fatal = 1;
-	}
-	elsif ($catmask = $Bits{$word}) {
-	    $mask |= $catmask ;
-	    $mask |= $DeadBits{$word} if $fatal ;
-	    $mask &= ~($DeadBits{$word}|$All) if $no_fatal ;
-	}
-	else
-          { Croaker("Unknown warnings category '$word'")}
-    }
-
-    ${^WARNING_BITS} = $mask ;
+    ${^WARNING_BITS} |= bits(@_ ? @_ : 'all') ;
 }
 
-sub unimport 
-{
+sub unimport {
     shift;
-
-    my $catmask ;
     my $mask = ${^WARNING_BITS} ;
-
     if (vec($mask, $Offsets{'all'}, 1)) {
-        $mask |= $Bits{'all'} ;
+        $mask = $Bits{'all'} ;
         $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
     }
-
-    push @_, 'all' unless @_;
-
-    foreach my $word ( @_ ) {
-	if ($word eq 'FATAL') {
-	    next; 
-	}
-	elsif ($catmask = $Bits{$word}) {
-	    $mask &= ~($catmask | $DeadBits{$word} | $All);
-	}
-	else
-          { Croaker("Unknown warnings category '$word'")}
-    }
-
-    ${^WARNING_BITS} = $mask ;
+    ${^WARNING_BITS} = $mask & ~ (bits(@_ ? @_ : 'all') | $All) ;
 }
 
-my %builtin_type; @builtin_type{qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE Regexp)} = ();
-
-sub __chk
+sub enabled
 {
+    croak("Usage: warnings::enabled([category])")
+	unless @_ == 1 || @_ == 0 ;
+    local $Carp::CarpLevel = 1 ;
     my $category ;
     my $offset ;
-    my $isobj = 0 ;
+    my $callers_bitmask = (caller(1))[9] ; 
+    return 0 unless defined $callers_bitmask ;
+
 
     if (@_) {
         # check the category supplied.
         $category = shift ;
-        if (my $type = ref $category) {
-            Croaker("not an object")
-                if exists $builtin_type{$type};
-	    $category = $type;
-            $isobj = 1 ;
-        }
         $offset = $Offsets{$category};
-        Croaker("Unknown warnings category '$category'")
+        croak("unknown warnings category '$category'")
 	    unless defined $offset;
     }
     else {
-        $category = (caller(1))[0] ;
+        $category = (caller(0))[0] ; 
         $offset = $Offsets{$category};
-        Croaker("package '$category' not registered for warnings")
+        croak("package '$category' not registered for warnings")
 	    unless defined $offset ;
     }
 
-    my $this_pkg = (caller(1))[0] ;
-    my $i = 2 ;
-    my $pkg ;
-
-    if ($isobj) {
-        while (do { { package DB; $pkg = (caller($i++))[0] } } ) {
-            last unless @DB::args && $DB::args[0] =~ /^$category=/ ;
-        }
-	$i -= 2 ;
-    }
-    else {
-        $i = _error_loc(); # see where Carp will allocate the error
-    }
-
-    my $callers_bitmask = (caller($i))[9] ;
-    return ($callers_bitmask, $offset, $i) ;
-}
-
-sub _error_loc {
-    require Carp;
-    goto &Carp::short_error_loc; # don't introduce another stack frame
-}                                                             
-
-sub enabled
-{
-    Croaker("Usage: warnings::enabled([category])")
-	unless @_ == 1 || @_ == 0 ;
-
-    my ($callers_bitmask, $offset, $i) = __chk(@_) ;
-
-    return 0 unless defined $callers_bitmask ;
     return vec($callers_bitmask, $offset, 1) ||
            vec($callers_bitmask, $Offsets{'all'}, 1) ;
 }
 
-sub fatal_enabled
-{
-    Croaker("Usage: warnings::fatal_enabled([category])")
-  unless @_ == 1 || @_ == 0 ;
-
-    my ($callers_bitmask, $offset, $i) = __chk(@_) ;
-
-    return 0 unless defined $callers_bitmask;
-    return vec($callers_bitmask, $offset + 1, 1) ||
-           vec($callers_bitmask, $Offsets{'all'} + 1, 1) ;
-}
 
 sub warn
 {
-    Croaker("Usage: warnings::warn([category,] 'message')")
-	unless @_ == 2 || @_ == 1 ;
-
-    my $message = pop ;
-    my ($callers_bitmask, $offset, $i) = __chk(@_) ;
-    require Carp;
-    Carp::croak($message)
-	if vec($callers_bitmask, $offset+1, 1) ||
-	   vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
-    Carp::carp($message) ;
-}
-
-sub warnif
-{
-    Croaker("Usage: warnings::warnif([category,] 'message')")
+    croak("Usage: warnings::warn([category,] 'message')")
 	unless @_ == 2 || @_ == 1 ;
+    local $Carp::CarpLevel = 1 ;
+    my $category ;
+    my $offset ;
+    my $callers_bitmask = (caller(1))[9] ; 
 
-    my $message = pop ;
-    my ($callers_bitmask, $offset, $i) = __chk(@_) ;
-
-    return
-        unless defined $callers_bitmask &&
-            	(vec($callers_bitmask, $offset, 1) ||
-            	vec($callers_bitmask, $Offsets{'all'}, 1)) ;
+    if (@_ == 2) {
+        $category = shift ;
+        $offset = $Offsets{$category};
+        croak("unknown warnings category '$category'")
+	    unless defined $offset ;
+    }
+    else {
+        $category = (caller(0))[0] ; 
+        $offset = $Offsets{$category};
+        croak("package '$category' not registered for warnings")
+	    unless defined $offset ;
+    }
 
-    require Carp;
-    Carp::croak($message)
+    my $message = shift ;
+    croak($message) 
 	if vec($callers_bitmask, $offset+1, 1) ||
 	   vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
-
-    Carp::carp($message) ;
+    carp($message) ;
 }
 
 1;
diff --git a/gnu/usr.bin/perl/win32/genmk95.pl b/gnu/usr.bin/perl/win32/genmk95.pl
index cf31457ab10..8fe4f86dbfc 100644
--- a/gnu/usr.bin/perl/win32/genmk95.pl
+++ b/gnu/usr.bin/perl/win32/genmk95.pl
@@ -64,7 +64,6 @@ while (<$in>)
  if (/^(.*?)(&&|\|\|)(.*)$/)  # two commands separated by && or ||
  {
     my ($one, $sep, $two) = ($1, $2, $3);
-    $one =~ s/^\t(?:-(?!-))?\@?(.*?)$/\t$1/;   # no -,@ in group recipes
 LINE_CONT:
     if ($two =~ /\\\s*$/)
     {
@@ -78,7 +77,6 @@ LINE_CONT:
     next;
  }
      # fall through - no need for special handling
- s/^\t(?:-(?!-))?\@?(.*?)$/\t$1/;      # no -,@ in group recipes
  print $out "$_\n";
 }
 print $out "]\n" if ($inrec);