stock perl 5.6.1

25 files changed, 1564 insertions, 131 deletions

diff --git a/gnu/usr.bin/perl/ext/B/B.pm b/gnu/usr.bin/perl/ext/B/B.pm
index 4512d916e61..c58e769a84d 100644
--- a/gnu/usr.bin/perl/ext/B/B.pm
+++ b/gnu/usr.bin/perl/ext/B/B.pm
@@ -9,11 +9,17 @@ package B;
 use XSLoader ();
 require Exporter;
 @ISA = qw(Exporter);
-@EXPORT_OK = qw(minus_c ppname
+
+# walkoptree_slow comes from B.pm (you are there),
+# walkoptree comes from B.xs
+@EXPORT_OK = qw(minus_c ppname save_BEGINs
 		class peekop cast_I32 cstring cchar hash threadsv_names
-		main_root main_start main_cv svref_2object opnumber amagic_generation
-		walkoptree walkoptree_slow walkoptree_exec walksymtable
-		parents comppadlist sv_undef compile_stats timing_info init_av);
+		main_root main_start main_cv svref_2object opnumber
+		amagic_generation
+		walkoptree_slow walkoptree walkoptree_exec walksymtable
+		parents comppadlist sv_undef compile_stats timing_info
+		begin_av init_av end_av);
+
 sub OPf_KIDS ();
 use strict;
 @B::SV::ISA = 'B::OBJECT';
@@ -54,6 +60,21 @@ use strict;
     package B::OBJECT;
 }
 
+sub B::GV::SAFENAME {
+  my $name = (shift())->NAME;
+
+  # The regex below corresponds to the isCONTROLVAR macro
+  # from toke.c
+
+  $name =~ s/^([\cA-\cZ\c\\c[\c]\c?\c_\c^])/"^".chr(64 ^ ord($1))/e;
+  return $name;
+}
+
+sub B::IV::int_value {
+  my ($self) = @_;
+  return (($self->FLAGS() & SVf_IVisUV()) ? $self->UVX : $self->IV);
+}
+
 my $debug;
 my $op_count = 0;
 my @parents = ();
@@ -125,6 +146,7 @@ sub objsym {
 
 sub walkoptree_exec {
     my ($op, $method, $level) = @_;
+    $level ||= 0;
     my ($sym, $ppname);
     my $prefix = "    " x $level;
     for (; $$op; $op = $op->next) {
@@ -184,7 +206,7 @@ sub walksymtable {
 	*glob = "*main::".$prefix.$sym;
 	if ($sym =~ /::$/) {
 	    $sym = $prefix . $sym;
-	    if ($sym ne "main::" && &$recurse($sym)) {
+	    if ($sym ne "main::" && $sym ne "<none>::" && &$recurse($sym)) {
 		walksymtable(\%glob, $method, $recurse, $sym);
 	    }
 	} else {
@@ -326,8 +348,22 @@ C<REFCNT> (corresponding to the C function C<SvREFCNT>).
 
 =item IV
 
+Returns the value of the IV, I<interpreted as
+a signed integer>. This will be misleading
+if C<FLAGS & SVf_IVisUV>. Perhaps you want the
+C<int_value> method instead?
+
 =item IVX
 
+=item UVX
+
+=item int_value
+
+This method returns the value of the IV as an integer.
+It differs from C<IV> in that it returns the correct
+value regardless of whether it's stored signed or
+unsigned.
+
 =item needs64bits
 
 =item packiv
@@ -358,6 +394,22 @@ C<REFCNT> (corresponding to the C function C<SvREFCNT>).
 
 =item PV
 
+This method is the one you usually want. It constructs a
+string using the length and offset information in the struct:
+for ordinary scalars it will return the string that you'd see
+from Perl, even if it contains null characters.
+
+=item PVX
+
+This method is less often useful. It assumes that the string
+stored in the struct is null-terminated, and disregards the
+length information.
+
+It is the appropriate method to use if you need to get the name
+of a lexical variable from a padname array. Lexical variable names
+are always stored with a null terminator, and the length field
+(SvCUR) is overloaded for other purposes and can't be relied on here.
+
 =back
 
 =head2 B::PVMG METHODS
@@ -426,6 +478,21 @@ This method returns TRUE if the GP field of the GV is NULL.
 
 =item NAME
 
+=item SAFENAME
+
+This method returns the name of the glob, but if the first
+character of the name is a control character, then it converts
+it to ^X first, so that *^G would return "^G" rather than "\cG".
+
+It's useful if you want to print out the name of a variable.
+If you restrict yourself to globs which exist at compile-time
+then the result ought to be unambiguous, because code like
+C<${"^G"} = 1> is compiled as two ops - a constant string and
+a dereference (rv2gv) - so that the glob is created at runtime.
+
+If you're working with globs at runtime, and need to disambiguate
+*^G from *{"^G"}, then you should use the raw NAME method.
+
 =item STASH
 
 =item SV
diff --git a/gnu/usr.bin/perl/ext/B/B.xs b/gnu/usr.bin/perl/ext/B/B.xs
index 9e2985582a1..10057475211 100644
--- a/gnu/usr.bin/perl/ext/B/B.xs
+++ b/gnu/usr.bin/perl/ext/B/B.xs
@@ -81,7 +81,7 @@ static char *opclassnames[] = {
 
 static int walkoptree_debug = 0;	/* Flag for walkoptree debug hook */
 
-static SV *specialsv_list[4];
+static SV *specialsv_list[6];
 
 static opclass
 cc_opclass(pTHX_ OP *o)
@@ -386,11 +386,15 @@ BOOT:
     specialsv_list[1] = &PL_sv_undef;
     specialsv_list[2] = &PL_sv_yes;
     specialsv_list[3] = &PL_sv_no;
+    specialsv_list[4] = pWARN_ALL;
+    specialsv_list[5] = pWARN_NONE;
 #include "defsubs.h"
 }
 
 #define B_main_cv()	PL_main_cv
 #define B_init_av()	PL_initav
+#define B_begin_av()	PL_beginav_save
+#define B_end_av()	PL_endav
 #define B_main_root()	PL_main_root
 #define B_main_start()	PL_main_start
 #define B_amagic_generation()	PL_amagic_generation
@@ -402,6 +406,12 @@ BOOT:
 B::AV
 B_init_av()
 
+B::AV
+B_begin_av()
+
+B::AV
+B_end_av()
+
 B::CV
 B_main_cv()
 
@@ -515,6 +525,11 @@ minus_c()
     CODE:
 	PL_minus_c = TRUE;
 
+void
+save_BEGINs()
+    CODE:
+	PL_minus_c |= 0x10;
+
 SV *
 cstring(sv)
 	SV *	sv
@@ -567,11 +582,12 @@ char *
 OP_name(o)
 	B::OP		o
     CODE:
-	ST(0) = sv_newmortal();
-	sv_setpv(ST(0), PL_op_name[o->op_type]);
+	RETVAL = PL_op_name[o->op_type];
+    OUTPUT:
+	RETVAL
 
 
-char *
+void
 OP_ppaddr(o)
 	B::OP		o
     PREINIT:
@@ -633,13 +649,20 @@ B::OP
 LOGOP_other(o)
 	B::LOGOP	o
 
-#define LISTOP_children(o)	o->op_children
-
 MODULE = B	PACKAGE = B::LISTOP		PREFIX = LISTOP_
 
 U32
 LISTOP_children(o)
 	B::LISTOP	o
+	OP *		kid = NO_INIT
+	int		i = NO_INIT
+    CODE:
+	i = 0;
+	for (kid = o->op_first; kid; kid = kid->op_sibling)
+	    i++;
+	RETVAL = i;
+    OUTPUT:
+        RETVAL
 
 #define PMOP_pmreplroot(o)	o->op_pmreplroot
 #define PMOP_pmreplstart(o)	o->op_pmreplstart
@@ -693,8 +716,8 @@ PMOP_precomp(o)
 	if (rx)
 	    sv_setpvn(ST(0), rx->precomp, rx->prelen);
 
-#define SVOP_sv(o)	cSVOPo->op_sv
-#define SVOP_gv(o)	((GV*)cSVOPo->op_sv)
+#define SVOP_sv(o)     cSVOPo->op_sv
+#define SVOP_gv(o)     ((GV*)cSVOPo->op_sv)
 
 MODULE = B	PACKAGE = B::SVOP		PREFIX = SVOP_
 
@@ -862,11 +885,11 @@ packiv(sv)
 
 MODULE = B	PACKAGE = B::NV		PREFIX = Sv
 
-double
+NV
 SvNV(sv)
 	B::NV	sv
 
-double
+NV
 SvNVX(sv)
 	B::NV	sv
 
@@ -878,6 +901,10 @@ SvRV(sv)
 
 MODULE = B	PACKAGE = B::PV		PREFIX = Sv
 
+char*
+SvPVX(sv)
+	B::PV	sv
+
 void
 SvPV(sv)
 	B::PV	sv
@@ -1210,7 +1237,7 @@ CvXSUBANY(cv)
 
 MODULE = B    PACKAGE = B::CV
 
-U8
+U16
 CvFLAGS(cv)
       B::CV   cv
 
@@ -1251,7 +1278,7 @@ HvARRAY(hv)
 	    I32 len;
 	    (void)hv_iterinit(hv);
 	    EXTEND(sp, HvKEYS(hv) * 2);
-	    while (sv = hv_iternextsv(hv, &key, &len)) {
+	    while ((sv = hv_iternextsv(hv, &key, &len))) {
 		PUSHs(newSVpvn(key, len));
 		PUSHs(make_sv_object(aTHX_ sv_newmortal(), sv));
 	    }
diff --git a/gnu/usr.bin/perl/ext/B/B/Concise.pm b/gnu/usr.bin/perl/ext/B/B/Concise.pm
new file mode 100644
index 00000000000..cb352ebf1cd
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/B/B/Concise.pm
@@ -0,0 +1,823 @@
+package B::Concise;
+# Copyright (C) 2000, 2001 Stephen McCamant. All rights reserved.
+# This program is free software; you can redistribute and/or modify it
+# under the same terms as Perl itself.
+
+our $VERSION = "0.51";
+use strict;
+use B qw(class ppname main_start main_root main_cv cstring svref_2object
+	 SVf_IOK SVf_NOK SVf_POK OPf_KIDS);
+
+my %style = 
+  ("terse" =>
+   ["(?(#label =>\n)?)(*(    )*)#class (#addr) #name (?([#targ])?) "
+    . "#svclass~(?((#svaddr))?)~#svval~(?(label \"#coplabel\")?)\n",
+    "(*(    )*)goto #class (#addr)\n",
+    "#class pp_#name"],
+   "concise" =>
+   ["#hyphseq2 (*(   (x( ;)x))*)<#classsym> "
+    . "#exname#arg(?([#targarglife])?)~#flags(?(/#private)?)(x(;~->#next)x)\n",
+    "  (*(    )*)     goto #seq\n",
+    "(?(<#seq>)?)#exname#arg(?([#targarglife])?)"],
+   "linenoise" =>
+   ["(x(;(*( )*))x)#noise#arg(?([#targarg])?)(x( ;\n)x)",
+    "gt_#seq ",
+    "(?(#seq)?)#noise#arg(?([#targarg])?)"],
+   "debug" =>
+   ["#class (#addr)\n\top_next\t\t#nextaddr\n\top_sibling\t#sibaddr\n\t"
+    . "op_ppaddr\tPL_ppaddr[OP_#NAME]\n\top_type\t\t#typenum\n\top_seq\t\t"
+    . "#seqnum\n\top_flags\t#flagval\n\top_private\t#privval\n"
+    . "(?(\top_first\t#firstaddr\n)?)(?(\top_last\t\t#lastaddr\n)?)"
+    . "(?(\top_sv\t\t#svaddr\n)?)",
+    "    GOTO #addr\n",
+    "#addr"],
+   "env" => [$ENV{B_CONCISE_FORMAT}, $ENV{B_CONCISE_GOTO_FORMAT},
+	     $ENV{B_CONCISE_TREE_FORMAT}],
+  );
+
+my($format, $gotofmt, $treefmt);
+my $curcv;
+my($seq_base, $cop_seq_base);
+
+sub concise_cv {
+    my ($order, $cvref) = @_;
+    my $cv = svref_2object($cvref);
+    $curcv = $cv;
+    if ($order eq "exec") {
+	walk_exec($cv->START);
+    } elsif ($order eq "basic") {
+	walk_topdown($cv->ROOT, sub { $_[0]->concise($_[1]) }, 0);
+    } else {
+	print tree($cv->ROOT, 0)
+    }
+}
+
+my $start_sym = "\e(0"; # "\cN" sometimes also works
+my $end_sym   = "\e(B"; # "\cO" respectively
+
+my @tree_decorations = 
+  (["  ", "--", "+-", "|-", "| ", "`-", "-", 1],
+   [" ", "-", "+", "+", "|", "`", "", 0],
+   ["  ", map("$start_sym$_$end_sym", "qq", "wq", "tq", "x ", "mq", "q"), 1],
+   [" ", map("$start_sym$_$end_sym", "q", "w", "t", "x", "m"), "", 0],
+  );
+my $tree_style = 0;
+
+my $base = 36;
+my $big_endian = 1;
+
+my $order = "basic";
+
+sub compile {
+    my @options = grep(/^-/, @_);
+    my @args = grep(!/^-/, @_);
+    my $do_main = 0;
+    ($format, $gotofmt, $treefmt) = @{$style{"concise"}};
+    for my $o (@options) {
+	if ($o eq "-basic") {
+	    $order = "basic";
+	} elsif ($o eq "-exec") {
+	    $order = "exec";
+	} elsif ($o eq "-tree") {
+	    $order = "tree";
+	} elsif ($o eq "-compact") {
+	    $tree_style |= 1;
+	} elsif ($o eq "-loose") {
+	    $tree_style &= ~1;
+	} elsif ($o eq "-vt") {
+	    $tree_style |= 2;
+	} elsif ($o eq "-ascii") {
+	    $tree_style &= ~2;
+	} elsif ($o eq "-main") {
+	    $do_main = 1;
+	} elsif ($o =~ /^-base(\d+)$/) {
+	    $base = $1;
+	} elsif ($o eq "-bigendian") {
+	    $big_endian = 1;
+	} elsif ($o eq "-littleendian") {
+	    $big_endian = 0;
+	} elsif (exists $style{substr($o, 1)}) {
+	    ($format, $gotofmt, $treefmt) = @{$style{substr($o, 1)}};
+	} else {
+	    warn "Option $o unrecognized";
+	}
+    }
+    if (@args) {
+	return sub {
+	    for my $objname (@args) {
+		$objname = "main::" . $objname unless $objname =~ /::/;
+		eval "concise_cv(\$order, \\&$objname)";
+		die "concise_cv($order, \\&$objname) failed: $@" if $@;
+	    }
+	}
+    }
+    if (!@args or $do_main) {
+	if ($order eq "exec") {
+	    return sub { return if class(main_start) eq "NULL";
+			 $curcv = main_cv;
+			 walk_exec(main_start) }
+	} elsif ($order eq "tree") {
+	    return sub { return if class(main_root) eq "NULL";
+			 $curcv = main_cv;
+			 print tree(main_root, 0) }
+	} elsif ($order eq "basic") {
+	    return sub { return if class(main_root) eq "NULL";
+			 $curcv = main_cv;
+			 walk_topdown(main_root,
+				      sub { $_[0]->concise($_[1]) }, 0); }
+	}
+    }
+}
+
+my %labels;
+my $lastnext;
+
+my %opclass = ('OP' => "0", 'UNOP' => "1", 'BINOP' => "2", 'LOGOP' => "|",
+	       'LISTOP' => "@", 'PMOP' => "/", 'SVOP' => "\$", 'GVOP' => "*",
+	       'PVOP' => '"', 'LOOP' => "{", 'COP' => ";");
+
+my @linenoise =
+  qw'#  () sc (  @? 1  $* gv *{ m$ m@ m% m? p/ *$ $  $# & a& pt \\ s\\ rf bl
+     `  *? <> ?? ?/ r/ c/ // qr s/ /c y/ =  @= C  sC Cp sp df un BM po +1 +I
+     -1 -I 1+ I+ 1- I- ** *  i* /  i/ %$ i% x  +  i+ -  i- .  "  << >> <  i<
+     >  i> <= i, >= i. == i= != i! <? i? s< s> s, s. s= s! s? b& b^ b| -0 -i
+     !  ~  a2 si cs rd sr e^ lg sq in %x %o ab le ss ve ix ri sf FL od ch cy
+     uf lf uc lc qm @  [f [  @[ eh vl ky dl ex %  ${ @{ uk pk st jn )  )[ a@
+     a% sl +] -] [- [+ so rv GS GW MS MW .. f. .f && || ^^ ?: &= |= -> s{ s}
+     v} ca wa di rs ;; ;  ;d }{ {  }  {} f{ it {l l} rt }l }n }r dm }g }e ^o
+     ^c ^| ^# um bm t~ u~ ~d DB db ^s se ^g ^r {w }w pf pr ^O ^K ^R ^W ^d ^v
+     ^e ^t ^k t. fc ic fl .s .p .b .c .l .a .h g1 s1 g2 s2 ?. l? -R -W -X -r
+     -w -x -e -o -O -z -s -M -A -C -S -c -b -f -d -p -l -u -g -k -t -T -B cd
+     co cr u. cm ut r. l@ s@ r@ mD uD oD rD tD sD wD cD f$ w$ p$ sh e$ k$ g3
+     g4 s4 g5 s5 T@ C@ L@ G@ A@ S@ Hg Hc Hr Hw Mg Mc Ms Mr Sg Sc So rq do {e
+     e} {t t} g6 G6 6e g7 G7 7e g8 G8 8e g9 G9 9e 6s 7s 8s 9s 6E 7E 8E 9E Pn
+     Pu GP SP EP Gn Gg GG SG EG g0 c$ lk t$ ;s n>';
+
+my $chars = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
+
+sub op_flags {
+    my($x) = @_;
+    my(@v);
+    push @v, "v" if ($x & 3) == 1;
+    push @v, "s" if ($x & 3) == 2;
+    push @v, "l" if ($x & 3) == 3;
+    push @v, "K" if $x & 4;
+    push @v, "P" if $x & 8;
+    push @v, "R" if $x & 16;
+    push @v, "M" if $x & 32;
+    push @v, "S" if $x & 64;
+    push @v, "*" if $x & 128;
+    return join("", @v);
+}
+
+sub base_n {
+    my $x = shift;
+    return "-" . base_n(-$x) if $x < 0;
+    my $str = "";
+    do { $str .= substr($chars, $x % $base, 1) } while $x = int($x / $base);
+    $str = reverse $str if $big_endian;
+    return $str;
+}
+
+sub seq { return $_[0]->seq ? base_n($_[0]->seq - $seq_base) : "-" }
+
+sub walk_topdown {
+    my($op, $sub, $level) = @_;
+    $sub->($op, $level);
+    if ($op->flags & OPf_KIDS) {
+	for (my $kid = $op->first; $$kid; $kid = $kid->sibling) {
+	    walk_topdown($kid, $sub, $level + 1);
+	}
+    }
+    if (class($op) eq "PMOP" and $ {$op->pmreplroot}
+	and $op->pmreplroot->isa("B::OP")) {
+	walk_topdown($op->pmreplroot, $sub, $level + 1);
+    }
+}
+
+sub walklines {
+    my($ar, $level) = @_;
+    for my $l (@$ar) {
+	if (ref($l) eq "ARRAY") {
+	    walklines($l, $level + 1);
+	} else {
+	    $l->concise($level);
+	}
+    }
+}
+
+sub walk_exec {
+    my($top, $level) = @_;
+    my %opsseen;
+    my @lines;
+    my @todo = ([$top, \@lines]);
+    while (@todo and my($op, $targ) = @{shift @todo}) {
+	for (; $$op; $op = $op->next) {
+	    last if $opsseen{$$op}++;
+	    push @$targ, $op;
+	    my $name = $op->name;
+	    if ($name
+		=~ /^(or|and|(map|grep)while|entertry|range|cond_expr)$/) {
+		my $ar = [];
+		push @$targ, $ar;
+		push @todo, [$op->other, $ar];
+	    } elsif ($name eq "subst" and $ {$op->pmreplstart}) {
+		my $ar = [];
+		push @$targ, $ar;
+		push @todo, [$op->pmreplstart, $ar];
+	    } elsif ($name =~ /^enter(loop|iter)$/) {
+		$labels{$op->nextop->seq} = "NEXT";
+		$labels{$op->lastop->seq} = "LAST";
+		$labels{$op->redoop->seq} = "REDO";		
+	    }
+	}
+    }
+    walklines(\@lines, 0);
+}
+
+sub fmt_line {
+    my($hr, $fmt, $level) = @_;
+    my $text = $fmt;
+    $text =~ s/\(\?\(([^\#]*?)\#(\w+)([^\#]*?)\)\?\)/
+      $hr->{$2} ? $1.$hr->{$2}.$3 : ""/eg;
+    $text =~ s/\(x\((.*?);(.*?)\)x\)/$order eq "exec" ? $1 : $2/egs;
+    $text =~ s/\(\*\(([^;]*?)\)\*\)/$1 x $level/egs;
+    $text =~ s/\(\*\((.*?);(.*?)\)\*\)/$1 x ($level - 1) . $2 x ($level>0)/egs;
+    $text =~ s/#([a-zA-Z]+)(\d+)/sprintf("%-$2s", $hr->{$1})/eg;
+    $text =~ s/#([a-zA-Z]+)/$hr->{$1}/eg;
+    $text =~ s/[ \t]*~+[ \t]*/ /g;
+    return $text;
+}
+
+my %priv;
+$priv{$_}{128} = "LVINTRO"
+  for ("pos", "substr", "vec", "threadsv", "gvsv", "rv2sv", "rv2hv", "rv2gv",
+       "rv2av", "rv2arylen", "aelem", "helem", "aslice", "hslice", "padsv",
+       "padav", "padhv");
+$priv{$_}{64} = "REFC" for ("leave", "leavesub", "leavesublv", "leavewrite");
+$priv{"aassign"}{64} = "COMMON";
+$priv{"aassign"}{32} = "PHASH";
+$priv{"sassign"}{64} = "BKWARD";
+$priv{$_}{64} = "RTIME" for ("match", "subst", "substcont");
+@{$priv{"trans"}}{1,2,4,8,16,64} = ("<UTF", ">UTF", "IDENT", "SQUASH", "DEL",
+				    "COMPL", "GROWS");
+$priv{"repeat"}{64} = "DOLIST";
+$priv{"leaveloop"}{64} = "CONT";
+@{$priv{$_}}{32,64,96} = ("DREFAV", "DREFHV", "DREFSV")
+  for ("entersub", map("rv2${_}v", "a", "s", "h", "g"), "aelem", "helem");
+$priv{"entersub"}{16} = "DBG";
+$priv{"entersub"}{32} = "TARG";
+@{$priv{$_}}{4,8,128} = ("INARGS","AMPER","NO()") for ("entersub", "rv2cv");
+$priv{"gv"}{32} = "EARLYCV";
+$priv{"aelem"}{16} = $priv{"helem"}{16} = "LVDEFER";
+$priv{$_}{16} = "OURINTR" for ("gvsv", "rv2sv", "rv2av", "rv2hv", "r2gv");
+$priv{$_}{16} = "TARGMY"
+  for (map(($_,"s$_"),"chop", "chomp"),
+       map(($_,"i_$_"), "postinc", "postdec", "multiply", "divide", "modulo",
+	   "add", "subtract", "negate"), "pow", "concat", "stringify",
+       "left_shift", "right_shift", "bit_and", "bit_xor", "bit_or",
+       "complement", "atan2", "sin", "cos", "rand", "exp", "log", "sqrt",
+       "int", "hex", "oct", "abs", "length", "index", "rindex", "sprintf",
+       "ord", "chr", "crypt", "quotemeta", "join", "push", "unshift", "flock",
+       "chdir", "chown", "chroot", "unlink", "chmod", "utime", "rename",
+       "link", "symlink", "mkdir", "rmdir", "wait", "waitpid", "system",
+       "exec", "kill", "getppid", "getpgrp", "setpgrp", "getpriority",
+       "setpriority", "time", "sleep");
+@{$priv{"const"}}{8,16,32,64,128} = ("STRICT","ENTERED", "$[", "BARE", "WARN");
+$priv{"flip"}{64} = $priv{"flop"}{64} = "LINENUM";
+$priv{"list"}{64} = "GUESSED";
+$priv{"delete"}{64} = "SLICE";
+$priv{"exists"}{64} = "SUB";
+$priv{$_}{64} = "LOCALE"
+  for ("sort", "prtf", "sprintf", "slt", "sle", "seq", "sne", "sgt", "sge",
+       "scmp", "lc", "uc", "lcfirst", "ucfirst");
+@{$priv{"sort"}}{1,2,4} = ("NUM", "INT", "REV");
+$priv{"threadsv"}{64} = "SVREFd";
+$priv{$_}{16} = "INBIN" for ("open", "backtick");
+$priv{$_}{32} = "INCR" for ("open", "backtick");
+$priv{$_}{64} = "OUTBIN" for ("open", "backtick");
+$priv{$_}{128} = "OUTCR" for ("open", "backtick");
+$priv{"exit"}{128} = "VMS";
+
+sub private_flags {
+    my($name, $x) = @_;
+    my @s;
+    for my $flag (128, 96, 64, 32, 16, 8, 4, 2, 1) {
+	if ($priv{$name}{$flag} and $x & $flag and $x >= $flag) {
+	    $x -= $flag;
+	    push @s, $priv{$name}{$flag};
+	}
+    }
+    push @s, $x if $x;
+    return join(",", @s);
+}
+
+sub concise_op {
+    my ($op, $level, $format) = @_;
+    my %h;
+    $h{exname} = $h{name} = $op->name;
+    $h{NAME} = uc $h{name};
+    $h{class} = class($op);
+    $h{extarg} = $h{targ} = $op->targ;
+    $h{extarg} = "" unless $h{extarg};
+    if ($h{name} eq "null" and $h{targ}) {
+	$h{exname} = "ex-" . substr(ppname($h{targ}), 3);
+	$h{extarg} = "";
+    } elsif ($h{targ}) {
+	my $padname = (($curcv->PADLIST->ARRAY)[0]->ARRAY)[$h{targ}];
+	if (defined $padname and class($padname) ne "SPECIAL") {
+	    $h{targarg}  = $padname->PVX;
+	    my $intro = $padname->NVX - $cop_seq_base;
+	    my $finish = int($padname->IVX) - $cop_seq_base;
+	    $finish = "end" if $finish == 999999999 - $cop_seq_base;
+	    $h{targarglife} = "$h{targarg}:$intro,$finish";
+	} else {
+	    $h{targarglife} = $h{targarg} = "t" . $h{targ};
+	}
+    }
+    $h{arg} = "";
+    $h{svclass} = $h{svaddr} = $h{svval} = "";
+    if ($h{class} eq "PMOP") {
+	my $precomp = $op->precomp;
+	$precomp = defined($precomp) ? "/$precomp/" : "";
+	my $pmreplroot = $op->pmreplroot;
+	my ($pmreplroot, $pmreplstart);
+	if ($ {$pmreplroot = $op->pmreplroot} && $pmreplroot->isa("B::GV")) {
+	    # with C<@stash_array = split(/pat/, str);>,
+	    #  *stash_array is stored in pmreplroot.
+	    $h{arg} = "($precomp => \@" . $pmreplroot->NAME . ")";
+	} elsif ($ {$op->pmreplstart}) {
+	    undef $lastnext;
+	    $pmreplstart = "replstart->" . seq($op->pmreplstart);
+	    $h{arg} = "(" . join(" ", $precomp, $pmreplstart) . ")";
+	} else {
+	    $h{arg} = "($precomp)";
+	}
+    } elsif ($h{class} eq "PVOP" and $h{name} ne "trans") {
+	$h{arg} = '("' . $op->pv . '")';
+	$h{svval} = '"' . $op->pv . '"';
+    } elsif ($h{class} eq "COP") {
+	my $label = $op->label;
+	$h{coplabel} = $label;
+	$label = $label ? "$label: " : "";
+	my $loc = $op->file;
+	$loc =~ s[.*/][];
+	$loc .= ":" . $op->line;
+	my($stash, $cseq) = ($op->stash->NAME, $op->cop_seq - $cop_seq_base);
+	my $arybase = $op->arybase;
+	$arybase = $arybase ? ' $[=' . $arybase : "";
+	$h{arg} = "($label$stash $cseq $loc$arybase)";
+    } elsif ($h{class} eq "LOOP") {
+	$h{arg} = "(next->" . seq($op->nextop) . " last->" . seq($op->lastop)
+	  . " redo->" . seq($op->redoop) . ")";
+    } elsif ($h{class} eq "LOGOP") {
+	undef $lastnext;
+	$h{arg} = "(other->" . seq($op->other) . ")";
+    } elsif ($h{class} eq "SVOP") {
+	my $sv = $op->sv;
+	$h{svclass} = class($sv);
+	$h{svaddr} = sprintf("%#x", $$sv);
+	if ($h{svclass} eq "GV") {
+	    my $gv = $sv;
+	    my $stash = $gv->STASH->NAME;
+	    if ($stash eq "main") {
+		$stash = "";
+	    } else {
+		$stash = $stash . "::";
+	    }
+	    $h{arg} = "(*$stash" . $gv->SAFENAME . ")";
+	    $h{svval} = "*$stash" . $gv->SAFENAME;
+	} else {
+	    while (class($sv) eq "RV") {
+		$h{svval} .= "\\";
+		$sv = $sv->RV;
+	    }
+	    if (class($sv) eq "SPECIAL") {
+		$h{svval} = ["Null", "sv_undef", "sv_yes", "sv_no"]->[$$sv];
+	    } elsif ($sv->FLAGS & SVf_NOK) {
+		$h{svval} = $sv->NV;
+	    } elsif ($sv->FLAGS & SVf_IOK) {
+		$h{svval} = $sv->IV;
+	    } elsif ($sv->FLAGS & SVf_POK) {
+		$h{svval} = cstring($sv->PV);
+	    }
+	    $h{arg} = "($h{svclass} $h{svval})";
+	}
+    }
+    $h{seq} = $h{hyphseq} = seq($op);
+    $h{seq} = "" if $h{seq} eq "-";
+    $h{seqnum} = $op->seq;
+    $h{next} = $op->next;
+    $h{next} = (class($h{next}) eq "NULL") ? "(end)" : seq($h{next});
+    $h{nextaddr} = sprintf("%#x", $ {$op->next});
+    $h{sibaddr} = sprintf("%#x", $ {$op->sibling});
+    $h{firstaddr} = sprintf("%#x", $ {$op->first}) if $op->can("first");
+    $h{lastaddr} = sprintf("%#x", $ {$op->last}) if $op->can("last");
+
+    $h{classsym} = $opclass{$h{class}};
+    $h{flagval} = $op->flags;
+    $h{flags} = op_flags($op->flags);
+    $h{privval} = $op->private;
+    $h{private} = private_flags($h{name}, $op->private);
+    $h{addr} = sprintf("%#x", $$op);
+    $h{label} = $labels{$op->seq};
+    $h{typenum} = $op->type;
+    $h{noise} = $linenoise[$op->type];
+    return fmt_line(\%h, $format, $level);
+}
+
+sub B::OP::concise {
+    my($op, $level) = @_;
+    if ($order eq "exec" and $lastnext and $$lastnext != $$op) {
+	my $h = {"seq" => seq($lastnext), "class" => class($lastnext),
+		 "addr" => sprintf("%#x", $$lastnext)};
+	print fmt_line($h, $gotofmt, $level+1);
+    }
+    $lastnext = $op->next;
+    print concise_op($op, $level, $format);
+}
+
+sub tree {
+    my $op = shift;
+    my $level = shift;
+    my $style = $tree_decorations[$tree_style];
+    my($space, $single, $kids, $kid, $nokid, $last, $lead, $size) = @$style;
+    my $name = concise_op($op, $level, $treefmt);
+    if (not $op->flags & OPf_KIDS) {
+	return $name . "\n";
+    }
+    my @lines;
+    for (my $kid = $op->first; $$kid; $kid = $kid->sibling) {
+	push @lines, tree($kid, $level+1);
+    }
+    my $i;
+    for ($i = $#lines; substr($lines[$i], 0, 1) eq " "; $i--) {
+	$lines[$i] = $space . $lines[$i];
+    }
+    if ($i > 0) {
+	$lines[$i] = $last . $lines[$i];
+	while ($i-- > 1) {
+	    if (substr($lines[$i], 0, 1) eq " ") {
+		$lines[$i] = $nokid . $lines[$i];
+	    } else {
+		$lines[$i] = $kid . $lines[$i];		
+	    }
+	}
+	$lines[$i] = $kids . $lines[$i];
+    } else {
+	$lines[0] = $single . $lines[0];
+    }
+    return("$name$lead" . shift @lines,
+           map(" " x (length($name)+$size) . $_, @lines));
+}
+
+# This is a bit of a hack; the 2 and 15 were determined empirically.
+# These need to stay the last things in the module.
+$cop_seq_base = svref_2object(eval 'sub{0;}')->START->cop_seq + 2;
+$seq_base = svref_2object(eval 'sub{}')->START->seq + 15;
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::Concise - Walk Perl syntax tree, printing concise info about ops
+
+=head1 SYNOPSIS
+
+    perl -MO=Concise[,OPTIONS] foo.pl
+
+=head1 DESCRIPTION
+
+This compiler backend prints the internal OPs of a Perl program's syntax
+tree in one of several space-efficient text formats suitable for debugging
+the inner workings of perl or other compiler backends. It can print OPs in
+the order they appear in the OP tree, in the order they will execute, or
+in a text approximation to their tree structure, and the format of the
+information displyed is customizable. Its function is similar to that of
+perl's B<-Dx> debugging flag or the B<B::Terse> module, but it is more
+sophisticated and flexible.
+
+=head1 OPTIONS
+
+Arguments that don't start with a hyphen are taken to be the names of
+subroutines to print the OPs of; if no such functions are specified, the
+main body of the program (outside any subroutines, and not including use'd
+or require'd files) is printed.
+
+=over 4
+
+=item B<-basic>
+
+Print OPs in the order they appear in the OP tree (a preorder
+traversal, starting at the root). The indentation of each OP shows its
+level in the tree.  This mode is the default, so the flag is included
+simply for completeness.
+
+=item B<-exec>
+
+Print OPs in the order they would normally execute (for the majority
+of constructs this is a postorder traversal of the tree, ending at the
+root). In most cases the OP that usually follows a given OP will
+appear directly below it; alternate paths are shown by indentation. In
+cases like loops when control jumps out of a linear path, a 'goto'
+line is generated.
+
+=item B<-tree>
+
+Print OPs in a text approximation of a tree, with the root of the tree
+at the left and 'left-to-right' order of children transformed into
+'top-to-bottom'. Because this mode grows both to the right and down,
+it isn't suitable for large programs (unless you have a very wide
+terminal).
+
+=item B<-compact>
+
+Use a tree format in which the minimum amount of space is used for the
+lines connecting nodes (one character in most cases). This squeezes out
+a few precious columns of screen real estate.
+
+=item B<-loose>
+
+Use a tree format that uses longer edges to separate OP nodes. This format
+tends to look better than the compact one, especially in ASCII, and is
+the default.
+
+=item B<-vt>
+
+Use tree connecting characters drawn from the VT100 line-drawing set.
+This looks better if your terminal supports it.
+
+=item B<-ascii>
+
+Draw the tree with standard ASCII characters like C<+> and C<|>. These don't
+look as clean as the VT100 characters, but they'll work with almost any
+terminal (or the horizontal scrolling mode of less(1)) and are suitable
+for text documentation or email. This is the default.
+
+=item B<-main>
+
+Include the main program in the output, even if subroutines were also
+specified.
+
+=item B<-base>I<n>
+
+Print OP sequence numbers in base I<n>. If I<n> is greater than 10, the
+digit for 11 will be 'a', and so on. If I<n> is greater than 36, the digit
+for 37 will be 'A', and so on until 62. Values greater than 62 are not
+currently supported. The default is 36.
+
+=item B<-bigendian>
+
+Print sequence numbers with the most significant digit first. This is the
+usual convention for Arabic numerals, and the default.
+
+=item B<-littleendian>
+
+Print seqence numbers with the least significant digit first.
+
+=item B<-concise>
+
+Use the author's favorite set of formatting conventions. This is the
+default, of course.
+
+=item B<-terse>
+
+Use formatting conventions that emulate the ouput of B<B::Terse>. The
+basic mode is almost indistinguishable from the real B<B::Terse>, and the
+exec mode looks very similar, but is in a more logical order and lacks
+curly brackets. B<B::Terse> doesn't have a tree mode, so the tree mode
+is only vaguely reminiscient of B<B::Terse>.
+
+=item B<-linenoise>
+
+Use formatting conventions in which the name of each OP, rather than being
+written out in full, is represented by a one- or two-character abbreviation.
+This is mainly a joke.
+
+=item B<-debug>
+
+Use formatting conventions reminiscient of B<B::Debug>; these aren't
+very concise at all.
+
+=item B<-env>
+
+Use formatting conventions read from the environment variables
+C<B_CONCISE_FORMAT>, C<B_CONCISE_GOTO_FORMAT>, and C<B_CONCISE_TREE_FORMAT>.
+
+=back
+
+=head1 FORMATTING SPECIFICATIONS
+
+For each general style ('concise', 'terse', 'linenoise', etc.) there are
+three specifications: one of how OPs should appear in the basic or exec
+modes, one of how 'goto' lines should appear (these occur in the exec
+mode only), and one of how nodes should appear in tree mode. Each has the
+same format, described below. Any text that doesn't match a special
+pattern is copied verbatim.
+
+=over 4
+
+=item B<(x(>I<exec_text>B<;>I<basic_text>B<)x)>
+
+Generates I<exec_text> in exec mode, or I<basic_text> in basic mode.
+
+=item B<(*(>I<text>B<)*)>
+
+Generates one copy of I<text> for each indentation level.
+
+=item B<(*(>I<text1>B<;>I<text2>B<)*)>
+
+Generates one fewer copies of I<text1> than the indentation level, followed
+by one copy of I<text2> if the indentation level is more than 0.
+
+=item B<(?(>I<text1>B<#>I<var>I<Text2>B<)?)>
+
+If the value of I<var> is true (not empty or zero), generates the
+value of I<var> surrounded by I<text1> and I<Text2>, otherwise
+nothing.
+
+=item B<#>I<var>
+
+Generates the value of the variable I<var>.
+
+=item B<#>I<var>I<N>
+
+Generates the value of I<var>, left jutified to fill I<N> spaces.
+
+=item B<~>
+
+Any number of tildes and surrounding whitespace will be collapsed to
+a single space.
+
+=back
+
+The following variables are recognized:
+
+=over 4
+
+=item B<#addr>
+
+The address of the OP, in hexidecimal.
+
+=item B<#arg>
+
+The OP-specific information of the OP (such as the SV for an SVOP, the
+non-local exit pointers for a LOOP, etc.) enclosed in paretheses.
+
+=item B<#class>
+
+The B-determined class of the OP, in all caps.
+
+=item B<#classym>
+
+A single symbol abbreviating the class of the OP.
+
+=item B<#coplabel>
+
+The label of the statement or block the OP is the start of, if any.
+
+=item B<#exname>
+
+The name of the OP, or 'ex-foo' if the OP is a null that used to be a foo.
+
+=item B<#extarg>
+
+The target of the OP, or nothing for a nulled OP.
+
+=item B<#firstaddr>
+
+The address of the OP's first child, in hexidecimal.
+
+=item B<#flags>
+
+The OP's flags, abbreviated as a series of symbols.
+
+=item B<#flagval>
+
+The numeric value of the OP's flags.
+
+=item B<#hyphenseq>
+
+The sequence number of the OP, or a hyphen if it doesn't have one.
+
+=item B<#label>
+
+'NEXT', 'LAST', or 'REDO' if the OP is a target of one of those in exec
+mode, or empty otherwise.
+
+=item B<#lastaddr>
+
+The address of the OP's last child, in hexidecimal.
+
+=item B<#name>
+
+The OP's name.
+
+=item B<#NAME>
+
+The OP's name, in all caps.
+
+=item B<#next>
+
+The sequence number of the OP's next OP.
+
+=item B<#nextaddr>
+
+The address of the OP's next OP, in hexidecimal.
+
+=item B<#noise>
+
+The two-character abbreviation for the OP's name.
+
+=item B<#private>
+
+The OP's private flags, rendered with abbreviated names if possible.
+
+=item B<#privval>
+
+The numeric value of the OP's private flags.
+
+=item B<#seq>
+
+The sequence number of the OP.
+
+=item B<#seqnum>
+
+The real sequence number of the OP, as a regular number and not adjusted
+to be relative to the start of the real program. (This will generally be
+a fairly large number because all of B<B::Concise> is compiled before
+your program is).
+
+=item B<#sibaddr>
+
+The address of the OP's next youngest sibling, in hexidecimal.
+
+=item B<#svaddr>
+
+The address of the OP's SV, if it has an SV, in hexidecimal.
+
+=item B<#svclass>
+
+The class of the OP's SV, if it has one, in all caps (e.g., 'IV').
+
+=item B<#svval>
+
+The value of the OP's SV, if it has one, in a short human-readable format.
+
+=item B<#targ>
+
+The numeric value of the OP's targ.
+
+=item B<#targarg>
+
+The name of the variable the OP's targ refers to, if any, otherwise the
+letter t followed by the OP's targ in decimal.
+
+=item B<#targarglife>
+
+Same as B<#targarg>, but followed by the COP sequence numbers that delimit
+the variable's lifetime (or 'end' for a variable in an open scope) for a
+variable.
+
+=item B<#typenum>
+
+The numeric value of the OP's type, in decimal.
+
+=back
+
+=head1 ABBREVIATIONS
+
+=head2 OP flags abbreviations
+
+    v      OPf_WANT_VOID    Want nothing (void context)
+    s      OPf_WANT_SCALAR  Want single value (scalar context)
+    l      OPf_WANT_LIST    Want list of any length (list context)
+    K      OPf_KIDS         There is a firstborn child.
+    P      OPf_PARENS       This operator was parenthesized.
+                             (Or block needs explicit scope entry.)
+    R      OPf_REF          Certified reference.
+                             (Return container, not containee).
+    M      OPf_MOD          Will modify (lvalue).
+    S      OPf_STACKED      Some arg is arriving on the stack.
+    *      OPf_SPECIAL      Do something weird for this op (see op.h)
+
+=head2 OP class abbreviations
+
+    0      OP (aka BASEOP)  An OP with no children
+    1      UNOP             An OP with one child
+    2      BINOP            An OP with two children
+    |      LOGOP            A control branch OP
+    @      LISTOP           An OP that could have lots of children
+    /      PMOP             An OP with a regular expression
+    $      SVOP             An OP with an SV
+    "      PVOP             An OP with a string
+    {      LOOP             An OP that holds pointers for a loop
+    ;      COP              An OP that marks the start of a statement
+
+=head1 AUTHOR
+
+Stephen McCamant, C<smcc@CSUA.Berkeley.EDU>
+
+=cut
diff --git a/gnu/usr.bin/perl/ext/B/B/Showlex.pm b/gnu/usr.bin/perl/ext/B/B/Showlex.pm
index 648f95dcc0a..842ca3ee2b8 100644
--- a/gnu/usr.bin/perl/ext/B/B/Showlex.pm
+++ b/gnu/usr.bin/perl/ext/B/B/Showlex.pm
@@ -12,7 +12,24 @@ use B::Terse ();
 # to see the names of file scope lexicals used by bar.pl
 #    
 
-sub showarray {
+sub shownamearray {
+    my ($name, $av) = @_;
+    my @els = $av->ARRAY;
+    my $count = @els;
+    my $i;
+    print "$name has $count entries\n";
+    for ($i = 0; $i < $count; $i++) {
+        print "$i: ";
+	my $sv = $els[$i];
+	if (class($sv) ne "SPECIAL") {
+	    printf "%s (0x%lx) %s\n", class($sv), $$sv, $sv->PVX;
+	} else {
+            $sv->terse;
+	}
+    }
+}
+
+sub showvaluearray {
     my ($name, $av) = @_;
     my @els = $av->ARRAY;
     my $count = @els;
@@ -26,8 +43,8 @@ sub showarray {
 
 sub showlex {
     my ($objname, $namesav, $valsav) = @_;
-    showarray("Pad of lexical names for $objname", $namesav);
-    showarray("Pad of lexical values for $objname", $valsav);
+    shownamearray("Pad of lexical names for $objname", $namesav);
+    showvaluearray("Pad of lexical values for $objname", $valsav);
 }
 
 sub showlex_obj {
diff --git a/gnu/usr.bin/perl/ext/B/B/Terse.pm b/gnu/usr.bin/perl/ext/B/B/Terse.pm
index 66b5cfc2f2f..52f0549911e 100644
--- a/gnu/usr.bin/perl/ext/B/B/Terse.pm
+++ b/gnu/usr.bin/perl/ext/B/B/Terse.pm
@@ -1,7 +1,7 @@
 package B::Terse;
 use strict;
-use B qw(peekop class walkoptree_slow walkoptree_exec
-	 main_start main_root cstring svref_2object);
+use B qw(peekop class walkoptree walkoptree_exec walkoptree_slow
+	 main_start main_root cstring svref_2object SVf_IVisUV);
 use B::Asmdata qw(@specialsv_name);
 
 sub terse {
@@ -15,7 +15,7 @@ sub terse {
 }
 
 sub compile {
-    my $order = shift;
+    my $order = @_ ? shift : "";
     my @options = @_;
     B::clearsym();
     if (@options) {
@@ -37,7 +37,7 @@ sub compile {
 }
 
 sub indent {
-    my $level = shift;
+    my $level = @_ ? shift : 0;
     return "    " x $level;
 }
 
@@ -102,13 +102,14 @@ sub B::GV::terse {
 	$stash = $stash . "::";
     }
     print indent($level);
-    printf "%s (0x%lx) *%s%s\n", class($gv), $$gv, $stash, $gv->NAME;
+    printf "%s (0x%lx) *%s%s\n", class($gv), $$gv, $stash, $gv->SAFENAME;
 }
 
 sub B::IV::terse {
     my ($sv, $level) = @_;
     print indent($level);
-    printf "%s (0x%lx) %d\n", class($sv), $$sv, $sv->IV;
+    my $v = $sv->FLAGS & SVf_IVisUV ? "%u" : "%d";
+    printf "%s (0x%lx) $v\n", class($sv), $$sv, $sv->int_value;
 }
 
 sub B::NV::terse {
diff --git a/gnu/usr.bin/perl/ext/B/Makefile.PL b/gnu/usr.bin/perl/ext/B/Makefile.PL
index cb9696bf416..dcf6a1db15b 100644
--- a/gnu/usr.bin/perl/ext/B/Makefile.PL
+++ b/gnu/usr.bin/perl/ext/B/Makefile.PL
@@ -1,5 +1,6 @@
 use ExtUtils::MakeMaker;
 use Config;
+use File::Spec;
 
 my $e = $Config{'exe_ext'};
 my $o = $Config{'obj_ext'};
@@ -29,8 +30,19 @@ sub post_constants {
     "\nLIBS = $Config::Config{libs}\n"
 }    
 
-sub postamble {
-'
-B$(OBJ_EXT) : defsubs.h 
-'
+sub upupfile {
+    File::Spec->catfile(File::Spec->updir,
+			File::Spec->updir, $_[0]);
+}
+
+sub MY::postamble {
+    my $op_h   = upupfile('op.h');
+    my $cop_h  = upupfile('cop.h');
+    my $noecho = shift->{NOECHO};
+"
+B\$(OBJ_EXT) : defsubs.h              
+
+defsubs.h :: $op_h $cop_h                     
+	$noecho \$(NOOP)
+" 
 }
diff --git a/gnu/usr.bin/perl/ext/B/O.pm b/gnu/usr.bin/perl/ext/B/O.pm
index 352f8d42069..2ef91edbd92 100644
--- a/gnu/usr.bin/perl/ext/B/O.pm
+++ b/gnu/usr.bin/perl/ext/B/O.pm
@@ -1,5 +1,5 @@
 package O;
-use B qw(minus_c);
+use B qw(minus_c save_BEGINs);
 use Carp;    
 
 sub import {
@@ -11,6 +11,7 @@ sub import {
     my $compilesub = &{"B::${backend}::compile"}(@options);
     if (ref($compilesub) eq "CODE") {
 	minus_c;
+	save_BEGINs;
 	eval 'CHECK { &$compilesub() }';
     } else {
 	die $compilesub;
diff --git a/gnu/usr.bin/perl/ext/B/defsubs_h.PL b/gnu/usr.bin/perl/ext/B/defsubs_h.PL
index 80ef936fcec..da6566b0d71 100644
--- a/gnu/usr.bin/perl/ext/B/defsubs_h.PL
+++ b/gnu/usr.bin/perl/ext/B/defsubs_h.PL
@@ -6,16 +6,23 @@ my ($out) = __FILE__ =~ /(^.*)\.PL/i;
 $out =~ s/_h$/.h/;
 open(OUT,">$out") || die "Cannot open $file:$!";
 print "Extracting $out...\n";
-foreach my $const (qw(AVf_REAL 
+foreach my $const (qw(
+		      AVf_REAL 
 		      HEf_SVKEY
+		      SVf_READONLY SVTYPEMASK
+		      GVf_IMPORTED_AV GVf_IMPORTED_HV
+		      GVf_IMPORTED_SV GVf_IMPORTED_CV
+		      CVf_METHOD CVf_LOCKED CVf_LVALUE
                       SVf_IOK SVf_IVisUV SVf_NOK SVf_POK 
-		      SVf_ROK SVp_IOK SVp_POK ))
+		      SVf_ROK SVp_IOK SVp_POK SVp_NOK
+		      ))
  {
   doconst($const);
  }
 foreach my $file (qw(op.h cop.h))
  {
-  open(OPH,"../../$file") || die "Cannot open ../../$file:$!";
+  my $path = $^O eq 'MacOS' ? ":::$file" : "../../$file";
+  open(OPH,"$path") || die "Cannot open $path:$!";
   while (<OPH>)
    {  
     doconst($1) if (/#define\s+(\w+)\s+([\(\)\|\dx]+)\s*(?:$|\/\*)/);
diff --git a/gnu/usr.bin/perl/ext/DynaLoader/DynaLoader_pm.PL b/gnu/usr.bin/perl/ext/DynaLoader/DynaLoader_pm.PL
index e0eb604c73a..266c9d030f7 100644
--- a/gnu/usr.bin/perl/ext/DynaLoader/DynaLoader_pm.PL
+++ b/gnu/usr.bin/perl/ext/DynaLoader/DynaLoader_pm.PL
@@ -1,4 +1,3 @@
-
 use Config;
 
 sub to_string {
@@ -12,7 +11,7 @@ unlink "DynaLoader.pm" if -f "DynaLoader.pm";
 open OUT, ">DynaLoader.pm" or die $!;
 print OUT <<'EOT';
 
-# Generated from DynaLoader.pm.PL (resolved %Config::Config values)
+# Generated from DynaLoader.pm.PL
 
 package DynaLoader;
 
@@ -21,18 +20,22 @@ package DynaLoader;
 #   feast like to keep their secret; for wonder makes the words of
 #   praise louder.'
 
-#   (Quote from Tolkien sugested by Anno Siegel.)
+#   (Quote from Tolkien suggested by Anno Siegel.)
 #
 # See pod text at end of file for documentation.
 # See also ext/DynaLoader/README in source tree for other information.
 #
 # Tim.Bunce@ig.co.uk, August 1994
 
-$VERSION = "1.04";	# avoid typo warning
+use vars qw($VERSION *AUTOLOAD);
+
+$VERSION = 1.04;	# avoid typo warning
 
 require AutoLoader;
 *AUTOLOAD = \&AutoLoader::AUTOLOAD;
 
+use Config;
+
 # The following require can't be removed during maintenance
 # releases, sadly, because of the risk of buggy code that does 
 # require Carp; Carp::croak "..."; without brackets dying 
@@ -40,7 +43,6 @@ require AutoLoader;
 # We'll let those bugs get found on the development track.
 require Carp if $] < 5.00450; 
 
-
 # enable debug/trace messages from DynaLoader perl code
 $dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug;
 
@@ -71,52 +73,116 @@ print OUT <<'EOT';
 # (VMS support by Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>)
 # See dl_expandspec() for more details. Should be harmless but
 # inefficient to define on systems that don't need it.
-$do_expand = $Is_VMS = $^O eq 'VMS';
+$Is_VMS    = $^O eq 'VMS';
+$do_expand = $Is_VMS;
 $Is_MacOS  = $^O eq 'MacOS';
 
 @dl_require_symbols = ();       # names of symbols we need
 @dl_resolve_using   = ();       # names of files to link with
 @dl_library_path    = ();       # path to look for files
-#@dl_librefs         = ();       # things we have loaded
-#@dl_modules         = ();       # Modules we have loaded
+@dl_librefs         = ();       # things we have loaded
+@dl_modules         = ();       # Modules we have loaded
 
 # This is a fix to support DLD's unfortunate desire to relink -lc
 @dl_resolve_using = dl_findfile('-lc') if $dlsrc eq "dl_dld.xs";
 
-# Initialise @dl_library_path with the 'standard' library path
-# for this platform as determined by Configure
+EOT
 
-# push(@dl_library_path, split(' ', $Config::Config{'libpth'});
+my $cfg_dl_library_path = <<'EOT';
+push(@dl_library_path, split(' ', $Config::Config{libpth}));
 EOT
 
-print OUT "push(\@dl_library_path, split(' ', ",
-          to_string($Config::Config{'libpth'}), "));\n";
+sub dquoted_comma_list {
+    join(", ", map {qq("$_")} @_);
+}
 
-print OUT <<'EOT';
+if ($ENV{PERL_BUILD_EXPAND_CONFIG_VARS}) {
+    eval $cfg_dl_library_path;
+    if (!$ENV{PERL_BUILD_EXPAND_ENV_VARS}) {
+        my $dl_library_path = dquoted_comma_list(@dl_library_path);
+        print OUT <<EOT;
+# The below \@dl_library_path has been expanded (%Config) in Perl build time.
+
+\@dl_library_path = ($dl_library_path);
+
+EOT
+    }
+}
+else {
+    print OUT <<EOT;
+# Initialise \@dl_library_path with the 'standard' library path
+# for this platform as determined by Configure.
+
+$cfg_dl_library_path
+
+EOT
+}
+
+my $ldlibpthname;
+my $ldlibpthname_defined;
+my $pthsep;
+
+if ($ENV{PERL_BUILD_EXPAND_CONFIG_VARS}) {
+    $ldlibpthname         = $Config::Config{ldlibpthname};
+    $ldlibpthname_defined = defined $Config::Config{ldlibpthname} ? 1 : 0;
+    $pthsep               = $Config::Config{path_sep};
+}
+else {
+    $ldlibpthname         = q($Config::Config{ldlibpthname});
+    $ldlibpthname_defined = q(defined $Config::Config{ldlibpthname});
+    $pthsep               = q($Config::Config{path_sep});
+    print OUT <<EOT;
+my \$ldlibpthname         = $ldlibpthname;
+my \$ldlibpthname_defined = $ldlibpthname_defined;
+my \$pthsep               = $pthsep;
+
+EOT
+}
+
+my $env_dl_library_path = <<'EOT';
+if ($ldlibpthname_defined &&
+    exists $ENV{$ldlibpthname}) {
+    push(@dl_library_path, split(/$pthsep/, $ENV{$ldlibpthname}));
+}
 
-# Add to @dl_library_path any extra directories we can gather
-# from environment variables.
-if ($Is_MacOS) {
-    push(@dl_library_path, split(/,/, $ENV{LD_LIBRARY_PATH}))
-   	if exists $ENV{LD_LIBRARY_PATH};
-} else {
-    push(@dl_library_path, split(/:/, $ENV{$Config::Config{ldlibpthname}}))
-    	if exists      $Config::Config{ldlibpthname}        &&
-                       $Config::Config{ldlibpthname}  ne '' &&
-                exists $ENV{$Config::Config{ldlibpthname}}       ;;
-    push(@dl_library_path, split(/:/, $ENV{$Config::Config{ldlibpthname}}))
-    	if exists      $Config::Config{ldlibpthname}        &&
-                       $Config::Config{ldlibpthname}  ne '' &&
-                exists $ENV{$Config::Config{ldlibpthname}}       ;;
 # E.g. HP-UX supports both its native SHLIB_PATH *and* LD_LIBRARY_PATH.
-push(@dl_library_path, split(/:/, $ENV{LD_LIBRARY_PATH}))
-    if exists $ENV{LD_LIBRARY_PATH};
+
+if ($ldlibpthname_defined &&
+    $ldlibpthname ne 'LD_LIBRARY_PATH' &&
+    exists $ENV{LD_LIBRARY_PATH}) {
+    push(@dl_library_path, split(/$pthsep/, $ENV{LD_LIBRARY_PATH}));
+}
+EOT
+
+if ($ENV{PERL_BUILD_EXPAND_CONFIG_VARS} && $ENV{PERL_BUILD_EXPAND_ENV_VARS}) {
+    eval $env_dl_library_path;
+}
+else {
+    print OUT <<EOT;
+# Add to \@dl_library_path any extra directories we can gather from environment
+# during runtime.
+
+$env_dl_library_path
+
+EOT
+}
+
+if ($ENV{PERL_BUILD_EXPAND_CONFIG_VARS} && $ENV{PERL_BUILD_EXPAND_ENV_VARS}) {
+    my $dl_library_path = dquoted_comma_list(@dl_library_path);
+    print OUT <<EOT;
+# The below \@dl_library_path has been expanded (%Config, %ENV)
+# in Perl build time.
+
+\@dl_library_path = ($dl_library_path);
+
+EOT
 }
 
+print OUT <<'EOT';
 # No prizes for guessing why we don't say 'bootstrap DynaLoader;' here.
+# NOTE: All dl_*.xs (including dl_none.xs) define a dl_error() XSUB
 boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) &&
-                                !defined(&dl_load_file);
-
+                                !defined(&dl_error);
 
 if ($dl_debug) {
     print STDERR "DynaLoader.pm loaded (@INC, @dl_library_path)\n";
@@ -170,8 +236,8 @@ sub bootstrap {
 
     print STDERR "DynaLoader::bootstrap for $module ",
 		($Is_MacOS
-                      ? "(auto/$modpname/$modfname.$dl_dlext)\n" :
-		 	"(:auto:$modpname:$modfname.$dl_dlext)\n")
+		       ? "(:auto:$modpname:$modfname.$dl_dlext)\n" :
+		       "(auto/$modpname/$modfname.$dl_dlext)\n")
 	if $dl_debug;
 
     foreach (@INC) {
@@ -198,7 +264,7 @@ sub bootstrap {
     croak("Can't locate loadable object for module $module in \@INC (\@INC contains: @INC)")
 	unless $file;	# wording similar to error from 'require'
 
-    $file = uc($file) if $Is_VMS && $Config{d_vms_case_sensitive_symbols};
+    $file = uc($file) if $Is_VMS && $Config::Config{d_vms_case_sensitive_symbols};
     my $bootname = "boot_$module";
     $bootname =~ s/\W/_/g;
     @dl_require_symbols = ($bootname);
@@ -326,7 +392,7 @@ print OUT <<'EOT';
         #  (this is a more complicated issue than it first appears)
         if (m:/: && -d $_) {   push(@dirs, $_); next; }
 
-        # VMS: we may be using native VMS directry syntax instead of
+        # VMS: we may be using native VMS directory syntax instead of
         # Unix emulation, so check this as well
         if ($Is_VMS && /[:>\]]/ && -d $_) {   push(@dirs, $_); next; }
 
diff --git a/gnu/usr.bin/perl/ext/DynaLoader/dl_dllload.xs b/gnu/usr.bin/perl/ext/DynaLoader/dl_dllload.xs
new file mode 100644
index 00000000000..fe6957ac200
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/DynaLoader/dl_dllload.xs
@@ -0,0 +1,189 @@
+/* dl_dllload.xs
+ *
+ * Platform:	OS/390, possibly others that use dllload(),dllfree() (VM/ESA?).
+ * Authors:	John Goodyear && Peter Prymmer
+ * Created:     28 October 2000
+ * Modified:
+ * 16 January 2001 - based loosely on dl_dlopen.xs.
+ */
+ 
+/* Porting notes:
+
+   OS/390 Dynamic Loading functions: 
+
+   dllload
+   -------
+     dllhandle * dllload(const char *dllName)
+
+     This function takes the name of a dynamic object file and returns
+     a descriptor which can be used by dlllqueryfn() and/or dllqueryvar() 
+     later.  If dllName contains a slash, it is used to locate the dll.
+     If not then the LIBPATH environment variable is used to
+     search for the requested dll (at least within the HFS).
+     It returns NULL on error and sets errno.
+
+   dllfree
+   -------
+     int dllfree(dllhandle *handle);
+
+     dllfree() decrements the load count for the dll and frees
+     it if the count is 0.  It returns zero on success, and 
+     non-zero on failure.
+
+   dllqueryfn && dllqueryvar
+   -------------------------
+     void (* dllqueryfn(dllhandle *handle, const char *function))();
+     void * dllqueryvar(dllhandle *handle, const char *symbol);
+
+     dllqueryfn() takes the handle returned from dllload() and the name 
+     of a function to get the address of.  If the function was found 
+     a pointer is returned, otherwise NULL is returned.
+
+     dllqueryvar() takes the handle returned from dllload() and the name 
+     of a symbol to get the address of.  If the variable was found a 
+     pointer is returned, otherwise NULL is returned.
+
+     The XS dl_find_symbol() first calls dllqueryfn().  If it fails
+     dlqueryvar() is then called.
+
+   strerror
+   --------
+     char * strerror(int errno)
+
+     Returns a null-terminated string which describes the last error
+     that occurred with other functions (not necessarily unique to
+     dll loading).
+
+   Return Types
+   ============
+   In this implementation the two functions, dl_load_file() &&
+   dl_find_symbol(), return (void *).  This is primarily because the 
+   dlopen() && dlsym() style dynamic linker calls return (void *).
+   We suspect that casting to (void *) may be easier than teaching XS
+   typemaps about the (dllhandle *) type.
+
+   Dealing with Error Messages
+   ===========================
+   In order to make the handling of dynamic linking errors as generic as
+   possible you should store any error messages associated with your
+   implementation with the StoreError function.
+
+   In the case of OS/390 the function strerror(errno) returns the error 
+   message associated with the last dynamic link error.  As the S/390 
+   dynamic linker functions dllload() && dllqueryvar() both return NULL 
+   on error every call to an S/390 dynamic link routine is coded 
+   like this:
+
+	RETVAL = dllload(filename) ;
+	if (RETVAL == NULL)
+	    SaveError("%s",strerror(errno)) ;
+
+   Note that SaveError() takes a printf format string. Use a "%s" as
+   the first parameter if the error may contain any % characters.
+
+   Other comments within the dl_dlopen.xs file may be helpful as well.
+*/
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include <dll.h>	/* the dynamic linker include file for S/390 */
+#include <errno.h>	/* strerror() and friends */
+
+#include "dlutils.c"	/* SaveError() etc */
+
+static void
+dl_private_init(pTHX)
+{
+    (void)dl_generic_private_init(aTHX);
+}
+
+MODULE = DynaLoader	PACKAGE = DynaLoader
+
+BOOT:
+    (void)dl_private_init(aTHX);
+
+
+void *
+dl_load_file(filename, flags=0)
+    char *	filename
+    int		flags
+  PREINIT:
+    int mode = 0;
+  CODE:
+{
+    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
+    /* add a (void *) dllload(filename) ; cast if needed */
+    RETVAL = dllload(filename) ;
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) RETVAL));
+    ST(0) = sv_newmortal() ;
+    if (RETVAL == NULL)
+	SaveError(aTHX_ "%s",strerror(errno)) ;
+    else
+	sv_setiv( ST(0), PTR2IV(RETVAL));
+}
+
+
+int
+dl_unload_file(libref)
+    void *	libref
+  CODE:
+    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", PTR2ul(libref)));
+    /* RETVAL = (dllfree((dllhandle *)libref) == 0 ? 1 : 0); */
+    RETVAL = (dllfree(libref) == 0 ? 1 : 0);
+    if (!RETVAL)
+        SaveError(aTHX_ "%s", strerror(errno)) ;
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL));
+  OUTPUT:
+    RETVAL
+
+
+void *
+dl_find_symbol(libhandle, symbolname)
+    void *	libhandle
+    char *	symbolname
+    CODE:
+    DLDEBUG(2, PerlIO_printf(Perl_debug_log,
+			     "dl_find_symbol(handle=%lx, symbol=%s)\n",
+			     (unsigned long) libhandle, symbolname));
+    if((RETVAL = (void*)dllqueryfn(libhandle, symbolname)) == NULL)
+    RETVAL = dllqueryvar(libhandle, symbolname);
+    DLDEBUG(2, PerlIO_printf(Perl_debug_log,
+			     "  symbolref = %lx\n", (unsigned long) RETVAL));
+    ST(0) = sv_newmortal() ;
+    if (RETVAL == NULL)
+	SaveError(aTHX_ "%s",strerror(errno)) ;
+    else
+	sv_setiv( ST(0), PTR2IV(RETVAL));
+
+
+void
+dl_undef_symbols()
+    PPCODE:
+
+
+
+# These functions should not need changing on any platform:
+
+void
+dl_install_xsub(perl_name, symref, filename="$Package")
+    char *		perl_name
+    void *		symref 
+    char *		filename
+    CODE:
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%lx)\n",
+		perl_name, (unsigned long) symref));
+    ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
+					(void(*)(pTHX_ CV *))symref,
+					filename)));
+
+
+char *
+dl_error()
+    CODE:
+    RETVAL = LastError ;
+    OUTPUT:
+    RETVAL
+
+# end.
diff --git a/gnu/usr.bin/perl/ext/DynaLoader/dl_mac.xs b/gnu/usr.bin/perl/ext/DynaLoader/dl_mac.xs
new file mode 100644
index 00000000000..5f48139c56a
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/DynaLoader/dl_mac.xs
@@ -0,0 +1,137 @@
+/* dl_mac.xs
+ * 
+ * Platform:	Macintosh CFM
+ * Author:	Matthias Neeracher <neeri@iis.ee.ethz.ch>
+ *		Adapted from dl_dlopen.xs reference implementation by
+ *              Paul Marquess (pmarquess@bfsec.bt.co.uk)
+ * $Log: dl_mac.xs,v $
+ * Revision 1.3  1998/04/07 01:47:24  neeri
+ * MacPerl 5.2.0r4b1
+ *
+ * Revision 1.2  1997/08/08 16:39:18  neeri
+ * MacPerl 5.1.4b1 + time() fix
+ *
+ * Revision 1.1  1997/04/07 20:48:23  neeri
+ * Synchronized with MacPerl 5.1.4a1
+ *
+ */
+
+#define MAC_CONTEXT
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include <CodeFragments.h>
+
+
+#include "dlutils.c"	/* SaveError() etc	*/
+
+typedef CFragConnectionID ConnectionID;
+
+static ConnectionID **	connections;
+
+static void terminate(void)
+{
+    int size = GetHandleSize((Handle) connections) / sizeof(ConnectionID);
+    HLock((Handle) connections);
+    while (size)
+    	CloseConnection(*connections + --size);
+    DisposeHandle((Handle) connections);
+    connections = nil;
+}
+
+static void
+dl_private_init(pTHX)
+{
+    (void)dl_generic_private_init(aTHX);
+}
+
+MODULE = DynaLoader	PACKAGE = DynaLoader
+
+BOOT:
+    (void)dl_private_init(aTHX);
+
+
+ConnectionID
+dl_load_file(filename, flags=0)
+    char *		filename
+    int			flags
+    PREINIT:
+    OSErr		err;
+    FSSpec		spec;
+    ConnectionID	connID;
+    Ptr			mainAddr;
+    Str255		errName;
+    CODE:
+    DLDEBUG(1,PerlIO_printf(Perl_debug_log,"dl_load_file(%s):\n", filename));
+    err = GUSIPath2FSp(filename, &spec);
+    if (!err)
+    	err = 
+	    GetDiskFragment(
+	    	&spec, 0, 0, spec.name, kLoadCFrag, &connID, &mainAddr, errName);
+    if (!err) {
+    	if (!connections) {
+	    connections = (ConnectionID **)NewHandle(0);
+	    atexit(terminate);
+    	}
+        PtrAndHand((Ptr) &connID, (Handle) connections, sizeof(ConnectionID));
+    	RETVAL = connID;
+    } else
+    	RETVAL = (ConnectionID) 0;
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log," libref=%d\n", RETVAL));
+    ST(0) = sv_newmortal() ;
+    if (err)
+    	SaveError(aTHX_ "DynaLoader error [%d, %#s]", err, errName) ;
+    else
+    	sv_setiv( ST(0), (IV)RETVAL);
+
+void *
+dl_find_symbol(connID, symbol)
+    ConnectionID	connID
+    Str255		symbol
+    CODE:
+    {
+    	OSErr		    err;
+    	Ptr		    symAddr;
+    	CFragSymbolClass    symClass;
+    	DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_find_symbol(handle=%x, symbol=%#s)\n",
+	    connID, symbol));
+   	err = FindSymbol(connID, symbol, &symAddr, &symClass);
+    	if (err)
+    	    symAddr = (Ptr) 0;
+    	RETVAL = (void *) symAddr;
+    	DLDEBUG(2,PerlIO_printf(Perl_debug_log,"  symbolref = %x\n", RETVAL));
+    	ST(0) = sv_newmortal() ;
+    	if (err)
+	    SaveError(aTHX_ "DynaLoader error [%d]!", err) ;
+    	else
+	    sv_setiv( ST(0), (IV)RETVAL);
+    }
+
+void
+dl_undef_symbols()
+    PPCODE:
+
+
+
+# These functions should not need changing on any platform:
+
+void
+dl_install_xsub(perl_name, symref, filename="$Package")
+    char *		perl_name
+    void *		symref 
+    char *		filename
+    CODE:
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_install_xsub(name=%s, symref=%x)\n",
+		perl_name, symref));
+    ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
+
+
+char *
+dl_error()
+    CODE:
+    RETVAL = LastError ;
+    OUTPUT:
+    RETVAL
+
+# end.
diff --git a/gnu/usr.bin/perl/ext/DynaLoader/hints/aix.pl b/gnu/usr.bin/perl/ext/DynaLoader/hints/aix.pl
index 7dde941b43d..d4231ccb3ef 100644
--- a/gnu/usr.bin/perl/ext/DynaLoader/hints/aix.pl
+++ b/gnu/usr.bin/perl/ext/DynaLoader/hints/aix.pl
@@ -2,9 +2,13 @@
 use Config;
 if ($Config{libs} =~ /-lC/ && -f '/lib/libC.a') {
     $self->{CCFLAGS} = $Config{ccflags} . ' -DUSE_libC';
-    if (-f '/usr/ibmcxx/include/load.h') {
+    if (-f '/usr/vacpp/include/load.h') {
+	$self->{CCFLAGS} .= ' -DUSE_vacpp_load_h';
+    } elsif (-f '/usr/ibmcxx/include/load.h') {
 	$self->{CCFLAGS} .= ' -DUSE_ibmcxx_load_h';
     } elsif (-f '/usr/lpp/xlC/include/load.h') {
 	$self->{CCFLAGS} .= ' -DUSE_xlC_load_h';
+    } elsif (-f '/usr/include/load.h') {
+	$self->{CCFLAGS} .= ' -DUSE_load_h';
     }
 }
diff --git a/gnu/usr.bin/perl/ext/DynaLoader/hints/netbsd.pl b/gnu/usr.bin/perl/ext/DynaLoader/hints/netbsd.pl
new file mode 100644
index 00000000000..a0fbaf7d89e
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/DynaLoader/hints/netbsd.pl
@@ -0,0 +1,3 @@
+# XXX Configure test needed?
+# Some NetBSDs seem to have a dlopen() that won't accept relative paths
+$self->{CCFLAGS} = $Config{ccflags} . ' -DDLOPEN_WONT_DO_RELATIVE_PATHS';
diff --git a/gnu/usr.bin/perl/ext/Errno/ChangeLog b/gnu/usr.bin/perl/ext/Errno/ChangeLog
index 2bfa003d96a..dd94b37bafb 100644
--- a/gnu/usr.bin/perl/ext/Errno/ChangeLog
+++ b/gnu/usr.bin/perl/ext/Errno/ChangeLog
@@ -1,3 +1,8 @@
+Change 171 on 2000-09-12 by <calle@lysator.liu.se> (Calle Dybedahl)
+
+	- Fixed filename-extracting regexp to allow whitespace between
+	  "#" and "line", which the cpp on Unicos 9 produces.
+
 Change 170 on 1998/07/05 by <gbarr@pobox.com> (Graham Barr)
 
 	Fixed three problems reported by Hans Mulder for NeXT
diff --git a/gnu/usr.bin/perl/ext/Errno/Errno_pm.PL b/gnu/usr.bin/perl/ext/Errno/Errno_pm.PL
index df68dc3bda6..3f2f3e04266 100644
--- a/gnu/usr.bin/perl/ext/Errno/Errno_pm.PL
+++ b/gnu/usr.bin/perl/ext/Errno/Errno_pm.PL
@@ -29,6 +29,14 @@ sub process_file {
             warn "Cannot open '$file'";
             return;
 	}     
+    } elsif ($Config{gccversion} ne '') { 
+	# With the -dM option, gcc outputs every #define it finds
+	my $ccopts = "-E -dM ";
+	$ccopts .= "-traditional-cpp " if $^O eq 'darwin';
+	unless(open(FH,"$Config{cc} $ccopts $file |")) {
+            warn "Cannot open '$file'";
+            return;
+	}     
     } else {
 	unless(open(FH,"< $file")) {
 	    # This file could be a temporary file created by cppstdin
@@ -37,11 +45,19 @@ sub process_file {
             return;
 	}
     }
-    while(<FH>) {
-	$err{$1} = 1
-	    if /^\s*#\s*define\s+(E\w+)\s+/;
-   }
-   close(FH);
+
+    if ($^O eq 'MacOS') {
+	while(<FH>) {
+	    $err{$1} = $2
+		if /^\s*#\s*define\s+(E\w+)\s+(\d+)/;
+	}
+    } else {
+	while(<FH>) {
+	    $err{$1} = 1
+		if /^\s*#\s*define\s+(E\w+)\s+/;
+	}
+    }
+    close(FH);
 }
 
 my $cppstdin;
@@ -79,6 +95,18 @@ sub get_files {
     } elsif ($^O eq 'vmesa') {
 	# OS/390 C compiler doesn't generate #file or #line directives
 	$file{'../../vmesa/errno.h'} = 1;
+    } elsif ($Config{archname} eq 'epoc') {
+	# Watch out for cross compiling for EPOC (usually done on linux)
+	$file{'/usr/local/epoc/include/libc/sys/errno.h'} = 1;
+    } elsif ($^O eq 'linux') {
+	# Some Linuxes have weird errno.hs which generate
+	# no #file or #line directives
+	$file{'/usr/include/errno.h'} = 1;
+    } elsif ($^O eq 'MacOS') {
+	# note that we are only getting the GUSI errno's here ...
+	# we might miss out on compiler-specific ones
+	$file{"$ENV{GUSI}include:sys:errno.h"} = 1;
+
     } else {
 	open(CPPI,"> errno.c") or
 	    die "Cannot open errno.c";
@@ -102,7 +130,7 @@ sub get_files {
 	    $pat = '^/\*\s+(.+)\s+\d+\s*:\s+\*/';
 	}
 	else {
-	    $pat = '^#(?:line)?\s*\d+\s+"([^"]+)"';
+	    $pat = '^#\s*(?:line)?\s*\d+\s+"([^"]+)"';
 	}
 	while(<CPPO>) {
 	    if ($^O eq 'os2' or $^O eq 'MSWin32') {
@@ -141,31 +169,33 @@ sub write_errno_pm {
 
     close(CPPI);
 
+    unless ($^O eq 'MacOS') {	# trust what we have
     # invoke CPP and read the output
 
-    if ($^O eq 'VMS') {
-	my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}";
-	$cpp =~ s/sys\$input//i;
-	open(CPPO,"$cpp  errno.c |") or
-          die "Cannot exec $Config{cppstdin}";
-    } elsif ($^O eq 'MSWin32') {
-	open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
-	    die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
-    } else {
-	my $cpp = default_cpp();
-	open(CPPO,"$cpp < errno.c |")
-	    or die "Cannot exec $cpp";
-    }
+	if ($^O eq 'VMS') {
+	    my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}";
+	    $cpp =~ s/sys\$input//i;
+	    open(CPPO,"$cpp  errno.c |") or
+		die "Cannot exec $Config{cppstdin}";
+	} elsif ($^O eq 'MSWin32') {
+	    open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
+		die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
+	} else {
+	    my $cpp = default_cpp();
+	    open(CPPO,"$cpp < errno.c |")
+		or die "Cannot exec $cpp";
+	}
 
-    %err = ();
+	%err = ();
 
-    while(<CPPO>) {
-	my($name,$expr);
-	next unless ($name, $expr) = /"(.*?)"\s*\[\s*\[\s*(.*?)\s*\]\s*\]/;
-	next if $name eq $expr;
-	$err{$name} = eval $expr;
+	while(<CPPO>) {
+	    my($name,$expr);
+	    next unless ($name, $expr) = /"(.*?)"\s*\[\s*\[\s*(.*?)\s*\]\s*\]/;
+	    next if $name eq $expr;
+	    $err{$name} = eval $expr;
+	}
+	close(CPPO);
     }
-    close(CPPO);
 
     # Write Errno.pm
 
diff --git a/gnu/usr.bin/perl/ext/GDBM_File/GDBM_File.xs b/gnu/usr.bin/perl/ext/GDBM_File/GDBM_File.xs
index 870f056c9bf..5e426f90f32 100644
--- a/gnu/usr.bin/perl/ext/GDBM_File/GDBM_File.xs
+++ b/gnu/usr.bin/perl/ext/GDBM_File/GDBM_File.xs
@@ -42,12 +42,14 @@ typedef datum datum_value ;
 
 typedef void (*FATALFUNC)();
 
+#ifndef GDBM_FAST
 static int
 not_here(char *s)
 {
     croak("GDBM_File::%s not implemented on this architecture", s);
     return -1;
 }
+#endif
 
 /* GDBM allocates the datum with system malloc() and expects the user
  * to free() it.  So we either have to free() it immediately, or have
@@ -56,7 +58,7 @@ not_here(char *s)
 static void
 output_datum(pTHX_ SV *arg, char *str, int size)
 {
-#if !defined(MYMALLOC) || (defined(MYMALLOC) && defined(PERL_POLLUTE_MALLOC))
+#if !defined(MYMALLOC) || (defined(MYMALLOC) && defined(PERL_POLLUTE_MALLOC) && !defined(LEAKTEST))
 	sv_usepvn(arg, str, size);
 #else
 	sv_setpvn(arg, str, size);
@@ -122,6 +124,12 @@ constant(char *name, int arg)
 #else
 	    goto not_there;
 #endif
+	if (strEQ(name, "GDBM_NOLOCK"))
+#ifdef GDBM_NOLOCK
+	    return GDBM_NOLOCK;
+#else
+	    goto not_there;
+#endif
 	if (strEQ(name, "GDBM_READER"))
 #ifdef GDBM_READER
 	    return GDBM_READER;
@@ -214,7 +222,7 @@ gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func = (FATALFUNC)croak)
 	    GDBM_FILE  	dbp ;
 
 	    RETVAL = NULL ;
-	    if (dbp =  gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode, fatal_func)) {
+	    if ((dbp =  gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode, fatal_func))) {
 	        RETVAL = (GDBM_File)safemalloc(sizeof(GDBM_File_type)) ;
     	        Zero(RETVAL, 1, GDBM_File_type) ;
 		RETVAL->dbp = dbp ;
diff --git a/gnu/usr.bin/perl/ext/NDBM_File/NDBM_File.xs b/gnu/usr.bin/perl/ext/NDBM_File/NDBM_File.xs
index 49a1db5e565..c417eb693e9 100644
--- a/gnu/usr.bin/perl/ext/NDBM_File/NDBM_File.xs
+++ b/gnu/usr.bin/perl/ext/NDBM_File/NDBM_File.xs
@@ -1,6 +1,11 @@
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
+/* If using the DB3 emulation, ENTER is defined both
+ * by DB3 and Perl.  We drop the Perl definition now.
+ * See also INSTALL section on DB3.
+ * -- Stanislav Brabec <utx@penguin.cz> */
+#undef ENTER
 #include <ndbm.h>
 
 typedef struct {
diff --git a/gnu/usr.bin/perl/ext/ODBM_File/typemap b/gnu/usr.bin/perl/ext/ODBM_File/typemap
index 7c23815ec75..096427ea7f3 100644
--- a/gnu/usr.bin/perl/ext/ODBM_File/typemap
+++ b/gnu/usr.bin/perl/ext/ODBM_File/typemap
@@ -20,8 +20,14 @@ T_DATUM_K
 	$var.dsize = (int)PL_na;
 T_DATUM_V
         ckFilter($arg, filter_store_value, \"filter_store_value\");
-	$var.dptr = SvPV($arg, PL_na);
-	$var.dsize = (int)PL_na;
+	if (SvOK($arg)) {
+	    $var.dptr = SvPV($arg, PL_na);
+	    $var.dsize = (int)PL_na;
+	}
+	else {
+	    $var.dptr = \"\";
+	    $var.dsize = 0;
+	}
 T_GDATUM
 	UNIMPLEMENTED
 OUTPUT
diff --git a/gnu/usr.bin/perl/ext/POSIX/Makefile.PL b/gnu/usr.bin/perl/ext/POSIX/Makefile.PL
index 55c5c1fbf3f..73bb02dddb5 100644
--- a/gnu/usr.bin/perl/ext/POSIX/Makefile.PL
+++ b/gnu/usr.bin/perl/ext/POSIX/Makefile.PL
@@ -2,12 +2,7 @@ use ExtUtils::MakeMaker;
 use Config;
 my @libs;
 if ($^O ne 'MSWin32') {
-    if ($Config{archname} =~ /RM\d\d\d-svr4/) {
-	@libs = ('LIBS' => ["-lm -lc -lposix -lcposix"]);
-    }
-    else {
-	@libs = ('LIBS' => ["-lm -lposix -lcposix"]);
-    }
+    @libs = ('LIBS' => ["-lm -lposix -lcposix"]);
 }
 WriteMakefile(
     NAME	=> 'POSIX',
diff --git a/gnu/usr.bin/perl/ext/POSIX/hints/svr4.pl b/gnu/usr.bin/perl/ext/POSIX/hints/svr4.pl
new file mode 100644
index 00000000000..07f2cb04126
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/POSIX/hints/svr4.pl
@@ -0,0 +1,12 @@
+# NCR MP-RAS.  Thanks to Doug Hendricks for this info.
+# Configure sets osname=svr4.0, osvers=3.0, archname='3441-svr4.0'
+# This system needs to explicitly link against -lmw to pull in some
+# symbols such as _mwoflocheckl and possibly others.
+#  A. Dougherty  Thu Dec  7 11:55:28 EST 2000
+if ($Config{'archname'} =~ /3441-svr4/) {
+    $self->{LIBS} = ['-lm -posix -lcposix -lmw'];
+}
+# Not sure what OS this one is.
+elsif ($Config{archname} =~ /RM\d\d\d-svr4/) {
+    $self->{LIBS} = ['-lm -lc -lposix -lcposix'];
+}
diff --git a/gnu/usr.bin/perl/ext/POSIX/typemap b/gnu/usr.bin/perl/ext/POSIX/typemap
index 63e41c77bf1..baf9bfc0519 100644
--- a/gnu/usr.bin/perl/ext/POSIX/typemap
+++ b/gnu/usr.bin/perl/ext/POSIX/typemap
@@ -5,6 +5,7 @@ Time_t			T_NV
 Gid_t			T_NV
 Off_t			T_NV
 Dev_t			T_NV
+NV			T_NV
 fd			T_IV
 speed_t			T_IV
 tcflag_t		T_IV
diff --git a/gnu/usr.bin/perl/ext/SDBM_File/SDBM_File.xs b/gnu/usr.bin/perl/ext/SDBM_File/SDBM_File.xs
index a4b90451a9b..859730bf3ac 100644
--- a/gnu/usr.bin/perl/ext/SDBM_File/SDBM_File.xs
+++ b/gnu/usr.bin/perl/ext/SDBM_File/SDBM_File.xs
@@ -57,7 +57,7 @@ sdbm_TIEHASH(dbtype, filename, flags, mode)
 	    DBM * 	dbp ;
 
 	    RETVAL = NULL ;
-	    if (dbp = sdbm_open(filename,flags,mode) ) {
+	    if ((dbp = sdbm_open(filename,flags,mode))) {
 	        RETVAL = (SDBM_File)safemalloc(sizeof(SDBM_File_type)) ;
     	        Zero(RETVAL, 1, SDBM_File_type) ;
 		RETVAL->dbp = dbp ;
diff --git a/gnu/usr.bin/perl/ext/re/Makefile.PL b/gnu/usr.bin/perl/ext/re/Makefile.PL
index bd0f1f741c1..bc31b2c2cc6 100644
--- a/gnu/usr.bin/perl/ext/re/Makefile.PL
+++ b/gnu/usr.bin/perl/ext/re/Makefile.PL
@@ -1,4 +1,6 @@
 use ExtUtils::MakeMaker;
+use File::Spec;
+
 WriteMakefile(
     NAME		=> 're',
     VERSION_FROM	=> 're.pm',
@@ -9,33 +11,28 @@ WriteMakefile(
     clean		=> { FILES => '*$(OBJ_EXT) *.c ../../lib/re.pm' },
 );
 
-sub MY::postamble {
-  if ($^O eq 'VMS') {
-    return <<'VMS_EOF';
-re_comp.c : [--]regcomp.c
-	- $(RM_F) $(MMS$TARGET_NAME)
-	$(CP) [--]regcomp.c $(MMS$TARGET_NAME)
+package MY;
 
-re_comp$(OBJ_EXT) : re_comp.c
+sub upupfile {
+    File::Spec->catfile(File::Spec->updir, File::Spec->updir, $_[0]);
+}
 
-re_exec.c : [--]regexec.c
-	- $(RM_F) $(MMS$TARGET_NAME)
-	$(CP) [--]regexec.c $(MMS$TARGET_NAME)
+sub postamble {
+    my $regcomp_c = upupfile('regcomp.c');
+    my $regexec_c = upupfile('regexec.c');
 
-re_exec$(OBJ_EXT) : re_exec.c
+    <<EOF;
+re_comp.c : $regcomp_c
+	- \$(RM_F) re_comp.c
+	\$(CP) $regcomp_c re_comp.c
 
+re_comp\$(OBJ_EXT) : re_comp.c
 
-VMS_EOF
-  } else {
-    return <<'EOF';
-re_comp.c: ../../regcomp.c
-	-$(RM_F) $@
-	$(CP) ../../regcomp.c $@
+re_exec.c : $regexec_c
+	- \$(RM_F) re_exec.c
+	\$(CP) $regexec_c re_exec.c
 
-re_exec.c: ../../regexec.c
-	-$(RM_F) $@
-	$(CP) ../../regexec.c $@
+re_exec\$(OBJ_EXT) : re_exec.c
 
 EOF
-  }
 }
diff --git a/gnu/usr.bin/perl/ext/re/hints/aix.pl b/gnu/usr.bin/perl/ext/re/hints/aix.pl
new file mode 100644
index 00000000000..4fbfefd7358
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/re/hints/aix.pl
@@ -0,0 +1,22 @@
+# Add explicit link to deb.o to pick up .Perl_deb symbol which is not
+# mentioned in perl.exp for earlier cc (xlc) versions in at least
+# non DEBUGGING builds
+#  Peter Prymmer <pvhp@best.com>
+
+use Config;
+
+if ($^O eq 'aix' && defined($Config{'ccversion'}) && 
+    ( $Config{'ccversion'} =~ /^3\.\d/
+      # needed for at least these versions:
+      # $Config{'ccversion'} eq '3.6.6.0' 
+      # $Config{'ccversion'} eq '3.6.4.0' 
+      # $Config{'ccversion'} eq '3.1.4.0'  AIX 4.2
+      # $Config{'ccversion'} eq '3.1.4.10' AIX 4.2
+      # $Config{'ccversion'} eq '3.1.3.3' 
+      ||
+      $Config{'ccversion'} =~ /^4\.4\.0\.[0-3]/
+    )
+   ) {
+    $self->{OBJECT} .= ' ../../deb$(OBJ_EXT)';
+}
+
diff --git a/gnu/usr.bin/perl/ext/re/re.xs b/gnu/usr.bin/perl/ext/re/re.xs
index 04a5fdc7420..25c2a90d60f 100644
--- a/gnu/usr.bin/perl/ext/re/re.xs
+++ b/gnu/usr.bin/perl/ext/re/re.xs
@@ -25,7 +25,6 @@ static int oldfl;
 static void
 deinstall(pTHX)
 {
-    dTHR;
     PL_regexecp = Perl_regexec_flags;
     PL_regcompp = Perl_pregcomp;
     PL_regint_start = Perl_re_intuit_start;
@@ -39,7 +38,6 @@ deinstall(pTHX)
 static void
 install(pTHX)
 {
-    dTHR;
     PL_colorset = 0;			/* Allow reinspection of ENV. */
     PL_regexecp = &my_regexec;
     PL_regcompp = &my_regcomp;